diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,39 @@ +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 new file mode 100644 --- /dev/null +++ b/Config.hs @@ -0,0 +1,85 @@ +{-# 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-core.cabal b/HROOT-core.cabal new file mode 100644 --- /dev/null +++ b/HROOT-core.cabal @@ -0,0 +1,376 @@ +Name: HROOT-core +Version: 0.8 +Synopsis: Haskell binding to ROOT Core 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 +Category: Graphics, Statistics, Math, Numerical +Tested-with: GHC >= 7.6 +Build-Type: Custom +cabal-version: >=1.10 +Extra-source-files: + CHANGES + Config.hs + csrc/HROOT-coreTopLevel.h + csrc/HROOTCoreDeletable.h + csrc/HROOTCoreTApplication.h + csrc/HROOTCoreTArray.h + csrc/HROOTCoreTArrayC.h + csrc/HROOTCoreTArrayD.h + csrc/HROOTCoreTArrayF.h + csrc/HROOTCoreTArrayI.h + csrc/HROOTCoreTArrayL.h + csrc/HROOTCoreTArrayL64.h + csrc/HROOTCoreTArrayS.h + csrc/HROOTCoreTAtt3D.h + csrc/HROOTCoreTAttAxis.h + csrc/HROOTCoreTAttBBox.h + csrc/HROOTCoreTAttCanvas.h + csrc/HROOTCoreTAttFill.h + csrc/HROOTCoreTAttLine.h + csrc/HROOTCoreTAttMarker.h + csrc/HROOTCoreTAttPad.h + csrc/HROOTCoreTAttText.h + csrc/HROOTCoreTClass.h + csrc/HROOTCoreTCollection.h + csrc/HROOTCoreTDictionary.h + csrc/HROOTCoreTDirectory.h + csrc/HROOTCoreTGlobal.h + csrc/HROOTCoreTKey.h + csrc/HROOTCoreTNamed.h + csrc/HROOTCoreTObjArray.h + csrc/HROOTCoreTObject.h + csrc/HROOTCoreTQObject.h + csrc/HROOTCoreTROOT.h + csrc/HROOTCoreTSeqCollection.h + csrc/HROOTCoreTSystem.h + csrc/HROOTCoreTVirtualPad.h + csrc/HROOT-coreTopLevel.cpp + csrc/HROOTCoreDeletable.cpp + csrc/HROOTCoreTApplication.cpp + csrc/HROOTCoreTArray.cpp + csrc/HROOTCoreTArrayC.cpp + csrc/HROOTCoreTArrayD.cpp + csrc/HROOTCoreTArrayF.cpp + csrc/HROOTCoreTArrayI.cpp + csrc/HROOTCoreTArrayL.cpp + csrc/HROOTCoreTArrayL64.cpp + csrc/HROOTCoreTArrayS.cpp + csrc/HROOTCoreTAtt3D.cpp + csrc/HROOTCoreTAttAxis.cpp + csrc/HROOTCoreTAttBBox.cpp + csrc/HROOTCoreTAttCanvas.cpp + csrc/HROOTCoreTAttFill.cpp + csrc/HROOTCoreTAttLine.cpp + csrc/HROOTCoreTAttMarker.cpp + csrc/HROOTCoreTAttPad.cpp + csrc/HROOTCoreTAttText.cpp + csrc/HROOTCoreTClass.cpp + csrc/HROOTCoreTCollection.cpp + csrc/HROOTCoreTDictionary.cpp + csrc/HROOTCoreTDirectory.cpp + csrc/HROOTCoreTGlobal.cpp + csrc/HROOTCoreTKey.cpp + csrc/HROOTCoreTNamed.cpp + csrc/HROOTCoreTObjArray.cpp + csrc/HROOTCoreTObject.cpp + csrc/HROOTCoreTQObject.cpp + csrc/HROOTCoreTROOT.cpp + csrc/HROOTCoreTSeqCollection.cpp + csrc/HROOTCoreTSystem.cpp + csrc/HROOTCoreTVirtualPad.cpp + + + + +Library + default-language: Haskell2010 + 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 + Exposed-Modules: + HROOT.Core + HROOT.Core.Deletable + HROOT.Core.TApplication + HROOT.Core.TArray + HROOT.Core.TArrayC + HROOT.Core.TArrayD + HROOT.Core.TArrayF + HROOT.Core.TArrayI + HROOT.Core.TArrayL + HROOT.Core.TArrayL64 + HROOT.Core.TArrayS + HROOT.Core.TAtt3D + HROOT.Core.TAttAxis + HROOT.Core.TAttBBox + HROOT.Core.TAttCanvas + HROOT.Core.TAttFill + HROOT.Core.TAttLine + HROOT.Core.TAttMarker + HROOT.Core.TAttPad + HROOT.Core.TAttText + HROOT.Core.TClass + HROOT.Core.TCollection + HROOT.Core.TDictionary + HROOT.Core.TDirectory + HROOT.Core.TGlobal + HROOT.Core.TKey + HROOT.Core.TNamed + HROOT.Core.TObjArray + HROOT.Core.TObject + HROOT.Core.TQObject + HROOT.Core.TROOT + HROOT.Core.TSeqCollection + HROOT.Core.TSystem + HROOT.Core.TVirtualPad + HROOT.Core.Deletable.RawType + HROOT.Core.TApplication.RawType + HROOT.Core.TArray.RawType + HROOT.Core.TArrayC.RawType + HROOT.Core.TArrayD.RawType + HROOT.Core.TArrayF.RawType + HROOT.Core.TArrayI.RawType + HROOT.Core.TArrayL.RawType + HROOT.Core.TArrayL64.RawType + HROOT.Core.TArrayS.RawType + HROOT.Core.TAtt3D.RawType + HROOT.Core.TAttAxis.RawType + HROOT.Core.TAttBBox.RawType + HROOT.Core.TAttCanvas.RawType + HROOT.Core.TAttFill.RawType + HROOT.Core.TAttLine.RawType + HROOT.Core.TAttMarker.RawType + HROOT.Core.TAttPad.RawType + HROOT.Core.TAttText.RawType + HROOT.Core.TClass.RawType + HROOT.Core.TCollection.RawType + HROOT.Core.TDictionary.RawType + HROOT.Core.TDirectory.RawType + HROOT.Core.TGlobal.RawType + HROOT.Core.TKey.RawType + HROOT.Core.TNamed.RawType + HROOT.Core.TObjArray.RawType + HROOT.Core.TObject.RawType + HROOT.Core.TQObject.RawType + HROOT.Core.TROOT.RawType + HROOT.Core.TSeqCollection.RawType + HROOT.Core.TSystem.RawType + HROOT.Core.TVirtualPad.RawType + HROOT.Core.Deletable.FFI + HROOT.Core.TApplication.FFI + HROOT.Core.TArray.FFI + HROOT.Core.TArrayC.FFI + HROOT.Core.TArrayD.FFI + HROOT.Core.TArrayF.FFI + HROOT.Core.TArrayI.FFI + HROOT.Core.TArrayL.FFI + HROOT.Core.TArrayL64.FFI + HROOT.Core.TArrayS.FFI + HROOT.Core.TAtt3D.FFI + HROOT.Core.TAttAxis.FFI + HROOT.Core.TAttBBox.FFI + HROOT.Core.TAttCanvas.FFI + HROOT.Core.TAttFill.FFI + HROOT.Core.TAttLine.FFI + HROOT.Core.TAttMarker.FFI + HROOT.Core.TAttPad.FFI + HROOT.Core.TAttText.FFI + HROOT.Core.TClass.FFI + HROOT.Core.TCollection.FFI + HROOT.Core.TDictionary.FFI + HROOT.Core.TDirectory.FFI + HROOT.Core.TGlobal.FFI + HROOT.Core.TKey.FFI + HROOT.Core.TNamed.FFI + HROOT.Core.TObjArray.FFI + HROOT.Core.TObject.FFI + HROOT.Core.TQObject.FFI + HROOT.Core.TROOT.FFI + HROOT.Core.TSeqCollection.FFI + HROOT.Core.TSystem.FFI + HROOT.Core.TVirtualPad.FFI + HROOT.Core.Deletable.Interface + HROOT.Core.TApplication.Interface + HROOT.Core.TArray.Interface + HROOT.Core.TArrayC.Interface + HROOT.Core.TArrayD.Interface + HROOT.Core.TArrayF.Interface + HROOT.Core.TArrayI.Interface + HROOT.Core.TArrayL.Interface + HROOT.Core.TArrayL64.Interface + HROOT.Core.TArrayS.Interface + HROOT.Core.TAtt3D.Interface + HROOT.Core.TAttAxis.Interface + HROOT.Core.TAttBBox.Interface + HROOT.Core.TAttCanvas.Interface + HROOT.Core.TAttFill.Interface + HROOT.Core.TAttLine.Interface + HROOT.Core.TAttMarker.Interface + HROOT.Core.TAttPad.Interface + HROOT.Core.TAttText.Interface + HROOT.Core.TClass.Interface + HROOT.Core.TCollection.Interface + HROOT.Core.TDictionary.Interface + HROOT.Core.TDirectory.Interface + HROOT.Core.TGlobal.Interface + HROOT.Core.TKey.Interface + HROOT.Core.TNamed.Interface + HROOT.Core.TObjArray.Interface + HROOT.Core.TObject.Interface + HROOT.Core.TQObject.Interface + HROOT.Core.TROOT.Interface + HROOT.Core.TSeqCollection.Interface + HROOT.Core.TSystem.Interface + HROOT.Core.TVirtualPad.Interface + HROOT.Core.Deletable.Cast + HROOT.Core.TApplication.Cast + HROOT.Core.TArray.Cast + HROOT.Core.TArrayC.Cast + HROOT.Core.TArrayD.Cast + HROOT.Core.TArrayF.Cast + HROOT.Core.TArrayI.Cast + HROOT.Core.TArrayL.Cast + HROOT.Core.TArrayL64.Cast + HROOT.Core.TArrayS.Cast + HROOT.Core.TAtt3D.Cast + HROOT.Core.TAttAxis.Cast + HROOT.Core.TAttBBox.Cast + HROOT.Core.TAttCanvas.Cast + HROOT.Core.TAttFill.Cast + HROOT.Core.TAttLine.Cast + HROOT.Core.TAttMarker.Cast + HROOT.Core.TAttPad.Cast + HROOT.Core.TAttText.Cast + HROOT.Core.TClass.Cast + HROOT.Core.TCollection.Cast + HROOT.Core.TDictionary.Cast + HROOT.Core.TDirectory.Cast + HROOT.Core.TGlobal.Cast + HROOT.Core.TKey.Cast + HROOT.Core.TNamed.Cast + HROOT.Core.TObjArray.Cast + HROOT.Core.TObject.Cast + HROOT.Core.TQObject.Cast + HROOT.Core.TROOT.Cast + HROOT.Core.TSeqCollection.Cast + HROOT.Core.TSystem.Cast + HROOT.Core.TVirtualPad.Cast + HROOT.Core.Deletable.Implementation + HROOT.Core.TApplication.Implementation + HROOT.Core.TArray.Implementation + HROOT.Core.TArrayC.Implementation + HROOT.Core.TArrayD.Implementation + HROOT.Core.TArrayF.Implementation + HROOT.Core.TArrayI.Implementation + HROOT.Core.TArrayL.Implementation + HROOT.Core.TArrayL64.Implementation + HROOT.Core.TArrayS.Implementation + HROOT.Core.TAtt3D.Implementation + HROOT.Core.TAttAxis.Implementation + HROOT.Core.TAttBBox.Implementation + HROOT.Core.TAttCanvas.Implementation + HROOT.Core.TAttFill.Implementation + HROOT.Core.TAttLine.Implementation + HROOT.Core.TAttMarker.Implementation + HROOT.Core.TAttPad.Implementation + HROOT.Core.TAttText.Implementation + HROOT.Core.TClass.Implementation + HROOT.Core.TCollection.Implementation + HROOT.Core.TDictionary.Implementation + HROOT.Core.TDirectory.Implementation + HROOT.Core.TGlobal.Implementation + HROOT.Core.TKey.Implementation + HROOT.Core.TNamed.Implementation + HROOT.Core.TObjArray.Implementation + HROOT.Core.TObject.Implementation + HROOT.Core.TQObject.Implementation + HROOT.Core.TROOT.Implementation + HROOT.Core.TSeqCollection.Implementation + HROOT.Core.TSystem.Implementation + HROOT.Core.TVirtualPad.Implementation + + Other-Modules: + + extra-lib-dirs: + extra-libraries: stdc++ + Include-dirs: csrc + Install-includes: + HROOT-coreType.h + HROOTCoreDeletable.h + HROOTCoreTApplication.h + HROOTCoreTArray.h + HROOTCoreTArrayC.h + HROOTCoreTArrayD.h + HROOTCoreTArrayF.h + HROOTCoreTArrayI.h + HROOTCoreTArrayL.h + HROOTCoreTArrayL64.h + HROOTCoreTArrayS.h + HROOTCoreTAtt3D.h + HROOTCoreTAttAxis.h + HROOTCoreTAttBBox.h + HROOTCoreTAttCanvas.h + HROOTCoreTAttFill.h + HROOTCoreTAttLine.h + HROOTCoreTAttMarker.h + HROOTCoreTAttPad.h + HROOTCoreTAttText.h + HROOTCoreTClass.h + HROOTCoreTCollection.h + HROOTCoreTDictionary.h + HROOTCoreTDirectory.h + HROOTCoreTGlobal.h + HROOTCoreTKey.h + HROOTCoreTNamed.h + HROOTCoreTObjArray.h + HROOTCoreTObject.h + HROOTCoreTQObject.h + HROOTCoreTROOT.h + HROOTCoreTSeqCollection.h + HROOTCoreTSystem.h + HROOTCoreTVirtualPad.h + + C-sources: + csrc/HROOT-coreTopLevel.cpp + csrc/HROOTCoreDeletable.cpp + csrc/HROOTCoreTApplication.cpp + csrc/HROOTCoreTArray.cpp + csrc/HROOTCoreTArrayC.cpp + csrc/HROOTCoreTArrayD.cpp + csrc/HROOTCoreTArrayF.cpp + csrc/HROOTCoreTArrayI.cpp + csrc/HROOTCoreTArrayL.cpp + csrc/HROOTCoreTArrayL64.cpp + csrc/HROOTCoreTArrayS.cpp + csrc/HROOTCoreTAtt3D.cpp + csrc/HROOTCoreTAttAxis.cpp + csrc/HROOTCoreTAttBBox.cpp + csrc/HROOTCoreTAttCanvas.cpp + csrc/HROOTCoreTAttFill.cpp + csrc/HROOTCoreTAttLine.cpp + csrc/HROOTCoreTAttMarker.cpp + csrc/HROOTCoreTAttPad.cpp + csrc/HROOTCoreTAttText.cpp + csrc/HROOTCoreTClass.cpp + csrc/HROOTCoreTCollection.cpp + csrc/HROOTCoreTDictionary.cpp + csrc/HROOTCoreTDirectory.cpp + csrc/HROOTCoreTGlobal.cpp + csrc/HROOTCoreTKey.cpp + csrc/HROOTCoreTNamed.cpp + csrc/HROOTCoreTObjArray.cpp + csrc/HROOTCoreTObject.cpp + csrc/HROOTCoreTQObject.cpp + csrc/HROOTCoreTROOT.cpp + csrc/HROOTCoreTSeqCollection.cpp + csrc/HROOTCoreTSystem.cpp + csrc/HROOTCoreTVirtualPad.cpp + + + + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,502 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,33 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> import Distribution.Simple.Setup +> import Distribution.PackageDescription +> import Distribution.Simple.LocalBuildInfo +> +> import Config +> +> myconfigHook = simpleUserHooks { confHook = hookfunction } +> +> hookfunction x y = do +> binfo <- confHook simpleUserHooks x y +> r_pbi <- config binfo +> let pkg_descr = localPkgDescr binfo +> +> let newbinfo = case r_pbi of +> Just pbi -> binfo { localPkgDescr = updatePackageDescription pbi pkg_descr } +> Nothing -> do +> let r_lib = library pkg_descr +> case r_lib of +> Just lib -> +> let binfo2 = libBuildInfo lib +> newlib = lib { libBuildInfo = binfo2 { cSources = [] }} +> in binfo { localPkgDescr = pkg_descr { library = Just newlib }} +> Nothing -> error "some library setting is wrong." +> -- putStrLn (show (localPkgDescr newbinfo)) +> return newbinfo +> +> +> main = defaultMainWithHooks myconfigHook +> + diff --git a/csrc/HROOT-coreTopLevel.cpp b/csrc/HROOT-coreTopLevel.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOT-coreTopLevel.cpp @@ -0,0 +1,56 @@ +#include + +#include "HROOT-coreTopLevel.h" + +#include "HROOTCoreTGlobal.h" +#include "HROOTCoreTDirectory.h" +#include "TROOT.h" +#include "HROOTCoreTNamed.h" +#include "TSystem.h" + +#include "HROOTCoreTROOT.h" +#include "HROOTCoreTSystem.h" + +using namespace std; +using namespace ROOT; + + +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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + +TROOT_p TopLevel_GetROOT ( ) { + return to_nonconst((TROOT*)GetROOT()); +} +TROOT_p TopLevel_gROOT ( ) { + return to_nonconst((TROOT*)gROOT); +} +TSystem_p TopLevel_gSystem ( ) { + return to_nonconst((TSystem*)gSystem); +} + + diff --git a/csrc/HROOT-coreTopLevel.h b/csrc/HROOT-coreTopLevel.h new file mode 100644 --- /dev/null +++ b/csrc/HROOT-coreTopLevel.h @@ -0,0 +1,21 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TOPLEVEL__ +#define __HROOT_CORE__TOPLEVEL__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTROOT.h" +#include "HROOTCoreTSystem.h" + +TROOT_p TopLevel_GetROOT ( ); +TROOT_p TopLevel_gROOT ( ); +TSystem_p TopLevel_gSystem ( ); + +#endif // __HROOT_CORE__TOPLEVEL__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOT-coreType.h b/csrc/HROOT-coreType.h new file mode 100644 --- /dev/null +++ b/csrc/HROOT-coreType.h @@ -0,0 +1,177 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__ +#define __HROOT_CORE__ + +// Opaque type definition for Deletable +typedef struct Deletable_tag Deletable_t; +typedef Deletable_t * Deletable_p; +typedef Deletable_t const* const_Deletable_p; + +// Opaque type definition for TApplication +typedef struct TApplication_tag TApplication_t; +typedef TApplication_t * TApplication_p; +typedef TApplication_t const* const_TApplication_p; + +// Opaque type definition for TArray +typedef struct TArray_tag TArray_t; +typedef TArray_t * TArray_p; +typedef TArray_t const* const_TArray_p; + +// Opaque type definition for TArrayC +typedef struct TArrayC_tag TArrayC_t; +typedef TArrayC_t * TArrayC_p; +typedef TArrayC_t const* const_TArrayC_p; + +// Opaque type definition for TArrayD +typedef struct TArrayD_tag TArrayD_t; +typedef TArrayD_t * TArrayD_p; +typedef TArrayD_t const* const_TArrayD_p; + +// Opaque type definition for TArrayF +typedef struct TArrayF_tag TArrayF_t; +typedef TArrayF_t * TArrayF_p; +typedef TArrayF_t const* const_TArrayF_p; + +// Opaque type definition for TArrayI +typedef struct TArrayI_tag TArrayI_t; +typedef TArrayI_t * TArrayI_p; +typedef TArrayI_t const* const_TArrayI_p; + +// Opaque type definition for TArrayL +typedef struct TArrayL_tag TArrayL_t; +typedef TArrayL_t * TArrayL_p; +typedef TArrayL_t const* const_TArrayL_p; + +// Opaque type definition for TArrayL64 +typedef struct TArrayL64_tag TArrayL64_t; +typedef TArrayL64_t * TArrayL64_p; +typedef TArrayL64_t const* const_TArrayL64_p; + +// Opaque type definition for TArrayS +typedef struct TArrayS_tag TArrayS_t; +typedef TArrayS_t * TArrayS_p; +typedef TArrayS_t const* const_TArrayS_p; + +// Opaque type definition for TAtt3D +typedef struct TAtt3D_tag TAtt3D_t; +typedef TAtt3D_t * TAtt3D_p; +typedef TAtt3D_t const* const_TAtt3D_p; + +// Opaque type definition for TAttAxis +typedef struct TAttAxis_tag TAttAxis_t; +typedef TAttAxis_t * TAttAxis_p; +typedef TAttAxis_t const* const_TAttAxis_p; + +// Opaque type definition for TAttBBox +typedef struct TAttBBox_tag TAttBBox_t; +typedef TAttBBox_t * TAttBBox_p; +typedef TAttBBox_t const* const_TAttBBox_p; + +// Opaque type definition for TAttCanvas +typedef struct TAttCanvas_tag TAttCanvas_t; +typedef TAttCanvas_t * TAttCanvas_p; +typedef TAttCanvas_t const* const_TAttCanvas_p; + +// Opaque type definition for TAttFill +typedef struct TAttFill_tag TAttFill_t; +typedef TAttFill_t * TAttFill_p; +typedef TAttFill_t const* const_TAttFill_p; + +// Opaque type definition for TAttLine +typedef struct TAttLine_tag TAttLine_t; +typedef TAttLine_t * TAttLine_p; +typedef TAttLine_t const* const_TAttLine_p; + +// Opaque type definition for TAttMarker +typedef struct TAttMarker_tag TAttMarker_t; +typedef TAttMarker_t * TAttMarker_p; +typedef TAttMarker_t const* const_TAttMarker_p; + +// Opaque type definition for TAttPad +typedef struct TAttPad_tag TAttPad_t; +typedef TAttPad_t * TAttPad_p; +typedef TAttPad_t const* const_TAttPad_p; + +// Opaque type definition for TAttText +typedef struct TAttText_tag TAttText_t; +typedef TAttText_t * TAttText_p; +typedef TAttText_t const* const_TAttText_p; + +// Opaque type definition for TClass +typedef struct TClass_tag TClass_t; +typedef TClass_t * TClass_p; +typedef TClass_t const* const_TClass_p; + +// Opaque type definition for TCollection +typedef struct TCollection_tag TCollection_t; +typedef TCollection_t * TCollection_p; +typedef TCollection_t const* const_TCollection_p; + +// Opaque type definition for TDictionary +typedef struct TDictionary_tag TDictionary_t; +typedef TDictionary_t * TDictionary_p; +typedef TDictionary_t const* const_TDictionary_p; + +// Opaque type definition for TDirectory +typedef struct TDirectory_tag TDirectory_t; +typedef TDirectory_t * TDirectory_p; +typedef TDirectory_t const* const_TDirectory_p; + +// Opaque type definition for TGlobal +typedef struct TGlobal_tag TGlobal_t; +typedef TGlobal_t * TGlobal_p; +typedef TGlobal_t const* const_TGlobal_p; + +// Opaque type definition for TKey +typedef struct TKey_tag TKey_t; +typedef TKey_t * TKey_p; +typedef TKey_t const* const_TKey_p; + +// Opaque type definition for TNamed +typedef struct TNamed_tag TNamed_t; +typedef TNamed_t * TNamed_p; +typedef TNamed_t const* const_TNamed_p; + +// Opaque type definition for TObjArray +typedef struct TObjArray_tag TObjArray_t; +typedef TObjArray_t * TObjArray_p; +typedef TObjArray_t const* const_TObjArray_p; + +// Opaque type definition for TObject +typedef struct TObject_tag TObject_t; +typedef TObject_t * TObject_p; +typedef TObject_t const* const_TObject_p; + +// Opaque type definition for TQObject +typedef struct TQObject_tag TQObject_t; +typedef TQObject_t * TQObject_p; +typedef TQObject_t const* const_TQObject_p; + +// Opaque type definition for TROOT +typedef struct TROOT_tag TROOT_t; +typedef TROOT_t * TROOT_p; +typedef TROOT_t const* const_TROOT_p; + +// Opaque type definition for TSeqCollection +typedef struct TSeqCollection_tag TSeqCollection_t; +typedef TSeqCollection_t * TSeqCollection_p; +typedef TSeqCollection_t const* const_TSeqCollection_p; + +// Opaque type definition for TSystem +typedef struct TSystem_tag TSystem_t; +typedef TSystem_t * TSystem_p; +typedef TSystem_t const* const_TSystem_p; + +// Opaque type definition for TVirtualPad +typedef struct TVirtualPad_tag TVirtualPad_t; +typedef TVirtualPad_t * TVirtualPad_p; +typedef TVirtualPad_t const* const_TVirtualPad_p; + +#endif // __HROOT_CORE__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreDeletable.cpp b/csrc/HROOTCoreDeletable.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreDeletable.cpp @@ -0,0 +1,41 @@ +#include + + +#include "HROOTCoreDeletable.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + + + + + diff --git a/csrc/HROOTCoreDeletable.h b/csrc/HROOTCoreDeletable.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreDeletable.h @@ -0,0 +1,37 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__Deletable__ +#define __HROOT_CORE__Deletable__ + +#include "HROOT-coreType.h" + + + +#undef DELETABLE_DECL_VIRT +#define DELETABLE_DECL_VIRT(Type) \ +void Type ## _delete ( Type ## _p p ) + +#undef DELETABLE_DECL_NONVIRT +#define DELETABLE_DECL_NONVIRT(Type) \ + + +#undef DELETABLE_DEF_VIRT +#define DELETABLE_DEF_VIRT(Type)\ +void Type ## _delete ( Type ## _p p )\ +{\ +delete (to_nonconst(p)) ; \ +} + +#undef DELETABLE_DEF_NONVIRT +#define DELETABLE_DEF_NONVIRT(Type)\ + + + + +#endif // __HROOT_CORE__Deletable__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTApplication.cpp b/csrc/HROOTCoreTApplication.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTApplication.cpp @@ -0,0 +1,48 @@ +#include + +#include "HROOTCoreTObject.h" +#include "HROOTCoreTQObject.h" +#include "TApplication.h" +#include "HROOTCoreTApplication.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TOBJECT_DEF_VIRT(TApplication) +TQOBJECT_DEF_VIRT(TApplication) +DELETABLE_DEF_VIRT(TApplication) + +TAPPLICATION_DEF_VIRT(TApplication) + +TAPPLICATION_DEF_NONVIRT(TApplication) + + diff --git a/csrc/HROOTCoreTApplication.h b/csrc/HROOTCoreTApplication.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTApplication.h @@ -0,0 +1,52 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TApplication__ +#define __HROOT_CORE__TApplication__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTObject.h" +#include "HROOTCoreTQObject.h" +#include "HROOTCoreDeletable.h" + +#undef TAPPLICATION_DECL_VIRT +#define TAPPLICATION_DECL_VIRT(Type) \ +void Type ## _Run ( Type ## _p p, int retrn ) + +#undef TAPPLICATION_DECL_NONVIRT +#define TAPPLICATION_DECL_NONVIRT(Type) \ +Type ## _p Type ## _newTApplication ( const char* appClassName, int* argc, char** argv ) + +#undef TAPPLICATION_DEF_VIRT +#define TAPPLICATION_DEF_VIRT(Type)\ +void Type ## _Run ( Type ## _p p, int retrn )\ +{\ +TYPECASTMETHOD(Type,Run,TApplication)(p)->Run(retrn);\ +} + +#undef TAPPLICATION_DEF_NONVIRT +#define TAPPLICATION_DEF_NONVIRT(Type)\ +Type ## _p Type ## _newTApplication ( const char* appClassName, int* argc, char** argv )\ +{\ +Type * newp = new Type (appClassName, argc, argv); \ +return to_nonconst(newp);\ +} + +TOBJECT_DECL_VIRT(TApplication); +TQOBJECT_DECL_VIRT(TApplication); +DELETABLE_DECL_VIRT(TApplication); + + +TAPPLICATION_DECL_VIRT(TApplication); + + +TAPPLICATION_DECL_NONVIRT(TApplication); + + +#endif // __HROOT_CORE__TApplication__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTArray.cpp b/csrc/HROOTCoreTArray.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArray.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TArray.h" +#include "HROOTCoreTArray.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TArray) + +TARRAY_DEF_VIRT(TArray) + +TARRAY_DEF_NONVIRT(TArray) + + diff --git a/csrc/HROOTCoreTArray.h b/csrc/HROOTCoreTArray.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArray.h @@ -0,0 +1,41 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TArray__ +#define __HROOT_CORE__TArray__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TARRAY_DECL_VIRT +#define TARRAY_DECL_VIRT(Type) \ + + +#undef TARRAY_DECL_NONVIRT +#define TARRAY_DECL_NONVIRT(Type) \ + + +#undef TARRAY_DEF_VIRT +#define TARRAY_DEF_VIRT(Type)\ + + +#undef TARRAY_DEF_NONVIRT +#define TARRAY_DEF_NONVIRT(Type)\ + + +DELETABLE_DECL_VIRT(TArray); + + +TARRAY_DECL_VIRT(TArray); + + +TARRAY_DECL_NONVIRT(TArray); + + +#endif // __HROOT_CORE__TArray__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTArrayC.cpp b/csrc/HROOTCoreTArrayC.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayC.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTArray.h" +#include "TArrayC.h" +#include "HROOTCoreTArrayC.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TARRAY_DEF_VIRT(TArrayC) +DELETABLE_DEF_VIRT(TArrayC) + +TARRAYC_DEF_VIRT(TArrayC) + +TARRAYC_DEF_NONVIRT(TArrayC) + + diff --git a/csrc/HROOTCoreTArrayC.h b/csrc/HROOTCoreTArrayC.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayC.h @@ -0,0 +1,43 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TArrayC__ +#define __HROOT_CORE__TArrayC__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTArray.h" +#include "HROOTCoreDeletable.h" + +#undef TARRAYC_DECL_VIRT +#define TARRAYC_DECL_VIRT(Type) \ + + +#undef TARRAYC_DECL_NONVIRT +#define TARRAYC_DECL_NONVIRT(Type) \ + + +#undef TARRAYC_DEF_VIRT +#define TARRAYC_DEF_VIRT(Type)\ + + +#undef TARRAYC_DEF_NONVIRT +#define TARRAYC_DEF_NONVIRT(Type)\ + + +TARRAY_DECL_VIRT(TArrayC); +DELETABLE_DECL_VIRT(TArrayC); + + +TARRAYC_DECL_VIRT(TArrayC); + + +TARRAYC_DECL_NONVIRT(TArrayC); + + +#endif // __HROOT_CORE__TArrayC__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTArrayD.cpp b/csrc/HROOTCoreTArrayD.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayD.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTArray.h" +#include "TArrayD.h" +#include "HROOTCoreTArrayD.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TARRAY_DEF_VIRT(TArrayD) +DELETABLE_DEF_VIRT(TArrayD) + +TARRAYD_DEF_VIRT(TArrayD) + +TARRAYD_DEF_NONVIRT(TArrayD) + + diff --git a/csrc/HROOTCoreTArrayD.h b/csrc/HROOTCoreTArrayD.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayD.h @@ -0,0 +1,43 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TArrayD__ +#define __HROOT_CORE__TArrayD__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTArray.h" +#include "HROOTCoreDeletable.h" + +#undef TARRAYD_DECL_VIRT +#define TARRAYD_DECL_VIRT(Type) \ + + +#undef TARRAYD_DECL_NONVIRT +#define TARRAYD_DECL_NONVIRT(Type) \ + + +#undef TARRAYD_DEF_VIRT +#define TARRAYD_DEF_VIRT(Type)\ + + +#undef TARRAYD_DEF_NONVIRT +#define TARRAYD_DEF_NONVIRT(Type)\ + + +TARRAY_DECL_VIRT(TArrayD); +DELETABLE_DECL_VIRT(TArrayD); + + +TARRAYD_DECL_VIRT(TArrayD); + + +TARRAYD_DECL_NONVIRT(TArrayD); + + +#endif // __HROOT_CORE__TArrayD__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTArrayF.cpp b/csrc/HROOTCoreTArrayF.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayF.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTArray.h" +#include "TArrayF.h" +#include "HROOTCoreTArrayF.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TARRAY_DEF_VIRT(TArrayF) +DELETABLE_DEF_VIRT(TArrayF) + +TARRAYF_DEF_VIRT(TArrayF) + +TARRAYF_DEF_NONVIRT(TArrayF) + + diff --git a/csrc/HROOTCoreTArrayF.h b/csrc/HROOTCoreTArrayF.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayF.h @@ -0,0 +1,43 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TArrayF__ +#define __HROOT_CORE__TArrayF__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTArray.h" +#include "HROOTCoreDeletable.h" + +#undef TARRAYF_DECL_VIRT +#define TARRAYF_DECL_VIRT(Type) \ + + +#undef TARRAYF_DECL_NONVIRT +#define TARRAYF_DECL_NONVIRT(Type) \ + + +#undef TARRAYF_DEF_VIRT +#define TARRAYF_DEF_VIRT(Type)\ + + +#undef TARRAYF_DEF_NONVIRT +#define TARRAYF_DEF_NONVIRT(Type)\ + + +TARRAY_DECL_VIRT(TArrayF); +DELETABLE_DECL_VIRT(TArrayF); + + +TARRAYF_DECL_VIRT(TArrayF); + + +TARRAYF_DECL_NONVIRT(TArrayF); + + +#endif // __HROOT_CORE__TArrayF__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTArrayI.cpp b/csrc/HROOTCoreTArrayI.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayI.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTArray.h" +#include "TArrayI.h" +#include "HROOTCoreTArrayI.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TARRAY_DEF_VIRT(TArrayI) +DELETABLE_DEF_VIRT(TArrayI) + +TARRAYI_DEF_VIRT(TArrayI) + +TARRAYI_DEF_NONVIRT(TArrayI) + + diff --git a/csrc/HROOTCoreTArrayI.h b/csrc/HROOTCoreTArrayI.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayI.h @@ -0,0 +1,43 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TArrayI__ +#define __HROOT_CORE__TArrayI__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTArray.h" +#include "HROOTCoreDeletable.h" + +#undef TARRAYI_DECL_VIRT +#define TARRAYI_DECL_VIRT(Type) \ + + +#undef TARRAYI_DECL_NONVIRT +#define TARRAYI_DECL_NONVIRT(Type) \ + + +#undef TARRAYI_DEF_VIRT +#define TARRAYI_DEF_VIRT(Type)\ + + +#undef TARRAYI_DEF_NONVIRT +#define TARRAYI_DEF_NONVIRT(Type)\ + + +TARRAY_DECL_VIRT(TArrayI); +DELETABLE_DECL_VIRT(TArrayI); + + +TARRAYI_DECL_VIRT(TArrayI); + + +TARRAYI_DECL_NONVIRT(TArrayI); + + +#endif // __HROOT_CORE__TArrayI__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTArrayL.cpp b/csrc/HROOTCoreTArrayL.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayL.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTArray.h" +#include "TArrayL.h" +#include "HROOTCoreTArrayL.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TARRAY_DEF_VIRT(TArrayL) +DELETABLE_DEF_VIRT(TArrayL) + +TARRAYL_DEF_VIRT(TArrayL) + +TARRAYL_DEF_NONVIRT(TArrayL) + + diff --git a/csrc/HROOTCoreTArrayL.h b/csrc/HROOTCoreTArrayL.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayL.h @@ -0,0 +1,43 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TArrayL__ +#define __HROOT_CORE__TArrayL__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTArray.h" +#include "HROOTCoreDeletable.h" + +#undef TARRAYL_DECL_VIRT +#define TARRAYL_DECL_VIRT(Type) \ + + +#undef TARRAYL_DECL_NONVIRT +#define TARRAYL_DECL_NONVIRT(Type) \ + + +#undef TARRAYL_DEF_VIRT +#define TARRAYL_DEF_VIRT(Type)\ + + +#undef TARRAYL_DEF_NONVIRT +#define TARRAYL_DEF_NONVIRT(Type)\ + + +TARRAY_DECL_VIRT(TArrayL); +DELETABLE_DECL_VIRT(TArrayL); + + +TARRAYL_DECL_VIRT(TArrayL); + + +TARRAYL_DECL_NONVIRT(TArrayL); + + +#endif // __HROOT_CORE__TArrayL__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTArrayL64.cpp b/csrc/HROOTCoreTArrayL64.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayL64.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTArray.h" +#include "TArrayL64.h" +#include "HROOTCoreTArrayL64.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TARRAY_DEF_VIRT(TArrayL64) +DELETABLE_DEF_VIRT(TArrayL64) + +TARRAYL64_DEF_VIRT(TArrayL64) + +TARRAYL64_DEF_NONVIRT(TArrayL64) + + diff --git a/csrc/HROOTCoreTArrayL64.h b/csrc/HROOTCoreTArrayL64.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayL64.h @@ -0,0 +1,43 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TArrayL64__ +#define __HROOT_CORE__TArrayL64__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTArray.h" +#include "HROOTCoreDeletable.h" + +#undef TARRAYL64_DECL_VIRT +#define TARRAYL64_DECL_VIRT(Type) \ + + +#undef TARRAYL64_DECL_NONVIRT +#define TARRAYL64_DECL_NONVIRT(Type) \ + + +#undef TARRAYL64_DEF_VIRT +#define TARRAYL64_DEF_VIRT(Type)\ + + +#undef TARRAYL64_DEF_NONVIRT +#define TARRAYL64_DEF_NONVIRT(Type)\ + + +TARRAY_DECL_VIRT(TArrayL64); +DELETABLE_DECL_VIRT(TArrayL64); + + +TARRAYL64_DECL_VIRT(TArrayL64); + + +TARRAYL64_DECL_NONVIRT(TArrayL64); + + +#endif // __HROOT_CORE__TArrayL64__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTArrayS.cpp b/csrc/HROOTCoreTArrayS.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayS.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTArray.h" +#include "TArrayS.h" +#include "HROOTCoreTArrayS.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TARRAY_DEF_VIRT(TArrayS) +DELETABLE_DEF_VIRT(TArrayS) + +TARRAYS_DEF_VIRT(TArrayS) + +TARRAYS_DEF_NONVIRT(TArrayS) + + diff --git a/csrc/HROOTCoreTArrayS.h b/csrc/HROOTCoreTArrayS.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTArrayS.h @@ -0,0 +1,43 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TArrayS__ +#define __HROOT_CORE__TArrayS__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTArray.h" +#include "HROOTCoreDeletable.h" + +#undef TARRAYS_DECL_VIRT +#define TARRAYS_DECL_VIRT(Type) \ + + +#undef TARRAYS_DECL_NONVIRT +#define TARRAYS_DECL_NONVIRT(Type) \ + + +#undef TARRAYS_DEF_VIRT +#define TARRAYS_DEF_VIRT(Type)\ + + +#undef TARRAYS_DEF_NONVIRT +#define TARRAYS_DEF_NONVIRT(Type)\ + + +TARRAY_DECL_VIRT(TArrayS); +DELETABLE_DECL_VIRT(TArrayS); + + +TARRAYS_DECL_VIRT(TArrayS); + + +TARRAYS_DECL_NONVIRT(TArrayS); + + +#endif // __HROOT_CORE__TArrayS__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTAtt3D.cpp b/csrc/HROOTCoreTAtt3D.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAtt3D.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TAtt3D.h" +#include "HROOTCoreTAtt3D.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TAtt3D) + +TATT3D_DEF_VIRT(TAtt3D) + +TATT3D_DEF_NONVIRT(TAtt3D) + + diff --git a/csrc/HROOTCoreTAtt3D.h b/csrc/HROOTCoreTAtt3D.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAtt3D.h @@ -0,0 +1,41 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TAtt3D__ +#define __HROOT_CORE__TAtt3D__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TATT3D_DECL_VIRT +#define TATT3D_DECL_VIRT(Type) \ + + +#undef TATT3D_DECL_NONVIRT +#define TATT3D_DECL_NONVIRT(Type) \ + + +#undef TATT3D_DEF_VIRT +#define TATT3D_DEF_VIRT(Type)\ + + +#undef TATT3D_DEF_NONVIRT +#define TATT3D_DEF_NONVIRT(Type)\ + + +DELETABLE_DECL_VIRT(TAtt3D); + + +TATT3D_DECL_VIRT(TAtt3D); + + +TATT3D_DECL_NONVIRT(TAtt3D); + + +#endif // __HROOT_CORE__TAtt3D__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTAttAxis.cpp b/csrc/HROOTCoreTAttAxis.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttAxis.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TAttAxis.h" +#include "HROOTCoreTAttAxis.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TAttAxis) + +TATTAXIS_DEF_VIRT(TAttAxis) + +TATTAXIS_DEF_NONVIRT(TAttAxis) + + diff --git a/csrc/HROOTCoreTAttAxis.h b/csrc/HROOTCoreTAttAxis.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttAxis.h @@ -0,0 +1,148 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TAttAxis__ +#define __HROOT_CORE__TAttAxis__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TATTAXIS_DECL_VIRT +#define TATTAXIS_DECL_VIRT(Type) \ +int Type ## _GetNdivisions ( Type ## _p p ); \ +int Type ## _GetAxisColor ( Type ## _p p ); \ +int Type ## _GetLabelColor ( Type ## _p p ); \ +int Type ## _GetLabelFont ( Type ## _p p ); \ +double Type ## _GetLabelOffset ( Type ## _p p ); \ +double Type ## _GetLabelSize ( Type ## _p p ); \ +double Type ## _GetTitleOffset ( Type ## _p p ); \ +double Type ## _GetTitleSize ( Type ## _p p ); \ +double Type ## _GetTickLength ( Type ## _p p ); \ +int Type ## _GetTitleFont ( Type ## _p p ); \ +void Type ## _SetNdivisions ( Type ## _p p, int n, int optim ); \ +void Type ## _SetAxisColor ( Type ## _p p, int color ); \ +void Type ## _SetLabelColor ( Type ## _p p, int color ); \ +void Type ## _SetLabelFont ( Type ## _p p, int font ); \ +void Type ## _SetLabelOffset ( Type ## _p p, double offset ); \ +void Type ## _SetLabelSize ( Type ## _p p, double size ); \ +void Type ## _SetTickLength ( Type ## _p p, double length ); \ +void Type ## _SetTitleOffset ( Type ## _p p, double offset ); \ +void Type ## _SetTitleSize ( Type ## _p p, double size ); \ +void Type ## _SetTitleColor ( Type ## _p p, int color ); \ +void Type ## _SetTitleFont ( Type ## _p p, int font ) + +#undef TATTAXIS_DECL_NONVIRT +#define TATTAXIS_DECL_NONVIRT(Type) \ +Type ## _p Type ## _newTAttAxis ( ) + +#undef TATTAXIS_DEF_VIRT +#define TATTAXIS_DEF_VIRT(Type)\ +int Type ## _GetNdivisions ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetNdivisions,TAttAxis)(p)->GetNdivisions();\ +}\ +int Type ## _GetAxisColor ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetAxisColor,TAttAxis)(p)->GetAxisColor();\ +}\ +int Type ## _GetLabelColor ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetLabelColor,TAttAxis)(p)->GetLabelColor();\ +}\ +int Type ## _GetLabelFont ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetLabelFont,TAttAxis)(p)->GetLabelFont();\ +}\ +double Type ## _GetLabelOffset ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetLabelOffset,TAttAxis)(p)->GetLabelOffset();\ +}\ +double Type ## _GetLabelSize ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetLabelSize,TAttAxis)(p)->GetLabelSize();\ +}\ +double Type ## _GetTitleOffset ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetTitleOffset,TAttAxis)(p)->GetTitleOffset();\ +}\ +double Type ## _GetTitleSize ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetTitleSize,TAttAxis)(p)->GetTitleSize();\ +}\ +double Type ## _GetTickLength ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetTickLength,TAttAxis)(p)->GetTickLength();\ +}\ +int Type ## _GetTitleFont ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetTitleFont,TAttAxis)(p)->GetTitleFont();\ +}\ +void Type ## _SetNdivisions ( Type ## _p p, int n, int optim )\ +{\ +TYPECASTMETHOD(Type,SetNdivisions,TAttAxis)(p)->SetNdivisions(n, optim);\ +}\ +void Type ## _SetAxisColor ( Type ## _p p, int color )\ +{\ +TYPECASTMETHOD(Type,SetAxisColor,TAttAxis)(p)->SetAxisColor(color);\ +}\ +void Type ## _SetLabelColor ( Type ## _p p, int color )\ +{\ +TYPECASTMETHOD(Type,SetLabelColor,TAttAxis)(p)->SetLabelColor(color);\ +}\ +void Type ## _SetLabelFont ( Type ## _p p, int font )\ +{\ +TYPECASTMETHOD(Type,SetLabelFont,TAttAxis)(p)->SetLabelFont(font);\ +}\ +void Type ## _SetLabelOffset ( Type ## _p p, double offset )\ +{\ +TYPECASTMETHOD(Type,SetLabelOffset,TAttAxis)(p)->SetLabelOffset(offset);\ +}\ +void Type ## _SetLabelSize ( Type ## _p p, double size )\ +{\ +TYPECASTMETHOD(Type,SetLabelSize,TAttAxis)(p)->SetLabelSize(size);\ +}\ +void Type ## _SetTickLength ( Type ## _p p, double length )\ +{\ +TYPECASTMETHOD(Type,SetTickLength,TAttAxis)(p)->SetTickLength(length);\ +}\ +void Type ## _SetTitleOffset ( Type ## _p p, double offset )\ +{\ +TYPECASTMETHOD(Type,SetTitleOffset,TAttAxis)(p)->SetTitleOffset(offset);\ +}\ +void Type ## _SetTitleSize ( Type ## _p p, double size )\ +{\ +TYPECASTMETHOD(Type,SetTitleSize,TAttAxis)(p)->SetTitleSize(size);\ +}\ +void Type ## _SetTitleColor ( Type ## _p p, int color )\ +{\ +TYPECASTMETHOD(Type,SetTitleColor,TAttAxis)(p)->SetTitleColor(color);\ +}\ +void Type ## _SetTitleFont ( Type ## _p p, int font )\ +{\ +TYPECASTMETHOD(Type,SetTitleFont,TAttAxis)(p)->SetTitleFont(font);\ +} + +#undef TATTAXIS_DEF_NONVIRT +#define TATTAXIS_DEF_NONVIRT(Type)\ +Type ## _p Type ## _newTAttAxis ( )\ +{\ +Type * newp = new Type (); \ +return to_nonconst(newp);\ +} + +DELETABLE_DECL_VIRT(TAttAxis); + + +TATTAXIS_DECL_VIRT(TAttAxis); + + +TATTAXIS_DECL_NONVIRT(TAttAxis); + + +#endif // __HROOT_CORE__TAttAxis__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTAttBBox.cpp b/csrc/HROOTCoreTAttBBox.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttBBox.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TAttBBox.h" +#include "HROOTCoreTAttBBox.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TAttBBox) + +TATTBBOX_DEF_VIRT(TAttBBox) + +TATTBBOX_DEF_NONVIRT(TAttBBox) + + diff --git a/csrc/HROOTCoreTAttBBox.h b/csrc/HROOTCoreTAttBBox.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttBBox.h @@ -0,0 +1,41 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TAttBBox__ +#define __HROOT_CORE__TAttBBox__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TATTBBOX_DECL_VIRT +#define TATTBBOX_DECL_VIRT(Type) \ + + +#undef TATTBBOX_DECL_NONVIRT +#define TATTBBOX_DECL_NONVIRT(Type) \ + + +#undef TATTBBOX_DEF_VIRT +#define TATTBBOX_DEF_VIRT(Type)\ + + +#undef TATTBBOX_DEF_NONVIRT +#define TATTBBOX_DEF_NONVIRT(Type)\ + + +DELETABLE_DECL_VIRT(TAttBBox); + + +TATTBBOX_DECL_VIRT(TAttBBox); + + +TATTBBOX_DECL_NONVIRT(TAttBBox); + + +#endif // __HROOT_CORE__TAttBBox__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTAttCanvas.cpp b/csrc/HROOTCoreTAttCanvas.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttCanvas.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TAttCanvas.h" +#include "HROOTCoreTAttCanvas.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TAttCanvas) + +TATTCANVAS_DEF_VIRT(TAttCanvas) + +TATTCANVAS_DEF_NONVIRT(TAttCanvas) + + diff --git a/csrc/HROOTCoreTAttCanvas.h b/csrc/HROOTCoreTAttCanvas.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttCanvas.h @@ -0,0 +1,45 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TAttCanvas__ +#define __HROOT_CORE__TAttCanvas__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TATTCANVAS_DECL_VIRT +#define TATTCANVAS_DECL_VIRT(Type) \ + + +#undef TATTCANVAS_DECL_NONVIRT +#define TATTCANVAS_DECL_NONVIRT(Type) \ +Type ## _p Type ## _newTAttCanvas ( ) + +#undef TATTCANVAS_DEF_VIRT +#define TATTCANVAS_DEF_VIRT(Type)\ + + +#undef TATTCANVAS_DEF_NONVIRT +#define TATTCANVAS_DEF_NONVIRT(Type)\ +Type ## _p Type ## _newTAttCanvas ( )\ +{\ +Type * newp = new Type (); \ +return to_nonconst(newp);\ +} + +DELETABLE_DECL_VIRT(TAttCanvas); + + +TATTCANVAS_DECL_VIRT(TAttCanvas); + + +TATTCANVAS_DECL_NONVIRT(TAttCanvas); + + +#endif // __HROOT_CORE__TAttCanvas__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTAttFill.cpp b/csrc/HROOTCoreTAttFill.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttFill.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TAttFill.h" +#include "HROOTCoreTAttFill.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TAttFill) + +TATTFILL_DEF_VIRT(TAttFill) + +TATTFILL_DEF_NONVIRT(TAttFill) + + diff --git a/csrc/HROOTCoreTAttFill.h b/csrc/HROOTCoreTAttFill.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttFill.h @@ -0,0 +1,53 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TAttFill__ +#define __HROOT_CORE__TAttFill__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TATTFILL_DECL_VIRT +#define TATTFILL_DECL_VIRT(Type) \ +void Type ## _SetFillColor ( Type ## _p p, int color ); \ +void Type ## _SetFillStyle ( Type ## _p p, int style ) + +#undef TATTFILL_DECL_NONVIRT +#define TATTFILL_DECL_NONVIRT(Type) \ +Type ## _p Type ## _newTAttFill ( int fcolor, int fstyle ) + +#undef TATTFILL_DEF_VIRT +#define TATTFILL_DEF_VIRT(Type)\ +void Type ## _SetFillColor ( Type ## _p p, int color )\ +{\ +TYPECASTMETHOD(Type,SetFillColor,TAttFill)(p)->SetFillColor(color);\ +}\ +void Type ## _SetFillStyle ( Type ## _p p, int style )\ +{\ +TYPECASTMETHOD(Type,SetFillStyle,TAttFill)(p)->SetFillStyle(style);\ +} + +#undef TATTFILL_DEF_NONVIRT +#define TATTFILL_DEF_NONVIRT(Type)\ +Type ## _p Type ## _newTAttFill ( int fcolor, int fstyle )\ +{\ +Type * newp = new Type (fcolor, fstyle); \ +return to_nonconst(newp);\ +} + +DELETABLE_DECL_VIRT(TAttFill); + + +TATTFILL_DECL_VIRT(TAttFill); + + +TATTFILL_DECL_NONVIRT(TAttFill); + + +#endif // __HROOT_CORE__TAttFill__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTAttLine.cpp b/csrc/HROOTCoreTAttLine.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttLine.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TAttLine.h" +#include "HROOTCoreTAttLine.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TAttLine) + +TATTLINE_DEF_VIRT(TAttLine) + +TATTLINE_DEF_NONVIRT(TAttLine) + + diff --git a/csrc/HROOTCoreTAttLine.h b/csrc/HROOTCoreTAttLine.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttLine.h @@ -0,0 +1,88 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TAttLine__ +#define __HROOT_CORE__TAttLine__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TATTLINE_DECL_VIRT +#define TATTLINE_DECL_VIRT(Type) \ +int Type ## _GetLineColor ( Type ## _p p ); \ +int Type ## _GetLineStyle ( Type ## _p p ); \ +int Type ## _GetLineWidth ( Type ## _p p ); \ +void Type ## _ResetAttLine ( Type ## _p p, const char* option ); \ +void Type ## _SetLineAttributes ( Type ## _p p ); \ +void Type ## _SetLineColor ( Type ## _p p, int lcolor ); \ +void Type ## _SetLineStyle ( Type ## _p p, int lstyle ); \ +void Type ## _SetLineWidth ( Type ## _p p, int lwidth ) + +#undef TATTLINE_DECL_NONVIRT +#define TATTLINE_DECL_NONVIRT(Type) \ +Type ## _p Type ## _newTAttLine ( int lcolor, int lstyle, int lwidth ); \ +int Type ## _tAttLineDistancetoLine ( Type ## _p p, int px, int py, double xp1, double yp1, double xp2, double yp2 ) + +#undef TATTLINE_DEF_VIRT +#define TATTLINE_DEF_VIRT(Type)\ +int Type ## _GetLineColor ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetLineColor,TAttLine)(p)->GetLineColor();\ +}\ +int Type ## _GetLineStyle ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetLineStyle,TAttLine)(p)->GetLineStyle();\ +}\ +int Type ## _GetLineWidth ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetLineWidth,TAttLine)(p)->GetLineWidth();\ +}\ +void Type ## _ResetAttLine ( Type ## _p p, const char* option )\ +{\ +TYPECASTMETHOD(Type,ResetAttLine,TAttLine)(p)->ResetAttLine(option);\ +}\ +void Type ## _SetLineAttributes ( Type ## _p p )\ +{\ +TYPECASTMETHOD(Type,SetLineAttributes,TAttLine)(p)->SetLineAttributes();\ +}\ +void Type ## _SetLineColor ( Type ## _p p, int lcolor )\ +{\ +TYPECASTMETHOD(Type,SetLineColor,TAttLine)(p)->SetLineColor(lcolor);\ +}\ +void Type ## _SetLineStyle ( Type ## _p p, int lstyle )\ +{\ +TYPECASTMETHOD(Type,SetLineStyle,TAttLine)(p)->SetLineStyle(lstyle);\ +}\ +void Type ## _SetLineWidth ( Type ## _p p, int lwidth )\ +{\ +TYPECASTMETHOD(Type,SetLineWidth,TAttLine)(p)->SetLineWidth(lwidth);\ +} + +#undef TATTLINE_DEF_NONVIRT +#define TATTLINE_DEF_NONVIRT(Type)\ +Type ## _p Type ## _newTAttLine ( int lcolor, int lstyle, int lwidth )\ +{\ +Type * newp = new Type (lcolor, lstyle, lwidth); \ +return to_nonconst(newp);\ +}\ +int Type ## _tAttLineDistancetoLine ( Type ## _p p, int px, int py, double xp1, double yp1, double xp2, double yp2 )\ +{\ +return TYPECASTMETHOD(Type,tAttLineDistancetoLine,TAttLine)(p)->DistancetoLine(px, py, xp1, yp1, xp2, yp2);\ +} + +DELETABLE_DECL_VIRT(TAttLine); + + +TATTLINE_DECL_VIRT(TAttLine); + + +TATTLINE_DECL_NONVIRT(TAttLine); + + +#endif // __HROOT_CORE__TAttLine__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTAttMarker.cpp b/csrc/HROOTCoreTAttMarker.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttMarker.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TAttMarker.h" +#include "HROOTCoreTAttMarker.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TAttMarker) + +TATTMARKER_DEF_VIRT(TAttMarker) + +TATTMARKER_DEF_NONVIRT(TAttMarker) + + diff --git a/csrc/HROOTCoreTAttMarker.h b/csrc/HROOTCoreTAttMarker.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttMarker.h @@ -0,0 +1,83 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TAttMarker__ +#define __HROOT_CORE__TAttMarker__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TATTMARKER_DECL_VIRT +#define TATTMARKER_DECL_VIRT(Type) \ +int Type ## _GetMarkerColor ( Type ## _p p ); \ +int Type ## _GetMarkerStyle ( Type ## _p p ); \ +double Type ## _GetMarkerSize ( Type ## _p p ); \ +void Type ## _ResetAttMarker ( Type ## _p p, const char* option ); \ +void Type ## _SetMarkerAttributes ( Type ## _p p ); \ +void Type ## _SetMarkerColor ( Type ## _p p, int tcolor ); \ +void Type ## _SetMarkerStyle ( Type ## _p p, int mstyle ); \ +void Type ## _SetMarkerSize ( Type ## _p p, int msize ) + +#undef TATTMARKER_DECL_NONVIRT +#define TATTMARKER_DECL_NONVIRT(Type) \ +Type ## _p Type ## _newTAttMarker ( int color, int style, int msize ) + +#undef TATTMARKER_DEF_VIRT +#define TATTMARKER_DEF_VIRT(Type)\ +int Type ## _GetMarkerColor ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetMarkerColor,TAttMarker)(p)->GetMarkerColor();\ +}\ +int Type ## _GetMarkerStyle ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetMarkerStyle,TAttMarker)(p)->GetMarkerStyle();\ +}\ +double Type ## _GetMarkerSize ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetMarkerSize,TAttMarker)(p)->GetMarkerSize();\ +}\ +void Type ## _ResetAttMarker ( Type ## _p p, const char* option )\ +{\ +TYPECASTMETHOD(Type,ResetAttMarker,TAttMarker)(p)->ResetAttMarker(option);\ +}\ +void Type ## _SetMarkerAttributes ( Type ## _p p )\ +{\ +TYPECASTMETHOD(Type,SetMarkerAttributes,TAttMarker)(p)->SetMarkerAttributes();\ +}\ +void Type ## _SetMarkerColor ( Type ## _p p, int tcolor )\ +{\ +TYPECASTMETHOD(Type,SetMarkerColor,TAttMarker)(p)->SetMarkerColor(tcolor);\ +}\ +void Type ## _SetMarkerStyle ( Type ## _p p, int mstyle )\ +{\ +TYPECASTMETHOD(Type,SetMarkerStyle,TAttMarker)(p)->SetMarkerStyle(mstyle);\ +}\ +void Type ## _SetMarkerSize ( Type ## _p p, int msize )\ +{\ +TYPECASTMETHOD(Type,SetMarkerSize,TAttMarker)(p)->SetMarkerSize(msize);\ +} + +#undef TATTMARKER_DEF_NONVIRT +#define TATTMARKER_DEF_NONVIRT(Type)\ +Type ## _p Type ## _newTAttMarker ( int color, int style, int msize )\ +{\ +Type * newp = new Type (color, style, msize); \ +return to_nonconst(newp);\ +} + +DELETABLE_DECL_VIRT(TAttMarker); + + +TATTMARKER_DECL_VIRT(TAttMarker); + + +TATTMARKER_DECL_NONVIRT(TAttMarker); + + +#endif // __HROOT_CORE__TAttMarker__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTAttPad.cpp b/csrc/HROOTCoreTAttPad.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttPad.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TAttPad.h" +#include "HROOTCoreTAttPad.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TAttPad) + +TATTPAD_DEF_VIRT(TAttPad) + +TATTPAD_DEF_NONVIRT(TAttPad) + + diff --git a/csrc/HROOTCoreTAttPad.h b/csrc/HROOTCoreTAttPad.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttPad.h @@ -0,0 +1,223 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TAttPad__ +#define __HROOT_CORE__TAttPad__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TATTPAD_DECL_VIRT +#define TATTPAD_DECL_VIRT(Type) \ +void Type ## _ResetAttPad ( Type ## _p p, const char* option ); \ +void Type ## _SetBottomMargin ( Type ## _p p, double bottommargin ); \ +void Type ## _SetLeftMargin ( Type ## _p p, double leftmargin ); \ +void Type ## _SetRightMargin ( Type ## _p p, double rightmargin ); \ +void Type ## _SetTopMargin ( Type ## _p p, double topmargin ); \ +void Type ## _SetMargin ( Type ## _p p, double left, double right, double bottom, double top ); \ +void Type ## _SetAfile ( Type ## _p p, double afile ); \ +void Type ## _SetXfile ( Type ## _p p, double xfile ); \ +void Type ## _SetYfile ( Type ## _p p, double yfile ); \ +void Type ## _SetAstat ( Type ## _p p, double astat ); \ +void Type ## _SetXstat ( Type ## _p p, double xstat ); \ +void Type ## _SetYstat ( Type ## _p p, double ystat ) + +#undef TATTPAD_DECL_NONVIRT +#define TATTPAD_DECL_NONVIRT(Type) \ +Type ## _p Type ## _newTAttPad ( ); \ +double Type ## _tAttPadGetBottomMargin ( Type ## _p p ); \ +double Type ## _tAttPadGetLeftMargin ( Type ## _p p ); \ +double Type ## _tAttPadGetRightMargin ( Type ## _p p ); \ +double Type ## _tAttPadGetTopMargin ( Type ## _p p ); \ +double Type ## _tAttPadGetAfile ( Type ## _p p ); \ +double Type ## _tAttPadGetXfile ( Type ## _p p ); \ +double Type ## _tAttPadGetYfile ( Type ## _p p ); \ +double Type ## _tAttPadGetAstat ( Type ## _p p ); \ +double Type ## _tAttPadGetXstat ( Type ## _p p ); \ +double Type ## _tAttPadGetYstat ( Type ## _p p ); \ +int Type ## _tAttPadGetFrameFillColor ( Type ## _p p ); \ +int Type ## _tAttPadGetFrameLineColor ( Type ## _p p ); \ +int Type ## _tAttPadGetFrameFillStyle ( Type ## _p p ); \ +int Type ## _tAttPadGetFrameLineStyle ( Type ## _p p ); \ +int Type ## _tAttPadGetFrameLineWidth ( Type ## _p p ); \ +int Type ## _tAttPadGetFrameBorderSize ( Type ## _p p ); \ +int Type ## _tAttPadGetFrameBorderMode ( Type ## _p p ); \ +void Type ## _tAttPadSetFrameFillColor ( Type ## _p p, int color ); \ +void Type ## _tAttPadSetFrameLineColor ( Type ## _p p, int color ); \ +void Type ## _tAttPadSetFrameFillStyle ( Type ## _p p, int styl ); \ +void Type ## _tAttPadSetFrameLineStyle ( Type ## _p p, int styl ); \ +void Type ## _tAttPadSetFrameLineWidth ( Type ## _p p, int width ); \ +void Type ## _tAttPadSetFrameBorderSize ( Type ## _p p, int size ); \ +void Type ## _tAttPadSetFrameBorderMode ( Type ## _p p, int mode ) + +#undef TATTPAD_DEF_VIRT +#define TATTPAD_DEF_VIRT(Type)\ +void Type ## _ResetAttPad ( Type ## _p p, const char* option )\ +{\ +TYPECASTMETHOD(Type,ResetAttPad,TAttPad)(p)->ResetAttPad(option);\ +}\ +void Type ## _SetBottomMargin ( Type ## _p p, double bottommargin )\ +{\ +TYPECASTMETHOD(Type,SetBottomMargin,TAttPad)(p)->SetBottomMargin(bottommargin);\ +}\ +void Type ## _SetLeftMargin ( Type ## _p p, double leftmargin )\ +{\ +TYPECASTMETHOD(Type,SetLeftMargin,TAttPad)(p)->SetLeftMargin(leftmargin);\ +}\ +void Type ## _SetRightMargin ( Type ## _p p, double rightmargin )\ +{\ +TYPECASTMETHOD(Type,SetRightMargin,TAttPad)(p)->SetRightMargin(rightmargin);\ +}\ +void Type ## _SetTopMargin ( Type ## _p p, double topmargin )\ +{\ +TYPECASTMETHOD(Type,SetTopMargin,TAttPad)(p)->SetTopMargin(topmargin);\ +}\ +void Type ## _SetMargin ( Type ## _p p, double left, double right, double bottom, double top )\ +{\ +TYPECASTMETHOD(Type,SetMargin,TAttPad)(p)->SetMargin(left, right, bottom, top);\ +}\ +void Type ## _SetAfile ( Type ## _p p, double afile )\ +{\ +TYPECASTMETHOD(Type,SetAfile,TAttPad)(p)->SetAfile(afile);\ +}\ +void Type ## _SetXfile ( Type ## _p p, double xfile )\ +{\ +TYPECASTMETHOD(Type,SetXfile,TAttPad)(p)->SetXfile(xfile);\ +}\ +void Type ## _SetYfile ( Type ## _p p, double yfile )\ +{\ +TYPECASTMETHOD(Type,SetYfile,TAttPad)(p)->SetYfile(yfile);\ +}\ +void Type ## _SetAstat ( Type ## _p p, double astat )\ +{\ +TYPECASTMETHOD(Type,SetAstat,TAttPad)(p)->SetAstat(astat);\ +}\ +void Type ## _SetXstat ( Type ## _p p, double xstat )\ +{\ +TYPECASTMETHOD(Type,SetXstat,TAttPad)(p)->SetXstat(xstat);\ +}\ +void Type ## _SetYstat ( Type ## _p p, double ystat )\ +{\ +TYPECASTMETHOD(Type,SetYstat,TAttPad)(p)->SetYstat(ystat);\ +} + +#undef TATTPAD_DEF_NONVIRT +#define TATTPAD_DEF_NONVIRT(Type)\ +Type ## _p Type ## _newTAttPad ( )\ +{\ +Type * newp = new Type (); \ +return to_nonconst(newp);\ +}\ +double Type ## _tAttPadGetBottomMargin ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetBottomMargin,TAttPad)(p)->GetBottomMargin();\ +}\ +double Type ## _tAttPadGetLeftMargin ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetLeftMargin,TAttPad)(p)->GetLeftMargin();\ +}\ +double Type ## _tAttPadGetRightMargin ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetRightMargin,TAttPad)(p)->GetRightMargin();\ +}\ +double Type ## _tAttPadGetTopMargin ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetTopMargin,TAttPad)(p)->GetTopMargin();\ +}\ +double Type ## _tAttPadGetAfile ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetAfile,TAttPad)(p)->GetAfile();\ +}\ +double Type ## _tAttPadGetXfile ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetXfile,TAttPad)(p)->GetXfile();\ +}\ +double Type ## _tAttPadGetYfile ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetYfile,TAttPad)(p)->GetYfile();\ +}\ +double Type ## _tAttPadGetAstat ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetAstat,TAttPad)(p)->GetAstat();\ +}\ +double Type ## _tAttPadGetXstat ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetXstat,TAttPad)(p)->GetXstat();\ +}\ +double Type ## _tAttPadGetYstat ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetYstat,TAttPad)(p)->GetYstat();\ +}\ +int Type ## _tAttPadGetFrameFillColor ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetFrameFillColor,TAttPad)(p)->GetFrameFillColor();\ +}\ +int Type ## _tAttPadGetFrameLineColor ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetFrameLineColor,TAttPad)(p)->GetFrameLineColor();\ +}\ +int Type ## _tAttPadGetFrameFillStyle ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetFrameFillStyle,TAttPad)(p)->GetFrameFillStyle();\ +}\ +int Type ## _tAttPadGetFrameLineStyle ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetFrameLineStyle,TAttPad)(p)->GetFrameLineStyle();\ +}\ +int Type ## _tAttPadGetFrameLineWidth ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetFrameLineWidth,TAttPad)(p)->GetFrameLineWidth();\ +}\ +int Type ## _tAttPadGetFrameBorderSize ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetFrameBorderSize,TAttPad)(p)->GetFrameBorderSize();\ +}\ +int Type ## _tAttPadGetFrameBorderMode ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,tAttPadGetFrameBorderMode,TAttPad)(p)->GetFrameBorderMode();\ +}\ +void Type ## _tAttPadSetFrameFillColor ( Type ## _p p, int color )\ +{\ +TYPECASTMETHOD(Type,tAttPadSetFrameFillColor,TAttPad)(p)->SetFrameFillColor(color);\ +}\ +void Type ## _tAttPadSetFrameLineColor ( Type ## _p p, int color )\ +{\ +TYPECASTMETHOD(Type,tAttPadSetFrameLineColor,TAttPad)(p)->SetFrameLineColor(color);\ +}\ +void Type ## _tAttPadSetFrameFillStyle ( Type ## _p p, int styl )\ +{\ +TYPECASTMETHOD(Type,tAttPadSetFrameFillStyle,TAttPad)(p)->SetFrameFillStyle(styl);\ +}\ +void Type ## _tAttPadSetFrameLineStyle ( Type ## _p p, int styl )\ +{\ +TYPECASTMETHOD(Type,tAttPadSetFrameLineStyle,TAttPad)(p)->SetFrameLineStyle(styl);\ +}\ +void Type ## _tAttPadSetFrameLineWidth ( Type ## _p p, int width )\ +{\ +TYPECASTMETHOD(Type,tAttPadSetFrameLineWidth,TAttPad)(p)->SetFrameLineWidth(width);\ +}\ +void Type ## _tAttPadSetFrameBorderSize ( Type ## _p p, int size )\ +{\ +TYPECASTMETHOD(Type,tAttPadSetFrameBorderSize,TAttPad)(p)->SetFrameBorderSize(size);\ +}\ +void Type ## _tAttPadSetFrameBorderMode ( Type ## _p p, int mode )\ +{\ +TYPECASTMETHOD(Type,tAttPadSetFrameBorderMode,TAttPad)(p)->SetFrameBorderMode(mode);\ +} + +DELETABLE_DECL_VIRT(TAttPad); + + +TATTPAD_DECL_VIRT(TAttPad); + + +TATTPAD_DECL_NONVIRT(TAttPad); + + +#endif // __HROOT_CORE__TAttPad__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTAttText.cpp b/csrc/HROOTCoreTAttText.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttText.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TAttText.h" +#include "HROOTCoreTAttText.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TAttText) + +TATTTEXT_DEF_VIRT(TAttText) + +TATTTEXT_DEF_NONVIRT(TAttText) + + diff --git a/csrc/HROOTCoreTAttText.h b/csrc/HROOTCoreTAttText.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTAttText.h @@ -0,0 +1,108 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TAttText__ +#define __HROOT_CORE__TAttText__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TATTTEXT_DECL_VIRT +#define TATTTEXT_DECL_VIRT(Type) \ +int Type ## _GetTextAlign ( Type ## _p p ); \ +double Type ## _GetTextAngle ( Type ## _p p ); \ +int Type ## _GetTextColor ( Type ## _p p ); \ +int Type ## _GetTextFont ( Type ## _p p ); \ +double Type ## _GetTextSize ( Type ## _p p ); \ +void Type ## _ResetAttText ( Type ## _p p, const char* toption ); \ +void Type ## _SetTextAttributes ( Type ## _p p ); \ +void Type ## _SetTextAlign ( Type ## _p p, int align ); \ +void Type ## _SetTextAngle ( Type ## _p p, double tangle ); \ +void Type ## _SetTextColor ( Type ## _p p, int tcolor ); \ +void Type ## _SetTextFont ( Type ## _p p, int tfont ); \ +void Type ## _SetTextSize ( Type ## _p p, double tsize ); \ +void Type ## _SetTextSizePixels ( Type ## _p p, int npixels ) + +#undef TATTTEXT_DECL_NONVIRT +#define TATTTEXT_DECL_NONVIRT(Type) \ +Type ## _p Type ## _newTAttText ( int align, double angle, int color, int font, double tsize ) + +#undef TATTTEXT_DEF_VIRT +#define TATTTEXT_DEF_VIRT(Type)\ +int Type ## _GetTextAlign ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetTextAlign,TAttText)(p)->GetTextAlign();\ +}\ +double Type ## _GetTextAngle ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetTextAngle,TAttText)(p)->GetTextAngle();\ +}\ +int Type ## _GetTextColor ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetTextColor,TAttText)(p)->GetTextColor();\ +}\ +int Type ## _GetTextFont ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetTextFont,TAttText)(p)->GetTextFont();\ +}\ +double Type ## _GetTextSize ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetTextSize,TAttText)(p)->GetTextSize();\ +}\ +void Type ## _ResetAttText ( Type ## _p p, const char* toption )\ +{\ +TYPECASTMETHOD(Type,ResetAttText,TAttText)(p)->ResetAttText(toption);\ +}\ +void Type ## _SetTextAttributes ( Type ## _p p )\ +{\ +TYPECASTMETHOD(Type,SetTextAttributes,TAttText)(p)->SetTextAttributes();\ +}\ +void Type ## _SetTextAlign ( Type ## _p p, int align )\ +{\ +TYPECASTMETHOD(Type,SetTextAlign,TAttText)(p)->SetTextAlign(align);\ +}\ +void Type ## _SetTextAngle ( Type ## _p p, double tangle )\ +{\ +TYPECASTMETHOD(Type,SetTextAngle,TAttText)(p)->SetTextAngle(tangle);\ +}\ +void Type ## _SetTextColor ( Type ## _p p, int tcolor )\ +{\ +TYPECASTMETHOD(Type,SetTextColor,TAttText)(p)->SetTextColor(tcolor);\ +}\ +void Type ## _SetTextFont ( Type ## _p p, int tfont )\ +{\ +TYPECASTMETHOD(Type,SetTextFont,TAttText)(p)->SetTextFont(tfont);\ +}\ +void Type ## _SetTextSize ( Type ## _p p, double tsize )\ +{\ +TYPECASTMETHOD(Type,SetTextSize,TAttText)(p)->SetTextSize(tsize);\ +}\ +void Type ## _SetTextSizePixels ( Type ## _p p, int npixels )\ +{\ +TYPECASTMETHOD(Type,SetTextSizePixels,TAttText)(p)->SetTextSizePixels(npixels);\ +} + +#undef TATTTEXT_DEF_NONVIRT +#define TATTTEXT_DEF_NONVIRT(Type)\ +Type ## _p Type ## _newTAttText ( int align, double angle, int color, int font, double tsize )\ +{\ +Type * newp = new Type (align, angle, color, font, tsize); \ +return to_nonconst(newp);\ +} + +DELETABLE_DECL_VIRT(TAttText); + + +TATTTEXT_DECL_VIRT(TAttText); + + +TATTTEXT_DECL_NONVIRT(TAttText); + + +#endif // __HROOT_CORE__TAttText__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTClass.cpp b/csrc/HROOTCoreTClass.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTClass.cpp @@ -0,0 +1,48 @@ +#include + +#include "HROOTCoreTDictionary.h" +#include "TClass.h" +#include "HROOTCoreTClass.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TDICTIONARY_DEF_VIRT(TClass) +TNAMED_DEF_VIRT(TClass) +TOBJECT_DEF_VIRT(TClass) +DELETABLE_DEF_VIRT(TClass) + +TCLASS_DEF_VIRT(TClass) + +TCLASS_DEF_NONVIRT(TClass) + + diff --git a/csrc/HROOTCoreTClass.h b/csrc/HROOTCoreTClass.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTClass.h @@ -0,0 +1,47 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TClass__ +#define __HROOT_CORE__TClass__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTDictionary.h" +#include "HROOTCoreTNamed.h" +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TCLASS_DECL_VIRT +#define TCLASS_DECL_VIRT(Type) \ + + +#undef TCLASS_DECL_NONVIRT +#define TCLASS_DECL_NONVIRT(Type) \ + + +#undef TCLASS_DEF_VIRT +#define TCLASS_DEF_VIRT(Type)\ + + +#undef TCLASS_DEF_NONVIRT +#define TCLASS_DEF_NONVIRT(Type)\ + + +TDICTIONARY_DECL_VIRT(TClass); +TNAMED_DECL_VIRT(TClass); +TOBJECT_DECL_VIRT(TClass); +DELETABLE_DECL_VIRT(TClass); + + +TCLASS_DECL_VIRT(TClass); + + +TCLASS_DECL_NONVIRT(TClass); + + +#endif // __HROOT_CORE__TClass__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTCollection.cpp b/csrc/HROOTCoreTCollection.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTCollection.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTObject.h" +#include "TCollection.h" +#include "HROOTCoreTCollection.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TOBJECT_DEF_VIRT(TCollection) +DELETABLE_DEF_VIRT(TCollection) + +TCOLLECTION_DEF_VIRT(TCollection) + +TCOLLECTION_DEF_NONVIRT(TCollection) + + diff --git a/csrc/HROOTCoreTCollection.h b/csrc/HROOTCoreTCollection.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTCollection.h @@ -0,0 +1,43 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TCollection__ +#define __HROOT_CORE__TCollection__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TCOLLECTION_DECL_VIRT +#define TCOLLECTION_DECL_VIRT(Type) \ + + +#undef TCOLLECTION_DECL_NONVIRT +#define TCOLLECTION_DECL_NONVIRT(Type) \ + + +#undef TCOLLECTION_DEF_VIRT +#define TCOLLECTION_DEF_VIRT(Type)\ + + +#undef TCOLLECTION_DEF_NONVIRT +#define TCOLLECTION_DEF_NONVIRT(Type)\ + + +TOBJECT_DECL_VIRT(TCollection); +DELETABLE_DECL_VIRT(TCollection); + + +TCOLLECTION_DECL_VIRT(TCollection); + + +TCOLLECTION_DECL_NONVIRT(TCollection); + + +#endif // __HROOT_CORE__TCollection__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTDictionary.cpp b/csrc/HROOTCoreTDictionary.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTDictionary.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreTNamed.h" +#include "TDictionary.h" +#include "HROOTCoreTDictionary.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TNAMED_DEF_VIRT(TDictionary) +TOBJECT_DEF_VIRT(TDictionary) +DELETABLE_DEF_VIRT(TDictionary) + + + + diff --git a/csrc/HROOTCoreTDictionary.h b/csrc/HROOTCoreTDictionary.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTDictionary.h @@ -0,0 +1,45 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TDictionary__ +#define __HROOT_CORE__TDictionary__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTNamed.h" +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TDICTIONARY_DECL_VIRT +#define TDICTIONARY_DECL_VIRT(Type) \ + + +#undef TDICTIONARY_DECL_NONVIRT +#define TDICTIONARY_DECL_NONVIRT(Type) \ + + +#undef TDICTIONARY_DEF_VIRT +#define TDICTIONARY_DEF_VIRT(Type)\ + + +#undef TDICTIONARY_DEF_NONVIRT +#define TDICTIONARY_DEF_NONVIRT(Type)\ + + +TNAMED_DECL_VIRT(TDictionary); +TOBJECT_DECL_VIRT(TDictionary); +DELETABLE_DECL_VIRT(TDictionary); + + +TDICTIONARY_DECL_VIRT(TDictionary); + + +TDICTIONARY_DECL_NONVIRT(TDictionary); + + +#endif // __HROOT_CORE__TDictionary__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTDirectory.cpp b/csrc/HROOTCoreTDirectory.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTDirectory.cpp @@ -0,0 +1,49 @@ +#include + +#include "HROOTCoreTObject.h" +#include "HROOTCoreTKey.h" +#include "HROOTCoreTNamed.h" +#include "TDirectory.h" +#include "HROOTCoreTDirectory.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TNAMED_DEF_VIRT(TDirectory) +TOBJECT_DEF_VIRT(TDirectory) +DELETABLE_DEF_VIRT(TDirectory) + +TDIRECTORY_DEF_VIRT(TDirectory) + +TDIRECTORY_DEF_NONVIRT(TDirectory) + + diff --git a/csrc/HROOTCoreTDirectory.h b/csrc/HROOTCoreTDirectory.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTDirectory.h @@ -0,0 +1,81 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TDirectory__ +#define __HROOT_CORE__TDirectory__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTNamed.h" +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TDIRECTORY_DECL_VIRT +#define TDIRECTORY_DECL_VIRT(Type) \ +void Type ## _Append ( Type ## _p p, TObject_p obj, int replace ); \ +void Type ## _addD ( Type ## _p p, TObject_p obj, int replace ); \ +int Type ## _AppendKey ( Type ## _p p, TKey_p key ); \ +void Type ## _Close ( Type ## _p p, const char* option ); \ +TObject_p Type ## _Get ( Type ## _p p, const char* namecycle ); \ +int Type ## _cd_TDirectory ( Type ## _p p, const char* path ) + +#undef TDIRECTORY_DECL_NONVIRT +#define TDIRECTORY_DECL_NONVIRT(Type) \ +void Type ## _tDirectoryAddDirectory ( int add ); \ +int Type ## _tDirectoryAddDirectoryStatus ( ) + +#undef TDIRECTORY_DEF_VIRT +#define TDIRECTORY_DEF_VIRT(Type)\ +void Type ## _Append ( Type ## _p p, TObject_p obj, int replace )\ +{\ +TYPECASTMETHOD(Type,Append,TDirectory)(p)->Append(to_nonconst(obj), replace);\ +}\ +void Type ## _addD ( Type ## _p p, TObject_p obj, int replace )\ +{\ +TYPECASTMETHOD(Type,addD,TDirectory)(p)->Add(to_nonconst(obj), replace);\ +}\ +int Type ## _AppendKey ( Type ## _p p, TKey_p key )\ +{\ +return TYPECASTMETHOD(Type,AppendKey,TDirectory)(p)->AppendKey(to_nonconst(key));\ +}\ +void Type ## _Close ( Type ## _p p, const char* option )\ +{\ +TYPECASTMETHOD(Type,Close,TDirectory)(p)->Close(option);\ +}\ +TObject_p Type ## _Get ( Type ## _p p, const char* namecycle )\ +{\ +return to_nonconst((TObject*)TYPECASTMETHOD(Type,Get,TDirectory)(p)->Get(namecycle));\ +}\ +int Type ## _cd_TDirectory ( Type ## _p p, const char* path )\ +{\ +return TYPECASTMETHOD(Type,cd_TDirectory,TDirectory)(p)->cd(path);\ +} + +#undef TDIRECTORY_DEF_NONVIRT +#define TDIRECTORY_DEF_NONVIRT(Type)\ +void Type ## _tDirectoryAddDirectory ( int add )\ +{\ +TDirectory::AddDirectory(add);\ +}\ +int Type ## _tDirectoryAddDirectoryStatus ( )\ +{\ +return TDirectory::AddDirectoryStatus();\ +} + +TNAMED_DECL_VIRT(TDirectory); +TOBJECT_DECL_VIRT(TDirectory); +DELETABLE_DECL_VIRT(TDirectory); + + +TDIRECTORY_DECL_VIRT(TDirectory); + + +TDIRECTORY_DECL_NONVIRT(TDirectory); + + +#endif // __HROOT_CORE__TDirectory__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTGlobal.cpp b/csrc/HROOTCoreTGlobal.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTGlobal.cpp @@ -0,0 +1,48 @@ +#include + +#include "HROOTCoreTDictionary.h" +#include "TGlobal.h" +#include "HROOTCoreTGlobal.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TDICTIONARY_DEF_VIRT(TGlobal) +TNAMED_DEF_VIRT(TGlobal) +TOBJECT_DEF_VIRT(TGlobal) +DELETABLE_DEF_VIRT(TGlobal) + +TGLOBAL_DEF_VIRT(TGlobal) + +TGLOBAL_DEF_NONVIRT(TGlobal) + + diff --git a/csrc/HROOTCoreTGlobal.h b/csrc/HROOTCoreTGlobal.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTGlobal.h @@ -0,0 +1,47 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TGlobal__ +#define __HROOT_CORE__TGlobal__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTDictionary.h" +#include "HROOTCoreTNamed.h" +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TGLOBAL_DECL_VIRT +#define TGLOBAL_DECL_VIRT(Type) \ + + +#undef TGLOBAL_DECL_NONVIRT +#define TGLOBAL_DECL_NONVIRT(Type) \ + + +#undef TGLOBAL_DEF_VIRT +#define TGLOBAL_DEF_VIRT(Type)\ + + +#undef TGLOBAL_DEF_NONVIRT +#define TGLOBAL_DEF_NONVIRT(Type)\ + + +TDICTIONARY_DECL_VIRT(TGlobal); +TNAMED_DECL_VIRT(TGlobal); +TOBJECT_DECL_VIRT(TGlobal); +DELETABLE_DECL_VIRT(TGlobal); + + +TGLOBAL_DECL_VIRT(TGlobal); + + +TGLOBAL_DECL_NONVIRT(TGlobal); + + +#endif // __HROOT_CORE__TGlobal__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTKey.cpp b/csrc/HROOTCoreTKey.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTKey.cpp @@ -0,0 +1,47 @@ +#include + +#include "HROOTCoreTNamed.h" +#include "TKey.h" +#include "HROOTCoreTKey.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TNAMED_DEF_VIRT(TKey) +TOBJECT_DEF_VIRT(TKey) +DELETABLE_DEF_VIRT(TKey) + +TKEY_DEF_VIRT(TKey) + +TKEY_DEF_NONVIRT(TKey) + + diff --git a/csrc/HROOTCoreTKey.h b/csrc/HROOTCoreTKey.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTKey.h @@ -0,0 +1,45 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TKey__ +#define __HROOT_CORE__TKey__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTNamed.h" +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TKEY_DECL_VIRT +#define TKEY_DECL_VIRT(Type) \ + + +#undef TKEY_DECL_NONVIRT +#define TKEY_DECL_NONVIRT(Type) \ + + +#undef TKEY_DEF_VIRT +#define TKEY_DEF_VIRT(Type)\ + + +#undef TKEY_DEF_NONVIRT +#define TKEY_DEF_NONVIRT(Type)\ + + +TNAMED_DECL_VIRT(TKey); +TOBJECT_DECL_VIRT(TKey); +DELETABLE_DECL_VIRT(TKey); + + +TKEY_DECL_VIRT(TKey); + + +TKEY_DECL_NONVIRT(TKey); + + +#endif // __HROOT_CORE__TKey__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTNamed.cpp b/csrc/HROOTCoreTNamed.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTNamed.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTObject.h" +#include "TNamed.h" +#include "HROOTCoreTNamed.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TOBJECT_DEF_VIRT(TNamed) +DELETABLE_DEF_VIRT(TNamed) + +TNAMED_DEF_VIRT(TNamed) + +TNAMED_DEF_NONVIRT(TNamed) + + diff --git a/csrc/HROOTCoreTNamed.h b/csrc/HROOTCoreTNamed.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTNamed.h @@ -0,0 +1,60 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TNamed__ +#define __HROOT_CORE__TNamed__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TNAMED_DECL_VIRT +#define TNAMED_DECL_VIRT(Type) \ +void Type ## _SetName ( Type ## _p p, const char* name ); \ +void Type ## _SetNameTitle ( Type ## _p p, const char* name, const char* title ); \ +void Type ## _SetTitle ( Type ## _p p, const char* name ) + +#undef TNAMED_DECL_NONVIRT +#define TNAMED_DECL_NONVIRT(Type) \ +Type ## _p Type ## _newTNamed ( const char* name, const char* title ) + +#undef TNAMED_DEF_VIRT +#define TNAMED_DEF_VIRT(Type)\ +void Type ## _SetName ( Type ## _p p, const char* name )\ +{\ +TYPECASTMETHOD(Type,SetName,TNamed)(p)->SetName(name);\ +}\ +void Type ## _SetNameTitle ( Type ## _p p, const char* name, const char* title )\ +{\ +TYPECASTMETHOD(Type,SetNameTitle,TNamed)(p)->SetNameTitle(name, title);\ +}\ +void Type ## _SetTitle ( Type ## _p p, const char* name )\ +{\ +TYPECASTMETHOD(Type,SetTitle,TNamed)(p)->SetTitle(name);\ +} + +#undef TNAMED_DEF_NONVIRT +#define TNAMED_DEF_NONVIRT(Type)\ +Type ## _p Type ## _newTNamed ( const char* name, const char* title )\ +{\ +Type * newp = new Type (name, title); \ +return to_nonconst(newp);\ +} + +TOBJECT_DECL_VIRT(TNamed); +DELETABLE_DECL_VIRT(TNamed); + + +TNAMED_DECL_VIRT(TNamed); + + +TNAMED_DECL_NONVIRT(TNamed); + + +#endif // __HROOT_CORE__TNamed__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTObjArray.cpp b/csrc/HROOTCoreTObjArray.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTObjArray.cpp @@ -0,0 +1,48 @@ +#include + +#include "HROOTCoreTSeqCollection.h" +#include "TObjArray.h" +#include "HROOTCoreTObjArray.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TSEQCOLLECTION_DEF_VIRT(TObjArray) +TCOLLECTION_DEF_VIRT(TObjArray) +TOBJECT_DEF_VIRT(TObjArray) +DELETABLE_DEF_VIRT(TObjArray) + +TOBJARRAY_DEF_VIRT(TObjArray) + +TOBJARRAY_DEF_NONVIRT(TObjArray) + + diff --git a/csrc/HROOTCoreTObjArray.h b/csrc/HROOTCoreTObjArray.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTObjArray.h @@ -0,0 +1,47 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TObjArray__ +#define __HROOT_CORE__TObjArray__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTSeqCollection.h" +#include "HROOTCoreTCollection.h" +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TOBJARRAY_DECL_VIRT +#define TOBJARRAY_DECL_VIRT(Type) \ + + +#undef TOBJARRAY_DECL_NONVIRT +#define TOBJARRAY_DECL_NONVIRT(Type) \ + + +#undef TOBJARRAY_DEF_VIRT +#define TOBJARRAY_DEF_VIRT(Type)\ + + +#undef TOBJARRAY_DEF_NONVIRT +#define TOBJARRAY_DEF_NONVIRT(Type)\ + + +TSEQCOLLECTION_DECL_VIRT(TObjArray); +TCOLLECTION_DECL_VIRT(TObjArray); +TOBJECT_DECL_VIRT(TObjArray); +DELETABLE_DECL_VIRT(TObjArray); + + +TOBJARRAY_DECL_VIRT(TObjArray); + + +TOBJARRAY_DECL_NONVIRT(TObjArray); + + +#endif // __HROOT_CORE__TObjArray__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTObject.cpp b/csrc/HROOTCoreTObject.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTObject.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTClass.h" +#include "HROOTCoreDeletable.h" +#include "TObject.h" +#include "HROOTCoreTObject.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TObject) + +TOBJECT_DEF_VIRT(TObject) + +TOBJECT_DEF_NONVIRT(TObject) + + diff --git a/csrc/HROOTCoreTObject.h b/csrc/HROOTCoreTObject.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTObject.h @@ -0,0 +1,88 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TObject__ +#define __HROOT_CORE__TObject__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TOBJECT_DECL_VIRT +#define TOBJECT_DECL_VIRT(Type) \ +void Type ## _Draw ( Type ## _p p, const char* option ); \ +TObject_p Type ## _FindObject ( Type ## _p p, const char* name ); \ +const char* Type ## _GetName ( Type ## _p p ); \ +TClass_p Type ## _IsA ( Type ## _p p ); \ +void Type ## _Paint ( Type ## _p p, const char* option ); \ +void Type ## _printObj ( Type ## _p p, const char* option ); \ +void Type ## _SaveAs ( Type ## _p p, const char* filename, const char* option ); \ +int Type ## _Write ( Type ## _p p, const char* name, int option, int bufsize ) + +#undef TOBJECT_DECL_NONVIRT +#define TOBJECT_DECL_NONVIRT(Type) \ +Type ## _p Type ## _newTObject ( ); \ +int Type ## _tObjectGetObjectStat ( ) + +#undef TOBJECT_DEF_VIRT +#define TOBJECT_DEF_VIRT(Type)\ +void Type ## _Draw ( Type ## _p p, const char* option )\ +{\ +TYPECASTMETHOD(Type,Draw,TObject)(p)->Draw(option);\ +}\ +TObject_p Type ## _FindObject ( Type ## _p p, const char* name )\ +{\ +return to_nonconst((TObject*)TYPECASTMETHOD(Type,FindObject,TObject)(p)->FindObject(name));\ +}\ +const char* Type ## _GetName ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,GetName,TObject)(p)->GetName();\ +}\ +TClass_p Type ## _IsA ( Type ## _p p )\ +{\ +return to_nonconst((TClass*)TYPECASTMETHOD(Type,IsA,TObject)(p)->IsA());\ +}\ +void Type ## _Paint ( Type ## _p p, const char* option )\ +{\ +TYPECASTMETHOD(Type,Paint,TObject)(p)->Paint(option);\ +}\ +void Type ## _printObj ( Type ## _p p, const char* option )\ +{\ +TYPECASTMETHOD(Type,printObj,TObject)(p)->Print(option);\ +}\ +void Type ## _SaveAs ( Type ## _p p, const char* filename, const char* option )\ +{\ +TYPECASTMETHOD(Type,SaveAs,TObject)(p)->SaveAs(filename, option);\ +}\ +int Type ## _Write ( Type ## _p p, const char* name, int option, int bufsize )\ +{\ +return TYPECASTMETHOD(Type,Write,TObject)(p)->Write(name, option, bufsize);\ +} + +#undef TOBJECT_DEF_NONVIRT +#define TOBJECT_DEF_NONVIRT(Type)\ +Type ## _p Type ## _newTObject ( )\ +{\ +Type * newp = new Type (); \ +return to_nonconst(newp);\ +}\ +int Type ## _tObjectGetObjectStat ( )\ +{\ +return TObject::GetObjectStat();\ +} + +DELETABLE_DECL_VIRT(TObject); + + +TOBJECT_DECL_VIRT(TObject); + + +TOBJECT_DECL_NONVIRT(TObject); + + +#endif // __HROOT_CORE__TObject__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTQObject.cpp b/csrc/HROOTCoreTQObject.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTQObject.cpp @@ -0,0 +1,45 @@ +#include + +#include "HROOTCoreDeletable.h" +#include "TQObject.h" +#include "HROOTCoreTQObject.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +DELETABLE_DEF_VIRT(TQObject) + +TQOBJECT_DEF_VIRT(TQObject) + +TQOBJECT_DEF_NONVIRT(TQObject) + + diff --git a/csrc/HROOTCoreTQObject.h b/csrc/HROOTCoreTQObject.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTQObject.h @@ -0,0 +1,41 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TQObject__ +#define __HROOT_CORE__TQObject__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreDeletable.h" + +#undef TQOBJECT_DECL_VIRT +#define TQOBJECT_DECL_VIRT(Type) \ + + +#undef TQOBJECT_DECL_NONVIRT +#define TQOBJECT_DECL_NONVIRT(Type) \ + + +#undef TQOBJECT_DEF_VIRT +#define TQOBJECT_DEF_VIRT(Type)\ + + +#undef TQOBJECT_DEF_NONVIRT +#define TQOBJECT_DEF_NONVIRT(Type)\ + + +DELETABLE_DECL_VIRT(TQObject); + + +TQOBJECT_DECL_VIRT(TQObject); + + +TQOBJECT_DECL_NONVIRT(TQObject); + + +#endif // __HROOT_CORE__TQObject__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTROOT.cpp b/csrc/HROOTCoreTROOT.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTROOT.cpp @@ -0,0 +1,50 @@ +#include + +#include "HROOTCoreTGlobal.h" +#include "HROOTCoreTDirectory.h" +#include "TROOT.h" +#include "HROOTCoreTROOT.h" + +using namespace std; +using namespace ROOT; + + +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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TDIRECTORY_DEF_VIRT(TROOT) +TNAMED_DEF_VIRT(TROOT) +TOBJECT_DEF_VIRT(TROOT) +DELETABLE_DEF_VIRT(TROOT) + +TROOT_DEF_VIRT(TROOT) + +TROOT_DEF_NONVIRT(TROOT) + + diff --git a/csrc/HROOTCoreTROOT.h b/csrc/HROOTCoreTROOT.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTROOT.h @@ -0,0 +1,55 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TROOT__ +#define __HROOT_CORE__TROOT__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTDirectory.h" +#include "HROOTCoreTNamed.h" +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TROOT_DECL_VIRT +#define TROOT_DECL_VIRT(Type) \ + + +#undef TROOT_DECL_NONVIRT +#define TROOT_DECL_NONVIRT(Type) \ +TGlobal_p Type ## _tROOTGetGlobal ( Type ## _p p, const char* name, int load ); \ +int Type ## _tROOTInitialized ( ) + +#undef TROOT_DEF_VIRT +#define TROOT_DEF_VIRT(Type)\ + + +#undef TROOT_DEF_NONVIRT +#define TROOT_DEF_NONVIRT(Type)\ +TGlobal_p Type ## _tROOTGetGlobal ( Type ## _p p, const char* name, int load )\ +{\ +return to_nonconst((TGlobal*)TYPECASTMETHOD(Type,tROOTGetGlobal,TROOT)(p)->GetGlobal(name, load));\ +}\ +int Type ## _tROOTInitialized ( )\ +{\ +return TROOT::Initialized();\ +} + +TDIRECTORY_DECL_VIRT(TROOT); +TNAMED_DECL_VIRT(TROOT); +TOBJECT_DECL_VIRT(TROOT); +DELETABLE_DECL_VIRT(TROOT); + + +TROOT_DECL_VIRT(TROOT); + + +TROOT_DECL_NONVIRT(TROOT); + + +#endif // __HROOT_CORE__TROOT__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTSeqCollection.cpp b/csrc/HROOTCoreTSeqCollection.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTSeqCollection.cpp @@ -0,0 +1,47 @@ +#include + +#include "HROOTCoreTCollection.h" +#include "TSeqCollection.h" +#include "HROOTCoreTSeqCollection.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TCOLLECTION_DEF_VIRT(TSeqCollection) +TOBJECT_DEF_VIRT(TSeqCollection) +DELETABLE_DEF_VIRT(TSeqCollection) + +TSEQCOLLECTION_DEF_VIRT(TSeqCollection) + +TSEQCOLLECTION_DEF_NONVIRT(TSeqCollection) + + diff --git a/csrc/HROOTCoreTSeqCollection.h b/csrc/HROOTCoreTSeqCollection.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTSeqCollection.h @@ -0,0 +1,45 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TSeqCollection__ +#define __HROOT_CORE__TSeqCollection__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTCollection.h" +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TSEQCOLLECTION_DECL_VIRT +#define TSEQCOLLECTION_DECL_VIRT(Type) \ + + +#undef TSEQCOLLECTION_DECL_NONVIRT +#define TSEQCOLLECTION_DECL_NONVIRT(Type) \ + + +#undef TSEQCOLLECTION_DEF_VIRT +#define TSEQCOLLECTION_DEF_VIRT(Type)\ + + +#undef TSEQCOLLECTION_DEF_NONVIRT +#define TSEQCOLLECTION_DEF_NONVIRT(Type)\ + + +TCOLLECTION_DECL_VIRT(TSeqCollection); +TOBJECT_DECL_VIRT(TSeqCollection); +DELETABLE_DECL_VIRT(TSeqCollection); + + +TSEQCOLLECTION_DECL_VIRT(TSeqCollection); + + +TSEQCOLLECTION_DECL_NONVIRT(TSeqCollection); + + +#endif // __HROOT_CORE__TSeqCollection__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTSystem.cpp b/csrc/HROOTCoreTSystem.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTSystem.cpp @@ -0,0 +1,47 @@ +#include + +#include "HROOTCoreTNamed.h" +#include "TSystem.h" +#include "HROOTCoreTSystem.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TNAMED_DEF_VIRT(TSystem) +TOBJECT_DEF_VIRT(TSystem) +DELETABLE_DEF_VIRT(TSystem) + +TSYSTEM_DEF_VIRT(TSystem) + +TSYSTEM_DEF_NONVIRT(TSystem) + + diff --git a/csrc/HROOTCoreTSystem.h b/csrc/HROOTCoreTSystem.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTSystem.h @@ -0,0 +1,48 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TSystem__ +#define __HROOT_CORE__TSystem__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTNamed.h" +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TSYSTEM_DECL_VIRT +#define TSYSTEM_DECL_VIRT(Type) \ +int Type ## _ProcessEvents ( Type ## _p p ) + +#undef TSYSTEM_DECL_NONVIRT +#define TSYSTEM_DECL_NONVIRT(Type) \ + + +#undef TSYSTEM_DEF_VIRT +#define TSYSTEM_DEF_VIRT(Type)\ +int Type ## _ProcessEvents ( Type ## _p p )\ +{\ +return TYPECASTMETHOD(Type,ProcessEvents,TSystem)(p)->ProcessEvents();\ +} + +#undef TSYSTEM_DEF_NONVIRT +#define TSYSTEM_DEF_NONVIRT(Type)\ + + +TNAMED_DECL_VIRT(TSystem); +TOBJECT_DECL_VIRT(TSystem); +DELETABLE_DECL_VIRT(TSystem); + + +TSYSTEM_DECL_VIRT(TSystem); + + +TSYSTEM_DECL_NONVIRT(TSystem); + + +#endif // __HROOT_CORE__TSystem__ + +#ifdef __cplusplus +} +#endif diff --git a/csrc/HROOTCoreTVirtualPad.cpp b/csrc/HROOTCoreTVirtualPad.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTVirtualPad.cpp @@ -0,0 +1,46 @@ +#include + +#include "HROOTCoreTObject.h" +#include "TVirtualPad.h" +#include "HROOTCoreTVirtualPad.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) \ + IIF( CHECKPROTECT(cname,mname) ) ( \ + (to_nonconst), \ + (to_nonconst) ) + + +TOBJECT_DEF_VIRT(TVirtualPad) +DELETABLE_DEF_VIRT(TVirtualPad) + +TVIRTUALPAD_DEF_VIRT(TVirtualPad) + +TVIRTUALPAD_DEF_NONVIRT(TVirtualPad) + + diff --git a/csrc/HROOTCoreTVirtualPad.h b/csrc/HROOTCoreTVirtualPad.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTCoreTVirtualPad.h @@ -0,0 +1,66 @@ +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef __HROOT_CORE__TVirtualPad__ +#define __HROOT_CORE__TVirtualPad__ + +#include "HROOT-coreType.h" + +#include "HROOTCoreTObject.h" +#include "HROOTCoreDeletable.h" + +#undef TVIRTUALPAD_DECL_VIRT +#define TVIRTUALPAD_DECL_VIRT(Type) \ +Type ## _p Type ## _cd ( Type ## _p p, int subpadnumber ); \ +void Type ## _divide_tvirtualpad ( Type ## _p p, int nx, int ny, double xmargin, double ymargin, int color ); \ +void Type ## _SetLogx ( Type ## _p p, int value ); \ +void Type ## _SetLogy ( Type ## _p p, int value ); \ +void Type ## _SetLogz ( Type ## _p p, int value ) + +#undef TVIRTUALPAD_DECL_NONVIRT +#define TVIRTUALPAD_DECL_NONVIRT(Type) \ + + +#undef TVIRTUALPAD_DEF_VIRT +#define TVIRTUALPAD_DEF_VIRT(Type)\ +Type ## _p Type ## _cd ( Type ## _p p, int subpadnumber )\ +{\ +return to_nonconst((Type *)TYPECASTMETHOD(Type,cd,TVirtualPad)(p)->cd(subpadnumber)) ;\ +}\ +void Type ## _divide_tvirtualpad ( Type ## _p p, int nx, int ny, double xmargin, double ymargin, int color )\ +{\ +TYPECASTMETHOD(Type,divide_tvirtualpad,TVirtualPad)(p)->Divide(nx, ny, xmargin, ymargin, color);\ +}\ +void Type ## _SetLogx ( Type ## _p p, int value )\ +{\ +TYPECASTMETHOD(Type,SetLogx,TVirtualPad)(p)->SetLogx(value);\ +}\ +void Type ## _SetLogy ( Type ## _p p, int value )\ +{\ +TYPECASTMETHOD(Type,SetLogy,TVirtualPad)(p)->SetLogy(value);\ +}\ +void Type ## _SetLogz ( Type ## _p p, int value )\ +{\ +TYPECASTMETHOD(Type,SetLogz,TVirtualPad)(p)->SetLogz(value);\ +} + +#undef TVIRTUALPAD_DEF_NONVIRT +#define TVIRTUALPAD_DEF_NONVIRT(Type)\ + + +TOBJECT_DECL_VIRT(TVirtualPad); +DELETABLE_DECL_VIRT(TVirtualPad); + + +TVIRTUALPAD_DECL_VIRT(TVirtualPad); + + +TVIRTUALPAD_DECL_NONVIRT(TVirtualPad); + + +#endif // __HROOT_CORE__TVirtualPad__ + +#ifdef __cplusplus +} +#endif diff --git a/src/HROOT/Core.hs b/src/HROOT/Core.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core.hs @@ -0,0 +1,96 @@ +module HROOT.Core ( +module HROOT.Core.Deletable +, module HROOT.Core.TApplication +, module HROOT.Core.TArray +, module HROOT.Core.TArrayC +, module HROOT.Core.TArrayD +, module HROOT.Core.TArrayF +, module HROOT.Core.TArrayI +, module HROOT.Core.TArrayL +, module HROOT.Core.TArrayL64 +, module HROOT.Core.TArrayS +, module HROOT.Core.TAtt3D +, module HROOT.Core.TAttAxis +, module HROOT.Core.TAttBBox +, module HROOT.Core.TAttCanvas +, module HROOT.Core.TAttFill +, module HROOT.Core.TAttLine +, module HROOT.Core.TAttMarker +, module HROOT.Core.TAttPad +, module HROOT.Core.TAttText +, module HROOT.Core.TClass +, module HROOT.Core.TCollection +, module HROOT.Core.TDictionary +, module HROOT.Core.TDirectory +, module HROOT.Core.TGlobal +, module HROOT.Core.TKey +, module HROOT.Core.TNamed +, module HROOT.Core.TObjArray +, module HROOT.Core.TObject +, module HROOT.Core.TQObject +, module HROOT.Core.TROOT +, module HROOT.Core.TSeqCollection +, module HROOT.Core.TSystem +, module HROOT.Core.TVirtualPad +, getROOT +, gROOT +, gSystem +) where + +import HROOT.Core.Deletable +import HROOT.Core.TApplication +import HROOT.Core.TArray +import HROOT.Core.TArrayC +import HROOT.Core.TArrayD +import HROOT.Core.TArrayF +import HROOT.Core.TArrayI +import HROOT.Core.TArrayL +import HROOT.Core.TArrayL64 +import HROOT.Core.TArrayS +import HROOT.Core.TAtt3D +import HROOT.Core.TAttAxis +import HROOT.Core.TAttBBox +import HROOT.Core.TAttCanvas +import HROOT.Core.TAttFill +import HROOT.Core.TAttLine +import HROOT.Core.TAttMarker +import HROOT.Core.TAttPad +import HROOT.Core.TAttText +import HROOT.Core.TClass +import HROOT.Core.TCollection +import HROOT.Core.TDictionary +import HROOT.Core.TDirectory +import HROOT.Core.TGlobal +import HROOT.Core.TKey +import HROOT.Core.TNamed +import HROOT.Core.TObjArray +import HROOT.Core.TObject +import HROOT.Core.TQObject +import HROOT.Core.TROOT +import HROOT.Core.TSeqCollection +import HROOT.Core.TSystem +import HROOT.Core.TVirtualPad + +import Foreign.C +import Foreign.Ptr +import FFICXX.Runtime.Cast +import HROOT.Core.TROOT.RawType +import HROOT.Core.TSystem.RawType + +foreign import ccall "HROOT-coreTopLevel.h TopLevel_GetROOT" c_getroot + :: IO (Ptr RawTROOT) + +foreign import ccall "HROOT-coreTopLevel.h TopLevel_gROOT" c_groot + :: IO (Ptr RawTROOT) + +foreign import ccall "HROOT-coreTopLevel.h TopLevel_gSystem" c_gsystem + :: IO (Ptr RawTSystem) + +getROOT :: IO TROOT +getROOT = xformnull c_getroot + +gROOT :: IO TROOT +gROOT = xformnull c_groot + +gSystem :: IO TSystem +gSystem = xformnull c_gsystem diff --git a/src/HROOT/Core/Deletable.hs b/src/HROOT/Core/Deletable.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/Deletable.hs @@ -0,0 +1,10 @@ +module HROOT.Core.Deletable + ( + IDeletable(..) + ) where + +import HROOT.Core.Deletable.RawType +import HROOT.Core.Deletable.Interface +import HROOT.Core.Deletable.Implementation + + diff --git a/src/HROOT/Core/Deletable/Cast.hs b/src/HROOT/Core/Deletable/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/Deletable/Cast.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.Deletable.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.Deletable.RawType +import HROOT.Core.Deletable.Interface + + + + diff --git a/src/HROOT/Core/Deletable/FFI.hsc b/src/HROOT/Core/Deletable/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/Deletable/FFI.hsc @@ -0,0 +1,21 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.Deletable.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.Deletable.RawType + + +#include "HROOTCoreDeletable.h" + + + diff --git a/src/HROOT/Core/Deletable/Implementation.hs b/src/HROOT/Core/Deletable/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/Deletable/Implementation.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.Deletable.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.Deletable.RawType +import HROOT.Core.Deletable.FFI +import HROOT.Core.Deletable.Interface +import HROOT.Core.Deletable.Cast + + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr + +import System.IO.Unsafe + + + + + + + + + + + + + diff --git a/src/HROOT/Core/Deletable/Interface.hs b/src/HROOT/Core/Deletable/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/Deletable/Interface.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.Deletable.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.Deletable.RawType + + +---- ============ ---- + + + +class IDeletable a where + + delete :: a -> IO () + + + + + + diff --git a/src/HROOT/Core/Deletable/RawType.hs b/src/HROOT/Core/Deletable/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/Deletable/RawType.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.Deletable.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + + diff --git a/src/HROOT/Core/TApplication.hs b/src/HROOT/Core/TApplication.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TApplication.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TApplication + ( + TApplication(..) + , ITApplication(..) + , upcastTApplication + , downcastTApplication + , newTApplication + + ) where + +import HROOT.Core.TApplication.RawType +import HROOT.Core.TApplication.Interface +import HROOT.Core.TApplication.Implementation + + diff --git a/src/HROOT/Core/TApplication/Cast.hs b/src/HROOT/Core/TApplication/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TApplication/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TApplication.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TApplication.RawType +import HROOT.Core.TApplication.Interface + +instance (ITApplication a, FPtr a) => Castable a (Ptr RawTApplication) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TApplication (Ptr RawTApplication) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TApplication/FFI.hsc b/src/HROOT/Core/TApplication/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TApplication/FFI.hsc @@ -0,0 +1,53 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TApplication.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TApplication.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTApplication.h" + +foreign import ccall "HROOTCoreTApplication.h TApplication_Draw" c_tapplication_draw + :: (Ptr RawTApplication) -> CString -> IO () + +foreign import ccall "HROOTCoreTApplication.h TApplication_FindObject" c_tapplication_findobject + :: (Ptr RawTApplication) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTApplication.h TApplication_GetName" c_tapplication_getname + :: (Ptr RawTApplication) -> IO CString + +foreign import ccall "HROOTCoreTApplication.h TApplication_IsA" c_tapplication_isa + :: (Ptr RawTApplication) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTApplication.h TApplication_Paint" c_tapplication_paint + :: (Ptr RawTApplication) -> CString -> IO () + +foreign import ccall "HROOTCoreTApplication.h TApplication_printObj" c_tapplication_printobj + :: (Ptr RawTApplication) -> CString -> IO () + +foreign import ccall "HROOTCoreTApplication.h TApplication_SaveAs" c_tapplication_saveas + :: (Ptr RawTApplication) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTApplication.h TApplication_Write" c_tapplication_write + :: (Ptr RawTApplication) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTApplication.h TApplication_delete" c_tapplication_delete + :: (Ptr RawTApplication) -> IO () + +foreign import ccall "HROOTCoreTApplication.h TApplication_newTApplication" c_tapplication_newtapplication + :: CString -> (Ptr CInt) -> (Ptr (CString)) -> IO (Ptr RawTApplication) + +foreign import ccall "HROOTCoreTApplication.h TApplication_Run" c_tapplication_run + :: (Ptr RawTApplication) -> CInt -> IO () + diff --git a/src/HROOT/Core/TApplication/Implementation.hs b/src/HROOT/Core/TApplication/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TApplication/Implementation.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TApplication.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TApplication.RawType +import HROOT.Core.TApplication.FFI +import HROOT.Core.TApplication.Interface +import HROOT.Core.TApplication.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +import HROOT.Core.TQObject.RawType +import HROOT.Core.TQObject.Cast +import HROOT.Core.TQObject.Interface +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 ITApplication TApplication where + run = xform1 c_tapplication_run +instance ITObject TApplication where + draw = xform1 c_tapplication_draw + findObject = xform1 c_tapplication_findobject + getName = xform0 c_tapplication_getname + isA = xform0 c_tapplication_isa + paint = xform1 c_tapplication_paint + printObj = xform1 c_tapplication_printobj + saveAs = xform2 c_tapplication_saveas + write = xform3 c_tapplication_write +instance ITQObject TApplication where +instance IDeletable TApplication where + delete = xform0 c_tapplication_delete + +instance ITApplication (Exist TApplication) where + run (ETApplication x) = run x +instance ITObject (Exist TApplication) where + draw (ETApplication x) = draw x + findObject (ETApplication x) = findObject x + getName (ETApplication x) = getName x + isA (ETApplication x) = isA x + paint (ETApplication x) = paint x + printObj (ETApplication x) = printObj x + saveAs (ETApplication x) = saveAs x + write (ETApplication x) = write x +instance ITQObject (Exist TApplication) where + +instance IDeletable (Exist TApplication) where + delete (ETApplication x) = delete x + + +newTApplication :: CString -> (Ptr CInt) -> (Ptr CString) -> IO TApplication +newTApplication = xform2 c_tapplication_newtapplication + + + + + +instance FPtr (Exist TApplication) where + type Raw (Exist TApplication) = RawTApplication + get_fptr (ETApplication obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETApplication (cast_fptr_to_obj (fptr :: ForeignPtr RawTApplication) :: TApplication) diff --git a/src/HROOT/Core/TApplication/Interface.hs b/src/HROOT/Core/TApplication/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TApplication/Interface.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TApplication.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TApplication.RawType + +import HROOT.Core.TObject.Interface +import HROOT.Core.TQObject.Interface +---- ============ ---- + + + +class (ITObject a,ITQObject a) => ITApplication a where + + run :: a -> CInt -> IO () + +instance Existable TApplication where + data Exist TApplication = forall a. (FPtr a, ITApplication a) => ETApplication a + +upcastTApplication :: (FPtr a, ITApplication a) => a -> TApplication +upcastTApplication h = let fh = get_fptr h + fh2 :: ForeignPtr RawTApplication = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTApplication :: (FPtr a, ITApplication a) => TApplication -> a +downcastTApplication h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TApplication/RawType.hs b/src/HROOT/Core/TApplication/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TApplication/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TApplication.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTApplication +newtype TApplication = TApplication (ForeignPtr RawTApplication) deriving (Eq, Ord, Show) +instance FPtr TApplication where + type Raw TApplication = RawTApplication + get_fptr (TApplication fptr) = fptr + cast_fptr_to_obj = TApplication diff --git a/src/HROOT/Core/TArray.hs b/src/HROOT/Core/TArray.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArray.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TArray + ( + TArray(..) + , ITArray + , upcastTArray + , downcastTArray + + + ) where + +import HROOT.Core.TArray.RawType +import HROOT.Core.TArray.Interface +import HROOT.Core.TArray.Implementation + + diff --git a/src/HROOT/Core/TArray/Cast.hs b/src/HROOT/Core/TArray/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArray/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArray.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TArray.RawType +import HROOT.Core.TArray.Interface + +instance (ITArray a, FPtr a) => Castable a (Ptr RawTArray) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TArray (Ptr RawTArray) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TArray/FFI.hsc b/src/HROOT/Core/TArray/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArray/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TArray.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TArray.RawType + + +#include "HROOTCoreTArray.h" + +foreign import ccall "HROOTCoreTArray.h TArray_delete" c_tarray_delete + :: (Ptr RawTArray) -> IO () + diff --git a/src/HROOT/Core/TArray/Implementation.hs b/src/HROOT/Core/TArray/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArray/Implementation.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArray.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TArray.RawType +import HROOT.Core.TArray.FFI +import HROOT.Core.TArray.Interface +import HROOT.Core.TArray.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 ITArray TArray where +instance IDeletable TArray where + delete = xform0 c_tarray_delete + +instance ITArray (Exist TArray) where + +instance IDeletable (Exist TArray) where + delete (ETArray x) = delete x + + + + + + + +instance FPtr (Exist TArray) where + type Raw (Exist TArray) = RawTArray + get_fptr (ETArray obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETArray (cast_fptr_to_obj (fptr :: ForeignPtr RawTArray) :: TArray) diff --git a/src/HROOT/Core/TArray/Interface.hs b/src/HROOT/Core/TArray/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArray/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TArray.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TArray.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITArray a where + +instance Existable TArray where + data Exist TArray = forall a. (FPtr a, ITArray a) => ETArray a + +upcastTArray :: (FPtr a, ITArray a) => a -> TArray +upcastTArray h = let fh = get_fptr h + fh2 :: ForeignPtr RawTArray = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTArray :: (FPtr a, ITArray a) => TArray -> a +downcastTArray h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArray/RawType.hs b/src/HROOT/Core/TArray/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArray/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TArray.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTArray +newtype TArray = TArray (ForeignPtr RawTArray) deriving (Eq, Ord, Show) +instance FPtr TArray where + type Raw TArray = RawTArray + get_fptr (TArray fptr) = fptr + cast_fptr_to_obj = TArray diff --git a/src/HROOT/Core/TArrayC.hs b/src/HROOT/Core/TArrayC.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayC.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TArrayC + ( + TArrayC(..) + , ITArrayC + , upcastTArrayC + , downcastTArrayC + + + ) where + +import HROOT.Core.TArrayC.RawType +import HROOT.Core.TArrayC.Interface +import HROOT.Core.TArrayC.Implementation + + diff --git a/src/HROOT/Core/TArrayC/Cast.hs b/src/HROOT/Core/TArrayC/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayC/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayC.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TArrayC.RawType +import HROOT.Core.TArrayC.Interface + +instance (ITArrayC a, FPtr a) => Castable a (Ptr RawTArrayC) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TArrayC (Ptr RawTArrayC) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TArrayC/FFI.hsc b/src/HROOT/Core/TArrayC/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayC/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TArrayC.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TArrayC.RawType + + +#include "HROOTCoreTArrayC.h" + +foreign import ccall "HROOTCoreTArrayC.h TArrayC_delete" c_tarrayc_delete + :: (Ptr RawTArrayC) -> IO () + diff --git a/src/HROOT/Core/TArrayC/Implementation.hs b/src/HROOT/Core/TArrayC/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayC/Implementation.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayC.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayC.RawType +import HROOT.Core.TArrayC.FFI +import HROOT.Core.TArrayC.Interface +import HROOT.Core.TArrayC.Cast + +import HROOT.Core.TArray.RawType +import HROOT.Core.TArray.Cast +import HROOT.Core.TArray.Interface +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 ITArrayC TArrayC where +instance ITArray TArrayC where +instance IDeletable TArrayC where + delete = xform0 c_tarrayc_delete + +instance ITArrayC (Exist TArrayC) where + +instance ITArray (Exist TArrayC) where + +instance IDeletable (Exist TArrayC) where + delete (ETArrayC x) = delete x + + + + + + + +instance FPtr (Exist TArrayC) where + type Raw (Exist TArrayC) = RawTArrayC + get_fptr (ETArrayC obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETArrayC (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayC) :: TArrayC) diff --git a/src/HROOT/Core/TArrayC/Interface.hs b/src/HROOT/Core/TArrayC/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayC/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TArrayC.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayC.RawType + +import HROOT.Core.TArray.Interface +---- ============ ---- + + + +class (ITArray a) => ITArrayC a where + +instance Existable TArrayC where + data Exist TArrayC = forall a. (FPtr a, ITArrayC a) => ETArrayC a + +upcastTArrayC :: (FPtr a, ITArrayC a) => a -> TArrayC +upcastTArrayC h = let fh = get_fptr h + fh2 :: ForeignPtr RawTArrayC = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTArrayC :: (FPtr a, ITArrayC a) => TArrayC -> a +downcastTArrayC h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayC/RawType.hs b/src/HROOT/Core/TArrayC/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayC/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TArrayC.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTArrayC +newtype TArrayC = TArrayC (ForeignPtr RawTArrayC) deriving (Eq, Ord, Show) +instance FPtr TArrayC where + type Raw TArrayC = RawTArrayC + get_fptr (TArrayC fptr) = fptr + cast_fptr_to_obj = TArrayC diff --git a/src/HROOT/Core/TArrayD.hs b/src/HROOT/Core/TArrayD.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayD.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TArrayD + ( + TArrayD(..) + , ITArrayD + , upcastTArrayD + , downcastTArrayD + + + ) where + +import HROOT.Core.TArrayD.RawType +import HROOT.Core.TArrayD.Interface +import HROOT.Core.TArrayD.Implementation + + diff --git a/src/HROOT/Core/TArrayD/Cast.hs b/src/HROOT/Core/TArrayD/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayD/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayD.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TArrayD.RawType +import HROOT.Core.TArrayD.Interface + +instance (ITArrayD a, FPtr a) => Castable a (Ptr RawTArrayD) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TArrayD (Ptr RawTArrayD) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TArrayD/FFI.hsc b/src/HROOT/Core/TArrayD/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayD/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TArrayD.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TArrayD.RawType + + +#include "HROOTCoreTArrayD.h" + +foreign import ccall "HROOTCoreTArrayD.h TArrayD_delete" c_tarrayd_delete + :: (Ptr RawTArrayD) -> IO () + diff --git a/src/HROOT/Core/TArrayD/Implementation.hs b/src/HROOT/Core/TArrayD/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayD/Implementation.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayD.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayD.RawType +import HROOT.Core.TArrayD.FFI +import HROOT.Core.TArrayD.Interface +import HROOT.Core.TArrayD.Cast + +import HROOT.Core.TArray.RawType +import HROOT.Core.TArray.Cast +import HROOT.Core.TArray.Interface +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 ITArrayD TArrayD where +instance ITArray TArrayD where +instance IDeletable TArrayD where + delete = xform0 c_tarrayd_delete + +instance ITArrayD (Exist TArrayD) where + +instance ITArray (Exist TArrayD) where + +instance IDeletable (Exist TArrayD) where + delete (ETArrayD x) = delete x + + + + + + + +instance FPtr (Exist TArrayD) where + type Raw (Exist TArrayD) = RawTArrayD + get_fptr (ETArrayD obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETArrayD (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayD) :: TArrayD) diff --git a/src/HROOT/Core/TArrayD/Interface.hs b/src/HROOT/Core/TArrayD/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayD/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TArrayD.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayD.RawType + +import HROOT.Core.TArray.Interface +---- ============ ---- + + + +class (ITArray a) => ITArrayD a where + +instance Existable TArrayD where + data Exist TArrayD = forall a. (FPtr a, ITArrayD a) => ETArrayD a + +upcastTArrayD :: (FPtr a, ITArrayD a) => a -> TArrayD +upcastTArrayD h = let fh = get_fptr h + fh2 :: ForeignPtr RawTArrayD = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTArrayD :: (FPtr a, ITArrayD a) => TArrayD -> a +downcastTArrayD h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayD/RawType.hs b/src/HROOT/Core/TArrayD/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayD/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TArrayD.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTArrayD +newtype TArrayD = TArrayD (ForeignPtr RawTArrayD) deriving (Eq, Ord, Show) +instance FPtr TArrayD where + type Raw TArrayD = RawTArrayD + get_fptr (TArrayD fptr) = fptr + cast_fptr_to_obj = TArrayD diff --git a/src/HROOT/Core/TArrayF.hs b/src/HROOT/Core/TArrayF.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayF.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TArrayF + ( + TArrayF(..) + , ITArrayF + , upcastTArrayF + , downcastTArrayF + + + ) where + +import HROOT.Core.TArrayF.RawType +import HROOT.Core.TArrayF.Interface +import HROOT.Core.TArrayF.Implementation + + diff --git a/src/HROOT/Core/TArrayF/Cast.hs b/src/HROOT/Core/TArrayF/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayF/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayF.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TArrayF.RawType +import HROOT.Core.TArrayF.Interface + +instance (ITArrayF a, FPtr a) => Castable a (Ptr RawTArrayF) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TArrayF (Ptr RawTArrayF) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TArrayF/FFI.hsc b/src/HROOT/Core/TArrayF/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayF/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TArrayF.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TArrayF.RawType + + +#include "HROOTCoreTArrayF.h" + +foreign import ccall "HROOTCoreTArrayF.h TArrayF_delete" c_tarrayf_delete + :: (Ptr RawTArrayF) -> IO () + diff --git a/src/HROOT/Core/TArrayF/Implementation.hs b/src/HROOT/Core/TArrayF/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayF/Implementation.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayF.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayF.RawType +import HROOT.Core.TArrayF.FFI +import HROOT.Core.TArrayF.Interface +import HROOT.Core.TArrayF.Cast + +import HROOT.Core.TArray.RawType +import HROOT.Core.TArray.Cast +import HROOT.Core.TArray.Interface +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 ITArrayF TArrayF where +instance ITArray TArrayF where +instance IDeletable TArrayF where + delete = xform0 c_tarrayf_delete + +instance ITArrayF (Exist TArrayF) where + +instance ITArray (Exist TArrayF) where + +instance IDeletable (Exist TArrayF) where + delete (ETArrayF x) = delete x + + + + + + + +instance FPtr (Exist TArrayF) where + type Raw (Exist TArrayF) = RawTArrayF + get_fptr (ETArrayF obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETArrayF (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayF) :: TArrayF) diff --git a/src/HROOT/Core/TArrayF/Interface.hs b/src/HROOT/Core/TArrayF/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayF/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TArrayF.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayF.RawType + +import HROOT.Core.TArray.Interface +---- ============ ---- + + + +class (ITArray a) => ITArrayF a where + +instance Existable TArrayF where + data Exist TArrayF = forall a. (FPtr a, ITArrayF a) => ETArrayF a + +upcastTArrayF :: (FPtr a, ITArrayF a) => a -> TArrayF +upcastTArrayF h = let fh = get_fptr h + fh2 :: ForeignPtr RawTArrayF = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTArrayF :: (FPtr a, ITArrayF a) => TArrayF -> a +downcastTArrayF h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayF/RawType.hs b/src/HROOT/Core/TArrayF/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayF/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TArrayF.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTArrayF +newtype TArrayF = TArrayF (ForeignPtr RawTArrayF) deriving (Eq, Ord, Show) +instance FPtr TArrayF where + type Raw TArrayF = RawTArrayF + get_fptr (TArrayF fptr) = fptr + cast_fptr_to_obj = TArrayF diff --git a/src/HROOT/Core/TArrayI.hs b/src/HROOT/Core/TArrayI.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayI.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TArrayI + ( + TArrayI(..) + , ITArrayI + , upcastTArrayI + , downcastTArrayI + + + ) where + +import HROOT.Core.TArrayI.RawType +import HROOT.Core.TArrayI.Interface +import HROOT.Core.TArrayI.Implementation + + diff --git a/src/HROOT/Core/TArrayI/Cast.hs b/src/HROOT/Core/TArrayI/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayI/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayI.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TArrayI.RawType +import HROOT.Core.TArrayI.Interface + +instance (ITArrayI a, FPtr a) => Castable a (Ptr RawTArrayI) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TArrayI (Ptr RawTArrayI) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TArrayI/FFI.hsc b/src/HROOT/Core/TArrayI/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayI/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TArrayI.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TArrayI.RawType + + +#include "HROOTCoreTArrayI.h" + +foreign import ccall "HROOTCoreTArrayI.h TArrayI_delete" c_tarrayi_delete + :: (Ptr RawTArrayI) -> IO () + diff --git a/src/HROOT/Core/TArrayI/Implementation.hs b/src/HROOT/Core/TArrayI/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayI/Implementation.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayI.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayI.RawType +import HROOT.Core.TArrayI.FFI +import HROOT.Core.TArrayI.Interface +import HROOT.Core.TArrayI.Cast + +import HROOT.Core.TArray.RawType +import HROOT.Core.TArray.Cast +import HROOT.Core.TArray.Interface +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 ITArrayI TArrayI where +instance ITArray TArrayI where +instance IDeletable TArrayI where + delete = xform0 c_tarrayi_delete + +instance ITArrayI (Exist TArrayI) where + +instance ITArray (Exist TArrayI) where + +instance IDeletable (Exist TArrayI) where + delete (ETArrayI x) = delete x + + + + + + + +instance FPtr (Exist TArrayI) where + type Raw (Exist TArrayI) = RawTArrayI + get_fptr (ETArrayI obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETArrayI (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayI) :: TArrayI) diff --git a/src/HROOT/Core/TArrayI/Interface.hs b/src/HROOT/Core/TArrayI/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayI/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TArrayI.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayI.RawType + +import HROOT.Core.TArray.Interface +---- ============ ---- + + + +class (ITArray a) => ITArrayI a where + +instance Existable TArrayI where + data Exist TArrayI = forall a. (FPtr a, ITArrayI a) => ETArrayI a + +upcastTArrayI :: (FPtr a, ITArrayI a) => a -> TArrayI +upcastTArrayI h = let fh = get_fptr h + fh2 :: ForeignPtr RawTArrayI = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTArrayI :: (FPtr a, ITArrayI a) => TArrayI -> a +downcastTArrayI h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayI/RawType.hs b/src/HROOT/Core/TArrayI/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayI/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TArrayI.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTArrayI +newtype TArrayI = TArrayI (ForeignPtr RawTArrayI) deriving (Eq, Ord, Show) +instance FPtr TArrayI where + type Raw TArrayI = RawTArrayI + get_fptr (TArrayI fptr) = fptr + cast_fptr_to_obj = TArrayI diff --git a/src/HROOT/Core/TArrayL.hs b/src/HROOT/Core/TArrayL.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TArrayL + ( + TArrayL(..) + , ITArrayL + , upcastTArrayL + , downcastTArrayL + + + ) where + +import HROOT.Core.TArrayL.RawType +import HROOT.Core.TArrayL.Interface +import HROOT.Core.TArrayL.Implementation + + diff --git a/src/HROOT/Core/TArrayL/Cast.hs b/src/HROOT/Core/TArrayL/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayL.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TArrayL.RawType +import HROOT.Core.TArrayL.Interface + +instance (ITArrayL a, FPtr a) => Castable a (Ptr RawTArrayL) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TArrayL (Ptr RawTArrayL) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TArrayL/FFI.hsc b/src/HROOT/Core/TArrayL/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TArrayL.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TArrayL.RawType + + +#include "HROOTCoreTArrayL.h" + +foreign import ccall "HROOTCoreTArrayL.h TArrayL_delete" c_tarrayl_delete + :: (Ptr RawTArrayL) -> IO () + diff --git a/src/HROOT/Core/TArrayL/Implementation.hs b/src/HROOT/Core/TArrayL/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL/Implementation.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayL.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayL.RawType +import HROOT.Core.TArrayL.FFI +import HROOT.Core.TArrayL.Interface +import HROOT.Core.TArrayL.Cast + +import HROOT.Core.TArray.RawType +import HROOT.Core.TArray.Cast +import HROOT.Core.TArray.Interface +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 ITArrayL TArrayL where +instance ITArray TArrayL where +instance IDeletable TArrayL where + delete = xform0 c_tarrayl_delete + +instance ITArrayL (Exist TArrayL) where + +instance ITArray (Exist TArrayL) where + +instance IDeletable (Exist TArrayL) where + delete (ETArrayL x) = delete x + + + + + + + +instance FPtr (Exist TArrayL) where + type Raw (Exist TArrayL) = RawTArrayL + get_fptr (ETArrayL obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETArrayL (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayL) :: TArrayL) diff --git a/src/HROOT/Core/TArrayL/Interface.hs b/src/HROOT/Core/TArrayL/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TArrayL.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayL.RawType + +import HROOT.Core.TArray.Interface +---- ============ ---- + + + +class (ITArray a) => ITArrayL a where + +instance Existable TArrayL where + data Exist TArrayL = forall a. (FPtr a, ITArrayL a) => ETArrayL a + +upcastTArrayL :: (FPtr a, ITArrayL a) => a -> TArrayL +upcastTArrayL h = let fh = get_fptr h + fh2 :: ForeignPtr RawTArrayL = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTArrayL :: (FPtr a, ITArrayL a) => TArrayL -> a +downcastTArrayL h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayL/RawType.hs b/src/HROOT/Core/TArrayL/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TArrayL.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTArrayL +newtype TArrayL = TArrayL (ForeignPtr RawTArrayL) deriving (Eq, Ord, Show) +instance FPtr TArrayL where + type Raw TArrayL = RawTArrayL + get_fptr (TArrayL fptr) = fptr + cast_fptr_to_obj = TArrayL diff --git a/src/HROOT/Core/TArrayL64.hs b/src/HROOT/Core/TArrayL64.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL64.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TArrayL64 + ( + TArrayL64(..) + , ITArrayL64 + , upcastTArrayL64 + , downcastTArrayL64 + + + ) where + +import HROOT.Core.TArrayL64.RawType +import HROOT.Core.TArrayL64.Interface +import HROOT.Core.TArrayL64.Implementation + + diff --git a/src/HROOT/Core/TArrayL64/Cast.hs b/src/HROOT/Core/TArrayL64/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL64/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayL64.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TArrayL64.RawType +import HROOT.Core.TArrayL64.Interface + +instance (ITArrayL64 a, FPtr a) => Castable a (Ptr RawTArrayL64) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TArrayL64 (Ptr RawTArrayL64) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TArrayL64/FFI.hsc b/src/HROOT/Core/TArrayL64/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL64/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TArrayL64.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TArrayL64.RawType + + +#include "HROOTCoreTArrayL64.h" + +foreign import ccall "HROOTCoreTArrayL64.h TArrayL64_delete" c_tarrayl64_delete + :: (Ptr RawTArrayL64) -> IO () + diff --git a/src/HROOT/Core/TArrayL64/Implementation.hs b/src/HROOT/Core/TArrayL64/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL64/Implementation.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayL64.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayL64.RawType +import HROOT.Core.TArrayL64.FFI +import HROOT.Core.TArrayL64.Interface +import HROOT.Core.TArrayL64.Cast + +import HROOT.Core.TArray.RawType +import HROOT.Core.TArray.Cast +import HROOT.Core.TArray.Interface +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 ITArrayL64 TArrayL64 where +instance ITArray TArrayL64 where +instance IDeletable TArrayL64 where + delete = xform0 c_tarrayl64_delete + +instance ITArrayL64 (Exist TArrayL64) where + +instance ITArray (Exist TArrayL64) where + +instance IDeletable (Exist TArrayL64) where + delete (ETArrayL64 x) = delete x + + + + + + + +instance FPtr (Exist TArrayL64) where + type Raw (Exist TArrayL64) = RawTArrayL64 + get_fptr (ETArrayL64 obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETArrayL64 (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayL64) :: TArrayL64) diff --git a/src/HROOT/Core/TArrayL64/Interface.hs b/src/HROOT/Core/TArrayL64/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL64/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TArrayL64.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayL64.RawType + +import HROOT.Core.TArray.Interface +---- ============ ---- + + + +class (ITArray a) => ITArrayL64 a where + +instance Existable TArrayL64 where + data Exist TArrayL64 = forall a. (FPtr a, ITArrayL64 a) => ETArrayL64 a + +upcastTArrayL64 :: (FPtr a, ITArrayL64 a) => a -> TArrayL64 +upcastTArrayL64 h = let fh = get_fptr h + fh2 :: ForeignPtr RawTArrayL64 = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTArrayL64 :: (FPtr a, ITArrayL64 a) => TArrayL64 -> a +downcastTArrayL64 h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayL64/RawType.hs b/src/HROOT/Core/TArrayL64/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayL64/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TArrayL64.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTArrayL64 +newtype TArrayL64 = TArrayL64 (ForeignPtr RawTArrayL64) deriving (Eq, Ord, Show) +instance FPtr TArrayL64 where + type Raw TArrayL64 = RawTArrayL64 + get_fptr (TArrayL64 fptr) = fptr + cast_fptr_to_obj = TArrayL64 diff --git a/src/HROOT/Core/TArrayS.hs b/src/HROOT/Core/TArrayS.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayS.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TArrayS + ( + TArrayS(..) + , ITArrayS + , upcastTArrayS + , downcastTArrayS + + + ) where + +import HROOT.Core.TArrayS.RawType +import HROOT.Core.TArrayS.Interface +import HROOT.Core.TArrayS.Implementation + + diff --git a/src/HROOT/Core/TArrayS/Cast.hs b/src/HROOT/Core/TArrayS/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayS/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayS.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TArrayS.RawType +import HROOT.Core.TArrayS.Interface + +instance (ITArrayS a, FPtr a) => Castable a (Ptr RawTArrayS) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TArrayS (Ptr RawTArrayS) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TArrayS/FFI.hsc b/src/HROOT/Core/TArrayS/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayS/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TArrayS.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TArrayS.RawType + + +#include "HROOTCoreTArrayS.h" + +foreign import ccall "HROOTCoreTArrayS.h TArrayS_delete" c_tarrays_delete + :: (Ptr RawTArrayS) -> IO () + diff --git a/src/HROOT/Core/TArrayS/Implementation.hs b/src/HROOT/Core/TArrayS/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayS/Implementation.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TArrayS.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayS.RawType +import HROOT.Core.TArrayS.FFI +import HROOT.Core.TArrayS.Interface +import HROOT.Core.TArrayS.Cast + +import HROOT.Core.TArray.RawType +import HROOT.Core.TArray.Cast +import HROOT.Core.TArray.Interface +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 ITArrayS TArrayS where +instance ITArray TArrayS where +instance IDeletable TArrayS where + delete = xform0 c_tarrays_delete + +instance ITArrayS (Exist TArrayS) where + +instance ITArray (Exist TArrayS) where + +instance IDeletable (Exist TArrayS) where + delete (ETArrayS x) = delete x + + + + + + + +instance FPtr (Exist TArrayS) where + type Raw (Exist TArrayS) = RawTArrayS + get_fptr (ETArrayS obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETArrayS (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayS) :: TArrayS) diff --git a/src/HROOT/Core/TArrayS/Interface.hs b/src/HROOT/Core/TArrayS/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayS/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TArrayS.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TArrayS.RawType + +import HROOT.Core.TArray.Interface +---- ============ ---- + + + +class (ITArray a) => ITArrayS a where + +instance Existable TArrayS where + data Exist TArrayS = forall a. (FPtr a, ITArrayS a) => ETArrayS a + +upcastTArrayS :: (FPtr a, ITArrayS a) => a -> TArrayS +upcastTArrayS h = let fh = get_fptr h + fh2 :: ForeignPtr RawTArrayS = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTArrayS :: (FPtr a, ITArrayS a) => TArrayS -> a +downcastTArrayS h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayS/RawType.hs b/src/HROOT/Core/TArrayS/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TArrayS/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TArrayS.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTArrayS +newtype TArrayS = TArrayS (ForeignPtr RawTArrayS) deriving (Eq, Ord, Show) +instance FPtr TArrayS where + type Raw TArrayS = RawTArrayS + get_fptr (TArrayS fptr) = fptr + cast_fptr_to_obj = TArrayS diff --git a/src/HROOT/Core/TAtt3D.hs b/src/HROOT/Core/TAtt3D.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAtt3D.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TAtt3D + ( + TAtt3D(..) + , ITAtt3D + , upcastTAtt3D + , downcastTAtt3D + + + ) where + +import HROOT.Core.TAtt3D.RawType +import HROOT.Core.TAtt3D.Interface +import HROOT.Core.TAtt3D.Implementation + + diff --git a/src/HROOT/Core/TAtt3D/Cast.hs b/src/HROOT/Core/TAtt3D/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAtt3D/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAtt3D.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TAtt3D.RawType +import HROOT.Core.TAtt3D.Interface + +instance (ITAtt3D a, FPtr a) => Castable a (Ptr RawTAtt3D) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TAtt3D (Ptr RawTAtt3D) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TAtt3D/FFI.hsc b/src/HROOT/Core/TAtt3D/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAtt3D/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TAtt3D.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TAtt3D.RawType + + +#include "HROOTCoreTAtt3D.h" + +foreign import ccall "HROOTCoreTAtt3D.h TAtt3D_delete" c_tatt3d_delete + :: (Ptr RawTAtt3D) -> IO () + diff --git a/src/HROOT/Core/TAtt3D/Implementation.hs b/src/HROOT/Core/TAtt3D/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAtt3D/Implementation.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAtt3D.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TAtt3D.RawType +import HROOT.Core.TAtt3D.FFI +import HROOT.Core.TAtt3D.Interface +import HROOT.Core.TAtt3D.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 ITAtt3D TAtt3D where +instance IDeletable TAtt3D where + delete = xform0 c_tatt3d_delete + +instance ITAtt3D (Exist TAtt3D) where + +instance IDeletable (Exist TAtt3D) where + delete (ETAtt3D x) = delete x + + + + + + + +instance FPtr (Exist TAtt3D) where + type Raw (Exist TAtt3D) = RawTAtt3D + get_fptr (ETAtt3D obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETAtt3D (cast_fptr_to_obj (fptr :: ForeignPtr RawTAtt3D) :: TAtt3D) diff --git a/src/HROOT/Core/TAtt3D/Interface.hs b/src/HROOT/Core/TAtt3D/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAtt3D/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TAtt3D.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TAtt3D.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITAtt3D a where + +instance Existable TAtt3D where + data Exist TAtt3D = forall a. (FPtr a, ITAtt3D a) => ETAtt3D a + +upcastTAtt3D :: (FPtr a, ITAtt3D a) => a -> TAtt3D +upcastTAtt3D h = let fh = get_fptr h + fh2 :: ForeignPtr RawTAtt3D = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTAtt3D :: (FPtr a, ITAtt3D a) => TAtt3D -> a +downcastTAtt3D h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAtt3D/RawType.hs b/src/HROOT/Core/TAtt3D/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAtt3D/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TAtt3D.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTAtt3D +newtype TAtt3D = TAtt3D (ForeignPtr RawTAtt3D) deriving (Eq, Ord, Show) +instance FPtr TAtt3D where + type Raw TAtt3D = RawTAtt3D + get_fptr (TAtt3D fptr) = fptr + cast_fptr_to_obj = TAtt3D diff --git a/src/HROOT/Core/TAttAxis.hs b/src/HROOT/Core/TAttAxis.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttAxis.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TAttAxis + ( + TAttAxis(..) + , ITAttAxis(..) + , upcastTAttAxis + , downcastTAttAxis + , newTAttAxis + + ) where + +import HROOT.Core.TAttAxis.RawType +import HROOT.Core.TAttAxis.Interface +import HROOT.Core.TAttAxis.Implementation + + diff --git a/src/HROOT/Core/TAttAxis/Cast.hs b/src/HROOT/Core/TAttAxis/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttAxis/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttAxis.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TAttAxis.RawType +import HROOT.Core.TAttAxis.Interface + +instance (ITAttAxis a, FPtr a) => Castable a (Ptr RawTAttAxis) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TAttAxis (Ptr RawTAttAxis) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TAttAxis/FFI.hsc b/src/HROOT/Core/TAttAxis/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttAxis/FFI.hsc @@ -0,0 +1,88 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TAttAxis.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TAttAxis.RawType + + +#include "HROOTCoreTAttAxis.h" + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_delete" c_tattaxis_delete + :: (Ptr RawTAttAxis) -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_newTAttAxis" c_tattaxis_newtattaxis + :: IO (Ptr RawTAttAxis) + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetNdivisions" c_tattaxis_getndivisions + :: (Ptr RawTAttAxis) -> IO CInt + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetAxisColor" c_tattaxis_getaxiscolor + :: (Ptr RawTAttAxis) -> IO CInt + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetLabelColor" c_tattaxis_getlabelcolor + :: (Ptr RawTAttAxis) -> IO CInt + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetLabelFont" c_tattaxis_getlabelfont + :: (Ptr RawTAttAxis) -> IO CInt + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetLabelOffset" c_tattaxis_getlabeloffset + :: (Ptr RawTAttAxis) -> IO CDouble + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetLabelSize" c_tattaxis_getlabelsize + :: (Ptr RawTAttAxis) -> IO CDouble + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetTitleOffset" c_tattaxis_gettitleoffset + :: (Ptr RawTAttAxis) -> IO CDouble + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetTitleSize" c_tattaxis_gettitlesize + :: (Ptr RawTAttAxis) -> IO CDouble + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetTickLength" c_tattaxis_getticklength + :: (Ptr RawTAttAxis) -> IO CDouble + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetTitleFont" c_tattaxis_gettitlefont + :: (Ptr RawTAttAxis) -> IO CInt + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetNdivisions" c_tattaxis_setndivisions + :: (Ptr RawTAttAxis) -> CInt -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetAxisColor" c_tattaxis_setaxiscolor + :: (Ptr RawTAttAxis) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetLabelColor" c_tattaxis_setlabelcolor + :: (Ptr RawTAttAxis) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetLabelFont" c_tattaxis_setlabelfont + :: (Ptr RawTAttAxis) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetLabelOffset" c_tattaxis_setlabeloffset + :: (Ptr RawTAttAxis) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetLabelSize" c_tattaxis_setlabelsize + :: (Ptr RawTAttAxis) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetTickLength" c_tattaxis_setticklength + :: (Ptr RawTAttAxis) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetTitleOffset" c_tattaxis_settitleoffset + :: (Ptr RawTAttAxis) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetTitleSize" c_tattaxis_settitlesize + :: (Ptr RawTAttAxis) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetTitleColor" c_tattaxis_settitlecolor + :: (Ptr RawTAttAxis) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetTitleFont" c_tattaxis_settitlefont + :: (Ptr RawTAttAxis) -> CInt -> IO () + diff --git a/src/HROOT/Core/TAttAxis/Implementation.hs b/src/HROOT/Core/TAttAxis/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttAxis/Implementation.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttAxis.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttAxis.RawType +import HROOT.Core.TAttAxis.FFI +import HROOT.Core.TAttAxis.Interface +import HROOT.Core.TAttAxis.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 ITAttAxis TAttAxis where + getNdivisions = xform0 c_tattaxis_getndivisions + getAxisColor = xform0 c_tattaxis_getaxiscolor + getLabelColor = xform0 c_tattaxis_getlabelcolor + getLabelFont = xform0 c_tattaxis_getlabelfont + getLabelOffset = xform0 c_tattaxis_getlabeloffset + getLabelSize = xform0 c_tattaxis_getlabelsize + getTitleOffset = xform0 c_tattaxis_gettitleoffset + getTitleSize = xform0 c_tattaxis_gettitlesize + getTickLength = xform0 c_tattaxis_getticklength + getTitleFont = xform0 c_tattaxis_gettitlefont + setNdivisions = xform2 c_tattaxis_setndivisions + setAxisColor = xform1 c_tattaxis_setaxiscolor + setLabelColor = xform1 c_tattaxis_setlabelcolor + setLabelFont = xform1 c_tattaxis_setlabelfont + setLabelOffset = xform1 c_tattaxis_setlabeloffset + setLabelSize = xform1 c_tattaxis_setlabelsize + setTickLength = xform1 c_tattaxis_setticklength + setTitleOffset = xform1 c_tattaxis_settitleoffset + setTitleSize = xform1 c_tattaxis_settitlesize + setTitleColor = xform1 c_tattaxis_settitlecolor + setTitleFont = xform1 c_tattaxis_settitlefont +instance IDeletable TAttAxis where + delete = xform0 c_tattaxis_delete + +instance ITAttAxis (Exist TAttAxis) where + getNdivisions (ETAttAxis x) = getNdivisions x + getAxisColor (ETAttAxis x) = getAxisColor x + getLabelColor (ETAttAxis x) = getLabelColor x + getLabelFont (ETAttAxis x) = getLabelFont x + getLabelOffset (ETAttAxis x) = getLabelOffset x + getLabelSize (ETAttAxis x) = getLabelSize x + getTitleOffset (ETAttAxis x) = getTitleOffset x + getTitleSize (ETAttAxis x) = getTitleSize x + getTickLength (ETAttAxis x) = getTickLength x + getTitleFont (ETAttAxis x) = getTitleFont x + setNdivisions (ETAttAxis x) = setNdivisions x + setAxisColor (ETAttAxis x) = setAxisColor x + setLabelColor (ETAttAxis x) = setLabelColor x + setLabelFont (ETAttAxis x) = setLabelFont x + setLabelOffset (ETAttAxis x) = setLabelOffset x + setLabelSize (ETAttAxis x) = setLabelSize x + setTickLength (ETAttAxis x) = setTickLength x + setTitleOffset (ETAttAxis x) = setTitleOffset x + setTitleSize (ETAttAxis x) = setTitleSize x + setTitleColor (ETAttAxis x) = setTitleColor x + setTitleFont (ETAttAxis x) = setTitleFont x +instance IDeletable (Exist TAttAxis) where + delete (ETAttAxis x) = delete x + + +newTAttAxis :: IO TAttAxis +newTAttAxis = xformnull c_tattaxis_newtattaxis + + + + + +instance FPtr (Exist TAttAxis) where + type Raw (Exist TAttAxis) = RawTAttAxis + get_fptr (ETAttAxis obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETAttAxis (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttAxis) :: TAttAxis) diff --git a/src/HROOT/Core/TAttAxis/Interface.hs b/src/HROOT/Core/TAttAxis/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttAxis/Interface.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TAttAxis.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttAxis.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITAttAxis a where + + getNdivisions :: a -> IO CInt + + getAxisColor :: a -> IO CInt + + getLabelColor :: a -> IO CInt + + getLabelFont :: a -> IO CInt + + getLabelOffset :: a -> IO CDouble + + getLabelSize :: a -> IO CDouble + + getTitleOffset :: a -> IO CDouble + + getTitleSize :: a -> IO CDouble + + getTickLength :: a -> IO CDouble + + getTitleFont :: a -> IO CInt + + setNdivisions :: a -> CInt -> CInt -> IO () + + setAxisColor :: a -> CInt -> IO () + + setLabelColor :: a -> CInt -> IO () + + setLabelFont :: a -> CInt -> IO () + + setLabelOffset :: a -> CDouble -> IO () + + setLabelSize :: a -> CDouble -> IO () + + setTickLength :: a -> CDouble -> IO () + + setTitleOffset :: a -> CDouble -> IO () + + setTitleSize :: a -> CDouble -> IO () + + setTitleColor :: a -> CInt -> IO () + + setTitleFont :: a -> CInt -> IO () + +instance Existable TAttAxis where + data Exist TAttAxis = forall a. (FPtr a, ITAttAxis a) => ETAttAxis a + +upcastTAttAxis :: (FPtr a, ITAttAxis a) => a -> TAttAxis +upcastTAttAxis h = let fh = get_fptr h + fh2 :: ForeignPtr RawTAttAxis = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTAttAxis :: (FPtr a, ITAttAxis a) => TAttAxis -> a +downcastTAttAxis h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttAxis/RawType.hs b/src/HROOT/Core/TAttAxis/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttAxis/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TAttAxis.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTAttAxis +newtype TAttAxis = TAttAxis (ForeignPtr RawTAttAxis) deriving (Eq, Ord, Show) +instance FPtr TAttAxis where + type Raw TAttAxis = RawTAttAxis + get_fptr (TAttAxis fptr) = fptr + cast_fptr_to_obj = TAttAxis diff --git a/src/HROOT/Core/TAttBBox.hs b/src/HROOT/Core/TAttBBox.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttBBox.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TAttBBox + ( + TAttBBox(..) + , ITAttBBox + , upcastTAttBBox + , downcastTAttBBox + + + ) where + +import HROOT.Core.TAttBBox.RawType +import HROOT.Core.TAttBBox.Interface +import HROOT.Core.TAttBBox.Implementation + + diff --git a/src/HROOT/Core/TAttBBox/Cast.hs b/src/HROOT/Core/TAttBBox/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttBBox/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttBBox.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TAttBBox.RawType +import HROOT.Core.TAttBBox.Interface + +instance (ITAttBBox a, FPtr a) => Castable a (Ptr RawTAttBBox) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TAttBBox (Ptr RawTAttBBox) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TAttBBox/FFI.hsc b/src/HROOT/Core/TAttBBox/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttBBox/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TAttBBox.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TAttBBox.RawType + + +#include "HROOTCoreTAttBBox.h" + +foreign import ccall "HROOTCoreTAttBBox.h TAttBBox_delete" c_tattbbox_delete + :: (Ptr RawTAttBBox) -> IO () + diff --git a/src/HROOT/Core/TAttBBox/Implementation.hs b/src/HROOT/Core/TAttBBox/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttBBox/Implementation.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttBBox.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttBBox.RawType +import HROOT.Core.TAttBBox.FFI +import HROOT.Core.TAttBBox.Interface +import HROOT.Core.TAttBBox.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 ITAttBBox TAttBBox where +instance IDeletable TAttBBox where + delete = xform0 c_tattbbox_delete + +instance ITAttBBox (Exist TAttBBox) where + +instance IDeletable (Exist TAttBBox) where + delete (ETAttBBox x) = delete x + + + + + + + +instance FPtr (Exist TAttBBox) where + type Raw (Exist TAttBBox) = RawTAttBBox + get_fptr (ETAttBBox obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETAttBBox (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttBBox) :: TAttBBox) diff --git a/src/HROOT/Core/TAttBBox/Interface.hs b/src/HROOT/Core/TAttBBox/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttBBox/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TAttBBox.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttBBox.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITAttBBox a where + +instance Existable TAttBBox where + data Exist TAttBBox = forall a. (FPtr a, ITAttBBox a) => ETAttBBox a + +upcastTAttBBox :: (FPtr a, ITAttBBox a) => a -> TAttBBox +upcastTAttBBox h = let fh = get_fptr h + fh2 :: ForeignPtr RawTAttBBox = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTAttBBox :: (FPtr a, ITAttBBox a) => TAttBBox -> a +downcastTAttBBox h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttBBox/RawType.hs b/src/HROOT/Core/TAttBBox/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttBBox/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TAttBBox.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTAttBBox +newtype TAttBBox = TAttBBox (ForeignPtr RawTAttBBox) deriving (Eq, Ord, Show) +instance FPtr TAttBBox where + type Raw TAttBBox = RawTAttBBox + get_fptr (TAttBBox fptr) = fptr + cast_fptr_to_obj = TAttBBox diff --git a/src/HROOT/Core/TAttCanvas.hs b/src/HROOT/Core/TAttCanvas.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttCanvas.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TAttCanvas + ( + TAttCanvas(..) + , ITAttCanvas + , upcastTAttCanvas + , downcastTAttCanvas + , newTAttCanvas + + ) where + +import HROOT.Core.TAttCanvas.RawType +import HROOT.Core.TAttCanvas.Interface +import HROOT.Core.TAttCanvas.Implementation + + diff --git a/src/HROOT/Core/TAttCanvas/Cast.hs b/src/HROOT/Core/TAttCanvas/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttCanvas/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttCanvas.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TAttCanvas.RawType +import HROOT.Core.TAttCanvas.Interface + +instance (ITAttCanvas a, FPtr a) => Castable a (Ptr RawTAttCanvas) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TAttCanvas (Ptr RawTAttCanvas) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TAttCanvas/FFI.hsc b/src/HROOT/Core/TAttCanvas/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttCanvas/FFI.hsc @@ -0,0 +1,25 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TAttCanvas.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TAttCanvas.RawType + + +#include "HROOTCoreTAttCanvas.h" + +foreign import ccall "HROOTCoreTAttCanvas.h TAttCanvas_delete" c_tattcanvas_delete + :: (Ptr RawTAttCanvas) -> IO () + +foreign import ccall "HROOTCoreTAttCanvas.h TAttCanvas_newTAttCanvas" c_tattcanvas_newtattcanvas + :: IO (Ptr RawTAttCanvas) + diff --git a/src/HROOT/Core/TAttCanvas/Implementation.hs b/src/HROOT/Core/TAttCanvas/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttCanvas/Implementation.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttCanvas.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttCanvas.RawType +import HROOT.Core.TAttCanvas.FFI +import HROOT.Core.TAttCanvas.Interface +import HROOT.Core.TAttCanvas.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 ITAttCanvas TAttCanvas where +instance IDeletable TAttCanvas where + delete = xform0 c_tattcanvas_delete + +instance ITAttCanvas (Exist TAttCanvas) where + +instance IDeletable (Exist TAttCanvas) where + delete (ETAttCanvas x) = delete x + + +newTAttCanvas :: IO TAttCanvas +newTAttCanvas = xformnull c_tattcanvas_newtattcanvas + + + + + +instance FPtr (Exist TAttCanvas) where + type Raw (Exist TAttCanvas) = RawTAttCanvas + get_fptr (ETAttCanvas obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETAttCanvas (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttCanvas) :: TAttCanvas) diff --git a/src/HROOT/Core/TAttCanvas/Interface.hs b/src/HROOT/Core/TAttCanvas/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttCanvas/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TAttCanvas.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttCanvas.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITAttCanvas a where + +instance Existable TAttCanvas where + data Exist TAttCanvas = forall a. (FPtr a, ITAttCanvas a) => ETAttCanvas a + +upcastTAttCanvas :: (FPtr a, ITAttCanvas a) => a -> TAttCanvas +upcastTAttCanvas h = let fh = get_fptr h + fh2 :: ForeignPtr RawTAttCanvas = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTAttCanvas :: (FPtr a, ITAttCanvas a) => TAttCanvas -> a +downcastTAttCanvas h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttCanvas/RawType.hs b/src/HROOT/Core/TAttCanvas/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttCanvas/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TAttCanvas.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTAttCanvas +newtype TAttCanvas = TAttCanvas (ForeignPtr RawTAttCanvas) deriving (Eq, Ord, Show) +instance FPtr TAttCanvas where + type Raw TAttCanvas = RawTAttCanvas + get_fptr (TAttCanvas fptr) = fptr + cast_fptr_to_obj = TAttCanvas diff --git a/src/HROOT/Core/TAttFill.hs b/src/HROOT/Core/TAttFill.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttFill.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TAttFill + ( + TAttFill(..) + , ITAttFill(..) + , upcastTAttFill + , downcastTAttFill + , newTAttFill + + ) where + +import HROOT.Core.TAttFill.RawType +import HROOT.Core.TAttFill.Interface +import HROOT.Core.TAttFill.Implementation + + diff --git a/src/HROOT/Core/TAttFill/Cast.hs b/src/HROOT/Core/TAttFill/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttFill/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttFill.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TAttFill.RawType +import HROOT.Core.TAttFill.Interface + +instance (ITAttFill a, FPtr a) => Castable a (Ptr RawTAttFill) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TAttFill (Ptr RawTAttFill) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TAttFill/FFI.hsc b/src/HROOT/Core/TAttFill/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttFill/FFI.hsc @@ -0,0 +1,31 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TAttFill.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TAttFill.RawType + + +#include "HROOTCoreTAttFill.h" + +foreign import ccall "HROOTCoreTAttFill.h TAttFill_delete" c_tattfill_delete + :: (Ptr RawTAttFill) -> IO () + +foreign import ccall "HROOTCoreTAttFill.h TAttFill_newTAttFill" c_tattfill_newtattfill + :: CInt -> CInt -> IO (Ptr RawTAttFill) + +foreign import ccall "HROOTCoreTAttFill.h TAttFill_SetFillColor" c_tattfill_setfillcolor + :: (Ptr RawTAttFill) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttFill.h TAttFill_SetFillStyle" c_tattfill_setfillstyle + :: (Ptr RawTAttFill) -> CInt -> IO () + diff --git a/src/HROOT/Core/TAttFill/Implementation.hs b/src/HROOT/Core/TAttFill/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttFill/Implementation.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttFill.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttFill.RawType +import HROOT.Core.TAttFill.FFI +import HROOT.Core.TAttFill.Interface +import HROOT.Core.TAttFill.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 ITAttFill TAttFill where + setFillColor = xform1 c_tattfill_setfillcolor + setFillStyle = xform1 c_tattfill_setfillstyle +instance IDeletable TAttFill where + delete = xform0 c_tattfill_delete + +instance ITAttFill (Exist TAttFill) where + setFillColor (ETAttFill x) = setFillColor x + setFillStyle (ETAttFill x) = setFillStyle x +instance IDeletable (Exist TAttFill) where + delete (ETAttFill x) = delete x + + +newTAttFill :: CInt -> CInt -> IO TAttFill +newTAttFill = xform1 c_tattfill_newtattfill + + + + + +instance FPtr (Exist TAttFill) where + type Raw (Exist TAttFill) = RawTAttFill + get_fptr (ETAttFill obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETAttFill (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttFill) :: TAttFill) diff --git a/src/HROOT/Core/TAttFill/Interface.hs b/src/HROOT/Core/TAttFill/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttFill/Interface.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TAttFill.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttFill.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITAttFill a where + + setFillColor :: a -> CInt -> IO () + + setFillStyle :: a -> CInt -> IO () + +instance Existable TAttFill where + data Exist TAttFill = forall a. (FPtr a, ITAttFill a) => ETAttFill a + +upcastTAttFill :: (FPtr a, ITAttFill a) => a -> TAttFill +upcastTAttFill h = let fh = get_fptr h + fh2 :: ForeignPtr RawTAttFill = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTAttFill :: (FPtr a, ITAttFill a) => TAttFill -> a +downcastTAttFill h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttFill/RawType.hs b/src/HROOT/Core/TAttFill/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttFill/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TAttFill.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTAttFill +newtype TAttFill = TAttFill (ForeignPtr RawTAttFill) deriving (Eq, Ord, Show) +instance FPtr TAttFill where + type Raw TAttFill = RawTAttFill + get_fptr (TAttFill fptr) = fptr + cast_fptr_to_obj = TAttFill diff --git a/src/HROOT/Core/TAttLine.hs b/src/HROOT/Core/TAttLine.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttLine.hs @@ -0,0 +1,16 @@ +module HROOT.Core.TAttLine + ( + TAttLine(..) + , ITAttLine(..) + , upcastTAttLine + , downcastTAttLine + , newTAttLine + , tAttLineDistancetoLine + + ) where + +import HROOT.Core.TAttLine.RawType +import HROOT.Core.TAttLine.Interface +import HROOT.Core.TAttLine.Implementation + + diff --git a/src/HROOT/Core/TAttLine/Cast.hs b/src/HROOT/Core/TAttLine/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttLine/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttLine.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TAttLine.RawType +import HROOT.Core.TAttLine.Interface + +instance (ITAttLine a, FPtr a) => Castable a (Ptr RawTAttLine) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TAttLine (Ptr RawTAttLine) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TAttLine/FFI.hsc b/src/HROOT/Core/TAttLine/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttLine/FFI.hsc @@ -0,0 +1,52 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TAttLine.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TAttLine.RawType + + +#include "HROOTCoreTAttLine.h" + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_delete" c_tattline_delete + :: (Ptr RawTAttLine) -> IO () + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_newTAttLine" c_tattline_newtattline + :: CInt -> CInt -> CInt -> IO (Ptr RawTAttLine) + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_tAttLineDistancetoLine" c_tattline_tattlinedistancetoline + :: (Ptr RawTAttLine) -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CDouble -> IO CInt + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_GetLineColor" c_tattline_getlinecolor + :: (Ptr RawTAttLine) -> IO CInt + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_GetLineStyle" c_tattline_getlinestyle + :: (Ptr RawTAttLine) -> IO CInt + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_GetLineWidth" c_tattline_getlinewidth + :: (Ptr RawTAttLine) -> IO CInt + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_ResetAttLine" c_tattline_resetattline + :: (Ptr RawTAttLine) -> CString -> IO () + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_SetLineAttributes" c_tattline_setlineattributes + :: (Ptr RawTAttLine) -> IO () + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_SetLineColor" c_tattline_setlinecolor + :: (Ptr RawTAttLine) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_SetLineStyle" c_tattline_setlinestyle + :: (Ptr RawTAttLine) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttLine.h TAttLine_SetLineWidth" c_tattline_setlinewidth + :: (Ptr RawTAttLine) -> CInt -> IO () + diff --git a/src/HROOT/Core/TAttLine/Implementation.hs b/src/HROOT/Core/TAttLine/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttLine/Implementation.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttLine.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttLine.RawType +import HROOT.Core.TAttLine.FFI +import HROOT.Core.TAttLine.Interface +import HROOT.Core.TAttLine.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 ITAttLine TAttLine where + getLineColor = xform0 c_tattline_getlinecolor + getLineStyle = xform0 c_tattline_getlinestyle + getLineWidth = xform0 c_tattline_getlinewidth + resetAttLine = xform1 c_tattline_resetattline + setLineAttributes = xform0 c_tattline_setlineattributes + setLineColor = xform1 c_tattline_setlinecolor + setLineStyle = xform1 c_tattline_setlinestyle + setLineWidth = xform1 c_tattline_setlinewidth +instance IDeletable TAttLine where + delete = xform0 c_tattline_delete + +instance ITAttLine (Exist TAttLine) where + getLineColor (ETAttLine x) = getLineColor x + getLineStyle (ETAttLine x) = getLineStyle x + getLineWidth (ETAttLine x) = getLineWidth x + resetAttLine (ETAttLine x) = resetAttLine x + setLineAttributes (ETAttLine x) = setLineAttributes x + setLineColor (ETAttLine x) = setLineColor x + setLineStyle (ETAttLine x) = setLineStyle x + setLineWidth (ETAttLine x) = setLineWidth x +instance IDeletable (Exist TAttLine) where + delete (ETAttLine x) = delete x + + +newTAttLine :: CInt -> CInt -> CInt -> IO TAttLine +newTAttLine = xform2 c_tattline_newtattline + +tAttLineDistancetoLine :: TAttLine -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CDouble -> IO CInt +tAttLineDistancetoLine = xform6 c_tattline_tattlinedistancetoline + + + +instance FPtr (Exist TAttLine) where + type Raw (Exist TAttLine) = RawTAttLine + get_fptr (ETAttLine obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETAttLine (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttLine) :: TAttLine) diff --git a/src/HROOT/Core/TAttLine/Interface.hs b/src/HROOT/Core/TAttLine/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttLine/Interface.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TAttLine.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttLine.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITAttLine a where + + getLineColor :: a -> IO CInt + + getLineStyle :: a -> IO CInt + + getLineWidth :: a -> IO CInt + + resetAttLine :: a -> CString -> IO () + + setLineAttributes :: a -> IO () + + setLineColor :: a -> CInt -> IO () + + setLineStyle :: a -> CInt -> IO () + + setLineWidth :: a -> CInt -> IO () + +instance Existable TAttLine where + data Exist TAttLine = forall a. (FPtr a, ITAttLine a) => ETAttLine a + +upcastTAttLine :: (FPtr a, ITAttLine a) => a -> TAttLine +upcastTAttLine h = let fh = get_fptr h + fh2 :: ForeignPtr RawTAttLine = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTAttLine :: (FPtr a, ITAttLine a) => TAttLine -> a +downcastTAttLine h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttLine/RawType.hs b/src/HROOT/Core/TAttLine/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttLine/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TAttLine.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTAttLine +newtype TAttLine = TAttLine (ForeignPtr RawTAttLine) deriving (Eq, Ord, Show) +instance FPtr TAttLine where + type Raw TAttLine = RawTAttLine + get_fptr (TAttLine fptr) = fptr + cast_fptr_to_obj = TAttLine diff --git a/src/HROOT/Core/TAttMarker.hs b/src/HROOT/Core/TAttMarker.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttMarker.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TAttMarker + ( + TAttMarker(..) + , ITAttMarker(..) + , upcastTAttMarker + , downcastTAttMarker + , newTAttMarker + + ) where + +import HROOT.Core.TAttMarker.RawType +import HROOT.Core.TAttMarker.Interface +import HROOT.Core.TAttMarker.Implementation + + diff --git a/src/HROOT/Core/TAttMarker/Cast.hs b/src/HROOT/Core/TAttMarker/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttMarker/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttMarker.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TAttMarker.RawType +import HROOT.Core.TAttMarker.Interface + +instance (ITAttMarker a, FPtr a) => Castable a (Ptr RawTAttMarker) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TAttMarker (Ptr RawTAttMarker) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TAttMarker/FFI.hsc b/src/HROOT/Core/TAttMarker/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttMarker/FFI.hsc @@ -0,0 +1,49 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TAttMarker.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TAttMarker.RawType + + +#include "HROOTCoreTAttMarker.h" + +foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_delete" c_tattmarker_delete + :: (Ptr RawTAttMarker) -> IO () + +foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_newTAttMarker" c_tattmarker_newtattmarker + :: CInt -> CInt -> CInt -> IO (Ptr RawTAttMarker) + +foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_GetMarkerColor" c_tattmarker_getmarkercolor + :: (Ptr RawTAttMarker) -> IO CInt + +foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_GetMarkerStyle" c_tattmarker_getmarkerstyle + :: (Ptr RawTAttMarker) -> IO CInt + +foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_GetMarkerSize" c_tattmarker_getmarkersize + :: (Ptr RawTAttMarker) -> IO CDouble + +foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_ResetAttMarker" c_tattmarker_resetattmarker + :: (Ptr RawTAttMarker) -> CString -> IO () + +foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_SetMarkerAttributes" c_tattmarker_setmarkerattributes + :: (Ptr RawTAttMarker) -> IO () + +foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_SetMarkerColor" c_tattmarker_setmarkercolor + :: (Ptr RawTAttMarker) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_SetMarkerStyle" c_tattmarker_setmarkerstyle + :: (Ptr RawTAttMarker) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_SetMarkerSize" c_tattmarker_setmarkersize + :: (Ptr RawTAttMarker) -> CInt -> IO () + diff --git a/src/HROOT/Core/TAttMarker/Implementation.hs b/src/HROOT/Core/TAttMarker/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttMarker/Implementation.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttMarker.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttMarker.RawType +import HROOT.Core.TAttMarker.FFI +import HROOT.Core.TAttMarker.Interface +import HROOT.Core.TAttMarker.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 ITAttMarker TAttMarker where + getMarkerColor = xform0 c_tattmarker_getmarkercolor + getMarkerStyle = xform0 c_tattmarker_getmarkerstyle + getMarkerSize = xform0 c_tattmarker_getmarkersize + resetAttMarker = xform1 c_tattmarker_resetattmarker + setMarkerAttributes = xform0 c_tattmarker_setmarkerattributes + setMarkerColor = xform1 c_tattmarker_setmarkercolor + setMarkerStyle = xform1 c_tattmarker_setmarkerstyle + setMarkerSize = xform1 c_tattmarker_setmarkersize +instance IDeletable TAttMarker where + delete = xform0 c_tattmarker_delete + +instance ITAttMarker (Exist TAttMarker) where + getMarkerColor (ETAttMarker x) = getMarkerColor x + getMarkerStyle (ETAttMarker x) = getMarkerStyle x + getMarkerSize (ETAttMarker x) = getMarkerSize x + resetAttMarker (ETAttMarker x) = resetAttMarker x + setMarkerAttributes (ETAttMarker x) = setMarkerAttributes x + setMarkerColor (ETAttMarker x) = setMarkerColor x + setMarkerStyle (ETAttMarker x) = setMarkerStyle x + setMarkerSize (ETAttMarker x) = setMarkerSize x +instance IDeletable (Exist TAttMarker) where + delete (ETAttMarker x) = delete x + + +newTAttMarker :: CInt -> CInt -> CInt -> IO TAttMarker +newTAttMarker = xform2 c_tattmarker_newtattmarker + + + + + +instance FPtr (Exist TAttMarker) where + type Raw (Exist TAttMarker) = RawTAttMarker + get_fptr (ETAttMarker obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETAttMarker (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttMarker) :: TAttMarker) diff --git a/src/HROOT/Core/TAttMarker/Interface.hs b/src/HROOT/Core/TAttMarker/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttMarker/Interface.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TAttMarker.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttMarker.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITAttMarker a where + + getMarkerColor :: a -> IO CInt + + getMarkerStyle :: a -> IO CInt + + getMarkerSize :: a -> IO CDouble + + resetAttMarker :: a -> CString -> IO () + + setMarkerAttributes :: a -> IO () + + setMarkerColor :: a -> CInt -> IO () + + setMarkerStyle :: a -> CInt -> IO () + + setMarkerSize :: a -> CInt -> IO () + +instance Existable TAttMarker where + data Exist TAttMarker = forall a. (FPtr a, ITAttMarker a) => ETAttMarker a + +upcastTAttMarker :: (FPtr a, ITAttMarker a) => a -> TAttMarker +upcastTAttMarker h = let fh = get_fptr h + fh2 :: ForeignPtr RawTAttMarker = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTAttMarker :: (FPtr a, ITAttMarker a) => TAttMarker -> a +downcastTAttMarker h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttMarker/RawType.hs b/src/HROOT/Core/TAttMarker/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttMarker/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TAttMarker.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTAttMarker +newtype TAttMarker = TAttMarker (ForeignPtr RawTAttMarker) deriving (Eq, Ord, Show) +instance FPtr TAttMarker where + type Raw TAttMarker = RawTAttMarker + get_fptr (TAttMarker fptr) = fptr + cast_fptr_to_obj = TAttMarker diff --git a/src/HROOT/Core/TAttPad.hs b/src/HROOT/Core/TAttPad.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttPad.hs @@ -0,0 +1,39 @@ +module HROOT.Core.TAttPad + ( + TAttPad(..) + , ITAttPad(..) + , upcastTAttPad + , downcastTAttPad + , newTAttPad + , tAttPadGetBottomMargin + , tAttPadGetLeftMargin + , tAttPadGetRightMargin + , tAttPadGetTopMargin + , tAttPadGetAfile + , tAttPadGetXfile + , tAttPadGetYfile + , tAttPadGetAstat + , tAttPadGetXstat + , tAttPadGetYstat + , tAttPadGetFrameFillColor + , tAttPadGetFrameLineColor + , tAttPadGetFrameFillStyle + , tAttPadGetFrameLineStyle + , tAttPadGetFrameLineWidth + , tAttPadGetFrameBorderSize + , tAttPadGetFrameBorderMode + , tAttPadSetFrameFillColor + , tAttPadSetFrameLineColor + , tAttPadSetFrameFillStyle + , tAttPadSetFrameLineStyle + , tAttPadSetFrameLineWidth + , tAttPadSetFrameBorderSize + , tAttPadSetFrameBorderMode + + ) where + +import HROOT.Core.TAttPad.RawType +import HROOT.Core.TAttPad.Interface +import HROOT.Core.TAttPad.Implementation + + diff --git a/src/HROOT/Core/TAttPad/Cast.hs b/src/HROOT/Core/TAttPad/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttPad/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttPad.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TAttPad.RawType +import HROOT.Core.TAttPad.Interface + +instance (ITAttPad a, FPtr a) => Castable a (Ptr RawTAttPad) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TAttPad (Ptr RawTAttPad) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TAttPad/FFI.hsc b/src/HROOT/Core/TAttPad/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttPad/FFI.hsc @@ -0,0 +1,133 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TAttPad.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TAttPad.RawType + + +#include "HROOTCoreTAttPad.h" + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_delete" c_tattpad_delete + :: (Ptr RawTAttPad) -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_newTAttPad" c_tattpad_newtattpad + :: IO (Ptr RawTAttPad) + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetBottomMargin" c_tattpad_tattpadgetbottommargin + :: (Ptr RawTAttPad) -> IO CDouble + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetLeftMargin" c_tattpad_tattpadgetleftmargin + :: (Ptr RawTAttPad) -> IO CDouble + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetRightMargin" c_tattpad_tattpadgetrightmargin + :: (Ptr RawTAttPad) -> IO CDouble + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetTopMargin" c_tattpad_tattpadgettopmargin + :: (Ptr RawTAttPad) -> IO CDouble + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetAfile" c_tattpad_tattpadgetafile + :: (Ptr RawTAttPad) -> IO CDouble + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetXfile" c_tattpad_tattpadgetxfile + :: (Ptr RawTAttPad) -> IO CDouble + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetYfile" c_tattpad_tattpadgetyfile + :: (Ptr RawTAttPad) -> IO CDouble + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetAstat" c_tattpad_tattpadgetastat + :: (Ptr RawTAttPad) -> IO CDouble + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetXstat" c_tattpad_tattpadgetxstat + :: (Ptr RawTAttPad) -> IO CDouble + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetYstat" c_tattpad_tattpadgetystat + :: (Ptr RawTAttPad) -> IO CDouble + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameFillColor" c_tattpad_tattpadgetframefillcolor + :: (Ptr RawTAttPad) -> IO CInt + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameLineColor" c_tattpad_tattpadgetframelinecolor + :: (Ptr RawTAttPad) -> IO CInt + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameFillStyle" c_tattpad_tattpadgetframefillstyle + :: (Ptr RawTAttPad) -> IO CInt + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameLineStyle" c_tattpad_tattpadgetframelinestyle + :: (Ptr RawTAttPad) -> IO CInt + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameLineWidth" c_tattpad_tattpadgetframelinewidth + :: (Ptr RawTAttPad) -> IO CInt + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameBorderSize" c_tattpad_tattpadgetframebordersize + :: (Ptr RawTAttPad) -> IO CInt + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameBorderMode" c_tattpad_tattpadgetframebordermode + :: (Ptr RawTAttPad) -> IO CInt + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_ResetAttPad" c_tattpad_resetattpad + :: (Ptr RawTAttPad) -> CString -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetBottomMargin" c_tattpad_setbottommargin + :: (Ptr RawTAttPad) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetLeftMargin" c_tattpad_setleftmargin + :: (Ptr RawTAttPad) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetRightMargin" c_tattpad_setrightmargin + :: (Ptr RawTAttPad) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetTopMargin" c_tattpad_settopmargin + :: (Ptr RawTAttPad) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetMargin" c_tattpad_setmargin + :: (Ptr RawTAttPad) -> CDouble -> CDouble -> CDouble -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetAfile" c_tattpad_setafile + :: (Ptr RawTAttPad) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetXfile" c_tattpad_setxfile + :: (Ptr RawTAttPad) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetYfile" c_tattpad_setyfile + :: (Ptr RawTAttPad) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetAstat" c_tattpad_setastat + :: (Ptr RawTAttPad) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetXstat" c_tattpad_setxstat + :: (Ptr RawTAttPad) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetYstat" c_tattpad_setystat + :: (Ptr RawTAttPad) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameFillColor" c_tattpad_tattpadsetframefillcolor + :: (Ptr RawTAttPad) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameLineColor" c_tattpad_tattpadsetframelinecolor + :: (Ptr RawTAttPad) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameFillStyle" c_tattpad_tattpadsetframefillstyle + :: (Ptr RawTAttPad) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameLineStyle" c_tattpad_tattpadsetframelinestyle + :: (Ptr RawTAttPad) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameLineWidth" c_tattpad_tattpadsetframelinewidth + :: (Ptr RawTAttPad) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameBorderSize" c_tattpad_tattpadsetframebordersize + :: (Ptr RawTAttPad) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameBorderMode" c_tattpad_tattpadsetframebordermode + :: (Ptr RawTAttPad) -> CInt -> IO () + diff --git a/src/HROOT/Core/TAttPad/Implementation.hs b/src/HROOT/Core/TAttPad/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttPad/Implementation.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttPad.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttPad.RawType +import HROOT.Core.TAttPad.FFI +import HROOT.Core.TAttPad.Interface +import HROOT.Core.TAttPad.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 ITAttPad TAttPad where + resetAttPad = xform1 c_tattpad_resetattpad + setBottomMargin = xform1 c_tattpad_setbottommargin + setLeftMargin = xform1 c_tattpad_setleftmargin + setRightMargin = xform1 c_tattpad_setrightmargin + setTopMargin = xform1 c_tattpad_settopmargin + setMargin = xform4 c_tattpad_setmargin + setAfile = xform1 c_tattpad_setafile + setXfile = xform1 c_tattpad_setxfile + setYfile = xform1 c_tattpad_setyfile + setAstat = xform1 c_tattpad_setastat + setXstat = xform1 c_tattpad_setxstat + setYstat = xform1 c_tattpad_setystat +instance IDeletable TAttPad where + delete = xform0 c_tattpad_delete + +instance ITAttPad (Exist TAttPad) where + resetAttPad (ETAttPad x) = resetAttPad x + setBottomMargin (ETAttPad x) = setBottomMargin x + setLeftMargin (ETAttPad x) = setLeftMargin x + setRightMargin (ETAttPad x) = setRightMargin x + setTopMargin (ETAttPad x) = setTopMargin x + setMargin (ETAttPad x) = setMargin x + setAfile (ETAttPad x) = setAfile x + setXfile (ETAttPad x) = setXfile x + setYfile (ETAttPad x) = setYfile x + setAstat (ETAttPad x) = setAstat x + setXstat (ETAttPad x) = setXstat x + setYstat (ETAttPad x) = setYstat x +instance IDeletable (Exist TAttPad) where + delete (ETAttPad x) = delete x + + +newTAttPad :: IO TAttPad +newTAttPad = xformnull c_tattpad_newtattpad + +tAttPadGetBottomMargin :: TAttPad -> IO CDouble +tAttPadGetBottomMargin = xform0 c_tattpad_tattpadgetbottommargin + +tAttPadGetLeftMargin :: TAttPad -> IO CDouble +tAttPadGetLeftMargin = xform0 c_tattpad_tattpadgetleftmargin + +tAttPadGetRightMargin :: TAttPad -> IO CDouble +tAttPadGetRightMargin = xform0 c_tattpad_tattpadgetrightmargin + +tAttPadGetTopMargin :: TAttPad -> IO CDouble +tAttPadGetTopMargin = xform0 c_tattpad_tattpadgettopmargin + +tAttPadGetAfile :: TAttPad -> IO CDouble +tAttPadGetAfile = xform0 c_tattpad_tattpadgetafile + +tAttPadGetXfile :: TAttPad -> IO CDouble +tAttPadGetXfile = xform0 c_tattpad_tattpadgetxfile + +tAttPadGetYfile :: TAttPad -> IO CDouble +tAttPadGetYfile = xform0 c_tattpad_tattpadgetyfile + +tAttPadGetAstat :: TAttPad -> IO CDouble +tAttPadGetAstat = xform0 c_tattpad_tattpadgetastat + +tAttPadGetXstat :: TAttPad -> IO CDouble +tAttPadGetXstat = xform0 c_tattpad_tattpadgetxstat + +tAttPadGetYstat :: TAttPad -> IO CDouble +tAttPadGetYstat = xform0 c_tattpad_tattpadgetystat + +tAttPadGetFrameFillColor :: TAttPad -> IO CInt +tAttPadGetFrameFillColor = xform0 c_tattpad_tattpadgetframefillcolor + +tAttPadGetFrameLineColor :: TAttPad -> IO CInt +tAttPadGetFrameLineColor = xform0 c_tattpad_tattpadgetframelinecolor + +tAttPadGetFrameFillStyle :: TAttPad -> IO CInt +tAttPadGetFrameFillStyle = xform0 c_tattpad_tattpadgetframefillstyle + +tAttPadGetFrameLineStyle :: TAttPad -> IO CInt +tAttPadGetFrameLineStyle = xform0 c_tattpad_tattpadgetframelinestyle + +tAttPadGetFrameLineWidth :: TAttPad -> IO CInt +tAttPadGetFrameLineWidth = xform0 c_tattpad_tattpadgetframelinewidth + +tAttPadGetFrameBorderSize :: TAttPad -> IO CInt +tAttPadGetFrameBorderSize = xform0 c_tattpad_tattpadgetframebordersize + +tAttPadGetFrameBorderMode :: TAttPad -> IO CInt +tAttPadGetFrameBorderMode = xform0 c_tattpad_tattpadgetframebordermode + +tAttPadSetFrameFillColor :: TAttPad -> CInt -> IO () +tAttPadSetFrameFillColor = xform1 c_tattpad_tattpadsetframefillcolor + +tAttPadSetFrameLineColor :: TAttPad -> CInt -> IO () +tAttPadSetFrameLineColor = xform1 c_tattpad_tattpadsetframelinecolor + +tAttPadSetFrameFillStyle :: TAttPad -> CInt -> IO () +tAttPadSetFrameFillStyle = xform1 c_tattpad_tattpadsetframefillstyle + +tAttPadSetFrameLineStyle :: TAttPad -> CInt -> IO () +tAttPadSetFrameLineStyle = xform1 c_tattpad_tattpadsetframelinestyle + +tAttPadSetFrameLineWidth :: TAttPad -> CInt -> IO () +tAttPadSetFrameLineWidth = xform1 c_tattpad_tattpadsetframelinewidth + +tAttPadSetFrameBorderSize :: TAttPad -> CInt -> IO () +tAttPadSetFrameBorderSize = xform1 c_tattpad_tattpadsetframebordersize + +tAttPadSetFrameBorderMode :: TAttPad -> CInt -> IO () +tAttPadSetFrameBorderMode = xform1 c_tattpad_tattpadsetframebordermode + + + +instance FPtr (Exist TAttPad) where + type Raw (Exist TAttPad) = RawTAttPad + get_fptr (ETAttPad obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETAttPad (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttPad) :: TAttPad) diff --git a/src/HROOT/Core/TAttPad/Interface.hs b/src/HROOT/Core/TAttPad/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttPad/Interface.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TAttPad.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttPad.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITAttPad a where + + resetAttPad :: a -> CString -> IO () + + setBottomMargin :: a -> CDouble -> IO () + + setLeftMargin :: a -> CDouble -> IO () + + setRightMargin :: a -> CDouble -> IO () + + setTopMargin :: a -> CDouble -> IO () + + setMargin :: a -> CDouble -> CDouble -> CDouble -> CDouble -> IO () + + setAfile :: a -> CDouble -> IO () + + setXfile :: a -> CDouble -> IO () + + setYfile :: a -> CDouble -> IO () + + setAstat :: a -> CDouble -> IO () + + setXstat :: a -> CDouble -> IO () + + setYstat :: a -> CDouble -> IO () + +instance Existable TAttPad where + data Exist TAttPad = forall a. (FPtr a, ITAttPad a) => ETAttPad a + +upcastTAttPad :: (FPtr a, ITAttPad a) => a -> TAttPad +upcastTAttPad h = let fh = get_fptr h + fh2 :: ForeignPtr RawTAttPad = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTAttPad :: (FPtr a, ITAttPad a) => TAttPad -> a +downcastTAttPad h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttPad/RawType.hs b/src/HROOT/Core/TAttPad/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttPad/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TAttPad.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTAttPad +newtype TAttPad = TAttPad (ForeignPtr RawTAttPad) deriving (Eq, Ord, Show) +instance FPtr TAttPad where + type Raw TAttPad = RawTAttPad + get_fptr (TAttPad fptr) = fptr + cast_fptr_to_obj = TAttPad diff --git a/src/HROOT/Core/TAttText.hs b/src/HROOT/Core/TAttText.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttText.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TAttText + ( + TAttText(..) + , ITAttText(..) + , upcastTAttText + , downcastTAttText + , newTAttText + + ) where + +import HROOT.Core.TAttText.RawType +import HROOT.Core.TAttText.Interface +import HROOT.Core.TAttText.Implementation + + diff --git a/src/HROOT/Core/TAttText/Cast.hs b/src/HROOT/Core/TAttText/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttText/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttText.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TAttText.RawType +import HROOT.Core.TAttText.Interface + +instance (ITAttText a, FPtr a) => Castable a (Ptr RawTAttText) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TAttText (Ptr RawTAttText) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TAttText/FFI.hsc b/src/HROOT/Core/TAttText/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttText/FFI.hsc @@ -0,0 +1,64 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TAttText.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TAttText.RawType + + +#include "HROOTCoreTAttText.h" + +foreign import ccall "HROOTCoreTAttText.h TAttText_delete" c_tatttext_delete + :: (Ptr RawTAttText) -> IO () + +foreign import ccall "HROOTCoreTAttText.h TAttText_newTAttText" c_tatttext_newtatttext + :: CInt -> CDouble -> CInt -> CInt -> CDouble -> IO (Ptr RawTAttText) + +foreign import ccall "HROOTCoreTAttText.h TAttText_GetTextAlign" c_tatttext_gettextalign + :: (Ptr RawTAttText) -> IO CInt + +foreign import ccall "HROOTCoreTAttText.h TAttText_GetTextAngle" c_tatttext_gettextangle + :: (Ptr RawTAttText) -> IO CDouble + +foreign import ccall "HROOTCoreTAttText.h TAttText_GetTextColor" c_tatttext_gettextcolor + :: (Ptr RawTAttText) -> IO CInt + +foreign import ccall "HROOTCoreTAttText.h TAttText_GetTextFont" c_tatttext_gettextfont + :: (Ptr RawTAttText) -> IO CInt + +foreign import ccall "HROOTCoreTAttText.h TAttText_GetTextSize" c_tatttext_gettextsize + :: (Ptr RawTAttText) -> IO CDouble + +foreign import ccall "HROOTCoreTAttText.h TAttText_ResetAttText" c_tatttext_resetatttext + :: (Ptr RawTAttText) -> CString -> IO () + +foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextAttributes" c_tatttext_settextattributes + :: (Ptr RawTAttText) -> IO () + +foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextAlign" c_tatttext_settextalign + :: (Ptr RawTAttText) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextAngle" c_tatttext_settextangle + :: (Ptr RawTAttText) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextColor" c_tatttext_settextcolor + :: (Ptr RawTAttText) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextFont" c_tatttext_settextfont + :: (Ptr RawTAttText) -> CInt -> IO () + +foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextSize" c_tatttext_settextsize + :: (Ptr RawTAttText) -> CDouble -> IO () + +foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextSizePixels" c_tatttext_settextsizepixels + :: (Ptr RawTAttText) -> CInt -> IO () + diff --git a/src/HROOT/Core/TAttText/Implementation.hs b/src/HROOT/Core/TAttText/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttText/Implementation.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TAttText.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttText.RawType +import HROOT.Core.TAttText.FFI +import HROOT.Core.TAttText.Interface +import HROOT.Core.TAttText.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 ITAttText TAttText where + getTextAlign = xform0 c_tatttext_gettextalign + getTextAngle = xform0 c_tatttext_gettextangle + getTextColor = xform0 c_tatttext_gettextcolor + getTextFont = xform0 c_tatttext_gettextfont + getTextSize = xform0 c_tatttext_gettextsize + resetAttText = xform1 c_tatttext_resetatttext + setTextAttributes = xform0 c_tatttext_settextattributes + setTextAlign = xform1 c_tatttext_settextalign + setTextAngle = xform1 c_tatttext_settextangle + setTextColor = xform1 c_tatttext_settextcolor + setTextFont = xform1 c_tatttext_settextfont + setTextSize = xform1 c_tatttext_settextsize + setTextSizePixels = xform1 c_tatttext_settextsizepixels +instance IDeletable TAttText where + delete = xform0 c_tatttext_delete + +instance ITAttText (Exist TAttText) where + getTextAlign (ETAttText x) = getTextAlign x + getTextAngle (ETAttText x) = getTextAngle x + getTextColor (ETAttText x) = getTextColor x + getTextFont (ETAttText x) = getTextFont x + getTextSize (ETAttText x) = getTextSize x + resetAttText (ETAttText x) = resetAttText x + setTextAttributes (ETAttText x) = setTextAttributes x + setTextAlign (ETAttText x) = setTextAlign x + setTextAngle (ETAttText x) = setTextAngle x + setTextColor (ETAttText x) = setTextColor x + setTextFont (ETAttText x) = setTextFont x + setTextSize (ETAttText x) = setTextSize x + setTextSizePixels (ETAttText x) = setTextSizePixels x +instance IDeletable (Exist TAttText) where + delete (ETAttText x) = delete x + + +newTAttText :: CInt -> CDouble -> CInt -> CInt -> CDouble -> IO TAttText +newTAttText = xform4 c_tatttext_newtatttext + + + + + +instance FPtr (Exist TAttText) where + type Raw (Exist TAttText) = RawTAttText + get_fptr (ETAttText obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETAttText (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttText) :: TAttText) diff --git a/src/HROOT/Core/TAttText/Interface.hs b/src/HROOT/Core/TAttText/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttText/Interface.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TAttText.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TAttText.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITAttText a where + + getTextAlign :: a -> IO CInt + + getTextAngle :: a -> IO CDouble + + getTextColor :: a -> IO CInt + + getTextFont :: a -> IO CInt + + getTextSize :: a -> IO CDouble + + resetAttText :: a -> CString -> IO () + + setTextAttributes :: a -> IO () + + setTextAlign :: a -> CInt -> IO () + + setTextAngle :: a -> CDouble -> IO () + + setTextColor :: a -> CInt -> IO () + + setTextFont :: a -> CInt -> IO () + + setTextSize :: a -> CDouble -> IO () + + setTextSizePixels :: a -> CInt -> IO () + +instance Existable TAttText where + data Exist TAttText = forall a. (FPtr a, ITAttText a) => ETAttText a + +upcastTAttText :: (FPtr a, ITAttText a) => a -> TAttText +upcastTAttText h = let fh = get_fptr h + fh2 :: ForeignPtr RawTAttText = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTAttText :: (FPtr a, ITAttText a) => TAttText -> a +downcastTAttText h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttText/RawType.hs b/src/HROOT/Core/TAttText/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TAttText/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TAttText.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTAttText +newtype TAttText = TAttText (ForeignPtr RawTAttText) deriving (Eq, Ord, Show) +instance FPtr TAttText where + type Raw TAttText = RawTAttText + get_fptr (TAttText fptr) = fptr + cast_fptr_to_obj = TAttText diff --git a/src/HROOT/Core/TClass.hs b/src/HROOT/Core/TClass.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TClass.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TClass + ( + TClass(..) + , ITClass + , upcastTClass + , downcastTClass + + + ) where + +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Interface +import HROOT.Core.TClass.Implementation + + diff --git a/src/HROOT/Core/TClass/Cast.hs b/src/HROOT/Core/TClass/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TClass/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TClass.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Interface + +instance (ITClass a, FPtr a) => Castable a (Ptr RawTClass) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TClass (Ptr RawTClass) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TClass/FFI.hsc b/src/HROOT/Core/TClass/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TClass/FFI.hsc @@ -0,0 +1,55 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TClass.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TClass.RawType +import HROOT.Core.TObject.RawType + +#include "HROOTCoreTClass.h" + +foreign import ccall "HROOTCoreTClass.h TClass_SetName" c_tclass_setname + :: (Ptr RawTClass) -> CString -> IO () + +foreign import ccall "HROOTCoreTClass.h TClass_SetNameTitle" c_tclass_setnametitle + :: (Ptr RawTClass) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTClass.h TClass_SetTitle" c_tclass_settitle + :: (Ptr RawTClass) -> CString -> IO () + +foreign import ccall "HROOTCoreTClass.h TClass_Draw" c_tclass_draw + :: (Ptr RawTClass) -> CString -> IO () + +foreign import ccall "HROOTCoreTClass.h TClass_FindObject" c_tclass_findobject + :: (Ptr RawTClass) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTClass.h TClass_GetName" c_tclass_getname + :: (Ptr RawTClass) -> IO CString + +foreign import ccall "HROOTCoreTClass.h TClass_IsA" c_tclass_isa + :: (Ptr RawTClass) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTClass.h TClass_Paint" c_tclass_paint + :: (Ptr RawTClass) -> CString -> IO () + +foreign import ccall "HROOTCoreTClass.h TClass_printObj" c_tclass_printobj + :: (Ptr RawTClass) -> CString -> IO () + +foreign import ccall "HROOTCoreTClass.h TClass_SaveAs" c_tclass_saveas + :: (Ptr RawTClass) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTClass.h TClass_Write" c_tclass_write + :: (Ptr RawTClass) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTClass.h TClass_delete" c_tclass_delete + :: (Ptr RawTClass) -> IO () + diff --git a/src/HROOT/Core/TClass/Implementation.hs b/src/HROOT/Core/TClass/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TClass/Implementation.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TClass.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.FFI +import HROOT.Core.TClass.Interface +import HROOT.Core.TClass.Cast + +import HROOT.Core.TDictionary.RawType +import HROOT.Core.TDictionary.Cast +import HROOT.Core.TDictionary.Interface +import HROOT.Core.TNamed.RawType +import HROOT.Core.TNamed.Cast +import HROOT.Core.TNamed.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITClass TClass where +instance ITDictionary TClass where +instance ITNamed TClass where + setName = xform1 c_tclass_setname + setNameTitle = xform2 c_tclass_setnametitle + setTitle = xform1 c_tclass_settitle +instance ITObject TClass where + draw = xform1 c_tclass_draw + findObject = xform1 c_tclass_findobject + getName = xform0 c_tclass_getname + isA = xform0 c_tclass_isa + paint = xform1 c_tclass_paint + printObj = xform1 c_tclass_printobj + saveAs = xform2 c_tclass_saveas + write = xform3 c_tclass_write +instance IDeletable TClass where + delete = xform0 c_tclass_delete + +instance ITClass (Exist TClass) where + +instance ITDictionary (Exist TClass) where + +instance ITNamed (Exist TClass) where + setName (ETClass x) = setName x + setNameTitle (ETClass x) = setNameTitle x + setTitle (ETClass x) = setTitle x +instance ITObject (Exist TClass) where + draw (ETClass x) = draw x + findObject (ETClass x) = findObject x + getName (ETClass x) = getName x + isA (ETClass x) = isA x + paint (ETClass x) = paint x + printObj (ETClass x) = printObj x + saveAs (ETClass x) = saveAs x + write (ETClass x) = write x +instance IDeletable (Exist TClass) where + delete (ETClass x) = delete x + + + + + + + +instance FPtr (Exist TClass) where + type Raw (Exist TClass) = RawTClass + get_fptr (ETClass obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETClass (cast_fptr_to_obj (fptr :: ForeignPtr RawTClass) :: TClass) diff --git a/src/HROOT/Core/TClass/Interface.hs b/src/HROOT/Core/TClass/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TClass/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TClass.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TClass.RawType + +import HROOT.Core.TDictionary.Interface +---- ============ ---- + + + +class (ITDictionary a) => ITClass a where + +instance Existable TClass where + data Exist TClass = forall a. (FPtr a, ITClass a) => ETClass a + +upcastTClass :: (FPtr a, ITClass a) => a -> TClass +upcastTClass h = let fh = get_fptr h + fh2 :: ForeignPtr RawTClass = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTClass :: (FPtr a, ITClass a) => TClass -> a +downcastTClass h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TClass/RawType.hs b/src/HROOT/Core/TClass/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TClass/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TClass.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTClass +newtype TClass = TClass (ForeignPtr RawTClass) deriving (Eq, Ord, Show) +instance FPtr TClass where + type Raw TClass = RawTClass + get_fptr (TClass fptr) = fptr + cast_fptr_to_obj = TClass diff --git a/src/HROOT/Core/TCollection.hs b/src/HROOT/Core/TCollection.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TCollection.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TCollection + ( + TCollection(..) + , ITCollection + , upcastTCollection + , downcastTCollection + + + ) where + +import HROOT.Core.TCollection.RawType +import HROOT.Core.TCollection.Interface +import HROOT.Core.TCollection.Implementation + + diff --git a/src/HROOT/Core/TCollection/Cast.hs b/src/HROOT/Core/TCollection/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TCollection/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TCollection.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TCollection.RawType +import HROOT.Core.TCollection.Interface + +instance (ITCollection a, FPtr a) => Castable a (Ptr RawTCollection) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TCollection (Ptr RawTCollection) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TCollection/FFI.hsc b/src/HROOT/Core/TCollection/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TCollection/FFI.hsc @@ -0,0 +1,47 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TCollection.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TCollection.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTCollection.h" + +foreign import ccall "HROOTCoreTCollection.h TCollection_Draw" c_tcollection_draw + :: (Ptr RawTCollection) -> CString -> IO () + +foreign import ccall "HROOTCoreTCollection.h TCollection_FindObject" c_tcollection_findobject + :: (Ptr RawTCollection) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTCollection.h TCollection_GetName" c_tcollection_getname + :: (Ptr RawTCollection) -> IO CString + +foreign import ccall "HROOTCoreTCollection.h TCollection_IsA" c_tcollection_isa + :: (Ptr RawTCollection) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTCollection.h TCollection_Paint" c_tcollection_paint + :: (Ptr RawTCollection) -> CString -> IO () + +foreign import ccall "HROOTCoreTCollection.h TCollection_printObj" c_tcollection_printobj + :: (Ptr RawTCollection) -> CString -> IO () + +foreign import ccall "HROOTCoreTCollection.h TCollection_SaveAs" c_tcollection_saveas + :: (Ptr RawTCollection) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTCollection.h TCollection_Write" c_tcollection_write + :: (Ptr RawTCollection) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTCollection.h TCollection_delete" c_tcollection_delete + :: (Ptr RawTCollection) -> IO () + diff --git a/src/HROOT/Core/TCollection/Implementation.hs b/src/HROOT/Core/TCollection/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TCollection/Implementation.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TCollection.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TCollection.RawType +import HROOT.Core.TCollection.FFI +import HROOT.Core.TCollection.Interface +import HROOT.Core.TCollection.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITCollection TCollection where +instance ITObject TCollection where + draw = xform1 c_tcollection_draw + findObject = xform1 c_tcollection_findobject + getName = xform0 c_tcollection_getname + isA = xform0 c_tcollection_isa + paint = xform1 c_tcollection_paint + printObj = xform1 c_tcollection_printobj + saveAs = xform2 c_tcollection_saveas + write = xform3 c_tcollection_write +instance IDeletable TCollection where + delete = xform0 c_tcollection_delete + +instance ITCollection (Exist TCollection) where + +instance ITObject (Exist TCollection) where + draw (ETCollection x) = draw x + findObject (ETCollection x) = findObject x + getName (ETCollection x) = getName x + isA (ETCollection x) = isA x + paint (ETCollection x) = paint x + printObj (ETCollection x) = printObj x + saveAs (ETCollection x) = saveAs x + write (ETCollection x) = write x +instance IDeletable (Exist TCollection) where + delete (ETCollection x) = delete x + + + + + + + +instance FPtr (Exist TCollection) where + type Raw (Exist TCollection) = RawTCollection + get_fptr (ETCollection obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETCollection (cast_fptr_to_obj (fptr :: ForeignPtr RawTCollection) :: TCollection) diff --git a/src/HROOT/Core/TCollection/Interface.hs b/src/HROOT/Core/TCollection/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TCollection/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TCollection.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TCollection.RawType + +import HROOT.Core.TObject.Interface +---- ============ ---- + + + +class (ITObject a) => ITCollection a where + +instance Existable TCollection where + data Exist TCollection = forall a. (FPtr a, ITCollection a) => ETCollection a + +upcastTCollection :: (FPtr a, ITCollection a) => a -> TCollection +upcastTCollection h = let fh = get_fptr h + fh2 :: ForeignPtr RawTCollection = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTCollection :: (FPtr a, ITCollection a) => TCollection -> a +downcastTCollection h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TCollection/RawType.hs b/src/HROOT/Core/TCollection/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TCollection/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TCollection.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTCollection +newtype TCollection = TCollection (ForeignPtr RawTCollection) deriving (Eq, Ord, Show) +instance FPtr TCollection where + type Raw TCollection = RawTCollection + get_fptr (TCollection fptr) = fptr + cast_fptr_to_obj = TCollection diff --git a/src/HROOT/Core/TDictionary.hs b/src/HROOT/Core/TDictionary.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDictionary.hs @@ -0,0 +1,10 @@ +module HROOT.Core.TDictionary + ( + ITDictionary + ) where + +import HROOT.Core.TDictionary.RawType +import HROOT.Core.TDictionary.Interface +import HROOT.Core.TDictionary.Implementation + + diff --git a/src/HROOT/Core/TDictionary/Cast.hs b/src/HROOT/Core/TDictionary/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDictionary/Cast.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TDictionary.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TDictionary.RawType +import HROOT.Core.TDictionary.Interface + + + + diff --git a/src/HROOT/Core/TDictionary/FFI.hsc b/src/HROOT/Core/TDictionary/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDictionary/FFI.hsc @@ -0,0 +1,44 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TDictionary.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TDictionary.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTDictionary.h" + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/HROOT/Core/TDictionary/Implementation.hs b/src/HROOT/Core/TDictionary/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDictionary/Implementation.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TDictionary.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TDictionary.RawType +import HROOT.Core.TDictionary.FFI +import HROOT.Core.TDictionary.Interface +import HROOT.Core.TDictionary.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TNamed.RawType +import HROOT.Core.TNamed.Cast +import HROOT.Core.TNamed.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 + + + + + + + + + + + + + + + + diff --git a/src/HROOT/Core/TDictionary/Interface.hs b/src/HROOT/Core/TDictionary/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDictionary/Interface.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TDictionary.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TDictionary.RawType + +import HROOT.Core.TNamed.Interface +---- ============ ---- + + + +class (ITNamed a) => ITDictionary a where + + + + + + diff --git a/src/HROOT/Core/TDictionary/RawType.hs b/src/HROOT/Core/TDictionary/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDictionary/RawType.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TDictionary.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + + diff --git a/src/HROOT/Core/TDirectory.hs b/src/HROOT/Core/TDirectory.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDirectory.hs @@ -0,0 +1,16 @@ +module HROOT.Core.TDirectory + ( + TDirectory(..) + , ITDirectory(..) + , upcastTDirectory + , downcastTDirectory + + , tDirectoryAddDirectory + , tDirectoryAddDirectoryStatus + ) where + +import HROOT.Core.TDirectory.RawType +import HROOT.Core.TDirectory.Interface +import HROOT.Core.TDirectory.Implementation + + diff --git a/src/HROOT/Core/TDirectory/Cast.hs b/src/HROOT/Core/TDirectory/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDirectory/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TDirectory.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TDirectory.RawType +import HROOT.Core.TDirectory.Interface + +instance (ITDirectory a, FPtr a) => Castable a (Ptr RawTDirectory) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TDirectory (Ptr RawTDirectory) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TDirectory/FFI.hsc b/src/HROOT/Core/TDirectory/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDirectory/FFI.hsc @@ -0,0 +1,81 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TDirectory.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TDirectory.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType +import HROOT.Core.TKey.RawType + +#include "HROOTCoreTDirectory.h" + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_SetName" c_tdirectory_setname + :: (Ptr RawTDirectory) -> CString -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_SetNameTitle" c_tdirectory_setnametitle + :: (Ptr RawTDirectory) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_SetTitle" c_tdirectory_settitle + :: (Ptr RawTDirectory) -> CString -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_Draw" c_tdirectory_draw + :: (Ptr RawTDirectory) -> CString -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_FindObject" c_tdirectory_findobject + :: (Ptr RawTDirectory) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_GetName" c_tdirectory_getname + :: (Ptr RawTDirectory) -> IO CString + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_IsA" c_tdirectory_isa + :: (Ptr RawTDirectory) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_Paint" c_tdirectory_paint + :: (Ptr RawTDirectory) -> CString -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_printObj" c_tdirectory_printobj + :: (Ptr RawTDirectory) -> CString -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_SaveAs" c_tdirectory_saveas + :: (Ptr RawTDirectory) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_Write" c_tdirectory_write + :: (Ptr RawTDirectory) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_delete" c_tdirectory_delete + :: (Ptr RawTDirectory) -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_tDirectoryAddDirectory" c_tdirectory_tdirectoryadddirectory + :: CInt -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_tDirectoryAddDirectoryStatus" c_tdirectory_tdirectoryadddirectorystatus + :: IO CInt + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_Append" c_tdirectory_append + :: (Ptr RawTDirectory) -> (Ptr RawTObject) -> CInt -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_addD" c_tdirectory_addd + :: (Ptr RawTDirectory) -> (Ptr RawTObject) -> CInt -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_AppendKey" c_tdirectory_appendkey + :: (Ptr RawTDirectory) -> (Ptr RawTKey) -> IO CInt + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_Close" c_tdirectory_close + :: (Ptr RawTDirectory) -> CString -> IO () + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_Get" c_tdirectory_get + :: (Ptr RawTDirectory) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTDirectory.h TDirectory_cd_TDirectory" c_tdirectory_cd_tdirectory + :: (Ptr RawTDirectory) -> CString -> IO CInt + diff --git a/src/HROOT/Core/TDirectory/Implementation.hs b/src/HROOT/Core/TDirectory/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDirectory/Implementation.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TDirectory.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TDirectory.RawType +import HROOT.Core.TDirectory.FFI +import HROOT.Core.TDirectory.Interface +import HROOT.Core.TDirectory.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TKey.RawType +import HROOT.Core.TKey.Cast +import HROOT.Core.TKey.Interface +import HROOT.Core.TNamed.RawType +import HROOT.Core.TNamed.Cast +import HROOT.Core.TNamed.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITDirectory TDirectory where + append = xform2 c_tdirectory_append + addD = xform2 c_tdirectory_addd + appendKey = xform1 c_tdirectory_appendkey + close = xform1 c_tdirectory_close + get = xform1 c_tdirectory_get + cd_TDirectory = xform1 c_tdirectory_cd_tdirectory +instance ITNamed TDirectory where + setName = xform1 c_tdirectory_setname + setNameTitle = xform2 c_tdirectory_setnametitle + setTitle = xform1 c_tdirectory_settitle +instance ITObject TDirectory where + draw = xform1 c_tdirectory_draw + findObject = xform1 c_tdirectory_findobject + getName = xform0 c_tdirectory_getname + isA = xform0 c_tdirectory_isa + paint = xform1 c_tdirectory_paint + printObj = xform1 c_tdirectory_printobj + saveAs = xform2 c_tdirectory_saveas + write = xform3 c_tdirectory_write +instance IDeletable TDirectory where + delete = xform0 c_tdirectory_delete + +instance ITDirectory (Exist TDirectory) where + append (ETDirectory x) = append x + addD (ETDirectory x) = addD x + appendKey (ETDirectory x) = appendKey x + close (ETDirectory x) = close x + get (ETDirectory x) = get x + cd_TDirectory (ETDirectory x) = cd_TDirectory x +instance ITNamed (Exist TDirectory) where + setName (ETDirectory x) = setName x + setNameTitle (ETDirectory x) = setNameTitle x + setTitle (ETDirectory x) = setTitle x +instance ITObject (Exist TDirectory) where + draw (ETDirectory x) = draw x + findObject (ETDirectory x) = findObject x + getName (ETDirectory x) = getName x + isA (ETDirectory x) = isA x + paint (ETDirectory x) = paint x + printObj (ETDirectory x) = printObj x + saveAs (ETDirectory x) = saveAs x + write (ETDirectory x) = write x +instance IDeletable (Exist TDirectory) where + delete (ETDirectory x) = delete x + + + + + +tDirectoryAddDirectory :: CInt -> IO () +tDirectoryAddDirectory = xform0 c_tdirectory_tdirectoryadddirectory + +tDirectoryAddDirectoryStatus :: IO CInt +tDirectoryAddDirectoryStatus = xformnull c_tdirectory_tdirectoryadddirectorystatus + +instance FPtr (Exist TDirectory) where + type Raw (Exist TDirectory) = RawTDirectory + get_fptr (ETDirectory obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETDirectory (cast_fptr_to_obj (fptr :: ForeignPtr RawTDirectory) :: TDirectory) diff --git a/src/HROOT/Core/TDirectory/Interface.hs b/src/HROOT/Core/TDirectory/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDirectory/Interface.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TDirectory.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TDirectory.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TNamed.Interface +---- ============ ---- +import {-# SOURCE #-} HROOT.Core.TObject.Interface +import {-# SOURCE #-} HROOT.Core.TKey.Interface + + +class (ITNamed a) => ITDirectory a where + + append :: (ITObject c0, FPtr c0) => a -> c0 -> CInt -> IO () + + addD :: (ITObject c0, FPtr c0) => a -> c0 -> CInt -> IO () + + appendKey :: (ITKey c0, FPtr c0) => a -> c0 -> IO CInt + + close :: a -> CString -> IO () + + get :: a -> CString -> IO TObject + + cd_TDirectory :: a -> CString -> IO CInt + +instance Existable TDirectory where + data Exist TDirectory = forall a. (FPtr a, ITDirectory a) => ETDirectory a + +upcastTDirectory :: (FPtr a, ITDirectory a) => a -> TDirectory +upcastTDirectory h = let fh = get_fptr h + fh2 :: ForeignPtr RawTDirectory = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTDirectory :: (FPtr a, ITDirectory a) => TDirectory -> a +downcastTDirectory h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TDirectory/RawType.hs b/src/HROOT/Core/TDirectory/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDirectory/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TDirectory.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTDirectory +newtype TDirectory = TDirectory (ForeignPtr RawTDirectory) deriving (Eq, Ord, Show) +instance FPtr TDirectory where + type Raw TDirectory = RawTDirectory + get_fptr (TDirectory fptr) = fptr + cast_fptr_to_obj = TDirectory diff --git a/src/HROOT/Core/TGlobal.hs b/src/HROOT/Core/TGlobal.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TGlobal.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TGlobal + ( + TGlobal(..) + , ITGlobal + , upcastTGlobal + , downcastTGlobal + + + ) where + +import HROOT.Core.TGlobal.RawType +import HROOT.Core.TGlobal.Interface +import HROOT.Core.TGlobal.Implementation + + diff --git a/src/HROOT/Core/TGlobal/Cast.hs b/src/HROOT/Core/TGlobal/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TGlobal/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TGlobal.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TGlobal.RawType +import HROOT.Core.TGlobal.Interface + +instance (ITGlobal a, FPtr a) => Castable a (Ptr RawTGlobal) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TGlobal (Ptr RawTGlobal) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TGlobal/FFI.hsc b/src/HROOT/Core/TGlobal/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TGlobal/FFI.hsc @@ -0,0 +1,56 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TGlobal.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TGlobal.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTGlobal.h" + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_SetName" c_tglobal_setname + :: (Ptr RawTGlobal) -> CString -> IO () + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_SetNameTitle" c_tglobal_setnametitle + :: (Ptr RawTGlobal) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_SetTitle" c_tglobal_settitle + :: (Ptr RawTGlobal) -> CString -> IO () + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_Draw" c_tglobal_draw + :: (Ptr RawTGlobal) -> CString -> IO () + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_FindObject" c_tglobal_findobject + :: (Ptr RawTGlobal) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_GetName" c_tglobal_getname + :: (Ptr RawTGlobal) -> IO CString + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_IsA" c_tglobal_isa + :: (Ptr RawTGlobal) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_Paint" c_tglobal_paint + :: (Ptr RawTGlobal) -> CString -> IO () + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_printObj" c_tglobal_printobj + :: (Ptr RawTGlobal) -> CString -> IO () + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_SaveAs" c_tglobal_saveas + :: (Ptr RawTGlobal) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_Write" c_tglobal_write + :: (Ptr RawTGlobal) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTGlobal.h TGlobal_delete" c_tglobal_delete + :: (Ptr RawTGlobal) -> IO () + diff --git a/src/HROOT/Core/TGlobal/Implementation.hs b/src/HROOT/Core/TGlobal/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TGlobal/Implementation.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TGlobal.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TGlobal.RawType +import HROOT.Core.TGlobal.FFI +import HROOT.Core.TGlobal.Interface +import HROOT.Core.TGlobal.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TDictionary.RawType +import HROOT.Core.TDictionary.Cast +import HROOT.Core.TDictionary.Interface +import HROOT.Core.TNamed.RawType +import HROOT.Core.TNamed.Cast +import HROOT.Core.TNamed.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITGlobal TGlobal where +instance ITDictionary TGlobal where +instance ITNamed TGlobal where + setName = xform1 c_tglobal_setname + setNameTitle = xform2 c_tglobal_setnametitle + setTitle = xform1 c_tglobal_settitle +instance ITObject TGlobal where + draw = xform1 c_tglobal_draw + findObject = xform1 c_tglobal_findobject + getName = xform0 c_tglobal_getname + isA = xform0 c_tglobal_isa + paint = xform1 c_tglobal_paint + printObj = xform1 c_tglobal_printobj + saveAs = xform2 c_tglobal_saveas + write = xform3 c_tglobal_write +instance IDeletable TGlobal where + delete = xform0 c_tglobal_delete + +instance ITGlobal (Exist TGlobal) where + +instance ITDictionary (Exist TGlobal) where + +instance ITNamed (Exist TGlobal) where + setName (ETGlobal x) = setName x + setNameTitle (ETGlobal x) = setNameTitle x + setTitle (ETGlobal x) = setTitle x +instance ITObject (Exist TGlobal) where + draw (ETGlobal x) = draw x + findObject (ETGlobal x) = findObject x + getName (ETGlobal x) = getName x + isA (ETGlobal x) = isA x + paint (ETGlobal x) = paint x + printObj (ETGlobal x) = printObj x + saveAs (ETGlobal x) = saveAs x + write (ETGlobal x) = write x +instance IDeletable (Exist TGlobal) where + delete (ETGlobal x) = delete x + + + + + + + +instance FPtr (Exist TGlobal) where + type Raw (Exist TGlobal) = RawTGlobal + get_fptr (ETGlobal obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETGlobal (cast_fptr_to_obj (fptr :: ForeignPtr RawTGlobal) :: TGlobal) diff --git a/src/HROOT/Core/TGlobal/Interface.hs b/src/HROOT/Core/TGlobal/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TGlobal/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TGlobal.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TGlobal.RawType + +import HROOT.Core.TDictionary.Interface +---- ============ ---- + + + +class (ITDictionary a) => ITGlobal a where + +instance Existable TGlobal where + data Exist TGlobal = forall a. (FPtr a, ITGlobal a) => ETGlobal a + +upcastTGlobal :: (FPtr a, ITGlobal a) => a -> TGlobal +upcastTGlobal h = let fh = get_fptr h + fh2 :: ForeignPtr RawTGlobal = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTGlobal :: (FPtr a, ITGlobal a) => TGlobal -> a +downcastTGlobal h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TGlobal/RawType.hs b/src/HROOT/Core/TGlobal/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TGlobal/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TGlobal.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTGlobal +newtype TGlobal = TGlobal (ForeignPtr RawTGlobal) deriving (Eq, Ord, Show) +instance FPtr TGlobal where + type Raw TGlobal = RawTGlobal + get_fptr (TGlobal fptr) = fptr + cast_fptr_to_obj = TGlobal diff --git a/src/HROOT/Core/TKey.hs b/src/HROOT/Core/TKey.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TKey.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TKey + ( + TKey(..) + , ITKey + , upcastTKey + , downcastTKey + + + ) where + +import HROOT.Core.TKey.RawType +import HROOT.Core.TKey.Interface +import HROOT.Core.TKey.Implementation + + diff --git a/src/HROOT/Core/TKey/Cast.hs b/src/HROOT/Core/TKey/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TKey/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TKey.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TKey.RawType +import HROOT.Core.TKey.Interface + +instance (ITKey a, FPtr a) => Castable a (Ptr RawTKey) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TKey (Ptr RawTKey) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TKey/FFI.hsc b/src/HROOT/Core/TKey/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TKey/FFI.hsc @@ -0,0 +1,56 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TKey.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TKey.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTKey.h" + +foreign import ccall "HROOTCoreTKey.h TKey_SetName" c_tkey_setname + :: (Ptr RawTKey) -> CString -> IO () + +foreign import ccall "HROOTCoreTKey.h TKey_SetNameTitle" c_tkey_setnametitle + :: (Ptr RawTKey) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTKey.h TKey_SetTitle" c_tkey_settitle + :: (Ptr RawTKey) -> CString -> IO () + +foreign import ccall "HROOTCoreTKey.h TKey_Draw" c_tkey_draw + :: (Ptr RawTKey) -> CString -> IO () + +foreign import ccall "HROOTCoreTKey.h TKey_FindObject" c_tkey_findobject + :: (Ptr RawTKey) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTKey.h TKey_GetName" c_tkey_getname + :: (Ptr RawTKey) -> IO CString + +foreign import ccall "HROOTCoreTKey.h TKey_IsA" c_tkey_isa + :: (Ptr RawTKey) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTKey.h TKey_Paint" c_tkey_paint + :: (Ptr RawTKey) -> CString -> IO () + +foreign import ccall "HROOTCoreTKey.h TKey_printObj" c_tkey_printobj + :: (Ptr RawTKey) -> CString -> IO () + +foreign import ccall "HROOTCoreTKey.h TKey_SaveAs" c_tkey_saveas + :: (Ptr RawTKey) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTKey.h TKey_Write" c_tkey_write + :: (Ptr RawTKey) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTKey.h TKey_delete" c_tkey_delete + :: (Ptr RawTKey) -> IO () + diff --git a/src/HROOT/Core/TKey/Implementation.hs b/src/HROOT/Core/TKey/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TKey/Implementation.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TKey.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TKey.RawType +import HROOT.Core.TKey.FFI +import HROOT.Core.TKey.Interface +import HROOT.Core.TKey.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TNamed.RawType +import HROOT.Core.TNamed.Cast +import HROOT.Core.TNamed.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITKey TKey where +instance ITNamed TKey where + setName = xform1 c_tkey_setname + setNameTitle = xform2 c_tkey_setnametitle + setTitle = xform1 c_tkey_settitle +instance ITObject TKey where + draw = xform1 c_tkey_draw + findObject = xform1 c_tkey_findobject + getName = xform0 c_tkey_getname + isA = xform0 c_tkey_isa + paint = xform1 c_tkey_paint + printObj = xform1 c_tkey_printobj + saveAs = xform2 c_tkey_saveas + write = xform3 c_tkey_write +instance IDeletable TKey where + delete = xform0 c_tkey_delete + +instance ITKey (Exist TKey) where + +instance ITNamed (Exist TKey) where + setName (ETKey x) = setName x + setNameTitle (ETKey x) = setNameTitle x + setTitle (ETKey x) = setTitle x +instance ITObject (Exist TKey) where + draw (ETKey x) = draw x + findObject (ETKey x) = findObject x + getName (ETKey x) = getName x + isA (ETKey x) = isA x + paint (ETKey x) = paint x + printObj (ETKey x) = printObj x + saveAs (ETKey x) = saveAs x + write (ETKey x) = write x +instance IDeletable (Exist TKey) where + delete (ETKey x) = delete x + + + + + + + +instance FPtr (Exist TKey) where + type Raw (Exist TKey) = RawTKey + get_fptr (ETKey obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETKey (cast_fptr_to_obj (fptr :: ForeignPtr RawTKey) :: TKey) diff --git a/src/HROOT/Core/TKey/Interface.hs b/src/HROOT/Core/TKey/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TKey/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TKey.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TKey.RawType + +import HROOT.Core.TNamed.Interface +---- ============ ---- + + + +class (ITNamed a) => ITKey a where + +instance Existable TKey where + data Exist TKey = forall a. (FPtr a, ITKey a) => ETKey a + +upcastTKey :: (FPtr a, ITKey a) => a -> TKey +upcastTKey h = let fh = get_fptr h + fh2 :: ForeignPtr RawTKey = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTKey :: (FPtr a, ITKey a) => TKey -> a +downcastTKey h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TKey/Interface.hs-boot b/src/HROOT/Core/TKey/Interface.hs-boot new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TKey/Interface.hs-boot @@ -0,0 +1,3 @@ +module HROOT.Core.TKey.Interface where + +class ITKey a diff --git a/src/HROOT/Core/TKey/RawType.hs b/src/HROOT/Core/TKey/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TKey/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TKey.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTKey +newtype TKey = TKey (ForeignPtr RawTKey) deriving (Eq, Ord, Show) +instance FPtr TKey where + type Raw TKey = RawTKey + get_fptr (TKey fptr) = fptr + cast_fptr_to_obj = TKey diff --git a/src/HROOT/Core/TNamed.hs b/src/HROOT/Core/TNamed.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TNamed.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TNamed + ( + TNamed(..) + , ITNamed(..) + , upcastTNamed + , downcastTNamed + , newTNamed + + ) where + +import HROOT.Core.TNamed.RawType +import HROOT.Core.TNamed.Interface +import HROOT.Core.TNamed.Implementation + + diff --git a/src/HROOT/Core/TNamed/Cast.hs b/src/HROOT/Core/TNamed/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TNamed/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TNamed.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TNamed.RawType +import HROOT.Core.TNamed.Interface + +instance (ITNamed a, FPtr a) => Castable a (Ptr RawTNamed) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TNamed (Ptr RawTNamed) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TNamed/FFI.hsc b/src/HROOT/Core/TNamed/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TNamed/FFI.hsc @@ -0,0 +1,59 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TNamed.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TNamed.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTNamed.h" + +foreign import ccall "HROOTCoreTNamed.h TNamed_Draw" c_tnamed_draw + :: (Ptr RawTNamed) -> CString -> IO () + +foreign import ccall "HROOTCoreTNamed.h TNamed_FindObject" c_tnamed_findobject + :: (Ptr RawTNamed) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTNamed.h TNamed_GetName" c_tnamed_getname + :: (Ptr RawTNamed) -> IO CString + +foreign import ccall "HROOTCoreTNamed.h TNamed_IsA" c_tnamed_isa + :: (Ptr RawTNamed) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTNamed.h TNamed_Paint" c_tnamed_paint + :: (Ptr RawTNamed) -> CString -> IO () + +foreign import ccall "HROOTCoreTNamed.h TNamed_printObj" c_tnamed_printobj + :: (Ptr RawTNamed) -> CString -> IO () + +foreign import ccall "HROOTCoreTNamed.h TNamed_SaveAs" c_tnamed_saveas + :: (Ptr RawTNamed) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTNamed.h TNamed_Write" c_tnamed_write + :: (Ptr RawTNamed) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTNamed.h TNamed_delete" c_tnamed_delete + :: (Ptr RawTNamed) -> IO () + +foreign import ccall "HROOTCoreTNamed.h TNamed_newTNamed" c_tnamed_newtnamed + :: CString -> CString -> IO (Ptr RawTNamed) + +foreign import ccall "HROOTCoreTNamed.h TNamed_SetName" c_tnamed_setname + :: (Ptr RawTNamed) -> CString -> IO () + +foreign import ccall "HROOTCoreTNamed.h TNamed_SetNameTitle" c_tnamed_setnametitle + :: (Ptr RawTNamed) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTNamed.h TNamed_SetTitle" c_tnamed_settitle + :: (Ptr RawTNamed) -> CString -> IO () + diff --git a/src/HROOT/Core/TNamed/Implementation.hs b/src/HROOT/Core/TNamed/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TNamed/Implementation.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TNamed.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TNamed.RawType +import HROOT.Core.TNamed.FFI +import HROOT.Core.TNamed.Interface +import HROOT.Core.TNamed.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITNamed TNamed where + setName = xform1 c_tnamed_setname + setNameTitle = xform2 c_tnamed_setnametitle + setTitle = xform1 c_tnamed_settitle +instance ITObject TNamed where + draw = xform1 c_tnamed_draw + findObject = xform1 c_tnamed_findobject + getName = xform0 c_tnamed_getname + isA = xform0 c_tnamed_isa + paint = xform1 c_tnamed_paint + printObj = xform1 c_tnamed_printobj + saveAs = xform2 c_tnamed_saveas + write = xform3 c_tnamed_write +instance IDeletable TNamed where + delete = xform0 c_tnamed_delete + +instance ITNamed (Exist TNamed) where + setName (ETNamed x) = setName x + setNameTitle (ETNamed x) = setNameTitle x + setTitle (ETNamed x) = setTitle x +instance ITObject (Exist TNamed) where + draw (ETNamed x) = draw x + findObject (ETNamed x) = findObject x + getName (ETNamed x) = getName x + isA (ETNamed x) = isA x + paint (ETNamed x) = paint x + printObj (ETNamed x) = printObj x + saveAs (ETNamed x) = saveAs x + write (ETNamed x) = write x +instance IDeletable (Exist TNamed) where + delete (ETNamed x) = delete x + +-- | constructor : +-- +-- > TNamed( char* name, char* title) +-- + +newTNamed :: CString -> CString -> IO TNamed +newTNamed = xform1 c_tnamed_newtnamed + + + + + +instance FPtr (Exist TNamed) where + type Raw (Exist TNamed) = RawTNamed + get_fptr (ETNamed obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETNamed (cast_fptr_to_obj (fptr :: ForeignPtr RawTNamed) :: TNamed) diff --git a/src/HROOT/Core/TNamed/Interface.hs b/src/HROOT/Core/TNamed/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TNamed/Interface.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TNamed.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TNamed.RawType + +import HROOT.Core.TObject.Interface +---- ============ ---- + + +-- | +-- Class TNamed +-- reference : http://root.cern.ch + +class (ITObject a) => ITNamed a where + + setName :: a -> CString -> IO () + + setNameTitle :: a -> CString -> CString -> IO () + -- | SetTitle method + -- + -- > SetTitle( char* name, char* title ) + -- + + setTitle :: a -> CString -> IO () + +instance Existable TNamed where + data Exist TNamed = forall a. (FPtr a, ITNamed a) => ETNamed a + +upcastTNamed :: (FPtr a, ITNamed a) => a -> TNamed +upcastTNamed h = let fh = get_fptr h + fh2 :: ForeignPtr RawTNamed = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTNamed :: (FPtr a, ITNamed a) => TNamed -> a +downcastTNamed h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TNamed/RawType.hs b/src/HROOT/Core/TNamed/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TNamed/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TNamed.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTNamed +newtype TNamed = TNamed (ForeignPtr RawTNamed) deriving (Eq, Ord, Show) +instance FPtr TNamed where + type Raw TNamed = RawTNamed + get_fptr (TNamed fptr) = fptr + cast_fptr_to_obj = TNamed diff --git a/src/HROOT/Core/TObjArray.hs b/src/HROOT/Core/TObjArray.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObjArray.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TObjArray + ( + TObjArray(..) + , ITObjArray + , upcastTObjArray + , downcastTObjArray + + + ) where + +import HROOT.Core.TObjArray.RawType +import HROOT.Core.TObjArray.Interface +import HROOT.Core.TObjArray.Implementation + + diff --git a/src/HROOT/Core/TObjArray/Cast.hs b/src/HROOT/Core/TObjArray/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObjArray/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TObjArray.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TObjArray.RawType +import HROOT.Core.TObjArray.Interface + +instance (ITObjArray a, FPtr a) => Castable a (Ptr RawTObjArray) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TObjArray (Ptr RawTObjArray) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TObjArray/FFI.hsc b/src/HROOT/Core/TObjArray/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObjArray/FFI.hsc @@ -0,0 +1,47 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TObjArray.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TObjArray.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTObjArray.h" + +foreign import ccall "HROOTCoreTObjArray.h TObjArray_Draw" c_tobjarray_draw + :: (Ptr RawTObjArray) -> CString -> IO () + +foreign import ccall "HROOTCoreTObjArray.h TObjArray_FindObject" c_tobjarray_findobject + :: (Ptr RawTObjArray) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTObjArray.h TObjArray_GetName" c_tobjarray_getname + :: (Ptr RawTObjArray) -> IO CString + +foreign import ccall "HROOTCoreTObjArray.h TObjArray_IsA" c_tobjarray_isa + :: (Ptr RawTObjArray) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTObjArray.h TObjArray_Paint" c_tobjarray_paint + :: (Ptr RawTObjArray) -> CString -> IO () + +foreign import ccall "HROOTCoreTObjArray.h TObjArray_printObj" c_tobjarray_printobj + :: (Ptr RawTObjArray) -> CString -> IO () + +foreign import ccall "HROOTCoreTObjArray.h TObjArray_SaveAs" c_tobjarray_saveas + :: (Ptr RawTObjArray) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTObjArray.h TObjArray_Write" c_tobjarray_write + :: (Ptr RawTObjArray) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTObjArray.h TObjArray_delete" c_tobjarray_delete + :: (Ptr RawTObjArray) -> IO () + diff --git a/src/HROOT/Core/TObjArray/Implementation.hs b/src/HROOT/Core/TObjArray/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObjArray/Implementation.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TObjArray.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TObjArray.RawType +import HROOT.Core.TObjArray.FFI +import HROOT.Core.TObjArray.Interface +import HROOT.Core.TObjArray.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TSeqCollection.RawType +import HROOT.Core.TSeqCollection.Cast +import HROOT.Core.TSeqCollection.Interface +import HROOT.Core.TCollection.RawType +import HROOT.Core.TCollection.Cast +import HROOT.Core.TCollection.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITObjArray TObjArray where +instance ITSeqCollection TObjArray where +instance ITCollection TObjArray where +instance ITObject TObjArray where + draw = xform1 c_tobjarray_draw + findObject = xform1 c_tobjarray_findobject + getName = xform0 c_tobjarray_getname + isA = xform0 c_tobjarray_isa + paint = xform1 c_tobjarray_paint + printObj = xform1 c_tobjarray_printobj + saveAs = xform2 c_tobjarray_saveas + write = xform3 c_tobjarray_write +instance IDeletable TObjArray where + delete = xform0 c_tobjarray_delete + +instance ITObjArray (Exist TObjArray) where + +instance ITSeqCollection (Exist TObjArray) where + +instance ITCollection (Exist TObjArray) where + +instance ITObject (Exist TObjArray) where + draw (ETObjArray x) = draw x + findObject (ETObjArray x) = findObject x + getName (ETObjArray x) = getName x + isA (ETObjArray x) = isA x + paint (ETObjArray x) = paint x + printObj (ETObjArray x) = printObj x + saveAs (ETObjArray x) = saveAs x + write (ETObjArray x) = write x +instance IDeletable (Exist TObjArray) where + delete (ETObjArray x) = delete x + + + + + + + +instance FPtr (Exist TObjArray) where + type Raw (Exist TObjArray) = RawTObjArray + get_fptr (ETObjArray obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETObjArray (cast_fptr_to_obj (fptr :: ForeignPtr RawTObjArray) :: TObjArray) diff --git a/src/HROOT/Core/TObjArray/Interface.hs b/src/HROOT/Core/TObjArray/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObjArray/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TObjArray.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TObjArray.RawType + +import HROOT.Core.TSeqCollection.Interface +---- ============ ---- + + + +class (ITSeqCollection a) => ITObjArray a where + +instance Existable TObjArray where + data Exist TObjArray = forall a. (FPtr a, ITObjArray a) => ETObjArray a + +upcastTObjArray :: (FPtr a, ITObjArray a) => a -> TObjArray +upcastTObjArray h = let fh = get_fptr h + fh2 :: ForeignPtr RawTObjArray = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTObjArray :: (FPtr a, ITObjArray a) => TObjArray -> a +downcastTObjArray h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TObjArray/RawType.hs b/src/HROOT/Core/TObjArray/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObjArray/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TObjArray.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTObjArray +newtype TObjArray = TObjArray (ForeignPtr RawTObjArray) deriving (Eq, Ord, Show) +instance FPtr TObjArray where + type Raw TObjArray = RawTObjArray + get_fptr (TObjArray fptr) = fptr + cast_fptr_to_obj = TObjArray diff --git a/src/HROOT/Core/TObject.hs b/src/HROOT/Core/TObject.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObject.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TObject + ( + TObject(..) + , ITObject(..) + , upcastTObject + , downcastTObject + , newTObject + , tObjectGetObjectStat + ) where + +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Interface +import HROOT.Core.TObject.Implementation + + diff --git a/src/HROOT/Core/TObject/Cast.hs b/src/HROOT/Core/TObject/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObject/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TObject.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Interface + +instance (ITObject a, FPtr a) => Castable a (Ptr RawTObject) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TObject (Ptr RawTObject) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TObject/FFI.hsc b/src/HROOT/Core/TObject/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObject/FFI.hsc @@ -0,0 +1,52 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TObject.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTObject.h" + +foreign import ccall "HROOTCoreTObject.h TObject_delete" c_tobject_delete + :: (Ptr RawTObject) -> IO () + +foreign import ccall "HROOTCoreTObject.h TObject_newTObject" c_tobject_newtobject + :: IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTObject.h TObject_Draw" c_tobject_draw + :: (Ptr RawTObject) -> CString -> IO () + +foreign import ccall "HROOTCoreTObject.h TObject_FindObject" c_tobject_findobject + :: (Ptr RawTObject) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTObject.h TObject_GetName" c_tobject_getname + :: (Ptr RawTObject) -> IO CString + +foreign import ccall "HROOTCoreTObject.h TObject_IsA" c_tobject_isa + :: (Ptr RawTObject) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTObject.h TObject_Paint" c_tobject_paint + :: (Ptr RawTObject) -> CString -> IO () + +foreign import ccall "HROOTCoreTObject.h TObject_printObj" c_tobject_printobj + :: (Ptr RawTObject) -> CString -> IO () + +foreign import ccall "HROOTCoreTObject.h TObject_SaveAs" c_tobject_saveas + :: (Ptr RawTObject) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTObject.h TObject_Write" c_tobject_write + :: (Ptr RawTObject) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTObject.h TObject_tObjectGetObjectStat" c_tobject_tobjectgetobjectstat + :: IO CInt + diff --git a/src/HROOT/Core/TObject/Implementation.hs b/src/HROOT/Core/TObject/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObject/Implementation.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TObject.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.FFI +import HROOT.Core.TObject.Interface +import HROOT.Core.TObject.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +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 ITObject TObject where + draw = xform1 c_tobject_draw + findObject = xform1 c_tobject_findobject + getName = xform0 c_tobject_getname + isA = xform0 c_tobject_isa + paint = xform1 c_tobject_paint + printObj = xform1 c_tobject_printobj + saveAs = xform2 c_tobject_saveas + write = xform3 c_tobject_write +instance IDeletable TObject where + delete = xform0 c_tobject_delete + +instance ITObject (Exist TObject) where + draw (ETObject x) = draw x + findObject (ETObject x) = findObject x + getName (ETObject x) = getName x + isA (ETObject x) = isA x + paint (ETObject x) = paint x + printObj (ETObject x) = printObj x + saveAs (ETObject x) = saveAs x + write (ETObject x) = write x +instance IDeletable (Exist TObject) where + delete (ETObject x) = delete x + + +newTObject :: IO TObject +newTObject = xformnull c_tobject_newtobject + + + +tObjectGetObjectStat :: IO CInt +tObjectGetObjectStat = xformnull c_tobject_tobjectgetobjectstat + +instance FPtr (Exist TObject) where + type Raw (Exist TObject) = RawTObject + get_fptr (ETObject obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETObject (cast_fptr_to_obj (fptr :: ForeignPtr RawTObject) :: TObject) diff --git a/src/HROOT/Core/TObject/Interface.hs b/src/HROOT/Core/TObject/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObject/Interface.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TObject.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITObject a where + -- | + -- > void TObject::Draw( char* option ) + -- + + draw :: a -> CString -> IO () + -- | + -- > TObject* TObject::FindObject( char* name ) + -- + + findObject :: a -> CString -> IO TObject + -- | + -- > char* TObject::GetName() + -- + + getName :: a -> IO CString + + isA :: a -> IO TClass + + paint :: a -> CString -> IO () + + printObj :: a -> CString -> IO () + + saveAs :: a -> CString -> CString -> IO () + + write :: a -> CString -> CInt -> CInt -> IO CInt + +instance Existable TObject where + data Exist TObject = forall a. (FPtr a, ITObject a) => ETObject a + +upcastTObject :: (FPtr a, ITObject a) => a -> TObject +upcastTObject h = let fh = get_fptr h + fh2 :: ForeignPtr RawTObject = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTObject :: (FPtr a, ITObject a) => TObject -> a +downcastTObject h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TObject/Interface.hs-boot b/src/HROOT/Core/TObject/Interface.hs-boot new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObject/Interface.hs-boot @@ -0,0 +1,3 @@ +module HROOT.Core.TObject.Interface where + +class ITObject a diff --git a/src/HROOT/Core/TObject/RawType.hs b/src/HROOT/Core/TObject/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TObject/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TObject.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTObject +newtype TObject = TObject (ForeignPtr RawTObject) deriving (Eq, Ord, Show) +instance FPtr TObject where + type Raw TObject = RawTObject + get_fptr (TObject fptr) = fptr + cast_fptr_to_obj = TObject diff --git a/src/HROOT/Core/TQObject.hs b/src/HROOT/Core/TQObject.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TQObject.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TQObject + ( + TQObject(..) + , ITQObject + , upcastTQObject + , downcastTQObject + + + ) where + +import HROOT.Core.TQObject.RawType +import HROOT.Core.TQObject.Interface +import HROOT.Core.TQObject.Implementation + + diff --git a/src/HROOT/Core/TQObject/Cast.hs b/src/HROOT/Core/TQObject/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TQObject/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TQObject.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TQObject.RawType +import HROOT.Core.TQObject.Interface + +instance (ITQObject a, FPtr a) => Castable a (Ptr RawTQObject) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TQObject (Ptr RawTQObject) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TQObject/FFI.hsc b/src/HROOT/Core/TQObject/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TQObject/FFI.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TQObject.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TQObject.RawType + + +#include "HROOTCoreTQObject.h" + +foreign import ccall "HROOTCoreTQObject.h TQObject_delete" c_tqobject_delete + :: (Ptr RawTQObject) -> IO () + diff --git a/src/HROOT/Core/TQObject/Implementation.hs b/src/HROOT/Core/TQObject/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TQObject/Implementation.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TQObject.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TQObject.RawType +import HROOT.Core.TQObject.FFI +import HROOT.Core.TQObject.Interface +import HROOT.Core.TQObject.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 ITQObject TQObject where +instance IDeletable TQObject where + delete = xform0 c_tqobject_delete + +instance ITQObject (Exist TQObject) where + +instance IDeletable (Exist TQObject) where + delete (ETQObject x) = delete x + + + + + + + +instance FPtr (Exist TQObject) where + type Raw (Exist TQObject) = RawTQObject + get_fptr (ETQObject obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETQObject (cast_fptr_to_obj (fptr :: ForeignPtr RawTQObject) :: TQObject) diff --git a/src/HROOT/Core/TQObject/Interface.hs b/src/HROOT/Core/TQObject/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TQObject/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TQObject.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TQObject.RawType + +import HROOT.Core.Deletable.Interface +---- ============ ---- + + + +class (IDeletable a) => ITQObject a where + +instance Existable TQObject where + data Exist TQObject = forall a. (FPtr a, ITQObject a) => ETQObject a + +upcastTQObject :: (FPtr a, ITQObject a) => a -> TQObject +upcastTQObject h = let fh = get_fptr h + fh2 :: ForeignPtr RawTQObject = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTQObject :: (FPtr a, ITQObject a) => TQObject -> a +downcastTQObject h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TQObject/RawType.hs b/src/HROOT/Core/TQObject/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TQObject/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TQObject.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTQObject +newtype TQObject = TQObject (ForeignPtr RawTQObject) deriving (Eq, Ord, Show) +instance FPtr TQObject where + type Raw TQObject = RawTQObject + get_fptr (TQObject fptr) = fptr + cast_fptr_to_obj = TQObject diff --git a/src/HROOT/Core/TROOT.hs b/src/HROOT/Core/TROOT.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TROOT.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TROOT + ( + TROOT(..) + , ITROOT + , upcastTROOT + , downcastTROOT + , tROOTGetGlobal + , tROOTInitialized + ) where + +import HROOT.Core.TROOT.RawType +import HROOT.Core.TROOT.Interface +import HROOT.Core.TROOT.Implementation + + diff --git a/src/HROOT/Core/TROOT/Cast.hs b/src/HROOT/Core/TROOT/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TROOT/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TROOT.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TROOT.RawType +import HROOT.Core.TROOT.Interface + +instance (ITROOT a, FPtr a) => Castable a (Ptr RawTROOT) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TROOT (Ptr RawTROOT) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TROOT/FFI.hsc b/src/HROOT/Core/TROOT/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TROOT/FFI.hsc @@ -0,0 +1,82 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TROOT.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TROOT.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TKey.RawType +import HROOT.Core.TClass.RawType +import HROOT.Core.TGlobal.RawType + +#include "HROOTCoreTROOT.h" + +foreign import ccall "HROOTCoreTROOT.h TROOT_Append" c_troot_append + :: (Ptr RawTROOT) -> (Ptr RawTObject) -> CInt -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_addD" c_troot_addd + :: (Ptr RawTROOT) -> (Ptr RawTObject) -> CInt -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_AppendKey" c_troot_appendkey + :: (Ptr RawTROOT) -> (Ptr RawTKey) -> IO CInt + +foreign import ccall "HROOTCoreTROOT.h TROOT_Close" c_troot_close + :: (Ptr RawTROOT) -> CString -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_Get" c_troot_get + :: (Ptr RawTROOT) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTROOT.h TROOT_cd_TDirectory" c_troot_cd_tdirectory + :: (Ptr RawTROOT) -> CString -> IO CInt + +foreign import ccall "HROOTCoreTROOT.h TROOT_SetName" c_troot_setname + :: (Ptr RawTROOT) -> CString -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_SetNameTitle" c_troot_setnametitle + :: (Ptr RawTROOT) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_SetTitle" c_troot_settitle + :: (Ptr RawTROOT) -> CString -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_Draw" c_troot_draw + :: (Ptr RawTROOT) -> CString -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_FindObject" c_troot_findobject + :: (Ptr RawTROOT) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTROOT.h TROOT_GetName" c_troot_getname + :: (Ptr RawTROOT) -> IO CString + +foreign import ccall "HROOTCoreTROOT.h TROOT_IsA" c_troot_isa + :: (Ptr RawTROOT) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTROOT.h TROOT_Paint" c_troot_paint + :: (Ptr RawTROOT) -> CString -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_printObj" c_troot_printobj + :: (Ptr RawTROOT) -> CString -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_SaveAs" c_troot_saveas + :: (Ptr RawTROOT) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_Write" c_troot_write + :: (Ptr RawTROOT) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTROOT.h TROOT_delete" c_troot_delete + :: (Ptr RawTROOT) -> IO () + +foreign import ccall "HROOTCoreTROOT.h TROOT_tROOTGetGlobal" c_troot_trootgetglobal + :: (Ptr RawTROOT) -> CString -> CInt -> IO (Ptr RawTGlobal) + +foreign import ccall "HROOTCoreTROOT.h TROOT_tROOTInitialized" c_troot_trootinitialized + :: IO CInt + diff --git a/src/HROOT/Core/TROOT/Implementation.hs b/src/HROOT/Core/TROOT/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TROOT/Implementation.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TROOT.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TROOT.RawType +import HROOT.Core.TROOT.FFI +import HROOT.Core.TROOT.Interface +import HROOT.Core.TROOT.Cast +import HROOT.Core.TKey.RawType +import HROOT.Core.TKey.Cast +import HROOT.Core.TKey.Interface +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TGlobal.RawType +import HROOT.Core.TGlobal.Cast +import HROOT.Core.TGlobal.Interface +import HROOT.Core.TDirectory.RawType +import HROOT.Core.TDirectory.Cast +import HROOT.Core.TDirectory.Interface +import HROOT.Core.TNamed.RawType +import HROOT.Core.TNamed.Cast +import HROOT.Core.TNamed.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITROOT TROOT where +instance ITDirectory TROOT where + append = xform2 c_troot_append + addD = xform2 c_troot_addd + appendKey = xform1 c_troot_appendkey + close = xform1 c_troot_close + get = xform1 c_troot_get + cd_TDirectory = xform1 c_troot_cd_tdirectory +instance ITNamed TROOT where + setName = xform1 c_troot_setname + setNameTitle = xform2 c_troot_setnametitle + setTitle = xform1 c_troot_settitle +instance ITObject TROOT where + draw = xform1 c_troot_draw + findObject = xform1 c_troot_findobject + getName = xform0 c_troot_getname + isA = xform0 c_troot_isa + paint = xform1 c_troot_paint + printObj = xform1 c_troot_printobj + saveAs = xform2 c_troot_saveas + write = xform3 c_troot_write +instance IDeletable TROOT where + delete = xform0 c_troot_delete + +instance ITROOT (Exist TROOT) where + +instance ITDirectory (Exist TROOT) where + append (ETROOT x) = append x + addD (ETROOT x) = addD x + appendKey (ETROOT x) = appendKey x + close (ETROOT x) = close x + get (ETROOT x) = get x + cd_TDirectory (ETROOT x) = cd_TDirectory x +instance ITNamed (Exist TROOT) where + setName (ETROOT x) = setName x + setNameTitle (ETROOT x) = setNameTitle x + setTitle (ETROOT x) = setTitle x +instance ITObject (Exist TROOT) where + draw (ETROOT x) = draw x + findObject (ETROOT x) = findObject x + getName (ETROOT x) = getName x + isA (ETROOT x) = isA x + paint (ETROOT x) = paint x + printObj (ETROOT x) = printObj x + saveAs (ETROOT x) = saveAs x + write (ETROOT x) = write x +instance IDeletable (Exist TROOT) where + delete (ETROOT x) = delete x + + + +tROOTGetGlobal :: TROOT -> CString -> CInt -> IO TGlobal +tROOTGetGlobal = xform2 c_troot_trootgetglobal + +tROOTInitialized :: IO CInt +tROOTInitialized = xformnull c_troot_trootinitialized + +instance FPtr (Exist TROOT) where + type Raw (Exist TROOT) = RawTROOT + get_fptr (ETROOT obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETROOT (cast_fptr_to_obj (fptr :: ForeignPtr RawTROOT) :: TROOT) diff --git a/src/HROOT/Core/TROOT/Interface.hs b/src/HROOT/Core/TROOT/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TROOT/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TROOT.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TROOT.RawType +import HROOT.Core.TGlobal.RawType +import HROOT.Core.TDirectory.Interface +---- ============ ---- + + + +class (ITDirectory a) => ITROOT a where + +instance Existable TROOT where + data Exist TROOT = forall a. (FPtr a, ITROOT a) => ETROOT a + +upcastTROOT :: (FPtr a, ITROOT a) => a -> TROOT +upcastTROOT h = let fh = get_fptr h + fh2 :: ForeignPtr RawTROOT = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTROOT :: (FPtr a, ITROOT a) => TROOT -> a +downcastTROOT h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TROOT/RawType.hs b/src/HROOT/Core/TROOT/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TROOT/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TROOT.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTROOT +newtype TROOT = TROOT (ForeignPtr RawTROOT) deriving (Eq, Ord, Show) +instance FPtr TROOT where + type Raw TROOT = RawTROOT + get_fptr (TROOT fptr) = fptr + cast_fptr_to_obj = TROOT diff --git a/src/HROOT/Core/TSeqCollection.hs b/src/HROOT/Core/TSeqCollection.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSeqCollection.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TSeqCollection + ( + TSeqCollection(..) + , ITSeqCollection + , upcastTSeqCollection + , downcastTSeqCollection + + + ) where + +import HROOT.Core.TSeqCollection.RawType +import HROOT.Core.TSeqCollection.Interface +import HROOT.Core.TSeqCollection.Implementation + + diff --git a/src/HROOT/Core/TSeqCollection/Cast.hs b/src/HROOT/Core/TSeqCollection/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSeqCollection/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TSeqCollection.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TSeqCollection.RawType +import HROOT.Core.TSeqCollection.Interface + +instance (ITSeqCollection a, FPtr a) => Castable a (Ptr RawTSeqCollection) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TSeqCollection (Ptr RawTSeqCollection) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TSeqCollection/FFI.hsc b/src/HROOT/Core/TSeqCollection/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSeqCollection/FFI.hsc @@ -0,0 +1,47 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TSeqCollection.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TSeqCollection.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTSeqCollection.h" + +foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_Draw" c_tseqcollection_draw + :: (Ptr RawTSeqCollection) -> CString -> IO () + +foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_FindObject" c_tseqcollection_findobject + :: (Ptr RawTSeqCollection) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_GetName" c_tseqcollection_getname + :: (Ptr RawTSeqCollection) -> IO CString + +foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_IsA" c_tseqcollection_isa + :: (Ptr RawTSeqCollection) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_Paint" c_tseqcollection_paint + :: (Ptr RawTSeqCollection) -> CString -> IO () + +foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_printObj" c_tseqcollection_printobj + :: (Ptr RawTSeqCollection) -> CString -> IO () + +foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_SaveAs" c_tseqcollection_saveas + :: (Ptr RawTSeqCollection) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_Write" c_tseqcollection_write + :: (Ptr RawTSeqCollection) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_delete" c_tseqcollection_delete + :: (Ptr RawTSeqCollection) -> IO () + diff --git a/src/HROOT/Core/TSeqCollection/Implementation.hs b/src/HROOT/Core/TSeqCollection/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSeqCollection/Implementation.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TSeqCollection.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TSeqCollection.RawType +import HROOT.Core.TSeqCollection.FFI +import HROOT.Core.TSeqCollection.Interface +import HROOT.Core.TSeqCollection.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TCollection.RawType +import HROOT.Core.TCollection.Cast +import HROOT.Core.TCollection.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITSeqCollection TSeqCollection where +instance ITCollection TSeqCollection where +instance ITObject TSeqCollection where + draw = xform1 c_tseqcollection_draw + findObject = xform1 c_tseqcollection_findobject + getName = xform0 c_tseqcollection_getname + isA = xform0 c_tseqcollection_isa + paint = xform1 c_tseqcollection_paint + printObj = xform1 c_tseqcollection_printobj + saveAs = xform2 c_tseqcollection_saveas + write = xform3 c_tseqcollection_write +instance IDeletable TSeqCollection where + delete = xform0 c_tseqcollection_delete + +instance ITSeqCollection (Exist TSeqCollection) where + +instance ITCollection (Exist TSeqCollection) where + +instance ITObject (Exist TSeqCollection) where + draw (ETSeqCollection x) = draw x + findObject (ETSeqCollection x) = findObject x + getName (ETSeqCollection x) = getName x + isA (ETSeqCollection x) = isA x + paint (ETSeqCollection x) = paint x + printObj (ETSeqCollection x) = printObj x + saveAs (ETSeqCollection x) = saveAs x + write (ETSeqCollection x) = write x +instance IDeletable (Exist TSeqCollection) where + delete (ETSeqCollection x) = delete x + + + + + + + +instance FPtr (Exist TSeqCollection) where + type Raw (Exist TSeqCollection) = RawTSeqCollection + get_fptr (ETSeqCollection obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETSeqCollection (cast_fptr_to_obj (fptr :: ForeignPtr RawTSeqCollection) :: TSeqCollection) diff --git a/src/HROOT/Core/TSeqCollection/Interface.hs b/src/HROOT/Core/TSeqCollection/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSeqCollection/Interface.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TSeqCollection.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TSeqCollection.RawType + +import HROOT.Core.TCollection.Interface +---- ============ ---- + + + +class (ITCollection a) => ITSeqCollection a where + +instance Existable TSeqCollection where + data Exist TSeqCollection = forall a. (FPtr a, ITSeqCollection a) => ETSeqCollection a + +upcastTSeqCollection :: (FPtr a, ITSeqCollection a) => a -> TSeqCollection +upcastTSeqCollection h = let fh = get_fptr h + fh2 :: ForeignPtr RawTSeqCollection = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTSeqCollection :: (FPtr a, ITSeqCollection a) => TSeqCollection -> a +downcastTSeqCollection h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TSeqCollection/RawType.hs b/src/HROOT/Core/TSeqCollection/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSeqCollection/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TSeqCollection.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTSeqCollection +newtype TSeqCollection = TSeqCollection (ForeignPtr RawTSeqCollection) deriving (Eq, Ord, Show) +instance FPtr TSeqCollection where + type Raw TSeqCollection = RawTSeqCollection + get_fptr (TSeqCollection fptr) = fptr + cast_fptr_to_obj = TSeqCollection diff --git a/src/HROOT/Core/TSystem.hs b/src/HROOT/Core/TSystem.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSystem.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TSystem + ( + TSystem(..) + , ITSystem(..) + , upcastTSystem + , downcastTSystem + + + ) where + +import HROOT.Core.TSystem.RawType +import HROOT.Core.TSystem.Interface +import HROOT.Core.TSystem.Implementation + + diff --git a/src/HROOT/Core/TSystem/Cast.hs b/src/HROOT/Core/TSystem/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSystem/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TSystem.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TSystem.RawType +import HROOT.Core.TSystem.Interface + +instance (ITSystem a, FPtr a) => Castable a (Ptr RawTSystem) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TSystem (Ptr RawTSystem) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TSystem/FFI.hsc b/src/HROOT/Core/TSystem/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSystem/FFI.hsc @@ -0,0 +1,59 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TSystem.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TSystem.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTSystem.h" + +foreign import ccall "HROOTCoreTSystem.h TSystem_SetName" c_tsystem_setname + :: (Ptr RawTSystem) -> CString -> IO () + +foreign import ccall "HROOTCoreTSystem.h TSystem_SetNameTitle" c_tsystem_setnametitle + :: (Ptr RawTSystem) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTSystem.h TSystem_SetTitle" c_tsystem_settitle + :: (Ptr RawTSystem) -> CString -> IO () + +foreign import ccall "HROOTCoreTSystem.h TSystem_Draw" c_tsystem_draw + :: (Ptr RawTSystem) -> CString -> IO () + +foreign import ccall "HROOTCoreTSystem.h TSystem_FindObject" c_tsystem_findobject + :: (Ptr RawTSystem) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTSystem.h TSystem_GetName" c_tsystem_getname + :: (Ptr RawTSystem) -> IO CString + +foreign import ccall "HROOTCoreTSystem.h TSystem_IsA" c_tsystem_isa + :: (Ptr RawTSystem) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTSystem.h TSystem_Paint" c_tsystem_paint + :: (Ptr RawTSystem) -> CString -> IO () + +foreign import ccall "HROOTCoreTSystem.h TSystem_printObj" c_tsystem_printobj + :: (Ptr RawTSystem) -> CString -> IO () + +foreign import ccall "HROOTCoreTSystem.h TSystem_SaveAs" c_tsystem_saveas + :: (Ptr RawTSystem) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTSystem.h TSystem_Write" c_tsystem_write + :: (Ptr RawTSystem) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTSystem.h TSystem_delete" c_tsystem_delete + :: (Ptr RawTSystem) -> IO () + +foreign import ccall "HROOTCoreTSystem.h TSystem_ProcessEvents" c_tsystem_processevents + :: (Ptr RawTSystem) -> IO CInt + diff --git a/src/HROOT/Core/TSystem/Implementation.hs b/src/HROOT/Core/TSystem/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSystem/Implementation.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TSystem.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TSystem.RawType +import HROOT.Core.TSystem.FFI +import HROOT.Core.TSystem.Interface +import HROOT.Core.TSystem.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TNamed.RawType +import HROOT.Core.TNamed.Cast +import HROOT.Core.TNamed.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITSystem TSystem where + processEvents = xform0 c_tsystem_processevents +instance ITNamed TSystem where + setName = xform1 c_tsystem_setname + setNameTitle = xform2 c_tsystem_setnametitle + setTitle = xform1 c_tsystem_settitle +instance ITObject TSystem where + draw = xform1 c_tsystem_draw + findObject = xform1 c_tsystem_findobject + getName = xform0 c_tsystem_getname + isA = xform0 c_tsystem_isa + paint = xform1 c_tsystem_paint + printObj = xform1 c_tsystem_printobj + saveAs = xform2 c_tsystem_saveas + write = xform3 c_tsystem_write +instance IDeletable TSystem where + delete = xform0 c_tsystem_delete + +instance ITSystem (Exist TSystem) where + processEvents (ETSystem x) = processEvents x +instance ITNamed (Exist TSystem) where + setName (ETSystem x) = setName x + setNameTitle (ETSystem x) = setNameTitle x + setTitle (ETSystem x) = setTitle x +instance ITObject (Exist TSystem) where + draw (ETSystem x) = draw x + findObject (ETSystem x) = findObject x + getName (ETSystem x) = getName x + isA (ETSystem x) = isA x + paint (ETSystem x) = paint x + printObj (ETSystem x) = printObj x + saveAs (ETSystem x) = saveAs x + write (ETSystem x) = write x +instance IDeletable (Exist TSystem) where + delete (ETSystem x) = delete x + + + + + + + +instance FPtr (Exist TSystem) where + type Raw (Exist TSystem) = RawTSystem + get_fptr (ETSystem obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETSystem (cast_fptr_to_obj (fptr :: ForeignPtr RawTSystem) :: TSystem) diff --git a/src/HROOT/Core/TSystem/Interface.hs b/src/HROOT/Core/TSystem/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSystem/Interface.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TSystem.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TSystem.RawType + +import HROOT.Core.TNamed.Interface +---- ============ ---- + + + +class (ITNamed a) => ITSystem a where + + processEvents :: a -> IO CInt + +instance Existable TSystem where + data Exist TSystem = forall a. (FPtr a, ITSystem a) => ETSystem a + +upcastTSystem :: (FPtr a, ITSystem a) => a -> TSystem +upcastTSystem h = let fh = get_fptr h + fh2 :: ForeignPtr RawTSystem = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTSystem :: (FPtr a, ITSystem a) => TSystem -> a +downcastTSystem h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TSystem/RawType.hs b/src/HROOT/Core/TSystem/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TSystem/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TSystem.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTSystem +newtype TSystem = TSystem (ForeignPtr RawTSystem) deriving (Eq, Ord, Show) +instance FPtr TSystem where + type Raw TSystem = RawTSystem + get_fptr (TSystem fptr) = fptr + cast_fptr_to_obj = TSystem diff --git a/src/HROOT/Core/TVirtualPad.hs b/src/HROOT/Core/TVirtualPad.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TVirtualPad.hs @@ -0,0 +1,15 @@ +module HROOT.Core.TVirtualPad + ( + TVirtualPad(..) + , ITVirtualPad(..) + , upcastTVirtualPad + , downcastTVirtualPad + + + ) where + +import HROOT.Core.TVirtualPad.RawType +import HROOT.Core.TVirtualPad.Interface +import HROOT.Core.TVirtualPad.Implementation + + diff --git a/src/HROOT/Core/TVirtualPad/Cast.hs b/src/HROOT/Core/TVirtualPad/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TVirtualPad/Cast.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TVirtualPad.Cast where + + +import Foreign.Ptr +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) +import Foreign.ForeignPtr.Unsafe +import FFICXX.Runtime.Cast +import System.IO.Unsafe + +import HROOT.Core.TVirtualPad.RawType +import HROOT.Core.TVirtualPad.Interface + +instance (ITVirtualPad a, FPtr a) => Castable a (Ptr RawTVirtualPad) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + +instance Castable TVirtualPad (Ptr RawTVirtualPad) where + cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr + uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ diff --git a/src/HROOT/Core/TVirtualPad/FFI.hsc b/src/HROOT/Core/TVirtualPad/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TVirtualPad/FFI.hsc @@ -0,0 +1,62 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- module HROOT.Class.FFI where + +module HROOT.Core.TVirtualPad.FFI where + + +import Foreign.C +import Foreign.Ptr + +-- import HROOT.Class.Interface + +-- #include "" + +import HROOT.Core.TVirtualPad.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TClass.RawType + +#include "HROOTCoreTVirtualPad.h" + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_Draw" c_tvirtualpad_draw + :: (Ptr RawTVirtualPad) -> CString -> IO () + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_FindObject" c_tvirtualpad_findobject + :: (Ptr RawTVirtualPad) -> CString -> IO (Ptr RawTObject) + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_GetName" c_tvirtualpad_getname + :: (Ptr RawTVirtualPad) -> IO CString + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_IsA" c_tvirtualpad_isa + :: (Ptr RawTVirtualPad) -> IO (Ptr RawTClass) + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_Paint" c_tvirtualpad_paint + :: (Ptr RawTVirtualPad) -> CString -> IO () + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_printObj" c_tvirtualpad_printobj + :: (Ptr RawTVirtualPad) -> CString -> IO () + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_SaveAs" c_tvirtualpad_saveas + :: (Ptr RawTVirtualPad) -> CString -> CString -> IO () + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_Write" c_tvirtualpad_write + :: (Ptr RawTVirtualPad) -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_delete" c_tvirtualpad_delete + :: (Ptr RawTVirtualPad) -> IO () + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_cd" c_tvirtualpad_cd + :: (Ptr RawTVirtualPad) -> CInt -> IO (Ptr RawTVirtualPad) + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_divide_tvirtualpad" c_tvirtualpad_divide_tvirtualpad + :: (Ptr RawTVirtualPad) -> CInt -> CInt -> CDouble -> CDouble -> CInt -> IO () + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_SetLogx" c_tvirtualpad_setlogx + :: (Ptr RawTVirtualPad) -> CInt -> IO () + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_SetLogy" c_tvirtualpad_setlogy + :: (Ptr RawTVirtualPad) -> CInt -> IO () + +foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_SetLogz" c_tvirtualpad_setlogz + :: (Ptr RawTVirtualPad) -> CInt -> IO () + diff --git a/src/HROOT/Core/TVirtualPad/Implementation.hs b/src/HROOT/Core/TVirtualPad/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TVirtualPad/Implementation.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, + OverlappingInstances, IncoherentInstances #-} + +module HROOT.Core.TVirtualPad.Implementation where + + +import FFICXX.Runtime.Cast + +import HROOT.Core.TVirtualPad.RawType +import HROOT.Core.TVirtualPad.FFI +import HROOT.Core.TVirtualPad.Interface +import HROOT.Core.TVirtualPad.Cast +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +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 ITVirtualPad TVirtualPad where + cd = xform1 c_tvirtualpad_cd + divide_tvirtualpad = xform5 c_tvirtualpad_divide_tvirtualpad + setLogx = xform1 c_tvirtualpad_setlogx + setLogy = xform1 c_tvirtualpad_setlogy + setLogz = xform1 c_tvirtualpad_setlogz +instance ITObject TVirtualPad where + draw = xform1 c_tvirtualpad_draw + findObject = xform1 c_tvirtualpad_findobject + getName = xform0 c_tvirtualpad_getname + isA = xform0 c_tvirtualpad_isa + paint = xform1 c_tvirtualpad_paint + printObj = xform1 c_tvirtualpad_printobj + saveAs = xform2 c_tvirtualpad_saveas + write = xform3 c_tvirtualpad_write +instance IDeletable TVirtualPad where + delete = xform0 c_tvirtualpad_delete + +instance ITVirtualPad (Exist TVirtualPad) where + cd (ETVirtualPad x) a1 = return . ETVirtualPad =<< cd x a1 + divide_tvirtualpad (ETVirtualPad x) = divide_tvirtualpad x + setLogx (ETVirtualPad x) = setLogx x + setLogy (ETVirtualPad x) = setLogy x + setLogz (ETVirtualPad x) = setLogz x +instance ITObject (Exist TVirtualPad) where + draw (ETVirtualPad x) = draw x + findObject (ETVirtualPad x) = findObject x + getName (ETVirtualPad x) = getName x + isA (ETVirtualPad x) = isA x + paint (ETVirtualPad x) = paint x + printObj (ETVirtualPad x) = printObj x + saveAs (ETVirtualPad x) = saveAs x + write (ETVirtualPad x) = write x +instance IDeletable (Exist TVirtualPad) where + delete (ETVirtualPad x) = delete x + + + + + + + +instance FPtr (Exist TVirtualPad) where + type Raw (Exist TVirtualPad) = RawTVirtualPad + get_fptr (ETVirtualPad obj) = castForeignPtr (get_fptr obj) + cast_fptr_to_obj fptr = ETVirtualPad (cast_fptr_to_obj (fptr :: ForeignPtr RawTVirtualPad) :: TVirtualPad) diff --git a/src/HROOT/Core/TVirtualPad/Interface.hs b/src/HROOT/Core/TVirtualPad/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TVirtualPad/Interface.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +-- module HROOT.Class.Interface where + +module HROOT.Core.TVirtualPad.Interface where + + +import Data.Word +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +import HROOT.Core.TVirtualPad.RawType + +import HROOT.Core.TObject.Interface +---- ============ ---- + + + +class (ITObject a) => ITVirtualPad a where + + cd :: a -> CInt -> IO a + + divide_tvirtualpad :: a -> CInt -> CInt -> CDouble -> CDouble -> CInt -> IO () + + setLogx :: a -> CInt -> IO () + + setLogy :: a -> CInt -> IO () + + setLogz :: a -> CInt -> IO () + +instance Existable TVirtualPad where + data Exist TVirtualPad = forall a. (FPtr a, ITVirtualPad a) => ETVirtualPad a + +upcastTVirtualPad :: (FPtr a, ITVirtualPad a) => a -> TVirtualPad +upcastTVirtualPad h = let fh = get_fptr h + fh2 :: ForeignPtr RawTVirtualPad = castForeignPtr fh + in cast_fptr_to_obj fh2 + +downcastTVirtualPad :: (FPtr a, ITVirtualPad a) => TVirtualPad -> a +downcastTVirtualPad h = let fh = get_fptr h + fh2 = castForeignPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TVirtualPad/RawType.hs b/src/HROOT/Core/TVirtualPad/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TVirtualPad/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} + +module HROOT.Core.TVirtualPad.RawType where + + +import Foreign.ForeignPtr +import FFICXX.Runtime.Cast + +data RawTVirtualPad +newtype TVirtualPad = TVirtualPad (ForeignPtr RawTVirtualPad) deriving (Eq, Ord, Show) +instance FPtr TVirtualPad where + type Raw TVirtualPad = RawTVirtualPad + get_fptr (TVirtualPad fptr) = fptr + cast_fptr_to_obj = TVirtualPad