diff --git a/CHANGES b/CHANGES deleted file mode 100644 --- a/CHANGES +++ /dev/null @@ -1,39 +0,0 @@ -0.5.0: 31 Jul 2011 - * initial preview release - -0.5.1: 3 Aug 2011 - * support for delete - -0.6: 16 Aug 2011 - * implement Deletable. delete method for every object - * refactor HROOT generated file names (Interface.hs, Implementation.hs, FFI.hs) - -0.6.3: 22 Sep 2011 - * Implement Existential Types - -0.6.4: 28 Sep 2011 - * add many TH2 class methods - -0.6.6: 7 Oct 2011 - * do not need OverlappingInstances, IncoherentInstances, UndecidableInstances - - -0.6.7: 18 Oct 2011 - * implement almost all TH1 class methods - -0.6.8: 20 Oct 2011 - * implement almost all class methods of TH2, TH3, TFormula, TF1 and TGraph - -0.6.9: 20 Oct 2011 - * implement almost all class methods of TLine, TAttLine, TAttMarker, TAttText and TAttPad - -0.7 : 8 Nov 2011 - * separate all class interfaces and implementation in different modules - * overhaul Existential - -0.7.1 : 12 Nov 2011 - * support for static methods - * add TROOT - -0.8 : 17 Jun 2014 - * separate packages into HROOT-core, HROOT-hist, HROOT-io, HROOT-math, HROOT-graf and HROOT is now an umbrella package diff --git a/Config.hs b/Config.hs deleted file mode 100644 --- a/Config.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -module Config where - -import Distribution.Simple -import Distribution.Simple.Setup -import Distribution.PackageDescription -import Distribution.Simple.LocalBuildInfo - -import System.Exit -import System.Process - -config :: LocalBuildInfo -> IO (Maybe HookedBuildInfo) -config bInfo = do - (excode, out, err) <- readProcessWithExitCode "root-config" ["--glibs"] "" - liboptset' <- case excode of - ExitSuccess -> do - return . Just . mkLibraryOptionSet . words $ out - _ -> do - putStrLn $ "root-config failure but I am installing HROOT without ROOT. It will not work. This is only for documentation." - return Nothing - (excode2,out2,err2) <- readProcessWithExitCode "root-config" ["--incdir"] "" - incdir' <- case excode2 of - ExitSuccess -> do - return . Just . head . words $ out2 - _ -> do - putStrLn $ "root-config failure but I am installing HROOT without ROOT. It will not work. This is only for documentation." - return Nothing - let Just lib = library . localPkgDescr $ bInfo - buildinfo = libBuildInfo lib - let (r :: Maybe HookedBuildInfo) = case liboptset' of - Nothing -> Nothing - Just liboptset -> - case incdir' of - Nothing -> Nothing - Just incdir -> - let hbi = emptyBuildInfo { extraLibs = extraLibs buildinfo - ++ libs liboptset - , extraLibDirs = libdirs liboptset - , includeDirs = incdir : includeDirs buildinfo - } - in Just (Just hbi, []) - return r - - -data LibraryOptionSet = LibraryOptionSet { - libs :: [String], - libdirs :: [String], - libopts :: [String] -} deriving Show - -data LibraryOption = Lib String - | Dir String - | Opt String - deriving Show - -mkLibraryOptionSet :: [String] -> LibraryOptionSet -mkLibraryOptionSet strs = let opts = libraryOptions strs - in foldr f (LibraryOptionSet [] [] []) opts - where f x (LibraryOptionSet l d o) = case x of - Lib st -> LibraryOptionSet (st:l) d o - Dir st -> LibraryOptionSet l (st:d) o - Opt st -> LibraryOptionSet l d (st:o) - -libraryOptions :: [String] -> [LibraryOption] -- LibraryOptionSet -libraryOptions = map f - where f x = let r = parseLibraryOptionClassifier x - in case r of - Left msg -> error (show msg) - Right result -> result - - -parseLibraryOptionClassifier :: String -> Either String LibraryOption -parseLibraryOptionClassifier [] = Left "empty option" -parseLibraryOptionClassifier str@(x:xs) = - case x of - '-' -> if null xs - then Left "parse error" - else let (y:ys) = xs - in case y of - 'L' -> Right (Dir ys) - 'l' -> Right (Lib ys) - _ -> Right (Opt str) - _ -> Right (Opt str) - diff --git a/HROOT-graf.cabal b/HROOT-graf.cabal --- a/HROOT-graf.cabal +++ b/HROOT-graf.cabal @@ -1,19 +1,17 @@ -Name: HROOT-graf -Version: 0.8 -Synopsis: Haskell binding to ROOT Graf modules -Description: HROOT is a haskell Foreign Function Interface (FFI) binding to ROOT. ROOT(http://root.cern.ch) is an object-oriented program and library developed by CERN for physics data analysis. +Name: HROOT-graf +Version: 0.9 +Synopsis: Haskell binding to ROOT Graf modules +Description: HROOT is a haskell Foreign Function Interface (FFI) binding to ROOT. ROOT(http://root.cern.ch) is an object-oriented program and library developed by CERN for physics data analysis. Homepage: http://ianwookim.org/HROOT -License: LGPL-2.1 -License-file: LICENSE -Author: Ian-Woo Kim -Maintainer: Ian-Woo Kim +license: LGPL-2.1 +license-file: LICENSE +Author: Ian-Woo Kim +Maintainer: Ian-Woo Kim Category: Graphics, Statistics, Math, Numerical Tested-with: GHC >= 7.6 -Build-Type: Custom +Build-Type: Custom cabal-version: >=1.10 -Extra-source-files: - CHANGES - Config.hs +Extra-source-files: csrc/HROOTGrafTArc.h csrc/HROOTGrafTArrow.h csrc/HROOTGrafTAttImage.h @@ -57,7 +55,8 @@ hs-source-dirs: src ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-unused-imports ghc-prof-options: -caf-all -auto-all - Build-Depends: base>4 && < 5, fficxx-runtime >= 0.0.999 ,HROOT-core,HROOT-hist + cc-options: -std=c++14 + Build-Depends: base>4 && < 5, fficxx >= 0.3, fficxx-runtime >= 0.3, template-haskell,HROOT-core,HROOT-hist Exposed-Modules: HROOT.Graf HROOT.Graf.TArc @@ -162,13 +161,13 @@ HROOT.Graf.TShape.Implementation HROOT.Graf.TSPHE.Implementation HROOT.Graf.TTUBE.Implementation - + Other-Modules: extra-lib-dirs: extra-libraries: stdc++ - Include-dirs: csrc - Install-includes: + Include-dirs: csrc + Install-includes: HROOT-grafType.h HROOTGrafTArc.h HROOTGrafTArrow.h @@ -188,7 +187,7 @@ HROOTGrafTSPHE.h HROOTGrafTTUBE.h - C-sources: + C-sources: csrc/HROOTGrafTArc.cpp csrc/HROOTGrafTArrow.cpp csrc/HROOTGrafTAttImage.cpp @@ -206,8 +205,5 @@ csrc/HROOTGrafTShape.cpp csrc/HROOTGrafTSPHE.cpp csrc/HROOTGrafTTUBE.cpp - - - diff --git a/csrc/HROOT-grafType.h b/csrc/HROOT-grafType.h --- a/csrc/HROOT-grafType.h +++ b/csrc/HROOT-grafType.h @@ -10,88 +10,106 @@ typedef TArc_t * TArc_p; typedef TArc_t const* const_TArc_p; + // Opaque type definition for TArrow typedef struct TArrow_tag TArrow_t; typedef TArrow_t * TArrow_p; typedef TArrow_t const* const_TArrow_p; + // Opaque type definition for TAttImage typedef struct TAttImage_tag TAttImage_t; typedef TAttImage_t * TAttImage_p; typedef TAttImage_t const* const_TAttImage_p; + // Opaque type definition for TBRIK typedef struct TBRIK_tag TBRIK_t; typedef TBRIK_t * TBRIK_p; typedef TBRIK_t const* const_TBRIK_p; + // Opaque type definition for TCanvas typedef struct TCanvas_tag TCanvas_t; typedef TCanvas_t * TCanvas_p; typedef TCanvas_t const* const_TCanvas_p; + // Opaque type definition for TCrown typedef struct TCrown_tag TCrown_t; typedef TCrown_t * TCrown_p; typedef TCrown_t const* const_TCrown_p; + // Opaque type definition for TCutG typedef struct TCutG_tag TCutG_t; typedef TCutG_t * TCutG_p; typedef TCutG_t const* const_TCutG_p; + // Opaque type definition for TEllipse typedef struct TEllipse_tag TEllipse_t; typedef TEllipse_t * TEllipse_p; typedef TEllipse_t const* const_TEllipse_p; + // Opaque type definition for TGaxis typedef struct TGaxis_tag TGaxis_t; typedef TGaxis_t * TGaxis_p; typedef TGaxis_t const* const_TGaxis_p; + // Opaque type definition for TGraphPolar typedef struct TGraphPolar_tag TGraphPolar_t; typedef TGraphPolar_t * TGraphPolar_p; typedef TGraphPolar_t const* const_TGraphPolar_p; + // Opaque type definition for TGraphQQ typedef struct TGraphQQ_tag TGraphQQ_t; typedef TGraphQQ_t * TGraphQQ_p; typedef TGraphQQ_t const* const_TGraphQQ_p; + // Opaque type definition for TLine typedef struct TLine_tag TLine_t; typedef TLine_t * TLine_p; typedef TLine_t const* const_TLine_p; + // Opaque type definition for TPad typedef struct TPad_tag TPad_t; typedef TPad_t * TPad_p; typedef TPad_t const* const_TPad_p; + // Opaque type definition for TPCON typedef struct TPCON_tag TPCON_t; typedef TPCON_t * TPCON_p; typedef TPCON_t const* const_TPCON_p; + // Opaque type definition for TShape typedef struct TShape_tag TShape_t; typedef TShape_t * TShape_p; typedef TShape_t const* const_TShape_p; + // Opaque type definition for TSPHE typedef struct TSPHE_tag TSPHE_t; typedef TSPHE_t * TSPHE_p; typedef TSPHE_t const* const_TSPHE_p; + // Opaque type definition for TTUBE typedef struct TTUBE_tag TTUBE_t; typedef TTUBE_t * TTUBE_p; typedef TTUBE_t const* const_TTUBE_p; + #endif // __HROOT_GRAF__ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTArc.cpp b/csrc/HROOTGrafTArc.cpp --- a/csrc/HROOTGrafTArc.cpp +++ b/csrc/HROOTGrafTArc.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTGrafTEllipse.h" #include "TArc.h" #include "HROOTGrafTArc.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -45,5 +22,4 @@ TARC_DEF_VIRT(TArc) TARC_DEF_NONVIRT(TArc) - diff --git a/csrc/HROOTGrafTArc.h b/csrc/HROOTGrafTArc.h --- a/csrc/HROOTGrafTArc.h +++ b/csrc/HROOTGrafTArc.h @@ -1,23 +1,22 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TArc__ #define __HROOT_GRAF__TArc__ #include "HROOT-grafType.h" - #include "HROOTGrafTEllipse.h" #include "HROOTCoreTObject.h" #include "HROOTCoreTAttLine.h" #include "HROOTCoreTAttFill.h" #include "HROOTCoreDeletable.h" -#undef TARC_DECL_VIRT +#undef TARC_DECL_VIRT #define TARC_DECL_VIRT(Type) \ -#undef TARC_DECL_NONVIRT +#undef TARC_DECL_NONVIRT #define TARC_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTArc ( double x1, double y1, double radius, double phimin, double phimax ) @@ -51,3 +50,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTArrow.cpp b/csrc/HROOTGrafTArrow.cpp --- a/csrc/HROOTGrafTArrow.cpp +++ b/csrc/HROOTGrafTArrow.cpp @@ -1,34 +1,11 @@ #include - #include "HROOTGrafTLine.h" #include "HROOTCoreTAttFill.h" #include "TArrow.h" #include "HROOTGrafTArrow.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -46,5 +23,4 @@ TARROW_DEF_VIRT(TArrow) TARROW_DEF_NONVIRT(TArrow) - diff --git a/csrc/HROOTGrafTArrow.h b/csrc/HROOTGrafTArrow.h --- a/csrc/HROOTGrafTArrow.h +++ b/csrc/HROOTGrafTArrow.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TArrow__ #define __HROOT_GRAF__TArrow__ #include "HROOT-grafType.h" - #include "HROOTGrafTLine.h" #include "HROOTCoreTAttFill.h" #include "HROOTCoreTObject.h" @@ -14,11 +13,11 @@ #include "HROOTCoreDeletable.h" #include "HROOT-coreType.h" -#undef TARROW_DECL_VIRT +#undef TARROW_DECL_VIRT #define TARROW_DECL_VIRT(Type) \ -#undef TARROW_DECL_NONVIRT +#undef TARROW_DECL_NONVIRT #define TARROW_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTArrow ( double x1, double y1, double x2, double y2, double arrowsize, const char* option ) @@ -52,3 +51,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTAttImage.cpp b/csrc/HROOTGrafTAttImage.cpp --- a/csrc/HROOTGrafTAttImage.cpp +++ b/csrc/HROOTGrafTAttImage.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TAttImage.h" #include "HROOTGrafTAttImage.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TATTIMAGE_DEF_VIRT(TAttImage) TATTIMAGE_DEF_NONVIRT(TAttImage) - diff --git a/csrc/HROOTGrafTAttImage.h b/csrc/HROOTGrafTAttImage.h --- a/csrc/HROOTGrafTAttImage.h +++ b/csrc/HROOTGrafTAttImage.h @@ -1,20 +1,19 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TAttImage__ #define __HROOT_GRAF__TAttImage__ #include "HROOT-grafType.h" - #include "HROOTCoreDeletable.h" #include "HROOT-coreType.h" -#undef TATTIMAGE_DECL_VIRT +#undef TATTIMAGE_DECL_VIRT #define TATTIMAGE_DECL_VIRT(Type) \ -#undef TATTIMAGE_DECL_NONVIRT +#undef TATTIMAGE_DECL_NONVIRT #define TATTIMAGE_DECL_NONVIRT(Type) \ @@ -40,3 +39,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTBRIK.cpp b/csrc/HROOTGrafTBRIK.cpp --- a/csrc/HROOTGrafTBRIK.cpp +++ b/csrc/HROOTGrafTBRIK.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTGrafTShape.h" #include "TBRIK.h" #include "HROOTGrafTBRIK.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -47,5 +24,4 @@ TBRIK_DEF_VIRT(TBRIK) TBRIK_DEF_NONVIRT(TBRIK) - diff --git a/csrc/HROOTGrafTBRIK.h b/csrc/HROOTGrafTBRIK.h --- a/csrc/HROOTGrafTBRIK.h +++ b/csrc/HROOTGrafTBRIK.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TBRIK__ #define __HROOT_GRAF__TBRIK__ #include "HROOT-grafType.h" - #include "HROOTGrafTShape.h" #include "HROOTCoreTNamed.h" #include "HROOTCoreTAttLine.h" @@ -15,11 +14,11 @@ #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TBRIK_DECL_VIRT +#undef TBRIK_DECL_VIRT #define TBRIK_DECL_VIRT(Type) \ -#undef TBRIK_DECL_NONVIRT +#undef TBRIK_DECL_NONVIRT #define TBRIK_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTBRIK ( const char* name, const char* title, const char* material, double dx, double dy, double dz ) @@ -55,3 +54,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTCanvas.cpp b/csrc/HROOTGrafTCanvas.cpp --- a/csrc/HROOTGrafTCanvas.cpp +++ b/csrc/HROOTGrafTCanvas.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTGrafTPad.h" #include "TCanvas.h" #include "HROOTGrafTCanvas.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -44,5 +21,4 @@ TCANVAS_DEF_VIRT(TCanvas) TCANVAS_DEF_NONVIRT(TCanvas) - diff --git a/csrc/HROOTGrafTCanvas.h b/csrc/HROOTGrafTCanvas.h --- a/csrc/HROOTGrafTCanvas.h +++ b/csrc/HROOTGrafTCanvas.h @@ -1,22 +1,21 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TCanvas__ #define __HROOT_GRAF__TCanvas__ #include "HROOT-grafType.h" - #include "HROOTGrafTPad.h" #include "HROOTCoreTVirtualPad.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TCANVAS_DECL_VIRT +#undef TCANVAS_DECL_VIRT #define TCANVAS_DECL_VIRT(Type) \ -#undef TCANVAS_DECL_NONVIRT +#undef TCANVAS_DECL_NONVIRT #define TCANVAS_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTCanvas ( const char* name, const char* title, int ww, int wh ) @@ -49,3 +48,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTCrown.cpp b/csrc/HROOTGrafTCrown.cpp --- a/csrc/HROOTGrafTCrown.cpp +++ b/csrc/HROOTGrafTCrown.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTGrafTEllipse.h" #include "TCrown.h" #include "HROOTGrafTCrown.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -45,5 +22,4 @@ TCROWN_DEF_VIRT(TCrown) TCROWN_DEF_NONVIRT(TCrown) - diff --git a/csrc/HROOTGrafTCrown.h b/csrc/HROOTGrafTCrown.h --- a/csrc/HROOTGrafTCrown.h +++ b/csrc/HROOTGrafTCrown.h @@ -1,23 +1,22 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TCrown__ #define __HROOT_GRAF__TCrown__ #include "HROOT-grafType.h" - #include "HROOTGrafTEllipse.h" #include "HROOTCoreTObject.h" #include "HROOTCoreTAttLine.h" #include "HROOTCoreTAttFill.h" #include "HROOTCoreDeletable.h" -#undef TCROWN_DECL_VIRT +#undef TCROWN_DECL_VIRT #define TCROWN_DECL_VIRT(Type) \ -#undef TCROWN_DECL_NONVIRT +#undef TCROWN_DECL_NONVIRT #define TCROWN_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTCrown ( double x1, double y1, double radin, double radout, double phimin, double phimax ) @@ -51,3 +50,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTCutG.cpp b/csrc/HROOTGrafTCutG.cpp --- a/csrc/HROOTGrafTCutG.cpp +++ b/csrc/HROOTGrafTCutG.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTHistTGraph.h" #include "TCutG.h" #include "HROOTGrafTCutG.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -47,5 +24,4 @@ TCUTG_DEF_VIRT(TCutG) TCUTG_DEF_NONVIRT(TCutG) - diff --git a/csrc/HROOTGrafTCutG.h b/csrc/HROOTGrafTCutG.h --- a/csrc/HROOTGrafTCutG.h +++ b/csrc/HROOTGrafTCutG.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TCutG__ #define __HROOT_GRAF__TCutG__ #include "HROOT-grafType.h" - #include "HROOTHistTGraph.h" #include "HROOTCoreTNamed.h" #include "HROOTCoreTAttLine.h" @@ -16,11 +15,11 @@ #include "HROOTCoreDeletable.h" #include "HROOT-histType.h" -#undef TCUTG_DECL_VIRT +#undef TCUTG_DECL_VIRT #define TCUTG_DECL_VIRT(Type) \ -#undef TCUTG_DECL_NONVIRT +#undef TCUTG_DECL_NONVIRT #define TCUTG_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTCutG ( const char* name, int n, double * x, double * y ) @@ -56,3 +55,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTEllipse.cpp b/csrc/HROOTGrafTEllipse.cpp --- a/csrc/HROOTGrafTEllipse.cpp +++ b/csrc/HROOTGrafTEllipse.cpp @@ -1,35 +1,12 @@ #include - #include "HROOTCoreTObject.h" #include "HROOTCoreTAttLine.h" #include "HROOTCoreTAttFill.h" #include "TEllipse.h" #include "HROOTGrafTEllipse.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -46,5 +23,4 @@ TELLIPSE_DEF_VIRT(TEllipse) TELLIPSE_DEF_NONVIRT(TEllipse) - diff --git a/csrc/HROOTGrafTEllipse.h b/csrc/HROOTGrafTEllipse.h --- a/csrc/HROOTGrafTEllipse.h +++ b/csrc/HROOTGrafTEllipse.h @@ -1,23 +1,22 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TEllipse__ #define __HROOT_GRAF__TEllipse__ #include "HROOT-grafType.h" - #include "HROOTCoreTObject.h" #include "HROOTCoreTAttLine.h" #include "HROOTCoreTAttFill.h" #include "HROOTCoreDeletable.h" #include "HROOT-coreType.h" -#undef TELLIPSE_DECL_VIRT +#undef TELLIPSE_DECL_VIRT #define TELLIPSE_DECL_VIRT(Type) \ -#undef TELLIPSE_DECL_NONVIRT +#undef TELLIPSE_DECL_NONVIRT #define TELLIPSE_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTEllipse ( double x1, double y1, double r1, double r2, double phimin, double phimax, double theta ) @@ -50,3 +49,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTGaxis.cpp b/csrc/HROOTGrafTGaxis.cpp --- a/csrc/HROOTGrafTGaxis.cpp +++ b/csrc/HROOTGrafTGaxis.cpp @@ -1,34 +1,11 @@ #include - #include "HROOTGrafTLine.h" #include "HROOTCoreTAttText.h" #include "TGaxis.h" #include "HROOTGrafTGaxis.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -46,5 +23,4 @@ TGAXIS_DEF_VIRT(TGaxis) TGAXIS_DEF_NONVIRT(TGaxis) - diff --git a/csrc/HROOTGrafTGaxis.h b/csrc/HROOTGrafTGaxis.h --- a/csrc/HROOTGrafTGaxis.h +++ b/csrc/HROOTGrafTGaxis.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TGaxis__ #define __HROOT_GRAF__TGaxis__ #include "HROOT-grafType.h" - #include "HROOTGrafTLine.h" #include "HROOTCoreTAttText.h" #include "HROOTCoreTObject.h" @@ -14,11 +13,11 @@ #include "HROOTCoreDeletable.h" #include "HROOT-coreType.h" -#undef TGAXIS_DECL_VIRT +#undef TGAXIS_DECL_VIRT #define TGAXIS_DECL_VIRT(Type) \ -#undef TGAXIS_DECL_NONVIRT +#undef TGAXIS_DECL_NONVIRT #define TGAXIS_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTGaxis ( double xmin, double ymin, double xmax, double ymax, double wmin, double wmax, int ndiv, const char* chopt, double gridlength ) @@ -52,3 +51,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTGraphPolar.cpp b/csrc/HROOTGrafTGraphPolar.cpp --- a/csrc/HROOTGrafTGraphPolar.cpp +++ b/csrc/HROOTGrafTGraphPolar.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTHistTGraphErrors.h" #include "TGraphPolar.h" #include "HROOTGrafTGraphPolar.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -48,5 +25,4 @@ TGRAPHPOLAR_DEF_VIRT(TGraphPolar) TGRAPHPOLAR_DEF_NONVIRT(TGraphPolar) - diff --git a/csrc/HROOTGrafTGraphPolar.h b/csrc/HROOTGrafTGraphPolar.h --- a/csrc/HROOTGrafTGraphPolar.h +++ b/csrc/HROOTGrafTGraphPolar.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TGraphPolar__ #define __HROOT_GRAF__TGraphPolar__ #include "HROOT-grafType.h" - #include "HROOTHistTGraphErrors.h" #include "HROOTHistTGraph.h" #include "HROOTCoreTNamed.h" @@ -17,11 +16,11 @@ #include "HROOTCoreDeletable.h" #include "HROOT-histType.h" -#undef TGRAPHPOLAR_DECL_VIRT +#undef TGRAPHPOLAR_DECL_VIRT #define TGRAPHPOLAR_DECL_VIRT(Type) \ -#undef TGRAPHPOLAR_DECL_NONVIRT +#undef TGRAPHPOLAR_DECL_NONVIRT #define TGRAPHPOLAR_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTGraphPolar ( int n, double * x, double * y, double * ex, double * ey ) @@ -58,3 +57,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTGraphQQ.cpp b/csrc/HROOTGrafTGraphQQ.cpp --- a/csrc/HROOTGrafTGraphQQ.cpp +++ b/csrc/HROOTGrafTGraphQQ.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTHistTGraph.h" #include "TGraphQQ.h" #include "HROOTGrafTGraphQQ.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -47,5 +24,4 @@ TGRAPHQQ_DEF_VIRT(TGraphQQ) TGRAPHQQ_DEF_NONVIRT(TGraphQQ) - diff --git a/csrc/HROOTGrafTGraphQQ.h b/csrc/HROOTGrafTGraphQQ.h --- a/csrc/HROOTGrafTGraphQQ.h +++ b/csrc/HROOTGrafTGraphQQ.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TGraphQQ__ #define __HROOT_GRAF__TGraphQQ__ #include "HROOT-grafType.h" - #include "HROOTHistTGraph.h" #include "HROOTCoreTNamed.h" #include "HROOTCoreTAttLine.h" @@ -16,11 +15,11 @@ #include "HROOTCoreDeletable.h" #include "HROOT-histType.h" -#undef TGRAPHQQ_DECL_VIRT +#undef TGRAPHQQ_DECL_VIRT #define TGRAPHQQ_DECL_VIRT(Type) \ -#undef TGRAPHQQ_DECL_NONVIRT +#undef TGRAPHQQ_DECL_NONVIRT #define TGRAPHQQ_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTGraphQQ ( int nx, double * x, int ny, double * y ) @@ -56,3 +55,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTLine.cpp b/csrc/HROOTGrafTLine.cpp --- a/csrc/HROOTGrafTLine.cpp +++ b/csrc/HROOTGrafTLine.cpp @@ -1,34 +1,11 @@ #include - #include "HROOTCoreTObject.h" #include "HROOTCoreTAttLine.h" #include "TLine.h" #include "HROOTGrafTLine.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -44,5 +21,4 @@ TLINE_DEF_VIRT(TLine) TLINE_DEF_NONVIRT(TLine) - diff --git a/csrc/HROOTGrafTLine.h b/csrc/HROOTGrafTLine.h --- a/csrc/HROOTGrafTLine.h +++ b/csrc/HROOTGrafTLine.h @@ -1,18 +1,17 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TLine__ #define __HROOT_GRAF__TLine__ #include "HROOT-grafType.h" - #include "HROOTCoreTObject.h" #include "HROOTCoreTAttLine.h" #include "HROOTCoreDeletable.h" #include "HROOT-coreType.h" -#undef TLINE_DECL_VIRT +#undef TLINE_DECL_VIRT #define TLINE_DECL_VIRT(Type) \ TLine_p Type ## _DrawLine ( Type ## _p p, double x1, double y1, double x2, double y2 ); \ TLine_p Type ## _DrawLineNDC ( Type ## _p p, double x1, double y1, double x2, double y2 ); \ @@ -23,7 +22,7 @@ void Type ## _SetY1 ( Type ## _p p, double y1 ); \ void Type ## _SetY2 ( Type ## _p p, double y2 ) -#undef TLINE_DECL_NONVIRT +#undef TLINE_DECL_NONVIRT #define TLINE_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTLine ( double x1, double y1, double x2, double y2 ); \ double Type ## _tLineGetX1 ( Type ## _p p ); \ @@ -126,3 +125,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTPCON.cpp b/csrc/HROOTGrafTPCON.cpp --- a/csrc/HROOTGrafTPCON.cpp +++ b/csrc/HROOTGrafTPCON.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTGrafTShape.h" #include "TPCON.h" #include "HROOTGrafTPCON.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -47,5 +24,4 @@ TPCON_DEF_VIRT(TPCON) TPCON_DEF_NONVIRT(TPCON) - diff --git a/csrc/HROOTGrafTPCON.h b/csrc/HROOTGrafTPCON.h --- a/csrc/HROOTGrafTPCON.h +++ b/csrc/HROOTGrafTPCON.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TPCON__ #define __HROOT_GRAF__TPCON__ #include "HROOT-grafType.h" - #include "HROOTGrafTShape.h" #include "HROOTCoreTNamed.h" #include "HROOTCoreTAttLine.h" @@ -15,11 +14,11 @@ #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TPCON_DECL_VIRT +#undef TPCON_DECL_VIRT #define TPCON_DECL_VIRT(Type) \ -#undef TPCON_DECL_NONVIRT +#undef TPCON_DECL_NONVIRT #define TPCON_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTPCON ( const char* name, const char* title, const char* material, double phi1, double dphi1, int nz ) @@ -55,3 +54,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTPad.cpp b/csrc/HROOTGrafTPad.cpp --- a/csrc/HROOTGrafTPad.cpp +++ b/csrc/HROOTGrafTPad.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTVirtualPad.h" #include "TPad.h" #include "HROOTGrafTPad.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -43,5 +20,4 @@ TPAD_DEF_VIRT(TPad) TPAD_DEF_NONVIRT(TPad) - diff --git a/csrc/HROOTGrafTPad.h b/csrc/HROOTGrafTPad.h --- a/csrc/HROOTGrafTPad.h +++ b/csrc/HROOTGrafTPad.h @@ -1,22 +1,21 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TPad__ #define __HROOT_GRAF__TPad__ #include "HROOT-grafType.h" - #include "HROOTCoreTVirtualPad.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" #include "HROOT-coreType.h" -#undef TPAD_DECL_VIRT +#undef TPAD_DECL_VIRT #define TPAD_DECL_VIRT(Type) \ -#undef TPAD_DECL_NONVIRT +#undef TPAD_DECL_NONVIRT #define TPAD_DECL_NONVIRT(Type) \ @@ -44,3 +43,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTSPHE.cpp b/csrc/HROOTGrafTSPHE.cpp --- a/csrc/HROOTGrafTSPHE.cpp +++ b/csrc/HROOTGrafTSPHE.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTGrafTShape.h" #include "TSPHE.h" #include "HROOTGrafTSPHE.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -47,5 +24,4 @@ TSPHE_DEF_VIRT(TSPHE) TSPHE_DEF_NONVIRT(TSPHE) - diff --git a/csrc/HROOTGrafTSPHE.h b/csrc/HROOTGrafTSPHE.h --- a/csrc/HROOTGrafTSPHE.h +++ b/csrc/HROOTGrafTSPHE.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TSPHE__ #define __HROOT_GRAF__TSPHE__ #include "HROOT-grafType.h" - #include "HROOTGrafTShape.h" #include "HROOTCoreTNamed.h" #include "HROOTCoreTAttLine.h" @@ -15,11 +14,11 @@ #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TSPHE_DECL_VIRT +#undef TSPHE_DECL_VIRT #define TSPHE_DECL_VIRT(Type) \ -#undef TSPHE_DECL_NONVIRT +#undef TSPHE_DECL_NONVIRT #define TSPHE_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTSPHE ( const char* name, const char* title, const char* material, double rmin, double rmax, double themin, double themax, double phimin, double phimax ) @@ -55,3 +54,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTShape.cpp b/csrc/HROOTGrafTShape.cpp --- a/csrc/HROOTGrafTShape.cpp +++ b/csrc/HROOTGrafTShape.cpp @@ -1,5 +1,4 @@ #include - #include "HROOTCoreTNamed.h" #include "HROOTCoreTAttLine.h" #include "HROOTCoreTAttFill.h" @@ -7,30 +6,8 @@ #include "TShape.h" #include "HROOTGrafTShape.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -49,5 +26,4 @@ TSHAPE_DEF_VIRT(TShape) TSHAPE_DEF_NONVIRT(TShape) - diff --git a/csrc/HROOTGrafTShape.h b/csrc/HROOTGrafTShape.h --- a/csrc/HROOTGrafTShape.h +++ b/csrc/HROOTGrafTShape.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TShape__ #define __HROOT_GRAF__TShape__ #include "HROOT-grafType.h" - #include "HROOTCoreTNamed.h" #include "HROOTCoreTAttLine.h" #include "HROOTCoreTAttFill.h" @@ -15,11 +14,11 @@ #include "HROOTCoreDeletable.h" #include "HROOT-coreType.h" -#undef TSHAPE_DECL_VIRT +#undef TSHAPE_DECL_VIRT #define TSHAPE_DECL_VIRT(Type) \ -#undef TSHAPE_DECL_NONVIRT +#undef TSHAPE_DECL_NONVIRT #define TSHAPE_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTShape ( const char* name, const char* title, const char* material ) @@ -54,3 +53,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTGrafTTUBE.cpp b/csrc/HROOTGrafTTUBE.cpp --- a/csrc/HROOTGrafTTUBE.cpp +++ b/csrc/HROOTGrafTTUBE.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTGrafTShape.h" #include "TTUBE.h" #include "HROOTGrafTTUBE.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -47,5 +24,4 @@ TTUBE_DEF_VIRT(TTUBE) TTUBE_DEF_NONVIRT(TTUBE) - diff --git a/csrc/HROOTGrafTTUBE.h b/csrc/HROOTGrafTTUBE.h --- a/csrc/HROOTGrafTTUBE.h +++ b/csrc/HROOTGrafTTUBE.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_GRAF__TTUBE__ #define __HROOT_GRAF__TTUBE__ #include "HROOT-grafType.h" - #include "HROOTGrafTShape.h" #include "HROOTCoreTNamed.h" #include "HROOTCoreTAttLine.h" @@ -15,11 +14,11 @@ #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TTUBE_DECL_VIRT +#undef TTUBE_DECL_VIRT #define TTUBE_DECL_VIRT(Type) \ -#undef TTUBE_DECL_NONVIRT +#undef TTUBE_DECL_NONVIRT #define TTUBE_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTTUBE ( const char* name, const char* title, const char* material, double rmin, double rmax, double dz, double aspect ) @@ -55,3 +54,4 @@ #ifdef __cplusplus } #endif + diff --git a/src/HROOT/Graf.hs b/src/HROOT/Graf.hs --- a/src/HROOT/Graf.hs +++ b/src/HROOT/Graf.hs @@ -1,5 +1,5 @@ module HROOT.Graf ( -module HROOT.Graf.TArc + module HROOT.Graf.TArc , module HROOT.Graf.TArrow , module HROOT.Graf.TAttImage , module HROOT.Graf.TBRIK @@ -15,7 +15,7 @@ , module HROOT.Graf.TPCON , module HROOT.Graf.TShape , module HROOT.Graf.TSPHE -, module HROOT.Graf.TTUBE +, module HROOT.Graf.TTUBE ) where import HROOT.Graf.TArc diff --git a/src/HROOT/Graf/TArc.hs b/src/HROOT/Graf/TArc.hs --- a/src/HROOT/Graf/TArc.hs +++ b/src/HROOT/Graf/TArc.hs @@ -1,15 +1,5 @@ module HROOT.Graf.TArc - ( - TArc(..) - , ITArc - , upcastTArc - , downcastTArc - , newTArc - - ) where - + (TArc(..), ITArc, upcastTArc, downcastTArc, newTArc) where import HROOT.Graf.TArc.RawType import HROOT.Graf.TArc.Interface import HROOT.Graf.TArc.Implementation - - diff --git a/src/HROOT/Graf/TArc/Cast.hs b/src/HROOT/Graf/TArc/Cast.hs --- a/src/HROOT/Graf/TArc/Cast.hs +++ b/src/HROOT/Graf/TArc/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TArc.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TArc.RawType import HROOT.Graf.TArc.Interface instance (ITArc a, FPtr a) => Castable a (Ptr RawTArc) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TArc (Ptr RawTArc) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TArc/FFI.hsc b/src/HROOT/Graf/TArc/FFI.hsc --- a/src/HROOT/Graf/TArc/FFI.hsc +++ b/src/HROOT/Graf/TArc/FFI.hsc @@ -1,80 +1,69 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TArc.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TArc.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTArc.h" - -foreign import ccall "HROOTGrafTArc.h TArc_Draw" c_tarc_draw - :: (Ptr RawTArc) -> CString -> IO () - -foreign import ccall "HROOTGrafTArc.h TArc_FindObject" c_tarc_findobject - :: (Ptr RawTArc) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTArc.h TArc_Draw" c_tarc_draw + :: Ptr RawTArc -> CString -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_GetName" c_tarc_getname - :: (Ptr RawTArc) -> IO CString +foreign import ccall safe "HROOTGrafTArc.h TArc_FindObject" + c_tarc_findobject :: Ptr RawTArc -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTArc.h TArc_IsA" c_tarc_isa - :: (Ptr RawTArc) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTArc.h TArc_GetName" + c_tarc_getname :: Ptr RawTArc -> IO CString -foreign import ccall "HROOTGrafTArc.h TArc_Paint" c_tarc_paint - :: (Ptr RawTArc) -> CString -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_IsA" c_tarc_isa :: + Ptr RawTArc -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTArc.h TArc_printObj" c_tarc_printobj - :: (Ptr RawTArc) -> CString -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_Paint" c_tarc_paint + :: Ptr RawTArc -> CString -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_SaveAs" c_tarc_saveas - :: (Ptr RawTArc) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_printObj" + c_tarc_printobj :: Ptr RawTArc -> CString -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_Write" c_tarc_write - :: (Ptr RawTArc) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTArc.h TArc_SaveAs" + c_tarc_saveas :: Ptr RawTArc -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_GetLineColor" c_tarc_getlinecolor - :: (Ptr RawTArc) -> IO CInt +foreign import ccall safe "HROOTGrafTArc.h TArc_Write" c_tarc_write + :: Ptr RawTArc -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTArc.h TArc_GetLineStyle" c_tarc_getlinestyle - :: (Ptr RawTArc) -> IO CInt +foreign import ccall safe "HROOTGrafTArc.h TArc_GetLineColor" + c_tarc_getlinecolor :: Ptr RawTArc -> IO CInt -foreign import ccall "HROOTGrafTArc.h TArc_GetLineWidth" c_tarc_getlinewidth - :: (Ptr RawTArc) -> IO CInt +foreign import ccall safe "HROOTGrafTArc.h TArc_GetLineStyle" + c_tarc_getlinestyle :: Ptr RawTArc -> IO CInt -foreign import ccall "HROOTGrafTArc.h TArc_ResetAttLine" c_tarc_resetattline - :: (Ptr RawTArc) -> CString -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_GetLineWidth" + c_tarc_getlinewidth :: Ptr RawTArc -> IO CInt -foreign import ccall "HROOTGrafTArc.h TArc_SetLineAttributes" c_tarc_setlineattributes - :: (Ptr RawTArc) -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_ResetAttLine" + c_tarc_resetattline :: Ptr RawTArc -> CString -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_SetLineColor" c_tarc_setlinecolor - :: (Ptr RawTArc) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_SetLineAttributes" + c_tarc_setlineattributes :: Ptr RawTArc -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_SetLineStyle" c_tarc_setlinestyle - :: (Ptr RawTArc) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_SetLineColor" + c_tarc_setlinecolor :: Ptr RawTArc -> CInt -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_SetLineWidth" c_tarc_setlinewidth - :: (Ptr RawTArc) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_SetLineStyle" + c_tarc_setlinestyle :: Ptr RawTArc -> CInt -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_SetFillColor" c_tarc_setfillcolor - :: (Ptr RawTArc) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_SetLineWidth" + c_tarc_setlinewidth :: Ptr RawTArc -> CInt -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_SetFillStyle" c_tarc_setfillstyle - :: (Ptr RawTArc) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_SetFillColor" + c_tarc_setfillcolor :: Ptr RawTArc -> CInt -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_delete" c_tarc_delete - :: (Ptr RawTArc) -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_SetFillStyle" + c_tarc_setfillstyle :: Ptr RawTArc -> CInt -> IO () -foreign import ccall "HROOTGrafTArc.h TArc_newTArc" c_tarc_newtarc - :: CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTArc) +foreign import ccall safe "HROOTGrafTArc.h TArc_delete" + c_tarc_delete :: Ptr RawTArc -> IO () +foreign import ccall safe "HROOTGrafTArc.h TArc_newTArc" + c_tarc_newtarc :: + CDouble -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTArc) diff --git a/src/HROOT/Graf/TArc/Implementation.hs b/src/HROOT/Graf/TArc/Implementation.hs --- a/src/HROOT/Graf/TArc/Implementation.hs +++ b/src/HROOT/Graf/TArc/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TArc.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TArc.RawType import HROOT.Graf.TArc.FFI import HROOT.Graf.TArc.Interface @@ -30,77 +31,37 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITArc TArc +instance ITEllipse TArc -instance ITArc TArc where -instance ITEllipse TArc where instance ITObject TArc where - draw = xform1 c_tarc_draw - findObject = xform1 c_tarc_findobject - getName = xform0 c_tarc_getname - isA = xform0 c_tarc_isa - paint = xform1 c_tarc_paint - printObj = xform1 c_tarc_printobj - saveAs = xform2 c_tarc_saveas - write = xform3 c_tarc_write -instance ITAttLine TArc where - getLineColor = xform0 c_tarc_getlinecolor - getLineStyle = xform0 c_tarc_getlinestyle - getLineWidth = xform0 c_tarc_getlinewidth - resetAttLine = xform1 c_tarc_resetattline - setLineAttributes = xform0 c_tarc_setlineattributes - setLineColor = xform1 c_tarc_setlinecolor - setLineStyle = xform1 c_tarc_setlinestyle - setLineWidth = xform1 c_tarc_setlinewidth -instance ITAttFill TArc where - setFillColor = xform1 c_tarc_setfillcolor - setFillStyle = xform1 c_tarc_setfillstyle -instance IDeletable TArc where - delete = xform0 c_tarc_delete - -instance ITArc (Exist TArc) where + draw = xform1 c_tarc_draw + findObject = xform1 c_tarc_findobject + getName = xform0 c_tarc_getname + isA = xform0 c_tarc_isa + paint = xform1 c_tarc_paint + printObj = xform1 c_tarc_printobj + saveAs = xform2 c_tarc_saveas + write = xform3 c_tarc_write -instance ITEllipse (Exist TArc) where +instance ITAttLine TArc where + getLineColor = xform0 c_tarc_getlinecolor + getLineStyle = xform0 c_tarc_getlinestyle + getLineWidth = xform0 c_tarc_getlinewidth + resetAttLine = xform1 c_tarc_resetattline + setLineAttributes = xform0 c_tarc_setlineattributes + setLineColor = xform1 c_tarc_setlinecolor + setLineStyle = xform1 c_tarc_setlinestyle + setLineWidth = xform1 c_tarc_setlinewidth -instance ITObject (Exist TArc) where - draw (ETArc x) = draw x - findObject (ETArc x) = findObject x - getName (ETArc x) = getName x - isA (ETArc x) = isA x - paint (ETArc x) = paint x - printObj (ETArc x) = printObj x - saveAs (ETArc x) = saveAs x - write (ETArc x) = write x -instance ITAttLine (Exist TArc) where - getLineColor (ETArc x) = getLineColor x - getLineStyle (ETArc x) = getLineStyle x - getLineWidth (ETArc x) = getLineWidth x - resetAttLine (ETArc x) = resetAttLine x - setLineAttributes (ETArc x) = setLineAttributes x - setLineColor (ETArc x) = setLineColor x - setLineStyle (ETArc x) = setLineStyle x - setLineWidth (ETArc x) = setLineWidth x -instance ITAttFill (Exist TArc) where - setFillColor (ETArc x) = setFillColor x - setFillStyle (ETArc x) = setFillStyle x -instance IDeletable (Exist TArc) where - delete (ETArc x) = delete x +instance ITAttFill TArc where + setFillColor = xform1 c_tarc_setfillcolor + setFillStyle = xform1 c_tarc_setfillstyle +instance IDeletable TArc where + delete = xform0 c_tarc_delete -newTArc :: CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO TArc +newTArc :: + CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO TArc newTArc = xform4 c_tarc_newtarc - - - - - -instance FPtr (Exist TArc) where - type Raw (Exist TArc) = RawTArc - get_fptr (ETArc obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETArc (cast_fptr_to_obj (fptr :: ForeignPtr RawTArc) :: TArc) diff --git a/src/HROOT/Graf/TArc/Interface.hs b/src/HROOT/Graf/TArc/Interface.hs --- a/src/HROOT/Graf/TArc/Interface.hs +++ b/src/HROOT/Graf/TArc/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TArc.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TArc.RawType - import HROOT.Graf.TEllipse.Interface ----- ============ ---- - - -class (ITEllipse a) => ITArc a where - -instance Existable TArc where - data Exist TArc = forall a. (FPtr a, ITArc a) => ETArc a +class ITEllipse a => ITArc a -upcastTArc :: (FPtr a, ITArc a) => a -> TArc -upcastTArc h = let fh = get_fptr h - fh2 :: ForeignPtr RawTArc = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTArc :: forall a . (FPtr a, ITArc a) => a -> TArc +upcastTArc h + = let fh = get_fptr h + fh2 :: Ptr RawTArc = castPtr fh + in cast_fptr_to_obj fh2 -downcastTArc :: (FPtr a, ITArc a) => TArc -> a -downcastTArc h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTArc :: forall a . (FPtr a, ITArc a) => TArc -> a +downcastTArc h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TArc/RawType.hs b/src/HROOT/Graf/TArc/RawType.hs --- a/src/HROOT/Graf/TArc/RawType.hs +++ b/src/HROOT/Graf/TArc/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TArc.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTArc -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TArc = TArc (Ptr RawTArc) + deriving (Eq, Ord, Show) -data RawTArc -newtype TArc = TArc (ForeignPtr RawTArc) deriving (Eq, Ord, Show) instance FPtr TArc where - type Raw TArc = RawTArc - get_fptr (TArc fptr) = fptr - cast_fptr_to_obj = TArc + type Raw TArc = RawTArc + get_fptr (TArc ptr) = ptr + cast_fptr_to_obj = TArc diff --git a/src/HROOT/Graf/TArrow.hs b/src/HROOT/Graf/TArrow.hs --- a/src/HROOT/Graf/TArrow.hs +++ b/src/HROOT/Graf/TArrow.hs @@ -1,15 +1,6 @@ module HROOT.Graf.TArrow - ( - TArrow(..) - , ITArrow - , upcastTArrow - , downcastTArrow - , newTArrow - - ) where - + (TArrow(..), ITArrow, upcastTArrow, downcastTArrow, newTArrow) + where import HROOT.Graf.TArrow.RawType import HROOT.Graf.TArrow.Interface import HROOT.Graf.TArrow.Implementation - - diff --git a/src/HROOT/Graf/TArrow/Cast.hs b/src/HROOT/Graf/TArrow/Cast.hs --- a/src/HROOT/Graf/TArrow/Cast.hs +++ b/src/HROOT/Graf/TArrow/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TArrow.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TArrow.RawType import HROOT.Graf.TArrow.Interface instance (ITArrow a, FPtr a) => Castable a (Ptr RawTArrow) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TArrow (Ptr RawTArrow) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TArrow/FFI.hsc b/src/HROOT/Graf/TArrow/FFI.hsc --- a/src/HROOT/Graf/TArrow/FFI.hsc +++ b/src/HROOT/Graf/TArrow/FFI.hsc @@ -1,105 +1,104 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TArrow.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TArrow.RawType import HROOT.Graf.TLine.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTArrow.h" - -foreign import ccall "HROOTGrafTArrow.h TArrow_DrawLine" c_tarrow_drawline - :: (Ptr RawTArrow) -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) - -foreign import ccall "HROOTGrafTArrow.h TArrow_DrawLineNDC" c_tarrow_drawlinendc - :: (Ptr RawTArrow) -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) +foreign import ccall safe "HROOTGrafTArrow.h TArrow_DrawLine" + c_tarrow_drawline :: + Ptr RawTArrow -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) -foreign import ccall "HROOTGrafTArrow.h TArrow_PaintLine" c_tarrow_paintline - :: (Ptr RawTArrow) -> CDouble -> CDouble -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_DrawLineNDC" + c_tarrow_drawlinendc :: + Ptr RawTArrow -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) -foreign import ccall "HROOTGrafTArrow.h TArrow_PaintLineNDC" c_tarrow_paintlinendc - :: (Ptr RawTArrow) -> CDouble -> CDouble -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_PaintLine" + c_tarrow_paintline :: + Ptr RawTArrow -> CDouble -> CDouble -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_SetX1" c_tarrow_setx1 - :: (Ptr RawTArrow) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_PaintLineNDC" + c_tarrow_paintlinendc :: + Ptr RawTArrow -> CDouble -> CDouble -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_SetX2" c_tarrow_setx2 - :: (Ptr RawTArrow) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_SetX1" + c_tarrow_setx1 :: Ptr RawTArrow -> CDouble -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_SetY1" c_tarrow_sety1 - :: (Ptr RawTArrow) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_SetX2" + c_tarrow_setx2 :: Ptr RawTArrow -> CDouble -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_SetY2" c_tarrow_sety2 - :: (Ptr RawTArrow) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_SetY1" + c_tarrow_sety1 :: Ptr RawTArrow -> CDouble -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_SetFillColor" c_tarrow_setfillcolor - :: (Ptr RawTArrow) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_SetY2" + c_tarrow_sety2 :: Ptr RawTArrow -> CDouble -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_SetFillStyle" c_tarrow_setfillstyle - :: (Ptr RawTArrow) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_SetFillColor" + c_tarrow_setfillcolor :: Ptr RawTArrow -> CInt -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_Draw" c_tarrow_draw - :: (Ptr RawTArrow) -> CString -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_SetFillStyle" + c_tarrow_setfillstyle :: Ptr RawTArrow -> CInt -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_FindObject" c_tarrow_findobject - :: (Ptr RawTArrow) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTArrow.h TArrow_Draw" + c_tarrow_draw :: Ptr RawTArrow -> CString -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_GetName" c_tarrow_getname - :: (Ptr RawTArrow) -> IO CString +foreign import ccall safe "HROOTGrafTArrow.h TArrow_FindObject" + c_tarrow_findobject :: + Ptr RawTArrow -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTArrow.h TArrow_IsA" c_tarrow_isa - :: (Ptr RawTArrow) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTArrow.h TArrow_GetName" + c_tarrow_getname :: Ptr RawTArrow -> IO CString -foreign import ccall "HROOTGrafTArrow.h TArrow_Paint" c_tarrow_paint - :: (Ptr RawTArrow) -> CString -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_IsA" + c_tarrow_isa :: Ptr RawTArrow -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTArrow.h TArrow_printObj" c_tarrow_printobj - :: (Ptr RawTArrow) -> CString -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_Paint" + c_tarrow_paint :: Ptr RawTArrow -> CString -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_SaveAs" c_tarrow_saveas - :: (Ptr RawTArrow) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_printObj" + c_tarrow_printobj :: Ptr RawTArrow -> CString -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_Write" c_tarrow_write - :: (Ptr RawTArrow) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTArrow.h TArrow_SaveAs" + c_tarrow_saveas :: Ptr RawTArrow -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_GetLineColor" c_tarrow_getlinecolor - :: (Ptr RawTArrow) -> IO CInt +foreign import ccall safe "HROOTGrafTArrow.h TArrow_Write" + c_tarrow_write :: + Ptr RawTArrow -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTArrow.h TArrow_GetLineStyle" c_tarrow_getlinestyle - :: (Ptr RawTArrow) -> IO CInt +foreign import ccall safe "HROOTGrafTArrow.h TArrow_GetLineColor" + c_tarrow_getlinecolor :: Ptr RawTArrow -> IO CInt -foreign import ccall "HROOTGrafTArrow.h TArrow_GetLineWidth" c_tarrow_getlinewidth - :: (Ptr RawTArrow) -> IO CInt +foreign import ccall safe "HROOTGrafTArrow.h TArrow_GetLineStyle" + c_tarrow_getlinestyle :: Ptr RawTArrow -> IO CInt -foreign import ccall "HROOTGrafTArrow.h TArrow_ResetAttLine" c_tarrow_resetattline - :: (Ptr RawTArrow) -> CString -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_GetLineWidth" + c_tarrow_getlinewidth :: Ptr RawTArrow -> IO CInt -foreign import ccall "HROOTGrafTArrow.h TArrow_SetLineAttributes" c_tarrow_setlineattributes - :: (Ptr RawTArrow) -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_ResetAttLine" + c_tarrow_resetattline :: Ptr RawTArrow -> CString -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_SetLineColor" c_tarrow_setlinecolor - :: (Ptr RawTArrow) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTArrow.h TArrow_SetLineAttributes" + c_tarrow_setlineattributes :: Ptr RawTArrow -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_SetLineStyle" c_tarrow_setlinestyle - :: (Ptr RawTArrow) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_SetLineColor" + c_tarrow_setlinecolor :: Ptr RawTArrow -> CInt -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_SetLineWidth" c_tarrow_setlinewidth - :: (Ptr RawTArrow) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_SetLineStyle" + c_tarrow_setlinestyle :: Ptr RawTArrow -> CInt -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_delete" c_tarrow_delete - :: (Ptr RawTArrow) -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_SetLineWidth" + c_tarrow_setlinewidth :: Ptr RawTArrow -> CInt -> IO () -foreign import ccall "HROOTGrafTArrow.h TArrow_newTArrow" c_tarrow_newtarrow - :: CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CString -> IO (Ptr RawTArrow) +foreign import ccall safe "HROOTGrafTArrow.h TArrow_delete" + c_tarrow_delete :: Ptr RawTArrow -> IO () +foreign import ccall safe "HROOTGrafTArrow.h TArrow_newTArrow" + c_tarrow_newtarrow :: + CDouble -> + CDouble -> + CDouble -> CDouble -> CDouble -> CString -> IO (Ptr RawTArrow) diff --git a/src/HROOT/Graf/TArrow/Implementation.hs b/src/HROOT/Graf/TArrow/Implementation.hs --- a/src/HROOT/Graf/TArrow/Implementation.hs +++ b/src/HROOT/Graf/TArrow/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TArrow.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TArrow.RawType import HROOT.Graf.TArrow.FFI import HROOT.Graf.TArrow.Interface @@ -30,92 +31,47 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITArrow TArrow -instance ITArrow TArrow where instance ITLine TArrow where - drawLine = xform4 c_tarrow_drawline - drawLineNDC = xform4 c_tarrow_drawlinendc - paintLine = xform4 c_tarrow_paintline - paintLineNDC = xform4 c_tarrow_paintlinendc - setX1 = xform1 c_tarrow_setx1 - setX2 = xform1 c_tarrow_setx2 - setY1 = xform1 c_tarrow_sety1 - setY2 = xform1 c_tarrow_sety2 + drawLine = xform4 c_tarrow_drawline + drawLineNDC = xform4 c_tarrow_drawlinendc + paintLine = xform4 c_tarrow_paintline + paintLineNDC = xform4 c_tarrow_paintlinendc + setX1 = xform1 c_tarrow_setx1 + setX2 = xform1 c_tarrow_setx2 + setY1 = xform1 c_tarrow_sety1 + setY2 = xform1 c_tarrow_sety2 + instance ITAttFill TArrow where - setFillColor = xform1 c_tarrow_setfillcolor - setFillStyle = xform1 c_tarrow_setfillstyle -instance ITObject TArrow where - draw = xform1 c_tarrow_draw - findObject = xform1 c_tarrow_findobject - getName = xform0 c_tarrow_getname - isA = xform0 c_tarrow_isa - paint = xform1 c_tarrow_paint - printObj = xform1 c_tarrow_printobj - saveAs = xform2 c_tarrow_saveas - write = xform3 c_tarrow_write -instance ITAttLine TArrow where - getLineColor = xform0 c_tarrow_getlinecolor - getLineStyle = xform0 c_tarrow_getlinestyle - getLineWidth = xform0 c_tarrow_getlinewidth - resetAttLine = xform1 c_tarrow_resetattline - setLineAttributes = xform0 c_tarrow_setlineattributes - setLineColor = xform1 c_tarrow_setlinecolor - setLineStyle = xform1 c_tarrow_setlinestyle - setLineWidth = xform1 c_tarrow_setlinewidth -instance IDeletable TArrow where - delete = xform0 c_tarrow_delete + setFillColor = xform1 c_tarrow_setfillcolor + setFillStyle = xform1 c_tarrow_setfillstyle -instance ITArrow (Exist TArrow) where +instance ITObject TArrow where + draw = xform1 c_tarrow_draw + findObject = xform1 c_tarrow_findobject + getName = xform0 c_tarrow_getname + isA = xform0 c_tarrow_isa + paint = xform1 c_tarrow_paint + printObj = xform1 c_tarrow_printobj + saveAs = xform2 c_tarrow_saveas + write = xform3 c_tarrow_write -instance ITLine (Exist TArrow) where - drawLine (ETArrow x) = drawLine x - drawLineNDC (ETArrow x) = drawLineNDC x - paintLine (ETArrow x) = paintLine x - paintLineNDC (ETArrow x) = paintLineNDC x - setX1 (ETArrow x) = setX1 x - setX2 (ETArrow x) = setX2 x - setY1 (ETArrow x) = setY1 x - setY2 (ETArrow x) = setY2 x -instance ITAttFill (Exist TArrow) where - setFillColor (ETArrow x) = setFillColor x - setFillStyle (ETArrow x) = setFillStyle x -instance ITObject (Exist TArrow) where - draw (ETArrow x) = draw x - findObject (ETArrow x) = findObject x - getName (ETArrow x) = getName x - isA (ETArrow x) = isA x - paint (ETArrow x) = paint x - printObj (ETArrow x) = printObj x - saveAs (ETArrow x) = saveAs x - write (ETArrow x) = write x -instance ITAttLine (Exist TArrow) where - getLineColor (ETArrow x) = getLineColor x - getLineStyle (ETArrow x) = getLineStyle x - getLineWidth (ETArrow x) = getLineWidth x - resetAttLine (ETArrow x) = resetAttLine x - setLineAttributes (ETArrow x) = setLineAttributes x - setLineColor (ETArrow x) = setLineColor x - setLineStyle (ETArrow x) = setLineStyle x - setLineWidth (ETArrow x) = setLineWidth x -instance IDeletable (Exist TArrow) where - delete (ETArrow x) = delete x +instance ITAttLine TArrow where + getLineColor = xform0 c_tarrow_getlinecolor + getLineStyle = xform0 c_tarrow_getlinestyle + getLineWidth = xform0 c_tarrow_getlinewidth + resetAttLine = xform1 c_tarrow_resetattline + setLineAttributes = xform0 c_tarrow_setlineattributes + setLineColor = xform1 c_tarrow_setlinecolor + setLineStyle = xform1 c_tarrow_setlinestyle + setLineWidth = xform1 c_tarrow_setlinewidth +instance IDeletable TArrow where + delete = xform0 c_tarrow_delete -newTArrow :: CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CString -> IO TArrow +newTArrow :: + Castable c0 CString => + CDouble -> + CDouble -> CDouble -> CDouble -> CDouble -> c0 -> IO TArrow newTArrow = xform5 c_tarrow_newtarrow - - - - - -instance FPtr (Exist TArrow) where - type Raw (Exist TArrow) = RawTArrow - get_fptr (ETArrow obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETArrow (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrow) :: TArrow) diff --git a/src/HROOT/Graf/TArrow/Interface.hs b/src/HROOT/Graf/TArrow/Interface.hs --- a/src/HROOT/Graf/TArrow/Interface.hs +++ b/src/HROOT/Graf/TArrow/Interface.hs @@ -1,37 +1,26 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TArrow.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TArrow.RawType - import HROOT.Graf.TLine.Interface import HROOT.Core.TAttFill.Interface ----- ============ ---- - - -class (ITLine a,ITAttFill a) => ITArrow a where - -instance Existable TArrow where - data Exist TArrow = forall a. (FPtr a, ITArrow a) => ETArrow a +class (ITLine a, ITAttFill a) => ITArrow a -upcastTArrow :: (FPtr a, ITArrow a) => a -> TArrow -upcastTArrow h = let fh = get_fptr h - fh2 :: ForeignPtr RawTArrow = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTArrow :: forall a . (FPtr a, ITArrow a) => a -> TArrow +upcastTArrow h + = let fh = get_fptr h + fh2 :: Ptr RawTArrow = castPtr fh + in cast_fptr_to_obj fh2 -downcastTArrow :: (FPtr a, ITArrow a) => TArrow -> a -downcastTArrow h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTArrow :: forall a . (FPtr a, ITArrow a) => TArrow -> a +downcastTArrow h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TArrow/RawType.hs b/src/HROOT/Graf/TArrow/RawType.hs --- a/src/HROOT/Graf/TArrow/RawType.hs +++ b/src/HROOT/Graf/TArrow/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TArrow.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTArrow -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TArrow = TArrow (Ptr RawTArrow) + deriving (Eq, Ord, Show) -data RawTArrow -newtype TArrow = TArrow (ForeignPtr RawTArrow) deriving (Eq, Ord, Show) instance FPtr TArrow where - type Raw TArrow = RawTArrow - get_fptr (TArrow fptr) = fptr - cast_fptr_to_obj = TArrow + type Raw TArrow = RawTArrow + get_fptr (TArrow ptr) = ptr + cast_fptr_to_obj = TArrow diff --git a/src/HROOT/Graf/TAttImage.hs b/src/HROOT/Graf/TAttImage.hs --- a/src/HROOT/Graf/TAttImage.hs +++ b/src/HROOT/Graf/TAttImage.hs @@ -1,15 +1,6 @@ module HROOT.Graf.TAttImage - ( - TAttImage(..) - , ITAttImage - , upcastTAttImage - , downcastTAttImage - - - ) where - + (TAttImage(..), ITAttImage, upcastTAttImage, downcastTAttImage) + where import HROOT.Graf.TAttImage.RawType import HROOT.Graf.TAttImage.Interface import HROOT.Graf.TAttImage.Implementation - - diff --git a/src/HROOT/Graf/TAttImage/Cast.hs b/src/HROOT/Graf/TAttImage/Cast.hs --- a/src/HROOT/Graf/TAttImage/Cast.hs +++ b/src/HROOT/Graf/TAttImage/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TAttImage.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TAttImage.RawType import HROOT.Graf.TAttImage.Interface -instance (ITAttImage a, FPtr a) => Castable a (Ptr RawTAttImage) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITAttImage a, FPtr a) => Castable a (Ptr RawTAttImage) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TAttImage (Ptr RawTAttImage) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TAttImage/FFI.hsc b/src/HROOT/Graf/TAttImage/FFI.hsc --- a/src/HROOT/Graf/TAttImage/FFI.hsc +++ b/src/HROOT/Graf/TAttImage/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TAttImage.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TAttImage.RawType - -#include "HROOTGrafTAttImage.h" - -foreign import ccall "HROOTGrafTAttImage.h TAttImage_delete" c_tattimage_delete - :: (Ptr RawTAttImage) -> IO () - +foreign import ccall safe "HROOTGrafTAttImage.h TAttImage_delete" + c_tattimage_delete :: Ptr RawTAttImage -> IO () diff --git a/src/HROOT/Graf/TAttImage/Implementation.hs b/src/HROOT/Graf/TAttImage/Implementation.hs --- a/src/HROOT/Graf/TAttImage/Implementation.hs +++ b/src/HROOT/Graf/TAttImage/Implementation.hs @@ -1,45 +1,22 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TAttImage.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TAttImage.RawType import HROOT.Graf.TAttImage.FFI import HROOT.Graf.TAttImage.Interface import HROOT.Graf.TAttImage.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITAttImage TAttImage -instance ITAttImage TAttImage where instance IDeletable TAttImage where - delete = xform0 c_tattimage_delete - -instance ITAttImage (Exist TAttImage) where - -instance IDeletable (Exist TAttImage) where - delete (ETAttImage x) = delete x - - - - - - - -instance FPtr (Exist TAttImage) where - type Raw (Exist TAttImage) = RawTAttImage - get_fptr (ETAttImage obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETAttImage (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttImage) :: TAttImage) + delete = xform0 c_tattimage_delete diff --git a/src/HROOT/Graf/TAttImage/Interface.hs b/src/HROOT/Graf/TAttImage/Interface.hs --- a/src/HROOT/Graf/TAttImage/Interface.hs +++ b/src/HROOT/Graf/TAttImage/Interface.hs @@ -1,36 +1,27 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TAttImage.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TAttImage.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITAttImage a where - -instance Existable TAttImage where - data Exist TAttImage = forall a. (FPtr a, ITAttImage a) => ETAttImage a +class IDeletable a => ITAttImage a -upcastTAttImage :: (FPtr a, ITAttImage a) => a -> TAttImage -upcastTAttImage h = let fh = get_fptr h - fh2 :: ForeignPtr RawTAttImage = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTAttImage :: + forall a . (FPtr a, ITAttImage a) => a -> TAttImage +upcastTAttImage h + = let fh = get_fptr h + fh2 :: Ptr RawTAttImage = castPtr fh + in cast_fptr_to_obj fh2 -downcastTAttImage :: (FPtr a, ITAttImage a) => TAttImage -> a -downcastTAttImage h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTAttImage :: + forall a . (FPtr a, ITAttImage a) => TAttImage -> a +downcastTAttImage h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TAttImage/RawType.hs b/src/HROOT/Graf/TAttImage/RawType.hs --- a/src/HROOT/Graf/TAttImage/RawType.hs +++ b/src/HROOT/Graf/TAttImage/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TAttImage.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTAttImage -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TAttImage = TAttImage (Ptr RawTAttImage) + deriving (Eq, Ord, Show) -data RawTAttImage -newtype TAttImage = TAttImage (ForeignPtr RawTAttImage) deriving (Eq, Ord, Show) instance FPtr TAttImage where - type Raw TAttImage = RawTAttImage - get_fptr (TAttImage fptr) = fptr - cast_fptr_to_obj = TAttImage + type Raw TAttImage = RawTAttImage + get_fptr (TAttImage ptr) = ptr + cast_fptr_to_obj = TAttImage diff --git a/src/HROOT/Graf/TBRIK.hs b/src/HROOT/Graf/TBRIK.hs --- a/src/HROOT/Graf/TBRIK.hs +++ b/src/HROOT/Graf/TBRIK.hs @@ -1,15 +1,5 @@ module HROOT.Graf.TBRIK - ( - TBRIK(..) - , ITBRIK - , upcastTBRIK - , downcastTBRIK - , newTBRIK - - ) where - + (TBRIK(..), ITBRIK, upcastTBRIK, downcastTBRIK, newTBRIK) where import HROOT.Graf.TBRIK.RawType import HROOT.Graf.TBRIK.Interface import HROOT.Graf.TBRIK.Implementation - - diff --git a/src/HROOT/Graf/TBRIK/Cast.hs b/src/HROOT/Graf/TBRIK/Cast.hs --- a/src/HROOT/Graf/TBRIK/Cast.hs +++ b/src/HROOT/Graf/TBRIK/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TBRIK.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TBRIK.RawType import HROOT.Graf.TBRIK.Interface instance (ITBRIK a, FPtr a) => Castable a (Ptr RawTBRIK) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TBRIK (Ptr RawTBRIK) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TBRIK/FFI.hsc b/src/HROOT/Graf/TBRIK/FFI.hsc --- a/src/HROOT/Graf/TBRIK/FFI.hsc +++ b/src/HROOT/Graf/TBRIK/FFI.hsc @@ -1,89 +1,81 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TBRIK.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TBRIK.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTBRIK.h" - -foreign import ccall "HROOTGrafTBRIK.h TBRIK_SetName" c_tbrik_setname - :: (Ptr RawTBRIK) -> CString -> IO () - -foreign import ccall "HROOTGrafTBRIK.h TBRIK_SetNameTitle" c_tbrik_setnametitle - :: (Ptr RawTBRIK) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_SetName" + c_tbrik_setname :: Ptr RawTBRIK -> CString -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_SetTitle" c_tbrik_settitle - :: (Ptr RawTBRIK) -> CString -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_SetNameTitle" + c_tbrik_setnametitle :: Ptr RawTBRIK -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_GetLineColor" c_tbrik_getlinecolor - :: (Ptr RawTBRIK) -> IO CInt +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_SetTitle" + c_tbrik_settitle :: Ptr RawTBRIK -> CString -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_GetLineStyle" c_tbrik_getlinestyle - :: (Ptr RawTBRIK) -> IO CInt +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_GetLineColor" + c_tbrik_getlinecolor :: Ptr RawTBRIK -> IO CInt -foreign import ccall "HROOTGrafTBRIK.h TBRIK_GetLineWidth" c_tbrik_getlinewidth - :: (Ptr RawTBRIK) -> IO CInt +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_GetLineStyle" + c_tbrik_getlinestyle :: Ptr RawTBRIK -> IO CInt -foreign import ccall "HROOTGrafTBRIK.h TBRIK_ResetAttLine" c_tbrik_resetattline - :: (Ptr RawTBRIK) -> CString -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_GetLineWidth" + c_tbrik_getlinewidth :: Ptr RawTBRIK -> IO CInt -foreign import ccall "HROOTGrafTBRIK.h TBRIK_SetLineAttributes" c_tbrik_setlineattributes - :: (Ptr RawTBRIK) -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_ResetAttLine" + c_tbrik_resetattline :: Ptr RawTBRIK -> CString -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_SetLineColor" c_tbrik_setlinecolor - :: (Ptr RawTBRIK) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTBRIK.h TBRIK_SetLineAttributes" + c_tbrik_setlineattributes :: Ptr RawTBRIK -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_SetLineStyle" c_tbrik_setlinestyle - :: (Ptr RawTBRIK) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_SetLineColor" + c_tbrik_setlinecolor :: Ptr RawTBRIK -> CInt -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_SetLineWidth" c_tbrik_setlinewidth - :: (Ptr RawTBRIK) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_SetLineStyle" + c_tbrik_setlinestyle :: Ptr RawTBRIK -> CInt -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_SetFillColor" c_tbrik_setfillcolor - :: (Ptr RawTBRIK) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_SetLineWidth" + c_tbrik_setlinewidth :: Ptr RawTBRIK -> CInt -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_SetFillStyle" c_tbrik_setfillstyle - :: (Ptr RawTBRIK) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_SetFillColor" + c_tbrik_setfillcolor :: Ptr RawTBRIK -> CInt -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_Draw" c_tbrik_draw - :: (Ptr RawTBRIK) -> CString -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_SetFillStyle" + c_tbrik_setfillstyle :: Ptr RawTBRIK -> CInt -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_FindObject" c_tbrik_findobject - :: (Ptr RawTBRIK) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_Draw" + c_tbrik_draw :: Ptr RawTBRIK -> CString -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_GetName" c_tbrik_getname - :: (Ptr RawTBRIK) -> IO CString +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_FindObject" + c_tbrik_findobject :: + Ptr RawTBRIK -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTBRIK.h TBRIK_IsA" c_tbrik_isa - :: (Ptr RawTBRIK) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_GetName" + c_tbrik_getname :: Ptr RawTBRIK -> IO CString -foreign import ccall "HROOTGrafTBRIK.h TBRIK_Paint" c_tbrik_paint - :: (Ptr RawTBRIK) -> CString -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_IsA" c_tbrik_isa + :: Ptr RawTBRIK -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTBRIK.h TBRIK_printObj" c_tbrik_printobj - :: (Ptr RawTBRIK) -> CString -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_Paint" + c_tbrik_paint :: Ptr RawTBRIK -> CString -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_SaveAs" c_tbrik_saveas - :: (Ptr RawTBRIK) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_printObj" + c_tbrik_printobj :: Ptr RawTBRIK -> CString -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_Write" c_tbrik_write - :: (Ptr RawTBRIK) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_SaveAs" + c_tbrik_saveas :: Ptr RawTBRIK -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTBRIK.h TBRIK_delete" c_tbrik_delete - :: (Ptr RawTBRIK) -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_Write" + c_tbrik_write :: Ptr RawTBRIK -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTBRIK.h TBRIK_newTBRIK" c_tbrik_newtbrik - :: CString -> CString -> CString -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTBRIK) +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_delete" + c_tbrik_delete :: Ptr RawTBRIK -> IO () +foreign import ccall safe "HROOTGrafTBRIK.h TBRIK_newTBRIK" + c_tbrik_newtbrik :: + CString -> + CString -> + CString -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTBRIK) diff --git a/src/HROOT/Graf/TBRIK/Implementation.hs b/src/HROOT/Graf/TBRIK/Implementation.hs --- a/src/HROOT/Graf/TBRIK/Implementation.hs +++ b/src/HROOT/Graf/TBRIK/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TBRIK.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TBRIK.RawType import HROOT.Graf.TBRIK.FFI import HROOT.Graf.TBRIK.Interface @@ -36,88 +37,45 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITBRIK TBRIK +instance ITShape TBRIK -instance ITBRIK TBRIK where -instance ITShape TBRIK where instance ITNamed TBRIK where - setName = xform1 c_tbrik_setname - setNameTitle = xform2 c_tbrik_setnametitle - setTitle = xform1 c_tbrik_settitle -instance ITAttLine TBRIK where - getLineColor = xform0 c_tbrik_getlinecolor - getLineStyle = xform0 c_tbrik_getlinestyle - getLineWidth = xform0 c_tbrik_getlinewidth - resetAttLine = xform1 c_tbrik_resetattline - setLineAttributes = xform0 c_tbrik_setlineattributes - setLineColor = xform1 c_tbrik_setlinecolor - setLineStyle = xform1 c_tbrik_setlinestyle - setLineWidth = xform1 c_tbrik_setlinewidth -instance ITAttFill TBRIK where - setFillColor = xform1 c_tbrik_setfillcolor - setFillStyle = xform1 c_tbrik_setfillstyle -instance ITAtt3D TBRIK where -instance ITObject TBRIK where - draw = xform1 c_tbrik_draw - findObject = xform1 c_tbrik_findobject - getName = xform0 c_tbrik_getname - isA = xform0 c_tbrik_isa - paint = xform1 c_tbrik_paint - printObj = xform1 c_tbrik_printobj - saveAs = xform2 c_tbrik_saveas - write = xform3 c_tbrik_write -instance IDeletable TBRIK where - delete = xform0 c_tbrik_delete + setName = xform1 c_tbrik_setname + setNameTitle = xform2 c_tbrik_setnametitle + setTitle = xform1 c_tbrik_settitle -instance ITBRIK (Exist TBRIK) where +instance ITAttLine TBRIK where + getLineColor = xform0 c_tbrik_getlinecolor + getLineStyle = xform0 c_tbrik_getlinestyle + getLineWidth = xform0 c_tbrik_getlinewidth + resetAttLine = xform1 c_tbrik_resetattline + setLineAttributes = xform0 c_tbrik_setlineattributes + setLineColor = xform1 c_tbrik_setlinecolor + setLineStyle = xform1 c_tbrik_setlinestyle + setLineWidth = xform1 c_tbrik_setlinewidth -instance ITShape (Exist TBRIK) where +instance ITAttFill TBRIK where + setFillColor = xform1 c_tbrik_setfillcolor + setFillStyle = xform1 c_tbrik_setfillstyle -instance ITNamed (Exist TBRIK) where - setName (ETBRIK x) = setName x - setNameTitle (ETBRIK x) = setNameTitle x - setTitle (ETBRIK x) = setTitle x -instance ITAttLine (Exist TBRIK) where - getLineColor (ETBRIK x) = getLineColor x - getLineStyle (ETBRIK x) = getLineStyle x - getLineWidth (ETBRIK x) = getLineWidth x - resetAttLine (ETBRIK x) = resetAttLine x - setLineAttributes (ETBRIK x) = setLineAttributes x - setLineColor (ETBRIK x) = setLineColor x - setLineStyle (ETBRIK x) = setLineStyle x - setLineWidth (ETBRIK x) = setLineWidth x -instance ITAttFill (Exist TBRIK) where - setFillColor (ETBRIK x) = setFillColor x - setFillStyle (ETBRIK x) = setFillStyle x -instance ITAtt3D (Exist TBRIK) where +instance ITAtt3D TBRIK -instance ITObject (Exist TBRIK) where - draw (ETBRIK x) = draw x - findObject (ETBRIK x) = findObject x - getName (ETBRIK x) = getName x - isA (ETBRIK x) = isA x - paint (ETBRIK x) = paint x - printObj (ETBRIK x) = printObj x - saveAs (ETBRIK x) = saveAs x - write (ETBRIK x) = write x -instance IDeletable (Exist TBRIK) where - delete (ETBRIK x) = delete x +instance ITObject TBRIK where + draw = xform1 c_tbrik_draw + findObject = xform1 c_tbrik_findobject + getName = xform0 c_tbrik_getname + isA = xform0 c_tbrik_isa + paint = xform1 c_tbrik_paint + printObj = xform1 c_tbrik_printobj + saveAs = xform2 c_tbrik_saveas + write = xform3 c_tbrik_write +instance IDeletable TBRIK where + delete = xform0 c_tbrik_delete -newTBRIK :: CString -> CString -> CString -> CDouble -> CDouble -> CDouble -> IO TBRIK +newTBRIK :: + (Castable c2 CString, Castable c1 CString, Castable c0 CString) => + c0 -> c1 -> c2 -> CDouble -> CDouble -> CDouble -> IO TBRIK newTBRIK = xform5 c_tbrik_newtbrik - - - - - -instance FPtr (Exist TBRIK) where - type Raw (Exist TBRIK) = RawTBRIK - get_fptr (ETBRIK obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETBRIK (cast_fptr_to_obj (fptr :: ForeignPtr RawTBRIK) :: TBRIK) diff --git a/src/HROOT/Graf/TBRIK/Interface.hs b/src/HROOT/Graf/TBRIK/Interface.hs --- a/src/HROOT/Graf/TBRIK/Interface.hs +++ b/src/HROOT/Graf/TBRIK/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TBRIK.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TBRIK.RawType - import HROOT.Graf.TShape.Interface ----- ============ ---- - - -class (ITShape a) => ITBRIK a where - -instance Existable TBRIK where - data Exist TBRIK = forall a. (FPtr a, ITBRIK a) => ETBRIK a +class ITShape a => ITBRIK a -upcastTBRIK :: (FPtr a, ITBRIK a) => a -> TBRIK -upcastTBRIK h = let fh = get_fptr h - fh2 :: ForeignPtr RawTBRIK = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTBRIK :: forall a . (FPtr a, ITBRIK a) => a -> TBRIK +upcastTBRIK h + = let fh = get_fptr h + fh2 :: Ptr RawTBRIK = castPtr fh + in cast_fptr_to_obj fh2 -downcastTBRIK :: (FPtr a, ITBRIK a) => TBRIK -> a -downcastTBRIK h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTBRIK :: forall a . (FPtr a, ITBRIK a) => TBRIK -> a +downcastTBRIK h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TBRIK/RawType.hs b/src/HROOT/Graf/TBRIK/RawType.hs --- a/src/HROOT/Graf/TBRIK/RawType.hs +++ b/src/HROOT/Graf/TBRIK/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TBRIK.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTBRIK -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TBRIK = TBRIK (Ptr RawTBRIK) + deriving (Eq, Ord, Show) -data RawTBRIK -newtype TBRIK = TBRIK (ForeignPtr RawTBRIK) deriving (Eq, Ord, Show) instance FPtr TBRIK where - type Raw TBRIK = RawTBRIK - get_fptr (TBRIK fptr) = fptr - cast_fptr_to_obj = TBRIK + type Raw TBRIK = RawTBRIK + get_fptr (TBRIK ptr) = ptr + cast_fptr_to_obj = TBRIK diff --git a/src/HROOT/Graf/TCanvas.hs b/src/HROOT/Graf/TCanvas.hs --- a/src/HROOT/Graf/TCanvas.hs +++ b/src/HROOT/Graf/TCanvas.hs @@ -1,15 +1,6 @@ module HROOT.Graf.TCanvas - ( - TCanvas(..) - , ITCanvas - , upcastTCanvas - , downcastTCanvas - , newTCanvas - - ) where - + (TCanvas(..), ITCanvas, upcastTCanvas, downcastTCanvas, newTCanvas) + where import HROOT.Graf.TCanvas.RawType import HROOT.Graf.TCanvas.Interface import HROOT.Graf.TCanvas.Implementation - - diff --git a/src/HROOT/Graf/TCanvas/Cast.hs b/src/HROOT/Graf/TCanvas/Cast.hs --- a/src/HROOT/Graf/TCanvas/Cast.hs +++ b/src/HROOT/Graf/TCanvas/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TCanvas.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TCanvas.RawType import HROOT.Graf.TCanvas.Interface instance (ITCanvas a, FPtr a) => Castable a (Ptr RawTCanvas) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TCanvas (Ptr RawTCanvas) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TCanvas/FFI.hsc b/src/HROOT/Graf/TCanvas/FFI.hsc --- a/src/HROOT/Graf/TCanvas/FFI.hsc +++ b/src/HROOT/Graf/TCanvas/FFI.hsc @@ -1,65 +1,58 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TCanvas.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TCanvas.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTCanvas.h" - -foreign import ccall "HROOTGrafTCanvas.h TCanvas_cd" c_tcanvas_cd - :: (Ptr RawTCanvas) -> CInt -> IO (Ptr RawTCanvas) - -foreign import ccall "HROOTGrafTCanvas.h TCanvas_divide_tvirtualpad" c_tcanvas_divide_tvirtualpad - :: (Ptr RawTCanvas) -> CInt -> CInt -> CDouble -> CDouble -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_cd" + c_tcanvas_cd :: Ptr RawTCanvas -> CInt -> IO (Ptr RawTCanvas) -foreign import ccall "HROOTGrafTCanvas.h TCanvas_SetLogx" c_tcanvas_setlogx - :: (Ptr RawTCanvas) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTCanvas.h TCanvas_divide_tvirtualpad" + c_tcanvas_divide_tvirtualpad :: + Ptr RawTCanvas -> + CInt -> CInt -> CDouble -> CDouble -> CInt -> IO () -foreign import ccall "HROOTGrafTCanvas.h TCanvas_SetLogy" c_tcanvas_setlogy - :: (Ptr RawTCanvas) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_SetLogx" + c_tcanvas_setlogx :: Ptr RawTCanvas -> CInt -> IO () -foreign import ccall "HROOTGrafTCanvas.h TCanvas_SetLogz" c_tcanvas_setlogz - :: (Ptr RawTCanvas) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_SetLogy" + c_tcanvas_setlogy :: Ptr RawTCanvas -> CInt -> IO () -foreign import ccall "HROOTGrafTCanvas.h TCanvas_Draw" c_tcanvas_draw - :: (Ptr RawTCanvas) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_SetLogz" + c_tcanvas_setlogz :: Ptr RawTCanvas -> CInt -> IO () -foreign import ccall "HROOTGrafTCanvas.h TCanvas_FindObject" c_tcanvas_findobject - :: (Ptr RawTCanvas) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_Draw" + c_tcanvas_draw :: Ptr RawTCanvas -> CString -> IO () -foreign import ccall "HROOTGrafTCanvas.h TCanvas_GetName" c_tcanvas_getname - :: (Ptr RawTCanvas) -> IO CString +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_FindObject" + c_tcanvas_findobject :: + Ptr RawTCanvas -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTCanvas.h TCanvas_IsA" c_tcanvas_isa - :: (Ptr RawTCanvas) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_GetName" + c_tcanvas_getname :: Ptr RawTCanvas -> IO CString -foreign import ccall "HROOTGrafTCanvas.h TCanvas_Paint" c_tcanvas_paint - :: (Ptr RawTCanvas) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_IsA" + c_tcanvas_isa :: Ptr RawTCanvas -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTCanvas.h TCanvas_printObj" c_tcanvas_printobj - :: (Ptr RawTCanvas) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_Paint" + c_tcanvas_paint :: Ptr RawTCanvas -> CString -> IO () -foreign import ccall "HROOTGrafTCanvas.h TCanvas_SaveAs" c_tcanvas_saveas - :: (Ptr RawTCanvas) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_printObj" + c_tcanvas_printobj :: Ptr RawTCanvas -> CString -> IO () -foreign import ccall "HROOTGrafTCanvas.h TCanvas_Write" c_tcanvas_write - :: (Ptr RawTCanvas) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_SaveAs" + c_tcanvas_saveas :: Ptr RawTCanvas -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTCanvas.h TCanvas_delete" c_tcanvas_delete - :: (Ptr RawTCanvas) -> IO () +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_Write" + c_tcanvas_write :: + Ptr RawTCanvas -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTCanvas.h TCanvas_newTCanvas" c_tcanvas_newtcanvas - :: CString -> CString -> CInt -> CInt -> IO (Ptr RawTCanvas) +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_delete" + c_tcanvas_delete :: Ptr RawTCanvas -> IO () +foreign import ccall safe "HROOTGrafTCanvas.h TCanvas_newTCanvas" + c_tcanvas_newtcanvas :: + CString -> CString -> CInt -> CInt -> IO (Ptr RawTCanvas) diff --git a/src/HROOT/Graf/TCanvas/Implementation.hs b/src/HROOT/Graf/TCanvas/Implementation.hs --- a/src/HROOT/Graf/TCanvas/Implementation.hs +++ b/src/HROOT/Graf/TCanvas/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TCanvas.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TCanvas.RawType import HROOT.Graf.TCanvas.FFI import HROOT.Graf.TCanvas.Interface @@ -27,65 +28,31 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITCanvas TCanvas +instance ITPad TCanvas -instance ITCanvas TCanvas where -instance ITPad TCanvas where instance ITVirtualPad TCanvas where - cd = xform1 c_tcanvas_cd - divide_tvirtualpad = xform5 c_tcanvas_divide_tvirtualpad - setLogx = xform1 c_tcanvas_setlogx - setLogy = xform1 c_tcanvas_setlogy - setLogz = xform1 c_tcanvas_setlogz -instance ITObject TCanvas where - draw = xform1 c_tcanvas_draw - findObject = xform1 c_tcanvas_findobject - getName = xform0 c_tcanvas_getname - isA = xform0 c_tcanvas_isa - paint = xform1 c_tcanvas_paint - printObj = xform1 c_tcanvas_printobj - saveAs = xform2 c_tcanvas_saveas - write = xform3 c_tcanvas_write -instance IDeletable TCanvas where - delete = xform0 c_tcanvas_delete - -instance ITCanvas (Exist TCanvas) where - -instance ITPad (Exist TCanvas) where + cd = xform1 c_tcanvas_cd + divide_tvirtualpad = xform5 c_tcanvas_divide_tvirtualpad + setLogx = xform1 c_tcanvas_setlogx + setLogy = xform1 c_tcanvas_setlogy + setLogz = xform1 c_tcanvas_setlogz -instance ITVirtualPad (Exist TCanvas) where - cd (ETCanvas x) a1 = return . ETCanvas =<< cd x a1 - divide_tvirtualpad (ETCanvas x) = divide_tvirtualpad x - setLogx (ETCanvas x) = setLogx x - setLogy (ETCanvas x) = setLogy x - setLogz (ETCanvas x) = setLogz x -instance ITObject (Exist TCanvas) where - draw (ETCanvas x) = draw x - findObject (ETCanvas x) = findObject x - getName (ETCanvas x) = getName x - isA (ETCanvas x) = isA x - paint (ETCanvas x) = paint x - printObj (ETCanvas x) = printObj x - saveAs (ETCanvas x) = saveAs x - write (ETCanvas x) = write x -instance IDeletable (Exist TCanvas) where - delete (ETCanvas x) = delete x +instance ITObject TCanvas where + draw = xform1 c_tcanvas_draw + findObject = xform1 c_tcanvas_findobject + getName = xform0 c_tcanvas_getname + isA = xform0 c_tcanvas_isa + paint = xform1 c_tcanvas_paint + printObj = xform1 c_tcanvas_printobj + saveAs = xform2 c_tcanvas_saveas + write = xform3 c_tcanvas_write +instance IDeletable TCanvas where + delete = xform0 c_tcanvas_delete -newTCanvas :: CString -> CString -> CInt -> CInt -> IO TCanvas +newTCanvas :: + (Castable c1 CString, Castable c0 CString) => + c0 -> c1 -> CInt -> CInt -> IO TCanvas newTCanvas = xform3 c_tcanvas_newtcanvas - - - - - -instance FPtr (Exist TCanvas) where - type Raw (Exist TCanvas) = RawTCanvas - get_fptr (ETCanvas obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETCanvas (cast_fptr_to_obj (fptr :: ForeignPtr RawTCanvas) :: TCanvas) diff --git a/src/HROOT/Graf/TCanvas/Interface.hs b/src/HROOT/Graf/TCanvas/Interface.hs --- a/src/HROOT/Graf/TCanvas/Interface.hs +++ b/src/HROOT/Graf/TCanvas/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TCanvas.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TCanvas.RawType - import HROOT.Graf.TPad.Interface ----- ============ ---- - - -class (ITPad a) => ITCanvas a where - -instance Existable TCanvas where - data Exist TCanvas = forall a. (FPtr a, ITCanvas a) => ETCanvas a +class ITPad a => ITCanvas a -upcastTCanvas :: (FPtr a, ITCanvas a) => a -> TCanvas -upcastTCanvas h = let fh = get_fptr h - fh2 :: ForeignPtr RawTCanvas = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTCanvas :: forall a . (FPtr a, ITCanvas a) => a -> TCanvas +upcastTCanvas h + = let fh = get_fptr h + fh2 :: Ptr RawTCanvas = castPtr fh + in cast_fptr_to_obj fh2 -downcastTCanvas :: (FPtr a, ITCanvas a) => TCanvas -> a -downcastTCanvas h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTCanvas :: forall a . (FPtr a, ITCanvas a) => TCanvas -> a +downcastTCanvas h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TCanvas/RawType.hs b/src/HROOT/Graf/TCanvas/RawType.hs --- a/src/HROOT/Graf/TCanvas/RawType.hs +++ b/src/HROOT/Graf/TCanvas/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TCanvas.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTCanvas -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TCanvas = TCanvas (Ptr RawTCanvas) + deriving (Eq, Ord, Show) -data RawTCanvas -newtype TCanvas = TCanvas (ForeignPtr RawTCanvas) deriving (Eq, Ord, Show) instance FPtr TCanvas where - type Raw TCanvas = RawTCanvas - get_fptr (TCanvas fptr) = fptr - cast_fptr_to_obj = TCanvas + type Raw TCanvas = RawTCanvas + get_fptr (TCanvas ptr) = ptr + cast_fptr_to_obj = TCanvas diff --git a/src/HROOT/Graf/TCrown.hs b/src/HROOT/Graf/TCrown.hs --- a/src/HROOT/Graf/TCrown.hs +++ b/src/HROOT/Graf/TCrown.hs @@ -1,15 +1,6 @@ module HROOT.Graf.TCrown - ( - TCrown(..) - , ITCrown - , upcastTCrown - , downcastTCrown - , newTCrown - - ) where - + (TCrown(..), ITCrown, upcastTCrown, downcastTCrown, newTCrown) + where import HROOT.Graf.TCrown.RawType import HROOT.Graf.TCrown.Interface import HROOT.Graf.TCrown.Implementation - - diff --git a/src/HROOT/Graf/TCrown/Cast.hs b/src/HROOT/Graf/TCrown/Cast.hs --- a/src/HROOT/Graf/TCrown/Cast.hs +++ b/src/HROOT/Graf/TCrown/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TCrown.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TCrown.RawType import HROOT.Graf.TCrown.Interface instance (ITCrown a, FPtr a) => Castable a (Ptr RawTCrown) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TCrown (Ptr RawTCrown) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TCrown/FFI.hsc b/src/HROOT/Graf/TCrown/FFI.hsc --- a/src/HROOT/Graf/TCrown/FFI.hsc +++ b/src/HROOT/Graf/TCrown/FFI.hsc @@ -1,80 +1,73 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TCrown.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TCrown.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTCrown.h" - -foreign import ccall "HROOTGrafTCrown.h TCrown_Draw" c_tcrown_draw - :: (Ptr RawTCrown) -> CString -> IO () - -foreign import ccall "HROOTGrafTCrown.h TCrown_FindObject" c_tcrown_findobject - :: (Ptr RawTCrown) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTCrown.h TCrown_Draw" + c_tcrown_draw :: Ptr RawTCrown -> CString -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_GetName" c_tcrown_getname - :: (Ptr RawTCrown) -> IO CString +foreign import ccall safe "HROOTGrafTCrown.h TCrown_FindObject" + c_tcrown_findobject :: + Ptr RawTCrown -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTCrown.h TCrown_IsA" c_tcrown_isa - :: (Ptr RawTCrown) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTCrown.h TCrown_GetName" + c_tcrown_getname :: Ptr RawTCrown -> IO CString -foreign import ccall "HROOTGrafTCrown.h TCrown_Paint" c_tcrown_paint - :: (Ptr RawTCrown) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_IsA" + c_tcrown_isa :: Ptr RawTCrown -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTCrown.h TCrown_printObj" c_tcrown_printobj - :: (Ptr RawTCrown) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_Paint" + c_tcrown_paint :: Ptr RawTCrown -> CString -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_SaveAs" c_tcrown_saveas - :: (Ptr RawTCrown) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_printObj" + c_tcrown_printobj :: Ptr RawTCrown -> CString -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_Write" c_tcrown_write - :: (Ptr RawTCrown) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTCrown.h TCrown_SaveAs" + c_tcrown_saveas :: Ptr RawTCrown -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_GetLineColor" c_tcrown_getlinecolor - :: (Ptr RawTCrown) -> IO CInt +foreign import ccall safe "HROOTGrafTCrown.h TCrown_Write" + c_tcrown_write :: + Ptr RawTCrown -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTCrown.h TCrown_GetLineStyle" c_tcrown_getlinestyle - :: (Ptr RawTCrown) -> IO CInt +foreign import ccall safe "HROOTGrafTCrown.h TCrown_GetLineColor" + c_tcrown_getlinecolor :: Ptr RawTCrown -> IO CInt -foreign import ccall "HROOTGrafTCrown.h TCrown_GetLineWidth" c_tcrown_getlinewidth - :: (Ptr RawTCrown) -> IO CInt +foreign import ccall safe "HROOTGrafTCrown.h TCrown_GetLineStyle" + c_tcrown_getlinestyle :: Ptr RawTCrown -> IO CInt -foreign import ccall "HROOTGrafTCrown.h TCrown_ResetAttLine" c_tcrown_resetattline - :: (Ptr RawTCrown) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_GetLineWidth" + c_tcrown_getlinewidth :: Ptr RawTCrown -> IO CInt -foreign import ccall "HROOTGrafTCrown.h TCrown_SetLineAttributes" c_tcrown_setlineattributes - :: (Ptr RawTCrown) -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_ResetAttLine" + c_tcrown_resetattline :: Ptr RawTCrown -> CString -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_SetLineColor" c_tcrown_setlinecolor - :: (Ptr RawTCrown) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTCrown.h TCrown_SetLineAttributes" + c_tcrown_setlineattributes :: Ptr RawTCrown -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_SetLineStyle" c_tcrown_setlinestyle - :: (Ptr RawTCrown) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_SetLineColor" + c_tcrown_setlinecolor :: Ptr RawTCrown -> CInt -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_SetLineWidth" c_tcrown_setlinewidth - :: (Ptr RawTCrown) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_SetLineStyle" + c_tcrown_setlinestyle :: Ptr RawTCrown -> CInt -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_SetFillColor" c_tcrown_setfillcolor - :: (Ptr RawTCrown) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_SetLineWidth" + c_tcrown_setlinewidth :: Ptr RawTCrown -> CInt -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_SetFillStyle" c_tcrown_setfillstyle - :: (Ptr RawTCrown) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_SetFillColor" + c_tcrown_setfillcolor :: Ptr RawTCrown -> CInt -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_delete" c_tcrown_delete - :: (Ptr RawTCrown) -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_SetFillStyle" + c_tcrown_setfillstyle :: Ptr RawTCrown -> CInt -> IO () -foreign import ccall "HROOTGrafTCrown.h TCrown_newTCrown" c_tcrown_newtcrown - :: CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTCrown) +foreign import ccall safe "HROOTGrafTCrown.h TCrown_delete" + c_tcrown_delete :: Ptr RawTCrown -> IO () +foreign import ccall safe "HROOTGrafTCrown.h TCrown_newTCrown" + c_tcrown_newtcrown :: + CDouble -> + CDouble -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTCrown) diff --git a/src/HROOT/Graf/TCrown/Implementation.hs b/src/HROOT/Graf/TCrown/Implementation.hs --- a/src/HROOT/Graf/TCrown/Implementation.hs +++ b/src/HROOT/Graf/TCrown/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TCrown.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TCrown.RawType import HROOT.Graf.TCrown.FFI import HROOT.Graf.TCrown.Interface @@ -30,77 +31,38 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITCrown TCrown +instance ITEllipse TCrown -instance ITCrown TCrown where -instance ITEllipse TCrown where instance ITObject TCrown where - draw = xform1 c_tcrown_draw - findObject = xform1 c_tcrown_findobject - getName = xform0 c_tcrown_getname - isA = xform0 c_tcrown_isa - paint = xform1 c_tcrown_paint - printObj = xform1 c_tcrown_printobj - saveAs = xform2 c_tcrown_saveas - write = xform3 c_tcrown_write -instance ITAttLine TCrown where - getLineColor = xform0 c_tcrown_getlinecolor - getLineStyle = xform0 c_tcrown_getlinestyle - getLineWidth = xform0 c_tcrown_getlinewidth - resetAttLine = xform1 c_tcrown_resetattline - setLineAttributes = xform0 c_tcrown_setlineattributes - setLineColor = xform1 c_tcrown_setlinecolor - setLineStyle = xform1 c_tcrown_setlinestyle - setLineWidth = xform1 c_tcrown_setlinewidth -instance ITAttFill TCrown where - setFillColor = xform1 c_tcrown_setfillcolor - setFillStyle = xform1 c_tcrown_setfillstyle -instance IDeletable TCrown where - delete = xform0 c_tcrown_delete - -instance ITCrown (Exist TCrown) where + draw = xform1 c_tcrown_draw + findObject = xform1 c_tcrown_findobject + getName = xform0 c_tcrown_getname + isA = xform0 c_tcrown_isa + paint = xform1 c_tcrown_paint + printObj = xform1 c_tcrown_printobj + saveAs = xform2 c_tcrown_saveas + write = xform3 c_tcrown_write -instance ITEllipse (Exist TCrown) where +instance ITAttLine TCrown where + getLineColor = xform0 c_tcrown_getlinecolor + getLineStyle = xform0 c_tcrown_getlinestyle + getLineWidth = xform0 c_tcrown_getlinewidth + resetAttLine = xform1 c_tcrown_resetattline + setLineAttributes = xform0 c_tcrown_setlineattributes + setLineColor = xform1 c_tcrown_setlinecolor + setLineStyle = xform1 c_tcrown_setlinestyle + setLineWidth = xform1 c_tcrown_setlinewidth -instance ITObject (Exist TCrown) where - draw (ETCrown x) = draw x - findObject (ETCrown x) = findObject x - getName (ETCrown x) = getName x - isA (ETCrown x) = isA x - paint (ETCrown x) = paint x - printObj (ETCrown x) = printObj x - saveAs (ETCrown x) = saveAs x - write (ETCrown x) = write x -instance ITAttLine (Exist TCrown) where - getLineColor (ETCrown x) = getLineColor x - getLineStyle (ETCrown x) = getLineStyle x - getLineWidth (ETCrown x) = getLineWidth x - resetAttLine (ETCrown x) = resetAttLine x - setLineAttributes (ETCrown x) = setLineAttributes x - setLineColor (ETCrown x) = setLineColor x - setLineStyle (ETCrown x) = setLineStyle x - setLineWidth (ETCrown x) = setLineWidth x -instance ITAttFill (Exist TCrown) where - setFillColor (ETCrown x) = setFillColor x - setFillStyle (ETCrown x) = setFillStyle x -instance IDeletable (Exist TCrown) where - delete (ETCrown x) = delete x +instance ITAttFill TCrown where + setFillColor = xform1 c_tcrown_setfillcolor + setFillStyle = xform1 c_tcrown_setfillstyle +instance IDeletable TCrown where + delete = xform0 c_tcrown_delete -newTCrown :: CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO TCrown +newTCrown :: + CDouble -> + CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO TCrown newTCrown = xform5 c_tcrown_newtcrown - - - - - -instance FPtr (Exist TCrown) where - type Raw (Exist TCrown) = RawTCrown - get_fptr (ETCrown obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETCrown (cast_fptr_to_obj (fptr :: ForeignPtr RawTCrown) :: TCrown) diff --git a/src/HROOT/Graf/TCrown/Interface.hs b/src/HROOT/Graf/TCrown/Interface.hs --- a/src/HROOT/Graf/TCrown/Interface.hs +++ b/src/HROOT/Graf/TCrown/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TCrown.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TCrown.RawType - import HROOT.Graf.TEllipse.Interface ----- ============ ---- - - -class (ITEllipse a) => ITCrown a where - -instance Existable TCrown where - data Exist TCrown = forall a. (FPtr a, ITCrown a) => ETCrown a +class ITEllipse a => ITCrown a -upcastTCrown :: (FPtr a, ITCrown a) => a -> TCrown -upcastTCrown h = let fh = get_fptr h - fh2 :: ForeignPtr RawTCrown = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTCrown :: forall a . (FPtr a, ITCrown a) => a -> TCrown +upcastTCrown h + = let fh = get_fptr h + fh2 :: Ptr RawTCrown = castPtr fh + in cast_fptr_to_obj fh2 -downcastTCrown :: (FPtr a, ITCrown a) => TCrown -> a -downcastTCrown h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTCrown :: forall a . (FPtr a, ITCrown a) => TCrown -> a +downcastTCrown h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TCrown/RawType.hs b/src/HROOT/Graf/TCrown/RawType.hs --- a/src/HROOT/Graf/TCrown/RawType.hs +++ b/src/HROOT/Graf/TCrown/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TCrown.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTCrown -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TCrown = TCrown (Ptr RawTCrown) + deriving (Eq, Ord, Show) -data RawTCrown -newtype TCrown = TCrown (ForeignPtr RawTCrown) deriving (Eq, Ord, Show) instance FPtr TCrown where - type Raw TCrown = RawTCrown - get_fptr (TCrown fptr) = fptr - cast_fptr_to_obj = TCrown + type Raw TCrown = RawTCrown + get_fptr (TCrown ptr) = ptr + cast_fptr_to_obj = TCrown diff --git a/src/HROOT/Graf/TCutG.hs b/src/HROOT/Graf/TCutG.hs --- a/src/HROOT/Graf/TCutG.hs +++ b/src/HROOT/Graf/TCutG.hs @@ -1,15 +1,5 @@ module HROOT.Graf.TCutG - ( - TCutG(..) - , ITCutG - , upcastTCutG - , downcastTCutG - , newTCutG - - ) where - + (TCutG(..), ITCutG, upcastTCutG, downcastTCutG, newTCutG) where import HROOT.Graf.TCutG.RawType import HROOT.Graf.TCutG.Interface import HROOT.Graf.TCutG.Implementation - - diff --git a/src/HROOT/Graf/TCutG/Cast.hs b/src/HROOT/Graf/TCutG/Cast.hs --- a/src/HROOT/Graf/TCutG/Cast.hs +++ b/src/HROOT/Graf/TCutG/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TCutG.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TCutG.RawType import HROOT.Graf.TCutG.Interface instance (ITCutG a, FPtr a) => Castable a (Ptr RawTCutG) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TCutG (Ptr RawTCutG) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TCutG/FFI.hsc b/src/HROOT/Graf/TCutG/FFI.hsc --- a/src/HROOT/Graf/TCutG/FFI.hsc +++ b/src/HROOT/Graf/TCutG/FFI.hsc @@ -1,17 +1,7 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TCutG.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TCutG.RawType import HROOT.Hist.TF1.RawType import HROOT.Hist.TH1F.RawType @@ -19,194 +9,205 @@ import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTCutG.h" - -foreign import ccall "HROOTGrafTCutG.h TCutG_Apply" c_tcutg_apply - :: (Ptr RawTCutG) -> (Ptr RawTF1) -> IO () - -foreign import ccall "HROOTGrafTCutG.h TCutG_Chisquare" c_tcutg_chisquare - :: (Ptr RawTCutG) -> (Ptr RawTF1) -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_Apply" + c_tcutg_apply :: Ptr RawTCutG -> Ptr RawTF1 -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_DrawGraph" c_tcutg_drawgraph - :: (Ptr RawTCutG) -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_Chisquare" + c_tcutg_chisquare :: Ptr RawTCutG -> Ptr RawTF1 -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_drawPanelTGraph" c_tcutg_drawpaneltgraph - :: (Ptr RawTCutG) -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_DrawGraph" + c_tcutg_drawgraph :: + Ptr RawTCutG -> + CInt -> (Ptr CDouble) -> (Ptr CDouble) -> CString -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_Expand" c_tcutg_expand - :: (Ptr RawTCutG) -> CInt -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_drawPanelTGraph" + c_tcutg_drawpaneltgraph :: Ptr RawTCutG -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_FitPanelTGraph" c_tcutg_fitpaneltgraph - :: (Ptr RawTCutG) -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_Expand" + c_tcutg_expand :: Ptr RawTCutG -> CInt -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_getCorrelationFactorTGraph" c_tcutg_getcorrelationfactortgraph - :: (Ptr RawTCutG) -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_FitPanelTGraph" + c_tcutg_fitpaneltgraph :: Ptr RawTCutG -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_getCovarianceTGraph" c_tcutg_getcovariancetgraph - :: (Ptr RawTCutG) -> IO CDouble +foreign import ccall safe + "HROOTGrafTCutG.h TCutG_getCorrelationFactorTGraph" + c_tcutg_getcorrelationfactortgraph :: Ptr RawTCutG -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_getMeanTGraph" c_tcutg_getmeantgraph - :: (Ptr RawTCutG) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTCutG.h TCutG_getCovarianceTGraph" + c_tcutg_getcovariancetgraph :: Ptr RawTCutG -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_getRMSTGraph" c_tcutg_getrmstgraph - :: (Ptr RawTCutG) -> CInt -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_getMeanTGraph" + c_tcutg_getmeantgraph :: Ptr RawTCutG -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_GetErrorX" c_tcutg_geterrorx - :: (Ptr RawTCutG) -> CInt -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_getRMSTGraph" + c_tcutg_getrmstgraph :: Ptr RawTCutG -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_GetErrorY" c_tcutg_geterrory - :: (Ptr RawTCutG) -> CInt -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetErrorX" + c_tcutg_geterrorx :: Ptr RawTCutG -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_GetErrorXhigh" c_tcutg_geterrorxhigh - :: (Ptr RawTCutG) -> CInt -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetErrorY" + c_tcutg_geterrory :: Ptr RawTCutG -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_GetErrorXlow" c_tcutg_geterrorxlow - :: (Ptr RawTCutG) -> CInt -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetErrorXhigh" + c_tcutg_geterrorxhigh :: Ptr RawTCutG -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_GetErrorYhigh" c_tcutg_geterroryhigh - :: (Ptr RawTCutG) -> CInt -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetErrorXlow" + c_tcutg_geterrorxlow :: Ptr RawTCutG -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_GetErrorYlow" c_tcutg_geterrorylow - :: (Ptr RawTCutG) -> CInt -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetErrorYhigh" + c_tcutg_geterroryhigh :: Ptr RawTCutG -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_InitExpo" c_tcutg_initexpo - :: (Ptr RawTCutG) -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetErrorYlow" + c_tcutg_geterrorylow :: Ptr RawTCutG -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_InitGaus" c_tcutg_initgaus - :: (Ptr RawTCutG) -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_InitExpo" + c_tcutg_initexpo :: Ptr RawTCutG -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_InitPolynom" c_tcutg_initpolynom - :: (Ptr RawTCutG) -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_InitGaus" + c_tcutg_initgaus :: Ptr RawTCutG -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_InsertPoint" c_tcutg_insertpoint - :: (Ptr RawTCutG) -> IO CInt +foreign import ccall safe "HROOTGrafTCutG.h TCutG_InitPolynom" + c_tcutg_initpolynom :: Ptr RawTCutG -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_integralTGraph" c_tcutg_integraltgraph - :: (Ptr RawTCutG) -> CInt -> CInt -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_InsertPoint" + c_tcutg_insertpoint :: Ptr RawTCutG -> IO CInt -foreign import ccall "HROOTGrafTCutG.h TCutG_IsEditable" c_tcutg_iseditable - :: (Ptr RawTCutG) -> IO CInt +foreign import ccall safe "HROOTGrafTCutG.h TCutG_integralTGraph" + c_tcutg_integraltgraph :: + Ptr RawTCutG -> CInt -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_isInsideTGraph" c_tcutg_isinsidetgraph - :: (Ptr RawTCutG) -> CDouble -> CDouble -> IO CInt +foreign import ccall safe "HROOTGrafTCutG.h TCutG_IsEditable" + c_tcutg_iseditable :: Ptr RawTCutG -> IO CInt -foreign import ccall "HROOTGrafTCutG.h TCutG_LeastSquareFit" c_tcutg_leastsquarefit - :: (Ptr RawTCutG) -> CInt -> (Ptr CDouble) -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_isInsideTGraph" + c_tcutg_isinsidetgraph :: + Ptr RawTCutG -> CDouble -> CDouble -> IO CInt -foreign import ccall "HROOTGrafTCutG.h TCutG_PaintStats" c_tcutg_paintstats - :: (Ptr RawTCutG) -> (Ptr RawTF1) -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_LeastSquareFit" + c_tcutg_leastsquarefit :: + Ptr RawTCutG -> + CInt -> (Ptr CDouble) -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_RemovePoint" c_tcutg_removepoint - :: (Ptr RawTCutG) -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTCutG.h TCutG_PaintStats" + c_tcutg_paintstats :: Ptr RawTCutG -> Ptr RawTF1 -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetEditable" c_tcutg_seteditable - :: (Ptr RawTCutG) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_RemovePoint" + c_tcutg_removepoint :: Ptr RawTCutG -> CInt -> IO CInt -foreign import ccall "HROOTGrafTCutG.h TCutG_SetHistogram" c_tcutg_sethistogram - :: (Ptr RawTCutG) -> (Ptr RawTH1F) -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetEditable" + c_tcutg_seteditable :: Ptr RawTCutG -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_setMaximumTGraph" c_tcutg_setmaximumtgraph - :: (Ptr RawTCutG) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetHistogram" + c_tcutg_sethistogram :: Ptr RawTCutG -> Ptr RawTH1F -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_setMinimumTGraph" c_tcutg_setminimumtgraph - :: (Ptr RawTCutG) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_setMaximumTGraph" + c_tcutg_setmaximumtgraph :: Ptr RawTCutG -> CDouble -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_Set" c_tcutg_set - :: (Ptr RawTCutG) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_setMinimumTGraph" + c_tcutg_setminimumtgraph :: Ptr RawTCutG -> CDouble -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetPoint" c_tcutg_setpoint - :: (Ptr RawTCutG) -> CInt -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_Set" c_tcutg_set + :: Ptr RawTCutG -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetName" c_tcutg_setname - :: (Ptr RawTCutG) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetPoint" + c_tcutg_setpoint :: + Ptr RawTCutG -> CInt -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetNameTitle" c_tcutg_setnametitle - :: (Ptr RawTCutG) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetName" + c_tcutg_setname :: Ptr RawTCutG -> CString -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetTitle" c_tcutg_settitle - :: (Ptr RawTCutG) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetNameTitle" + c_tcutg_setnametitle :: Ptr RawTCutG -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_GetLineColor" c_tcutg_getlinecolor - :: (Ptr RawTCutG) -> IO CInt +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetTitle" + c_tcutg_settitle :: Ptr RawTCutG -> CString -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_GetLineStyle" c_tcutg_getlinestyle - :: (Ptr RawTCutG) -> IO CInt +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetLineColor" + c_tcutg_getlinecolor :: Ptr RawTCutG -> IO CInt -foreign import ccall "HROOTGrafTCutG.h TCutG_GetLineWidth" c_tcutg_getlinewidth - :: (Ptr RawTCutG) -> IO CInt +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetLineStyle" + c_tcutg_getlinestyle :: Ptr RawTCutG -> IO CInt -foreign import ccall "HROOTGrafTCutG.h TCutG_ResetAttLine" c_tcutg_resetattline - :: (Ptr RawTCutG) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetLineWidth" + c_tcutg_getlinewidth :: Ptr RawTCutG -> IO CInt -foreign import ccall "HROOTGrafTCutG.h TCutG_SetLineAttributes" c_tcutg_setlineattributes - :: (Ptr RawTCutG) -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_ResetAttLine" + c_tcutg_resetattline :: Ptr RawTCutG -> CString -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetLineColor" c_tcutg_setlinecolor - :: (Ptr RawTCutG) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTCutG.h TCutG_SetLineAttributes" + c_tcutg_setlineattributes :: Ptr RawTCutG -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetLineStyle" c_tcutg_setlinestyle - :: (Ptr RawTCutG) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetLineColor" + c_tcutg_setlinecolor :: Ptr RawTCutG -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetLineWidth" c_tcutg_setlinewidth - :: (Ptr RawTCutG) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetLineStyle" + c_tcutg_setlinestyle :: Ptr RawTCutG -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetFillColor" c_tcutg_setfillcolor - :: (Ptr RawTCutG) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetLineWidth" + c_tcutg_setlinewidth :: Ptr RawTCutG -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetFillStyle" c_tcutg_setfillstyle - :: (Ptr RawTCutG) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetFillColor" + c_tcutg_setfillcolor :: Ptr RawTCutG -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_GetMarkerColor" c_tcutg_getmarkercolor - :: (Ptr RawTCutG) -> IO CInt +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetFillStyle" + c_tcutg_setfillstyle :: Ptr RawTCutG -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_GetMarkerStyle" c_tcutg_getmarkerstyle - :: (Ptr RawTCutG) -> IO CInt +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetMarkerColor" + c_tcutg_getmarkercolor :: Ptr RawTCutG -> IO CInt -foreign import ccall "HROOTGrafTCutG.h TCutG_GetMarkerSize" c_tcutg_getmarkersize - :: (Ptr RawTCutG) -> IO CDouble +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetMarkerStyle" + c_tcutg_getmarkerstyle :: Ptr RawTCutG -> IO CInt -foreign import ccall "HROOTGrafTCutG.h TCutG_ResetAttMarker" c_tcutg_resetattmarker - :: (Ptr RawTCutG) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetMarkerSize" + c_tcutg_getmarkersize :: Ptr RawTCutG -> IO CDouble -foreign import ccall "HROOTGrafTCutG.h TCutG_SetMarkerAttributes" c_tcutg_setmarkerattributes - :: (Ptr RawTCutG) -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_ResetAttMarker" + c_tcutg_resetattmarker :: Ptr RawTCutG -> CString -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetMarkerColor" c_tcutg_setmarkercolor - :: (Ptr RawTCutG) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTCutG.h TCutG_SetMarkerAttributes" + c_tcutg_setmarkerattributes :: Ptr RawTCutG -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetMarkerStyle" c_tcutg_setmarkerstyle - :: (Ptr RawTCutG) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetMarkerColor" + c_tcutg_setmarkercolor :: Ptr RawTCutG -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SetMarkerSize" c_tcutg_setmarkersize - :: (Ptr RawTCutG) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetMarkerStyle" + c_tcutg_setmarkerstyle :: Ptr RawTCutG -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_Draw" c_tcutg_draw - :: (Ptr RawTCutG) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SetMarkerSize" + c_tcutg_setmarkersize :: Ptr RawTCutG -> CInt -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_FindObject" c_tcutg_findobject - :: (Ptr RawTCutG) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTCutG.h TCutG_Draw" + c_tcutg_draw :: Ptr RawTCutG -> CString -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_GetName" c_tcutg_getname - :: (Ptr RawTCutG) -> IO CString +foreign import ccall safe "HROOTGrafTCutG.h TCutG_FindObject" + c_tcutg_findobject :: + Ptr RawTCutG -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTCutG.h TCutG_IsA" c_tcutg_isa - :: (Ptr RawTCutG) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTCutG.h TCutG_GetName" + c_tcutg_getname :: Ptr RawTCutG -> IO CString -foreign import ccall "HROOTGrafTCutG.h TCutG_Paint" c_tcutg_paint - :: (Ptr RawTCutG) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_IsA" c_tcutg_isa + :: Ptr RawTCutG -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTCutG.h TCutG_printObj" c_tcutg_printobj - :: (Ptr RawTCutG) -> CString -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_Paint" + c_tcutg_paint :: Ptr RawTCutG -> CString -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_SaveAs" c_tcutg_saveas - :: (Ptr RawTCutG) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_printObj" + c_tcutg_printobj :: Ptr RawTCutG -> CString -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_Write" c_tcutg_write - :: (Ptr RawTCutG) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTCutG.h TCutG_SaveAs" + c_tcutg_saveas :: Ptr RawTCutG -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTCutG.h TCutG_delete" c_tcutg_delete - :: (Ptr RawTCutG) -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_Write" + c_tcutg_write :: Ptr RawTCutG -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTCutG.h TCutG_newTCutG" c_tcutg_newtcutg - :: CString -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> IO (Ptr RawTCutG) +foreign import ccall safe "HROOTGrafTCutG.h TCutG_delete" + c_tcutg_delete :: Ptr RawTCutG -> IO () +foreign import ccall safe "HROOTGrafTCutG.h TCutG_newTCutG" + c_tcutg_newtcutg :: + CString -> + CInt -> (Ptr CDouble) -> (Ptr CDouble) -> IO (Ptr RawTCutG) diff --git a/src/HROOT/Graf/TCutG/Implementation.hs b/src/HROOT/Graf/TCutG/Implementation.hs --- a/src/HROOT/Graf/TCutG/Implementation.hs +++ b/src/HROOT/Graf/TCutG/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TCutG.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TCutG.RawType import HROOT.Graf.TCutG.FFI import HROOT.Graf.TCutG.Interface @@ -45,166 +46,86 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITCutG TCutG -instance ITCutG TCutG where instance ITGraph TCutG where - apply = xform1 c_tcutg_apply - chisquare = xform1 c_tcutg_chisquare - drawGraph = xform4 c_tcutg_drawgraph - drawPanelTGraph = xform0 c_tcutg_drawpaneltgraph - expand = xform2 c_tcutg_expand - fitPanelTGraph = xform0 c_tcutg_fitpaneltgraph - getCorrelationFactorTGraph = xform0 c_tcutg_getcorrelationfactortgraph - getCovarianceTGraph = xform0 c_tcutg_getcovariancetgraph - getMeanTGraph = xform1 c_tcutg_getmeantgraph - getRMSTGraph = xform1 c_tcutg_getrmstgraph - getErrorX = xform1 c_tcutg_geterrorx - getErrorY = xform1 c_tcutg_geterrory - getErrorXhigh = xform1 c_tcutg_geterrorxhigh - getErrorXlow = xform1 c_tcutg_geterrorxlow - getErrorYhigh = xform1 c_tcutg_geterroryhigh - getErrorYlow = xform1 c_tcutg_geterrorylow - initExpo = xform2 c_tcutg_initexpo - initGaus = xform2 c_tcutg_initgaus - initPolynom = xform2 c_tcutg_initpolynom - insertPoint = xform0 c_tcutg_insertpoint - integralTGraph = xform2 c_tcutg_integraltgraph - isEditable = xform0 c_tcutg_iseditable - isInsideTGraph = xform2 c_tcutg_isinsidetgraph - leastSquareFit = xform4 c_tcutg_leastsquarefit - paintStats = xform1 c_tcutg_paintstats - removePoint = xform1 c_tcutg_removepoint - setEditable = xform1 c_tcutg_seteditable - setHistogram = xform1 c_tcutg_sethistogram - setMaximumTGraph = xform1 c_tcutg_setmaximumtgraph - setMinimumTGraph = xform1 c_tcutg_setminimumtgraph - set = xform1 c_tcutg_set - setPoint = xform3 c_tcutg_setpoint + apply = xform1 c_tcutg_apply + chisquare = xform1 c_tcutg_chisquare + drawGraph = xform4 c_tcutg_drawgraph + drawPanelTGraph = xform0 c_tcutg_drawpaneltgraph + expand = xform2 c_tcutg_expand + fitPanelTGraph = xform0 c_tcutg_fitpaneltgraph + getCorrelationFactorTGraph + = xform0 c_tcutg_getcorrelationfactortgraph + getCovarianceTGraph = xform0 c_tcutg_getcovariancetgraph + getMeanTGraph = xform1 c_tcutg_getmeantgraph + getRMSTGraph = xform1 c_tcutg_getrmstgraph + getErrorX = xform1 c_tcutg_geterrorx + getErrorY = xform1 c_tcutg_geterrory + getErrorXhigh = xform1 c_tcutg_geterrorxhigh + getErrorXlow = xform1 c_tcutg_geterrorxlow + getErrorYhigh = xform1 c_tcutg_geterroryhigh + getErrorYlow = xform1 c_tcutg_geterrorylow + initExpo = xform2 c_tcutg_initexpo + initGaus = xform2 c_tcutg_initgaus + initPolynom = xform2 c_tcutg_initpolynom + insertPoint = xform0 c_tcutg_insertpoint + integralTGraph = xform2 c_tcutg_integraltgraph + isEditable = xform0 c_tcutg_iseditable + isInsideTGraph = xform2 c_tcutg_isinsidetgraph + leastSquareFit = xform4 c_tcutg_leastsquarefit + paintStats = xform1 c_tcutg_paintstats + removePoint = xform1 c_tcutg_removepoint + setEditable = xform1 c_tcutg_seteditable + setHistogram = xform1 c_tcutg_sethistogram + setMaximumTGraph = xform1 c_tcutg_setmaximumtgraph + setMinimumTGraph = xform1 c_tcutg_setminimumtgraph + set = xform1 c_tcutg_set + setPoint = xform3 c_tcutg_setpoint + instance ITNamed TCutG where - setName = xform1 c_tcutg_setname - setNameTitle = xform2 c_tcutg_setnametitle - setTitle = xform1 c_tcutg_settitle + setName = xform1 c_tcutg_setname + setNameTitle = xform2 c_tcutg_setnametitle + setTitle = xform1 c_tcutg_settitle + instance ITAttLine TCutG where - getLineColor = xform0 c_tcutg_getlinecolor - getLineStyle = xform0 c_tcutg_getlinestyle - getLineWidth = xform0 c_tcutg_getlinewidth - resetAttLine = xform1 c_tcutg_resetattline - setLineAttributes = xform0 c_tcutg_setlineattributes - setLineColor = xform1 c_tcutg_setlinecolor - setLineStyle = xform1 c_tcutg_setlinestyle - setLineWidth = xform1 c_tcutg_setlinewidth + getLineColor = xform0 c_tcutg_getlinecolor + getLineStyle = xform0 c_tcutg_getlinestyle + getLineWidth = xform0 c_tcutg_getlinewidth + resetAttLine = xform1 c_tcutg_resetattline + setLineAttributes = xform0 c_tcutg_setlineattributes + setLineColor = xform1 c_tcutg_setlinecolor + setLineStyle = xform1 c_tcutg_setlinestyle + setLineWidth = xform1 c_tcutg_setlinewidth + instance ITAttFill TCutG where - setFillColor = xform1 c_tcutg_setfillcolor - setFillStyle = xform1 c_tcutg_setfillstyle -instance ITAttMarker TCutG where - getMarkerColor = xform0 c_tcutg_getmarkercolor - getMarkerStyle = xform0 c_tcutg_getmarkerstyle - getMarkerSize = xform0 c_tcutg_getmarkersize - resetAttMarker = xform1 c_tcutg_resetattmarker - setMarkerAttributes = xform0 c_tcutg_setmarkerattributes - setMarkerColor = xform1 c_tcutg_setmarkercolor - setMarkerStyle = xform1 c_tcutg_setmarkerstyle - setMarkerSize = xform1 c_tcutg_setmarkersize -instance ITObject TCutG where - draw = xform1 c_tcutg_draw - findObject = xform1 c_tcutg_findobject - getName = xform0 c_tcutg_getname - isA = xform0 c_tcutg_isa - paint = xform1 c_tcutg_paint - printObj = xform1 c_tcutg_printobj - saveAs = xform2 c_tcutg_saveas - write = xform3 c_tcutg_write -instance IDeletable TCutG where - delete = xform0 c_tcutg_delete + setFillColor = xform1 c_tcutg_setfillcolor + setFillStyle = xform1 c_tcutg_setfillstyle -instance ITCutG (Exist TCutG) where +instance ITAttMarker TCutG where + getMarkerColor = xform0 c_tcutg_getmarkercolor + getMarkerStyle = xform0 c_tcutg_getmarkerstyle + getMarkerSize = xform0 c_tcutg_getmarkersize + resetAttMarker = xform1 c_tcutg_resetattmarker + setMarkerAttributes = xform0 c_tcutg_setmarkerattributes + setMarkerColor = xform1 c_tcutg_setmarkercolor + setMarkerStyle = xform1 c_tcutg_setmarkerstyle + setMarkerSize = xform1 c_tcutg_setmarkersize -instance ITGraph (Exist TCutG) where - apply (ETCutG x) = apply x - chisquare (ETCutG x) = chisquare x - drawGraph (ETCutG x) = drawGraph x - drawPanelTGraph (ETCutG x) = drawPanelTGraph x - expand (ETCutG x) = expand x - fitPanelTGraph (ETCutG x) = fitPanelTGraph x - getCorrelationFactorTGraph (ETCutG x) = getCorrelationFactorTGraph x - getCovarianceTGraph (ETCutG x) = getCovarianceTGraph x - getMeanTGraph (ETCutG x) = getMeanTGraph x - getRMSTGraph (ETCutG x) = getRMSTGraph x - getErrorX (ETCutG x) = getErrorX x - getErrorY (ETCutG x) = getErrorY x - getErrorXhigh (ETCutG x) = getErrorXhigh x - getErrorXlow (ETCutG x) = getErrorXlow x - getErrorYhigh (ETCutG x) = getErrorYhigh x - getErrorYlow (ETCutG x) = getErrorYlow x - initExpo (ETCutG x) = initExpo x - initGaus (ETCutG x) = initGaus x - initPolynom (ETCutG x) = initPolynom x - insertPoint (ETCutG x) = insertPoint x - integralTGraph (ETCutG x) = integralTGraph x - isEditable (ETCutG x) = isEditable x - isInsideTGraph (ETCutG x) = isInsideTGraph x - leastSquareFit (ETCutG x) = leastSquareFit x - paintStats (ETCutG x) = paintStats x - removePoint (ETCutG x) = removePoint x - setEditable (ETCutG x) = setEditable x - setHistogram (ETCutG x) = setHistogram x - setMaximumTGraph (ETCutG x) = setMaximumTGraph x - setMinimumTGraph (ETCutG x) = setMinimumTGraph x - set (ETCutG x) = set x - setPoint (ETCutG x) = setPoint x -instance ITNamed (Exist TCutG) where - setName (ETCutG x) = setName x - setNameTitle (ETCutG x) = setNameTitle x - setTitle (ETCutG x) = setTitle x -instance ITAttLine (Exist TCutG) where - getLineColor (ETCutG x) = getLineColor x - getLineStyle (ETCutG x) = getLineStyle x - getLineWidth (ETCutG x) = getLineWidth x - resetAttLine (ETCutG x) = resetAttLine x - setLineAttributes (ETCutG x) = setLineAttributes x - setLineColor (ETCutG x) = setLineColor x - setLineStyle (ETCutG x) = setLineStyle x - setLineWidth (ETCutG x) = setLineWidth x -instance ITAttFill (Exist TCutG) where - setFillColor (ETCutG x) = setFillColor x - setFillStyle (ETCutG x) = setFillStyle x -instance ITAttMarker (Exist TCutG) where - getMarkerColor (ETCutG x) = getMarkerColor x - getMarkerStyle (ETCutG x) = getMarkerStyle x - getMarkerSize (ETCutG x) = getMarkerSize x - resetAttMarker (ETCutG x) = resetAttMarker x - setMarkerAttributes (ETCutG x) = setMarkerAttributes x - setMarkerColor (ETCutG x) = setMarkerColor x - setMarkerStyle (ETCutG x) = setMarkerStyle x - setMarkerSize (ETCutG x) = setMarkerSize x -instance ITObject (Exist TCutG) where - draw (ETCutG x) = draw x - findObject (ETCutG x) = findObject x - getName (ETCutG x) = getName x - isA (ETCutG x) = isA x - paint (ETCutG x) = paint x - printObj (ETCutG x) = printObj x - saveAs (ETCutG x) = saveAs x - write (ETCutG x) = write x -instance IDeletable (Exist TCutG) where - delete (ETCutG x) = delete x +instance ITObject TCutG where + draw = xform1 c_tcutg_draw + findObject = xform1 c_tcutg_findobject + getName = xform0 c_tcutg_getname + isA = xform0 c_tcutg_isa + paint = xform1 c_tcutg_paint + printObj = xform1 c_tcutg_printobj + saveAs = xform2 c_tcutg_saveas + write = xform3 c_tcutg_write +instance IDeletable TCutG where + delete = xform0 c_tcutg_delete -newTCutG :: CString -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> IO TCutG +newTCutG :: + Castable c0 CString => + c0 -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> IO TCutG newTCutG = xform3 c_tcutg_newtcutg - - - - - -instance FPtr (Exist TCutG) where - type Raw (Exist TCutG) = RawTCutG - get_fptr (ETCutG obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETCutG (cast_fptr_to_obj (fptr :: ForeignPtr RawTCutG) :: TCutG) diff --git a/src/HROOT/Graf/TCutG/Interface.hs b/src/HROOT/Graf/TCutG/Interface.hs --- a/src/HROOT/Graf/TCutG/Interface.hs +++ b/src/HROOT/Graf/TCutG/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TCutG.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TCutG.RawType - import HROOT.Hist.TGraph.Interface ----- ============ ---- - - -class (ITGraph a) => ITCutG a where - -instance Existable TCutG where - data Exist TCutG = forall a. (FPtr a, ITCutG a) => ETCutG a +class ITGraph a => ITCutG a -upcastTCutG :: (FPtr a, ITCutG a) => a -> TCutG -upcastTCutG h = let fh = get_fptr h - fh2 :: ForeignPtr RawTCutG = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTCutG :: forall a . (FPtr a, ITCutG a) => a -> TCutG +upcastTCutG h + = let fh = get_fptr h + fh2 :: Ptr RawTCutG = castPtr fh + in cast_fptr_to_obj fh2 -downcastTCutG :: (FPtr a, ITCutG a) => TCutG -> a -downcastTCutG h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTCutG :: forall a . (FPtr a, ITCutG a) => TCutG -> a +downcastTCutG h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TCutG/RawType.hs b/src/HROOT/Graf/TCutG/RawType.hs --- a/src/HROOT/Graf/TCutG/RawType.hs +++ b/src/HROOT/Graf/TCutG/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TCutG.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTCutG -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TCutG = TCutG (Ptr RawTCutG) + deriving (Eq, Ord, Show) -data RawTCutG -newtype TCutG = TCutG (ForeignPtr RawTCutG) deriving (Eq, Ord, Show) instance FPtr TCutG where - type Raw TCutG = RawTCutG - get_fptr (TCutG fptr) = fptr - cast_fptr_to_obj = TCutG + type Raw TCutG = RawTCutG + get_fptr (TCutG ptr) = ptr + cast_fptr_to_obj = TCutG diff --git a/src/HROOT/Graf/TEllipse.hs b/src/HROOT/Graf/TEllipse.hs --- a/src/HROOT/Graf/TEllipse.hs +++ b/src/HROOT/Graf/TEllipse.hs @@ -1,15 +1,7 @@ module HROOT.Graf.TEllipse - ( - TEllipse(..) - , ITEllipse - , upcastTEllipse - , downcastTEllipse - , newTEllipse - - ) where - + (TEllipse(..), ITEllipse, upcastTEllipse, downcastTEllipse, + newTEllipse) + where import HROOT.Graf.TEllipse.RawType import HROOT.Graf.TEllipse.Interface import HROOT.Graf.TEllipse.Implementation - - diff --git a/src/HROOT/Graf/TEllipse/Cast.hs b/src/HROOT/Graf/TEllipse/Cast.hs --- a/src/HROOT/Graf/TEllipse/Cast.hs +++ b/src/HROOT/Graf/TEllipse/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TEllipse.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TEllipse.RawType import HROOT.Graf.TEllipse.Interface -instance (ITEllipse a, FPtr a) => Castable a (Ptr RawTEllipse) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITEllipse a, FPtr a) => Castable a (Ptr RawTEllipse) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TEllipse (Ptr RawTEllipse) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TEllipse/FFI.hsc b/src/HROOT/Graf/TEllipse/FFI.hsc --- a/src/HROOT/Graf/TEllipse/FFI.hsc +++ b/src/HROOT/Graf/TEllipse/FFI.hsc @@ -1,80 +1,84 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TEllipse.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TEllipse.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTEllipse.h" - -foreign import ccall "HROOTGrafTEllipse.h TEllipse_Draw" c_tellipse_draw - :: (Ptr RawTEllipse) -> CString -> IO () - -foreign import ccall "HROOTGrafTEllipse.h TEllipse_FindObject" c_tellipse_findobject - :: (Ptr RawTEllipse) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTEllipse.h TEllipse_Draw" + c_tellipse_draw :: Ptr RawTEllipse -> CString -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_GetName" c_tellipse_getname - :: (Ptr RawTEllipse) -> IO CString +foreign import ccall safe "HROOTGrafTEllipse.h TEllipse_FindObject" + c_tellipse_findobject :: + Ptr RawTEllipse -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTEllipse.h TEllipse_IsA" c_tellipse_isa - :: (Ptr RawTEllipse) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTEllipse.h TEllipse_GetName" + c_tellipse_getname :: Ptr RawTEllipse -> IO CString -foreign import ccall "HROOTGrafTEllipse.h TEllipse_Paint" c_tellipse_paint - :: (Ptr RawTEllipse) -> CString -> IO () +foreign import ccall safe "HROOTGrafTEllipse.h TEllipse_IsA" + c_tellipse_isa :: Ptr RawTEllipse -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTEllipse.h TEllipse_printObj" c_tellipse_printobj - :: (Ptr RawTEllipse) -> CString -> IO () +foreign import ccall safe "HROOTGrafTEllipse.h TEllipse_Paint" + c_tellipse_paint :: Ptr RawTEllipse -> CString -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_SaveAs" c_tellipse_saveas - :: (Ptr RawTEllipse) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTEllipse.h TEllipse_printObj" + c_tellipse_printobj :: Ptr RawTEllipse -> CString -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_Write" c_tellipse_write - :: (Ptr RawTEllipse) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTEllipse.h TEllipse_SaveAs" + c_tellipse_saveas :: Ptr RawTEllipse -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_GetLineColor" c_tellipse_getlinecolor - :: (Ptr RawTEllipse) -> IO CInt +foreign import ccall safe "HROOTGrafTEllipse.h TEllipse_Write" + c_tellipse_write :: + Ptr RawTEllipse -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTEllipse.h TEllipse_GetLineStyle" c_tellipse_getlinestyle - :: (Ptr RawTEllipse) -> IO CInt +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_GetLineColor" c_tellipse_getlinecolor + :: Ptr RawTEllipse -> IO CInt -foreign import ccall "HROOTGrafTEllipse.h TEllipse_GetLineWidth" c_tellipse_getlinewidth - :: (Ptr RawTEllipse) -> IO CInt +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_GetLineStyle" c_tellipse_getlinestyle + :: Ptr RawTEllipse -> IO CInt -foreign import ccall "HROOTGrafTEllipse.h TEllipse_ResetAttLine" c_tellipse_resetattline - :: (Ptr RawTEllipse) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_GetLineWidth" c_tellipse_getlinewidth + :: Ptr RawTEllipse -> IO CInt -foreign import ccall "HROOTGrafTEllipse.h TEllipse_SetLineAttributes" c_tellipse_setlineattributes - :: (Ptr RawTEllipse) -> IO () +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_ResetAttLine" c_tellipse_resetattline + :: Ptr RawTEllipse -> CString -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_SetLineColor" c_tellipse_setlinecolor - :: (Ptr RawTEllipse) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_SetLineAttributes" + c_tellipse_setlineattributes :: Ptr RawTEllipse -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_SetLineStyle" c_tellipse_setlinestyle - :: (Ptr RawTEllipse) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_SetLineColor" c_tellipse_setlinecolor + :: Ptr RawTEllipse -> CInt -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_SetLineWidth" c_tellipse_setlinewidth - :: (Ptr RawTEllipse) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_SetLineStyle" c_tellipse_setlinestyle + :: Ptr RawTEllipse -> CInt -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_SetFillColor" c_tellipse_setfillcolor - :: (Ptr RawTEllipse) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_SetLineWidth" c_tellipse_setlinewidth + :: Ptr RawTEllipse -> CInt -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_SetFillStyle" c_tellipse_setfillstyle - :: (Ptr RawTEllipse) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_SetFillColor" c_tellipse_setfillcolor + :: Ptr RawTEllipse -> CInt -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_delete" c_tellipse_delete - :: (Ptr RawTEllipse) -> IO () +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_SetFillStyle" c_tellipse_setfillstyle + :: Ptr RawTEllipse -> CInt -> IO () -foreign import ccall "HROOTGrafTEllipse.h TEllipse_newTEllipse" c_tellipse_newtellipse - :: CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTEllipse) +foreign import ccall safe "HROOTGrafTEllipse.h TEllipse_delete" + c_tellipse_delete :: Ptr RawTEllipse -> IO () +foreign import ccall safe + "HROOTGrafTEllipse.h TEllipse_newTEllipse" c_tellipse_newtellipse + :: + CDouble -> + CDouble -> + CDouble -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTEllipse) diff --git a/src/HROOT/Graf/TEllipse/Implementation.hs b/src/HROOT/Graf/TEllipse/Implementation.hs --- a/src/HROOT/Graf/TEllipse/Implementation.hs +++ b/src/HROOT/Graf/TEllipse/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TEllipse.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TEllipse.RawType import HROOT.Graf.TEllipse.FFI import HROOT.Graf.TEllipse.Interface @@ -27,74 +28,37 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITEllipse TEllipse -instance ITEllipse TEllipse where instance ITObject TEllipse where - draw = xform1 c_tellipse_draw - findObject = xform1 c_tellipse_findobject - getName = xform0 c_tellipse_getname - isA = xform0 c_tellipse_isa - paint = xform1 c_tellipse_paint - printObj = xform1 c_tellipse_printobj - saveAs = xform2 c_tellipse_saveas - write = xform3 c_tellipse_write -instance ITAttLine TEllipse where - getLineColor = xform0 c_tellipse_getlinecolor - getLineStyle = xform0 c_tellipse_getlinestyle - getLineWidth = xform0 c_tellipse_getlinewidth - resetAttLine = xform1 c_tellipse_resetattline - setLineAttributes = xform0 c_tellipse_setlineattributes - setLineColor = xform1 c_tellipse_setlinecolor - setLineStyle = xform1 c_tellipse_setlinestyle - setLineWidth = xform1 c_tellipse_setlinewidth -instance ITAttFill TEllipse where - setFillColor = xform1 c_tellipse_setfillcolor - setFillStyle = xform1 c_tellipse_setfillstyle -instance IDeletable TEllipse where - delete = xform0 c_tellipse_delete + draw = xform1 c_tellipse_draw + findObject = xform1 c_tellipse_findobject + getName = xform0 c_tellipse_getname + isA = xform0 c_tellipse_isa + paint = xform1 c_tellipse_paint + printObj = xform1 c_tellipse_printobj + saveAs = xform2 c_tellipse_saveas + write = xform3 c_tellipse_write -instance ITEllipse (Exist TEllipse) where +instance ITAttLine TEllipse where + getLineColor = xform0 c_tellipse_getlinecolor + getLineStyle = xform0 c_tellipse_getlinestyle + getLineWidth = xform0 c_tellipse_getlinewidth + resetAttLine = xform1 c_tellipse_resetattline + setLineAttributes = xform0 c_tellipse_setlineattributes + setLineColor = xform1 c_tellipse_setlinecolor + setLineStyle = xform1 c_tellipse_setlinestyle + setLineWidth = xform1 c_tellipse_setlinewidth -instance ITObject (Exist TEllipse) where - draw (ETEllipse x) = draw x - findObject (ETEllipse x) = findObject x - getName (ETEllipse x) = getName x - isA (ETEllipse x) = isA x - paint (ETEllipse x) = paint x - printObj (ETEllipse x) = printObj x - saveAs (ETEllipse x) = saveAs x - write (ETEllipse x) = write x -instance ITAttLine (Exist TEllipse) where - getLineColor (ETEllipse x) = getLineColor x - getLineStyle (ETEllipse x) = getLineStyle x - getLineWidth (ETEllipse x) = getLineWidth x - resetAttLine (ETEllipse x) = resetAttLine x - setLineAttributes (ETEllipse x) = setLineAttributes x - setLineColor (ETEllipse x) = setLineColor x - setLineStyle (ETEllipse x) = setLineStyle x - setLineWidth (ETEllipse x) = setLineWidth x -instance ITAttFill (Exist TEllipse) where - setFillColor (ETEllipse x) = setFillColor x - setFillStyle (ETEllipse x) = setFillStyle x -instance IDeletable (Exist TEllipse) where - delete (ETEllipse x) = delete x +instance ITAttFill TEllipse where + setFillColor = xform1 c_tellipse_setfillcolor + setFillStyle = xform1 c_tellipse_setfillstyle +instance IDeletable TEllipse where + delete = xform0 c_tellipse_delete -newTEllipse :: CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO TEllipse +newTEllipse :: + CDouble -> + CDouble -> + CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO TEllipse newTEllipse = xform6 c_tellipse_newtellipse - - - - - -instance FPtr (Exist TEllipse) where - type Raw (Exist TEllipse) = RawTEllipse - get_fptr (ETEllipse obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETEllipse (cast_fptr_to_obj (fptr :: ForeignPtr RawTEllipse) :: TEllipse) diff --git a/src/HROOT/Graf/TEllipse/Interface.hs b/src/HROOT/Graf/TEllipse/Interface.hs --- a/src/HROOT/Graf/TEllipse/Interface.hs +++ b/src/HROOT/Graf/TEllipse/Interface.hs @@ -1,38 +1,28 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TEllipse.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TEllipse.RawType - import HROOT.Core.TObject.Interface import HROOT.Core.TAttLine.Interface import HROOT.Core.TAttFill.Interface ----- ============ ---- - - -class (ITObject a,ITAttLine a,ITAttFill a) => ITEllipse a where - -instance Existable TEllipse where - data Exist TEllipse = forall a. (FPtr a, ITEllipse a) => ETEllipse a +class (ITObject a, ITAttLine a, ITAttFill a) => ITEllipse a -upcastTEllipse :: (FPtr a, ITEllipse a) => a -> TEllipse -upcastTEllipse h = let fh = get_fptr h - fh2 :: ForeignPtr RawTEllipse = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTEllipse :: forall a . (FPtr a, ITEllipse a) => a -> TEllipse +upcastTEllipse h + = let fh = get_fptr h + fh2 :: Ptr RawTEllipse = castPtr fh + in cast_fptr_to_obj fh2 -downcastTEllipse :: (FPtr a, ITEllipse a) => TEllipse -> a -downcastTEllipse h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTEllipse :: + forall a . (FPtr a, ITEllipse a) => TEllipse -> a +downcastTEllipse h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TEllipse/RawType.hs b/src/HROOT/Graf/TEllipse/RawType.hs --- a/src/HROOT/Graf/TEllipse/RawType.hs +++ b/src/HROOT/Graf/TEllipse/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TEllipse.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTEllipse -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TEllipse = TEllipse (Ptr RawTEllipse) + deriving (Eq, Ord, Show) -data RawTEllipse -newtype TEllipse = TEllipse (ForeignPtr RawTEllipse) deriving (Eq, Ord, Show) instance FPtr TEllipse where - type Raw TEllipse = RawTEllipse - get_fptr (TEllipse fptr) = fptr - cast_fptr_to_obj = TEllipse + type Raw TEllipse = RawTEllipse + get_fptr (TEllipse ptr) = ptr + cast_fptr_to_obj = TEllipse diff --git a/src/HROOT/Graf/TGaxis.hs b/src/HROOT/Graf/TGaxis.hs --- a/src/HROOT/Graf/TGaxis.hs +++ b/src/HROOT/Graf/TGaxis.hs @@ -1,15 +1,6 @@ module HROOT.Graf.TGaxis - ( - TGaxis(..) - , ITGaxis - , upcastTGaxis - , downcastTGaxis - , newTGaxis - - ) where - + (TGaxis(..), ITGaxis, upcastTGaxis, downcastTGaxis, newTGaxis) + where import HROOT.Graf.TGaxis.RawType import HROOT.Graf.TGaxis.Interface import HROOT.Graf.TGaxis.Implementation - - diff --git a/src/HROOT/Graf/TGaxis/Cast.hs b/src/HROOT/Graf/TGaxis/Cast.hs --- a/src/HROOT/Graf/TGaxis/Cast.hs +++ b/src/HROOT/Graf/TGaxis/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TGaxis.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TGaxis.RawType import HROOT.Graf.TGaxis.Interface instance (ITGaxis a, FPtr a) => Castable a (Ptr RawTGaxis) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TGaxis (Ptr RawTGaxis) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TGaxis/FFI.hsc b/src/HROOT/Graf/TGaxis/FFI.hsc --- a/src/HROOT/Graf/TGaxis/FFI.hsc +++ b/src/HROOT/Graf/TGaxis/FFI.hsc @@ -1,138 +1,142 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TGaxis.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TGaxis.RawType import HROOT.Graf.TLine.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTGaxis.h" - -foreign import ccall "HROOTGrafTGaxis.h TGaxis_DrawLine" c_tgaxis_drawline - :: (Ptr RawTGaxis) -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) - -foreign import ccall "HROOTGrafTGaxis.h TGaxis_DrawLineNDC" c_tgaxis_drawlinendc - :: (Ptr RawTGaxis) -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_DrawLine" + c_tgaxis_drawline :: + Ptr RawTGaxis -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) -foreign import ccall "HROOTGrafTGaxis.h TGaxis_PaintLine" c_tgaxis_paintline - :: (Ptr RawTGaxis) -> CDouble -> CDouble -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_DrawLineNDC" + c_tgaxis_drawlinendc :: + Ptr RawTGaxis -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) -foreign import ccall "HROOTGrafTGaxis.h TGaxis_PaintLineNDC" c_tgaxis_paintlinendc - :: (Ptr RawTGaxis) -> CDouble -> CDouble -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_PaintLine" + c_tgaxis_paintline :: + Ptr RawTGaxis -> CDouble -> CDouble -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetX1" c_tgaxis_setx1 - :: (Ptr RawTGaxis) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_PaintLineNDC" + c_tgaxis_paintlinendc :: + Ptr RawTGaxis -> CDouble -> CDouble -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetX2" c_tgaxis_setx2 - :: (Ptr RawTGaxis) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetX1" + c_tgaxis_setx1 :: Ptr RawTGaxis -> CDouble -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetY1" c_tgaxis_sety1 - :: (Ptr RawTGaxis) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetX2" + c_tgaxis_setx2 :: Ptr RawTGaxis -> CDouble -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetY2" c_tgaxis_sety2 - :: (Ptr RawTGaxis) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetY1" + c_tgaxis_sety1 :: Ptr RawTGaxis -> CDouble -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_GetTextAlign" c_tgaxis_gettextalign - :: (Ptr RawTGaxis) -> IO CInt +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetY2" + c_tgaxis_sety2 :: Ptr RawTGaxis -> CDouble -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_GetTextAngle" c_tgaxis_gettextangle - :: (Ptr RawTGaxis) -> IO CDouble +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_GetTextAlign" + c_tgaxis_gettextalign :: Ptr RawTGaxis -> IO CInt -foreign import ccall "HROOTGrafTGaxis.h TGaxis_GetTextColor" c_tgaxis_gettextcolor - :: (Ptr RawTGaxis) -> IO CInt +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_GetTextAngle" + c_tgaxis_gettextangle :: Ptr RawTGaxis -> IO CDouble -foreign import ccall "HROOTGrafTGaxis.h TGaxis_GetTextFont" c_tgaxis_gettextfont - :: (Ptr RawTGaxis) -> IO CInt +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_GetTextColor" + c_tgaxis_gettextcolor :: Ptr RawTGaxis -> IO CInt -foreign import ccall "HROOTGrafTGaxis.h TGaxis_GetTextSize" c_tgaxis_gettextsize - :: (Ptr RawTGaxis) -> IO CDouble +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_GetTextFont" + c_tgaxis_gettextfont :: Ptr RawTGaxis -> IO CInt -foreign import ccall "HROOTGrafTGaxis.h TGaxis_ResetAttText" c_tgaxis_resetatttext - :: (Ptr RawTGaxis) -> CString -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_GetTextSize" + c_tgaxis_gettextsize :: Ptr RawTGaxis -> IO CDouble -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetTextAttributes" c_tgaxis_settextattributes - :: (Ptr RawTGaxis) -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_ResetAttText" + c_tgaxis_resetatttext :: Ptr RawTGaxis -> CString -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetTextAlign" c_tgaxis_settextalign - :: (Ptr RawTGaxis) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGaxis.h TGaxis_SetTextAttributes" + c_tgaxis_settextattributes :: Ptr RawTGaxis -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetTextAngle" c_tgaxis_settextangle - :: (Ptr RawTGaxis) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetTextAlign" + c_tgaxis_settextalign :: Ptr RawTGaxis -> CInt -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetTextColor" c_tgaxis_settextcolor - :: (Ptr RawTGaxis) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetTextAngle" + c_tgaxis_settextangle :: Ptr RawTGaxis -> CDouble -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetTextFont" c_tgaxis_settextfont - :: (Ptr RawTGaxis) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetTextColor" + c_tgaxis_settextcolor :: Ptr RawTGaxis -> CInt -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetTextSize" c_tgaxis_settextsize - :: (Ptr RawTGaxis) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetTextFont" + c_tgaxis_settextfont :: Ptr RawTGaxis -> CInt -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetTextSizePixels" c_tgaxis_settextsizepixels - :: (Ptr RawTGaxis) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetTextSize" + c_tgaxis_settextsize :: Ptr RawTGaxis -> CDouble -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_Draw" c_tgaxis_draw - :: (Ptr RawTGaxis) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGaxis.h TGaxis_SetTextSizePixels" + c_tgaxis_settextsizepixels :: Ptr RawTGaxis -> CInt -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_FindObject" c_tgaxis_findobject - :: (Ptr RawTGaxis) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_Draw" + c_tgaxis_draw :: Ptr RawTGaxis -> CString -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_GetName" c_tgaxis_getname - :: (Ptr RawTGaxis) -> IO CString +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_FindObject" + c_tgaxis_findobject :: + Ptr RawTGaxis -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTGaxis.h TGaxis_IsA" c_tgaxis_isa - :: (Ptr RawTGaxis) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_GetName" + c_tgaxis_getname :: Ptr RawTGaxis -> IO CString -foreign import ccall "HROOTGrafTGaxis.h TGaxis_Paint" c_tgaxis_paint - :: (Ptr RawTGaxis) -> CString -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_IsA" + c_tgaxis_isa :: Ptr RawTGaxis -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTGaxis.h TGaxis_printObj" c_tgaxis_printobj - :: (Ptr RawTGaxis) -> CString -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_Paint" + c_tgaxis_paint :: Ptr RawTGaxis -> CString -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SaveAs" c_tgaxis_saveas - :: (Ptr RawTGaxis) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_printObj" + c_tgaxis_printobj :: Ptr RawTGaxis -> CString -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_Write" c_tgaxis_write - :: (Ptr RawTGaxis) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SaveAs" + c_tgaxis_saveas :: Ptr RawTGaxis -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_GetLineColor" c_tgaxis_getlinecolor - :: (Ptr RawTGaxis) -> IO CInt +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_Write" + c_tgaxis_write :: + Ptr RawTGaxis -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTGaxis.h TGaxis_GetLineStyle" c_tgaxis_getlinestyle - :: (Ptr RawTGaxis) -> IO CInt +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_GetLineColor" + c_tgaxis_getlinecolor :: Ptr RawTGaxis -> IO CInt -foreign import ccall "HROOTGrafTGaxis.h TGaxis_GetLineWidth" c_tgaxis_getlinewidth - :: (Ptr RawTGaxis) -> IO CInt +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_GetLineStyle" + c_tgaxis_getlinestyle :: Ptr RawTGaxis -> IO CInt -foreign import ccall "HROOTGrafTGaxis.h TGaxis_ResetAttLine" c_tgaxis_resetattline - :: (Ptr RawTGaxis) -> CString -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_GetLineWidth" + c_tgaxis_getlinewidth :: Ptr RawTGaxis -> IO CInt -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetLineAttributes" c_tgaxis_setlineattributes - :: (Ptr RawTGaxis) -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_ResetAttLine" + c_tgaxis_resetattline :: Ptr RawTGaxis -> CString -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetLineColor" c_tgaxis_setlinecolor - :: (Ptr RawTGaxis) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGaxis.h TGaxis_SetLineAttributes" + c_tgaxis_setlineattributes :: Ptr RawTGaxis -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetLineStyle" c_tgaxis_setlinestyle - :: (Ptr RawTGaxis) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetLineColor" + c_tgaxis_setlinecolor :: Ptr RawTGaxis -> CInt -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_SetLineWidth" c_tgaxis_setlinewidth - :: (Ptr RawTGaxis) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetLineStyle" + c_tgaxis_setlinestyle :: Ptr RawTGaxis -> CInt -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_delete" c_tgaxis_delete - :: (Ptr RawTGaxis) -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_SetLineWidth" + c_tgaxis_setlinewidth :: Ptr RawTGaxis -> CInt -> IO () -foreign import ccall "HROOTGrafTGaxis.h TGaxis_newTGaxis" c_tgaxis_newtgaxis - :: CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CInt -> CString -> CDouble -> IO (Ptr RawTGaxis) +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_delete" + c_tgaxis_delete :: Ptr RawTGaxis -> IO () +foreign import ccall safe "HROOTGrafTGaxis.h TGaxis_newTGaxis" + c_tgaxis_newtgaxis :: + CDouble -> + CDouble -> + CDouble -> + CDouble -> + CDouble -> + CDouble -> CInt -> CString -> CDouble -> IO (Ptr RawTGaxis) diff --git a/src/HROOT/Graf/TGaxis/Implementation.hs b/src/HROOT/Graf/TGaxis/Implementation.hs --- a/src/HROOT/Graf/TGaxis/Implementation.hs +++ b/src/HROOT/Graf/TGaxis/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TGaxis.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TGaxis.RawType import HROOT.Graf.TGaxis.FFI import HROOT.Graf.TGaxis.Interface @@ -30,114 +31,60 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITGaxis TGaxis -instance ITGaxis TGaxis where instance ITLine TGaxis where - drawLine = xform4 c_tgaxis_drawline - drawLineNDC = xform4 c_tgaxis_drawlinendc - paintLine = xform4 c_tgaxis_paintline - paintLineNDC = xform4 c_tgaxis_paintlinendc - setX1 = xform1 c_tgaxis_setx1 - setX2 = xform1 c_tgaxis_setx2 - setY1 = xform1 c_tgaxis_sety1 - setY2 = xform1 c_tgaxis_sety2 + drawLine = xform4 c_tgaxis_drawline + drawLineNDC = xform4 c_tgaxis_drawlinendc + paintLine = xform4 c_tgaxis_paintline + paintLineNDC = xform4 c_tgaxis_paintlinendc + setX1 = xform1 c_tgaxis_setx1 + setX2 = xform1 c_tgaxis_setx2 + setY1 = xform1 c_tgaxis_sety1 + setY2 = xform1 c_tgaxis_sety2 + instance ITAttText TGaxis where - getTextAlign = xform0 c_tgaxis_gettextalign - getTextAngle = xform0 c_tgaxis_gettextangle - getTextColor = xform0 c_tgaxis_gettextcolor - getTextFont = xform0 c_tgaxis_gettextfont - getTextSize = xform0 c_tgaxis_gettextsize - resetAttText = xform1 c_tgaxis_resetatttext - setTextAttributes = xform0 c_tgaxis_settextattributes - setTextAlign = xform1 c_tgaxis_settextalign - setTextAngle = xform1 c_tgaxis_settextangle - setTextColor = xform1 c_tgaxis_settextcolor - setTextFont = xform1 c_tgaxis_settextfont - setTextSize = xform1 c_tgaxis_settextsize - setTextSizePixels = xform1 c_tgaxis_settextsizepixels -instance ITObject TGaxis where - draw = xform1 c_tgaxis_draw - findObject = xform1 c_tgaxis_findobject - getName = xform0 c_tgaxis_getname - isA = xform0 c_tgaxis_isa - paint = xform1 c_tgaxis_paint - printObj = xform1 c_tgaxis_printobj - saveAs = xform2 c_tgaxis_saveas - write = xform3 c_tgaxis_write -instance ITAttLine TGaxis where - getLineColor = xform0 c_tgaxis_getlinecolor - getLineStyle = xform0 c_tgaxis_getlinestyle - getLineWidth = xform0 c_tgaxis_getlinewidth - resetAttLine = xform1 c_tgaxis_resetattline - setLineAttributes = xform0 c_tgaxis_setlineattributes - setLineColor = xform1 c_tgaxis_setlinecolor - setLineStyle = xform1 c_tgaxis_setlinestyle - setLineWidth = xform1 c_tgaxis_setlinewidth -instance IDeletable TGaxis where - delete = xform0 c_tgaxis_delete + getTextAlign = xform0 c_tgaxis_gettextalign + getTextAngle = xform0 c_tgaxis_gettextangle + getTextColor = xform0 c_tgaxis_gettextcolor + getTextFont = xform0 c_tgaxis_gettextfont + getTextSize = xform0 c_tgaxis_gettextsize + resetAttText = xform1 c_tgaxis_resetatttext + setTextAttributes = xform0 c_tgaxis_settextattributes + setTextAlign = xform1 c_tgaxis_settextalign + setTextAngle = xform1 c_tgaxis_settextangle + setTextColor = xform1 c_tgaxis_settextcolor + setTextFont = xform1 c_tgaxis_settextfont + setTextSize = xform1 c_tgaxis_settextsize + setTextSizePixels = xform1 c_tgaxis_settextsizepixels -instance ITGaxis (Exist TGaxis) where +instance ITObject TGaxis where + draw = xform1 c_tgaxis_draw + findObject = xform1 c_tgaxis_findobject + getName = xform0 c_tgaxis_getname + isA = xform0 c_tgaxis_isa + paint = xform1 c_tgaxis_paint + printObj = xform1 c_tgaxis_printobj + saveAs = xform2 c_tgaxis_saveas + write = xform3 c_tgaxis_write -instance ITLine (Exist TGaxis) where - drawLine (ETGaxis x) = drawLine x - drawLineNDC (ETGaxis x) = drawLineNDC x - paintLine (ETGaxis x) = paintLine x - paintLineNDC (ETGaxis x) = paintLineNDC x - setX1 (ETGaxis x) = setX1 x - setX2 (ETGaxis x) = setX2 x - setY1 (ETGaxis x) = setY1 x - setY2 (ETGaxis x) = setY2 x -instance ITAttText (Exist TGaxis) where - getTextAlign (ETGaxis x) = getTextAlign x - getTextAngle (ETGaxis x) = getTextAngle x - getTextColor (ETGaxis x) = getTextColor x - getTextFont (ETGaxis x) = getTextFont x - getTextSize (ETGaxis x) = getTextSize x - resetAttText (ETGaxis x) = resetAttText x - setTextAttributes (ETGaxis x) = setTextAttributes x - setTextAlign (ETGaxis x) = setTextAlign x - setTextAngle (ETGaxis x) = setTextAngle x - setTextColor (ETGaxis x) = setTextColor x - setTextFont (ETGaxis x) = setTextFont x - setTextSize (ETGaxis x) = setTextSize x - setTextSizePixels (ETGaxis x) = setTextSizePixels x -instance ITObject (Exist TGaxis) where - draw (ETGaxis x) = draw x - findObject (ETGaxis x) = findObject x - getName (ETGaxis x) = getName x - isA (ETGaxis x) = isA x - paint (ETGaxis x) = paint x - printObj (ETGaxis x) = printObj x - saveAs (ETGaxis x) = saveAs x - write (ETGaxis x) = write x -instance ITAttLine (Exist TGaxis) where - getLineColor (ETGaxis x) = getLineColor x - getLineStyle (ETGaxis x) = getLineStyle x - getLineWidth (ETGaxis x) = getLineWidth x - resetAttLine (ETGaxis x) = resetAttLine x - setLineAttributes (ETGaxis x) = setLineAttributes x - setLineColor (ETGaxis x) = setLineColor x - setLineStyle (ETGaxis x) = setLineStyle x - setLineWidth (ETGaxis x) = setLineWidth x -instance IDeletable (Exist TGaxis) where - delete (ETGaxis x) = delete x +instance ITAttLine TGaxis where + getLineColor = xform0 c_tgaxis_getlinecolor + getLineStyle = xform0 c_tgaxis_getlinestyle + getLineWidth = xform0 c_tgaxis_getlinewidth + resetAttLine = xform1 c_tgaxis_resetattline + setLineAttributes = xform0 c_tgaxis_setlineattributes + setLineColor = xform1 c_tgaxis_setlinecolor + setLineStyle = xform1 c_tgaxis_setlinestyle + setLineWidth = xform1 c_tgaxis_setlinewidth +instance IDeletable TGaxis where + delete = xform0 c_tgaxis_delete -newTGaxis :: CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CInt -> CString -> CDouble -> IO TGaxis +newTGaxis :: + Castable c0 CString => + CDouble -> + CDouble -> + CDouble -> + CDouble -> CDouble -> CDouble -> CInt -> c0 -> CDouble -> IO TGaxis newTGaxis = xform8 c_tgaxis_newtgaxis - - - - - -instance FPtr (Exist TGaxis) where - type Raw (Exist TGaxis) = RawTGaxis - get_fptr (ETGaxis obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETGaxis (cast_fptr_to_obj (fptr :: ForeignPtr RawTGaxis) :: TGaxis) diff --git a/src/HROOT/Graf/TGaxis/Interface.hs b/src/HROOT/Graf/TGaxis/Interface.hs --- a/src/HROOT/Graf/TGaxis/Interface.hs +++ b/src/HROOT/Graf/TGaxis/Interface.hs @@ -1,37 +1,26 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TGaxis.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TGaxis.RawType - import HROOT.Graf.TLine.Interface import HROOT.Core.TAttText.Interface ----- ============ ---- - - -class (ITLine a,ITAttText a) => ITGaxis a where - -instance Existable TGaxis where - data Exist TGaxis = forall a. (FPtr a, ITGaxis a) => ETGaxis a +class (ITLine a, ITAttText a) => ITGaxis a -upcastTGaxis :: (FPtr a, ITGaxis a) => a -> TGaxis -upcastTGaxis h = let fh = get_fptr h - fh2 :: ForeignPtr RawTGaxis = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTGaxis :: forall a . (FPtr a, ITGaxis a) => a -> TGaxis +upcastTGaxis h + = let fh = get_fptr h + fh2 :: Ptr RawTGaxis = castPtr fh + in cast_fptr_to_obj fh2 -downcastTGaxis :: (FPtr a, ITGaxis a) => TGaxis -> a -downcastTGaxis h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTGaxis :: forall a . (FPtr a, ITGaxis a) => TGaxis -> a +downcastTGaxis h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TGaxis/RawType.hs b/src/HROOT/Graf/TGaxis/RawType.hs --- a/src/HROOT/Graf/TGaxis/RawType.hs +++ b/src/HROOT/Graf/TGaxis/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TGaxis.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTGaxis -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TGaxis = TGaxis (Ptr RawTGaxis) + deriving (Eq, Ord, Show) -data RawTGaxis -newtype TGaxis = TGaxis (ForeignPtr RawTGaxis) deriving (Eq, Ord, Show) instance FPtr TGaxis where - type Raw TGaxis = RawTGaxis - get_fptr (TGaxis fptr) = fptr - cast_fptr_to_obj = TGaxis + type Raw TGaxis = RawTGaxis + get_fptr (TGaxis ptr) = ptr + cast_fptr_to_obj = TGaxis diff --git a/src/HROOT/Graf/TGraphPolar.hs b/src/HROOT/Graf/TGraphPolar.hs --- a/src/HROOT/Graf/TGraphPolar.hs +++ b/src/HROOT/Graf/TGraphPolar.hs @@ -1,15 +1,7 @@ module HROOT.Graf.TGraphPolar - ( - TGraphPolar(..) - , ITGraphPolar - , upcastTGraphPolar - , downcastTGraphPolar - , newTGraphPolar - - ) where - + (TGraphPolar(..), ITGraphPolar, upcastTGraphPolar, + downcastTGraphPolar, newTGraphPolar) + where import HROOT.Graf.TGraphPolar.RawType import HROOT.Graf.TGraphPolar.Interface import HROOT.Graf.TGraphPolar.Implementation - - diff --git a/src/HROOT/Graf/TGraphPolar/Cast.hs b/src/HROOT/Graf/TGraphPolar/Cast.hs --- a/src/HROOT/Graf/TGraphPolar/Cast.hs +++ b/src/HROOT/Graf/TGraphPolar/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TGraphPolar.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TGraphPolar.RawType import HROOT.Graf.TGraphPolar.Interface -instance (ITGraphPolar a, FPtr a) => Castable a (Ptr RawTGraphPolar) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITGraphPolar a, FPtr a) => Castable a + (Ptr RawTGraphPolar) where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TGraphPolar (Ptr RawTGraphPolar) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TGraphPolar/FFI.hsc b/src/HROOT/Graf/TGraphPolar/FFI.hsc --- a/src/HROOT/Graf/TGraphPolar/FFI.hsc +++ b/src/HROOT/Graf/TGraphPolar/FFI.hsc @@ -1,17 +1,7 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TGraphPolar.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TGraphPolar.RawType import HROOT.Hist.TF1.RawType import HROOT.Hist.TH1F.RawType @@ -19,194 +9,282 @@ import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTGraphPolar.h" - -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_Apply" c_tgraphpolar_apply - :: (Ptr RawTGraphPolar) -> (Ptr RawTF1) -> IO () - -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_Chisquare" c_tgraphpolar_chisquare - :: (Ptr RawTGraphPolar) -> (Ptr RawTF1) -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_Apply" c_tgraphpolar_apply :: + Ptr RawTGraphPolar -> Ptr RawTF1 -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_DrawGraph" c_tgraphpolar_drawgraph - :: (Ptr RawTGraphPolar) -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_Chisquare" + c_tgraphpolar_chisquare :: + Ptr RawTGraphPolar -> Ptr RawTF1 -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_drawPanelTGraph" c_tgraphpolar_drawpaneltgraph - :: (Ptr RawTGraphPolar) -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_DrawGraph" + c_tgraphpolar_drawgraph :: + Ptr RawTGraphPolar -> + CInt -> (Ptr CDouble) -> (Ptr CDouble) -> CString -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_Expand" c_tgraphpolar_expand - :: (Ptr RawTGraphPolar) -> CInt -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_drawPanelTGraph" + c_tgraphpolar_drawpaneltgraph :: Ptr RawTGraphPolar -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_FitPanelTGraph" c_tgraphpolar_fitpaneltgraph - :: (Ptr RawTGraphPolar) -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_Expand" c_tgraphpolar_expand :: + Ptr RawTGraphPolar -> CInt -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_getCorrelationFactorTGraph" c_tgraphpolar_getcorrelationfactortgraph - :: (Ptr RawTGraphPolar) -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_FitPanelTGraph" + c_tgraphpolar_fitpaneltgraph :: Ptr RawTGraphPolar -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_getCovarianceTGraph" c_tgraphpolar_getcovariancetgraph - :: (Ptr RawTGraphPolar) -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_getCorrelationFactorTGraph" + c_tgraphpolar_getcorrelationfactortgraph :: + Ptr RawTGraphPolar -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_getMeanTGraph" c_tgraphpolar_getmeantgraph - :: (Ptr RawTGraphPolar) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_getCovarianceTGraph" + c_tgraphpolar_getcovariancetgraph :: + Ptr RawTGraphPolar -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_getRMSTGraph" c_tgraphpolar_getrmstgraph - :: (Ptr RawTGraphPolar) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_getMeanTGraph" + c_tgraphpolar_getmeantgraph :: + Ptr RawTGraphPolar -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorX" c_tgraphpolar_geterrorx - :: (Ptr RawTGraphPolar) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_getRMSTGraph" + c_tgraphpolar_getrmstgraph :: + Ptr RawTGraphPolar -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorY" c_tgraphpolar_geterrory - :: (Ptr RawTGraphPolar) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorX" + c_tgraphpolar_geterrorx :: Ptr RawTGraphPolar -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorXhigh" c_tgraphpolar_geterrorxhigh - :: (Ptr RawTGraphPolar) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorY" + c_tgraphpolar_geterrory :: Ptr RawTGraphPolar -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorXlow" c_tgraphpolar_geterrorxlow - :: (Ptr RawTGraphPolar) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorXhigh" + c_tgraphpolar_geterrorxhigh :: + Ptr RawTGraphPolar -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorYhigh" c_tgraphpolar_geterroryhigh - :: (Ptr RawTGraphPolar) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorXlow" + c_tgraphpolar_geterrorxlow :: + Ptr RawTGraphPolar -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorYlow" c_tgraphpolar_geterrorylow - :: (Ptr RawTGraphPolar) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorYhigh" + c_tgraphpolar_geterroryhigh :: + Ptr RawTGraphPolar -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_InitExpo" c_tgraphpolar_initexpo - :: (Ptr RawTGraphPolar) -> CDouble -> CDouble -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetErrorYlow" + c_tgraphpolar_geterrorylow :: + Ptr RawTGraphPolar -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_InitGaus" c_tgraphpolar_initgaus - :: (Ptr RawTGraphPolar) -> CDouble -> CDouble -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_InitExpo" + c_tgraphpolar_initexpo :: + Ptr RawTGraphPolar -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_InitPolynom" c_tgraphpolar_initpolynom - :: (Ptr RawTGraphPolar) -> CDouble -> CDouble -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_InitGaus" + c_tgraphpolar_initgaus :: + Ptr RawTGraphPolar -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_InsertPoint" c_tgraphpolar_insertpoint - :: (Ptr RawTGraphPolar) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_InitPolynom" + c_tgraphpolar_initpolynom :: + Ptr RawTGraphPolar -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_integralTGraph" c_tgraphpolar_integraltgraph - :: (Ptr RawTGraphPolar) -> CInt -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_InsertPoint" + c_tgraphpolar_insertpoint :: Ptr RawTGraphPolar -> IO CInt -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_IsEditable" c_tgraphpolar_iseditable - :: (Ptr RawTGraphPolar) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_integralTGraph" + c_tgraphpolar_integraltgraph :: + Ptr RawTGraphPolar -> CInt -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_isInsideTGraph" c_tgraphpolar_isinsidetgraph - :: (Ptr RawTGraphPolar) -> CDouble -> CDouble -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_IsEditable" + c_tgraphpolar_iseditable :: Ptr RawTGraphPolar -> IO CInt -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_LeastSquareFit" c_tgraphpolar_leastsquarefit - :: (Ptr RawTGraphPolar) -> CInt -> (Ptr CDouble) -> CDouble -> CDouble -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_isInsideTGraph" + c_tgraphpolar_isinsidetgraph :: + Ptr RawTGraphPolar -> CDouble -> CDouble -> IO CInt -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_PaintStats" c_tgraphpolar_paintstats - :: (Ptr RawTGraphPolar) -> (Ptr RawTF1) -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_LeastSquareFit" + c_tgraphpolar_leastsquarefit :: + Ptr RawTGraphPolar -> + CInt -> (Ptr CDouble) -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_RemovePoint" c_tgraphpolar_removepoint - :: (Ptr RawTGraphPolar) -> CInt -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_PaintStats" + c_tgraphpolar_paintstats :: + Ptr RawTGraphPolar -> Ptr RawTF1 -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetEditable" c_tgraphpolar_seteditable - :: (Ptr RawTGraphPolar) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_RemovePoint" + c_tgraphpolar_removepoint :: Ptr RawTGraphPolar -> CInt -> IO CInt -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetHistogram" c_tgraphpolar_sethistogram - :: (Ptr RawTGraphPolar) -> (Ptr RawTH1F) -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetEditable" + c_tgraphpolar_seteditable :: Ptr RawTGraphPolar -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_setMaximumTGraph" c_tgraphpolar_setmaximumtgraph - :: (Ptr RawTGraphPolar) -> CDouble -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetHistogram" + c_tgraphpolar_sethistogram :: + Ptr RawTGraphPolar -> Ptr RawTH1F -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_setMinimumTGraph" c_tgraphpolar_setminimumtgraph - :: (Ptr RawTGraphPolar) -> CDouble -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_setMaximumTGraph" + c_tgraphpolar_setmaximumtgraph :: + Ptr RawTGraphPolar -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_Set" c_tgraphpolar_set - :: (Ptr RawTGraphPolar) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_setMinimumTGraph" + c_tgraphpolar_setminimumtgraph :: + Ptr RawTGraphPolar -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetPoint" c_tgraphpolar_setpoint - :: (Ptr RawTGraphPolar) -> CInt -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGraphPolar.h TGraphPolar_Set" + c_tgraphpolar_set :: Ptr RawTGraphPolar -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetName" c_tgraphpolar_setname - :: (Ptr RawTGraphPolar) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetPoint" + c_tgraphpolar_setpoint :: + Ptr RawTGraphPolar -> CInt -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetNameTitle" c_tgraphpolar_setnametitle - :: (Ptr RawTGraphPolar) -> CString -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetName" c_tgraphpolar_setname + :: Ptr RawTGraphPolar -> CString -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetTitle" c_tgraphpolar_settitle - :: (Ptr RawTGraphPolar) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetNameTitle" + c_tgraphpolar_setnametitle :: + Ptr RawTGraphPolar -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetLineColor" c_tgraphpolar_getlinecolor - :: (Ptr RawTGraphPolar) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetTitle" + c_tgraphpolar_settitle :: Ptr RawTGraphPolar -> CString -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetLineStyle" c_tgraphpolar_getlinestyle - :: (Ptr RawTGraphPolar) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetLineColor" + c_tgraphpolar_getlinecolor :: Ptr RawTGraphPolar -> IO CInt -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetLineWidth" c_tgraphpolar_getlinewidth - :: (Ptr RawTGraphPolar) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetLineStyle" + c_tgraphpolar_getlinestyle :: Ptr RawTGraphPolar -> IO CInt -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_ResetAttLine" c_tgraphpolar_resetattline - :: (Ptr RawTGraphPolar) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetLineWidth" + c_tgraphpolar_getlinewidth :: Ptr RawTGraphPolar -> IO CInt -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetLineAttributes" c_tgraphpolar_setlineattributes - :: (Ptr RawTGraphPolar) -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_ResetAttLine" + c_tgraphpolar_resetattline :: + Ptr RawTGraphPolar -> CString -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetLineColor" c_tgraphpolar_setlinecolor - :: (Ptr RawTGraphPolar) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetLineAttributes" + c_tgraphpolar_setlineattributes :: Ptr RawTGraphPolar -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetLineStyle" c_tgraphpolar_setlinestyle - :: (Ptr RawTGraphPolar) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetLineColor" + c_tgraphpolar_setlinecolor :: Ptr RawTGraphPolar -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetLineWidth" c_tgraphpolar_setlinewidth - :: (Ptr RawTGraphPolar) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetLineStyle" + c_tgraphpolar_setlinestyle :: Ptr RawTGraphPolar -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetFillColor" c_tgraphpolar_setfillcolor - :: (Ptr RawTGraphPolar) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetLineWidth" + c_tgraphpolar_setlinewidth :: Ptr RawTGraphPolar -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetFillStyle" c_tgraphpolar_setfillstyle - :: (Ptr RawTGraphPolar) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetFillColor" + c_tgraphpolar_setfillcolor :: Ptr RawTGraphPolar -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetMarkerColor" c_tgraphpolar_getmarkercolor - :: (Ptr RawTGraphPolar) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetFillStyle" + c_tgraphpolar_setfillstyle :: Ptr RawTGraphPolar -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetMarkerStyle" c_tgraphpolar_getmarkerstyle - :: (Ptr RawTGraphPolar) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetMarkerColor" + c_tgraphpolar_getmarkercolor :: Ptr RawTGraphPolar -> IO CInt -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetMarkerSize" c_tgraphpolar_getmarkersize - :: (Ptr RawTGraphPolar) -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetMarkerStyle" + c_tgraphpolar_getmarkerstyle :: Ptr RawTGraphPolar -> IO CInt -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_ResetAttMarker" c_tgraphpolar_resetattmarker - :: (Ptr RawTGraphPolar) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetMarkerSize" + c_tgraphpolar_getmarkersize :: Ptr RawTGraphPolar -> IO CDouble -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetMarkerAttributes" c_tgraphpolar_setmarkerattributes - :: (Ptr RawTGraphPolar) -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_ResetAttMarker" + c_tgraphpolar_resetattmarker :: + Ptr RawTGraphPolar -> CString -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetMarkerColor" c_tgraphpolar_setmarkercolor - :: (Ptr RawTGraphPolar) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetMarkerAttributes" + c_tgraphpolar_setmarkerattributes :: Ptr RawTGraphPolar -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetMarkerStyle" c_tgraphpolar_setmarkerstyle - :: (Ptr RawTGraphPolar) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetMarkerColor" + c_tgraphpolar_setmarkercolor :: Ptr RawTGraphPolar -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SetMarkerSize" c_tgraphpolar_setmarkersize - :: (Ptr RawTGraphPolar) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetMarkerStyle" + c_tgraphpolar_setmarkerstyle :: Ptr RawTGraphPolar -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_Draw" c_tgraphpolar_draw - :: (Ptr RawTGraphPolar) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SetMarkerSize" + c_tgraphpolar_setmarkersize :: Ptr RawTGraphPolar -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_FindObject" c_tgraphpolar_findobject - :: (Ptr RawTGraphPolar) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTGraphPolar.h TGraphPolar_Draw" + c_tgraphpolar_draw :: Ptr RawTGraphPolar -> CString -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_GetName" c_tgraphpolar_getname - :: (Ptr RawTGraphPolar) -> IO CString +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_FindObject" + c_tgraphpolar_findobject :: + Ptr RawTGraphPolar -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_IsA" c_tgraphpolar_isa - :: (Ptr RawTGraphPolar) -> IO (Ptr RawTClass) +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_GetName" c_tgraphpolar_getname + :: Ptr RawTGraphPolar -> IO CString -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_Paint" c_tgraphpolar_paint - :: (Ptr RawTGraphPolar) -> CString -> IO () +foreign import ccall safe "HROOTGrafTGraphPolar.h TGraphPolar_IsA" + c_tgraphpolar_isa :: Ptr RawTGraphPolar -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_printObj" c_tgraphpolar_printobj - :: (Ptr RawTGraphPolar) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_Paint" c_tgraphpolar_paint :: + Ptr RawTGraphPolar -> CString -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_SaveAs" c_tgraphpolar_saveas - :: (Ptr RawTGraphPolar) -> CString -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_printObj" + c_tgraphpolar_printobj :: Ptr RawTGraphPolar -> CString -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_Write" c_tgraphpolar_write - :: (Ptr RawTGraphPolar) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_SaveAs" c_tgraphpolar_saveas :: + Ptr RawTGraphPolar -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_delete" c_tgraphpolar_delete - :: (Ptr RawTGraphPolar) -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_Write" c_tgraphpolar_write :: + Ptr RawTGraphPolar -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTGraphPolar.h TGraphPolar_newTGraphPolar" c_tgraphpolar_newtgraphpolar - :: CInt -> (Ptr CDouble) -> (Ptr CDouble) -> (Ptr CDouble) -> (Ptr CDouble) -> IO (Ptr RawTGraphPolar) +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_delete" c_tgraphpolar_delete :: + Ptr RawTGraphPolar -> IO () +foreign import ccall safe + "HROOTGrafTGraphPolar.h TGraphPolar_newTGraphPolar" + c_tgraphpolar_newtgraphpolar :: + CInt -> + (Ptr CDouble) -> + (Ptr CDouble) -> + (Ptr CDouble) -> (Ptr CDouble) -> IO (Ptr RawTGraphPolar) diff --git a/src/HROOT/Graf/TGraphPolar/Implementation.hs b/src/HROOT/Graf/TGraphPolar/Implementation.hs --- a/src/HROOT/Graf/TGraphPolar/Implementation.hs +++ b/src/HROOT/Graf/TGraphPolar/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TGraphPolar.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TGraphPolar.RawType import HROOT.Graf.TGraphPolar.FFI import HROOT.Graf.TGraphPolar.Interface @@ -48,169 +49,89 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITGraphPolar TGraphPolar +instance ITGraphErrors TGraphPolar -instance ITGraphPolar TGraphPolar where -instance ITGraphErrors TGraphPolar where instance ITGraph TGraphPolar where - apply = xform1 c_tgraphpolar_apply - chisquare = xform1 c_tgraphpolar_chisquare - drawGraph = xform4 c_tgraphpolar_drawgraph - drawPanelTGraph = xform0 c_tgraphpolar_drawpaneltgraph - expand = xform2 c_tgraphpolar_expand - fitPanelTGraph = xform0 c_tgraphpolar_fitpaneltgraph - getCorrelationFactorTGraph = xform0 c_tgraphpolar_getcorrelationfactortgraph - getCovarianceTGraph = xform0 c_tgraphpolar_getcovariancetgraph - getMeanTGraph = xform1 c_tgraphpolar_getmeantgraph - getRMSTGraph = xform1 c_tgraphpolar_getrmstgraph - getErrorX = xform1 c_tgraphpolar_geterrorx - getErrorY = xform1 c_tgraphpolar_geterrory - getErrorXhigh = xform1 c_tgraphpolar_geterrorxhigh - getErrorXlow = xform1 c_tgraphpolar_geterrorxlow - getErrorYhigh = xform1 c_tgraphpolar_geterroryhigh - getErrorYlow = xform1 c_tgraphpolar_geterrorylow - initExpo = xform2 c_tgraphpolar_initexpo - initGaus = xform2 c_tgraphpolar_initgaus - initPolynom = xform2 c_tgraphpolar_initpolynom - insertPoint = xform0 c_tgraphpolar_insertpoint - integralTGraph = xform2 c_tgraphpolar_integraltgraph - isEditable = xform0 c_tgraphpolar_iseditable - isInsideTGraph = xform2 c_tgraphpolar_isinsidetgraph - leastSquareFit = xform4 c_tgraphpolar_leastsquarefit - paintStats = xform1 c_tgraphpolar_paintstats - removePoint = xform1 c_tgraphpolar_removepoint - setEditable = xform1 c_tgraphpolar_seteditable - setHistogram = xform1 c_tgraphpolar_sethistogram - setMaximumTGraph = xform1 c_tgraphpolar_setmaximumtgraph - setMinimumTGraph = xform1 c_tgraphpolar_setminimumtgraph - set = xform1 c_tgraphpolar_set - setPoint = xform3 c_tgraphpolar_setpoint + apply = xform1 c_tgraphpolar_apply + chisquare = xform1 c_tgraphpolar_chisquare + drawGraph = xform4 c_tgraphpolar_drawgraph + drawPanelTGraph = xform0 c_tgraphpolar_drawpaneltgraph + expand = xform2 c_tgraphpolar_expand + fitPanelTGraph = xform0 c_tgraphpolar_fitpaneltgraph + getCorrelationFactorTGraph + = xform0 c_tgraphpolar_getcorrelationfactortgraph + getCovarianceTGraph = xform0 c_tgraphpolar_getcovariancetgraph + getMeanTGraph = xform1 c_tgraphpolar_getmeantgraph + getRMSTGraph = xform1 c_tgraphpolar_getrmstgraph + getErrorX = xform1 c_tgraphpolar_geterrorx + getErrorY = xform1 c_tgraphpolar_geterrory + getErrorXhigh = xform1 c_tgraphpolar_geterrorxhigh + getErrorXlow = xform1 c_tgraphpolar_geterrorxlow + getErrorYhigh = xform1 c_tgraphpolar_geterroryhigh + getErrorYlow = xform1 c_tgraphpolar_geterrorylow + initExpo = xform2 c_tgraphpolar_initexpo + initGaus = xform2 c_tgraphpolar_initgaus + initPolynom = xform2 c_tgraphpolar_initpolynom + insertPoint = xform0 c_tgraphpolar_insertpoint + integralTGraph = xform2 c_tgraphpolar_integraltgraph + isEditable = xform0 c_tgraphpolar_iseditable + isInsideTGraph = xform2 c_tgraphpolar_isinsidetgraph + leastSquareFit = xform4 c_tgraphpolar_leastsquarefit + paintStats = xform1 c_tgraphpolar_paintstats + removePoint = xform1 c_tgraphpolar_removepoint + setEditable = xform1 c_tgraphpolar_seteditable + setHistogram = xform1 c_tgraphpolar_sethistogram + setMaximumTGraph = xform1 c_tgraphpolar_setmaximumtgraph + setMinimumTGraph = xform1 c_tgraphpolar_setminimumtgraph + set = xform1 c_tgraphpolar_set + setPoint = xform3 c_tgraphpolar_setpoint + instance ITNamed TGraphPolar where - setName = xform1 c_tgraphpolar_setname - setNameTitle = xform2 c_tgraphpolar_setnametitle - setTitle = xform1 c_tgraphpolar_settitle + setName = xform1 c_tgraphpolar_setname + setNameTitle = xform2 c_tgraphpolar_setnametitle + setTitle = xform1 c_tgraphpolar_settitle + instance ITAttLine TGraphPolar where - getLineColor = xform0 c_tgraphpolar_getlinecolor - getLineStyle = xform0 c_tgraphpolar_getlinestyle - getLineWidth = xform0 c_tgraphpolar_getlinewidth - resetAttLine = xform1 c_tgraphpolar_resetattline - setLineAttributes = xform0 c_tgraphpolar_setlineattributes - setLineColor = xform1 c_tgraphpolar_setlinecolor - setLineStyle = xform1 c_tgraphpolar_setlinestyle - setLineWidth = xform1 c_tgraphpolar_setlinewidth -instance ITAttFill TGraphPolar where - setFillColor = xform1 c_tgraphpolar_setfillcolor - setFillStyle = xform1 c_tgraphpolar_setfillstyle -instance ITAttMarker TGraphPolar where - getMarkerColor = xform0 c_tgraphpolar_getmarkercolor - getMarkerStyle = xform0 c_tgraphpolar_getmarkerstyle - getMarkerSize = xform0 c_tgraphpolar_getmarkersize - resetAttMarker = xform1 c_tgraphpolar_resetattmarker - setMarkerAttributes = xform0 c_tgraphpolar_setmarkerattributes - setMarkerColor = xform1 c_tgraphpolar_setmarkercolor - setMarkerStyle = xform1 c_tgraphpolar_setmarkerstyle - setMarkerSize = xform1 c_tgraphpolar_setmarkersize -instance ITObject TGraphPolar where - draw = xform1 c_tgraphpolar_draw - findObject = xform1 c_tgraphpolar_findobject - getName = xform0 c_tgraphpolar_getname - isA = xform0 c_tgraphpolar_isa - paint = xform1 c_tgraphpolar_paint - printObj = xform1 c_tgraphpolar_printobj - saveAs = xform2 c_tgraphpolar_saveas - write = xform3 c_tgraphpolar_write -instance IDeletable TGraphPolar where - delete = xform0 c_tgraphpolar_delete + getLineColor = xform0 c_tgraphpolar_getlinecolor + getLineStyle = xform0 c_tgraphpolar_getlinestyle + getLineWidth = xform0 c_tgraphpolar_getlinewidth + resetAttLine = xform1 c_tgraphpolar_resetattline + setLineAttributes = xform0 c_tgraphpolar_setlineattributes + setLineColor = xform1 c_tgraphpolar_setlinecolor + setLineStyle = xform1 c_tgraphpolar_setlinestyle + setLineWidth = xform1 c_tgraphpolar_setlinewidth -instance ITGraphPolar (Exist TGraphPolar) where +instance ITAttFill TGraphPolar where + setFillColor = xform1 c_tgraphpolar_setfillcolor + setFillStyle = xform1 c_tgraphpolar_setfillstyle -instance ITGraphErrors (Exist TGraphPolar) where +instance ITAttMarker TGraphPolar where + getMarkerColor = xform0 c_tgraphpolar_getmarkercolor + getMarkerStyle = xform0 c_tgraphpolar_getmarkerstyle + getMarkerSize = xform0 c_tgraphpolar_getmarkersize + resetAttMarker = xform1 c_tgraphpolar_resetattmarker + setMarkerAttributes = xform0 c_tgraphpolar_setmarkerattributes + setMarkerColor = xform1 c_tgraphpolar_setmarkercolor + setMarkerStyle = xform1 c_tgraphpolar_setmarkerstyle + setMarkerSize = xform1 c_tgraphpolar_setmarkersize -instance ITGraph (Exist TGraphPolar) where - apply (ETGraphPolar x) = apply x - chisquare (ETGraphPolar x) = chisquare x - drawGraph (ETGraphPolar x) = drawGraph x - drawPanelTGraph (ETGraphPolar x) = drawPanelTGraph x - expand (ETGraphPolar x) = expand x - fitPanelTGraph (ETGraphPolar x) = fitPanelTGraph x - getCorrelationFactorTGraph (ETGraphPolar x) = getCorrelationFactorTGraph x - getCovarianceTGraph (ETGraphPolar x) = getCovarianceTGraph x - getMeanTGraph (ETGraphPolar x) = getMeanTGraph x - getRMSTGraph (ETGraphPolar x) = getRMSTGraph x - getErrorX (ETGraphPolar x) = getErrorX x - getErrorY (ETGraphPolar x) = getErrorY x - getErrorXhigh (ETGraphPolar x) = getErrorXhigh x - getErrorXlow (ETGraphPolar x) = getErrorXlow x - getErrorYhigh (ETGraphPolar x) = getErrorYhigh x - getErrorYlow (ETGraphPolar x) = getErrorYlow x - initExpo (ETGraphPolar x) = initExpo x - initGaus (ETGraphPolar x) = initGaus x - initPolynom (ETGraphPolar x) = initPolynom x - insertPoint (ETGraphPolar x) = insertPoint x - integralTGraph (ETGraphPolar x) = integralTGraph x - isEditable (ETGraphPolar x) = isEditable x - isInsideTGraph (ETGraphPolar x) = isInsideTGraph x - leastSquareFit (ETGraphPolar x) = leastSquareFit x - paintStats (ETGraphPolar x) = paintStats x - removePoint (ETGraphPolar x) = removePoint x - setEditable (ETGraphPolar x) = setEditable x - setHistogram (ETGraphPolar x) = setHistogram x - setMaximumTGraph (ETGraphPolar x) = setMaximumTGraph x - setMinimumTGraph (ETGraphPolar x) = setMinimumTGraph x - set (ETGraphPolar x) = set x - setPoint (ETGraphPolar x) = setPoint x -instance ITNamed (Exist TGraphPolar) where - setName (ETGraphPolar x) = setName x - setNameTitle (ETGraphPolar x) = setNameTitle x - setTitle (ETGraphPolar x) = setTitle x -instance ITAttLine (Exist TGraphPolar) where - getLineColor (ETGraphPolar x) = getLineColor x - getLineStyle (ETGraphPolar x) = getLineStyle x - getLineWidth (ETGraphPolar x) = getLineWidth x - resetAttLine (ETGraphPolar x) = resetAttLine x - setLineAttributes (ETGraphPolar x) = setLineAttributes x - setLineColor (ETGraphPolar x) = setLineColor x - setLineStyle (ETGraphPolar x) = setLineStyle x - setLineWidth (ETGraphPolar x) = setLineWidth x -instance ITAttFill (Exist TGraphPolar) where - setFillColor (ETGraphPolar x) = setFillColor x - setFillStyle (ETGraphPolar x) = setFillStyle x -instance ITAttMarker (Exist TGraphPolar) where - getMarkerColor (ETGraphPolar x) = getMarkerColor x - getMarkerStyle (ETGraphPolar x) = getMarkerStyle x - getMarkerSize (ETGraphPolar x) = getMarkerSize x - resetAttMarker (ETGraphPolar x) = resetAttMarker x - setMarkerAttributes (ETGraphPolar x) = setMarkerAttributes x - setMarkerColor (ETGraphPolar x) = setMarkerColor x - setMarkerStyle (ETGraphPolar x) = setMarkerStyle x - setMarkerSize (ETGraphPolar x) = setMarkerSize x -instance ITObject (Exist TGraphPolar) where - draw (ETGraphPolar x) = draw x - findObject (ETGraphPolar x) = findObject x - getName (ETGraphPolar x) = getName x - isA (ETGraphPolar x) = isA x - paint (ETGraphPolar x) = paint x - printObj (ETGraphPolar x) = printObj x - saveAs (ETGraphPolar x) = saveAs x - write (ETGraphPolar x) = write x -instance IDeletable (Exist TGraphPolar) where - delete (ETGraphPolar x) = delete x +instance ITObject TGraphPolar where + draw = xform1 c_tgraphpolar_draw + findObject = xform1 c_tgraphpolar_findobject + getName = xform0 c_tgraphpolar_getname + isA = xform0 c_tgraphpolar_isa + paint = xform1 c_tgraphpolar_paint + printObj = xform1 c_tgraphpolar_printobj + saveAs = xform2 c_tgraphpolar_saveas + write = xform3 c_tgraphpolar_write +instance IDeletable TGraphPolar where + delete = xform0 c_tgraphpolar_delete -newTGraphPolar :: CInt -> (Ptr CDouble) -> (Ptr CDouble) -> (Ptr CDouble) -> (Ptr CDouble) -> IO TGraphPolar +newTGraphPolar :: + CInt -> + (Ptr CDouble) -> + (Ptr CDouble) -> (Ptr CDouble) -> (Ptr CDouble) -> IO TGraphPolar newTGraphPolar = xform4 c_tgraphpolar_newtgraphpolar - - - - - -instance FPtr (Exist TGraphPolar) where - type Raw (Exist TGraphPolar) = RawTGraphPolar - get_fptr (ETGraphPolar obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETGraphPolar (cast_fptr_to_obj (fptr :: ForeignPtr RawTGraphPolar) :: TGraphPolar) diff --git a/src/HROOT/Graf/TGraphPolar/Interface.hs b/src/HROOT/Graf/TGraphPolar/Interface.hs --- a/src/HROOT/Graf/TGraphPolar/Interface.hs +++ b/src/HROOT/Graf/TGraphPolar/Interface.hs @@ -1,36 +1,27 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TGraphPolar.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TGraphPolar.RawType - import HROOT.Hist.TGraphErrors.Interface ----- ============ ---- - - -class (ITGraphErrors a) => ITGraphPolar a where - -instance Existable TGraphPolar where - data Exist TGraphPolar = forall a. (FPtr a, ITGraphPolar a) => ETGraphPolar a +class ITGraphErrors a => ITGraphPolar a -upcastTGraphPolar :: (FPtr a, ITGraphPolar a) => a -> TGraphPolar -upcastTGraphPolar h = let fh = get_fptr h - fh2 :: ForeignPtr RawTGraphPolar = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTGraphPolar :: + forall a . (FPtr a, ITGraphPolar a) => a -> TGraphPolar +upcastTGraphPolar h + = let fh = get_fptr h + fh2 :: Ptr RawTGraphPolar = castPtr fh + in cast_fptr_to_obj fh2 -downcastTGraphPolar :: (FPtr a, ITGraphPolar a) => TGraphPolar -> a -downcastTGraphPolar h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTGraphPolar :: + forall a . (FPtr a, ITGraphPolar a) => TGraphPolar -> a +downcastTGraphPolar h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TGraphPolar/RawType.hs b/src/HROOT/Graf/TGraphPolar/RawType.hs --- a/src/HROOT/Graf/TGraphPolar/RawType.hs +++ b/src/HROOT/Graf/TGraphPolar/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TGraphPolar.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTGraphPolar -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TGraphPolar = TGraphPolar (Ptr RawTGraphPolar) + deriving (Eq, Ord, Show) -data RawTGraphPolar -newtype TGraphPolar = TGraphPolar (ForeignPtr RawTGraphPolar) deriving (Eq, Ord, Show) instance FPtr TGraphPolar where - type Raw TGraphPolar = RawTGraphPolar - get_fptr (TGraphPolar fptr) = fptr - cast_fptr_to_obj = TGraphPolar + type Raw TGraphPolar = RawTGraphPolar + get_fptr (TGraphPolar ptr) = ptr + cast_fptr_to_obj = TGraphPolar diff --git a/src/HROOT/Graf/TGraphQQ.hs b/src/HROOT/Graf/TGraphQQ.hs --- a/src/HROOT/Graf/TGraphQQ.hs +++ b/src/HROOT/Graf/TGraphQQ.hs @@ -1,15 +1,7 @@ module HROOT.Graf.TGraphQQ - ( - TGraphQQ(..) - , ITGraphQQ - , upcastTGraphQQ - , downcastTGraphQQ - , newTGraphQQ - - ) where - + (TGraphQQ(..), ITGraphQQ, upcastTGraphQQ, downcastTGraphQQ, + newTGraphQQ) + where import HROOT.Graf.TGraphQQ.RawType import HROOT.Graf.TGraphQQ.Interface import HROOT.Graf.TGraphQQ.Implementation - - diff --git a/src/HROOT/Graf/TGraphQQ/Cast.hs b/src/HROOT/Graf/TGraphQQ/Cast.hs --- a/src/HROOT/Graf/TGraphQQ/Cast.hs +++ b/src/HROOT/Graf/TGraphQQ/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TGraphQQ.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TGraphQQ.RawType import HROOT.Graf.TGraphQQ.Interface -instance (ITGraphQQ a, FPtr a) => Castable a (Ptr RawTGraphQQ) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITGraphQQ a, FPtr a) => Castable a (Ptr RawTGraphQQ) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TGraphQQ (Ptr RawTGraphQQ) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TGraphQQ/FFI.hsc b/src/HROOT/Graf/TGraphQQ/FFI.hsc --- a/src/HROOT/Graf/TGraphQQ/FFI.hsc +++ b/src/HROOT/Graf/TGraphQQ/FFI.hsc @@ -1,17 +1,7 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TGraphQQ.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TGraphQQ.RawType import HROOT.Hist.TF1.RawType import HROOT.Hist.TH1F.RawType @@ -19,194 +9,245 @@ import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTGraphQQ.h" - -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_Apply" c_tgraphqq_apply - :: (Ptr RawTGraphQQ) -> (Ptr RawTF1) -> IO () - -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_Chisquare" c_tgraphqq_chisquare - :: (Ptr RawTGraphQQ) -> (Ptr RawTF1) -> IO CDouble +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_Apply" + c_tgraphqq_apply :: Ptr RawTGraphQQ -> Ptr RawTF1 -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_DrawGraph" c_tgraphqq_drawgraph - :: (Ptr RawTGraphQQ) -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> CString -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_Chisquare" + c_tgraphqq_chisquare :: Ptr RawTGraphQQ -> Ptr RawTF1 -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_drawPanelTGraph" c_tgraphqq_drawpaneltgraph - :: (Ptr RawTGraphQQ) -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_DrawGraph" + c_tgraphqq_drawgraph :: + Ptr RawTGraphQQ -> + CInt -> (Ptr CDouble) -> (Ptr CDouble) -> CString -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_Expand" c_tgraphqq_expand - :: (Ptr RawTGraphQQ) -> CInt -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_drawPanelTGraph" + c_tgraphqq_drawpaneltgraph :: Ptr RawTGraphQQ -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_FitPanelTGraph" c_tgraphqq_fitpaneltgraph - :: (Ptr RawTGraphQQ) -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_Expand" + c_tgraphqq_expand :: Ptr RawTGraphQQ -> CInt -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_getCorrelationFactorTGraph" c_tgraphqq_getcorrelationfactortgraph - :: (Ptr RawTGraphQQ) -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_FitPanelTGraph" + c_tgraphqq_fitpaneltgraph :: Ptr RawTGraphQQ -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_getCovarianceTGraph" c_tgraphqq_getcovariancetgraph - :: (Ptr RawTGraphQQ) -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_getCorrelationFactorTGraph" + c_tgraphqq_getcorrelationfactortgraph :: + Ptr RawTGraphQQ -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_getMeanTGraph" c_tgraphqq_getmeantgraph - :: (Ptr RawTGraphQQ) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_getCovarianceTGraph" + c_tgraphqq_getcovariancetgraph :: Ptr RawTGraphQQ -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_getRMSTGraph" c_tgraphqq_getrmstgraph - :: (Ptr RawTGraphQQ) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_getMeanTGraph" + c_tgraphqq_getmeantgraph :: Ptr RawTGraphQQ -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorX" c_tgraphqq_geterrorx - :: (Ptr RawTGraphQQ) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_getRMSTGraph" c_tgraphqq_getrmstgraph + :: Ptr RawTGraphQQ -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorY" c_tgraphqq_geterrory - :: (Ptr RawTGraphQQ) -> CInt -> IO CDouble +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorX" + c_tgraphqq_geterrorx :: Ptr RawTGraphQQ -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorXhigh" c_tgraphqq_geterrorxhigh - :: (Ptr RawTGraphQQ) -> CInt -> IO CDouble +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorY" + c_tgraphqq_geterrory :: Ptr RawTGraphQQ -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorXlow" c_tgraphqq_geterrorxlow - :: (Ptr RawTGraphQQ) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorXhigh" + c_tgraphqq_geterrorxhigh :: Ptr RawTGraphQQ -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorYhigh" c_tgraphqq_geterroryhigh - :: (Ptr RawTGraphQQ) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorXlow" c_tgraphqq_geterrorxlow + :: Ptr RawTGraphQQ -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorYlow" c_tgraphqq_geterrorylow - :: (Ptr RawTGraphQQ) -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorYhigh" + c_tgraphqq_geterroryhigh :: Ptr RawTGraphQQ -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_InitExpo" c_tgraphqq_initexpo - :: (Ptr RawTGraphQQ) -> CDouble -> CDouble -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_GetErrorYlow" c_tgraphqq_geterrorylow + :: Ptr RawTGraphQQ -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_InitGaus" c_tgraphqq_initgaus - :: (Ptr RawTGraphQQ) -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_InitExpo" + c_tgraphqq_initexpo :: + Ptr RawTGraphQQ -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_InitPolynom" c_tgraphqq_initpolynom - :: (Ptr RawTGraphQQ) -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_InitGaus" + c_tgraphqq_initgaus :: + Ptr RawTGraphQQ -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_InsertPoint" c_tgraphqq_insertpoint - :: (Ptr RawTGraphQQ) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_InitPolynom" c_tgraphqq_initpolynom + :: Ptr RawTGraphQQ -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_integralTGraph" c_tgraphqq_integraltgraph - :: (Ptr RawTGraphQQ) -> CInt -> CInt -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_InsertPoint" c_tgraphqq_insertpoint + :: Ptr RawTGraphQQ -> IO CInt -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_IsEditable" c_tgraphqq_iseditable - :: (Ptr RawTGraphQQ) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_integralTGraph" + c_tgraphqq_integraltgraph :: + Ptr RawTGraphQQ -> CInt -> CInt -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_isInsideTGraph" c_tgraphqq_isinsidetgraph - :: (Ptr RawTGraphQQ) -> CDouble -> CDouble -> IO CInt +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_IsEditable" + c_tgraphqq_iseditable :: Ptr RawTGraphQQ -> IO CInt -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_LeastSquareFit" c_tgraphqq_leastsquarefit - :: (Ptr RawTGraphQQ) -> CInt -> (Ptr CDouble) -> CDouble -> CDouble -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_isInsideTGraph" + c_tgraphqq_isinsidetgraph :: + Ptr RawTGraphQQ -> CDouble -> CDouble -> IO CInt -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_PaintStats" c_tgraphqq_paintstats - :: (Ptr RawTGraphQQ) -> (Ptr RawTF1) -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_LeastSquareFit" + c_tgraphqq_leastsquarefit :: + Ptr RawTGraphQQ -> + CInt -> (Ptr CDouble) -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_RemovePoint" c_tgraphqq_removepoint - :: (Ptr RawTGraphQQ) -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_PaintStats" + c_tgraphqq_paintstats :: Ptr RawTGraphQQ -> Ptr RawTF1 -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetEditable" c_tgraphqq_seteditable - :: (Ptr RawTGraphQQ) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_RemovePoint" c_tgraphqq_removepoint + :: Ptr RawTGraphQQ -> CInt -> IO CInt -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetHistogram" c_tgraphqq_sethistogram - :: (Ptr RawTGraphQQ) -> (Ptr RawTH1F) -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetEditable" c_tgraphqq_seteditable + :: Ptr RawTGraphQQ -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_setMaximumTGraph" c_tgraphqq_setmaximumtgraph - :: (Ptr RawTGraphQQ) -> CDouble -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetHistogram" c_tgraphqq_sethistogram + :: Ptr RawTGraphQQ -> Ptr RawTH1F -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_setMinimumTGraph" c_tgraphqq_setminimumtgraph - :: (Ptr RawTGraphQQ) -> CDouble -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_setMaximumTGraph" + c_tgraphqq_setmaximumtgraph :: Ptr RawTGraphQQ -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_Set" c_tgraphqq_set - :: (Ptr RawTGraphQQ) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_setMinimumTGraph" + c_tgraphqq_setminimumtgraph :: Ptr RawTGraphQQ -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetPoint" c_tgraphqq_setpoint - :: (Ptr RawTGraphQQ) -> CInt -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_Set" + c_tgraphqq_set :: Ptr RawTGraphQQ -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetName" c_tgraphqq_setname - :: (Ptr RawTGraphQQ) -> CString -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_SetPoint" + c_tgraphqq_setpoint :: + Ptr RawTGraphQQ -> CInt -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetNameTitle" c_tgraphqq_setnametitle - :: (Ptr RawTGraphQQ) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_SetName" + c_tgraphqq_setname :: Ptr RawTGraphQQ -> CString -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetTitle" c_tgraphqq_settitle - :: (Ptr RawTGraphQQ) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetNameTitle" c_tgraphqq_setnametitle + :: Ptr RawTGraphQQ -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetLineColor" c_tgraphqq_getlinecolor - :: (Ptr RawTGraphQQ) -> IO CInt +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_SetTitle" + c_tgraphqq_settitle :: Ptr RawTGraphQQ -> CString -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetLineStyle" c_tgraphqq_getlinestyle - :: (Ptr RawTGraphQQ) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_GetLineColor" c_tgraphqq_getlinecolor + :: Ptr RawTGraphQQ -> IO CInt -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetLineWidth" c_tgraphqq_getlinewidth - :: (Ptr RawTGraphQQ) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_GetLineStyle" c_tgraphqq_getlinestyle + :: Ptr RawTGraphQQ -> IO CInt -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_ResetAttLine" c_tgraphqq_resetattline - :: (Ptr RawTGraphQQ) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_GetLineWidth" c_tgraphqq_getlinewidth + :: Ptr RawTGraphQQ -> IO CInt -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetLineAttributes" c_tgraphqq_setlineattributes - :: (Ptr RawTGraphQQ) -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_ResetAttLine" c_tgraphqq_resetattline + :: Ptr RawTGraphQQ -> CString -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetLineColor" c_tgraphqq_setlinecolor - :: (Ptr RawTGraphQQ) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetLineAttributes" + c_tgraphqq_setlineattributes :: Ptr RawTGraphQQ -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetLineStyle" c_tgraphqq_setlinestyle - :: (Ptr RawTGraphQQ) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetLineColor" c_tgraphqq_setlinecolor + :: Ptr RawTGraphQQ -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetLineWidth" c_tgraphqq_setlinewidth - :: (Ptr RawTGraphQQ) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetLineStyle" c_tgraphqq_setlinestyle + :: Ptr RawTGraphQQ -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetFillColor" c_tgraphqq_setfillcolor - :: (Ptr RawTGraphQQ) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetLineWidth" c_tgraphqq_setlinewidth + :: Ptr RawTGraphQQ -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetFillStyle" c_tgraphqq_setfillstyle - :: (Ptr RawTGraphQQ) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetFillColor" c_tgraphqq_setfillcolor + :: Ptr RawTGraphQQ -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetMarkerColor" c_tgraphqq_getmarkercolor - :: (Ptr RawTGraphQQ) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetFillStyle" c_tgraphqq_setfillstyle + :: Ptr RawTGraphQQ -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetMarkerStyle" c_tgraphqq_getmarkerstyle - :: (Ptr RawTGraphQQ) -> IO CInt +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_GetMarkerColor" + c_tgraphqq_getmarkercolor :: Ptr RawTGraphQQ -> IO CInt -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetMarkerSize" c_tgraphqq_getmarkersize - :: (Ptr RawTGraphQQ) -> IO CDouble +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_GetMarkerStyle" + c_tgraphqq_getmarkerstyle :: Ptr RawTGraphQQ -> IO CInt -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_ResetAttMarker" c_tgraphqq_resetattmarker - :: (Ptr RawTGraphQQ) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_GetMarkerSize" + c_tgraphqq_getmarkersize :: Ptr RawTGraphQQ -> IO CDouble -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetMarkerAttributes" c_tgraphqq_setmarkerattributes - :: (Ptr RawTGraphQQ) -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_ResetAttMarker" + c_tgraphqq_resetattmarker :: Ptr RawTGraphQQ -> CString -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetMarkerColor" c_tgraphqq_setmarkercolor - :: (Ptr RawTGraphQQ) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetMarkerAttributes" + c_tgraphqq_setmarkerattributes :: Ptr RawTGraphQQ -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetMarkerStyle" c_tgraphqq_setmarkerstyle - :: (Ptr RawTGraphQQ) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetMarkerColor" + c_tgraphqq_setmarkercolor :: Ptr RawTGraphQQ -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SetMarkerSize" c_tgraphqq_setmarkersize - :: (Ptr RawTGraphQQ) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetMarkerStyle" + c_tgraphqq_setmarkerstyle :: Ptr RawTGraphQQ -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_Draw" c_tgraphqq_draw - :: (Ptr RawTGraphQQ) -> CString -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_SetMarkerSize" + c_tgraphqq_setmarkersize :: Ptr RawTGraphQQ -> CInt -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_FindObject" c_tgraphqq_findobject - :: (Ptr RawTGraphQQ) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_Draw" + c_tgraphqq_draw :: Ptr RawTGraphQQ -> CString -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_GetName" c_tgraphqq_getname - :: (Ptr RawTGraphQQ) -> IO CString +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_FindObject" + c_tgraphqq_findobject :: + Ptr RawTGraphQQ -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_IsA" c_tgraphqq_isa - :: (Ptr RawTGraphQQ) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_GetName" + c_tgraphqq_getname :: Ptr RawTGraphQQ -> IO CString -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_Paint" c_tgraphqq_paint - :: (Ptr RawTGraphQQ) -> CString -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_IsA" + c_tgraphqq_isa :: Ptr RawTGraphQQ -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_printObj" c_tgraphqq_printobj - :: (Ptr RawTGraphQQ) -> CString -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_Paint" + c_tgraphqq_paint :: Ptr RawTGraphQQ -> CString -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_SaveAs" c_tgraphqq_saveas - :: (Ptr RawTGraphQQ) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_printObj" + c_tgraphqq_printobj :: Ptr RawTGraphQQ -> CString -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_Write" c_tgraphqq_write - :: (Ptr RawTGraphQQ) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_SaveAs" + c_tgraphqq_saveas :: Ptr RawTGraphQQ -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_delete" c_tgraphqq_delete - :: (Ptr RawTGraphQQ) -> IO () +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_Write" + c_tgraphqq_write :: + Ptr RawTGraphQQ -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTGraphQQ.h TGraphQQ_newTGraphQQ" c_tgraphqq_newtgraphqq - :: CInt -> (Ptr CDouble) -> CInt -> (Ptr CDouble) -> IO (Ptr RawTGraphQQ) +foreign import ccall safe "HROOTGrafTGraphQQ.h TGraphQQ_delete" + c_tgraphqq_delete :: Ptr RawTGraphQQ -> IO () +foreign import ccall safe + "HROOTGrafTGraphQQ.h TGraphQQ_newTGraphQQ" c_tgraphqq_newtgraphqq + :: + CInt -> + (Ptr CDouble) -> CInt -> (Ptr CDouble) -> IO (Ptr RawTGraphQQ) diff --git a/src/HROOT/Graf/TGraphQQ/Implementation.hs b/src/HROOT/Graf/TGraphQQ/Implementation.hs --- a/src/HROOT/Graf/TGraphQQ/Implementation.hs +++ b/src/HROOT/Graf/TGraphQQ/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TGraphQQ.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TGraphQQ.RawType import HROOT.Graf.TGraphQQ.FFI import HROOT.Graf.TGraphQQ.Interface @@ -45,166 +46,85 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITGraphQQ TGraphQQ -instance ITGraphQQ TGraphQQ where instance ITGraph TGraphQQ where - apply = xform1 c_tgraphqq_apply - chisquare = xform1 c_tgraphqq_chisquare - drawGraph = xform4 c_tgraphqq_drawgraph - drawPanelTGraph = xform0 c_tgraphqq_drawpaneltgraph - expand = xform2 c_tgraphqq_expand - fitPanelTGraph = xform0 c_tgraphqq_fitpaneltgraph - getCorrelationFactorTGraph = xform0 c_tgraphqq_getcorrelationfactortgraph - getCovarianceTGraph = xform0 c_tgraphqq_getcovariancetgraph - getMeanTGraph = xform1 c_tgraphqq_getmeantgraph - getRMSTGraph = xform1 c_tgraphqq_getrmstgraph - getErrorX = xform1 c_tgraphqq_geterrorx - getErrorY = xform1 c_tgraphqq_geterrory - getErrorXhigh = xform1 c_tgraphqq_geterrorxhigh - getErrorXlow = xform1 c_tgraphqq_geterrorxlow - getErrorYhigh = xform1 c_tgraphqq_geterroryhigh - getErrorYlow = xform1 c_tgraphqq_geterrorylow - initExpo = xform2 c_tgraphqq_initexpo - initGaus = xform2 c_tgraphqq_initgaus - initPolynom = xform2 c_tgraphqq_initpolynom - insertPoint = xform0 c_tgraphqq_insertpoint - integralTGraph = xform2 c_tgraphqq_integraltgraph - isEditable = xform0 c_tgraphqq_iseditable - isInsideTGraph = xform2 c_tgraphqq_isinsidetgraph - leastSquareFit = xform4 c_tgraphqq_leastsquarefit - paintStats = xform1 c_tgraphqq_paintstats - removePoint = xform1 c_tgraphqq_removepoint - setEditable = xform1 c_tgraphqq_seteditable - setHistogram = xform1 c_tgraphqq_sethistogram - setMaximumTGraph = xform1 c_tgraphqq_setmaximumtgraph - setMinimumTGraph = xform1 c_tgraphqq_setminimumtgraph - set = xform1 c_tgraphqq_set - setPoint = xform3 c_tgraphqq_setpoint + apply = xform1 c_tgraphqq_apply + chisquare = xform1 c_tgraphqq_chisquare + drawGraph = xform4 c_tgraphqq_drawgraph + drawPanelTGraph = xform0 c_tgraphqq_drawpaneltgraph + expand = xform2 c_tgraphqq_expand + fitPanelTGraph = xform0 c_tgraphqq_fitpaneltgraph + getCorrelationFactorTGraph + = xform0 c_tgraphqq_getcorrelationfactortgraph + getCovarianceTGraph = xform0 c_tgraphqq_getcovariancetgraph + getMeanTGraph = xform1 c_tgraphqq_getmeantgraph + getRMSTGraph = xform1 c_tgraphqq_getrmstgraph + getErrorX = xform1 c_tgraphqq_geterrorx + getErrorY = xform1 c_tgraphqq_geterrory + getErrorXhigh = xform1 c_tgraphqq_geterrorxhigh + getErrorXlow = xform1 c_tgraphqq_geterrorxlow + getErrorYhigh = xform1 c_tgraphqq_geterroryhigh + getErrorYlow = xform1 c_tgraphqq_geterrorylow + initExpo = xform2 c_tgraphqq_initexpo + initGaus = xform2 c_tgraphqq_initgaus + initPolynom = xform2 c_tgraphqq_initpolynom + insertPoint = xform0 c_tgraphqq_insertpoint + integralTGraph = xform2 c_tgraphqq_integraltgraph + isEditable = xform0 c_tgraphqq_iseditable + isInsideTGraph = xform2 c_tgraphqq_isinsidetgraph + leastSquareFit = xform4 c_tgraphqq_leastsquarefit + paintStats = xform1 c_tgraphqq_paintstats + removePoint = xform1 c_tgraphqq_removepoint + setEditable = xform1 c_tgraphqq_seteditable + setHistogram = xform1 c_tgraphqq_sethistogram + setMaximumTGraph = xform1 c_tgraphqq_setmaximumtgraph + setMinimumTGraph = xform1 c_tgraphqq_setminimumtgraph + set = xform1 c_tgraphqq_set + setPoint = xform3 c_tgraphqq_setpoint + instance ITNamed TGraphQQ where - setName = xform1 c_tgraphqq_setname - setNameTitle = xform2 c_tgraphqq_setnametitle - setTitle = xform1 c_tgraphqq_settitle + setName = xform1 c_tgraphqq_setname + setNameTitle = xform2 c_tgraphqq_setnametitle + setTitle = xform1 c_tgraphqq_settitle + instance ITAttLine TGraphQQ where - getLineColor = xform0 c_tgraphqq_getlinecolor - getLineStyle = xform0 c_tgraphqq_getlinestyle - getLineWidth = xform0 c_tgraphqq_getlinewidth - resetAttLine = xform1 c_tgraphqq_resetattline - setLineAttributes = xform0 c_tgraphqq_setlineattributes - setLineColor = xform1 c_tgraphqq_setlinecolor - setLineStyle = xform1 c_tgraphqq_setlinestyle - setLineWidth = xform1 c_tgraphqq_setlinewidth + getLineColor = xform0 c_tgraphqq_getlinecolor + getLineStyle = xform0 c_tgraphqq_getlinestyle + getLineWidth = xform0 c_tgraphqq_getlinewidth + resetAttLine = xform1 c_tgraphqq_resetattline + setLineAttributes = xform0 c_tgraphqq_setlineattributes + setLineColor = xform1 c_tgraphqq_setlinecolor + setLineStyle = xform1 c_tgraphqq_setlinestyle + setLineWidth = xform1 c_tgraphqq_setlinewidth + instance ITAttFill TGraphQQ where - setFillColor = xform1 c_tgraphqq_setfillcolor - setFillStyle = xform1 c_tgraphqq_setfillstyle -instance ITAttMarker TGraphQQ where - getMarkerColor = xform0 c_tgraphqq_getmarkercolor - getMarkerStyle = xform0 c_tgraphqq_getmarkerstyle - getMarkerSize = xform0 c_tgraphqq_getmarkersize - resetAttMarker = xform1 c_tgraphqq_resetattmarker - setMarkerAttributes = xform0 c_tgraphqq_setmarkerattributes - setMarkerColor = xform1 c_tgraphqq_setmarkercolor - setMarkerStyle = xform1 c_tgraphqq_setmarkerstyle - setMarkerSize = xform1 c_tgraphqq_setmarkersize -instance ITObject TGraphQQ where - draw = xform1 c_tgraphqq_draw - findObject = xform1 c_tgraphqq_findobject - getName = xform0 c_tgraphqq_getname - isA = xform0 c_tgraphqq_isa - paint = xform1 c_tgraphqq_paint - printObj = xform1 c_tgraphqq_printobj - saveAs = xform2 c_tgraphqq_saveas - write = xform3 c_tgraphqq_write -instance IDeletable TGraphQQ where - delete = xform0 c_tgraphqq_delete + setFillColor = xform1 c_tgraphqq_setfillcolor + setFillStyle = xform1 c_tgraphqq_setfillstyle -instance ITGraphQQ (Exist TGraphQQ) where +instance ITAttMarker TGraphQQ where + getMarkerColor = xform0 c_tgraphqq_getmarkercolor + getMarkerStyle = xform0 c_tgraphqq_getmarkerstyle + getMarkerSize = xform0 c_tgraphqq_getmarkersize + resetAttMarker = xform1 c_tgraphqq_resetattmarker + setMarkerAttributes = xform0 c_tgraphqq_setmarkerattributes + setMarkerColor = xform1 c_tgraphqq_setmarkercolor + setMarkerStyle = xform1 c_tgraphqq_setmarkerstyle + setMarkerSize = xform1 c_tgraphqq_setmarkersize -instance ITGraph (Exist TGraphQQ) where - apply (ETGraphQQ x) = apply x - chisquare (ETGraphQQ x) = chisquare x - drawGraph (ETGraphQQ x) = drawGraph x - drawPanelTGraph (ETGraphQQ x) = drawPanelTGraph x - expand (ETGraphQQ x) = expand x - fitPanelTGraph (ETGraphQQ x) = fitPanelTGraph x - getCorrelationFactorTGraph (ETGraphQQ x) = getCorrelationFactorTGraph x - getCovarianceTGraph (ETGraphQQ x) = getCovarianceTGraph x - getMeanTGraph (ETGraphQQ x) = getMeanTGraph x - getRMSTGraph (ETGraphQQ x) = getRMSTGraph x - getErrorX (ETGraphQQ x) = getErrorX x - getErrorY (ETGraphQQ x) = getErrorY x - getErrorXhigh (ETGraphQQ x) = getErrorXhigh x - getErrorXlow (ETGraphQQ x) = getErrorXlow x - getErrorYhigh (ETGraphQQ x) = getErrorYhigh x - getErrorYlow (ETGraphQQ x) = getErrorYlow x - initExpo (ETGraphQQ x) = initExpo x - initGaus (ETGraphQQ x) = initGaus x - initPolynom (ETGraphQQ x) = initPolynom x - insertPoint (ETGraphQQ x) = insertPoint x - integralTGraph (ETGraphQQ x) = integralTGraph x - isEditable (ETGraphQQ x) = isEditable x - isInsideTGraph (ETGraphQQ x) = isInsideTGraph x - leastSquareFit (ETGraphQQ x) = leastSquareFit x - paintStats (ETGraphQQ x) = paintStats x - removePoint (ETGraphQQ x) = removePoint x - setEditable (ETGraphQQ x) = setEditable x - setHistogram (ETGraphQQ x) = setHistogram x - setMaximumTGraph (ETGraphQQ x) = setMaximumTGraph x - setMinimumTGraph (ETGraphQQ x) = setMinimumTGraph x - set (ETGraphQQ x) = set x - setPoint (ETGraphQQ x) = setPoint x -instance ITNamed (Exist TGraphQQ) where - setName (ETGraphQQ x) = setName x - setNameTitle (ETGraphQQ x) = setNameTitle x - setTitle (ETGraphQQ x) = setTitle x -instance ITAttLine (Exist TGraphQQ) where - getLineColor (ETGraphQQ x) = getLineColor x - getLineStyle (ETGraphQQ x) = getLineStyle x - getLineWidth (ETGraphQQ x) = getLineWidth x - resetAttLine (ETGraphQQ x) = resetAttLine x - setLineAttributes (ETGraphQQ x) = setLineAttributes x - setLineColor (ETGraphQQ x) = setLineColor x - setLineStyle (ETGraphQQ x) = setLineStyle x - setLineWidth (ETGraphQQ x) = setLineWidth x -instance ITAttFill (Exist TGraphQQ) where - setFillColor (ETGraphQQ x) = setFillColor x - setFillStyle (ETGraphQQ x) = setFillStyle x -instance ITAttMarker (Exist TGraphQQ) where - getMarkerColor (ETGraphQQ x) = getMarkerColor x - getMarkerStyle (ETGraphQQ x) = getMarkerStyle x - getMarkerSize (ETGraphQQ x) = getMarkerSize x - resetAttMarker (ETGraphQQ x) = resetAttMarker x - setMarkerAttributes (ETGraphQQ x) = setMarkerAttributes x - setMarkerColor (ETGraphQQ x) = setMarkerColor x - setMarkerStyle (ETGraphQQ x) = setMarkerStyle x - setMarkerSize (ETGraphQQ x) = setMarkerSize x -instance ITObject (Exist TGraphQQ) where - draw (ETGraphQQ x) = draw x - findObject (ETGraphQQ x) = findObject x - getName (ETGraphQQ x) = getName x - isA (ETGraphQQ x) = isA x - paint (ETGraphQQ x) = paint x - printObj (ETGraphQQ x) = printObj x - saveAs (ETGraphQQ x) = saveAs x - write (ETGraphQQ x) = write x -instance IDeletable (Exist TGraphQQ) where - delete (ETGraphQQ x) = delete x +instance ITObject TGraphQQ where + draw = xform1 c_tgraphqq_draw + findObject = xform1 c_tgraphqq_findobject + getName = xform0 c_tgraphqq_getname + isA = xform0 c_tgraphqq_isa + paint = xform1 c_tgraphqq_paint + printObj = xform1 c_tgraphqq_printobj + saveAs = xform2 c_tgraphqq_saveas + write = xform3 c_tgraphqq_write +instance IDeletable TGraphQQ where + delete = xform0 c_tgraphqq_delete -newTGraphQQ :: CInt -> (Ptr CDouble) -> CInt -> (Ptr CDouble) -> IO TGraphQQ +newTGraphQQ :: + CInt -> (Ptr CDouble) -> CInt -> (Ptr CDouble) -> IO TGraphQQ newTGraphQQ = xform3 c_tgraphqq_newtgraphqq - - - - - -instance FPtr (Exist TGraphQQ) where - type Raw (Exist TGraphQQ) = RawTGraphQQ - get_fptr (ETGraphQQ obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETGraphQQ (cast_fptr_to_obj (fptr :: ForeignPtr RawTGraphQQ) :: TGraphQQ) diff --git a/src/HROOT/Graf/TGraphQQ/Interface.hs b/src/HROOT/Graf/TGraphQQ/Interface.hs --- a/src/HROOT/Graf/TGraphQQ/Interface.hs +++ b/src/HROOT/Graf/TGraphQQ/Interface.hs @@ -1,36 +1,26 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TGraphQQ.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TGraphQQ.RawType - import HROOT.Hist.TGraph.Interface ----- ============ ---- - - -class (ITGraph a) => ITGraphQQ a where - -instance Existable TGraphQQ where - data Exist TGraphQQ = forall a. (FPtr a, ITGraphQQ a) => ETGraphQQ a +class ITGraph a => ITGraphQQ a -upcastTGraphQQ :: (FPtr a, ITGraphQQ a) => a -> TGraphQQ -upcastTGraphQQ h = let fh = get_fptr h - fh2 :: ForeignPtr RawTGraphQQ = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTGraphQQ :: forall a . (FPtr a, ITGraphQQ a) => a -> TGraphQQ +upcastTGraphQQ h + = let fh = get_fptr h + fh2 :: Ptr RawTGraphQQ = castPtr fh + in cast_fptr_to_obj fh2 -downcastTGraphQQ :: (FPtr a, ITGraphQQ a) => TGraphQQ -> a -downcastTGraphQQ h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTGraphQQ :: + forall a . (FPtr a, ITGraphQQ a) => TGraphQQ -> a +downcastTGraphQQ h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TGraphQQ/RawType.hs b/src/HROOT/Graf/TGraphQQ/RawType.hs --- a/src/HROOT/Graf/TGraphQQ/RawType.hs +++ b/src/HROOT/Graf/TGraphQQ/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TGraphQQ.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTGraphQQ -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TGraphQQ = TGraphQQ (Ptr RawTGraphQQ) + deriving (Eq, Ord, Show) -data RawTGraphQQ -newtype TGraphQQ = TGraphQQ (ForeignPtr RawTGraphQQ) deriving (Eq, Ord, Show) instance FPtr TGraphQQ where - type Raw TGraphQQ = RawTGraphQQ - get_fptr (TGraphQQ fptr) = fptr - cast_fptr_to_obj = TGraphQQ + type Raw TGraphQQ = RawTGraphQQ + get_fptr (TGraphQQ ptr) = ptr + cast_fptr_to_obj = TGraphQQ diff --git a/src/HROOT/Graf/TLine.hs b/src/HROOT/Graf/TLine.hs --- a/src/HROOT/Graf/TLine.hs +++ b/src/HROOT/Graf/TLine.hs @@ -1,23 +1,8 @@ module HROOT.Graf.TLine - ( - TLine(..) - , ITLine(..) - , upcastTLine - , downcastTLine - , newTLine - , tLineGetX1 - , tLineGetX2 - , tLineGetY1 - , tLineGetY2 - , tLineIsHorizontal - , tLineIsVertical - , tLineSetHorizontal - , tLineSetVertical - - ) where - + (TLine(..), ITLine(..), upcastTLine, downcastTLine, newTLine, + tLineGetX1, tLineGetX2, tLineGetY1, tLineGetY2, tLineIsHorizontal, + tLineIsVertical, tLineSetHorizontal, tLineSetVertical) + where import HROOT.Graf.TLine.RawType import HROOT.Graf.TLine.Interface import HROOT.Graf.TLine.Implementation - - diff --git a/src/HROOT/Graf/TLine/Cast.hs b/src/HROOT/Graf/TLine/Cast.hs --- a/src/HROOT/Graf/TLine/Cast.hs +++ b/src/HROOT/Graf/TLine/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TLine.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TLine.RawType import HROOT.Graf.TLine.Interface instance (ITLine a, FPtr a) => Castable a (Ptr RawTLine) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TLine (Ptr RawTLine) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TLine/FFI.hsc b/src/HROOT/Graf/TLine/FFI.hsc --- a/src/HROOT/Graf/TLine/FFI.hsc +++ b/src/HROOT/Graf/TLine/FFI.hsc @@ -1,122 +1,120 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TLine.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TLine.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTLine.h" - -foreign import ccall "HROOTGrafTLine.h TLine_Draw" c_tline_draw - :: (Ptr RawTLine) -> CString -> IO () - -foreign import ccall "HROOTGrafTLine.h TLine_FindObject" c_tline_findobject - :: (Ptr RawTLine) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTLine.h TLine_Draw" + c_tline_draw :: Ptr RawTLine -> CString -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_GetName" c_tline_getname - :: (Ptr RawTLine) -> IO CString +foreign import ccall safe "HROOTGrafTLine.h TLine_FindObject" + c_tline_findobject :: + Ptr RawTLine -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTLine.h TLine_IsA" c_tline_isa - :: (Ptr RawTLine) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTLine.h TLine_GetName" + c_tline_getname :: Ptr RawTLine -> IO CString -foreign import ccall "HROOTGrafTLine.h TLine_Paint" c_tline_paint - :: (Ptr RawTLine) -> CString -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_IsA" c_tline_isa + :: Ptr RawTLine -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTLine.h TLine_printObj" c_tline_printobj - :: (Ptr RawTLine) -> CString -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_Paint" + c_tline_paint :: Ptr RawTLine -> CString -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_SaveAs" c_tline_saveas - :: (Ptr RawTLine) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_printObj" + c_tline_printobj :: Ptr RawTLine -> CString -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_Write" c_tline_write - :: (Ptr RawTLine) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTLine.h TLine_SaveAs" + c_tline_saveas :: Ptr RawTLine -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_GetLineColor" c_tline_getlinecolor - :: (Ptr RawTLine) -> IO CInt +foreign import ccall safe "HROOTGrafTLine.h TLine_Write" + c_tline_write :: Ptr RawTLine -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTLine.h TLine_GetLineStyle" c_tline_getlinestyle - :: (Ptr RawTLine) -> IO CInt +foreign import ccall safe "HROOTGrafTLine.h TLine_GetLineColor" + c_tline_getlinecolor :: Ptr RawTLine -> IO CInt -foreign import ccall "HROOTGrafTLine.h TLine_GetLineWidth" c_tline_getlinewidth - :: (Ptr RawTLine) -> IO CInt +foreign import ccall safe "HROOTGrafTLine.h TLine_GetLineStyle" + c_tline_getlinestyle :: Ptr RawTLine -> IO CInt -foreign import ccall "HROOTGrafTLine.h TLine_ResetAttLine" c_tline_resetattline - :: (Ptr RawTLine) -> CString -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_GetLineWidth" + c_tline_getlinewidth :: Ptr RawTLine -> IO CInt -foreign import ccall "HROOTGrafTLine.h TLine_SetLineAttributes" c_tline_setlineattributes - :: (Ptr RawTLine) -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_ResetAttLine" + c_tline_resetattline :: Ptr RawTLine -> CString -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_SetLineColor" c_tline_setlinecolor - :: (Ptr RawTLine) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTLine.h TLine_SetLineAttributes" + c_tline_setlineattributes :: Ptr RawTLine -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_SetLineStyle" c_tline_setlinestyle - :: (Ptr RawTLine) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_SetLineColor" + c_tline_setlinecolor :: Ptr RawTLine -> CInt -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_SetLineWidth" c_tline_setlinewidth - :: (Ptr RawTLine) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_SetLineStyle" + c_tline_setlinestyle :: Ptr RawTLine -> CInt -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_delete" c_tline_delete - :: (Ptr RawTLine) -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_SetLineWidth" + c_tline_setlinewidth :: Ptr RawTLine -> CInt -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_newTLine" c_tline_newtline - :: CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) +foreign import ccall safe "HROOTGrafTLine.h TLine_delete" + c_tline_delete :: Ptr RawTLine -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_DrawLine" c_tline_drawline - :: (Ptr RawTLine) -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) +foreign import ccall safe "HROOTGrafTLine.h TLine_newTLine" + c_tline_newtline :: + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) -foreign import ccall "HROOTGrafTLine.h TLine_DrawLineNDC" c_tline_drawlinendc - :: (Ptr RawTLine) -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) +foreign import ccall safe "HROOTGrafTLine.h TLine_DrawLine" + c_tline_drawline :: + Ptr RawTLine -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) -foreign import ccall "HROOTGrafTLine.h TLine_tLineGetX1" c_tline_tlinegetx1 - :: (Ptr RawTLine) -> IO CDouble +foreign import ccall safe "HROOTGrafTLine.h TLine_DrawLineNDC" + c_tline_drawlinendc :: + Ptr RawTLine -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTLine) -foreign import ccall "HROOTGrafTLine.h TLine_tLineGetX2" c_tline_tlinegetx2 - :: (Ptr RawTLine) -> IO CDouble +foreign import ccall safe "HROOTGrafTLine.h TLine_tLineGetX1" + c_tline_tlinegetx1 :: Ptr RawTLine -> IO CDouble -foreign import ccall "HROOTGrafTLine.h TLine_tLineGetY1" c_tline_tlinegety1 - :: (Ptr RawTLine) -> IO CDouble +foreign import ccall safe "HROOTGrafTLine.h TLine_tLineGetX2" + c_tline_tlinegetx2 :: Ptr RawTLine -> IO CDouble -foreign import ccall "HROOTGrafTLine.h TLine_tLineGetY2" c_tline_tlinegety2 - :: (Ptr RawTLine) -> IO CDouble +foreign import ccall safe "HROOTGrafTLine.h TLine_tLineGetY1" + c_tline_tlinegety1 :: Ptr RawTLine -> IO CDouble -foreign import ccall "HROOTGrafTLine.h TLine_tLineIsHorizontal" c_tline_tlineishorizontal - :: (Ptr RawTLine) -> IO CInt +foreign import ccall safe "HROOTGrafTLine.h TLine_tLineGetY2" + c_tline_tlinegety2 :: Ptr RawTLine -> IO CDouble -foreign import ccall "HROOTGrafTLine.h TLine_tLineIsVertical" c_tline_tlineisvertical - :: (Ptr RawTLine) -> IO CInt +foreign import ccall safe + "HROOTGrafTLine.h TLine_tLineIsHorizontal" + c_tline_tlineishorizontal :: Ptr RawTLine -> IO CInt -foreign import ccall "HROOTGrafTLine.h TLine_PaintLine" c_tline_paintline - :: (Ptr RawTLine) -> CDouble -> CDouble -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_tLineIsVertical" + c_tline_tlineisvertical :: Ptr RawTLine -> IO CInt -foreign import ccall "HROOTGrafTLine.h TLine_PaintLineNDC" c_tline_paintlinendc - :: (Ptr RawTLine) -> CDouble -> CDouble -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_PaintLine" + c_tline_paintline :: + Ptr RawTLine -> CDouble -> CDouble -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_tLineSetHorizontal" c_tline_tlinesethorizontal - :: (Ptr RawTLine) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_PaintLineNDC" + c_tline_paintlinendc :: + Ptr RawTLine -> CDouble -> CDouble -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_tLineSetVertical" c_tline_tlinesetvertical - :: (Ptr RawTLine) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTLine.h TLine_tLineSetHorizontal" + c_tline_tlinesethorizontal :: Ptr RawTLine -> CInt -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_SetX1" c_tline_setx1 - :: (Ptr RawTLine) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_tLineSetVertical" + c_tline_tlinesetvertical :: Ptr RawTLine -> CInt -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_SetX2" c_tline_setx2 - :: (Ptr RawTLine) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_SetX1" + c_tline_setx1 :: Ptr RawTLine -> CDouble -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_SetY1" c_tline_sety1 - :: (Ptr RawTLine) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_SetX2" + c_tline_setx2 :: Ptr RawTLine -> CDouble -> IO () -foreign import ccall "HROOTGrafTLine.h TLine_SetY2" c_tline_sety2 - :: (Ptr RawTLine) -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_SetY1" + c_tline_sety1 :: Ptr RawTLine -> CDouble -> IO () +foreign import ccall safe "HROOTGrafTLine.h TLine_SetY2" + c_tline_sety2 :: Ptr RawTLine -> CDouble -> IO () diff --git a/src/HROOT/Graf/TLine/Implementation.hs b/src/HROOT/Graf/TLine/Implementation.hs --- a/src/HROOT/Graf/TLine/Implementation.hs +++ b/src/HROOT/Graf/TLine/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TLine.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TLine.RawType import HROOT.Graf.TLine.FFI import HROOT.Graf.TLine.Interface @@ -24,74 +25,38 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITLine TLine where - drawLine = xform4 c_tline_drawline - drawLineNDC = xform4 c_tline_drawlinendc - paintLine = xform4 c_tline_paintline - paintLineNDC = xform4 c_tline_paintlinendc - setX1 = xform1 c_tline_setx1 - setX2 = xform1 c_tline_setx2 - setY1 = xform1 c_tline_sety1 - setY2 = xform1 c_tline_sety2 + drawLine = xform4 c_tline_drawline + drawLineNDC = xform4 c_tline_drawlinendc + paintLine = xform4 c_tline_paintline + paintLineNDC = xform4 c_tline_paintlinendc + setX1 = xform1 c_tline_setx1 + setX2 = xform1 c_tline_setx2 + setY1 = xform1 c_tline_sety1 + setY2 = xform1 c_tline_sety2 + instance ITObject TLine where - draw = xform1 c_tline_draw - findObject = xform1 c_tline_findobject - getName = xform0 c_tline_getname - isA = xform0 c_tline_isa - paint = xform1 c_tline_paint - printObj = xform1 c_tline_printobj - saveAs = xform2 c_tline_saveas - write = xform3 c_tline_write -instance ITAttLine TLine where - getLineColor = xform0 c_tline_getlinecolor - getLineStyle = xform0 c_tline_getlinestyle - getLineWidth = xform0 c_tline_getlinewidth - resetAttLine = xform1 c_tline_resetattline - setLineAttributes = xform0 c_tline_setlineattributes - setLineColor = xform1 c_tline_setlinecolor - setLineStyle = xform1 c_tline_setlinestyle - setLineWidth = xform1 c_tline_setlinewidth -instance IDeletable TLine where - delete = xform0 c_tline_delete + draw = xform1 c_tline_draw + findObject = xform1 c_tline_findobject + getName = xform0 c_tline_getname + isA = xform0 c_tline_isa + paint = xform1 c_tline_paint + printObj = xform1 c_tline_printobj + saveAs = xform2 c_tline_saveas + write = xform3 c_tline_write -instance ITLine (Exist TLine) where - drawLine (ETLine x) = drawLine x - drawLineNDC (ETLine x) = drawLineNDC x - paintLine (ETLine x) = paintLine x - paintLineNDC (ETLine x) = paintLineNDC x - setX1 (ETLine x) = setX1 x - setX2 (ETLine x) = setX2 x - setY1 (ETLine x) = setY1 x - setY2 (ETLine x) = setY2 x -instance ITObject (Exist TLine) where - draw (ETLine x) = draw x - findObject (ETLine x) = findObject x - getName (ETLine x) = getName x - isA (ETLine x) = isA x - paint (ETLine x) = paint x - printObj (ETLine x) = printObj x - saveAs (ETLine x) = saveAs x - write (ETLine x) = write x -instance ITAttLine (Exist TLine) where - getLineColor (ETLine x) = getLineColor x - getLineStyle (ETLine x) = getLineStyle x - getLineWidth (ETLine x) = getLineWidth x - resetAttLine (ETLine x) = resetAttLine x - setLineAttributes (ETLine x) = setLineAttributes x - setLineColor (ETLine x) = setLineColor x - setLineStyle (ETLine x) = setLineStyle x - setLineWidth (ETLine x) = setLineWidth x -instance IDeletable (Exist TLine) where - delete (ETLine x) = delete x +instance ITAttLine TLine where + getLineColor = xform0 c_tline_getlinecolor + getLineStyle = xform0 c_tline_getlinestyle + getLineWidth = xform0 c_tline_getlinewidth + resetAttLine = xform1 c_tline_resetattline + setLineAttributes = xform0 c_tline_setlineattributes + setLineColor = xform1 c_tline_setlinecolor + setLineStyle = xform1 c_tline_setlinestyle + setLineWidth = xform1 c_tline_setlinewidth +instance IDeletable TLine where + delete = xform0 c_tline_delete newTLine :: CDouble -> CDouble -> CDouble -> CDouble -> IO TLine newTLine = xform3 c_tline_newtline @@ -119,10 +84,3 @@ tLineSetVertical :: TLine -> CInt -> IO () tLineSetVertical = xform1 c_tline_tlinesetvertical - - - -instance FPtr (Exist TLine) where - type Raw (Exist TLine) = RawTLine - get_fptr (ETLine obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETLine (cast_fptr_to_obj (fptr :: ForeignPtr RawTLine) :: TLine) diff --git a/src/HROOT/Graf/TLine/Interface.hs b/src/HROOT/Graf/TLine/Interface.hs --- a/src/HROOT/Graf/TLine/Interface.hs +++ b/src/HROOT/Graf/TLine/Interface.hs @@ -1,53 +1,44 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TLine.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TLine.RawType - import HROOT.Core.TObject.Interface import HROOT.Core.TAttLine.Interface ----- ============ ---- - - -class (ITObject a,ITAttLine a) => ITLine a where - - drawLine :: a -> CDouble -> CDouble -> CDouble -> CDouble -> IO TLine - - drawLineNDC :: a -> CDouble -> CDouble -> CDouble -> CDouble -> IO TLine - - paintLine :: a -> CDouble -> CDouble -> CDouble -> CDouble -> IO () - - paintLineNDC :: a -> CDouble -> CDouble -> CDouble -> CDouble -> IO () - - setX1 :: a -> CDouble -> IO () - - setX2 :: a -> CDouble -> IO () - - setY1 :: a -> CDouble -> IO () - - setY2 :: a -> CDouble -> IO () - -instance Existable TLine where - data Exist TLine = forall a. (FPtr a, ITLine a) => ETLine a +class (ITObject a, ITAttLine a) => ITLine a where + drawLine :: + a -> CDouble -> CDouble -> CDouble -> CDouble -> IO TLine + + drawLineNDC :: + a -> CDouble -> CDouble -> CDouble -> CDouble -> IO TLine + + paintLine :: a -> CDouble -> CDouble -> CDouble -> CDouble -> IO () + + paintLineNDC :: + a -> CDouble -> CDouble -> CDouble -> CDouble -> IO () + + setX1 :: a -> CDouble -> IO () + + setX2 :: a -> CDouble -> IO () + + setY1 :: a -> CDouble -> IO () + + setY2 :: a -> CDouble -> IO () -upcastTLine :: (FPtr a, ITLine a) => a -> TLine -upcastTLine h = let fh = get_fptr h - fh2 :: ForeignPtr RawTLine = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTLine :: forall a . (FPtr a, ITLine a) => a -> TLine +upcastTLine h + = let fh = get_fptr h + fh2 :: Ptr RawTLine = castPtr fh + in cast_fptr_to_obj fh2 -downcastTLine :: (FPtr a, ITLine a) => TLine -> a -downcastTLine h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTLine :: forall a . (FPtr a, ITLine a) => TLine -> a +downcastTLine h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TLine/RawType.hs b/src/HROOT/Graf/TLine/RawType.hs --- a/src/HROOT/Graf/TLine/RawType.hs +++ b/src/HROOT/Graf/TLine/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TLine.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTLine -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TLine = TLine (Ptr RawTLine) + deriving (Eq, Ord, Show) -data RawTLine -newtype TLine = TLine (ForeignPtr RawTLine) deriving (Eq, Ord, Show) instance FPtr TLine where - type Raw TLine = RawTLine - get_fptr (TLine fptr) = fptr - cast_fptr_to_obj = TLine + type Raw TLine = RawTLine + get_fptr (TLine ptr) = ptr + cast_fptr_to_obj = TLine diff --git a/src/HROOT/Graf/TPCON.hs b/src/HROOT/Graf/TPCON.hs --- a/src/HROOT/Graf/TPCON.hs +++ b/src/HROOT/Graf/TPCON.hs @@ -1,15 +1,5 @@ module HROOT.Graf.TPCON - ( - TPCON(..) - , ITPCON - , upcastTPCON - , downcastTPCON - , newTPCON - - ) where - + (TPCON(..), ITPCON, upcastTPCON, downcastTPCON, newTPCON) where import HROOT.Graf.TPCON.RawType import HROOT.Graf.TPCON.Interface import HROOT.Graf.TPCON.Implementation - - diff --git a/src/HROOT/Graf/TPCON/Cast.hs b/src/HROOT/Graf/TPCON/Cast.hs --- a/src/HROOT/Graf/TPCON/Cast.hs +++ b/src/HROOT/Graf/TPCON/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TPCON.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TPCON.RawType import HROOT.Graf.TPCON.Interface instance (ITPCON a, FPtr a) => Castable a (Ptr RawTPCON) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TPCON (Ptr RawTPCON) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TPCON/FFI.hsc b/src/HROOT/Graf/TPCON/FFI.hsc --- a/src/HROOT/Graf/TPCON/FFI.hsc +++ b/src/HROOT/Graf/TPCON/FFI.hsc @@ -1,89 +1,81 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TPCON.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TPCON.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTPCON.h" - -foreign import ccall "HROOTGrafTPCON.h TPCON_SetName" c_tpcon_setname - :: (Ptr RawTPCON) -> CString -> IO () - -foreign import ccall "HROOTGrafTPCON.h TPCON_SetNameTitle" c_tpcon_setnametitle - :: (Ptr RawTPCON) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_SetName" + c_tpcon_setname :: Ptr RawTPCON -> CString -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_SetTitle" c_tpcon_settitle - :: (Ptr RawTPCON) -> CString -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_SetNameTitle" + c_tpcon_setnametitle :: Ptr RawTPCON -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_GetLineColor" c_tpcon_getlinecolor - :: (Ptr RawTPCON) -> IO CInt +foreign import ccall safe "HROOTGrafTPCON.h TPCON_SetTitle" + c_tpcon_settitle :: Ptr RawTPCON -> CString -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_GetLineStyle" c_tpcon_getlinestyle - :: (Ptr RawTPCON) -> IO CInt +foreign import ccall safe "HROOTGrafTPCON.h TPCON_GetLineColor" + c_tpcon_getlinecolor :: Ptr RawTPCON -> IO CInt -foreign import ccall "HROOTGrafTPCON.h TPCON_GetLineWidth" c_tpcon_getlinewidth - :: (Ptr RawTPCON) -> IO CInt +foreign import ccall safe "HROOTGrafTPCON.h TPCON_GetLineStyle" + c_tpcon_getlinestyle :: Ptr RawTPCON -> IO CInt -foreign import ccall "HROOTGrafTPCON.h TPCON_ResetAttLine" c_tpcon_resetattline - :: (Ptr RawTPCON) -> CString -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_GetLineWidth" + c_tpcon_getlinewidth :: Ptr RawTPCON -> IO CInt -foreign import ccall "HROOTGrafTPCON.h TPCON_SetLineAttributes" c_tpcon_setlineattributes - :: (Ptr RawTPCON) -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_ResetAttLine" + c_tpcon_resetattline :: Ptr RawTPCON -> CString -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_SetLineColor" c_tpcon_setlinecolor - :: (Ptr RawTPCON) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTPCON.h TPCON_SetLineAttributes" + c_tpcon_setlineattributes :: Ptr RawTPCON -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_SetLineStyle" c_tpcon_setlinestyle - :: (Ptr RawTPCON) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_SetLineColor" + c_tpcon_setlinecolor :: Ptr RawTPCON -> CInt -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_SetLineWidth" c_tpcon_setlinewidth - :: (Ptr RawTPCON) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_SetLineStyle" + c_tpcon_setlinestyle :: Ptr RawTPCON -> CInt -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_SetFillColor" c_tpcon_setfillcolor - :: (Ptr RawTPCON) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_SetLineWidth" + c_tpcon_setlinewidth :: Ptr RawTPCON -> CInt -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_SetFillStyle" c_tpcon_setfillstyle - :: (Ptr RawTPCON) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_SetFillColor" + c_tpcon_setfillcolor :: Ptr RawTPCON -> CInt -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_Draw" c_tpcon_draw - :: (Ptr RawTPCON) -> CString -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_SetFillStyle" + c_tpcon_setfillstyle :: Ptr RawTPCON -> CInt -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_FindObject" c_tpcon_findobject - :: (Ptr RawTPCON) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTPCON.h TPCON_Draw" + c_tpcon_draw :: Ptr RawTPCON -> CString -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_GetName" c_tpcon_getname - :: (Ptr RawTPCON) -> IO CString +foreign import ccall safe "HROOTGrafTPCON.h TPCON_FindObject" + c_tpcon_findobject :: + Ptr RawTPCON -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTPCON.h TPCON_IsA" c_tpcon_isa - :: (Ptr RawTPCON) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTPCON.h TPCON_GetName" + c_tpcon_getname :: Ptr RawTPCON -> IO CString -foreign import ccall "HROOTGrafTPCON.h TPCON_Paint" c_tpcon_paint - :: (Ptr RawTPCON) -> CString -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_IsA" c_tpcon_isa + :: Ptr RawTPCON -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTPCON.h TPCON_printObj" c_tpcon_printobj - :: (Ptr RawTPCON) -> CString -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_Paint" + c_tpcon_paint :: Ptr RawTPCON -> CString -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_SaveAs" c_tpcon_saveas - :: (Ptr RawTPCON) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_printObj" + c_tpcon_printobj :: Ptr RawTPCON -> CString -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_Write" c_tpcon_write - :: (Ptr RawTPCON) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTPCON.h TPCON_SaveAs" + c_tpcon_saveas :: Ptr RawTPCON -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTPCON.h TPCON_delete" c_tpcon_delete - :: (Ptr RawTPCON) -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_Write" + c_tpcon_write :: Ptr RawTPCON -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTPCON.h TPCON_newTPCON" c_tpcon_newtpcon - :: CString -> CString -> CString -> CDouble -> CDouble -> CInt -> IO (Ptr RawTPCON) +foreign import ccall safe "HROOTGrafTPCON.h TPCON_delete" + c_tpcon_delete :: Ptr RawTPCON -> IO () +foreign import ccall safe "HROOTGrafTPCON.h TPCON_newTPCON" + c_tpcon_newtpcon :: + CString -> + CString -> + CString -> CDouble -> CDouble -> CInt -> IO (Ptr RawTPCON) diff --git a/src/HROOT/Graf/TPCON/Implementation.hs b/src/HROOT/Graf/TPCON/Implementation.hs --- a/src/HROOT/Graf/TPCON/Implementation.hs +++ b/src/HROOT/Graf/TPCON/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TPCON.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TPCON.RawType import HROOT.Graf.TPCON.FFI import HROOT.Graf.TPCON.Interface @@ -36,88 +37,45 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITPCON TPCON +instance ITShape TPCON -instance ITPCON TPCON where -instance ITShape TPCON where instance ITNamed TPCON where - setName = xform1 c_tpcon_setname - setNameTitle = xform2 c_tpcon_setnametitle - setTitle = xform1 c_tpcon_settitle -instance ITAttLine TPCON where - getLineColor = xform0 c_tpcon_getlinecolor - getLineStyle = xform0 c_tpcon_getlinestyle - getLineWidth = xform0 c_tpcon_getlinewidth - resetAttLine = xform1 c_tpcon_resetattline - setLineAttributes = xform0 c_tpcon_setlineattributes - setLineColor = xform1 c_tpcon_setlinecolor - setLineStyle = xform1 c_tpcon_setlinestyle - setLineWidth = xform1 c_tpcon_setlinewidth -instance ITAttFill TPCON where - setFillColor = xform1 c_tpcon_setfillcolor - setFillStyle = xform1 c_tpcon_setfillstyle -instance ITAtt3D TPCON where -instance ITObject TPCON where - draw = xform1 c_tpcon_draw - findObject = xform1 c_tpcon_findobject - getName = xform0 c_tpcon_getname - isA = xform0 c_tpcon_isa - paint = xform1 c_tpcon_paint - printObj = xform1 c_tpcon_printobj - saveAs = xform2 c_tpcon_saveas - write = xform3 c_tpcon_write -instance IDeletable TPCON where - delete = xform0 c_tpcon_delete + setName = xform1 c_tpcon_setname + setNameTitle = xform2 c_tpcon_setnametitle + setTitle = xform1 c_tpcon_settitle -instance ITPCON (Exist TPCON) where +instance ITAttLine TPCON where + getLineColor = xform0 c_tpcon_getlinecolor + getLineStyle = xform0 c_tpcon_getlinestyle + getLineWidth = xform0 c_tpcon_getlinewidth + resetAttLine = xform1 c_tpcon_resetattline + setLineAttributes = xform0 c_tpcon_setlineattributes + setLineColor = xform1 c_tpcon_setlinecolor + setLineStyle = xform1 c_tpcon_setlinestyle + setLineWidth = xform1 c_tpcon_setlinewidth -instance ITShape (Exist TPCON) where +instance ITAttFill TPCON where + setFillColor = xform1 c_tpcon_setfillcolor + setFillStyle = xform1 c_tpcon_setfillstyle -instance ITNamed (Exist TPCON) where - setName (ETPCON x) = setName x - setNameTitle (ETPCON x) = setNameTitle x - setTitle (ETPCON x) = setTitle x -instance ITAttLine (Exist TPCON) where - getLineColor (ETPCON x) = getLineColor x - getLineStyle (ETPCON x) = getLineStyle x - getLineWidth (ETPCON x) = getLineWidth x - resetAttLine (ETPCON x) = resetAttLine x - setLineAttributes (ETPCON x) = setLineAttributes x - setLineColor (ETPCON x) = setLineColor x - setLineStyle (ETPCON x) = setLineStyle x - setLineWidth (ETPCON x) = setLineWidth x -instance ITAttFill (Exist TPCON) where - setFillColor (ETPCON x) = setFillColor x - setFillStyle (ETPCON x) = setFillStyle x -instance ITAtt3D (Exist TPCON) where +instance ITAtt3D TPCON -instance ITObject (Exist TPCON) where - draw (ETPCON x) = draw x - findObject (ETPCON x) = findObject x - getName (ETPCON x) = getName x - isA (ETPCON x) = isA x - paint (ETPCON x) = paint x - printObj (ETPCON x) = printObj x - saveAs (ETPCON x) = saveAs x - write (ETPCON x) = write x -instance IDeletable (Exist TPCON) where - delete (ETPCON x) = delete x +instance ITObject TPCON where + draw = xform1 c_tpcon_draw + findObject = xform1 c_tpcon_findobject + getName = xform0 c_tpcon_getname + isA = xform0 c_tpcon_isa + paint = xform1 c_tpcon_paint + printObj = xform1 c_tpcon_printobj + saveAs = xform2 c_tpcon_saveas + write = xform3 c_tpcon_write +instance IDeletable TPCON where + delete = xform0 c_tpcon_delete -newTPCON :: CString -> CString -> CString -> CDouble -> CDouble -> CInt -> IO TPCON +newTPCON :: + (Castable c2 CString, Castable c1 CString, Castable c0 CString) => + c0 -> c1 -> c2 -> CDouble -> CDouble -> CInt -> IO TPCON newTPCON = xform5 c_tpcon_newtpcon - - - - - -instance FPtr (Exist TPCON) where - type Raw (Exist TPCON) = RawTPCON - get_fptr (ETPCON obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETPCON (cast_fptr_to_obj (fptr :: ForeignPtr RawTPCON) :: TPCON) diff --git a/src/HROOT/Graf/TPCON/Interface.hs b/src/HROOT/Graf/TPCON/Interface.hs --- a/src/HROOT/Graf/TPCON/Interface.hs +++ b/src/HROOT/Graf/TPCON/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TPCON.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TPCON.RawType - import HROOT.Graf.TShape.Interface ----- ============ ---- - - -class (ITShape a) => ITPCON a where - -instance Existable TPCON where - data Exist TPCON = forall a. (FPtr a, ITPCON a) => ETPCON a +class ITShape a => ITPCON a -upcastTPCON :: (FPtr a, ITPCON a) => a -> TPCON -upcastTPCON h = let fh = get_fptr h - fh2 :: ForeignPtr RawTPCON = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTPCON :: forall a . (FPtr a, ITPCON a) => a -> TPCON +upcastTPCON h + = let fh = get_fptr h + fh2 :: Ptr RawTPCON = castPtr fh + in cast_fptr_to_obj fh2 -downcastTPCON :: (FPtr a, ITPCON a) => TPCON -> a -downcastTPCON h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTPCON :: forall a . (FPtr a, ITPCON a) => TPCON -> a +downcastTPCON h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TPCON/RawType.hs b/src/HROOT/Graf/TPCON/RawType.hs --- a/src/HROOT/Graf/TPCON/RawType.hs +++ b/src/HROOT/Graf/TPCON/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TPCON.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTPCON -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TPCON = TPCON (Ptr RawTPCON) + deriving (Eq, Ord, Show) -data RawTPCON -newtype TPCON = TPCON (ForeignPtr RawTPCON) deriving (Eq, Ord, Show) instance FPtr TPCON where - type Raw TPCON = RawTPCON - get_fptr (TPCON fptr) = fptr - cast_fptr_to_obj = TPCON + type Raw TPCON = RawTPCON + get_fptr (TPCON ptr) = ptr + cast_fptr_to_obj = TPCON diff --git a/src/HROOT/Graf/TPad.hs b/src/HROOT/Graf/TPad.hs --- a/src/HROOT/Graf/TPad.hs +++ b/src/HROOT/Graf/TPad.hs @@ -1,15 +1,5 @@ -module HROOT.Graf.TPad - ( - TPad(..) - , ITPad - , upcastTPad - , downcastTPad - - - ) where - +module HROOT.Graf.TPad (TPad(..), ITPad, upcastTPad, downcastTPad) + where import HROOT.Graf.TPad.RawType import HROOT.Graf.TPad.Interface import HROOT.Graf.TPad.Implementation - - diff --git a/src/HROOT/Graf/TPad/Cast.hs b/src/HROOT/Graf/TPad/Cast.hs --- a/src/HROOT/Graf/TPad/Cast.hs +++ b/src/HROOT/Graf/TPad/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TPad.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TPad.RawType import HROOT.Graf.TPad.Interface instance (ITPad a, FPtr a) => Castable a (Ptr RawTPad) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TPad (Ptr RawTPad) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TPad/FFI.hsc b/src/HROOT/Graf/TPad/FFI.hsc --- a/src/HROOT/Graf/TPad/FFI.hsc +++ b/src/HROOT/Graf/TPad/FFI.hsc @@ -1,62 +1,50 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TPad.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TPad.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTPad.h" - -foreign import ccall "HROOTGrafTPad.h TPad_cd" c_tpad_cd - :: (Ptr RawTPad) -> CInt -> IO (Ptr RawTPad) - -foreign import ccall "HROOTGrafTPad.h TPad_divide_tvirtualpad" c_tpad_divide_tvirtualpad - :: (Ptr RawTPad) -> CInt -> CInt -> CDouble -> CDouble -> CInt -> IO () +foreign import ccall safe "HROOTGrafTPad.h TPad_cd" c_tpad_cd :: + Ptr RawTPad -> CInt -> IO (Ptr RawTPad) -foreign import ccall "HROOTGrafTPad.h TPad_SetLogx" c_tpad_setlogx - :: (Ptr RawTPad) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTPad.h TPad_divide_tvirtualpad" + c_tpad_divide_tvirtualpad :: + Ptr RawTPad -> CInt -> CInt -> CDouble -> CDouble -> CInt -> IO () -foreign import ccall "HROOTGrafTPad.h TPad_SetLogy" c_tpad_setlogy - :: (Ptr RawTPad) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTPad.h TPad_SetLogx" + c_tpad_setlogx :: Ptr RawTPad -> CInt -> IO () -foreign import ccall "HROOTGrafTPad.h TPad_SetLogz" c_tpad_setlogz - :: (Ptr RawTPad) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTPad.h TPad_SetLogy" + c_tpad_setlogy :: Ptr RawTPad -> CInt -> IO () -foreign import ccall "HROOTGrafTPad.h TPad_Draw" c_tpad_draw - :: (Ptr RawTPad) -> CString -> IO () +foreign import ccall safe "HROOTGrafTPad.h TPad_SetLogz" + c_tpad_setlogz :: Ptr RawTPad -> CInt -> IO () -foreign import ccall "HROOTGrafTPad.h TPad_FindObject" c_tpad_findobject - :: (Ptr RawTPad) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTPad.h TPad_Draw" c_tpad_draw + :: Ptr RawTPad -> CString -> IO () -foreign import ccall "HROOTGrafTPad.h TPad_GetName" c_tpad_getname - :: (Ptr RawTPad) -> IO CString +foreign import ccall safe "HROOTGrafTPad.h TPad_FindObject" + c_tpad_findobject :: Ptr RawTPad -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTPad.h TPad_IsA" c_tpad_isa - :: (Ptr RawTPad) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTPad.h TPad_GetName" + c_tpad_getname :: Ptr RawTPad -> IO CString -foreign import ccall "HROOTGrafTPad.h TPad_Paint" c_tpad_paint - :: (Ptr RawTPad) -> CString -> IO () +foreign import ccall safe "HROOTGrafTPad.h TPad_IsA" c_tpad_isa :: + Ptr RawTPad -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTPad.h TPad_printObj" c_tpad_printobj - :: (Ptr RawTPad) -> CString -> IO () +foreign import ccall safe "HROOTGrafTPad.h TPad_Paint" c_tpad_paint + :: Ptr RawTPad -> CString -> IO () -foreign import ccall "HROOTGrafTPad.h TPad_SaveAs" c_tpad_saveas - :: (Ptr RawTPad) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTPad.h TPad_printObj" + c_tpad_printobj :: Ptr RawTPad -> CString -> IO () -foreign import ccall "HROOTGrafTPad.h TPad_Write" c_tpad_write - :: (Ptr RawTPad) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTPad.h TPad_SaveAs" + c_tpad_saveas :: Ptr RawTPad -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTPad.h TPad_delete" c_tpad_delete - :: (Ptr RawTPad) -> IO () +foreign import ccall safe "HROOTGrafTPad.h TPad_Write" c_tpad_write + :: Ptr RawTPad -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTPad.h TPad_delete" + c_tpad_delete :: Ptr RawTPad -> IO () diff --git a/src/HROOT/Graf/TPad/Implementation.hs b/src/HROOT/Graf/TPad/Implementation.hs --- a/src/HROOT/Graf/TPad/Implementation.hs +++ b/src/HROOT/Graf/TPad/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TPad.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TPad.RawType import HROOT.Graf.TPad.FFI import HROOT.Graf.TPad.Interface @@ -24,60 +25,24 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITPad TPad -instance ITPad TPad where instance ITVirtualPad TPad where - cd = xform1 c_tpad_cd - divide_tvirtualpad = xform5 c_tpad_divide_tvirtualpad - setLogx = xform1 c_tpad_setlogx - setLogy = xform1 c_tpad_setlogy - setLogz = xform1 c_tpad_setlogz -instance ITObject TPad where - draw = xform1 c_tpad_draw - findObject = xform1 c_tpad_findobject - getName = xform0 c_tpad_getname - isA = xform0 c_tpad_isa - paint = xform1 c_tpad_paint - printObj = xform1 c_tpad_printobj - saveAs = xform2 c_tpad_saveas - write = xform3 c_tpad_write -instance IDeletable TPad where - delete = xform0 c_tpad_delete - -instance ITPad (Exist TPad) where - -instance ITVirtualPad (Exist TPad) where - cd (ETPad x) a1 = return . ETPad =<< cd x a1 - divide_tvirtualpad (ETPad x) = divide_tvirtualpad x - setLogx (ETPad x) = setLogx x - setLogy (ETPad x) = setLogy x - setLogz (ETPad x) = setLogz x -instance ITObject (Exist TPad) where - draw (ETPad x) = draw x - findObject (ETPad x) = findObject x - getName (ETPad x) = getName x - isA (ETPad x) = isA x - paint (ETPad x) = paint x - printObj (ETPad x) = printObj x - saveAs (ETPad x) = saveAs x - write (ETPad x) = write x -instance IDeletable (Exist TPad) where - delete (ETPad x) = delete x - - - - - + cd = xform1 c_tpad_cd + divide_tvirtualpad = xform5 c_tpad_divide_tvirtualpad + setLogx = xform1 c_tpad_setlogx + setLogy = xform1 c_tpad_setlogy + setLogz = xform1 c_tpad_setlogz +instance ITObject TPad where + draw = xform1 c_tpad_draw + findObject = xform1 c_tpad_findobject + getName = xform0 c_tpad_getname + isA = xform0 c_tpad_isa + paint = xform1 c_tpad_paint + printObj = xform1 c_tpad_printobj + saveAs = xform2 c_tpad_saveas + write = xform3 c_tpad_write -instance FPtr (Exist TPad) where - type Raw (Exist TPad) = RawTPad - get_fptr (ETPad obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETPad (cast_fptr_to_obj (fptr :: ForeignPtr RawTPad) :: TPad) +instance IDeletable TPad where + delete = xform0 c_tpad_delete diff --git a/src/HROOT/Graf/TPad/Interface.hs b/src/HROOT/Graf/TPad/Interface.hs --- a/src/HROOT/Graf/TPad/Interface.hs +++ b/src/HROOT/Graf/TPad/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TPad.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TPad.RawType - import HROOT.Core.TVirtualPad.Interface ----- ============ ---- - - -class (ITVirtualPad a) => ITPad a where - -instance Existable TPad where - data Exist TPad = forall a. (FPtr a, ITPad a) => ETPad a +class ITVirtualPad a => ITPad a -upcastTPad :: (FPtr a, ITPad a) => a -> TPad -upcastTPad h = let fh = get_fptr h - fh2 :: ForeignPtr RawTPad = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTPad :: forall a . (FPtr a, ITPad a) => a -> TPad +upcastTPad h + = let fh = get_fptr h + fh2 :: Ptr RawTPad = castPtr fh + in cast_fptr_to_obj fh2 -downcastTPad :: (FPtr a, ITPad a) => TPad -> a -downcastTPad h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTPad :: forall a . (FPtr a, ITPad a) => TPad -> a +downcastTPad h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TPad/RawType.hs b/src/HROOT/Graf/TPad/RawType.hs --- a/src/HROOT/Graf/TPad/RawType.hs +++ b/src/HROOT/Graf/TPad/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TPad.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTPad -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TPad = TPad (Ptr RawTPad) + deriving (Eq, Ord, Show) -data RawTPad -newtype TPad = TPad (ForeignPtr RawTPad) deriving (Eq, Ord, Show) instance FPtr TPad where - type Raw TPad = RawTPad - get_fptr (TPad fptr) = fptr - cast_fptr_to_obj = TPad + type Raw TPad = RawTPad + get_fptr (TPad ptr) = ptr + cast_fptr_to_obj = TPad diff --git a/src/HROOT/Graf/TSPHE.hs b/src/HROOT/Graf/TSPHE.hs --- a/src/HROOT/Graf/TSPHE.hs +++ b/src/HROOT/Graf/TSPHE.hs @@ -1,15 +1,5 @@ module HROOT.Graf.TSPHE - ( - TSPHE(..) - , ITSPHE - , upcastTSPHE - , downcastTSPHE - , newTSPHE - - ) where - + (TSPHE(..), ITSPHE, upcastTSPHE, downcastTSPHE, newTSPHE) where import HROOT.Graf.TSPHE.RawType import HROOT.Graf.TSPHE.Interface import HROOT.Graf.TSPHE.Implementation - - diff --git a/src/HROOT/Graf/TSPHE/Cast.hs b/src/HROOT/Graf/TSPHE/Cast.hs --- a/src/HROOT/Graf/TSPHE/Cast.hs +++ b/src/HROOT/Graf/TSPHE/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TSPHE.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TSPHE.RawType import HROOT.Graf.TSPHE.Interface instance (ITSPHE a, FPtr a) => Castable a (Ptr RawTSPHE) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TSPHE (Ptr RawTSPHE) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TSPHE/FFI.hsc b/src/HROOT/Graf/TSPHE/FFI.hsc --- a/src/HROOT/Graf/TSPHE/FFI.hsc +++ b/src/HROOT/Graf/TSPHE/FFI.hsc @@ -1,89 +1,84 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TSPHE.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TSPHE.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTSPHE.h" - -foreign import ccall "HROOTGrafTSPHE.h TSPHE_SetName" c_tsphe_setname - :: (Ptr RawTSPHE) -> CString -> IO () - -foreign import ccall "HROOTGrafTSPHE.h TSPHE_SetNameTitle" c_tsphe_setnametitle - :: (Ptr RawTSPHE) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_SetName" + c_tsphe_setname :: Ptr RawTSPHE -> CString -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_SetTitle" c_tsphe_settitle - :: (Ptr RawTSPHE) -> CString -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_SetNameTitle" + c_tsphe_setnametitle :: Ptr RawTSPHE -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_GetLineColor" c_tsphe_getlinecolor - :: (Ptr RawTSPHE) -> IO CInt +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_SetTitle" + c_tsphe_settitle :: Ptr RawTSPHE -> CString -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_GetLineStyle" c_tsphe_getlinestyle - :: (Ptr RawTSPHE) -> IO CInt +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_GetLineColor" + c_tsphe_getlinecolor :: Ptr RawTSPHE -> IO CInt -foreign import ccall "HROOTGrafTSPHE.h TSPHE_GetLineWidth" c_tsphe_getlinewidth - :: (Ptr RawTSPHE) -> IO CInt +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_GetLineStyle" + c_tsphe_getlinestyle :: Ptr RawTSPHE -> IO CInt -foreign import ccall "HROOTGrafTSPHE.h TSPHE_ResetAttLine" c_tsphe_resetattline - :: (Ptr RawTSPHE) -> CString -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_GetLineWidth" + c_tsphe_getlinewidth :: Ptr RawTSPHE -> IO CInt -foreign import ccall "HROOTGrafTSPHE.h TSPHE_SetLineAttributes" c_tsphe_setlineattributes - :: (Ptr RawTSPHE) -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_ResetAttLine" + c_tsphe_resetattline :: Ptr RawTSPHE -> CString -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_SetLineColor" c_tsphe_setlinecolor - :: (Ptr RawTSPHE) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTSPHE.h TSPHE_SetLineAttributes" + c_tsphe_setlineattributes :: Ptr RawTSPHE -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_SetLineStyle" c_tsphe_setlinestyle - :: (Ptr RawTSPHE) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_SetLineColor" + c_tsphe_setlinecolor :: Ptr RawTSPHE -> CInt -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_SetLineWidth" c_tsphe_setlinewidth - :: (Ptr RawTSPHE) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_SetLineStyle" + c_tsphe_setlinestyle :: Ptr RawTSPHE -> CInt -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_SetFillColor" c_tsphe_setfillcolor - :: (Ptr RawTSPHE) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_SetLineWidth" + c_tsphe_setlinewidth :: Ptr RawTSPHE -> CInt -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_SetFillStyle" c_tsphe_setfillstyle - :: (Ptr RawTSPHE) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_SetFillColor" + c_tsphe_setfillcolor :: Ptr RawTSPHE -> CInt -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_Draw" c_tsphe_draw - :: (Ptr RawTSPHE) -> CString -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_SetFillStyle" + c_tsphe_setfillstyle :: Ptr RawTSPHE -> CInt -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_FindObject" c_tsphe_findobject - :: (Ptr RawTSPHE) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_Draw" + c_tsphe_draw :: Ptr RawTSPHE -> CString -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_GetName" c_tsphe_getname - :: (Ptr RawTSPHE) -> IO CString +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_FindObject" + c_tsphe_findobject :: + Ptr RawTSPHE -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTSPHE.h TSPHE_IsA" c_tsphe_isa - :: (Ptr RawTSPHE) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_GetName" + c_tsphe_getname :: Ptr RawTSPHE -> IO CString -foreign import ccall "HROOTGrafTSPHE.h TSPHE_Paint" c_tsphe_paint - :: (Ptr RawTSPHE) -> CString -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_IsA" c_tsphe_isa + :: Ptr RawTSPHE -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTSPHE.h TSPHE_printObj" c_tsphe_printobj - :: (Ptr RawTSPHE) -> CString -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_Paint" + c_tsphe_paint :: Ptr RawTSPHE -> CString -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_SaveAs" c_tsphe_saveas - :: (Ptr RawTSPHE) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_printObj" + c_tsphe_printobj :: Ptr RawTSPHE -> CString -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_Write" c_tsphe_write - :: (Ptr RawTSPHE) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_SaveAs" + c_tsphe_saveas :: Ptr RawTSPHE -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTSPHE.h TSPHE_delete" c_tsphe_delete - :: (Ptr RawTSPHE) -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_Write" + c_tsphe_write :: Ptr RawTSPHE -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTSPHE.h TSPHE_newTSPHE" c_tsphe_newtsphe - :: CString -> CString -> CString -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTSPHE) +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_delete" + c_tsphe_delete :: Ptr RawTSPHE -> IO () +foreign import ccall safe "HROOTGrafTSPHE.h TSPHE_newTSPHE" + c_tsphe_newtsphe :: + CString -> + CString -> + CString -> + CDouble -> + CDouble -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTSPHE) diff --git a/src/HROOT/Graf/TSPHE/Implementation.hs b/src/HROOT/Graf/TSPHE/Implementation.hs --- a/src/HROOT/Graf/TSPHE/Implementation.hs +++ b/src/HROOT/Graf/TSPHE/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TSPHE.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TSPHE.RawType import HROOT.Graf.TSPHE.FFI import HROOT.Graf.TSPHE.Interface @@ -36,88 +37,49 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITSPHE TSPHE +instance ITShape TSPHE -instance ITSPHE TSPHE where -instance ITShape TSPHE where instance ITNamed TSPHE where - setName = xform1 c_tsphe_setname - setNameTitle = xform2 c_tsphe_setnametitle - setTitle = xform1 c_tsphe_settitle -instance ITAttLine TSPHE where - getLineColor = xform0 c_tsphe_getlinecolor - getLineStyle = xform0 c_tsphe_getlinestyle - getLineWidth = xform0 c_tsphe_getlinewidth - resetAttLine = xform1 c_tsphe_resetattline - setLineAttributes = xform0 c_tsphe_setlineattributes - setLineColor = xform1 c_tsphe_setlinecolor - setLineStyle = xform1 c_tsphe_setlinestyle - setLineWidth = xform1 c_tsphe_setlinewidth -instance ITAttFill TSPHE where - setFillColor = xform1 c_tsphe_setfillcolor - setFillStyle = xform1 c_tsphe_setfillstyle -instance ITAtt3D TSPHE where -instance ITObject TSPHE where - draw = xform1 c_tsphe_draw - findObject = xform1 c_tsphe_findobject - getName = xform0 c_tsphe_getname - isA = xform0 c_tsphe_isa - paint = xform1 c_tsphe_paint - printObj = xform1 c_tsphe_printobj - saveAs = xform2 c_tsphe_saveas - write = xform3 c_tsphe_write -instance IDeletable TSPHE where - delete = xform0 c_tsphe_delete + setName = xform1 c_tsphe_setname + setNameTitle = xform2 c_tsphe_setnametitle + setTitle = xform1 c_tsphe_settitle -instance ITSPHE (Exist TSPHE) where +instance ITAttLine TSPHE where + getLineColor = xform0 c_tsphe_getlinecolor + getLineStyle = xform0 c_tsphe_getlinestyle + getLineWidth = xform0 c_tsphe_getlinewidth + resetAttLine = xform1 c_tsphe_resetattline + setLineAttributes = xform0 c_tsphe_setlineattributes + setLineColor = xform1 c_tsphe_setlinecolor + setLineStyle = xform1 c_tsphe_setlinestyle + setLineWidth = xform1 c_tsphe_setlinewidth -instance ITShape (Exist TSPHE) where +instance ITAttFill TSPHE where + setFillColor = xform1 c_tsphe_setfillcolor + setFillStyle = xform1 c_tsphe_setfillstyle -instance ITNamed (Exist TSPHE) where - setName (ETSPHE x) = setName x - setNameTitle (ETSPHE x) = setNameTitle x - setTitle (ETSPHE x) = setTitle x -instance ITAttLine (Exist TSPHE) where - getLineColor (ETSPHE x) = getLineColor x - getLineStyle (ETSPHE x) = getLineStyle x - getLineWidth (ETSPHE x) = getLineWidth x - resetAttLine (ETSPHE x) = resetAttLine x - setLineAttributes (ETSPHE x) = setLineAttributes x - setLineColor (ETSPHE x) = setLineColor x - setLineStyle (ETSPHE x) = setLineStyle x - setLineWidth (ETSPHE x) = setLineWidth x -instance ITAttFill (Exist TSPHE) where - setFillColor (ETSPHE x) = setFillColor x - setFillStyle (ETSPHE x) = setFillStyle x -instance ITAtt3D (Exist TSPHE) where +instance ITAtt3D TSPHE -instance ITObject (Exist TSPHE) where - draw (ETSPHE x) = draw x - findObject (ETSPHE x) = findObject x - getName (ETSPHE x) = getName x - isA (ETSPHE x) = isA x - paint (ETSPHE x) = paint x - printObj (ETSPHE x) = printObj x - saveAs (ETSPHE x) = saveAs x - write (ETSPHE x) = write x -instance IDeletable (Exist TSPHE) where - delete (ETSPHE x) = delete x +instance ITObject TSPHE where + draw = xform1 c_tsphe_draw + findObject = xform1 c_tsphe_findobject + getName = xform0 c_tsphe_getname + isA = xform0 c_tsphe_isa + paint = xform1 c_tsphe_paint + printObj = xform1 c_tsphe_printobj + saveAs = xform2 c_tsphe_saveas + write = xform3 c_tsphe_write +instance IDeletable TSPHE where + delete = xform0 c_tsphe_delete -newTSPHE :: CString -> CString -> CString -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO TSPHE +newTSPHE :: + (Castable c2 CString, Castable c1 CString, Castable c0 CString) => + c0 -> + c1 -> + c2 -> + CDouble -> + CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO TSPHE newTSPHE = xform8 c_tsphe_newtsphe - - - - - -instance FPtr (Exist TSPHE) where - type Raw (Exist TSPHE) = RawTSPHE - get_fptr (ETSPHE obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETSPHE (cast_fptr_to_obj (fptr :: ForeignPtr RawTSPHE) :: TSPHE) diff --git a/src/HROOT/Graf/TSPHE/Interface.hs b/src/HROOT/Graf/TSPHE/Interface.hs --- a/src/HROOT/Graf/TSPHE/Interface.hs +++ b/src/HROOT/Graf/TSPHE/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TSPHE.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TSPHE.RawType - import HROOT.Graf.TShape.Interface ----- ============ ---- - - -class (ITShape a) => ITSPHE a where - -instance Existable TSPHE where - data Exist TSPHE = forall a. (FPtr a, ITSPHE a) => ETSPHE a +class ITShape a => ITSPHE a -upcastTSPHE :: (FPtr a, ITSPHE a) => a -> TSPHE -upcastTSPHE h = let fh = get_fptr h - fh2 :: ForeignPtr RawTSPHE = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTSPHE :: forall a . (FPtr a, ITSPHE a) => a -> TSPHE +upcastTSPHE h + = let fh = get_fptr h + fh2 :: Ptr RawTSPHE = castPtr fh + in cast_fptr_to_obj fh2 -downcastTSPHE :: (FPtr a, ITSPHE a) => TSPHE -> a -downcastTSPHE h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTSPHE :: forall a . (FPtr a, ITSPHE a) => TSPHE -> a +downcastTSPHE h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TSPHE/RawType.hs b/src/HROOT/Graf/TSPHE/RawType.hs --- a/src/HROOT/Graf/TSPHE/RawType.hs +++ b/src/HROOT/Graf/TSPHE/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TSPHE.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTSPHE -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TSPHE = TSPHE (Ptr RawTSPHE) + deriving (Eq, Ord, Show) -data RawTSPHE -newtype TSPHE = TSPHE (ForeignPtr RawTSPHE) deriving (Eq, Ord, Show) instance FPtr TSPHE where - type Raw TSPHE = RawTSPHE - get_fptr (TSPHE fptr) = fptr - cast_fptr_to_obj = TSPHE + type Raw TSPHE = RawTSPHE + get_fptr (TSPHE ptr) = ptr + cast_fptr_to_obj = TSPHE diff --git a/src/HROOT/Graf/TShape.hs b/src/HROOT/Graf/TShape.hs --- a/src/HROOT/Graf/TShape.hs +++ b/src/HROOT/Graf/TShape.hs @@ -1,15 +1,6 @@ module HROOT.Graf.TShape - ( - TShape(..) - , ITShape - , upcastTShape - , downcastTShape - , newTShape - - ) where - + (TShape(..), ITShape, upcastTShape, downcastTShape, newTShape) + where import HROOT.Graf.TShape.RawType import HROOT.Graf.TShape.Interface import HROOT.Graf.TShape.Implementation - - diff --git a/src/HROOT/Graf/TShape/Cast.hs b/src/HROOT/Graf/TShape/Cast.hs --- a/src/HROOT/Graf/TShape/Cast.hs +++ b/src/HROOT/Graf/TShape/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TShape.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TShape.RawType import HROOT.Graf.TShape.Interface instance (ITShape a, FPtr a) => Castable a (Ptr RawTShape) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TShape (Ptr RawTShape) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TShape/FFI.hsc b/src/HROOT/Graf/TShape/FFI.hsc --- a/src/HROOT/Graf/TShape/FFI.hsc +++ b/src/HROOT/Graf/TShape/FFI.hsc @@ -1,89 +1,81 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TShape.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TShape.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTShape.h" - -foreign import ccall "HROOTGrafTShape.h TShape_SetName" c_tshape_setname - :: (Ptr RawTShape) -> CString -> IO () - -foreign import ccall "HROOTGrafTShape.h TShape_SetNameTitle" c_tshape_setnametitle - :: (Ptr RawTShape) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_SetName" + c_tshape_setname :: Ptr RawTShape -> CString -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_SetTitle" c_tshape_settitle - :: (Ptr RawTShape) -> CString -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_SetNameTitle" + c_tshape_setnametitle :: + Ptr RawTShape -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_GetLineColor" c_tshape_getlinecolor - :: (Ptr RawTShape) -> IO CInt +foreign import ccall safe "HROOTGrafTShape.h TShape_SetTitle" + c_tshape_settitle :: Ptr RawTShape -> CString -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_GetLineStyle" c_tshape_getlinestyle - :: (Ptr RawTShape) -> IO CInt +foreign import ccall safe "HROOTGrafTShape.h TShape_GetLineColor" + c_tshape_getlinecolor :: Ptr RawTShape -> IO CInt -foreign import ccall "HROOTGrafTShape.h TShape_GetLineWidth" c_tshape_getlinewidth - :: (Ptr RawTShape) -> IO CInt +foreign import ccall safe "HROOTGrafTShape.h TShape_GetLineStyle" + c_tshape_getlinestyle :: Ptr RawTShape -> IO CInt -foreign import ccall "HROOTGrafTShape.h TShape_ResetAttLine" c_tshape_resetattline - :: (Ptr RawTShape) -> CString -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_GetLineWidth" + c_tshape_getlinewidth :: Ptr RawTShape -> IO CInt -foreign import ccall "HROOTGrafTShape.h TShape_SetLineAttributes" c_tshape_setlineattributes - :: (Ptr RawTShape) -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_ResetAttLine" + c_tshape_resetattline :: Ptr RawTShape -> CString -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_SetLineColor" c_tshape_setlinecolor - :: (Ptr RawTShape) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTShape.h TShape_SetLineAttributes" + c_tshape_setlineattributes :: Ptr RawTShape -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_SetLineStyle" c_tshape_setlinestyle - :: (Ptr RawTShape) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_SetLineColor" + c_tshape_setlinecolor :: Ptr RawTShape -> CInt -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_SetLineWidth" c_tshape_setlinewidth - :: (Ptr RawTShape) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_SetLineStyle" + c_tshape_setlinestyle :: Ptr RawTShape -> CInt -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_SetFillColor" c_tshape_setfillcolor - :: (Ptr RawTShape) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_SetLineWidth" + c_tshape_setlinewidth :: Ptr RawTShape -> CInt -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_SetFillStyle" c_tshape_setfillstyle - :: (Ptr RawTShape) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_SetFillColor" + c_tshape_setfillcolor :: Ptr RawTShape -> CInt -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_Draw" c_tshape_draw - :: (Ptr RawTShape) -> CString -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_SetFillStyle" + c_tshape_setfillstyle :: Ptr RawTShape -> CInt -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_FindObject" c_tshape_findobject - :: (Ptr RawTShape) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTShape.h TShape_Draw" + c_tshape_draw :: Ptr RawTShape -> CString -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_GetName" c_tshape_getname - :: (Ptr RawTShape) -> IO CString +foreign import ccall safe "HROOTGrafTShape.h TShape_FindObject" + c_tshape_findobject :: + Ptr RawTShape -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTShape.h TShape_IsA" c_tshape_isa - :: (Ptr RawTShape) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTShape.h TShape_GetName" + c_tshape_getname :: Ptr RawTShape -> IO CString -foreign import ccall "HROOTGrafTShape.h TShape_Paint" c_tshape_paint - :: (Ptr RawTShape) -> CString -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_IsA" + c_tshape_isa :: Ptr RawTShape -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTShape.h TShape_printObj" c_tshape_printobj - :: (Ptr RawTShape) -> CString -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_Paint" + c_tshape_paint :: Ptr RawTShape -> CString -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_SaveAs" c_tshape_saveas - :: (Ptr RawTShape) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_printObj" + c_tshape_printobj :: Ptr RawTShape -> CString -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_Write" c_tshape_write - :: (Ptr RawTShape) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTShape.h TShape_SaveAs" + c_tshape_saveas :: Ptr RawTShape -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTShape.h TShape_delete" c_tshape_delete - :: (Ptr RawTShape) -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_Write" + c_tshape_write :: + Ptr RawTShape -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTShape.h TShape_newTShape" c_tshape_newtshape - :: CString -> CString -> CString -> IO (Ptr RawTShape) +foreign import ccall safe "HROOTGrafTShape.h TShape_delete" + c_tshape_delete :: Ptr RawTShape -> IO () +foreign import ccall safe "HROOTGrafTShape.h TShape_newTShape" + c_tshape_newtshape :: + CString -> CString -> CString -> IO (Ptr RawTShape) diff --git a/src/HROOT/Graf/TShape/Implementation.hs b/src/HROOT/Graf/TShape/Implementation.hs --- a/src/HROOT/Graf/TShape/Implementation.hs +++ b/src/HROOT/Graf/TShape/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TShape.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TShape.RawType import HROOT.Graf.TShape.FFI import HROOT.Graf.TShape.Interface @@ -33,85 +34,43 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITShape TShape -instance ITShape TShape where instance ITNamed TShape where - setName = xform1 c_tshape_setname - setNameTitle = xform2 c_tshape_setnametitle - setTitle = xform1 c_tshape_settitle + setName = xform1 c_tshape_setname + setNameTitle = xform2 c_tshape_setnametitle + setTitle = xform1 c_tshape_settitle + instance ITAttLine TShape where - getLineColor = xform0 c_tshape_getlinecolor - getLineStyle = xform0 c_tshape_getlinestyle - getLineWidth = xform0 c_tshape_getlinewidth - resetAttLine = xform1 c_tshape_resetattline - setLineAttributes = xform0 c_tshape_setlineattributes - setLineColor = xform1 c_tshape_setlinecolor - setLineStyle = xform1 c_tshape_setlinestyle - setLineWidth = xform1 c_tshape_setlinewidth -instance ITAttFill TShape where - setFillColor = xform1 c_tshape_setfillcolor - setFillStyle = xform1 c_tshape_setfillstyle -instance ITAtt3D TShape where -instance ITObject TShape where - draw = xform1 c_tshape_draw - findObject = xform1 c_tshape_findobject - getName = xform0 c_tshape_getname - isA = xform0 c_tshape_isa - paint = xform1 c_tshape_paint - printObj = xform1 c_tshape_printobj - saveAs = xform2 c_tshape_saveas - write = xform3 c_tshape_write -instance IDeletable TShape where - delete = xform0 c_tshape_delete + getLineColor = xform0 c_tshape_getlinecolor + getLineStyle = xform0 c_tshape_getlinestyle + getLineWidth = xform0 c_tshape_getlinewidth + resetAttLine = xform1 c_tshape_resetattline + setLineAttributes = xform0 c_tshape_setlineattributes + setLineColor = xform1 c_tshape_setlinecolor + setLineStyle = xform1 c_tshape_setlinestyle + setLineWidth = xform1 c_tshape_setlinewidth -instance ITShape (Exist TShape) where +instance ITAttFill TShape where + setFillColor = xform1 c_tshape_setfillcolor + setFillStyle = xform1 c_tshape_setfillstyle -instance ITNamed (Exist TShape) where - setName (ETShape x) = setName x - setNameTitle (ETShape x) = setNameTitle x - setTitle (ETShape x) = setTitle x -instance ITAttLine (Exist TShape) where - getLineColor (ETShape x) = getLineColor x - getLineStyle (ETShape x) = getLineStyle x - getLineWidth (ETShape x) = getLineWidth x - resetAttLine (ETShape x) = resetAttLine x - setLineAttributes (ETShape x) = setLineAttributes x - setLineColor (ETShape x) = setLineColor x - setLineStyle (ETShape x) = setLineStyle x - setLineWidth (ETShape x) = setLineWidth x -instance ITAttFill (Exist TShape) where - setFillColor (ETShape x) = setFillColor x - setFillStyle (ETShape x) = setFillStyle x -instance ITAtt3D (Exist TShape) where +instance ITAtt3D TShape -instance ITObject (Exist TShape) where - draw (ETShape x) = draw x - findObject (ETShape x) = findObject x - getName (ETShape x) = getName x - isA (ETShape x) = isA x - paint (ETShape x) = paint x - printObj (ETShape x) = printObj x - saveAs (ETShape x) = saveAs x - write (ETShape x) = write x -instance IDeletable (Exist TShape) where - delete (ETShape x) = delete x +instance ITObject TShape where + draw = xform1 c_tshape_draw + findObject = xform1 c_tshape_findobject + getName = xform0 c_tshape_getname + isA = xform0 c_tshape_isa + paint = xform1 c_tshape_paint + printObj = xform1 c_tshape_printobj + saveAs = xform2 c_tshape_saveas + write = xform3 c_tshape_write +instance IDeletable TShape where + delete = xform0 c_tshape_delete -newTShape :: CString -> CString -> CString -> IO TShape +newTShape :: + (Castable c2 CString, Castable c1 CString, Castable c0 CString) => + c0 -> c1 -> c2 -> IO TShape newTShape = xform2 c_tshape_newtshape - - - - - -instance FPtr (Exist TShape) where - type Raw (Exist TShape) = RawTShape - get_fptr (ETShape obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETShape (cast_fptr_to_obj (fptr :: ForeignPtr RawTShape) :: TShape) diff --git a/src/HROOT/Graf/TShape/Interface.hs b/src/HROOT/Graf/TShape/Interface.hs --- a/src/HROOT/Graf/TShape/Interface.hs +++ b/src/HROOT/Graf/TShape/Interface.hs @@ -1,39 +1,28 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TShape.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TShape.RawType - import HROOT.Core.TNamed.Interface import HROOT.Core.TAttLine.Interface import HROOT.Core.TAttFill.Interface import HROOT.Core.TAtt3D.Interface ----- ============ ---- - - -class (ITNamed a,ITAttLine a,ITAttFill a,ITAtt3D a) => ITShape a where - -instance Existable TShape where - data Exist TShape = forall a. (FPtr a, ITShape a) => ETShape a +class (ITNamed a, ITAttLine a, ITAttFill a, ITAtt3D a) => ITShape a -upcastTShape :: (FPtr a, ITShape a) => a -> TShape -upcastTShape h = let fh = get_fptr h - fh2 :: ForeignPtr RawTShape = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTShape :: forall a . (FPtr a, ITShape a) => a -> TShape +upcastTShape h + = let fh = get_fptr h + fh2 :: Ptr RawTShape = castPtr fh + in cast_fptr_to_obj fh2 -downcastTShape :: (FPtr a, ITShape a) => TShape -> a -downcastTShape h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTShape :: forall a . (FPtr a, ITShape a) => TShape -> a +downcastTShape h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TShape/RawType.hs b/src/HROOT/Graf/TShape/RawType.hs --- a/src/HROOT/Graf/TShape/RawType.hs +++ b/src/HROOT/Graf/TShape/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TShape.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTShape -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TShape = TShape (Ptr RawTShape) + deriving (Eq, Ord, Show) -data RawTShape -newtype TShape = TShape (ForeignPtr RawTShape) deriving (Eq, Ord, Show) instance FPtr TShape where - type Raw TShape = RawTShape - get_fptr (TShape fptr) = fptr - cast_fptr_to_obj = TShape + type Raw TShape = RawTShape + get_fptr (TShape ptr) = ptr + cast_fptr_to_obj = TShape diff --git a/src/HROOT/Graf/TTUBE.hs b/src/HROOT/Graf/TTUBE.hs --- a/src/HROOT/Graf/TTUBE.hs +++ b/src/HROOT/Graf/TTUBE.hs @@ -1,15 +1,5 @@ module HROOT.Graf.TTUBE - ( - TTUBE(..) - , ITTUBE - , upcastTTUBE - , downcastTTUBE - , newTTUBE - - ) where - + (TTUBE(..), ITTUBE, upcastTTUBE, downcastTTUBE, newTTUBE) where import HROOT.Graf.TTUBE.RawType import HROOT.Graf.TTUBE.Interface import HROOT.Graf.TTUBE.Implementation - - diff --git a/src/HROOT/Graf/TTUBE/Cast.hs b/src/HROOT/Graf/TTUBE/Cast.hs --- a/src/HROOT/Graf/TTUBE/Cast.hs +++ b/src/HROOT/Graf/TTUBE/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Graf.TTUBE.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Graf.TTUBE.RawType import HROOT.Graf.TTUBE.Interface instance (ITTUBE a, FPtr a) => Castable a (Ptr RawTTUBE) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TTUBE (Ptr RawTTUBE) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Graf/TTUBE/FFI.hsc b/src/HROOT/Graf/TTUBE/FFI.hsc --- a/src/HROOT/Graf/TTUBE/FFI.hsc +++ b/src/HROOT/Graf/TTUBE/FFI.hsc @@ -1,89 +1,82 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Graf.TTUBE.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Graf.TTUBE.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTGrafTTUBE.h" - -foreign import ccall "HROOTGrafTTUBE.h TTUBE_SetName" c_ttube_setname - :: (Ptr RawTTUBE) -> CString -> IO () - -foreign import ccall "HROOTGrafTTUBE.h TTUBE_SetNameTitle" c_ttube_setnametitle - :: (Ptr RawTTUBE) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_SetName" + c_ttube_setname :: Ptr RawTTUBE -> CString -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_SetTitle" c_ttube_settitle - :: (Ptr RawTTUBE) -> CString -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_SetNameTitle" + c_ttube_setnametitle :: Ptr RawTTUBE -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_GetLineColor" c_ttube_getlinecolor - :: (Ptr RawTTUBE) -> IO CInt +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_SetTitle" + c_ttube_settitle :: Ptr RawTTUBE -> CString -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_GetLineStyle" c_ttube_getlinestyle - :: (Ptr RawTTUBE) -> IO CInt +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_GetLineColor" + c_ttube_getlinecolor :: Ptr RawTTUBE -> IO CInt -foreign import ccall "HROOTGrafTTUBE.h TTUBE_GetLineWidth" c_ttube_getlinewidth - :: (Ptr RawTTUBE) -> IO CInt +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_GetLineStyle" + c_ttube_getlinestyle :: Ptr RawTTUBE -> IO CInt -foreign import ccall "HROOTGrafTTUBE.h TTUBE_ResetAttLine" c_ttube_resetattline - :: (Ptr RawTTUBE) -> CString -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_GetLineWidth" + c_ttube_getlinewidth :: Ptr RawTTUBE -> IO CInt -foreign import ccall "HROOTGrafTTUBE.h TTUBE_SetLineAttributes" c_ttube_setlineattributes - :: (Ptr RawTTUBE) -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_ResetAttLine" + c_ttube_resetattline :: Ptr RawTTUBE -> CString -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_SetLineColor" c_ttube_setlinecolor - :: (Ptr RawTTUBE) -> CInt -> IO () +foreign import ccall safe + "HROOTGrafTTUBE.h TTUBE_SetLineAttributes" + c_ttube_setlineattributes :: Ptr RawTTUBE -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_SetLineStyle" c_ttube_setlinestyle - :: (Ptr RawTTUBE) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_SetLineColor" + c_ttube_setlinecolor :: Ptr RawTTUBE -> CInt -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_SetLineWidth" c_ttube_setlinewidth - :: (Ptr RawTTUBE) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_SetLineStyle" + c_ttube_setlinestyle :: Ptr RawTTUBE -> CInt -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_SetFillColor" c_ttube_setfillcolor - :: (Ptr RawTTUBE) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_SetLineWidth" + c_ttube_setlinewidth :: Ptr RawTTUBE -> CInt -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_SetFillStyle" c_ttube_setfillstyle - :: (Ptr RawTTUBE) -> CInt -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_SetFillColor" + c_ttube_setfillcolor :: Ptr RawTTUBE -> CInt -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_Draw" c_ttube_draw - :: (Ptr RawTTUBE) -> CString -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_SetFillStyle" + c_ttube_setfillstyle :: Ptr RawTTUBE -> CInt -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_FindObject" c_ttube_findobject - :: (Ptr RawTTUBE) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_Draw" + c_ttube_draw :: Ptr RawTTUBE -> CString -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_GetName" c_ttube_getname - :: (Ptr RawTTUBE) -> IO CString +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_FindObject" + c_ttube_findobject :: + Ptr RawTTUBE -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTGrafTTUBE.h TTUBE_IsA" c_ttube_isa - :: (Ptr RawTTUBE) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_GetName" + c_ttube_getname :: Ptr RawTTUBE -> IO CString -foreign import ccall "HROOTGrafTTUBE.h TTUBE_Paint" c_ttube_paint - :: (Ptr RawTTUBE) -> CString -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_IsA" c_ttube_isa + :: Ptr RawTTUBE -> IO (Ptr RawTClass) -foreign import ccall "HROOTGrafTTUBE.h TTUBE_printObj" c_ttube_printobj - :: (Ptr RawTTUBE) -> CString -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_Paint" + c_ttube_paint :: Ptr RawTTUBE -> CString -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_SaveAs" c_ttube_saveas - :: (Ptr RawTTUBE) -> CString -> CString -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_printObj" + c_ttube_printobj :: Ptr RawTTUBE -> CString -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_Write" c_ttube_write - :: (Ptr RawTTUBE) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_SaveAs" + c_ttube_saveas :: Ptr RawTTUBE -> CString -> CString -> IO () -foreign import ccall "HROOTGrafTTUBE.h TTUBE_delete" c_ttube_delete - :: (Ptr RawTTUBE) -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_Write" + c_ttube_write :: Ptr RawTTUBE -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTGrafTTUBE.h TTUBE_newTTUBE" c_ttube_newttube - :: CString -> CString -> CString -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTTUBE) +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_delete" + c_ttube_delete :: Ptr RawTTUBE -> IO () +foreign import ccall safe "HROOTGrafTTUBE.h TTUBE_newTTUBE" + c_ttube_newttube :: + CString -> + CString -> + CString -> + CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr RawTTUBE) diff --git a/src/HROOT/Graf/TTUBE/Implementation.hs b/src/HROOT/Graf/TTUBE/Implementation.hs --- a/src/HROOT/Graf/TTUBE/Implementation.hs +++ b/src/HROOT/Graf/TTUBE/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TTUBE.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Graf.TTUBE.RawType import HROOT.Graf.TTUBE.FFI import HROOT.Graf.TTUBE.Interface @@ -36,88 +37,46 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITTUBE TTUBE +instance ITShape TTUBE -instance ITTUBE TTUBE where -instance ITShape TTUBE where instance ITNamed TTUBE where - setName = xform1 c_ttube_setname - setNameTitle = xform2 c_ttube_setnametitle - setTitle = xform1 c_ttube_settitle -instance ITAttLine TTUBE where - getLineColor = xform0 c_ttube_getlinecolor - getLineStyle = xform0 c_ttube_getlinestyle - getLineWidth = xform0 c_ttube_getlinewidth - resetAttLine = xform1 c_ttube_resetattline - setLineAttributes = xform0 c_ttube_setlineattributes - setLineColor = xform1 c_ttube_setlinecolor - setLineStyle = xform1 c_ttube_setlinestyle - setLineWidth = xform1 c_ttube_setlinewidth -instance ITAttFill TTUBE where - setFillColor = xform1 c_ttube_setfillcolor - setFillStyle = xform1 c_ttube_setfillstyle -instance ITAtt3D TTUBE where -instance ITObject TTUBE where - draw = xform1 c_ttube_draw - findObject = xform1 c_ttube_findobject - getName = xform0 c_ttube_getname - isA = xform0 c_ttube_isa - paint = xform1 c_ttube_paint - printObj = xform1 c_ttube_printobj - saveAs = xform2 c_ttube_saveas - write = xform3 c_ttube_write -instance IDeletable TTUBE where - delete = xform0 c_ttube_delete + setName = xform1 c_ttube_setname + setNameTitle = xform2 c_ttube_setnametitle + setTitle = xform1 c_ttube_settitle -instance ITTUBE (Exist TTUBE) where +instance ITAttLine TTUBE where + getLineColor = xform0 c_ttube_getlinecolor + getLineStyle = xform0 c_ttube_getlinestyle + getLineWidth = xform0 c_ttube_getlinewidth + resetAttLine = xform1 c_ttube_resetattline + setLineAttributes = xform0 c_ttube_setlineattributes + setLineColor = xform1 c_ttube_setlinecolor + setLineStyle = xform1 c_ttube_setlinestyle + setLineWidth = xform1 c_ttube_setlinewidth -instance ITShape (Exist TTUBE) where +instance ITAttFill TTUBE where + setFillColor = xform1 c_ttube_setfillcolor + setFillStyle = xform1 c_ttube_setfillstyle -instance ITNamed (Exist TTUBE) where - setName (ETTUBE x) = setName x - setNameTitle (ETTUBE x) = setNameTitle x - setTitle (ETTUBE x) = setTitle x -instance ITAttLine (Exist TTUBE) where - getLineColor (ETTUBE x) = getLineColor x - getLineStyle (ETTUBE x) = getLineStyle x - getLineWidth (ETTUBE x) = getLineWidth x - resetAttLine (ETTUBE x) = resetAttLine x - setLineAttributes (ETTUBE x) = setLineAttributes x - setLineColor (ETTUBE x) = setLineColor x - setLineStyle (ETTUBE x) = setLineStyle x - setLineWidth (ETTUBE x) = setLineWidth x -instance ITAttFill (Exist TTUBE) where - setFillColor (ETTUBE x) = setFillColor x - setFillStyle (ETTUBE x) = setFillStyle x -instance ITAtt3D (Exist TTUBE) where +instance ITAtt3D TTUBE -instance ITObject (Exist TTUBE) where - draw (ETTUBE x) = draw x - findObject (ETTUBE x) = findObject x - getName (ETTUBE x) = getName x - isA (ETTUBE x) = isA x - paint (ETTUBE x) = paint x - printObj (ETTUBE x) = printObj x - saveAs (ETTUBE x) = saveAs x - write (ETTUBE x) = write x -instance IDeletable (Exist TTUBE) where - delete (ETTUBE x) = delete x +instance ITObject TTUBE where + draw = xform1 c_ttube_draw + findObject = xform1 c_ttube_findobject + getName = xform0 c_ttube_getname + isA = xform0 c_ttube_isa + paint = xform1 c_ttube_paint + printObj = xform1 c_ttube_printobj + saveAs = xform2 c_ttube_saveas + write = xform3 c_ttube_write +instance IDeletable TTUBE where + delete = xform0 c_ttube_delete -newTTUBE :: CString -> CString -> CString -> CDouble -> CDouble -> CDouble -> CDouble -> IO TTUBE +newTTUBE :: + (Castable c2 CString, Castable c1 CString, Castable c0 CString) => + c0 -> + c1 -> c2 -> CDouble -> CDouble -> CDouble -> CDouble -> IO TTUBE newTTUBE = xform6 c_ttube_newttube - - - - - -instance FPtr (Exist TTUBE) where - type Raw (Exist TTUBE) = RawTTUBE - get_fptr (ETTUBE obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETTUBE (cast_fptr_to_obj (fptr :: ForeignPtr RawTTUBE) :: TTUBE) diff --git a/src/HROOT/Graf/TTUBE/Interface.hs b/src/HROOT/Graf/TTUBE/Interface.hs --- a/src/HROOT/Graf/TTUBE/Interface.hs +++ b/src/HROOT/Graf/TTUBE/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Graf.TTUBE.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Graf.TTUBE.RawType - import HROOT.Graf.TShape.Interface ----- ============ ---- - - -class (ITShape a) => ITTUBE a where - -instance Existable TTUBE where - data Exist TTUBE = forall a. (FPtr a, ITTUBE a) => ETTUBE a +class ITShape a => ITTUBE a -upcastTTUBE :: (FPtr a, ITTUBE a) => a -> TTUBE -upcastTTUBE h = let fh = get_fptr h - fh2 :: ForeignPtr RawTTUBE = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTTUBE :: forall a . (FPtr a, ITTUBE a) => a -> TTUBE +upcastTTUBE h + = let fh = get_fptr h + fh2 :: Ptr RawTTUBE = castPtr fh + in cast_fptr_to_obj fh2 -downcastTTUBE :: (FPtr a, ITTUBE a) => TTUBE -> a -downcastTTUBE h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTTUBE :: forall a . (FPtr a, ITTUBE a) => TTUBE -> a +downcastTTUBE h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Graf/TTUBE/RawType.hs b/src/HROOT/Graf/TTUBE/RawType.hs --- a/src/HROOT/Graf/TTUBE/RawType.hs +++ b/src/HROOT/Graf/TTUBE/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Graf.TTUBE.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTTUBE -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TTUBE = TTUBE (Ptr RawTTUBE) + deriving (Eq, Ord, Show) -data RawTTUBE -newtype TTUBE = TTUBE (ForeignPtr RawTTUBE) deriving (Eq, Ord, Show) instance FPtr TTUBE where - type Raw TTUBE = RawTTUBE - get_fptr (TTUBE fptr) = fptr - cast_fptr_to_obj = TTUBE + type Raw TTUBE = RawTTUBE + get_fptr (TTUBE ptr) = ptr + cast_fptr_to_obj = TTUBE