fltkhs 0.1.0.2 → 0.2.0.0

raw patch · 130 files changed

+9471/−6880 lines, 130 filesdep +filepathdep +ghcdep +mtlsetup-changednew-component:exe:fltkhs-fluidtohsnew-component:exe:fltkhs-packnew-component:exe:fltkhs-tilePVP ok

version bump matches the API change (PVP)

Dependencies added: filepath, ghc, mtl, parsec

API changes (from Hackage documentation)

Files

• .gitignore +4/−0
• README.md +5/−8
• Setup.hs +3/−2
• c-examples/cube.c +0/−1
• c-examples/list_visuals.h +0/−1
• c-examples/sanity_check.c +3/−0
• c-src/CMakeLists.txt +4/−1
• c-src/Fl_AskC.h +11/−0
• c-src/Fl_CallbackC.cpp +63/−9
• c-src/Fl_ChoiceC.cpp +1/−1
• c-src/Fl_Color_ChooserC.cpp +10/−4
• c-src/Fl_Color_ChooserC.h +5/−3
• c-src/Fl_CounterC.h +7/−1
• c-src/Fl_DialC.h +8/−0
• c-src/Fl_EnumerationsC.cpp +2/−1
• c-src/Fl_EnumerationsC.h +14/−2
• c-src/Fl_GroupC.cpp +6/−0
• c-src/Fl_GroupC.h +2/−2
• c-src/Fl_Menu_ButtonC.cpp +1/−1
• c-src/Fl_Menu_ButtonC.h +12/−0
• c-src/Fl_Menu_C.cpp +8/−1
• c-src/Fl_Menu_C.h +3/−1
• c-src/Fl_Menu_ItemC.cpp +10/−0
• c-src/Fl_Menu_ItemC.h +1/−0
• c-src/Fl_PackC.cpp +31/−0
• c-src/Fl_PackC.h +22/−0
• c-src/Fl_ScrollC.cpp +45/−0
• c-src/Fl_ScrollC.h +27/−0
• c-src/Fl_ScrollbarC.h +3/−3
• c-src/Fl_SpinnerC.cpp +90/−0
• c-src/Fl_SpinnerC.h +48/−0
• c-src/Fl_Sys_Menu_BarC.cpp +1/−1
• c-src/Fl_TileC.cpp +3/−0
• c-src/Fl_TileC.h +1/−1
• c-src/Fl_TreeC.cpp +9/−0
• c-src/Fl_TreeC.h +3/−0
• c-src/Fl_Types.h +6/−1
• c-src/Fl_ValuatorC.h +6/−0
• c-src/Fl_WidgetC.cpp +13/−0
• c-src/Fl_WidgetC.h +2/−0
• c-src/Fl_WindowC.h +4/−0
• c-src/Makefile.in +4/−1
• c-src/Utils.cpp +0/−11
• c-src/Utils.h +0/−9
• c-src/UtilsC.cpp +11/−0
• c-src/UtilsC.h +9/−0
• configure.ac +1/−0
• fltkhs.cabal +77/−37
• scripts/doc-parser.hs +88/−46
• scripts/header-to-function-definition.hs +10/−1
• src/Examples/bitmap.hs +2/−2
• src/Examples/boxtype.hs +1/−1
• src/Examples/browser.hs +6/−6
• src/Examples/clock.hs +2/−2
• src/Examples/doublebuffer.hs +9/−20
• src/Examples/hello-world.hs +0/−29
• src/Examples/nativefilechooser-simple-app.hs +14/−14
• src/Examples/pack.hs +73/−0
• src/Examples/table-as-container.hs +3/−3
• src/Examples/table-simple.hs +1/−1
• src/Examples/table-sort.hs +4/−4
• src/Examples/table-spreadsheet-with-keyboard-nav.hs +4/−4
• src/Examples/textdisplay-with-colors.hs +2/−2
• src/Examples/texteditor-simple.hs +1/−1
• src/Examples/tile.hs +69/−0
• src/Fluid/Generate.hs +462/−0
• src/Fluid/Lookup.hs +288/−0
• src/Fluid/Main.hs +44/−0
• src/Fluid/Migrate.hs +169/−0
• src/Fluid/Parser.hs +536/−0
• src/Fluid/Types.hs +168/−0
• src/Graphics/UI/FLTK/LowLevel/Adjuster.chs +3/−2
• src/Graphics/UI/FLTK/LowLevel/Ask.chs +51/−0
• src/Graphics/UI/FLTK/LowLevel/Bitmap.chs +29/−27
• src/Graphics/UI/FLTK/LowLevel/Browser.chs +94/−87
• src/Graphics/UI/FLTK/LowLevel/Button.chs +52/−39
• src/Graphics/UI/FLTK/LowLevel/Choice.chs +8/−6
• src/Graphics/UI/FLTK/LowLevel/ColorChooser.chs +217/−0
• src/Graphics/UI/FLTK/LowLevel/CopySurface.chs +6/−4
• src/Graphics/UI/FLTK/LowLevel/Counter.chs +23/−9
• src/Graphics/UI/FLTK/LowLevel/Dial.chs +21/−5
• src/Graphics/UI/FLTK/LowLevel/Dispatch.hs +14/−3
• src/Graphics/UI/FLTK/LowLevel/Draw.chs +127/−117
• src/Graphics/UI/FLTK/LowLevel/FL.chs +43/−24
• src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs +111/−11
• src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs +113/−20
• src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs +81/−38
• src/Graphics/UI/FLTK/LowLevel/Gl.chs +12/−12
• src/Graphics/UI/FLTK/LowLevel/GlWindow.chs +29/−29
• src/Graphics/UI/FLTK/LowLevel/Group.chs +37/−26
• src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs +3853/−4935
• src/Graphics/UI/FLTK/LowLevel/Image.chs +29/−31
• src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs +5/−5
• src/Graphics/UI/FLTK/LowLevel/Input.chs +76/−75
• src/Graphics/UI/FLTK/LowLevel/MenuButton.chs +19/−4
• src/Graphics/UI/FLTK/LowLevel/MenuItem.chs +90/−88
• src/Graphics/UI/FLTK/LowLevel/MenuPrim.chs +85/−71
• src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs +29/−29
• src/Graphics/UI/FLTK/LowLevel/Output.chs +68/−0
• src/Graphics/UI/FLTK/LowLevel/OverlayWindow.chs +6/−6
• src/Graphics/UI/FLTK/LowLevel/Pack.chs +79/−0
• src/Graphics/UI/FLTK/LowLevel/Pixmap.chs +18/−18
• src/Graphics/UI/FLTK/LowLevel/Positioner.chs +16/−16
• src/Graphics/UI/FLTK/LowLevel/Progress.chs +6/−6
• src/Graphics/UI/FLTK/LowLevel/RepeatButton.chs +6/−6
• src/Graphics/UI/FLTK/LowLevel/Scrollbar.chs +17/−6
• src/Graphics/UI/FLTK/LowLevel/Scrolled.chs +100/−0
• src/Graphics/UI/FLTK/LowLevel/Slider.chs +13/−7
• src/Graphics/UI/FLTK/LowLevel/Spinner.chs +164/−0
• src/Graphics/UI/FLTK/LowLevel/SysMenuBar.chs +15/−15
• src/Graphics/UI/FLTK/LowLevel/Table.chs +79/−77
• src/Graphics/UI/FLTK/LowLevel/TableRow.chs +10/−10
• src/Graphics/UI/FLTK/LowLevel/Tabs.chs +99/−0
• src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs +108/−108
• src/Graphics/UI/FLTK/LowLevel/TextDisplay.chs +98/−94
• src/Graphics/UI/FLTK/LowLevel/TextEditor.chs +6/−6
• src/Graphics/UI/FLTK/LowLevel/TextSelection.chs +8/−8
• src/Graphics/UI/FLTK/LowLevel/Tile.chs +73/−0
• src/Graphics/UI/FLTK/LowLevel/Timer.chs +6/−6
• src/Graphics/UI/FLTK/LowLevel/Tree.chs +203/−181
• src/Graphics/UI/FLTK/LowLevel/TreeItem.chs +136/−136
• src/Graphics/UI/FLTK/LowLevel/TreePrefs.chs +79/−79
• src/Graphics/UI/FLTK/LowLevel/Utils.hs +53/−10
• src/Graphics/UI/FLTK/LowLevel/Valuator.chs +31/−17
• src/Graphics/UI/FLTK/LowLevel/ValueInput.chs +26/−26
• src/Graphics/UI/FLTK/LowLevel/ValueOutput.chs +17/−18
• src/Graphics/UI/FLTK/LowLevel/ValueSlider.chs +6/−6
• src/Graphics/UI/FLTK/LowLevel/Widget.chs +58/−49
• src/Graphics/UI/FLTK/LowLevel/Window.chs +42/−23
• src/Graphics/UI/FLTK/LowLevel/Wizard.chs +13/−10

@@ -32,3 +32,7 @@ /c-src/cmake_install.cmake /c-src/libfltkdyn.so /cmake_install.cmake+/src/Fluid/Parser+/src/Fluid/Parser.hi+/src/Fluid/Types.hi+/TAGS

@@ -3,13 +3,7 @@  Fltkhs aims to be a complete Haskell binding to the [FLTK GUI library] [1]. -The rest of the documentation (including installation instructions and usage) is located in-src/Examples/Graphics/UI/LowLevel/FLTK/FLTKHS.hs. This is the primary module that needs to be-imported by every Fltkhs app and the entry point into the application.--This package does not yet install on Windows.--Abbreviated installation instructions are reproduced here:+Abbreviated installation instructions are for Linux and Mac are:  - Download [FLTK 1.3.3] [2]. - Install with:@@ -25,8 +19,11 @@     cabal install ``` -- Test your installation by invoking: 'fltkhs-hello-world'.+- Test your installation by invoking: 'fltkhs-arc'. +The rest of the documentation (including installation instructions for Windows and API usage) is located in the [FLTKHS module] [3]. This is the primary module that needs to be imported by every Fltkhs app and the entry point into the application. +   [1]: http://www.fltk.org/index.php      "FLTK"   [2]: http://www.fltk.org/software.php+  [3]: http://hackage.haskell.org/package/fltkhs/docs/Graphics-UI-FLTK-LowLevel-FLTKHS.html

@@ -175,7 +175,8 @@          verbosity = fromFlag (buildVerbosity bld_flags)          with_in_place            = local_bld_info{withPackageDB =-                              withPackageDB local_bld_info ++ [SpecificPackageDB dbFile]}+                              withPackageDB local_bld_info ++ [SpecificPackageDB dbFile]+                           }          pref = buildDir local_bld_info      withAllComponentsInBuildOrder pkg_descr with_in_place $        \ comp clbi ->@@ -216,7 +217,7 @@     case buildOS of      Linux -> rawSystemExit (fromFlag $ copyVerbosity flags) "cp"               ["c-lib/libfltkcdyn.so", libPref]-     _ -> return ()+  myCleanHook pd x uh cf = do   rawSystemExit normal "make" ["clean"]

@@ -1,4 +1,3 @@-#include <config.h> #include <Fl_C.h> #include <Fl_WindowC.h> #include <Fl_BoxC.h>

@@ -1,4 +1,3 @@-#include <config.h> #include <X11/Xlib.h> #include <X11/Xutil.h> #include <X11/Xatom.h>

@@ -10,11 +10,13 @@ #include <Fl_Check_ButtonC.h> #include <Fl_ChoiceC.h> #include <Fl_ScrollbarC.h>+#include <Fl_ScrollC.h> #include <Fl_Value_SliderC.h> #include <Fl_ClockC.h> #include <Fl_ClockC.h> #include <Fl_Color_ChooserC.h> #include <Fl_CounterC.h>+#include <Fl_SpinnerC.h> #include <Fl_DeviceC.h> #include <Fl_Double_WindowC.h> #include <Fl_DialC.h>@@ -73,6 +75,7 @@ #include <Fl_Text_EditorC.h> #include <Fl_Text_SelectionC.h> #include <Fl_TileC.h>+#include <Fl_PackC.h> #include <Fl_Toggle_ButtonC.h> #include <Fl_TooltipC.h> #include <Fl_TreeC.h>

@@ -5,10 +5,11 @@ 	Fl_Value_OutputC.cpp 	Fl_Value_SliderC.cpp 	Fl_ScrollbarC.cpp+	Fl_ScrollC.cpp 	Fl_RollerC.cpp 	Fl_DialC.cpp 	Fl_CounterC.cpp-	Utils.cpp+	UtilsC.cpp 	xC.cpp 	fl_utf8C.cpp 	glC.cpp@@ -73,6 +74,7 @@ 	fl_show_colormapC.cpp 	Fl_Single_WindowC.cpp 	Fl_SliderC.cpp+	Fl_SpinnerC.cpp 	Fl_Sys_Menu_BarC.cpp 	Fl_TableC.cpp 	Fl_Table_RowC.cpp@@ -82,6 +84,7 @@ 	Fl_Text_EditorC.cpp 	Fl_Text_SelectionC.cpp 	Fl_TileC.cpp+	Fl_PackC.cpp 	Fl_Toggle_ButtonC.cpp 	Fl_TooltipC.cpp 	Fl_TreeC.cpp

@@ -10,6 +10,17 @@ #include "Fl_CallbackC.h" EXPORT { #endif+#ifndef INTERNAL_LINKAGE+  typedef enum Fl_Beep {+    FL_BEEP_DEFAULT = 0,+    FL_BEEP_MESSAGE = 1,+    FL_BEEP_ERROR = 2,+    FL_BEEP_QUESTION = 3,+    FL_BEEP_PASSWORD = 4,+    FL_BEEP_NOTIFICATION = 5+  } Fl_Beep;+#endif+   FL_EXPORT_C(void,flc_beep)();   FL_EXPORT_C(void,flc_beep_with_type)(int type);   FL_EXPORT_C(void,flc_message)(const char* message);

@@ -32,10 +32,22 @@   this->user_data = user_data; } void C_to_Fl_Callback::set_callback(Fl_File_Chooser* c){-  c->callback(intercept, this);+  if (this->callback) {+    c->callback(intercept, this);+  }+  else {+    void* p = 0;+    c->callback(NULL,p);+  } } void C_to_Fl_Callback::set_callback(Fl_Menu_Item* item){-  item->callback(intercept,this);+  if (this->callback) {+    item->callback(intercept, this);+  }+  else {+    void* p = 0;+    item->callback(NULL,p);+  } } void C_to_Fl_Callback::set_callback(Fl_Text_Buffer* b){   b->transcoding_warning_action = intercept;@@ -47,25 +59,67 @@   this->user_data = user_data; } int C_to_Fl_Callback::menu_insert(Fl_Menu_Item* item, int index, char* name, int shortcut, int flags){-  return item->insert(index,name,shortcut,intercept,this,flags);+  if (this->callback) {+    return item->insert(index,name,shortcut,intercept,this,flags);+  }+  else {+    void* p = 0;+    return item->insert(index,name,shortcut,NULL,p,flags);+  } } int C_to_Fl_Callback::menu_insert(Fl_Menu_* menu_, int index, char* name, int shortcut, int flags){-  return menu_->insert(index,name,shortcut,intercept,this,flags);+  if (this->callback) {+    return menu_->insert(index,name,shortcut,intercept,this,flags);+  }+  else {+    void* p = 0;+    return menu_->insert(index,name,shortcut,NULL,p,flags);+  } } int C_to_Fl_Callback::menu_insert(Fl_Menu_* menu_, int index, char* name, char* shortcut, int flags){-  return menu_->insert(index,name,shortcut,intercept,this,flags);+  if (this->callback) {+    return menu_->insert(index,name,shortcut,intercept,this,flags);+  }+  else {+    void* p = 0;+    return menu_->insert(index,name,shortcut,NULL,p,flags);+  } } int C_to_Fl_Callback::menu_add(Fl_Menu_Item* item, char* name, int shortcut, int flags){-  return item->add(name, shortcut, intercept, this, flags);+  if (this->callback) {+    return item->add(name, shortcut, intercept, this, flags);+  }+  else {+    void* p = 0;+    return item->add(name, shortcut, NULL, p, flags);+  } } int C_to_Fl_Callback::menu_add(Fl_Menu_Item* item, char* name, char* shortcut, int flags){-  return item->add(name, shortcut, intercept, this, flags);+  if (this->callback) {+    return item->add(name, shortcut, intercept, this, flags);+  }+  else {+    void* p = 0;+    return item->add(name, shortcut, NULL, p, flags);+  } } int C_to_Fl_Callback::menu_add(Fl_Menu_* menu_, char* name, char* shortcut, int flags){-  return menu_->add(name,shortcut,intercept,this,flags);+  if (this->callback) {+    return menu_->add(name,shortcut,intercept,this,flags);+  }+  else {+    void* p = 0;+    return menu_->add(name,shortcut,NULL,p,flags);+  } } int C_to_Fl_Callback::menu_add(Fl_Menu_* menu_, char* name, int shortcut, int flags){-  return menu_->add(name,shortcut,intercept,this,flags);+  if (this->callback) {+    return menu_->add(name,shortcut,intercept,this,flags);+  }+  else {+    void* p = 0;+    return menu_->add(name,shortcut,NULL,p,flags);+  } } void C_to_Fl_Callback::runCallback(Fl_Widget* w) {   (*callback)((fl_Widget) w, user_data);

@@ -1,5 +1,5 @@ #include "Fl_ChoiceC.h"-#include "Utils.h"+#include "UtilsC.h" #ifdef __cplusplus EXPORT { #endif

@@ -369,11 +369,17 @@   FL_EXPORT_C(void,Fl_Color_Chooser_rgb2hsv)(double R,double G,double B,double* H,double* S,double* V){     Fl_Color_Chooser::rgb2hsv(R,G,B,*H,*S,*V);   }-  FL_EXPORT_C(int, flc_color_chooser)(const char* name, double r, double g, double b){-    return fl_color_chooser(name,r,g,b);+  FL_EXPORT_C(int, flc_color_chooser)(const char* name, double* r, double* g, double* b){+    return fl_color_chooser(name,*r,*g,*b);   }-  FL_EXPORT_C(int, flc_color_chooser_with_m)(const char* name, double r, double g, double b, int m){-    return fl_color_chooser(name,r,g,b,m);+  FL_EXPORT_C(int, flc_color_chooser_with_m)(const char* name, double* r, double* g, double* b, int m){+    return fl_color_chooser(name,*r,*g,*b,m);+  }+  FL_EXPORT_C(int, flc_color_chooser_with_uchar)(const char* name, uchar* r, uchar* g, uchar* b){+    return fl_color_chooser(name,*r,*g,*b);+  }+  FL_EXPORT_C(int, flc_color_chooser_with_uchar_m)(const char* name, uchar* r, uchar* g, uchar* b, int m){+    return fl_color_chooser(name,*r,*g,*b,m);   } #ifdef __cplusplus }

@@ -124,7 +124,7 @@   FL_EXPORT_C(fl_Widget*,   Fl_Color_Chooser_array)(fl_Color_Chooser color_chooser);   FL_EXPORT_C(fl_Widget,    Fl_Color_Chooser_child)(fl_Color_Chooser color_chooser, int n); -  FL_EXPORT_C(int,Fl_Color_Chooser_mode)(fl_Color_Chooser color_chooser); +  FL_EXPORT_C(int,Fl_Color_Chooser_mode)(fl_Color_Chooser color_chooser);   FL_EXPORT_C(void,Fl_Color_Chooser_set_mode)(fl_Color_Chooser color_chooser,int newMode);   FL_EXPORT_C(double,Fl_Color_Chooser_hue)(fl_Color_Chooser color_chooser);   FL_EXPORT_C(double,Fl_Color_Chooser_saturation)(fl_Color_Chooser color_chooser);@@ -138,8 +138,10 @@   FL_EXPORT_C(void,Fl_Color_Chooser_rgb2hsv)(double R, double G, double B, double* H, double* S, double* V);   FL_EXPORT_C(fl_Color_Chooser,Fl_Color_Chooser_New)(int x, int y, int w, int h);   FL_EXPORT_C(fl_Color_Chooser,Fl_Color_Chooser_New_WithLabel)(int x, int y, int w, int h, const char* t);-  FL_EXPORT_C(int, flc_color_chooser)(const char* name, double r, double g, double b);-  FL_EXPORT_C(int, flc_color_chooser_with_m)(const char* name, double r, double g, double b, int m);+  FL_EXPORT_C(int, flc_color_chooser)(const char* name, double* r, double* g, double* b);+  FL_EXPORT_C(int, flc_color_chooser_with_m)(const char* name, double* r, double* g, double* b, int m);+  FL_EXPORT_C(int, flc_color_chooser_with_uchar)(const char* name, uchar* r, uchar* g, uchar* b);+  FL_EXPORT_C(int, flc_color_chooser_with_uchar_m)(const char* name, uchar* r, uchar* g, uchar* b, int m); #ifdef __cplusplus } #endif

@@ -10,6 +10,12 @@ #include "Fl_CallbackC.h" EXPORT { #endif+#ifndef INTERNAL_LINKAGE+  typedef enum Counter_Type {+    FL_NORMAL_COUNTERC = 0,+    FL_SIMPLE_COUNTERC = 1+  } Counter_Type;+#endif   FL_EXPORT_C(fl_Group,     Fl_Counter_parent)(fl_Counter counter);   FL_EXPORT_C(void,         Fl_Counter_set_parent)(fl_Counter counter, fl_Group grp);   FL_EXPORT_C(uchar,        Fl_Counter_type)(fl_Counter counter);@@ -92,7 +98,7 @@   FL_EXPORT_C(fl_Window,    Fl_Counter_top_window)(fl_Counter counter);   FL_EXPORT_C(fl_Window ,   Fl_Counter_top_window_offset)(fl_Counter counter, int* xoff, int* yoff);   FL_EXPORT_C(fl_Gl_Window, Fl_Counter_as_gl_window)(fl_Counter counter);-  FL_EXPORT_C(void,         Fl_Counter_resize)(fl_Table table,int X, int Y, int W, int H);+  FL_EXPORT_C(void,         Fl_Counter_resize)(fl_Counter counter ,int X, int Y, int W, int H);    /* Inherited from Fl_Valuator */   FL_EXPORT_C(void, Fl_Counter_bounds)(fl_Counter counter, double a, double b);

@@ -11,6 +11,14 @@ #include "Fl_CallbackC.h" EXPORT { #endif+#ifndef INTERNAL_LINKAGE+  typedef enum Dial_Type {+    FL_NORMAL_DIALC = 0,+    FL_LINE_DIALC = 1,+    FL_FILL_DIALC = 2+  } Dial_Type;+#endif+   FL_EXPORT_C(fl_Group,     Fl_Dial_parent)(fl_Dial dial);   FL_EXPORT_C(void,         Fl_Dial_set_parent)(fl_Dial dial, fl_Group grp);   FL_EXPORT_C(uchar,        Fl_Dial_type)(fl_Dial dial);

@@ -3,7 +3,7 @@ #ifdef __cplusplus #include "Fl_EnumerationsC.h" EXPORT {-#endif  +#endif   FL_EXPORT_C(Fl_Boxtype, fl_define_FL_ROUND_UP_BOXC)(){ return fl_define_FL_ROUND_UP_BOX();}   FL_EXPORT_C(Fl_Boxtype, fl_define_FL_SHADOW_BOXC)(){ return fl_define_FL_SHADOW_BOX();}   FL_EXPORT_C(Fl_Boxtype, fl_define_FL_ROUNDED_BOXC)(){ return fl_define_FL_ROUNDED_BOX();}@@ -13,6 +13,7 @@   FL_EXPORT_C(Fl_Boxtype, fl_define_FL_OVAL_BOXC)(){ return fl_define_FL_OVAL_BOX(); }   FL_EXPORT_C(Fl_Boxtype, fl_define_FL_PLASTIC_UP_BOXC)(){ return fl_define_FL_PLASTIC_UP_BOX();}   FL_EXPORT_C(Fl_Boxtype, fl_define_FL_GTK_UP_BOXC)(){ return fl_define_FL_GTK_UP_BOX();}+  FL_EXPORT_C(Fl_Boxtype, fl_define_FL_GLEAM_UP_BOXC)(){ return fl_define_FL_GLEAM_UP_BOX();}   FL_EXPORT_C(Fl_Boxtype, fl_boxC)(Fl_Boxtype b) { return fl_box(b);}   FL_EXPORT_C(Fl_Boxtype, fl_downC)(Fl_Boxtype b) { return fl_down(b);}   FL_EXPORT_C(Fl_Boxtype, fl_frameC)(Fl_Boxtype b) { return fl_frame(b);}

@@ -67,7 +67,8 @@   typedef enum  Fl_Tree_Select{     FL_TREE_SELECT_NONE=0,     FL_TREE_SELECT_SINGLE=1,-    FL_TREE_SELECT_MULTI=2+    FL_TREE_SELECT_MULTI=2,+    FL_TREE_SELECT_SINGLE_DRAGGABLE=3   }Fl_Tree_Select; #if FLTK_ABI_VERSION >= 10302   typedef enum  Fl_Tree_Item_Reselect_Mode{@@ -81,6 +82,7 @@   }Fl_Tree_Item_Draw_Mode; #endif /*FLTK_ABI_VERSION*/ #define FL_Button         0xfee8+#define FL_Clear          0xff0b #define FL_BackSpace      0xff08 #define FL_Tab            0xff09 #define FL_Iso_Key        0xff0c@@ -88,7 +90,7 @@ #define FL_Pause          0xff13 #define FL_Scroll_Lock    0xff14 #define FL_Escape         0xff1b-#define FL_Kana           0xff2e +#define FL_Kana           0xff2e #define FL_Eisu           0xff2f #define FL_Yen            0xff30 #define FL_JIS_Underscore 0xff31@@ -253,6 +255,15 @@ #define FL_GTK_THIN_DOWN_FRAME (Fl_Boxtype)(fl_define_FL_GTK_UP_BOXC()+7) #define FL_GTK_ROUND_UP_BOX (Fl_Boxtype)(fl_define_FL_GTK_UP_BOXC()+8) #define FL_GTK_ROUND_DOWN_BOX (Fl_Boxtype)(fl_define_FL_GTK_UP_BOXC()+9)+#define FL_GLEAM_UP_BOX fl_define_FL_GLEAM_UP_BOXC()+#define FL_GLEAM_DOWN_BOX (Fl_Boxtype)(fl_define_FL_GLEAM_UP_BOXC()+1)+#define FL_GLEAM_UP_FRAME (Fl_Boxtype)(fl_define_FL_GLEAM_UP_BOXC()+2)+#define FL_GLEAM_DOWN_FRAME (Fl_Boxtype)(fl_define_FL_GLEAM_UP_BOXC()+3)+#define FL_GLEAM_THIN_UP_BOX (Fl_Boxtype)(fl_define_FL_GLEAM_UP_BOXC()+4)+#define FL_GLEAM_THIN_DOWN_BOX (Fl_Boxtype)(fl_define_FL_GLEAM_UP_BOXC()+5)+#define FL_GLEAM_ROUND_UP_BOX (Fl_Boxtype)(fl_define_FL_GLEAM_UP_BOXC()+6)+#define FL_GLEAM_ROUND_DOWN_BOX (Fl_Boxtype)(fl_define_FL_GLEAM_UP_BOXC()+7)+ #define FL_FRAME FL_ENGRAVED_FRAME #define FL_FRAME_BOX FL_ENGRAVED_BOX #define FL_CIRCLE_BOX FL_ROUND_DOWN_BOX@@ -437,6 +448,7 @@   FL_EXPORT_C(Fl_Boxtype, fl_define_FL_OVAL_BOXC)();   FL_EXPORT_C(Fl_Boxtype, fl_define_FL_PLASTIC_UP_BOXC)();   FL_EXPORT_C(Fl_Boxtype, fl_define_FL_GTK_UP_BOXC)();+  FL_EXPORT_C(Fl_Boxtype, fl_define_FL_GLEAM_UP_BOXC)();   FL_EXPORT_C(Fl_Boxtype, fl_boxC)(Fl_Boxtype b) ;   FL_EXPORT_C(Fl_Boxtype, fl_downC)(Fl_Boxtype b) ;   FL_EXPORT_C(Fl_Boxtype, fl_frameC)(Fl_Boxtype b) ;

@@ -186,6 +186,12 @@   FL_EXPORT_C(void,Fl_Group_deactivate)(fl_Group win){     (static_cast<Fl_DerivedGroup*>(win))->deactivate();   }+  FL_EXPORT_C(fl_Group,Fl_Group_current)(){+    return (fl_Group)Fl_DerivedGroup::current();+  }+  FL_EXPORT_C(void ,   Fl_Group_set_current)(fl_Group g){+    Fl_DerivedGroup::current(static_cast<Fl_DerivedGroup*>(g));+  }   FL_EXPORT_C(unsigned int,Fl_Group_output)(fl_Group win){     return (static_cast<Fl_DerivedGroup*>(win))->output();   }

@@ -111,8 +111,8 @@   FL_EXPORT_C(void,         Fl_Group_resize)(fl_Group group,int X, int Y, int W, int H);    /* Fl_Group static members */-  FL_EXPORT_C(fl_Group,Fl_Group_set_current)();-  FL_EXPORT_C(void ,   Fl_Group_current)(fl_Group g);+  FL_EXPORT_C(fl_Group,Fl_Group_current)();+  FL_EXPORT_C(void ,   Fl_Group_set_current)(fl_Group g);    /* Fl_Group specific */   FL_EXPORT_C(void,         Fl_Group_draw_child)(fl_Group group, fl_Widget widget);

@@ -1,5 +1,5 @@ #include "Fl_Menu_ButtonC.h"-#include "Utils.h"+#include "UtilsC.h" #ifdef __cplusplus EXPORT { #endif

@@ -10,6 +10,18 @@ #include "Fl_Menu_C.h" EXPORT { #endif+#ifndef INTERNAL_LINKAGE+  typedef enum Menu_Button_Type {+    NORMAL = 0,+    POPUP1 = 1, /**< pops up with the mouse 1st button. */+    POPUP2,  /**< pops up with the mouse 2nd button. */+    POPUP12, /**< pops up with the mouse 1st or 2nd buttons. */+    POPUP3,   /**< pops up with the mouse 3rd button. */+    POPUP13,  /**< pops up with the mouse 1st or 3rd buttons. */+    POPUP23,  /**< pops up with the mouse 2nd or 3rd buttons. */+    POPUP123 /**< pops up with any mouse button. */+  } Menu_Button_Type;+#endif   /* Inherited from Fl_Widget */   FL_EXPORT_C(int,          Fl_Menu_Button_handle)(fl_Group self, int event);   FL_EXPORT_C(fl_Group,     Fl_Menu_Button_parent)(fl_Menu_Button menu_button);

@@ -1,5 +1,5 @@ #include "Fl_Menu_C.h"-#include "Utils.h"+#include "UtilsC.h" #ifdef __cplusplus Fl_DerivedMenu_::Fl_DerivedMenu_(int X, int Y, int W, int H, const char *l, fl_Menu__Virtual_Funcs* funcs) : Fl_Menu_(X,Y,W,H,l){     overriddenFuncs = funcs;@@ -24,6 +24,10 @@     this->overriddenFuncs->destroy_data((fl_Menu_) this);   } }++const Fl_Menu_Item* Fl_DerivedMenu_::get_menu_item_by_index(int i) {+  return &menu()[i];+} int Fl_DerivedMenu_::handle(int event){   int i;   if (this->overriddenFuncs->handle != NULL) {@@ -568,6 +572,9 @@   }   FL_EXPORT_C(int,Fl_Menu__value_with_item)(fl_Menu_ menu_,fl_Menu_Item item){     return (static_cast<Fl_DerivedMenu_*>(menu_))->value(static_cast<Fl_Menu_Item*>(item));+  }+  FL_EXPORT_C(fl_Menu_Item, Fl_Menu__get_menu_item_by_index)(fl_Menu_ menu_,  int i) {+    return (fl_Menu_Item)(static_cast<Fl_DerivedMenu_*>(menu_)->get_menu_item_by_index(i));   }   FL_EXPORT_C(int,Fl_Menu__value_with_index)(fl_Menu_ menu_,int index){     return (static_cast<Fl_DerivedMenu_*>(menu_))->value(index);

@@ -33,6 +33,7 @@     virtual Fl_Gl_Window* as_gl_window();     virtual Fl_Group* as_group();     virtual Fl_Group* as_group_super();+    const Fl_Menu_Item* get_menu_item_by_index(int i);     Fl_DerivedMenu_(int X, int Y, int W, int H, const char *l, fl_Menu__Virtual_Funcs* funcs);     Fl_DerivedMenu_(int X, int Y, int W, int H, fl_Menu__Virtual_Funcs* funcs);     ~Fl_DerivedMenu_();@@ -161,7 +162,7 @@   //  FL_EXPORT_C(int, Fl_Menu__find_index_with_cb)(fl_Menu_ menu_, fl_Callback cb); Don't know how to do this   FL_EXPORT_C( fl_Menu_Item, Fl_Menu__test_shortcut)(fl_Menu_ menu_);   FL_EXPORT_C(void, Fl_Menu__global)(fl_Menu_ menu_);-  FL_EXPORT_C( fl_Menu_Item, Fl_Menu__menu)(fl_Menu_ menu_);+  FL_EXPORT_C(fl_Menu_Item, Fl_Menu__menu)(fl_Menu_ menu_);   FL_EXPORT_C(void, Fl_Menu__menu_with_m)(fl_Menu_ menu_,  fl_Menu_Item* item, int size);   FL_EXPORT_C(void, Fl_Menu__copy)(fl_Menu_ menu_,  fl_Menu_Item m);   FL_EXPORT_C(void, Fl_Menu__copy_with_user_data)(fl_Menu_ menu_,  fl_Menu_Item m, void* user_data);@@ -192,6 +193,7 @@   FL_EXPORT_C(fl_Menu_Item, Fl_Menu__mvalue)(fl_Menu_ menu_);   FL_EXPORT_C(int, Fl_Menu__value)(fl_Menu_ menu_);   FL_EXPORT_C(int, Fl_Menu__value_with_item)(fl_Menu_ menu_,  fl_Menu_Item item);+  FL_EXPORT_C(fl_Menu_Item, Fl_Menu__get_menu_item_by_index)(fl_Menu_ menu_,  int i);   FL_EXPORT_C(int, Fl_Menu__value_with_index)(fl_Menu_ menu_, int index);   FL_EXPORT_C(char*, Fl_Menu__text)(fl_Menu_ menu_);   FL_EXPORT_C(char*, Fl_Menu__text_with_index)(fl_Menu_ menu_, int i);

@@ -53,6 +53,16 @@     C_to_Fl_Callback* callback = new C_to_Fl_Callback(c);     callback->set_callback(static_cast<Fl_Menu_Item*>(menu_item));   }+  FL_EXPORT_C(int, Fl_Menu_Item_has_callback)(fl_Menu_Item menu_item){+    void* p = 0;+    p = (void*)(static_cast<Fl_Menu_Item*>(menu_item)->callback());+    if (p == NULL) {+      return 0;+    }+    else {+      return 1;+    }+  }   FL_EXPORT_C(void*,Fl_Menu_Item_user_data)(fl_Menu_Item menu_item){     return (static_cast<Fl_Menu_Item*>(menu_item))->user_data();   }

@@ -26,6 +26,7 @@   //  fl_Callback* callback(); commented until I figure out how to do this   FL_EXPORT_C(void, Fl_Menu_Item_set_callback_with_user_data)(fl_Menu_Item menu_item, fl_Callback* c, void* user_data);   FL_EXPORT_C(void, Fl_Menu_Item_set_callback)(fl_Menu_Item menu_item, fl_Callback* c);+  FL_EXPORT_C(int,  Fl_Menu_Item_has_callback)(fl_Menu_Item menu_item);   FL_EXPORT_C(void*, Fl_Menu_Item_user_data)(fl_Menu_Item menu_item);   FL_EXPORT_C(void, Fl_Menu_Item_set_user_data)(fl_Menu_Item menu_item, void* v);   FL_EXPORT_C(long, Fl_Menu_Item_argument)(fl_Menu_Item menu_item);

@@ -0,0 +1,31 @@+#include "Fl_PackC.h"+#ifdef __cplusplus+EXPORT {+#endif+  FL_EXPORT_C(void ,Fl_Pack_set_spacing)(fl_Pack self, int pixels){+    (static_cast<Fl_Pack*>(self))->spacing(pixels);+  }+  FL_EXPORT_C(int,Fl_Pack_get_spacing)(fl_Pack self){+    return (static_cast<Fl_Pack*>(self))->spacing();+  }+  FL_EXPORT_C(uchar, Fl_Pack_horizontal)(fl_Pack self){+    return (static_cast<Fl_Pack*>(self))->horizontal();+  }+  FL_EXPORT_C(fl_Pack, Fl_Pack_New)(int x, int y, int w, int h){+    Fl_Pack* g = new Fl_Pack(x,y,w,h);+    return (fl_Pack)g;+  }+  FL_EXPORT_C(fl_Pack, Fl_Pack_New_WithLabel)(int x, int y, int w, int h, const char* t){+    Fl_Pack* g = new Fl_Pack(x,y,w,h,t);+    return (fl_Pack)g;+  }+  FL_EXPORT_C(uchar,Fl_Pack_type)(fl_Pack win){+    return (static_cast<Fl_Pack*>(win))->type();+  }+  FL_EXPORT_C(void,Fl_Pack_set_type)(fl_Pack win,uchar t){+    (static_cast<Fl_Pack*>(win))->type(t);+  }++#ifdef __cplusplus+}+#endif

@@ -0,0 +1,22 @@+#ifndef __FL_PACK_C__+#define __FL_PACK_C__+// always include the FL/*.H headers before local headers+// Fl_Widget is included transitively and needed for+// the callback mechanism included below to work.+#ifdef __cplusplus+#include "FL/Fl.H"+#include "FL/Fl_Pack.H"+#include "Fl_CallbackC.h"+EXPORT {+#endif+  FL_EXPORT_C(uchar,   Fl_Pack_type)(fl_Pack pack);+  FL_EXPORT_C(void,    Fl_Pack_set_type)(fl_Pack pack, uchar);+  FL_EXPORT_C(int,     Fl_Pack_get_spacing)(fl_Pack p);+  FL_EXPORT_C(void,    Fl_Pack_set_spacing)(fl_Pack p, int pixels);+  FL_EXPORT_C(uchar,   Fl_Pack_horizontal)(fl_Pack p);+  FL_EXPORT_C(fl_Pack, Fl_Pack_New)(int x, int y, int w, int h);+  FL_EXPORT_C(fl_Pack, Fl_Pack_New_WithLabel)(int x, int y, int w, int h, const char* t);+#ifdef __cplusplus+}+#endif+#endif /* __FL_PACK_C__ */

@@ -0,0 +1,45 @@+#include "Fl_ScrollC.h"+#ifdef __cplusplus+EXPORT {+#endif+  FL_EXPORT_C(void,Fl_Scroll_set_scrollbar_size)(fl_Scroll widget,int size){+    (static_cast<Fl_Scroll*>(widget))->scrollbar_size(size);+  }+  FL_EXPORT_C(int,Fl_Scroll_get_scrollbar_size)(fl_Scroll widget){+    return (static_cast<Fl_Scroll*>(widget))->scrollbar_size();+  }+  FL_EXPORT_C(void,Fl_Scroll_clear)(fl_Scroll widget){+    (static_cast<Fl_Scroll*>(widget))->clear();+  }+  FL_EXPORT_C(void,Fl_Scroll_scroll_to)(fl_Scroll widget,int x,int y){+    (static_cast<Fl_Scroll*>(widget))->scroll_to(x,y);+  }+  FL_EXPORT_C(int,Fl_Scroll_yposition)(fl_Scroll widget){+    return (static_cast<Fl_Scroll*>(widget))->yposition();+  }+  FL_EXPORT_C(int,Fl_Scroll_xposition)(fl_Scroll widget){+    return (static_cast<Fl_Scroll*>(widget))->xposition();+  }+  FL_EXPORT_C(uchar,Fl_Scroll_type)(fl_Scroll widget){+    return (static_cast<Fl_Scroll*>(widget))->type();+  }+  FL_EXPORT_C(void,Fl_Scroll_set_type)(fl_Scroll widget,uchar t){+    (static_cast<Fl_Scroll*>(widget))->type(t);+  }+  FL_EXPORT_C(void,Fl_Scroll_resize)(fl_Scroll scroll,int X,int Y,int W,int H){+    (static_cast<Fl_Scroll*>(scroll))->resize(X,Y,W,H);+  }+  FL_EXPORT_C(int,Fl_Scroll_handle)(fl_Scroll self,int event){+    return (static_cast<Fl_Scroll*>(self))->handle(event);+  }+  FL_EXPORT_C(fl_Scroll,Fl_Scroll_New_WithLabel)(int x,int y,int w,int h,const char* label){+    Fl_Scroll* scroll = new Fl_Scroll(x,y,w,h,label);+    return (static_cast<fl_Scroll>(scroll));+  }+  FL_EXPORT_C(fl_Scroll,Fl_Scroll_New)(int x,int y,int w,int h){+    Fl_Scroll* scroll = new Fl_Scroll(x,y,w,h);+    return (static_cast<fl_Scroll>(scroll));+  }+#ifdef __cplusplus+}+#endif

@@ -0,0 +1,27 @@+#ifndef __FL_SCROLL_C__+#define __FL_SCROLL_C__+#ifdef __cplusplus+// always include the FL/*.H headers before local headers+// Fl_Scrollbar is included transitively and needed for+// the callback mechanism included below to work.+#include "FL/Fl.H"+#include "FL/Fl_Scroll.H"+#include "Fl_CallbackC.h"+EXPORT {+#endif+  FL_EXPORT_C(void,        Fl_Scroll_set_scrollbar_size)(fl_Scroll widget, int size);+  FL_EXPORT_C(int,         Fl_Scroll_get_scrollbar_size)(fl_Scroll widget);+  FL_EXPORT_C(void,        Fl_Scroll_clear)(fl_Scroll widget);+  FL_EXPORT_C(void,        Fl_Scroll_scroll_to)(fl_Scroll widget, int x, int y);+  FL_EXPORT_C(int,         Fl_Scroll_yposition)(fl_Scroll widget);+  FL_EXPORT_C(int,         Fl_Scroll_xposition)(fl_Scroll widget);+  FL_EXPORT_C(uchar,        Fl_Scroll_type)(fl_Scroll widget);+  FL_EXPORT_C(void,         Fl_Scroll_set_type)(fl_Scroll widget, uchar t);+  FL_EXPORT_C(void,         Fl_Scroll_resize)(fl_Scroll scroll,int X, int Y, int W, int H);+  FL_EXPORT_C(int,Fl_Scroll_handle)(fl_Scroll scroll, int event);+  FL_EXPORT_C(fl_Scroll,    Fl_Scroll_New_WithLabel)(int x, int y, int w, int h, const char* label);+  FL_EXPORT_C(fl_Scroll,    Fl_Scroll_New)(int x, int y, int w, int h);+#ifdef __cplusplus+}+#endif+#endif /* __FL_SCROLL_C__ */

@@ -1,5 +1,5 @@-#ifndef __FL_SLIDER_C__-#define __FL_SLIDER_C__+#ifndef __FL_SCROLLBAR_C__+#define __FL_SCROLLBAR_C__ #ifdef __cplusplus // always include the FL/*.H headers before local headers // Fl_Scrollbar is included transitively and needed for@@ -127,4 +127,4 @@ #ifdef __cplusplus } #endif-#endif /* __FL_SLIDER_C__ */+#endif /* __FL_SCROLLBAR_C__ */

@@ -0,0 +1,90 @@+#include "Fl_SpinnerC.h"+#ifdef __cplusplus+EXPORT {+#endif+  FL_EXPORT_C(Fl_Color,Fl_Spinner_color)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->color();+  }+  FL_EXPORT_C(void,Fl_Spinner_set_color)(fl_Spinner spinner,Fl_Color bg){+    (static_cast<Fl_Spinner*>(spinner))->color(bg);+  }+  FL_EXPORT_C(Fl_Color,Fl_Spinner_selection_color)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->selection_color();+  }+  FL_EXPORT_C(void,Fl_Spinner_set_selection_color)(fl_Spinner spinner,Fl_Color a){+    (static_cast<Fl_Spinner*>(spinner))->selection_color(a);+  }+  FL_EXPORT_C(uchar,Fl_Spinner_type)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->type();+  }+  FL_EXPORT_C(void,Fl_Spinner_set_type)(fl_Spinner spinner,uchar t){+    (static_cast<Fl_Spinner*>(spinner))->type(t);+  }+  FL_EXPORT_C(void,Fl_Spinner_resize)(fl_Spinner spinner,int X,int Y,int W,int H){+    (static_cast<Fl_Spinner*>(spinner))->resize(X,Y,W,H);+  }+  FL_EXPORT_C(double,Fl_Spinner_minimum)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->minimum();+  }+  FL_EXPORT_C(void,Fl_Spinner_set_minimum)(fl_Spinner spinner,double a){+    (static_cast<Fl_Spinner*>(spinner))->minimum(a);+  }+  FL_EXPORT_C(double,Fl_Spinner_maximum)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->maximum();+  }+  FL_EXPORT_C(void,Fl_Spinner_set_maximum)(fl_Spinner spinner,double a){+    (static_cast<Fl_Spinner*>(spinner))->maximum(a);+  }+  FL_EXPORT_C(void,Fl_Spinner_range)(fl_Spinner spinner,double a,double b){+    (static_cast<Fl_Spinner*>(spinner))->range(a,b);+  }+  FL_EXPORT_C(void,Fl_Spinner_set_step)(fl_Spinner spinner,double s){+    (static_cast<Fl_Spinner*>(spinner))->step(s);+  }+  FL_EXPORT_C(double,Fl_Spinner_step)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->step();+  }+  FL_EXPORT_C(double,Fl_Spinner_value)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->value();+  }+  FL_EXPORT_C(void ,Fl_Spinner_set_value)(fl_Spinner spinner,double v){+    return (static_cast<Fl_Spinner*>(spinner))->value(v);+  }+  FL_EXPORT_C(const char*,Fl_Spinner_format)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->format();+  }+  FL_EXPORT_C(void,Fl_Spinner_set_format)(fl_Spinner spinner,const char* format){+    (static_cast<Fl_Spinner*>(spinner))->format(format);+  }+  FL_EXPORT_C(void,Fl_Spinner_set_textfont)(fl_Spinner spinner,Fl_Font text){+    (static_cast<Fl_Spinner*>(spinner))->textfont(text);+  }+  FL_EXPORT_C(Fl_Font,Fl_Spinner_textfont)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->textfont();+  }+  FL_EXPORT_C(void,Fl_Spinner_set_textsize)(fl_Spinner spinner,Fl_Fontsize text){+    (static_cast<Fl_Spinner*>(spinner))->textsize(text);+  }+  FL_EXPORT_C(Fl_Fontsize,Fl_Spinner_textsize)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->textsize();+  }+  FL_EXPORT_C(void,Fl_Spinner_set_textcolor)(fl_Spinner spinner,Fl_Color text){+    (static_cast<Fl_Spinner*>(spinner))->textcolor(text);+  }+  FL_EXPORT_C(Fl_Color,Fl_Spinner_textcolor)(fl_Spinner spinner){+    return (static_cast<Fl_Spinner*>(spinner))->textcolor();+  }+  FL_EXPORT_C(int,Fl_Spinner_handle)(fl_Spinner spinner,int event){+    return (static_cast<Fl_Spinner*>(spinner))->handle(event);+  }+  FL_EXPORT_C(fl_Spinner,Fl_Spinner_New_WithLabel)(int x,int y,int w,int h,const char* label){+    Fl_Spinner* counter = new Fl_Spinner(x,y,w,h,label);+    return (fl_Spinner) counter;+  }+  FL_EXPORT_C(fl_Spinner,Fl_Spinner_New)(int x,int y,int w,int h){+    Fl_Spinner* counter = new Fl_Spinner(x,y,w,h);+    return (fl_Spinner) counter;+  }+#ifdef __cplusplus+}+#endif

@@ -0,0 +1,48 @@+#ifndef __FL_SPINNER_C__+#define __FL_SPINNER_C__+#ifdef __cplusplus+// always include the FL/*.H headers before local headers+// Fl_Spinner is included transitively and needed for+// the callback mechanism included below to work.+#include "FL/Fl.H"+#include "FL/Fl_Spinner.H"+#include "Fl_CallbackC.h"+EXPORT {+#endif+#ifndef INTERNAL_LINKAGE+  typedef enum Spinner_Type {+    FL_FLOAT_INPUTC = 1,+    FL_INT_INPUTC = 2+  } Spinner_Type;+#endif+  FL_EXPORT_C(int,       Fl_Spinner_handle)(fl_Spinner counter, int event);+  FL_EXPORT_C(Fl_Color,     Fl_Spinner_color)(fl_Spinner counter);+  FL_EXPORT_C(void,         Fl_Spinner_set_color)(fl_Spinner counter, Fl_Color bg);+  FL_EXPORT_C(Fl_Color,     Fl_Spinner_selection_color)(fl_Spinner counter);+  FL_EXPORT_C(void,         Fl_Spinner_set_selection_color)(fl_Spinner counter, Fl_Color a);+  FL_EXPORT_C(uchar,        Fl_Spinner_type)(fl_Spinner counter);+  FL_EXPORT_C(void,         Fl_Spinner_set_type)(fl_Spinner counter, uchar t);+  FL_EXPORT_C(void,         Fl_Spinner_resize)(fl_Spinner spinner,int X, int Y, int W, int H);+  FL_EXPORT_C(double, Fl_Spinner_minimum)(fl_Spinner spinner);+  FL_EXPORT_C(void, Fl_Spinner_set_minimum)(fl_Spinner spinner, double a);+  FL_EXPORT_C(double, Fl_Spinner_maximum)(fl_Spinner spinner);+  FL_EXPORT_C(void, Fl_Spinner_set_maximum)(fl_Spinner spinner, double a);+  FL_EXPORT_C(void, Fl_Spinner_range)(fl_Spinner spinner, double a, double b);+  FL_EXPORT_C(void, Fl_Spinner_set_step)(fl_Spinner spinner, double a);+  FL_EXPORT_C(double, Fl_Spinner_step)(fl_Spinner spinner);+  FL_EXPORT_C(double, Fl_Spinner_value)(fl_Spinner spinner);+  FL_EXPORT_C(void, Fl_Spinner_set_value)(fl_Spinner spinner, double v);+  FL_EXPORT_C(void, Fl_Spinner_set_format)(fl_Spinner spinner, const char* format);+  FL_EXPORT_C(const char*, Fl_Spinner_format)(fl_Spinner spinner);+  FL_EXPORT_C(void,         Fl_Spinner_set_textfont)(fl_Spinner spinner, Fl_Font text);+  FL_EXPORT_C(Fl_Font,     Fl_Spinner_textfont)(fl_Spinner spinner);+  FL_EXPORT_C(void,         Fl_Spinner_set_textsize)(fl_Spinner spinner, Fl_Fontsize text);+  FL_EXPORT_C(Fl_Fontsize,     Fl_Spinner_textsize)(fl_Spinner spinner);+  FL_EXPORT_C(void,         Fl_Spinner_set_textcolor)(fl_Spinner spinner, Fl_Color text);+  FL_EXPORT_C(Fl_Color,     Fl_Spinner_textcolor)(fl_Spinner spinner);+  FL_EXPORT_C(fl_Spinner,    Fl_Spinner_New_WithLabel)(int x, int y, int w, int h, const char* label);+  FL_EXPORT_C(fl_Spinner   , Fl_Spinner_New)(int x, int y, int w, int h);+#ifdef __cplusplus+}+#endif+#endif /* __FL_SPINNER_C__ */

@@ -1,5 +1,5 @@ #include "Fl_Sys_Menu_BarC.h"-#include "Utils.h"+#include "UtilsC.h" #ifdef __cplusplus EXPORT { #endif

@@ -243,6 +243,9 @@   FL_EXPORT_C(void,Fl_Tile_damage_inside_widget)(fl_Tile tile,uchar c,int x,int y,int w,int h){     (static_cast<Fl_Tile*>(tile))->damage(c,x,y,w,h);   }+  FL_EXPORT_C(void,Fl_Tile_position)(fl_Tile tile,int x,int y,int w,int h){+    (static_cast<Fl_Tile*>(tile))->position(x,y,w,h);+  }   FL_EXPORT_C(void,Fl_Tile_draw_label_with_xywh_alignment)(fl_Tile tile,int x,int y,int w,int h,Fl_Align alignment){     (static_cast<Fl_Tile*>(tile))->draw_label(x,y,w,h,alignment);   }

@@ -125,7 +125,7 @@   FL_EXPORT_C(fl_Widget,    Fl_Tile_child)(fl_Tile tile, int n);   FL_EXPORT_C(fl_Group,     Fl_Tile_New)(int x, int y, int w, int h);   FL_EXPORT_C(fl_Group,     Fl_Tile_New_WithLabel)(int x, int y, int w, int h, const char* t);-  FL_EXPORT_C(void,         Fl_Tile_position)(int x, int y, int w, int h);+  FL_EXPORT_C(void,         Fl_Tile_position)(fl_Tile tile, int x, int y, int w, int h); #ifdef __cplusplus } #endif

@@ -379,11 +379,20 @@   FL_EXPORT_C(fl_Tree_Item,Fl_Tree_first_selected_item)(fl_Tree tree){     return (static_cast<Fl_Tree*>(tree))->first_selected_item();   }+  FL_EXPORT_C(fl_Tree_Item,Fl_Tree_last_selected_item)(fl_Tree tree){+    return (static_cast<Fl_Tree*>(tree))->last_selected_item();+  }   FL_EXPORT_C(fl_Tree_Item,Fl_Tree_next_selected_item)(fl_Tree tree){     return (static_cast<Fl_Tree*>(tree))->next_selected_item();   }   FL_EXPORT_C(fl_Tree_Item,Fl_Tree_next_selected_item_with_item)(fl_Tree tree,fl_Tree_Item item){     return (static_cast<Fl_Tree*>(tree))->next_selected_item((static_cast<Fl_Tree_Item*>(item)));+  }+  FL_EXPORT_C(fl_Tree_Item,Fl_Tree_next_selected_item_with_item_direction)(fl_Tree tree,fl_Tree_Item item, int dir){+    return (static_cast<Fl_Tree*>(tree))->next_selected_item((static_cast<Fl_Tree_Item*>(item)), dir);+  }+  FL_EXPORT_C(fl_Tree_Item, Fl_Tree_next_item)(fl_Tree tree,fl_Tree_Item item, int dir, int visible) {+    return (static_cast<Fl_Tree*>(tree))->next_item((static_cast<Fl_Tree_Item*>(item)), dir, visible);   }   FL_EXPORT_C(int,Fl_Tree_open_with_item)(fl_Tree tree,fl_Tree_Item item){     return (static_cast<Fl_Tree*>(tree))->open((static_cast<Fl_Tree_Item*>(item)));

@@ -141,8 +141,11 @@   FL_EXPORT_C(fl_Tree_Item, Fl_Tree_last)(fl_Tree tree);   FL_EXPORT_C(fl_Tree_Item, Fl_Tree_last_visible)(fl_Tree tree);   FL_EXPORT_C(fl_Tree_Item, Fl_Tree_first_selected_item)(fl_Tree tree);+  FL_EXPORT_C(fl_Tree_Item, Fl_Tree_last_selected_item)(fl_Tree tree);   FL_EXPORT_C(fl_Tree_Item, Fl_Tree_next_selected_item)(fl_Tree tree);   FL_EXPORT_C(fl_Tree_Item, Fl_Tree_next_selected_item_with_item)(fl_Tree tree,fl_Tree_Item item);+  FL_EXPORT_C(fl_Tree_Item, Fl_Tree_next_selected_item_with_item_direction)(fl_Tree tree,fl_Tree_Item item, int dir);+  FL_EXPORT_C(fl_Tree_Item, Fl_Tree_next_item)(fl_Tree tree,fl_Tree_Item item, int dir, int visible);   FL_EXPORT_C(int, Fl_Tree_open_with_item)(fl_Tree tree,fl_Tree_Item item);   FL_EXPORT_C(int, Fl_Tree_open_with_item_docallback)(fl_Tree tree,fl_Tree_Item item, int docallback);   FL_EXPORT_C(int, Fl_Tree_open_with_path)(fl_Tree tree,const char *path);

@@ -88,7 +88,8 @@     FL_TREE_REASON_RESELECTED, #endif /*FLTK_ABI_VERSION*/     FL_TREE_REASON_OPENED,-    FL_TREE_REASON_CLOSED+    FL_TREE_REASON_CLOSED,+    FL_TREE_REASON_DRAGGED   } Fl_Tree_Reason;   enum {     FL_MENU_INACTIVE = 1,@@ -109,6 +110,10 @@     HORIZONTAL_ALWAYS = 5,     VERTICAL_ALWAYS = 6,     BOTH_ALWAYS = 7+  };+  enum { // values for type(int)+    PACK_VERTICAL = 0,+    PACK_HORIZONTAL = 1   };   enum {     NORMAL_CURSOR,

@@ -37,6 +37,12 @@     ~Fl_DerivedValuator();   }; #endif+#ifndef INTERNAL_LINKAGE+  typedef enum Valuator_Type {+    FL_VERTICALC = 0,+    FL_HORIZONTALC = 1+  } Valuator_Type;+#endif   FL_EXPORT_C(int,Fl_Valuator_handle)(fl_Widget self, int event);   FL_EXPORT_C(int,Fl_Valuator_handle_super)(fl_Widget self, int event);   FL_EXPORT_C(fl_Group,     Fl_Valuator_parent)(fl_Valuator valuator);

@@ -267,9 +267,22 @@     Fl_DerivedWidget* castedWindow = (static_cast<Fl_DerivedWidget*>(widget));     new C_to_Fl_Callback(castedWindow, cb, p);   }+  FL_EXPORT_C(void,Fl_Widget_do_callback)(fl_Widget widget){+    (static_cast<Fl_DerivedWidget*>(widget))->do_callback();+  }   FL_EXPORT_C(void,Fl_Widget_set_callback)(fl_Widget widget,fl_Callback* cb){     Fl_DerivedWidget* castedWindow = (static_cast<Fl_DerivedWidget*>(widget));     new C_to_Fl_Callback(castedWindow, cb);+  }+  FL_EXPORT_C(int, Fl_Widget_has_callback)(fl_Widget widget){+    void* p = 0;+    p = (void*)(static_cast<Fl_DerivedWidget*>(widget)->callback());+    if (p == NULL) {+      return 0;+    }+    else {+      return 1;+    }   }   FL_EXPORT_C(void*,Fl_Widget_other_data)(fl_Widget widget){     return (static_cast<Fl_DerivedWidget*>(widget))->get_other_data();

@@ -79,8 +79,10 @@   FL_EXPORT_C(const char*,  Fl_Widget_tooltip)(fl_Widget widget);   FL_EXPORT_C(void,         Fl_Widget_copy_tooltip)(fl_Widget widget, const char* text);   FL_EXPORT_C(void,         Fl_Widget_set_tooltip)(fl_Widget widget, const char* text);+  FL_EXPORT_C(void,         Fl_Widget_do_callback)(fl_Widget widget);   FL_EXPORT_C(void,         Fl_Widget_set_callback_with_user_data)(fl_Widget widget, fl_Callback* cb, void* p);   FL_EXPORT_C(void,         Fl_Widget_set_callback)(fl_Widget widget, fl_Callback* cb);+  FL_EXPORT_C(int,          Fl_Widget_has_callback)(fl_Widget widget);   FL_EXPORT_C(void*,        Fl_Widget_other_data)(fl_Widget widget);   FL_EXPORT_C(void,         Fl_Widget_set_other_data)(fl_Widget widget, void* v);   FL_EXPORT_C(void*,        Fl_Widget_user_data)(fl_Widget widget);

@@ -47,6 +47,10 @@ }; EXPORT { #endif+#ifndef INTERNAL_LINKAGE+#define FL_WINDOWC 0xF0+#define FL_DOUBLE_WINDOWC 0xF1+#endif   /* Inherited from Fl_Widget */   FL_EXPORT_C(int,Fl_Window_handle)(fl_Window self, int event);   FL_EXPORT_C(fl_Group,     Fl_Window_parent)(fl_Window win);

@@ -10,10 +10,12 @@ 	Fl_Value_OutputC.cpp \ 	Fl_Value_SliderC.cpp \ 	Fl_ScrollbarC.cpp \+	Fl_ScrollC.cpp \ 	Fl_RollerC.cpp \ 	Fl_DialC.cpp \ 	Fl_CounterC.cpp \-	Utils.cpp \+	Fl_SpinnerC.cpp \+	UtilsC.cpp \ 	xC.cpp \ 	fl_utf8C.cpp \ 	glC.cpp \@@ -87,6 +89,7 @@ 	Fl_Text_EditorC.cpp \ 	Fl_Text_SelectionC.cpp \ 	Fl_TileC.cpp \+	Fl_PackC.cpp \ 	Fl_Toggle_ButtonC.cpp \ 	Fl_TooltipC.cpp \ 	Fl_TreeC.cpp \

@@ -1,11 +0,0 @@-#include "Utils.h"-#ifdef __cplusplus-Fl_Menu_Item* convert(fl_Menu_Item* item, int size){-  int i = 0;-  Fl_Menu_Item* current = new Fl_Menu_Item[size];-  for (;i<size;i++){-    current[i] = *(static_cast<Fl_Menu_Item*>(*(item + i)));-  }-  return current;-}-#endif

@@ -1,9 +0,0 @@-#ifndef __UTILS__-#define __UTILS__-#ifdef __cplusplus-#include "Fl_Types.h"-#include "FL/Fl.H"-#include "FL/Fl_Menu_Item.H"-Fl_Menu_Item* convert(fl_Menu_Item* item, int size);-#endif-#endif

@@ -0,0 +1,11 @@+#include "UtilsC.h"+#ifdef __cplusplus+Fl_Menu_Item* convert(fl_Menu_Item* item, int size){+  int i = 0;+  Fl_Menu_Item* current = new Fl_Menu_Item[size];+  for (;i<size;i++){+    current[i] = *(static_cast<Fl_Menu_Item*>(*(item + i)));+  }+  return current;+}+#endif

@@ -0,0 +1,9 @@+#ifndef __UTILS__+#define __UTILS__+#ifdef __cplusplus+#include "Fl_Types.h"+#include "FL/Fl.H"+#include "FL/Fl_Menu_Item.H"+Fl_Menu_Item* convert(fl_Menu_Item* item, int size);+#endif+#endif

@@ -30,6 +30,7 @@              FormsFlag='')  AC_SUBST(FLTKCONFIGCOMMAND,`fltk-config --ldstaticflags $GlFlag $ImagesFlag $CairoFlag $FormsFlag`)+AC_SUBST(FLTK_HOME,`fltk-config --includedir`) # Checks for typedefs, structures, and compiler characteristics. AC_TYPE_SIZE_T 

@@ -1,11 +1,11 @@-name: fltkhs-version: 0.1.0.2-synopsis: FLTK bindings+name : fltkhs+version : 0.2.0.0+synopsis : FLTK bindings description:     Low level bindings for the FLTK GUI toolkit.-license: MIT-license-file: LICENSE-author: Aditya Siram+license : MIT+license-file : LICENSE+author : Aditya Siram maintainer: aditya.siram@gmail.com homepage: http://github.com/deech/fltkhs -- bug-reports:@@ -19,6 +19,7 @@ library   exposed-modules:                    Graphics.UI.FLTK.LowLevel.FLTKHS+                   Graphics.UI.FLTK.LowLevel.Ask                    Graphics.UI.FLTK.LowLevel.GlWindow                    Graphics.UI.FLTK.LowLevel.SingleWindow                    Graphics.UI.FLTK.LowLevel.Window@@ -69,6 +70,7 @@                    Graphics.UI.FLTK.LowLevel.Counter                    Graphics.UI.FLTK.LowLevel.SimpleCounter                    Graphics.UI.FLTK.LowLevel.Scrollbar+                   Graphics.UI.FLTK.LowLevel.Scrolled                    Graphics.UI.FLTK.LowLevel.ValueSlider                    Graphics.UI.FLTK.LowLevel.ValueInput                    Graphics.UI.FLTK.LowLevel.ValueOutput@@ -76,6 +78,7 @@                    Graphics.UI.FLTK.LowLevel.Progress                    Graphics.UI.FLTK.LowLevel.Positioner                    Graphics.UI.FLTK.LowLevel.Input+                   Graphics.UI.FLTK.LowLevel.Output                    Graphics.UI.FLTK.LowLevel.IntInput                    Graphics.UI.FLTK.LowLevel.Wizard                    Graphics.UI.FLTK.LowLevel.Table@@ -91,73 +94,110 @@                    Graphics.UI.FLTK.LowLevel.TextEditor                    Graphics.UI.FLTK.LowLevel.NativeFileChooser                    Graphics.UI.FLTK.LowLevel.Utils+                   Graphics.UI.FLTK.LowLevel.Tile+                   Graphics.UI.FLTK.LowLevel.Pack+                   Graphics.UI.FLTK.LowLevel.Tabs+                   Graphics.UI.FLTK.LowLevel.Spinner+                   Graphics.UI.FLTK.LowLevel.ColorChooser   build-depends:-    base == 4.*,-    bytestring+                base == 4.*,+                bytestring,+                ghc   build-tools: c2hs   hs-source-dirs: src   other-modules: C2HS   include-dirs: ./c-src, ./   default-extensions: GADTs   default-language: Haskell2010-  ghc-options: -Wall -fcontext-stack=220+  ghc-options: -Wall -fcontext-stack=300+  if impl(ghc >= 7.10.2)+     cpp-options: -DCALLSTACK_AVAILABLE+  if impl(ghc >= 7.10)+     cpp-options: -DOVERLAPPING_INSTANCES_DEPRECATED -Executable fltkhs-nativefilechooser-simple-app-  Main-Is: nativefilechooser-simple-app.hs+Executable fltkhs-fluidtohs+  Main-Is: Main.hs+  Hs-Source-Dirs: src/Fluid+  Build-Depends:+    base == 4.*,+    filepath,+    fltkhs,+    parsec,+    mtl+  default-language: Haskell2010+  ghc-Options: -Wall -threaded -fcontext-stack=300+  if !os(darwin)+    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"++Executable fltkhs-pack+  Main-Is: pack.hs   Hs-Source-Dirs: src/Examples   Build-Depends:     base == 4.*,     directory,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" -Executable fltkhs-table-as-container-  Main-Is: table-as-container.hs+Executable fltkhs-tile+  Main-Is: tile.hs   Hs-Source-Dirs: src/Examples   Build-Depends:     base == 4.*,+    directory,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" -Executable fltkhs-texteditor-simple-  Main-Is: texteditor-simple.hs+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+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" -Executable fltkhs-textdisplay-with-colors-  Main-Is: textdisplay-with-colors.hs+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+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" -Executable fltkhs-hello-world-  Main-Is: hello-world.hs+Executable fltkhs-texteditor-simple+  Main-Is: texteditor-simple.hs   Hs-Source-Dirs: src/Examples   Build-Depends:     base == 4.*,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" +Executable fltkhs-textdisplay-with-colors+  Main-Is: textdisplay-with-colors.hs+  Hs-Source-Dirs: src/Examples+  Build-Depends:+    base == 4.*,+    fltkhs+  default-language: Haskell2010+  ghc-Options: -Wall -threaded -fcontext-stack=300+  if !os(darwin)+    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"+ Executable fltkhs-doublebuffer   Main-Is: doublebuffer.hs   Hs-Source-Dirs: src/Examples@@ -165,7 +205,7 @@     base == 4.*,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -176,7 +216,7 @@     base == 4.*,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -187,7 +227,7 @@     base == 4.*,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -198,7 +238,7 @@     base == 4.*,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -209,7 +249,7 @@     base == 4.*,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -220,7 +260,7 @@     base == 4.*,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -231,7 +271,7 @@     base == 4.*,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -243,7 +283,7 @@     fltkhs,     process   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -254,7 +294,7 @@     base == 4.*,     fltkhs   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -265,7 +305,7 @@      base == 4.*,      fltkhs,bytestring   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -276,7 +316,7 @@      base == 4.*,      fltkhs,bytestring   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -288,7 +328,7 @@      fltkhs,      bytestring   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" @@ -300,6 +340,6 @@      fltkhs,      bytestring   default-language: Haskell2010-  ghc-Options: -Wall -threaded -fcontext-stack=220+  ghc-Options: -Wall -threaded -fcontext-stack=300   if !os(darwin)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"

@@ -1,4 +1,5 @@ #!/bin/runhaskell+{-# LANGUAGE FlexibleContexts #-} import Control.Monad import Text.Parsec import Text.Parsec.String@@ -12,32 +13,70 @@ import System.Process import Data.Maybe -data ConstraintsImpl = Constraints [String] String-parseConstraints = do-  spaces-  constraints <- manyTill anyChar (try (string "(~) * impl ("))-  state' <- getParserState-  impl <- manyTill anyChar (try $ string $ ") => Op ")+spacesOrNewLines =+  skipMany $ (char ' ') <|> (char '\n') <|> crlf++parseInstances = go (return [])+  where+    go accum = ((try (eof >> accum)) <|>+                (try (do+                    newline >> string "instance"+                    soFar <- accum+                    opInstance <- parseInstance+                    go (return (soFar ++ [opInstance])))) <|>+                (anyChar >> go accum))+parseInstance = do   spaces-  return (constraints,impl)-runImplParser = do-  constraints <- parseConstraints-  manyTill anyChar (try (string "("))-  methodDatatype <- manyTill anyChar (try (string " ()) "))-  widgetName <- manyTill anyChar (try (string " "))-  return (constraints, methodDatatype, widgetName)+  char '('+  spacesOrNewLines+  constraints <- manyTill anyChar (try (string "impl"))+  spacesOrNewLines+  char '~'+  spacesOrNewLines+  typeSig <- (try+                (do+                   char '('+                   sig <- go (1 :: Int) ""+                   spacesOrNewLines+                   char ')'+                   return sig) <|>+              (go (1 :: Int) ""))+  spacesOrNewLines+  string "=>"+  spacesOrNewLines+  string "Op"+  spacesOrNewLines+  char '('+  methodName <- word+  _ <- go (1 :: Int) ""+  spacesOrNewLines+  widgetType <- word+  return (constraints, typeSig, methodName, widgetType)+  where+    go nesting accum =+      (try $ char '(' >> go (nesting + 1) (accum ++ "(")) <|>+      (try $ lookAhead (char ')') >>+             if (nesting == 0)+               then parserZero+               else if (nesting == 1)+                      then char ')' >> return accum+                      else char ')' >> go (nesting - 1) (accum ++ ")")) <|>+      (do+         bare <- manyTill anyChar ((lookAhead (char ')')) <|> (lookAhead (char '(')))+         go nesting (accum ++ bare))  runHierarchyParser = do   spaces-  char '*'+  string "type"   spaces-  word-  klazz <- word-  char '='+  widgetType <- word   spaces-  word+  string "="+  spaces+  _ <- word+  spaces   parent <- many anyChar-  return (klazz,parent)+  return (widgetType, parent) className = "Op"  lowerFirst m = [(toLower $ head m)] ++ (tail m)@@ -69,7 +108,7 @@   ((c ,impl), methodDatatype, widgetName) ->     (lowerFirst methodDatatype) ++     "::" ++ " "-    ++ "(" ++ (quoteDatatypes (tail (reverse (drop 2 (reverse c))))) ++ ")" ++ " => "+    ++ "(" ++ (quoteDatatypes (reverse (drop 2 (reverse c)))) ++ ")" ++ " => "     ++ "'Ref' '" ++ widgetName     ++ "'" ++ " -> "     ++ quoteDatatypes impl@@ -86,38 +125,41 @@  main = do   args <- getArgs-  let command = case args of-        ("functions":w':[]) -> Just (Functions w')-        ("hierarchy":w':[]) -> Just (Hierarchy w')-        _ -> Nothing+  let command =+        case args of+          ("functions":w':[]) -> Just (Functions w')+          ("hierarchy":w':[]) -> Just (Hierarchy w')+          _                   -> Nothing -  ls <- readProcess "html2text" ["-width", "1000", "../dist/doc/html/fltkhs/Graphics-UI-FLTK-LowLevel-Dispatch.html" ] "" >>= return . filter (isInfixOf ("=> " ++ className)) . lines-  objs <- readProcess "html2text" ["-width", "1000", "../dist/doc/html/fltkhs/Graphics-UI-FLTK-LowLevel-Hierarchy.html"] "" >>= return . filter (isInfixOf ("    * type")) . lines-  let ppLines = map (\l -> case (parse runImplParser "" l) of-                        Left err -> Nothing-                        Right r -> Just r-                    )-                ls-  let hier' = map (\o -> case (parse runHierarchyParser "" o) of-                      Left err -> trace (show  err) $ Nothing-                      Right r -> Just r-                  )-              objs+  objs <- readFile "../src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs" >>=+          return .+          filter (not . isInfixOf "Funcs") .+          filter (isPrefixOf "type") .+          lines+  let readWidgetFile w = readFile ("../src/Graphics/UI/FLTK/LowLevel/" ++ w ++ ".chs")+  let parseWidgetFile contents =+        case (parse parseInstances "" contents) of+          Left err        -> error (show err)+          Right instances -> Just instances+  let hier' = map+                (\o -> case (parse runHierarchyParser "" o) of+                   Left err -> Nothing+                   Right r  -> Just r)+                objs   case command of     Nothing -> error ""     (Just (Hierarchy w)) -> do       let trace' = reverse $-                   map (\w -> "-- " ++ w) $-                   map (\w -> "\"" ++ w ++ "\"") $-                   map (\w -> "Graphics.UI.FLTK.LowLevel." ++ w) $-                   traceHierarchy w [] (catMaybes hier')+            map (\w -> "-- " ++ w) $+              map (\w -> "\"" ++ w ++ "\"") $+                map (\w -> "Graphics.UI.FLTK.LowLevel." ++ w) $+                  traceHierarchy w [] (catMaybes hier')       putStr $ concat $ intersperse "\n--  |\n--  v\n" trace'       putStr "\n"     (Just (Functions w)) -> do-      let filteredByWidget = map (maybe "" pprint) $-                             filter (\ppl -> case ppl of-                                        Nothing -> False-                                        Just ppl' -> isWidget w ppl'-                                    ) ppLines-      putStr $ intercalate "\n--\n" (map ((++) "-- ")  (sort  filteredByWidget))+      contents <- readWidgetFile w+      let parsed = parseWidgetFile contents+      let instances = maybe [] (sort . map (\(c, sig, mName, wType) -> pprint ((c, sig), mName, wType)))+                        parsed+      putStr $ intercalate "\n--\n" (map ((++) "-- ") instances)       putStr "\n"

@@ -1,4 +1,5 @@ #!/bin/runhaskell+{-# LANGUAGE FlexibleContexts #-} import Control.Monad import Text.Parsec import Text.Parsec.String@@ -224,7 +225,7 @@              )             )     in-    printf "{# fun unsafe %s as %s { %s } -> %s #}\ninstance (impl ~ (%s)) => Op (%s ()) xxx orig impl where\n   runOp _ _ %s"+    printf "{# fun %s as %s { %s } -> %s #}\ninstance (impl ~ (%s)) => Op (%s ()) xxx orig impl where\n   runOp _ _ %s"            oldName            (name ++ "'")            (intercalate ","@@ -409,7 +410,10 @@     ,("fl_Region", "Ptr ()")     ,("Fl_Boxtype", "Boxtype")     ,("Fl_Mode", "Mode")+    ,("fl_Scroll", "Ptr ()")     ,("fl_Widget", "Ptr ()")+    ,("fl_Spinner", "Ptr ()")+    ,("fl_Tabs", "Ptr ()")     ,("fl_Native_File_Chooser", "Ptr ()")     ,("fl_Text_Buffer", "Ptr ()")     ,("fl_Text_Selection", "Ptr ()")@@ -427,6 +431,7 @@     ,("fl_Positioner", "Ptr ()")     ,("fl_Counter", "Ptr ()")     ,("fl_Scrollbar", "Ptr ()")+    ,("fl_Pack", "Ptr ()")     ,("fl_Dial", "Ptr ()")     ,("fl_Value_Slider", "Ptr ()")     ,("fl_Value_Input", "Ptr ()")@@ -477,6 +482,8 @@     [      ("fl_Region"         , "Region"),      ("fl_Widget"         , "Widget"),+     ("fl_Spinner"         , "Spinner"),+     ("fl_Tabs"         , "Tabs"),      ("fl_Native_File_Chooser"         , "NativeFileChooser"),      ("fl_Text_Buffer"    , "TextBuffer"),      ("fl_Text_Selection" , "TextSelection"),@@ -494,6 +501,8 @@      ("fl_Positioner"     , "Positioner"),      ("fl_Counter"        , "Counter"),      ("fl_Scrollbar"      , "Scrollbar"),+     ("fl_Pack"           , "Pack"),+     ("fl_Scroll"         , "Scroll"),      ("fl_Dial"           , "Dial"),      ("fl_Value_Slider"   , "ValueSlider"),      ("fl_Value_Input"    , "ValueInput"),

@@ -126,7 +126,7 @@                (Size                  (Width sorceressWidth)                  (Height sorceressHeight)))-  setImage button bitmap+  setImage button (Just bitmap)   leftb' <- toggleButtonNew (Rectangle (Position (X 25) (Y 50)) (Size (Width 50) (Height 25))) (Just "left")   rightb' <- toggleButtonNew (Rectangle (Position (X 75) (Y 50)) (Size (Width 50) (Height 25))) (Just "right")   topb' <- toggleButtonNew (Rectangle (Position (X 125) (Y 50)) (Size (Width 50) (Height 25))) (Just "top")@@ -144,7 +144,7 @@   setCallback insideb' $ buttonCb state'   setCallback overb' $ buttonCb state'   setCallback inactb' $ buttonCb state'-  setResizable window window+  setResizable window (Just window)   end window   showWidget window   _ <- FL.run

@@ -91,7 +91,7 @@   bt n' "GtkRoundUpBox" GtkRoundUpBox False   bt n' "GtkRoundDownBox" GtkRoundDownBox False   bt n' "FreeBoxtype" FreeBoxtype False-  setResizable window window+  setResizable window (Just window)   end window   showWidget window   _ <- FL.run

@@ -77,10 +77,10 @@   _ <- select browser' 1 False -- leave focus box on first line   choice' <- getText btype'   case choice' of-   "Normal" -> setType browser' (fromIntegral $ fromEnum NormalBrowserType)-   "Select" -> setType browser' (fromIntegral $ fromEnum SelectBrowserType)-   "Hold" -> setType browser' (fromIntegral $ fromEnum HoldBrowserType)-   "Multi" -> setType browser' (fromIntegral $ fromEnum MultiBrowserType)+   "Normal" -> setType browser' NormalBrowserType+   "Select" -> setType browser' SelectBrowserType+   "Hold" -> setType browser' HoldBrowserType+   "Multi" -> setType browser' MultiBrowserType    _ -> return ()   redraw browser' @@ -92,7 +92,7 @@      let fname = head args      window <- doubleWindowNew (Size (Width 560) (Height 400)) Nothing (Just fname)      browser' <- selectBrowserNew (Rectangle (Position (X 0) (Y 0)) (Size (Width 560) (Height 350))) Nothing-     setType browser' (fromIntegral $ fromEnum MultiBrowserType)+     setType browser' MultiBrowserType      setCallback browser' bCb      loadStatus' <- load browser' fname      if (loadStatus' == 0)@@ -121,7 +121,7 @@        addName btype "Multi"        setCallback btype $ btypeCb browser'        _ <- setValue btype (MenuItemByIndex (MenuItemIndex 3))-       setResizable window browser'+       setResizable window (Just browser')        showWidget window        _ <- FL.run        return ()

@@ -7,12 +7,12 @@   w1 <- doubleWindowNew (Size (Width 220) (Height 220)) Nothing (Just "clock")   begin w1   c1 <- clockNew (toRectangle (0,0,220,220)) Nothing-  setResizable w1 c1+  setResizable w1 (Just c1)   end w1   w2 <- doubleWindowNew (Size (Width 220) (Height 220)) Nothing (Just "Rounded Clock")   begin w2   c2 <- clockNew (toRectangle (0,0,220,220)) Nothing-  setResizable w2 c2+  setResizable w2 (Just c2)   end w2   setXclass w1 "Fl_Clock"   setXclass w2 "Fl_Clock"

@@ -30,32 +30,21 @@   redraw p'  badDraw :: IORef (Double,Double) -> Int -> Int -> ((Double,Double) -> Double) -> IO ()-badDraw sides w h which = do+badDraw sides w h which' = do   flcSetColor blackColor >> flcRectf (toRectangle (0,0,w,h))-  flcSetColor whiteColor >> readIORef sides >>= star w h . which+  flcSetColor whiteColor >> readIORef sides >>= star w h . which'  -drawWindow :: forall a r1 r2 r3 r4.-              (-               FindOp a (DrawChild ())(Match r1),-               FindOp a (GetChild ()) (Match r2),-               FindOp a (GetH ())     (Match r3),-               FindOp a (GetW ())     (Match r4),-               Op (DrawChild ())  r1 a (Ref Widget -> IO ()),-               Op (GetChild ())   r2 a (Int -> IO (Ref Widget)),-               Op (GetH ())       r3 a (IO Int),-               Op (GetW ())       r4 a (IO Int)-              ) =>-              IORef (Double, Double) ->+drawWindow :: IORef (Double, Double) ->               ((Double, Double) -> Double) ->-              Ref a ->+              Ref Window ->               IO () drawWindow sides' whichf' w' = do   ww' <- getW w'   wh' <- getH w'   badDraw sides' ww' wh' whichf'   c' <- getChild w' (0 :: Int)-  drawChild w' (c' :: Ref Widget)+  maybe (return ()) (drawChild w') (c' :: Maybe (Ref Widget))  main :: IO () main = do@@ -70,12 +59,12 @@           (Just (Position (X 10) (Y 10)))           (Just "Single Window")           defaultCustomWidgetFuncs {-            drawCustom = (Just $ drawWindow sides' fst)+            drawCustom = (Just $ (\w -> drawWindow sides' fst (safeCast w)))           }           defaultCustomWindowFuncs   setBox w1 FlatBox   setColor w1 blackColor-  setResizable w1 w1+  setResizable w1 (Just w1)   begin w1   slider0 <- horSliderNew (toRectangle (20,370,360,25)) Nothing   range slider0 2 30@@ -92,12 +81,12 @@           (Just $ Position (X 10) (Y 10))           (Just "Fl_Double_Window")           defaultCustomWidgetFuncs {-                drawCustom = Just (drawWindow sides' snd)+                drawCustom = Just (\w -> drawWindow sides' snd (safeCast w))               }           defaultCustomWindowFuncs   setBox w2 FlatBox   setColor w2 blackColor-  setResizable w2 w2+  setResizable w2 (Just w2)   begin w2   slider1 <- horSliderNew (toRectangle $ (20,370,360,25)) Nothing   range slider1 2 30

@@ -1,29 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.FLTKHS---buttonCb :: Ref Button -> IO ()-buttonCb b' = do-  l' <- getLabel b'-  if (l' == "Hello world")-    then setLabel b' "Goodbye world"-    else setLabel b' "Hello world"--main :: IO ()-main = do- window <- windowNew-           (Size (Width 100) (Height 75))-           Nothing-           Nothing- begin window- b' <- buttonNew-        (Rectangle (Position (X 10) (Y 30)) (Size (Width 95) (Height 30)))-        (Just "Hello world")- setLabelsize b' (FontSize 10)- setCallback b' buttonCb- end window- showWidget window- _ <- FL.run- return ()

@@ -17,7 +17,7 @@     then writeFile fp "Hello world.\n"     else return () -openCb :: Ref NativeFileChooser -> Ref SysMenuBar ->  IO ()+openCb :: Ref NativeFileChooser -> Ref MenuItem ->  IO () openCb fc _ = do   setTitle fc "Open"   res' <- showWidget fc@@ -31,7 +31,7 @@       _ -> return ()    _ -> return () -saveAsCb :: Ref NativeFileChooser -> Ref SysMenuBar ->  IO ()+saveAsCb :: Ref NativeFileChooser -> Ref MenuItem ->  IO () saveAsCb fc _ = do   setTitle fc "Open"   res' <- showWidget fc@@ -45,14 +45,14 @@       _ -> return ()    _ -> return () -saveCb :: Ref NativeFileChooser -> Ref SysMenuBar ->  IO ()+saveCb :: Ref NativeFileChooser -> Ref MenuItem ->  IO () saveCb fc w' = do   f' <- getFilename fc   case f' of    Nothing -> saveAsCb fc w'    (Just f'') -> saveFile f'' -quitCb :: Ref SysMenuBar -> IO ()+quitCb :: Ref MenuItem -> IO () quitCb _ = exitSuccess  initializeWindow :: Ref Window -> IO ()@@ -62,10 +62,10 @@   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 [])+  _ <- add menu "&File/&Open" (Just (KeySequence (ShortcutKeySequence [kb_CommandState] (NormalKeyType 'o')))) (Just (openCb chooser)) (MenuItemFlags [])+  _ <- add menu "&File/&Save" (Just (KeySequence (ShortcutKeySequence [kb_CommandState] (NormalKeyType 's')))) (Just (saveCb chooser)) (MenuItemFlags [])+  _ <- add menu "&File/&Save As" Nothing (Just (saveAsCb chooser)) (MenuItemFlags [])+  _ <- add menu "&File/&Quit" (Just (KeySequence (ShortcutKeySequence [kb_CommandState] (NormalKeyType 'q')))) (Just quitCb) (MenuItemFlags [])   w_w' <- getW w'   w_h' <- getH w'   box' <- boxNew (toRectangle (20,25+20,w_w'-40,w_h'-40-25)) Nothing Nothing@@ -73,12 +73,12 @@   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.";+                  "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' 

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

@@ -25,7 +25,7 @@            if (odd _c)            then do             let s = (show _r) ++ "." ++ (show _c)-            input_ <- inputNew Nothing cellRectangle' Nothing+            input_ <- inputNew cellRectangle' Nothing Nothing             _ <- setValue input_ s Nothing             return ()            else@@ -59,7 +59,7 @@                 case cellRectangle of                   Just cellRectangle' -> do                    child' <- getChild t' i-                   resize child' cellRectangle'+                   maybe (return ()) (\c -> resize c cellRectangle') child'                   Nothing -> return ()         )         (zip [0..] rowCols)@@ -107,7 +107,7 @@   initializeTable table   setTableSize table 50 50   end win-  setResizable win table+  setResizable win (Just table)   showWidget win   _ <- FL.run   return ()

@@ -71,7 +71,7 @@                drawCellCustom = (Just drawCell)              }   initializeTable table-  setResizable window table+  setResizable window (Just table)   end window   showWidget window   _ <- FL.run

@@ -11,7 +11,7 @@ import System.Process dirCommand :: ([Char], [[Char]]) dirHeaders :: [[Char]]-#ifdef ming32_HOST_OS+#ifdef mingw32_HOST_OS dirCommand = ("dir", []) dirHeaders = ["Perms", "#L", "Own", "Group", "Size", "Date", "", "", "Filename"] #else@@ -160,7 +160,7 @@   flcSetFont headerFontFace headerFontSize   mapM_     (\(colNum, colName) -> do-        (Size (Width w') _) <- flcMeasure colName Nothing+        (Size (Width w') _) <- flcMeasure colName True True         setColWidth table (Column colNum) (w' + pad)     )     (zip [0 ..] dirHeaders)@@ -169,7 +169,7 @@     (\row' -> do       mapM_         (\(colIdx,col) -> do-            (Size (Width wc') _) <- flcMeasure col Nothing+            (Size (Width wc') _) <- flcMeasure col True True             colWidth' <- getColWidth table (Column colIdx)             if (wc' + pad > colWidth')               then setColWidth table (Column colIdx) (wc' + pad)@@ -234,7 +234,7 @@   setColor table whiteColor   setCallback table (eventCallback tableState)   end window-  setResizable window table+  setResizable window (Just table)   resize_window window table   _ <- showWidget window   _ <- FL.run

@@ -46,7 +46,7 @@   writeIORef sp' updatedProperties'   hide intInput'   window' <- getWindow table'-  setCursor window' CursorDefault+  maybe (return ()) (\w' -> setCursor w' CursorDefault ) window'  startEditing :: IORef SpreadsheetProperties -> Ref IntInput -> Ref Table -> Int -> Int -> IO () startEditing props' intInput' table' row' col' = do@@ -267,7 +267,7 @@   begin win'   -- Rows slider   setRows' <- valueSliderNew (toRectangle (winWidth'-40,20,20,winHeight'-80)) Nothing-  setType setRows' (fromIntegral $ fromEnum VertNiceSliderType)+  setType setRows' VertNiceSliderType   bounds setRows' 2 (fromIntegral maxRows)   setStep setRows' 1   numRows' <- getRows spreadsheet'@@ -277,7 +277,7 @@   clearVisibleFocus setRows'    -- Cols slider   setCols' <- valueSliderNew (toRectangle (20,winHeight'-40,winWidth'-80,20)) Nothing-  setType setCols' (fromIntegral $ fromEnum HorNiceSliderType)+  setType setCols' HorNiceSliderType   bounds setCols' 2 (fromIntegral maxCols)   setStep setCols' 1   numCols' <- getCols spreadsheet'@@ -286,7 +286,7 @@   setWhen setCols' [WhenChanged]   clearVisibleFocus setCols'   end win'-  setResizable win' spreadsheet'+  setResizable win' (Just spreadsheet')   showWidget win'   _ <- FL.run   return ()

@@ -13,11 +13,11 @@   disp <- textDisplayNew (toRectangle (20,20,640-40,480-40)) Nothing   tbuff <- textBufferNew Nothing Nothing   sbuff <- textBufferNew Nothing Nothing-  setBuffer disp tbuff+  setBuffer disp (Just tbuff)   highlightData disp sbuff (indexStyleTableEntries stes) Nothing   setText tbuff "Red Line 1\nYel Line 2\nGrn Line 3\nBlu Line 4\nRed Line 5\nYel Line 6\nGrn Line 7\nBlu Line 8\n"   setText sbuff "AAAAAAAAAA\nBBBBBBBBBB\nCCCCCCCCCC\nDDDDDDDDDD\nAAAAAAAAAA\nBBBBBBBBBB\nCCCCCCCCCC\nDDDDDDDDDD\n"-  setResizable win disp+  setResizable win (Just disp)   showWidget win   _ <- FL.run   return ()

@@ -8,7 +8,7 @@   win <- doubleWindowNew (toSize (640,480)) Nothing (Just "Simple Fl_Text_Editor")   buff <- textBufferNew Nothing Nothing   edit <- textEditorNew (toRectangle (20,20,(640-40),(480-40))) Nothing-  setBuffer edit buff+  setBuffer edit (Just buff)   showWidget win   setText buff "line 0\nline 1\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8\nline 9\nline 10\nline 11\nline 12\nline 13\nline 14\nline 15\nline 16\nline 17\nline 18\nline 19\nline 20\nline 21\nline 22\nline 23\n"   _ <- FL.run

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

@@ -0,0 +1,462 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Generate+       (collapseString,+        typeToHs,+        typicalConstructorG,+        constructorG,+        attributeG,+        toHs+       )+       where++import           Control.Monad.State+import           Control.Monad.Writer+import           Control.Monad.Identity+import           Data.Char+import           Data.List+import           Foreign.C.Types+import           Graphics.UI.FLTK.LowLevel.Utils+import           Lookup+import           Numeric+import           Types+import           Parser+apply+  :: [Char] -> [Char] -> Maybe [Char] -> [Char]+apply f n args =+  f ++ " " ++ n ++ (maybe "" (\args' -> " " ++ args') args)+++collapseParts :: [BracedStringParts] -> String+collapseParts parts = go parts []+  where go ((BareString s):_parts) accum =+          go _parts (accum ++ s)+        go ((QuotedCharCode c):_parts) accum =+          go _parts (accum ++ "\\" ++ [c])+        go ((QuotedHex h):_parts) accum =+          go _parts (accum ++ "0x" ++ (showHex h ""))+        go ((QuotedOctal o):_parts) accum =+          go _parts (accum ++ "0o" ++ (showOct o ""))+        go ((QuotedChar c):_parts) accum =+          go _parts (accum ++ c)+        go ((NestedBrace ps):_parts) accum =+          go _parts ("{" ++ (go ps accum) ++ "}")+        go [] accum = accum++collapseString :: UnbrokenOrBraced -> String+collapseString (UnbrokenString s) = s+collapseString (BracedString []) = ""+collapseString (BracedString parts) = collapseParts parts++typeToHs :: String -> String -> Maybe String+typeToHs flClassName flWidgetType+  | flClassName == "Fl_Box" =+    lookup flWidgetType boxType+  | flClassName == "Fl_Slider" || flClassName == "Fl_Value_Slider" =+    lookup flWidgetType sliderType+  | flClassName == "Fl_Roller" =+    lookup flWidgetType valuatorType+  | flClassName == "Fl_Input" =+    lookup flWidgetType inputType+  | flClassName == "Fl_Output" =+    lookup flWidgetType outputType+  | flClassName == "Fl_Pack" =+    lookup flWidgetType packType+  | flClassName == "Fl_Button" =+    lookup flWidgetType buttonType+  | flClassName == "Fl_Browser" =+    lookup flWidgetType browserType+  | flClassName == "Fl_MenuItem" =+    lookup flWidgetType menuItemType+  | flClassName == "Fl_MenuButton" =+    lookup flWidgetType menuButtonType+  | flClassName == "Fl_Dial" =+    lookup flWidgetType dialType+  | flClassName == "Fl_Valuator" =+    lookup flWidgetType valuatorType+  | flClassName == "Fl_Counter" =+    lookup flWidgetType counterType+  | flClassName == "Fl_Scroll" =+    lookup flWidgetType scrollType+  | flClassName == "Fl_Scrollbar" =+    lookup flWidgetType scrollbarType+  | flClassName == "Fl_Window" =+    lookup flWidgetType windowType+  | flClassName == "Fl_Spinner" =+    lookup flWidgetType spinnerType+  | otherwise = Nothing++typicalConstructorG+  :: Maybe String -> (Int,Int,Int,Int) -> String -> String+typicalConstructorG name posSize constructorF =+  (maybe "_ <- " (\n -> n ++ " <- ") name) +++  (apply constructorF "" (Just $ "(toRectangle " ++ show posSize ++ ") Nothing"))++constructorG+  :: String -> String -> Maybe String -> (Int,Int,Int,Int) -> [String]+constructorG flClassName hsConstructor name posSize+  | flClassName == "Fl_Table" =+    ["-- Fl_Table " ++ (maybe "" id name) ++ " " ++ (show posSize)]+  | flClassName == "MenuItem" || flClassName == "Submenu" =+    [(maybe "_ <- " (\n -> n ++ " <- ") name) ++ "menuItemNew"]+  | flClassName == "Fl_Browser" || flClassName == "Fl_Box" =+    [typicalConstructorG name posSize hsConstructor ++ " Nothing"]+  | flClassName == "Fl_Window" =+    let (x,y,w,h) = posSize in+    [(maybe "_ <- " (\n -> n ++ " <- ") name) +++    (apply hsConstructor "" (Just $ "(Size (Width " ++ show w ++ ") (Height " ++ show h ++ ")) (Just (Position (X " ++ show x ++ ") (Y " ++ show y ++ "))) Nothing"))]+  | flClassName == "Fl_Input" || flClassName == "Fl_Output" =+    [typicalConstructorG name posSize hsConstructor ++ " Nothing"]+  | otherwise = [typicalConstructorG name posSize hsConstructor]++attributeG+  :: String -> String -> Attribute -> String+attributeG flClassName name attr =+  case attr of+    Types.Label l ->+      apply "setLabel" name (Just $ show $ collapseString l)+    Types.Value v ->+      apply "setValue" name (Just $ collapseString v)+    Types.WidgetType w ->+      maybe ""+            (\t ->+               (apply "setType" name) (Just t))+            (typeToHs flClassName (collapseString w))+    Types.Color c ->+      apply "setColor" name (Just $ "(Color " ++ (show c) ++ ")")+    Types.Maximum m ->+      apply "setMaximum" name (Just (show m))+    Types.Box b ->+      maybe ""+            (\t -> apply "setBox" name (Just t))+            (lookup b boxType)+    Types.Labelsize s ->+      apply "setLabelsize" name (Just ("(FontSize " ++ (show s) ++ ")"))+    Types.Resizable ->+      apply "setResizable" name (Just ("((Just (safeCast " ++ name  ++ ")) :: Maybe (Ref Widget))"))+    Types.Visible ->+      apply "setVisible" name Nothing+    Types.Align a ->+      apply "setAlign" name (Just $ "(" ++ (show $ intToAlignments a) ++ ")")+    Types.Minimum m ->+      apply "setMinimum" name (Just $ show m)+    Types.Step s ->+      apply "setStep" name (Just $ show s)+    Types.SelectionColor sc ->+      apply "setSelectionColor" name (Just $ "(Color " ++ (show sc) ++ ")")+    Types.Labeltype l ->+      maybe ""+            (\_f ->+               (apply "setLabeltype" name (Just _f)))+            (lookup (show l) labelType)+    Types.Labelcolor c ->+      apply "setLabelcolor" name (Just $ "(Color " ++ (show c) ++ ")")+    Types.Labelfont f ->+      maybe ""+            (\_f ->+               (apply "setLabelfont" name (Just _f)))+            (lookup (show f) fontType)+    Types.Shortcut s ->+      maybe []+            (\ks -> apply "setShortcut" name (Just ("(" ++ (show ks) ++ ")")))+            (cIntToKeySequence ((read s) :: CInt))+    Types.Tooltip t ->+      apply "setTooltip" name (Just $ show $ collapseString t)+    Types.When w ->+      apply "setWhen" name (Just $ "[" ++ (snd (whenType !! w)) ++ "]")+    Types.Hotspot ->+      apply "setHotspot" name Nothing+    Types.Modal ->+      apply "setModal" name Nothing+    Types.TextFont f ->+      maybe ""+            (\_f ->+               (apply "setTextfont" name (Just _f)))+            (lookup (show f) fontType)+    Types.TextSize s ->+      apply "setTextsize" name (Just ("(FontSize " ++ (show s) ++ ")"))+    Types.TextColor c ->+      apply "setTextcolor" name (Just $ "(Color " ++ (show c) ++ ")")+    Types.SliderSize s ->+      apply "setSlizersize" name (Just $ show s)+    Types.Deactivate ->+      apply "deactivate" name Nothing+    Types.DownBox b ->+      maybe ("-- unknown Box type: " ++ b) (\b' -> apply "setDownBox" name (Just b')) (lookup b boxType)+    Types.SizeRange (minw', minh', maxw', maxh') ->+      apply "sizeRangeWithArgs"+            name+            (Just $+             (show minw') +++             " " +++             (show minh') +++             " " +++             "defaultOptionalSizeRangeArgs {" +++             "maxw = " ++ (show maxw' ++ "," ++ "maxh =" ++ (show maxh') ++ "}"))+    Types.Callback code ->+      apply "setCallback" name (Just $ collapseString code)+    Types.Code0 code ->+      collapseParts code+    Types.Code1 code ->+      collapseParts code+    Types.Code2 code ->+      collapseParts code+    Types.Code3 code ->+      collapseParts code+    unknown -> " -- unknown attribute: " ++ (show unknown)++haskellIdToName :: TakenNames -> String -> HaskellIdentifier -> String+haskellIdToName _ _ (ValidHaskell hid) = hid+haskellIdToName _ _ (InvalidHaskell hid) = hid+haskellIdToName _ _ UnidentifiedFunction = "main"+haskellIdToName (TakenNames names) hsClassName Unidentified =+  let classNumber = do+        haskellFriendly <- case hsClassName of+          (x:xs) -> return ([(toLower x)] ++ xs)+          []     -> Nothing+        let ofType = filter (\n -> haskellFriendly `isPrefixOf` n) names+        return $ (haskellFriendly, length ofType)+  in maybe "o" (\(tc, n) -> tc ++ (show n)) classNumber++concatTakenNames :: TakenNames -> TakenNames -> TakenNames+concatTakenNames (TakenNames ns) (TakenNames ns') = TakenNames (nub $ ns ++ ns')++findDrop :: [a] -> (a -> Bool) -> (Maybe a, [a])+findDrop as pred' =+  let (found, rest) = partition pred' as+  in+    case found of+      [] -> (Nothing, rest)+      (_ : _ : _) -> (Nothing, rest)+      _ -> (Just (head found), rest)++menuItemCode :: String -> String -> [Attribute] -> ([String], [Attribute])+menuItemCode mn menuItemName restAttrs =+  let callbackCode callback = [+                                "let { callback :: Maybe (Ref MenuItem -> IO ()); callback = " ++ callback ++ "}"+                              ]+      labelCode label = [+                          "let { label = \"" ++ label ++ "\"}"+                        ]+      (((), attrs), haskellCode)= (runIdentity+                                      (runWriterT+                                         (runStateT+                                            (do+                                              let attrCode :: (Attribute -> Bool) ->+                                                              (Attribute -> [String]) ->+                                                              [String] ->+                                                              StateT [Attribute] (WriterT [String] Identity) ()+                                                  attrCode findAttr toCode fallback =+                                                     do+                                                       currentAttrs <- get+                                                       let (attr, restAttrs') = findDrop currentAttrs findAttr+                                                       modify (\_ -> restAttrs')+                                                       tell (maybe fallback toCode attr)+                                              attrCode (\a -> case a of Callback _ -> True; _ -> False)+                                                       (\(Callback c) -> callbackCode (collapseString c))+                                                       (callbackCode "(Nothing :: Maybe (Ref MenuItem -> IO ())) ")+                                              attrCode (\a -> case a of Label _ -> True ; _ -> False)+                                                       (\(Label l) -> labelCode (collapseString l))+                                                       ["let {label = " ++ menuItemName ++ "}"]+                                              tell [+                                                    "(MenuItemIndex idx) <- add " +++                                                    mn ++ " label " +++                                                    "(Nothing :: Maybe Shortcut) " +++                                                    "callback " +++                                                    "(MenuItemFlags [])",+                                                    mn ++ "_menuItems <- getMenu " ++ mn,+                                                    "let {" ++ menuItemName ++ " = fromJust (" ++ mn ++ "_menuItems !! idx)}"+                                                   ]+                                              attrCode (\a -> case a of Shortcut _ -> True; _ -> False)+                                                       (\(Shortcut s) ->+                                                            maybe+                                                              []+                                                              (\ks -> ["setShortcut " ++ mn ++ " idx (" ++ (show ks) ++ ")"])+                                                              (cIntToKeySequence ((read s) :: CInt)))+                                                       []+                                             ) restAttrs)))+  in (haskellCode, attrs)+determineClassName :: String -> [Attribute] -> (Maybe (String, String, String), [Attribute])+determineClassName flClassName attrs =+  case findDrop attrs+       (\a -> case a of+          DerivedFromClass _ -> True+          _ -> False) of+     (Just (DerivedFromClass derivedClass), restAttrs) ->+       (maybe Nothing (\(c,cons) -> Just (derivedClass, c, cons)) (lookup derivedClass flClasses) , restAttrs)+     _ -> (maybe Nothing (\(c,cons) -> Just (flClassName, c, cons)) (lookup flClassName flClasses), attrs)++widgetTreeG :: Maybe String -> WidgetTree -> State TakenNames [String]+widgetTreeG menuName widgetTree =+  case widgetTree of+    (Group flClassName haskellId attrs trees) ->+      case (determineClassName flClassName attrs) of+        (Just (newFlClassName, hsClassName, hsConstructor), restAttrs) ->+          case findDrop restAttrs+                 (\a -> case a of+                    XYWH _ -> True+                    _      -> False) of+            (Just (XYWH posSize), restAttrs) -> do+              takenNames <- get+              let newName = haskellIdToName takenNames hsClassName haskellId+              modify (\ns -> concatTakenNames ns (TakenNames [newName]))+              (newNames, innerTreeOutput) <-+                get >>= \names ->+                           return+                             (foldl+                                (\(takenNames', outputSoFar) tree ->+                                   let (output, newNames) = runState+                                                              (widgetTreeG+                                                                 Nothing+                                                                 tree)+                                                              takenNames'+                                   in (concatTakenNames takenNames' newNames, outputSoFar ++ output))+                                (names, [])+                                trees)+              modify (\ns -> concatTakenNames ns newNames)+              let code = (constructorG newFlClassName hsConstructor (Just newName) posSize) +++                         (map (attributeG hsClassName newName) restAttrs) +++                         ["begin " ++ newName] +++                         innerTreeOutput +++                         ["end " ++ newName]+              return code+            _ -> return []+        _ -> return ["-- unknown FLTK class: " ++ flClassName]+    (Menu flClassName haskellId attrs trees) ->+      case (determineClassName flClassName attrs) of+        (Just (newFlClassName, hsClassName, hsConstructor), restAttrs) ->+          case findDrop restAttrs+                 (\a -> case a of+                    XYWH _ -> True+                    _      -> False) of+            (Just (XYWH posSize), restAttrs) -> do+              takenNames <- get+              let newName = haskellIdToName takenNames hsClassName haskellId+              modify (\ns -> concatTakenNames ns (TakenNames [newName]))+              (newNames, innerTreeOutput) <-+                 get >>= \names ->+                   return+                     (foldl+                        (\(takenNames', outputSoFar) tree ->+                           let (output, newNames) = runState (widgetTreeG+                                                               (case hsClassName of {+                                                                  "Submenu" -> menuName;+                                                                  _ -> (Just newName)+                                                                })+                                                               tree)+                                                              takenNames'+                           in (concatTakenNames takenNames' newNames, outputSoFar ++ output))+                        (names, [])+                        trees)+              modify (\ns -> concatTakenNames ns newNames)+              let code = (case hsClassName of+                           "Submenu" ->+                              case menuName of+                                Just mn ->+                                  let (haskellCode, newAttrs) = menuItemCode mn newName restAttrs+                                  in+                                  haskellCode +++                                  [+                                    "flags " ++ " <- getFlags " ++ newName,+                                    "let {newFlags = maybe (MenuItemFlags [Submenu]) (\\(MenuItemFlags fs)-> (MenuItemFlags (fs ++ [Submenu]))) flags}",+                                    "setMode " ++ mn ++ " idx newFlags"+                                  ] +++                                  (map (attributeG newFlClassName newName) newAttrs) +++                                  innerTreeOutput+                                _ ->+                                  (constructorG newFlClassName hsConstructor (Just newName) posSize) +++                                  (map (attributeG newFlClassName newName) restAttrs) +++                                  ["setMenu " ++ newName ++ " ([] :: [Ref MenuItem])"] +++                                  innerTreeOutput+                           _ ->+                             (constructorG newFlClassName hsConstructor (Just newName) posSize) +++                             (map (attributeG newFlClassName newName) restAttrs) +++                             ["setMenu " ++ newName ++ " ([] :: [Ref MenuItem])"] +++                             innerTreeOutput+                          )+              return code+            _ -> return []+        _ -> return ["-- unknown FLTK class: " ++ flClassName]+    (Component flClassName haskellId attrs) -> do+         case (determineClassName flClassName attrs) of+           (Just (newFlClassName, hsClassName, hsConstructor), restAttrs) ->+             case findDrop restAttrs+                    (\a -> case a of+                       XYWH _ -> True+                       _      -> False) of+               (Just (XYWH posSize), restAttrs) -> do+                 takenNames <- get+                 newName <- return (haskellIdToName takenNames hsClassName haskellId)+                 modify (\ns -> concatTakenNames ns (TakenNames [newName]))+                 let code = case hsClassName of+                               "MenuItem" ->+                                  case menuName of+                                     Just mn ->+                                       let (haskellCode, newAttrs) = menuItemCode mn newName restAttrs+                                       in haskellCode ++ (map (attributeG newFlClassName newName) newAttrs)+                                     _ -> []+                               _ -> (constructorG newFlClassName hsConstructor (Just newName) posSize) +++                                    (case newFlClassName of+                                       "Fl_Output" -> ["setType " ++ newName ++ " FlNormalOutput"]+                                       _           -> []) +++                                    (map (attributeG newFlClassName newName) restAttrs)+                 return code+               _ -> return []+           _ -> return ["-- unknown FLTK class: " ++ flClassName]+    (Code _ code) -> return [collapseString code]+    (StandAloneComment _ comment) -> return ["{-\n", collapseString comment, "\n-}"]+    _ -> return []++functionG :: Function -> [String]+functionG (Function haskellId args attrs trees) =+  let fArgs =+               case (haskellId, args) of+                 (UnidentifiedFunction, _) -> "IO ()"+                 (_, FunctionArgs Nothing)        -> "()"+                 (_, FunctionArgs (Just args'))   -> args'+      fName = haskellIdToName (TakenNames []) "" haskellId+      fBody = filter (not . null) $ concatMap (\t -> evalState (widgetTreeG Nothing t) (TakenNames [fName]))+                                      trees+      argumentNames = case findDrop attrs+                           (\a -> case a of+                              ReturnType _ -> True+                              _ -> False) of+                      (Just (ReturnType argNames), _) -> collapseString argNames+                      _ -> ""+      indent = "  "+  in+    [fName ++ " :: " ++ fArgs, fName ++ " " ++ argumentNames ++ " = ", indent ++ " do {"] +++    (map (\line -> indent ++ "  " ++ line ++ ";") fBody) +++    [indent ++ "}"]++disclaimer :: [String]+disclaimer =+  ["-- GENERATED by fltkhs-fluid, do not edit.",+  "-- Instead edit the original .fl file using the `fluid` tool that ships with FLTK."]++standardImports :: [String]+standardImports =+  [ "import Graphics.UI.FLTK.LowLevel.FLTKHS"+  , "import qualified Graphics.UI.FLTK.LowLevel.FL as FL"+  , "import Graphics.UI.FLTK.LowLevel.Fl_Types"+  , "import Graphics.UI.FLTK.LowLevel.Fl_Enumerations"+  , "import Data.Maybe"+  ]++fluidBlockG :: FluidBlock -> Maybe [String]+fluidBlockG (FluidFunction f) = Just ((filter (not . null) . functionG) f)+fluidBlockG (Decl _ importStatement) = Just [collapseString importStatement]+fluidBlockG _ = Nothing++toHs :: String -> Fluid -> Either GenerationError [String]+toHs moduleName fluid =+  case (toModuleIdentifier moduleName) of+    Nothing -> Left (BadModuleName "")+    Just (InvalidModule m) -> Left (BadModuleName m)+    Just (ValidModule m ) ->+      Right(intersperse "\n" (disclaimer ++ ["module " ++ m ++ " where "] ++ standardImports ++ blocksToHaskell))+  where+    blocksToHaskell :: [String]+    blocksToHaskell = foldl+                        (\accum generatedBlock -> maybe accum (\b -> accum ++ b) generatedBlock)+                        []+                        (map fluidBlockG fluid)