summaryrefslogtreecommitdiff
path: root/contrib/haskell
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/haskell')
-rw-r--r--contrib/haskell/LICENSE674
-rw-r--r--contrib/haskell/Setup.hs2
-rw-r--r--contrib/haskell/data/3d3.ui251
-rw-r--r--contrib/haskell/data/ghkl3.ui2537
-rwxr-xr-xcontrib/haskell/data/gprof2dot.py3293
-rw-r--r--contrib/haskell/data/pseudo3.ui240
-rw-r--r--contrib/haskell/hkl.cabal192
-rw-r--r--contrib/haskell/src/Hkl.hs16
-rw-r--r--contrib/haskell/src/Hkl/C.hsc160
-rw-r--r--contrib/haskell/src/Hkl/C/DArray.hsc25
-rw-r--r--contrib/haskell/src/Hkl/C/Detector.hsc41
-rw-r--r--contrib/haskell/src/Hkl/C/Engine.hsc81
-rw-r--r--contrib/haskell/src/Hkl/C/EngineList.hsc60
-rw-r--r--contrib/haskell/src/Hkl/C/Geometry.hsc188
-rw-r--r--contrib/haskell/src/Hkl/C/GeometryList.hsc120
-rw-r--r--contrib/haskell/src/Hkl/C/Lattice.hsc106
-rw-r--r--contrib/haskell/src/Hkl/C/Sample.hsc91
-rw-r--r--contrib/haskell/src/Hkl/DataSource.hs51
-rw-r--r--contrib/haskell/src/Hkl/Detector.hs82
-rw-r--r--contrib/haskell/src/Hkl/Edf.hs69
-rw-r--r--contrib/haskell/src/Hkl/Engine.hs27
-rw-r--r--contrib/haskell/src/Hkl/Flat.hs81
-rw-r--r--contrib/haskell/src/Hkl/H5.hs194
-rw-r--r--contrib/haskell/src/Hkl/Lattice.hs63
-rw-r--r--contrib/haskell/src/Hkl/MyMatrix.hs50
-rw-r--r--contrib/haskell/src/Hkl/Nxs.hs237
-rw-r--r--contrib/haskell/src/Hkl/Projects.hs6
-rw-r--r--contrib/haskell/src/Hkl/Projects/D2AM.hs3
-rw-r--r--contrib/haskell/src/Hkl/Projects/D2AM/XRD.hs105
-rw-r--r--contrib/haskell/src/Hkl/Projects/Diffabs.hs9
-rw-r--r--contrib/haskell/src/Hkl/Projects/Diffabs/Charlier.hs164
-rw-r--r--contrib/haskell/src/Hkl/Projects/Diffabs/Hamon.hs134
-rw-r--r--contrib/haskell/src/Hkl/Projects/Diffabs/Hercules.hs168
-rw-r--r--contrib/haskell/src/Hkl/Projects/Diffabs/IRDRx.hs158
-rw-r--r--contrib/haskell/src/Hkl/Projects/Diffabs/Laure.hs206
-rw-r--r--contrib/haskell/src/Hkl/Projects/Diffabs/Martinetto.hs294
-rw-r--r--contrib/haskell/src/Hkl/Projects/Diffabs/Melle.hs439
-rw-r--r--contrib/haskell/src/Hkl/Projects/Mars.hs4
-rw-r--r--contrib/haskell/src/Hkl/Projects/Mars/Romeden.hs47
-rw-r--r--contrib/haskell/src/Hkl/Projects/Mars/Schlegel.hs110
-rw-r--r--contrib/haskell/src/Hkl/Projects/Sixs.hs141
-rw-r--r--contrib/haskell/src/Hkl/PyFAI.hs9
-rw-r--r--contrib/haskell/src/Hkl/PyFAI/AzimuthalIntegrator.hs18
-rw-r--r--contrib/haskell/src/Hkl/PyFAI/Calib.hs29
-rw-r--r--contrib/haskell/src/Hkl/PyFAI/Calibrant.hs10
-rw-r--r--contrib/haskell/src/Hkl/PyFAI/Detector.hs19
-rw-r--r--contrib/haskell/src/Hkl/PyFAI/Npt.hs99
-rw-r--r--contrib/haskell/src/Hkl/PyFAI/Poni.hs257
-rw-r--r--contrib/haskell/src/Hkl/PyFAI/PoniExt.hs41
-rw-r--r--contrib/haskell/src/Hkl/Python.hs30
-rw-r--r--contrib/haskell/src/Hkl/Script.hs107
-rw-r--r--contrib/haskell/src/Hkl/Tiff.hs10
-rw-r--r--contrib/haskell/src/Hkl/Types.hs77
-rw-r--r--contrib/haskell/src/Hkl/Types/Parameter.hsc85
-rw-r--r--contrib/haskell/src/Hkl/Utils.hs17
-rw-r--r--contrib/haskell/src/Hkl/Xrd.hs6
-rw-r--r--contrib/haskell/src/Hkl/Xrd/Calibration.hs355
-rw-r--r--contrib/haskell/src/Hkl/Xrd/Mesh.hs270
-rw-r--r--contrib/haskell/src/Hkl/Xrd/OneD.hs667
-rw-r--r--contrib/haskell/src/Hkl/Xrd/ZeroD.hs118
-rw-r--r--contrib/haskell/src/Tango/DeviceProxy.hsc47
-rw-r--r--contrib/haskell/src/ghkl.hs98
-rw-r--r--contrib/haskell/src/hkl.hs73
-rw-r--r--contrib/haskell/src/hkl3d.hs8
-rw-r--r--contrib/haskell/src/xrd.hs16
65 files changed, 13385 insertions, 0 deletions
diff --git a/contrib/haskell/LICENSE b/contrib/haskell/LICENSE
new file mode 100644
index 0000000..45644ff
--- /dev/null
+++ b/contrib/haskell/LICENSE
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, 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
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If 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 convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU 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
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "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 PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program 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 General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ <program> Copyright (C) <year> <name of author>
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<http://www.gnu.org/licenses/>.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/contrib/haskell/Setup.hs b/contrib/haskell/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/contrib/haskell/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/contrib/haskell/data/3d3.ui b/contrib/haskell/data/3d3.ui
new file mode 100644
index 0000000..3b8175d
--- /dev/null
+++ b/contrib/haskell/data/3d3.ui
@@ -0,0 +1,251 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- Generated with glade 3.20.0 -->
+<interface>
+ <requires lib="gtk+" version="3.0"/>
+ <object class="GtkFileChooserDialog" id="filechooserdialog1">
+ <property name="can_focus">False</property>
+ <property name="border_width">5</property>
+ <property name="type_hint">normal</property>
+ <property name="select_multiple">True</property>
+ <child internal-child="vbox">
+ <object class="GtkBox" id="dialog-vbox1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <property name="spacing">2</property>
+ <child internal-child="action_area">
+ <object class="GtkButtonBox" id="dialog-action_area1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="layout_style">end</property>
+ <child>
+ <object class="GtkButton" id="button2">
+ <property name="label">gtk-cancel</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <property name="use_stock">True</property>
+ <signal name="clicked" handler="hkl_gui_3d_button2_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="button1">
+ <property name="label">gtk-apply</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <property name="use_stock">True</property>
+ <signal name="clicked" handler="hkl_gui_3d_button1_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="pack_type">end</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ </object>
+ </child>
+ <action-widgets>
+ <action-widget response="0">button2</action-widget>
+ <action-widget response="0">button1</action-widget>
+ </action-widgets>
+ </object>
+ <object class="GtkTreeStore" id="treestore1">
+ <columns>
+ <!-- column-name name -->
+ <column type="gchararray"/>
+ <!-- column-name hide -->
+ <column type="gboolean"/>
+ <!-- column-name config -->
+ <column type="gpointer"/>
+ <!-- column-name object -->
+ <column type="gpointer"/>
+ </columns>
+ </object>
+ <object class="GtkFrame" id="frame1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label_xalign">0</property>
+ <property name="shadow_type">none</property>
+ <child>
+ <object class="GtkPaned" id="vpaned1">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="orientation">vertical</property>
+ <property name="position">181</property>
+ <child>
+ <object class="GtkBox" id="vbox1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <placeholder/>
+ </child>
+ <child>
+ <object class="GtkDrawingArea" id="drawingarea1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="events">GDK_EXPOSURE_MASK | GDK_STRUCTURE_MASK | GDK_SCROLL_MASK</property>
+ <signal name="scroll-event" handler="hkl_gui_3d_drawingarea1_scroll_event_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="resize">False</property>
+ <property name="shrink">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="vbox2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkToolbar" id="toolbar1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkToolButton" id="toolbutton1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="stock_id">gtk-add</property>
+ <signal name="clicked" handler="hkl_gui_3d_toolbutton1_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolButton" id="toolbutton2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="stock_id">gtk-remove</property>
+ <signal name="clicked" handler="hkl_gui_3d_toolbutton2_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolButton" id="toolbutton3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">3D view Reinitialize</property>
+ <property name="use_underline">True</property>
+ <property name="stock_id">gtk-home</property>
+ <signal name="clicked" handler="hkl_gui_3d_toolbutton3_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToggleToolButton" id="toolbutton4">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Aabb</property>
+ <property name="use_underline">True</property>
+ <property name="stock_id">gtk-apply</property>
+ <signal name="toggled" handler="hkl_gui_3d_toolbutton4_toggled_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkTreeView" id="treeview1">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="model">treestore1</property>
+ <property name="headers_clickable">False</property>
+ <property name="search_column">0</property>
+ <property name="enable_tree_lines">True</property>
+ <signal name="cursor-changed" handler="hkl_gui_3d_treeview1_cursor_changed_cb" swapped="no"/>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection" id="treeview-selection1"/>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn1">
+ <property name="title">name</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext1"/>
+ <attributes>
+ <attribute name="text">0</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn2">
+ <property name="title">hide</property>
+ <child>
+ <object class="GtkCellRendererToggle" id="cellrenderertext2">
+ <signal name="toggled" handler="hkl_gui_3d_cellrenderertext2_toggled_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="active">1</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="resize">True</property>
+ <property name="shrink">True</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">3D</property>
+ <attributes>
+ <attribute name="weight" value="bold"/>
+ </attributes>
+ </object>
+ </child>
+ </object>
+</interface>
diff --git a/contrib/haskell/data/ghkl3.ui b/contrib/haskell/data/ghkl3.ui
new file mode 100644
index 0000000..f9c8654
--- /dev/null
+++ b/contrib/haskell/data/ghkl3.ui
@@ -0,0 +1,2537 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- Generated with glade 3.20.0 -->
+<interface>
+ <requires lib="gtk+" version="3.14"/>
+ <object class="GtkAdjustment" id="adjustment1">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment10">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment11">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment12">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment13">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment14">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment15">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment16">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment17">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment18">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment19">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment2">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment20">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment21">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment22">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment23">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment24">
+ <property name="upper">100</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment25">
+ <property name="upper">100</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment26">
+ <property name="upper">100</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment27">
+ <property name="upper">100</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment28">
+ <property name="upper">100</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment29">
+ <property name="upper">100</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment3">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="value">-3</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment30">
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment31">
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment32">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment33">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment34">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment35">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment36">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment37">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment38">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment39">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment4">
+ <property name="upper">100</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment40">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment41">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment42">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment43">
+ <property name="lower">-100</property>
+ <property name="upper">100</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment5">
+ <property name="upper">10000</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment6">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">6</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment7">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment8">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkAdjustment" id="adjustment9">
+ <property name="lower">-180</property>
+ <property name="upper">180</property>
+ <property name="value">1</property>
+ <property name="step_increment">1</property>
+ <property name="page_increment">10</property>
+ </object>
+ <object class="GtkListStore" id="liststore_axis">
+ <columns>
+ <!-- column-name HklParameter -->
+ <column type="gpointer"/>
+ <!-- column-name name -->
+ <column type="gchararray"/>
+ <!-- column-name read -->
+ <column type="gdouble"/>
+ <!-- column-name write -->
+ <column type="gdouble"/>
+ <!-- column-name min -->
+ <column type="gdouble"/>
+ <!-- column-name max -->
+ <column type="gdouble"/>
+ </columns>
+ </object>
+ <object class="GtkListStore" id="liststore_crystals">
+ <columns>
+ <!-- column-name sample -->
+ <column type="gpointer"/>
+ <!-- column-name name -->
+ <column type="gchararray"/>
+ <!-- column-name a -->
+ <column type="gdouble"/>
+ <!-- column-name b -->
+ <column type="gdouble"/>
+ <!-- column-name c -->
+ <column type="gdouble"/>
+ <!-- column-name alpha -->
+ <column type="gdouble"/>
+ <!-- column-name beta -->
+ <column type="gdouble"/>
+ <!-- column-name gamma -->
+ <column type="gdouble"/>
+ </columns>
+ </object>
+ <object class="GtkListStore" id="liststore_diffractometer">
+ <columns>
+ <!-- column-name name -->
+ <column type="gchararray"/>
+ <!-- column-name HklFactory -->
+ <column type="gpointer"/>
+ <!-- column-name diffractometer_t -->
+ <column type="gpointer"/>
+ </columns>
+ </object>
+ <object class="GtkListStore" id="liststore_pseudo_axes">
+ <columns>
+ <!-- column-name idx -->
+ <column type="guint"/>
+ <!-- column-name HklEngine -->
+ <column type="gpointer"/>
+ <!-- column-name name -->
+ <column type="gchararray"/>
+ <!-- column-name read -->
+ <column type="gdouble"/>
+ <!-- column-name write -->
+ <column type="gdouble"/>
+ </columns>
+ </object>
+ <object class="GtkListStore" id="liststore_reflections">
+ <columns>
+ <!-- column-name index -->
+ <column type="guint"/>
+ <!-- column-name h -->
+ <column type="gdouble"/>
+ <!-- column-name k -->
+ <column type="gdouble"/>
+ <!-- column-name l -->
+ <column type="gdouble"/>
+ <!-- column-name flag -->
+ <column type="gboolean"/>
+ <!-- column-name reflection -->
+ <column type="gpointer"/>
+ </columns>
+ </object>
+ <object class="GtkWindow" id="window1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="title" translatable="yes">gHKL</property>
+ <child>
+ <object class="GtkBox" id="vbox1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkMenuBar" id="menubar1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkMenuItem" id="menuitem1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_Fichier</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="menu1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkImageMenuItem" id="imagemenuitem1">
+ <property name="label">gtk-new</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkImageMenuItem" id="imagemenuitem2">
+ <property name="label">gtk-open</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkImageMenuItem" id="imagemenuitem3">
+ <property name="label">gtk-save</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkImageMenuItem" id="imagemenuitem4">
+ <property name="label">gtk-save-as</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separatormenuitem1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkImageMenuItem" id="imagemenuitem5">
+ <property name="label">gtk-quit</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="gtk_main_quit" swapped="no"/>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="menuitem2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">É_dition</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="menu2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkImageMenuItem" id="imagemenuitem6">
+ <property name="label">gtk-cut</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkImageMenuItem" id="imagemenuitem7">
+ <property name="label">gtk-copy</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkImageMenuItem" id="imagemenuitem8">
+ <property name="label">gtk-paste</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkImageMenuItem" id="imagemenuitem9">
+ <property name="label">gtk-delete</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkImageMenuItem" id="menuitem5">
+ <property name="label">gtk-preferences</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="menuitem3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_Affichage</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="menuitem4">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Aid_e</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="menu3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkImageMenuItem" id="imagemenuitem10">
+ <property name="label">gtk-about</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkPaned" id="hpaned1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkBox" id="vbox3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkBox" id="box1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkFrame" id="frame2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label_xalign">0</property>
+ <property name="shadow_type">none</property>
+ <child>
+ <object class="GtkAlignment" id="alignment3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="left_padding">12</property>
+ <child>
+ <object class="GtkComboBox" id="combobox1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="model">liststore_diffractometer</property>
+ <property name="tearoff_title">Diffractometer Type</property>
+ <signal name="changed" handler="hkl_gui_window_combobox1_changed_cb" swapped="no"/>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext1"/>
+ <attributes>
+ <attribute name="text">0</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label17">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;Diffractometer&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkFrame" id="frame3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label_xalign">0</property>
+ <property name="shadow_type">none</property>
+ <child>
+ <object class="GtkAlignment" id="alignment4">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="left_padding">12</property>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_lambda">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment4</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <signal name="value-changed" handler="hkl_gui_window_spinbutton_lambda_value_changed_cb" swapped="no"/>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;Wave length&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkFrame" id="frame12">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label_xalign">0</property>
+ <property name="shadow_type">none</property>
+ <child>
+ <object class="GtkAlignment" id="alignment13">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="top_padding">6</property>
+ <property name="bottom_padding">6</property>
+ <property name="left_padding">12</property>
+ <child>
+ <object class="GtkTreeView" id="treeview_axes">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="model">liststore_axis</property>
+ <property name="rules_hint">True</property>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection" id="treeview-selection1"/>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn1">
+ <property name="title" translatable="yes">name</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext2"/>
+ <attributes>
+ <attribute name="text">1</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn2">
+ <property name="title" translatable="yes">read</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrendererspin1">
+ <property name="editable">True</property>
+ <signal name="edited" handler="hkl_gui_window_cellrendererspin1_edited_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="text">2</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn3">
+ <property name="title" translatable="yes">write</property>
+ <child>
+ <object class="GtkCellRendererSpin" id="cellrendererspin2"/>
+ <attributes>
+ <attribute name="text">3</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn6">
+ <property name="title" translatable="yes">min</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrendererspin3">
+ <property name="editable">True</property>
+ <signal name="edited" handler="hkl_gui_window_cellrendererspin3_edited_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="text">4</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn4">
+ <property name="title" translatable="yes">max</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrendererspin4">
+ <property name="editable">True</property>
+ <signal name="edited" handler="hkl_gui_window_cellrendererspin4_edited_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="text">5</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label58">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;Axes&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkFrame" id="frame13">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label_xalign">0</property>
+ <property name="shadow_type">none</property>
+ <child>
+ <object class="GtkAlignment" id="alignment14">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="top_padding">6</property>
+ <property name="bottom_padding">6</property>
+ <property name="left_padding">12</property>
+ <child>
+ <object class="GtkTreeView" id="treeview_pseudo_axes">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="model">liststore_pseudo_axes</property>
+ <property name="rules_hint">True</property>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection" id="treeview-selection2"/>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn5">
+ <property name="title" translatable="yes">name</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext3"/>
+ <attributes>
+ <attribute name="text">2</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn7">
+ <property name="title" translatable="yes">read</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext4"/>
+ <attributes>
+ <attribute name="text">3</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn8">
+ <property name="title" translatable="yes">write</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext5">
+ <property name="editable">True</property>
+ <signal name="edited" handler="hkl_gui_window_cellrenderertext5_edited_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="text">4</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label59">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;PseudoAxes&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkFrame" id="frame1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label_xalign">0</property>
+ <property name="shadow_type">none</property>
+ <child>
+ <object class="GtkAlignment" id="alignment1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="left_padding">12</property>
+ <child>
+ <object class="GtkBox" id="box_info_bar">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <property name="spacing">2</property>
+ <child>
+ <object class="GtkTreeView" id="treeview_solutions">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="rules_hint">True</property>
+ <signal name="cursor-changed" handler="hkl_gui_window_treeview_solutions_cursor_changed_cb" swapped="no"/>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection" id="treeview-selection4"/>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label5">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;Solutions&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">4</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="resize">False</property>
+ <property name="shrink">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkNotebook" id="notebook2">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="scrollable">True</property>
+ <child>
+ <object class="GtkBox" id="vbox_crystals">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="border_width">6</property>
+ <property name="orientation">vertical</property>
+ <property name="spacing">6</property>
+ <child>
+ <object class="GtkToolbar" id="toolbar2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="toolbar_style">both</property>
+ <child>
+ <object class="GtkToolButton" id="toolbutton_add_crystal">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock_id">gtk-add</property>
+ <signal name="clicked" handler="hkl_gui_window_toolbutton_add_crystal_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolButton" id="toolbutton_copy_crystal">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock_id">gtk-copy</property>
+ <signal name="clicked" handler="hkl_gui_window_toolbutton_copy_crystal_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolButton" id="toolbutton_del_crystal">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock_id">gtk-delete</property>
+ <signal name="clicked" handler="hkl_gui_window_toolbutton_del_crystal_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSeparatorToolItem" id="separatortoolitem2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolButton" id="toolbutton_setUB">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">set UB</property>
+ <property name="use_underline">True</property>
+ <property name="stock_id">gtk-preferences</property>
+ <signal name="clicked" handler="hkl_gui_window_toolbutton_setUB_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolButton" id="toolbutton_computeUB">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Compute UB</property>
+ <property name="use_underline">True</property>
+ <property name="stock_id">gtk-execute</property>
+ <signal name="clicked" handler="hkl_gui_window_toolbutton_computeUB_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolButton" id="toolbutton_affiner">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Refine</property>
+ <property name="use_underline">True</property>
+ <property name="stock_id">gtk-execute</property>
+ <signal name="clicked" handler="hkl_gui_window_toolbutton_affiner_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkScrolledWindow" id="scrolledwindow2">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">never</property>
+ <property name="shadow_type">in</property>
+ <child>
+ <object class="GtkTreeView" id="treeview_crystals">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="model">liststore_crystals</property>
+ <signal name="cursor-changed" handler="hkl_gui_window_treeview_crystals_cursor_changed_cb" swapped="no"/>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection" id="treeview-selection5"/>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn14">
+ <property name="title" translatable="yes">name</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext10">
+ <property name="editable">True</property>
+ <signal name="edited" handler="hkl_gui_window_cellrenderertext10_edited_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="text">1</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn15">
+ <property name="title" translatable="yes">a</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext11"/>
+ <attributes>
+ <attribute name="text">2</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn16">
+ <property name="title" translatable="yes">b</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext12"/>
+ <attributes>
+ <attribute name="text">3</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn17">
+ <property name="title" translatable="yes">c</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext13"/>
+ <attributes>
+ <attribute name="text">4</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn18">
+ <property name="title" translatable="yes">alpha</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext14"/>
+ <attributes>
+ <attribute name="text">5</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn19">
+ <property name="title" translatable="yes">beta</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext15"/>
+ <attributes>
+ <attribute name="text">6</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn20">
+ <property name="title" translatable="yes">gamma</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext16"/>
+ <attributes>
+ <attribute name="text">7</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkNotebook" id="notebook1">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <child>
+ <object class="GtkBox" id="vbox6">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkFrame" id="frame4">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label_xalign">0</property>
+ <property name="shadow_type">none</property>
+ <child>
+ <object class="GtkAlignment" id="alignment5">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="left_padding">12</property>
+ <child>
+ <object class="GtkGrid">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkLabel" id="label3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;x&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label6">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;y&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label4">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;z&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label12">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;a*&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label_UB11">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label32</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label_UB21">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label35</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label_UB31">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label38</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label13">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;b*&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label_UB12">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label33</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label_UB22">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label36</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label_UB32">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label39</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label14">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;c*&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label_UB13">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label34</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label_UB23">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label37</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label_UB33">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label40</property>
+ <property name="use_markup">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label7">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">&lt;b&gt;UB&lt;/b&gt;</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkGrid">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkLabel" id="label46">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Values</property>
+ <property name="justify">center</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_a">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment6</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkCheckButton" id="checkbutton_a">
+ <property name="label" translatable="yes">a</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_underline">True</property>
+ <property name="draw_indicator">True</property>
+ <signal name="toggled" handler="hkl_gui_window_checkbutton_a_toggled_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkCheckButton" id="checkbutton_b">
+ <property name="label" translatable="yes">b</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_underline">True</property>
+ <property name="draw_indicator">True</property>
+ <signal name="toggled" handler="hkl_gui_window_checkbutton_b_toggled_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkCheckButton" id="checkbutton_c">
+ <property name="label" translatable="yes">c</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_underline">True</property>
+ <property name="draw_indicator">True</property>
+ <signal name="toggled" handler="hkl_gui_window_checkbutton_c_toggled_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkCheckButton" id="checkbutton_alpha">
+ <property name="label" translatable="yes">alpha</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_underline">True</property>
+ <property name="draw_indicator">True</property>
+ <signal name="toggled" handler="hkl_gui_window_checkbutton_alpha_toggled_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkCheckButton" id="checkbutton_beta">
+ <property name="label" translatable="yes">beta</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_underline">True</property>
+ <property name="draw_indicator">True</property>
+ <signal name="toggled" handler="hkl_gui_window_checkbutton_beta_toggled_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">5</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkCheckButton" id="checkbutton_gamma">
+ <property name="label" translatable="yes">gamma</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_underline">True</property>
+ <property name="draw_indicator">True</property>
+ <signal name="toggled" handler="hkl_gui_window_checkbutton_gamma_toggled_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">6</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_b">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment7</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_c">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment8</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_alpha">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment9</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_beta">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment10</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">5</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_gamma">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment11</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">6</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkCheckButton" id="checkbutton_ux">
+ <property name="label" translatable="yes">Ux</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_underline">True</property>
+ <property name="draw_indicator">True</property>
+ <signal name="toggled" handler="hkl_gui_window_checkbutton_ux_toggled_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">7</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkCheckButton" id="checkbutton_uy">
+ <property name="label" translatable="yes">Uy</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_underline">True</property>
+ <property name="draw_indicator">True</property>
+ <signal name="toggled" handler="hkl_gui_window_checkbutton_uy_toggled_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">8</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkCheckButton" id="checkbutton_uz">
+ <property name="label" translatable="yes">Uz</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_underline">True</property>
+ <property name="draw_indicator">True</property>
+ <signal name="toggled" handler="hkl_gui_window_checkbutton_uz_toggled_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">9</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_ux">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment32</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <signal name="value-changed" handler="hkl_gui_window_spinbutton_ux_value_changed_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">7</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_uy">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment33</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <signal name="value-changed" handler="hkl_gui_window_spinbutton_uy_value_changed_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">8</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_uz">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment34</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <signal name="value-changed" handler="hkl_gui_window_spinbutton_uz_value_changed_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">9</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label47">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Minimum</property>
+ <property name="justify">center</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label48">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Maximum</property>
+ <property name="justify">center</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_a_min">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment12</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_b_min">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment13</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_c_min">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment14</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_alpha_min">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment15</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_beta_min">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment16</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">5</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_gamma_min">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment17</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">6</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_a_max">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment18</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_b_max">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment19</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_c_max">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment20</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_alpha_max">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment21</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_beta_max">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment22</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">5</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_gamma_max">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment23</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="update_policy">if-valid</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">6</property>
+ </packing>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButtonBox">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <property name="layout_style">start</property>
+ <child>
+ <object class="GtkButton" id="button2">
+ <property name="label">gtk-apply</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <property name="use_stock">True</property>
+ <signal name="clicked" handler="hkl_gui_window_button2_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="box2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkGrid">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_U11">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment35</property>
+ <property name="digits">4</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_U21">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment38</property>
+ <property name="digits">4</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_U31">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment41</property>
+ <property name="digits">4</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_U12">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment36</property>
+ <property name="digits">4</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_U22">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment39</property>
+ <property name="digits">4</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_U32">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment42</property>
+ <property name="digits">4</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_U13">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment37</property>
+ <property name="digits">4</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_U23">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment40</property>
+ <property name="digits">4</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_U33">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="adjustment">adjustment43</property>
+ <property name="digits">4</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ <child>
+ <placeholder/>
+ </child>
+ </object>
+ <packing>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="label8">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Parameters</property>
+ </object>
+ <packing>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkGrid" id="grid1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkLabel" id="label20">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">a*</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_a_star">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="text" translatable="yes">1,000</property>
+ <property name="orientation">vertical</property>
+ <property name="adjustment">adjustment24</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="value">1</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label26">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">alpha*</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_alpha_star">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="text" translatable="yes">1,000</property>
+ <property name="orientation">vertical</property>
+ <property name="adjustment">adjustment26</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="value">1</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label21">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">b*</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_b_star">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="text" translatable="yes">1,000</property>
+ <property name="orientation">vertical</property>
+ <property name="adjustment">adjustment29</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="value">1</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label27">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">beta*</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_beta_star">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="text" translatable="yes">1,000</property>
+ <property name="orientation">vertical</property>
+ <property name="adjustment">adjustment27</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="value">1</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label22">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">c*</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_c_star">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="text" translatable="yes">1,000</property>
+ <property name="orientation">vertical</property>
+ <property name="adjustment">adjustment25</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="value">1</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label28">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">gamma*</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSpinButton" id="spinbutton_gamma_star">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">True</property>
+ <property name="invisible_char">●</property>
+ <property name="text" translatable="yes">1,000</property>
+ <property name="orientation">vertical</property>
+ <property name="adjustment">adjustment28</property>
+ <property name="climb_rate">1</property>
+ <property name="digits">3</property>
+ <property name="numeric">True</property>
+ <property name="value">1</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="label2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">extra</property>
+ </object>
+ <packing>
+ <property name="position">1</property>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="vbox4">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <property name="spacing">3</property>
+ <child>
+ <object class="GtkToolbar" id="toolbar1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="toolbar_style">both</property>
+ <child>
+ <object class="GtkToolButton" id="toolbutton_add_reflection">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock_id">gtk-add</property>
+ <signal name="clicked" handler="hkl_gui_window_toolbutton_add_reflection_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolButton" id="toolbutton_goto_reflection">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock_id">gtk-jump-to</property>
+ <signal name="clicked" handler="hkl_gui_window_toolbutton_goto_reflection_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolButton" id="toolbutton_del_reflection">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock_id">gtk-delete</property>
+ <signal name="clicked" handler="hkl_gui_window_toolbutton_del_reflection_clicked_cb" swapped="no"/>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSeparatorToolItem" id="separatortoolitem1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkScrolledWindow" id="scrolledwindow1">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">never</property>
+ <property name="shadow_type">in</property>
+ <child>
+ <object class="GtkTreeView" id="treeview_reflections">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="model">liststore_reflections</property>
+ <property name="headers_clickable">False</property>
+ <property name="rules_hint">True</property>
+ <signal name="key-press-event" handler="hkl_gui_window_treeview_reflections_key_press_event_cb" swapped="no"/>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection" id="treeview-selection6">
+ <property name="mode">multiple</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn9">
+ <property name="title" translatable="yes">index</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext6"/>
+ <attributes>
+ <attribute name="text">0</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn10">
+ <property name="title" translatable="yes">h</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext7">
+ <property name="editable">True</property>
+ <signal name="edited" handler="hkl_gui_window_cellrenderertext7_edited_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="text">1</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn11">
+ <property name="title" translatable="yes">k</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext8">
+ <property name="editable">True</property>
+ <signal name="edited" handler="hkl_gui_window_cellrenderertext8_edited_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="text">2</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn12">
+ <property name="title" translatable="yes">l</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext9">
+ <property name="editable">True</property>
+ <signal name="edited" handler="hkl_gui_window_cellrenderertext9_edited_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="text">3</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn13">
+ <property name="title" translatable="yes">flag</property>
+ <child>
+ <object class="GtkCellRendererToggle" id="cellrenderertoggle1">
+ <signal name="toggled" handler="hkl_gui_window_cellrenderertoggle1_toggled_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="active">4</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="label16">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">reflections</property>
+ </object>
+ <packing>
+ <property name="position">2</property>
+ <property name="tab_fill">False</property>
+ <property name="reorderable">True</property>
+ <property name="detachable">True</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="label10">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="margin_bottom">1</property>
+ <property name="label" translatable="yes">crystals</property>
+ </object>
+ <packing>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkScrolledWindow" id="scrolledwindow3">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="shadow_type">in</property>
+ <child>
+ <object class="GtkViewport" id="viewport1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkAlignment" id="alignment2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkBox" id="vbox2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <placeholder/>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="label11">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">pseudo axes</property>
+ </object>
+ <packing>
+ <property name="position">1</property>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="vbox7">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <placeholder/>
+ </child>
+ </object>
+ <packing>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="label15">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">3D</property>
+ </object>
+ <packing>
+ <property name="position">2</property>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="resize">True</property>
+ <property name="shrink">True</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkStatusbar" id="statusbar">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+</interface>
diff --git a/contrib/haskell/data/gprof2dot.py b/contrib/haskell/data/gprof2dot.py
new file mode 100755
index 0000000..30cf683
--- /dev/null
+++ b/contrib/haskell/data/gprof2dot.py
@@ -0,0 +1,3293 @@
+#!/usr/bin/env python
+#
+# Copyright 2008-2018 Jose Fonseca
+#
+# This program 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 3 of the License, or
+# (at your option) any later version.
+#
+# This program 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 program. If not, see <http://www.gnu.org/licenses/>.
+#
+
+"""Generate a dot graph from the output of several profilers."""
+
+__author__ = "Jose Fonseca et al"
+
+
+import sys
+import math
+import os.path
+import re
+import textwrap
+import optparse
+import xml.parsers.expat
+import collections
+import locale
+import json
+
+
+# Python 2.x/3.x compatibility
+if sys.version_info[0] >= 3:
+ PYTHON_3 = True
+ def compat_iteritems(x): return x.items() # No iteritems() in Python 3
+ def compat_itervalues(x): return x.values() # No itervalues() in Python 3
+ def compat_keys(x): return list(x.keys()) # keys() is a generator in Python 3
+ basestring = str # No class basestring in Python 3
+ unichr = chr # No unichr in Python 3
+ xrange = range # No xrange in Python 3
+else:
+ PYTHON_3 = False
+ def compat_iteritems(x): return x.iteritems()
+ def compat_itervalues(x): return x.itervalues()
+ def compat_keys(x): return x.keys()
+
+
+try:
+ # Debugging helper module
+ import debug
+except ImportError:
+ pass
+
+
+
+########################################################################
+# Model
+
+
+MULTIPLICATION_SIGN = unichr(0xd7)
+
+
+def times(x):
+ return "%u%s" % (x, MULTIPLICATION_SIGN)
+
+def percentage(p):
+ return "%.02f%%" % (p*100.0,)
+
+def add(a, b):
+ return a + b
+
+def fail(a, b):
+ assert False
+
+
+tol = 2 ** -23
+
+def ratio(numerator, denominator):
+ try:
+ ratio = float(numerator)/float(denominator)
+ except ZeroDivisionError:
+ # 0/0 is undefined, but 1.0 yields more useful results
+ return 1.0
+ if ratio < 0.0:
+ if ratio < -tol:
+ sys.stderr.write('warning: negative ratio (%s/%s)\n' % (numerator, denominator))
+ return 0.0
+ if ratio > 1.0:
+ if ratio > 1.0 + tol:
+ sys.stderr.write('warning: ratio greater than one (%s/%s)\n' % (numerator, denominator))
+ return 1.0
+ return ratio
+
+
+class UndefinedEvent(Exception):
+ """Raised when attempting to get an event which is undefined."""
+
+ def __init__(self, event):
+ Exception.__init__(self)
+ self.event = event
+
+ def __str__(self):
+ return 'unspecified event %s' % self.event.name
+
+
+class Event(object):
+ """Describe a kind of event, and its basic operations."""
+
+ def __init__(self, name, null, aggregator, formatter = str):
+ self.name = name
+ self._null = null
+ self._aggregator = aggregator
+ self._formatter = formatter
+
+ def __eq__(self, other):
+ return self is other
+
+ def __hash__(self):
+ return id(self)
+
+ def null(self):
+ return self._null
+
+ def aggregate(self, val1, val2):
+ """Aggregate two event values."""
+ assert val1 is not None
+ assert val2 is not None
+ return self._aggregator(val1, val2)
+
+ def format(self, val):
+ """Format an event value."""
+ assert val is not None
+ return self._formatter(val)
+
+
+CALLS = Event("Calls", 0, add, times)
+SAMPLES = Event("Samples", 0, add, times)
+SAMPLES2 = Event("Samples", 0, add, times)
+
+# Count of samples where a given function was either executing or on the stack.
+# This is used to calculate the total time ratio according to the
+# straightforward method described in Mike Dunlavey's answer to
+# stackoverflow.com/questions/1777556/alternatives-to-gprof, item 4 (the myth
+# "that recursion is a tricky confusing issue"), last edited 2012-08-30: it's
+# just the ratio of TOTAL_SAMPLES over the number of samples in the profile.
+#
+# Used only when totalMethod == callstacks
+TOTAL_SAMPLES = Event("Samples", 0, add, times)
+
+TIME = Event("Time", 0.0, add, lambda x: '(' + str(x) + ')')
+TIME_RATIO = Event("Time ratio", 0.0, add, lambda x: '(' + percentage(x) + ')')
+TOTAL_TIME = Event("Total time", 0.0, fail)
+TOTAL_TIME_RATIO = Event("Total time ratio", 0.0, fail, percentage)
+
+totalMethod = 'callratios'
+
+
+class Object(object):
+ """Base class for all objects in profile which can store events."""
+
+ def __init__(self, events=None):
+ if events is None:
+ self.events = {}
+ else:
+ self.events = events
+
+ def __hash__(self):
+ return id(self)
+
+ def __eq__(self, other):
+ return self is other
+
+ def __lt__(self, other):
+ return id(self) < id(other)
+
+ def __contains__(self, event):
+ return event in self.events
+
+ def __getitem__(self, event):
+ try:
+ return self.events[event]
+ except KeyError:
+ raise UndefinedEvent(event)
+
+ def __setitem__(self, event, value):
+ if value is None:
+ if event in self.events:
+ del self.events[event]
+ else:
+ self.events[event] = value
+
+
+class Call(Object):
+ """A call between functions.
+
+ There should be at most one call object for every pair of functions.
+ """
+
+ def __init__(self, callee_id):
+ Object.__init__(self)
+ self.callee_id = callee_id
+ self.ratio = None
+ self.weight = None
+
+
+class Function(Object):
+ """A function."""
+
+ def __init__(self, id, name):
+ Object.__init__(self)
+ self.id = id
+ self.name = name
+ self.module = None
+ self.process = None
+ self.calls = {}
+ self.called = None
+ self.weight = None
+ self.cycle = None
+ self.filename = None
+
+ def add_call(self, call):
+ if call.callee_id in self.calls:
+ sys.stderr.write('warning: overwriting call from function %s to %s\n' % (str(self.id), str(call.callee_id)))
+ self.calls[call.callee_id] = call
+
+ def get_call(self, callee_id):
+ if not callee_id in self.calls:
+ call = Call(callee_id)
+ call[SAMPLES] = 0
+ call[SAMPLES2] = 0
+ call[CALLS] = 0
+ self.calls[callee_id] = call
+ return self.calls[callee_id]
+
+ _parenthesis_re = re.compile(r'\([^()]*\)')
+ _angles_re = re.compile(r'<[^<>]*>')
+ _const_re = re.compile(r'\s+const$')
+
+ def stripped_name(self):
+ """Remove extraneous information from C++ demangled function names."""
+
+ name = self.name
+
+ # Strip function parameters from name by recursively removing paired parenthesis
+ while True:
+ name, n = self._parenthesis_re.subn('', name)
+ if not n:
+ break
+
+ # Strip const qualifier
+ name = self._const_re.sub('', name)
+
+ # Strip template parameters from name by recursively removing paired angles
+ while True:
+ name, n = self._angles_re.subn('', name)
+ if not n:
+ break
+
+ return name
+
+ # TODO: write utility functions
+
+ def __repr__(self):
+ return self.name
+
+
+class Cycle(Object):
+ """A cycle made from recursive function calls."""
+
+ def __init__(self):
+ Object.__init__(self)
+ self.functions = set()
+
+ def add_function(self, function):
+ assert function not in self.functions
+ self.functions.add(function)
+ if function.cycle is not None:
+ for other in function.cycle.functions:
+ if function not in self.functions:
+ self.add_function(other)
+ function.cycle = self
+
+
+class Profile(Object):
+ """The whole profile."""
+
+ def __init__(self):
+ Object.__init__(self)
+ self.functions = {}
+ self.cycles = []
+
+ def add_function(self, function):
+ if function.id in self.functions:
+ sys.stderr.write('warning: overwriting function %s (id %s)\n' % (function.name, str(function.id)))
+ self.functions[function.id] = function
+
+ def add_cycle(self, cycle):
+ self.cycles.append(cycle)
+
+ def validate(self):
+ """Validate the edges."""
+
+ for function in compat_itervalues(self.functions):
+ for callee_id in compat_keys(function.calls):
+ assert function.calls[callee_id].callee_id == callee_id
+ if callee_id not in self.functions:
+ sys.stderr.write('warning: call to undefined function %s from function %s\n' % (str(callee_id), function.name))
+ del function.calls[callee_id]
+
+ def find_cycles(self):
+ """Find cycles using Tarjan's strongly connected components algorithm."""
+
+ # Apply the Tarjan's algorithm successively until all functions are visited
+ stack = []
+ data = {}
+ order = 0
+ for function in compat_itervalues(self.functions):
+ order = self._tarjan(function, order, stack, data)
+ cycles = []
+ for function in compat_itervalues(self.functions):
+ if function.cycle is not None and function.cycle not in cycles:
+ cycles.append(function.cycle)
+ self.cycles = cycles
+ if 0:
+ for cycle in cycles:
+ sys.stderr.write("Cycle:\n")
+ for member in cycle.functions:
+ sys.stderr.write("\tFunction %s\n" % member.name)
+
+ def prune_root(self, root):
+ visited = set()
+ frontier = set([root])
+ while len(frontier) > 0:
+ node = frontier.pop()
+ visited.add(node)
+ f = self.functions[node]
+ newNodes = f.calls.keys()
+ frontier = frontier.union(set(newNodes) - visited)
+ subtreeFunctions = {}
+ for n in visited:
+ subtreeFunctions[n] = self.functions[n]
+ self.functions = subtreeFunctions
+
+ def prune_leaf(self, leaf):
+ edgesUp = collections.defaultdict(set)
+ for f in self.functions.keys():
+ for n in self.functions[f].calls.keys():
+ edgesUp[n].add(f)
+ # build the tree up
+ visited = set()
+ frontier = set([leaf])
+ while len(frontier) > 0:
+ node = frontier.pop()
+ visited.add(node)
+ frontier = frontier.union(edgesUp[node] - visited)
+ downTree = set(self.functions.keys())
+ upTree = visited
+ path = downTree.intersection(upTree)
+ pathFunctions = {}
+ for n in path:
+ f = self.functions[n]
+ newCalls = {}
+ for c in f.calls.keys():
+ if c in path:
+ newCalls[c] = f.calls[c]
+ f.calls = newCalls
+ pathFunctions[n] = f
+ self.functions = pathFunctions
+
+
+ def getFunctionId(self, funcName):
+ for f in self.functions:
+ if self.functions[f].name == funcName:
+ return f
+ return False
+
+ class _TarjanData:
+ def __init__(self, order):
+ self.order = order
+ self.lowlink = order
+ self.onstack = False
+
+ def _tarjan(self, function, order, stack, data):
+ """Tarjan's strongly connected components algorithm.
+
+ See also:
+ - http://en.wikipedia.org/wiki/Tarjan's_strongly_connected_components_algorithm
+ """
+
+ try:
+ func_data = data[function.id]
+ return order
+ except KeyError:
+ func_data = self._TarjanData(order)
+ data[function.id] = func_data
+ order += 1
+ pos = len(stack)
+ stack.append(function)
+ func_data.onstack = True
+ for call in compat_itervalues(function.calls):
+ try:
+ callee_data = data[call.callee_id]
+ if callee_data.onstack:
+ func_data.lowlink = min(func_data.lowlink, callee_data.order)
+ except KeyError:
+ callee = self.functions[call.callee_id]
+ order = self._tarjan(callee, order, stack, data)
+ callee_data = data[call.callee_id]
+ func_data.lowlink = min(func_data.lowlink, callee_data.lowlink)
+ if func_data.lowlink == func_data.order:
+ # Strongly connected component found
+ members = stack[pos:]
+ del stack[pos:]
+ if len(members) > 1:
+ cycle = Cycle()
+ for member in members:
+ cycle.add_function(member)
+ data[member.id].onstack = False
+ else:
+ for member in members:
+ data[member.id].onstack = False
+ return order
+
+ def call_ratios(self, event):
+ # Aggregate for incoming calls
+ cycle_totals = {}
+ for cycle in self.cycles:
+ cycle_totals[cycle] = 0.0
+ function_totals = {}
+ for function in compat_itervalues(self.functions):
+ function_totals[function] = 0.0
+
+ # Pass 1: function_total gets the sum of call[event] for all
+ # incoming arrows. Same for cycle_total for all arrows
+ # that are coming into the *cycle* but are not part of it.
+ for function in compat_itervalues(self.functions):
+ for call in compat_itervalues(function.calls):
+ if call.callee_id != function.id:
+ callee = self.functions[call.callee_id]
+ if event in call.events:
+ function_totals[callee] += call[event]
+ if callee.cycle is not None and callee.cycle is not function.cycle:
+ cycle_totals[callee.cycle] += call[event]
+ else:
+ sys.stderr.write("call_ratios: No data for " + function.name + " call to " + callee.name + "\n")
+
+ # Pass 2: Compute the ratios. Each call[event] is scaled by the
+ # function_total of the callee. Calls into cycles use the
+ # cycle_total, but not calls within cycles.
+ for function in compat_itervalues(self.functions):
+ for call in compat_itervalues(function.calls):
+ assert call.ratio is None
+ if call.callee_id != function.id:
+ callee = self.functions[call.callee_id]
+ if event in call.events:
+ if callee.cycle is not None and callee.cycle is not function.cycle:
+ total = cycle_totals[callee.cycle]
+ else:
+ total = function_totals[callee]
+ call.ratio = ratio(call[event], total)
+ else:
+ # Warnings here would only repeat those issued above.
+ call.ratio = 0.0
+
+ def integrate(self, outevent, inevent):
+ """Propagate function time ratio along the function calls.
+
+ Must be called after finding the cycles.
+
+ See also:
+ - http://citeseer.ist.psu.edu/graham82gprof.html
+ """
+
+ # Sanity checking
+ assert outevent not in self
+ for function in compat_itervalues(self.functions):
+ assert outevent not in function
+ assert inevent in function
+ for call in compat_itervalues(function.calls):
+ assert outevent not in call
+ if call.callee_id != function.id:
+ assert call.ratio is not None
+
+ # Aggregate the input for each cycle
+ for cycle in self.cycles:
+ total = inevent.null()
+ for function in compat_itervalues(self.functions):
+ total = inevent.aggregate(total, function[inevent])
+ self[inevent] = total
+
+ # Integrate along the edges
+ total = inevent.null()
+ for function in compat_itervalues(self.functions):
+ total = inevent.aggregate(total, function[inevent])
+ self._integrate_function(function, outevent, inevent)
+ self[outevent] = total
+
+ def _integrate_function(self, function, outevent, inevent):
+ if function.cycle is not None:
+ return self._integrate_cycle(function.cycle, outevent, inevent)
+ else:
+ if outevent not in function:
+ total = function[inevent]
+ for call in compat_itervalues(function.calls):
+ if call.callee_id != function.id:
+ total += self._integrate_call(call, outevent, inevent)
+ function[outevent] = total
+ return function[outevent]
+
+ def _integrate_call(self, call, outevent, inevent):
+ assert outevent not in call
+ assert call.ratio is not None
+ callee = self.functions[call.callee_id]
+ subtotal = call.ratio *self._integrate_function(callee, outevent, inevent)
+ call[outevent] = subtotal
+ return subtotal
+
+ def _integrate_cycle(self, cycle, outevent, inevent):
+ if outevent not in cycle:
+
+ # Compute the outevent for the whole cycle
+ total = inevent.null()
+ for member in cycle.functions:
+ subtotal = member[inevent]
+ for call in compat_itervalues(member.calls):
+ callee = self.functions[call.callee_id]
+ if callee.cycle is not cycle:
+ subtotal += self._integrate_call(call, outevent, inevent)
+ total += subtotal
+ cycle[outevent] = total
+
+ # Compute the time propagated to callers of this cycle
+ callees = {}
+ for function in compat_itervalues(self.functions):
+ if function.cycle is not cycle:
+ for call in compat_itervalues(function.calls):
+ callee = self.functions[call.callee_id]
+ if callee.cycle is cycle:
+ try:
+ callees[callee] += call.ratio
+ except KeyError:
+ callees[callee] = call.ratio
+
+ for member in cycle.functions:
+ member[outevent] = outevent.null()
+
+ for callee, call_ratio in compat_iteritems(callees):
+ ranks = {}
+ call_ratios = {}
+ partials = {}
+ self._rank_cycle_function(cycle, callee, ranks)
+ self._call_ratios_cycle(cycle, callee, ranks, call_ratios, set())
+ partial = self._integrate_cycle_function(cycle, callee, call_ratio, partials, ranks, call_ratios, outevent, inevent)
+
+ # Ensure `partial == max(partials.values())`, but with round-off tolerance
+ max_partial = max(partials.values())
+ assert abs(partial - max_partial) <= 1e-7*max_partial
+
+ assert abs(call_ratio*total - partial) <= 0.001*call_ratio*total
+
+ return cycle[outevent]
+
+ def _rank_cycle_function(self, cycle, function, ranks):
+ """Dijkstra's shortest paths algorithm.
+
+ See also:
+ - http://en.wikipedia.org/wiki/Dijkstra's_algorithm
+ """
+
+ import heapq
+ Q = []
+ Qd = {}
+ p = {}
+ visited = set([function])
+
+ ranks[function] = 0
+ for call in compat_itervalues(function.calls):
+ if call.callee_id != function.id:
+ callee = self.functions[call.callee_id]
+ if callee.cycle is cycle:
+ ranks[callee] = 1
+ item = [ranks[callee], function, callee]
+ heapq.heappush(Q, item)
+ Qd[callee] = item
+
+ while Q:
+ cost, parent, member = heapq.heappop(Q)
+ if member not in visited:
+ p[member]= parent
+ visited.add(member)
+ for call in compat_itervalues(member.calls):
+ if call.callee_id != member.id:
+ callee = self.functions[call.callee_id]
+ if callee.cycle is cycle:
+ member_rank = ranks[member]
+ rank = ranks.get(callee)
+ if rank is not None:
+ if rank > 1 + member_rank:
+ rank = 1 + member_rank
+ ranks[callee] = rank
+ Qd_callee = Qd[callee]
+ Qd_callee[0] = rank
+ Qd_callee[1] = member
+ heapq._siftdown(Q, 0, Q.index(Qd_callee))
+ else:
+ rank = 1 + member_rank
+ ranks[callee] = rank
+ item = [rank, member, callee]
+ heapq.heappush(Q, item)
+ Qd[callee] = item
+
+ def _call_ratios_cycle(self, cycle, function, ranks, call_ratios, visited):
+ if function not in visited:
+ visited.add(function)
+ for call in compat_itervalues(function.calls):
+ if call.callee_id != function.id:
+ callee = self.functions[call.callee_id]
+ if callee.cycle is cycle:
+ if ranks[callee] > ranks[function]:
+ call_ratios[callee] = call_ratios.get(callee, 0.0) + call.ratio
+ self._call_ratios_cycle(cycle, callee, ranks, call_ratios, visited)
+
+ def _integrate_cycle_function(self, cycle, function, partial_ratio, partials, ranks, call_ratios, outevent, inevent):
+ if function not in partials:
+ partial = partial_ratio*function[inevent]
+ for call in compat_itervalues(function.calls):
+ if call.callee_id != function.id:
+ callee = self.functions[call.callee_id]
+ if callee.cycle is not cycle:
+ assert outevent in call
+ partial += partial_ratio*call[outevent]
+ else:
+ if ranks[callee] > ranks[function]:
+ callee_partial = self._integrate_cycle_function(cycle, callee, partial_ratio, partials, ranks, call_ratios, outevent, inevent)
+ call_ratio = ratio(call.ratio, call_ratios[callee])
+ call_partial = call_ratio*callee_partial
+ try:
+ call[outevent] += call_partial
+ except UndefinedEvent:
+ call[outevent] = call_partial
+ partial += call_partial
+ partials[function] = partial
+ try:
+ function[outevent] += partial
+ except UndefinedEvent:
+ function[outevent] = partial
+ return partials[function]
+
+ def aggregate(self, event):
+ """Aggregate an event for the whole profile."""
+
+ total = event.null()
+ for function in compat_itervalues(self.functions):
+ try:
+ total = event.aggregate(total, function[event])
+ except UndefinedEvent:
+ return
+ self[event] = total
+
+ def ratio(self, outevent, inevent):
+ assert outevent not in self
+ assert inevent in self
+ for function in compat_itervalues(self.functions):
+ assert outevent not in function
+ assert inevent in function
+ function[outevent] = ratio(function[inevent], self[inevent])
+ for call in compat_itervalues(function.calls):
+ assert outevent not in call
+ if inevent in call:
+ call[outevent] = ratio(call[inevent], self[inevent])
+ self[outevent] = 1.0
+
+ def prune(self, node_thres, edge_thres, colour_nodes_by_selftime):
+ """Prune the profile"""
+
+ # compute the prune ratios
+ for function in compat_itervalues(self.functions):
+ try:
+ function.weight = function[TOTAL_TIME_RATIO]
+ except UndefinedEvent:
+ pass
+
+ for call in compat_itervalues(function.calls):
+ callee = self.functions[call.callee_id]
+
+ if TOTAL_TIME_RATIO in call:
+ # handle exact cases first
+ call.weight = call[TOTAL_TIME_RATIO]
+ else:
+ try:
+ # make a safe estimate
+ call.weight = min(function[TOTAL_TIME_RATIO], callee[TOTAL_TIME_RATIO])
+ except UndefinedEvent:
+ pass
+
+ # prune the nodes
+ for function_id in compat_keys(self.functions):
+ function = self.functions[function_id]
+ if function.weight is not None:
+ if function.weight < node_thres:
+ del self.functions[function_id]
+
+ # prune the egdes
+ for function in compat_itervalues(self.functions):
+ for callee_id in compat_keys(function.calls):
+ call = function.calls[callee_id]
+ if callee_id not in self.functions or call.weight is not None and call.weight < edge_thres:
+ del function.calls[callee_id]
+
+ if colour_nodes_by_selftime:
+ weights = []
+ for function in compat_itervalues(self.functions):
+ try:
+ weights.append(function[TIME_RATIO])
+ except UndefinedEvent:
+ pass
+ max_ratio = max(weights or [1])
+
+ # apply rescaled weights for coloriung
+ for function in compat_itervalues(self.functions):
+ try:
+ function.weight = function[TIME_RATIO] / max_ratio
+ except (ZeroDivisionError, UndefinedEvent):
+ pass
+
+ def dump(self):
+ for function in compat_itervalues(self.functions):
+ sys.stderr.write('Function %s:\n' % (function.name,))
+ self._dump_events(function.events)
+ for call in compat_itervalues(function.calls):
+ callee = self.functions[call.callee_id]
+ sys.stderr.write(' Call %s:\n' % (callee.name,))
+ self._dump_events(call.events)
+ for cycle in self.cycles:
+ sys.stderr.write('Cycle:\n')
+ self._dump_events(cycle.events)
+ for function in cycle.functions:
+ sys.stderr.write(' Function %s\n' % (function.name,))
+
+ def _dump_events(self, events):
+ for event, value in compat_iteritems(events):
+ sys.stderr.write(' %s: %s\n' % (event.name, event.format(value)))
+
+
+
+########################################################################
+# Parsers
+
+
+class Struct:
+ """Masquerade a dictionary with a structure-like behavior."""
+
+ def __init__(self, attrs = None):
+ if attrs is None:
+ attrs = {}
+ self.__dict__['_attrs'] = attrs
+
+ def __getattr__(self, name):
+ try:
+ return self._attrs[name]
+ except KeyError:
+ raise AttributeError(name)
+
+ def __setattr__(self, name, value):
+ self._attrs[name] = value
+
+ def __str__(self):
+ return str(self._attrs)
+
+ def __repr__(self):
+ return repr(self._attrs)
+
+
+class ParseError(Exception):
+ """Raised when parsing to signal mismatches."""
+
+ def __init__(self, msg, line):
+ Exception.__init__(self)
+ self.msg = msg
+ # TODO: store more source line information
+ self.line = line
+
+ def __str__(self):
+ return '%s: %r' % (self.msg, self.line)
+
+
+class Parser:
+ """Parser interface."""
+
+ stdinInput = True
+ multipleInput = False
+
+ def __init__(self):
+ pass
+
+ def parse(self):
+ raise NotImplementedError
+
+
+class JsonParser(Parser):
+ """Parser for a custom JSON representation of profile data.
+
+ See schema.json for details.
+ """
+
+
+ def __init__(self, stream):
+ Parser.__init__(self)
+ self.stream = stream
+
+ def parse(self):
+
+ obj = json.load(self.stream)
+
+ assert obj['version'] == 0
+
+ profile = Profile()
+ profile[SAMPLES] = 0
+
+ fns = obj['functions']
+
+ for functionIndex in range(len(fns)):
+ fn = fns[functionIndex]
+ function = Function(functionIndex, fn['name'])
+ try:
+ function.module = fn['module']
+ except KeyError:
+ pass
+ try:
+ function.process = fn['process']
+ except KeyError:
+ pass
+ function[SAMPLES] = 0
+ profile.add_function(function)
+
+ for event in obj['events']:
+ callchain = []
+
+ for functionIndex in event['callchain']:
+ function = profile.functions[functionIndex]
+ callchain.append(function)
+
+ cost = event['cost'][0]
+
+ callee = callchain[0]
+ callee[SAMPLES] += cost
+ profile[SAMPLES] += cost
+
+ for caller in callchain[1:]:
+ try:
+ call = caller.calls[callee.id]
+ except KeyError:
+ call = Call(callee.id)
+ call[SAMPLES2] = cost
+ caller.add_call(call)
+ else:
+ call[SAMPLES2] += cost
+
+ callee = caller
+
+ if False:
+ profile.dump()
+
+ # compute derived data
+ profile.validate()
+ profile.find_cycles()
+ profile.ratio(TIME_RATIO, SAMPLES)
+ profile.call_ratios(SAMPLES2)
+ profile.integrate(TOTAL_TIME_RATIO, TIME_RATIO)
+
+ return profile
+
+
+class LineParser(Parser):
+ """Base class for parsers that read line-based formats."""
+
+ def __init__(self, stream):
+ Parser.__init__(self)
+ self._stream = stream
+ self.__line = None
+ self.__eof = False
+ self.line_no = 0
+
+ def readline(self):
+ line = self._stream.readline()
+ if not line:
+ self.__line = ''
+ self.__eof = True
+ else:
+ self.line_no += 1
+ line = line.rstrip('\r\n')
+ if not PYTHON_3:
+ encoding = self._stream.encoding
+ if encoding is None:
+ encoding = locale.getpreferredencoding()
+ line = line.decode(encoding)
+ self.__line = line
+
+ def lookahead(self):
+ assert self.__line is not None
+ return self.__line
+
+ def consume(self):
+ assert self.__line is not None
+ line = self.__line
+ self.readline()
+ return line
+
+ def eof(self):
+ assert self.__line is not None
+ return self.__eof
+
+
+XML_ELEMENT_START, XML_ELEMENT_END, XML_CHARACTER_DATA, XML_EOF = range(4)
+
+
+class XmlToken:
+
+ def __init__(self, type, name_or_data, attrs = None, line = None, column = None):
+ assert type in (XML_ELEMENT_START, XML_ELEMENT_END, XML_CHARACTER_DATA, XML_EOF)
+ self.type = type
+ self.name_or_data = name_or_data
+ self.attrs = attrs
+ self.line = line
+ self.column = column
+
+ def __str__(self):
+ if self.type == XML_ELEMENT_START:
+ return '<' + self.name_or_data + ' ...>'
+ if self.type == XML_ELEMENT_END:
+ return '</' + self.name_or_data + '>'
+ if self.type == XML_CHARACTER_DATA:
+ return self.name_or_data
+ if self.type == XML_EOF:
+ return 'end of file'
+ assert 0
+
+
+class XmlTokenizer:
+ """Expat based XML tokenizer."""
+
+ def __init__(self, fp, skip_ws = True):
+ self.fp = fp
+ self.tokens = []
+ self.index = 0
+ self.final = False
+ self.skip_ws = skip_ws
+
+ self.character_pos = 0, 0
+ self.character_data = ''
+
+ self.parser = xml.parsers.expat.ParserCreate()
+ self.parser.StartElementHandler = self.handle_element_start
+ self.parser.EndElementHandler = self.handle_element_end
+ self.parser.CharacterDataHandler = self.handle_character_data
+
+ def handle_element_start(self, name, attributes):
+ self.finish_character_data()
+ line, column = self.pos()
+ token = XmlToken(XML_ELEMENT_START, name, attributes, line, column)
+ self.tokens.append(token)
+
+ def handle_element_end(self, name):
+ self.finish_character_data()
+ line, column = self.pos()
+ token = XmlToken(XML_ELEMENT_END, name, None, line, column)
+ self.tokens.append(token)
+
+ def handle_character_data(self, data):
+ if not self.character_data:
+ self.character_pos = self.pos()
+ self.character_data += data
+
+ def finish_character_data(self):
+ if self.character_data:
+ if not self.skip_ws or not self.character_data.isspace():
+ line, column = self.character_pos
+ token = XmlToken(XML_CHARACTER_DATA, self.character_data, None, line, column)
+ self.tokens.append(token)
+ self.character_data = ''
+
+ def next(self):
+ size = 16*1024
+ while self.index >= len(self.tokens) and not self.final:
+ self.tokens = []
+ self.index = 0
+ data = self.fp.read(size)
+ self.final = len(data) < size
+ self.parser.Parse(data, self.final)
+ if self.index >= len(self.tokens):
+ line, column = self.pos()
+ token = XmlToken(XML_EOF, None, None, line, column)
+ else:
+ token = self.tokens[self.index]
+ self.index += 1
+ return token
+
+ def pos(self):
+ return self.parser.CurrentLineNumber, self.parser.CurrentColumnNumber
+
+
+class XmlTokenMismatch(Exception):
+
+ def __init__(self, expected, found):
+ Exception.__init__(self)
+ self.expected = expected
+ self.found = found
+
+ def __str__(self):
+ return '%u:%u: %s expected, %s found' % (self.found.line, self.found.column, str(self.expected), str(self.found))
+
+
+class XmlParser(Parser):
+ """Base XML document parser."""
+
+ def __init__(self, fp):
+ Parser.__init__(self)
+ self.tokenizer = XmlTokenizer(fp)
+ self.consume()
+
+ def consume(self):
+ self.token = self.tokenizer.next()
+
+ def match_element_start(self, name):
+ return self.token.type == XML_ELEMENT_START and self.token.name_or_data == name
+
+ def match_element_end(self, name):
+ return self.token.type == XML_ELEMENT_END and self.token.name_or_data == name
+
+ def element_start(self, name):
+ while self.token.type == XML_CHARACTER_DATA:
+ self.consume()
+ if self.token.type != XML_ELEMENT_START:
+ raise XmlTokenMismatch(XmlToken(XML_ELEMENT_START, name), self.token)
+ if self.token.name_or_data != name:
+ raise XmlTokenMismatch(XmlToken(XML_ELEMENT_START, name), self.token)
+ attrs = self.token.attrs
+ self.consume()
+ return attrs
+
+ def element_end(self, name):
+ while self.token.type == XML_CHARACTER_DATA:
+ self.consume()
+ if self.token.type != XML_ELEMENT_END:
+ raise XmlTokenMismatch(XmlToken(XML_ELEMENT_END, name), self.token)
+ if self.token.name_or_data != name:
+ raise XmlTokenMismatch(XmlToken(XML_ELEMENT_END, name), self.token)
+ self.consume()
+
+ def character_data(self, strip = True):
+ data = ''
+ while self.token.type == XML_CHARACTER_DATA:
+ data += self.token.name_or_data
+ self.consume()
+ if strip:
+ data = data.strip()
+ return data
+
+
+class GprofParser(Parser):
+ """Parser for GNU gprof output.
+
+ See also:
+ - Chapter "Interpreting gprof's Output" from the GNU gprof manual
+ http://sourceware.org/binutils/docs-2.18/gprof/Call-Graph.html#Call-Graph
+ - File "cg_print.c" from the GNU gprof source code
+ http://sourceware.org/cgi-bin/cvsweb.cgi/~checkout~/src/gprof/cg_print.c?rev=1.12&cvsroot=src
+ """
+
+ def __init__(self, fp):
+ Parser.__init__(self)
+ self.fp = fp
+ self.functions = {}
+ self.cycles = {}
+
+ def readline(self):
+ line = self.fp.readline()
+ if not line:
+ sys.stderr.write('error: unexpected end of file\n')
+ sys.exit(1)
+ line = line.rstrip('\r\n')
+ return line
+
+ _int_re = re.compile(r'^\d+$')
+ _float_re = re.compile(r'^\d+\.\d+$')
+
+ def translate(self, mo):
+ """Extract a structure from a match object, while translating the types in the process."""
+ attrs = {}
+ groupdict = mo.groupdict()
+ for name, value in compat_iteritems(groupdict):
+ if value is None:
+ value = None
+ elif self._int_re.match(value):
+ value = int(value)
+ elif self._float_re.match(value):
+ value = float(value)
+ attrs[name] = (value)
+ return Struct(attrs)
+
+ _cg_header_re = re.compile(
+ # original gprof header
+ r'^\s+called/total\s+parents\s*$|' +
+ r'^index\s+%time\s+self\s+descendents\s+called\+self\s+name\s+index\s*$|' +
+ r'^\s+called/total\s+children\s*$|' +
+ # GNU gprof header
+ r'^index\s+%\s+time\s+self\s+children\s+called\s+name\s*$'
+ )
+
+ _cg_ignore_re = re.compile(
+ # spontaneous
+ r'^\s+<spontaneous>\s*$|'
+ # internal calls (such as "mcount")
+ r'^.*\((\d+)\)$'
+ )
+
+ _cg_primary_re = re.compile(
+ r'^\[(?P<index>\d+)\]?' +
+ r'\s+(?P<percentage_time>\d+\.\d+)' +
+ r'\s+(?P<self>\d+\.\d+)' +
+ r'\s+(?P<descendants>\d+\.\d+)' +
+ r'\s+(?:(?P<called>\d+)(?:\+(?P<called_self>\d+))?)?' +
+ r'\s+(?P<name>\S.*?)' +
+ r'(?:\s+<cycle\s(?P<cycle>\d+)>)?' +
+ r'\s\[(\d+)\]$'
+ )
+
+ _cg_parent_re = re.compile(
+ r'^\s+(?P<self>\d+\.\d+)?' +
+ r'\s+(?P<descendants>\d+\.\d+)?' +
+ r'\s+(?P<called>\d+)(?:/(?P<called_total>\d+))?' +
+ r'\s+(?P<name>\S.*?)' +
+ r'(?:\s+<cycle\s(?P<cycle>\d+)>)?' +
+ r'\s\[(?P<index>\d+)\]$'
+ )
+
+ _cg_child_re = _cg_parent_re
+
+ _cg_cycle_header_re = re.compile(
+ r'^\[(?P<index>\d+)\]?' +
+ r'\s+(?P<percentage_time>\d+\.\d+)' +
+ r'\s+(?P<self>\d+\.\d+)' +
+ r'\s+(?P<descendants>\d+\.\d+)' +
+ r'\s+(?:(?P<called>\d+)(?:\+(?P<called_self>\d+))?)?' +
+ r'\s+<cycle\s(?P<cycle>\d+)\sas\sa\swhole>' +
+ r'\s\[(\d+)\]$'
+ )
+
+ _cg_cycle_member_re = re.compile(
+ r'^\s+(?P<self>\d+\.\d+)?' +
+ r'\s+(?P<descendants>\d+\.\d+)?' +
+ r'\s+(?P<called>\d+)(?:\+(?P<called_self>\d+))?' +
+ r'\s+(?P<name>\S.*?)' +
+ r'(?:\s+<cycle\s(?P<cycle>\d+)>)?' +
+ r'\s\[(?P<index>\d+)\]$'
+ )
+
+ _cg_sep_re = re.compile(r'^--+$')
+
+ def parse_function_entry(self, lines):
+ parents = []
+ children = []
+
+ while True:
+ if not lines:
+ sys.stderr.write('warning: unexpected end of entry\n')
+ line = lines.pop(0)
+ if line.startswith('['):
+ break
+
+ # read function parent line
+ mo = self._cg_parent_re.match(line)
+ if not mo:
+ if self._cg_ignore_re.match(line):
+ continue
+ sys.stderr.write('warning: unrecognized call graph entry: %r\n' % line)
+ else:
+ parent = self.translate(mo)
+ parents.append(parent)
+
+ # read primary line
+ mo = self._cg_primary_re.match(line)
+ if not mo:
+ sys.stderr.write('warning: unrecognized call graph entry: %r\n' % line)
+ return
+ else:
+ function = self.translate(mo)
+
+ while lines:
+ line = lines.pop(0)
+
+ # read function subroutine line
+ mo = self._cg_child_re.match(line)
+ if not mo:
+ if self._cg_ignore_re.match(line):
+ continue
+ sys.stderr.write('warning: unrecognized call graph entry: %r\n' % line)
+ else:
+ child = self.translate(mo)
+ children.append(child)
+
+ function.parents = parents
+ function.children = children
+
+ self.functions[function.index] = function
+
+ def parse_cycle_entry(self, lines):
+
+ # read cycle header line
+ line = lines[0]
+ mo = self._cg_cycle_header_re.match(line)
+ if not mo:
+ sys.stderr.write('warning: unrecognized call graph entry: %r\n' % line)
+ return
+ cycle = self.translate(mo)
+
+ # read cycle member lines
+ cycle.functions = []
+ for line in lines[1:]:
+ mo = self._cg_cycle_member_re.match(line)
+ if not mo:
+ sys.stderr.write('warning: unrecognized call graph entry: %r\n' % line)
+ continue
+ call = self.translate(mo)
+ cycle.functions.append(call)
+
+ self.cycles[cycle.cycle] = cycle
+
+ def parse_cg_entry(self, lines):
+ if lines[0].startswith("["):
+ self.parse_cycle_entry(lines)
+ else:
+ self.parse_function_entry(lines)
+
+ def parse_cg(self):
+ """Parse the call graph."""
+
+ # skip call graph header
+ while not self._cg_header_re.match(self.readline()):
+ pass
+ line = self.readline()
+ while self._cg_header_re.match(line):
+ line = self.readline()
+
+ # process call graph entries
+ entry_lines = []
+ while line != '\014': # form feed
+ if line and not line.isspace():
+ if self._cg_sep_re.match(line):
+ self.parse_cg_entry(entry_lines)
+ entry_lines = []
+ else:
+ entry_lines.append(line)
+ line = self.readline()
+
+ def parse(self):
+ self.parse_cg()
+ self.fp.close()
+
+ profile = Profile()
+ profile[TIME] = 0.0
+
+ cycles = {}
+ for index in self.cycles:
+ cycles[index] = Cycle()
+
+ for entry in compat_itervalues(self.functions):
+ # populate the function
+ function = Function(entry.index, entry.name)
+ function[TIME] = entry.self
+ if entry.called is not None:
+ function.called = entry.called
+ if entry.called_self is not None:
+ call = Call(entry.index)
+ call[CALLS] = entry.called_self
+ function.called += entry.called_self
+
+ # populate the function calls
+ for child in entry.children:
+ call = Call(child.index)
+
+ assert child.called is not None
+ call[CALLS] = child.called
+
+ if child.index not in self.functions:
+ # NOTE: functions that were never called but were discovered by gprof's
+ # static call graph analysis dont have a call graph entry so we need
+ # to add them here
+ missing = Function(child.index, child.name)
+ function[TIME] = 0.0
+ function.called = 0
+ profile.add_function(missing)
+
+ function.add_call(call)
+
+ profile.add_function(function)
+
+ if entry.cycle is not None:
+ try:
+ cycle = cycles[entry.cycle]
+ except KeyError:
+ sys.stderr.write('warning: <cycle %u as a whole> entry missing\n' % entry.cycle)
+ cycle = Cycle()
+ cycles[entry.cycle] = cycle
+ cycle.add_function(function)
+
+ profile[TIME] = profile[TIME] + function[TIME]
+
+ for cycle in compat_itervalues(cycles):
+ profile.add_cycle(cycle)
+
+ # Compute derived events
+ profile.validate()
+ profile.ratio(TIME_RATIO, TIME)
+ profile.call_ratios(CALLS)
+ profile.integrate(TOTAL_TIME, TIME)
+ profile.ratio(TOTAL_TIME_RATIO, TOTAL_TIME)
+
+ return profile
+
+
+# Clone&hack of GprofParser for VTune Amplifier XE 2013 gprof-cc output.
+# Tested only with AXE 2013 for Windows.
+# - Use total times as reported by AXE.
+# - In the absence of call counts, call ratios are faked from the relative
+# proportions of total time. This affects only the weighting of the calls.
+# - Different header, separator, and end marker.
+# - Extra whitespace after function names.
+# - You get a full entry for <spontaneous>, which does not have parents.
+# - Cycles do have parents. These are saved but unused (as they are
+# for functions).
+# - Disambiguated "unrecognized call graph entry" error messages.
+# Notes:
+# - Total time of functions as reported by AXE passes the val3 test.
+# - CPU Time:Children in the input is sometimes a negative number. This
+# value goes to the variable descendants, which is unused.
+# - The format of gprof-cc reports is unaffected by the use of
+# -knob enable-call-counts=true (no call counts, ever), or
+# -show-as=samples (results are quoted in seconds regardless).
+class AXEParser(Parser):
+ "Parser for VTune Amplifier XE 2013 gprof-cc report output."
+
+ def __init__(self, fp):
+ Parser.__init__(self)
+ self.fp = fp
+ self.functions = {}
+ self.cycles = {}
+
+ def readline(self):
+ line = self.fp.readline()
+ if not line:
+ sys.stderr.write('error: unexpected end of file\n')
+ sys.exit(1)
+ line = line.rstrip('\r\n')
+ return line
+
+ _int_re = re.compile(r'^\d+$')
+ _float_re = re.compile(r'^\d+\.\d+$')
+
+ def translate(self, mo):
+ """Extract a structure from a match object, while translating the types in the process."""
+ attrs = {}
+ groupdict = mo.groupdict()
+ for name, value in compat_iteritems(groupdict):
+ if value is None:
+ value = None
+ elif self._int_re.match(value):
+ value = int(value)
+ elif self._float_re.match(value):
+ value = float(value)
+ attrs[name] = (value)
+ return Struct(attrs)
+
+ _cg_header_re = re.compile(
+ '^Index |'
+ '^-----+ '
+ )
+
+ _cg_footer_re = re.compile(r'^Index\s+Function\s*$')
+
+ _cg_primary_re = re.compile(
+ r'^\[(?P<index>\d+)\]?' +
+ r'\s+(?P<percentage_time>\d+\.\d+)' +
+ r'\s+(?P<self>\d+\.\d+)' +
+ r'\s+(?P<descendants>\d+\.\d+)' +
+ r'\s+(?P<name>\S.*?)' +
+ r'(?:\s+<cycle\s(?P<cycle>\d+)>)?' +
+ r'\s+\[(\d+)\]' +
+ r'\s*$'
+ )
+
+ _cg_parent_re = re.compile(
+ r'^\s+(?P<self>\d+\.\d+)?' +
+ r'\s+(?P<descendants>\d+\.\d+)?' +
+ r'\s+(?P<name>\S.*?)' +
+ r'(?:\s+<cycle\s(?P<cycle>\d+)>)?' +
+ r'(?:\s+\[(?P<index>\d+)\]\s*)?' +
+ r'\s*$'
+ )
+
+ _cg_child_re = _cg_parent_re
+
+ _cg_cycle_header_re = re.compile(
+ r'^\[(?P<index>\d+)\]?' +
+ r'\s+(?P<percentage_time>\d+\.\d+)' +
+ r'\s+(?P<self>\d+\.\d+)' +
+ r'\s+(?P<descendants>\d+\.\d+)' +
+ r'\s+<cycle\s(?P<cycle>\d+)\sas\sa\swhole>' +
+ r'\s+\[(\d+)\]' +
+ r'\s*$'
+ )
+
+ _cg_cycle_member_re = re.compile(
+ r'^\s+(?P<self>\d+\.\d+)?' +
+ r'\s+(?P<descendants>\d+\.\d+)?' +
+ r'\s+(?P<name>\S.*?)' +
+ r'(?:\s+<cycle\s(?P<cycle>\d+)>)?' +
+ r'\s+\[(?P<index>\d+)\]' +
+ r'\s*$'
+ )
+
+ def parse_function_entry(self, lines):
+ parents = []
+ children = []
+
+ while True:
+ if not lines:
+ sys.stderr.write('warning: unexpected end of entry\n')
+ return
+ line = lines.pop(0)
+ if line.startswith('['):
+ break
+
+ # read function parent line
+ mo = self._cg_parent_re.match(line)
+ if not mo:
+ sys.stderr.write('warning: unrecognized call graph entry (1): %r\n' % line)
+ else:
+ parent = self.translate(mo)
+ if parent.name != '<spontaneous>':
+ parents.append(parent)
+
+ # read primary line
+ mo = self._cg_primary_re.match(line)
+ if not mo:
+ sys.stderr.write('warning: unrecognized call graph entry (2): %r\n' % line)
+ return
+ else:
+ function = self.translate(mo)
+
+ while lines:
+ line = lines.pop(0)
+
+ # read function subroutine line
+ mo = self._cg_child_re.match(line)
+ if not mo:
+ sys.stderr.write('warning: unrecognized call graph entry (3): %r\n' % line)
+ else:
+ child = self.translate(mo)
+ if child.name != '<spontaneous>':
+ children.append(child)
+
+ if function.name != '<spontaneous>':
+ function.parents = parents
+ function.children = children
+
+ self.functions[function.index] = function
+
+ def parse_cycle_entry(self, lines):
+
+ # Process the parents that were not there in gprof format.
+ parents = []
+ while True:
+ if not lines:
+ sys.stderr.write('warning: unexpected end of cycle entry\n')
+ return
+ line = lines.pop(0)
+ if line.startswith('['):
+ break
+ mo = self._cg_parent_re.match(line)
+ if not mo:
+ sys.stderr.write('warning: unrecognized call graph entry (6): %r\n' % line)
+ else:
+ parent = self.translate(mo)
+ if parent.name != '<spontaneous>':
+ parents.append(parent)
+
+ # read cycle header line
+ mo = self._cg_cycle_header_re.match(line)
+ if not mo:
+ sys.stderr.write('warning: unrecognized call graph entry (4): %r\n' % line)
+ return
+ cycle = self.translate(mo)
+
+ # read cycle member lines
+ cycle.functions = []
+ for line in lines[1:]:
+ mo = self._cg_cycle_member_re.match(line)
+ if not mo:
+ sys.stderr.write('warning: unrecognized call graph entry (5): %r\n' % line)
+ continue
+ call = self.translate(mo)
+ cycle.functions.append(call)
+
+ cycle.parents = parents
+ self.cycles[cycle.cycle] = cycle
+
+ def parse_cg_entry(self, lines):
+ if any("as a whole" in linelooper for linelooper in lines):
+ self.parse_cycle_entry(lines)
+ else:
+ self.parse_function_entry(lines)
+
+ def parse_cg(self):
+ """Parse the call graph."""
+
+ # skip call graph header
+ line = self.readline()
+ while self._cg_header_re.match(line):
+ line = self.readline()
+
+ # process call graph entries
+ entry_lines = []
+ # An EOF in readline terminates the program without returning.
+ while not self._cg_footer_re.match(line):
+ if line.isspace():
+ self.parse_cg_entry(entry_lines)
+ entry_lines = []
+ else:
+ entry_lines.append(line)
+ line = self.readline()
+
+ def parse(self):
+ sys.stderr.write('warning: for axe format, edge weights are unreliable estimates derived from function total times.\n')
+ self.parse_cg()
+ self.fp.close()
+
+ profile = Profile()
+ profile[TIME] = 0.0
+
+ cycles = {}
+ for index in self.cycles:
+ cycles[index] = Cycle()
+
+ for entry in compat_itervalues(self.functions):
+ # populate the function
+ function = Function(entry.index, entry.name)
+ function[TIME] = entry.self
+ function[TOTAL_TIME_RATIO] = entry.percentage_time / 100.0
+
+ # populate the function calls
+ for child in entry.children:
+ call = Call(child.index)
+ # The following bogus value affects only the weighting of
+ # the calls.
+ call[TOTAL_TIME_RATIO] = function[TOTAL_TIME_RATIO]
+
+ if child.index not in self.functions:
+ # NOTE: functions that were never called but were discovered by gprof's
+ # static call graph analysis dont have a call graph entry so we need
+ # to add them here
+ # FIXME: Is this applicable?
+ missing = Function(child.index, child.name)
+ function[TIME] = 0.0
+ profile.add_function(missing)
+
+ function.add_call(call)
+
+ profile.add_function(function)
+
+ if entry.cycle is not None:
+ try:
+ cycle = cycles[entry.cycle]
+ except KeyError:
+ sys.stderr.write('warning: <cycle %u as a whole> entry missing\n' % entry.cycle)
+ cycle = Cycle()
+ cycles[entry.cycle] = cycle
+ cycle.add_function(function)
+
+ profile[TIME] = profile[TIME] + function[TIME]
+
+ for cycle in compat_itervalues(cycles):
+ profile.add_cycle(cycle)
+
+ # Compute derived events.
+ profile.validate()
+ profile.ratio(TIME_RATIO, TIME)
+ # Lacking call counts, fake call ratios based on total times.
+ profile.call_ratios(TOTAL_TIME_RATIO)
+ # The TOTAL_TIME_RATIO of functions is already set. Propagate that
+ # total time to the calls. (TOTAL_TIME is neither set nor used.)
+ for function in compat_itervalues(profile.functions):
+ for call in compat_itervalues(function.calls):
+ if call.ratio is not None:
+ callee = profile.functions[call.callee_id]
+ call[TOTAL_TIME_RATIO] = call.ratio * callee[TOTAL_TIME_RATIO]
+
+ return profile
+
+
+class CallgrindParser(LineParser):
+ """Parser for valgrind's callgrind tool.
+
+ See also:
+ - http://valgrind.org/docs/manual/cl-format.html
+ """
+
+ _call_re = re.compile(r'^calls=\s*(\d+)\s+((\d+|\+\d+|-\d+|\*)\s+)+$')
+
+ def __init__(self, infile):
+ LineParser.__init__(self, infile)
+
+ # Textual positions
+ self.position_ids = {}
+ self.positions = {}
+
+ # Numeric positions
+ self.num_positions = 1
+ self.cost_positions = ['line']
+ self.last_positions = [0]
+
+ # Events
+ self.num_events = 0
+ self.cost_events = []
+
+ self.profile = Profile()
+ self.profile[SAMPLES] = 0
+
+ def parse(self):
+ # read lookahead
+ self.readline()
+
+ self.parse_key('version')
+ self.parse_key('creator')
+ while self.parse_part():
+ pass
+ if not self.eof():
+ sys.stderr.write('warning: line %u: unexpected line\n' % self.line_no)
+ sys.stderr.write('%s\n' % self.lookahead())
+
+ # compute derived data
+ self.profile.validate()
+ self.profile.find_cycles()
+ self.profile.ratio(TIME_RATIO, SAMPLES)
+ self.profile.call_ratios(SAMPLES2)
+ self.profile.integrate(TOTAL_TIME_RATIO, TIME_RATIO)
+
+ return self.profile
+
+ def parse_part(self):
+ if not self.parse_header_line():
+ return False
+ while self.parse_header_line():
+ pass
+ if not self.parse_body_line():
+ return False
+ while self.parse_body_line():
+ pass
+ return True
+
+ def parse_header_line(self):
+ return \
+ self.parse_empty() or \
+ self.parse_comment() or \
+ self.parse_part_detail() or \
+ self.parse_description() or \
+ self.parse_event_specification() or \
+ self.parse_cost_line_def() or \
+ self.parse_cost_summary()
+
+ _detail_keys = set(('cmd', 'pid', 'thread', 'part'))
+
+ def parse_part_detail(self):
+ return self.parse_keys(self._detail_keys)
+
+ def parse_description(self):
+ return self.parse_key('desc') is not None
+
+ def parse_event_specification(self):
+ event = self.parse_key('event')
+ if event is None:
+ return False
+ return True
+
+ def parse_cost_line_def(self):
+ pair = self.parse_keys(('events', 'positions'))
+ if pair is None:
+ return False
+ key, value = pair
+ items = value.split()
+ if key == 'events':
+ self.num_events = len(items)
+ self.cost_events = items
+ if key == 'positions':
+ self.num_positions = len(items)
+ self.cost_positions = items
+ self.last_positions = [0]*self.num_positions
+ return True
+
+ def parse_cost_summary(self):
+ pair = self.parse_keys(('summary', 'totals'))
+ if pair is None:
+ return False
+ return True
+
+ def parse_body_line(self):
+ return \
+ self.parse_empty() or \
+ self.parse_comment() or \
+ self.parse_cost_line() or \
+ self.parse_position_spec() or \
+ self.parse_association_spec()
+
+ __subpos_re = r'(0x[0-9a-fA-F]+|\d+|\+\d+|-\d+|\*)'
+ _cost_re = re.compile(r'^' +
+ __subpos_re + r'( +' + __subpos_re + r')*' +
+ r'( +\d+)*' +
+ '$')
+
+ def parse_cost_line(self, calls=None):
+ line = self.lookahead().rstrip()
+ mo = self._cost_re.match(line)
+ if not mo:
+ return False
+
+ function = self.get_function()
+
+ if calls is None:
+ # Unlike other aspects, call object (cob) is relative not to the
+ # last call object, but to the caller's object (ob), so try to
+ # update it when processing a functions cost line
+ try:
+ self.positions['cob'] = self.positions['ob']
+ except KeyError:
+ pass
+
+ values = line.split()
+ assert len(values) <= self.num_positions + self.num_events
+
+ positions = values[0 : self.num_positions]
+ events = values[self.num_positions : ]
+ events += ['0']*(self.num_events - len(events))
+
+ for i in range(self.num_positions):
+ position = positions[i]
+ if position == '*':
+ position = self.last_positions[i]
+ elif position[0] in '-+':
+ position = self.last_positions[i] + int(position)
+ elif position.startswith('0x'):
+ position = int(position, 16)
+ else:
+ position = int(position)
+ self.last_positions[i] = position
+
+ events = [float(event) for event in events]
+
+ if calls is None:
+ function[SAMPLES] += events[0]
+ self.profile[SAMPLES] += events[0]
+ else:
+ callee = self.get_callee()
+ callee.called += calls
+
+ try:
+ call = function.calls[callee.id]
+ except KeyError:
+ call = Call(callee.id)
+ call[CALLS] = calls
+ call[SAMPLES2] = events[0]
+ function.add_call(call)
+ else:
+ call[CALLS] += calls
+ call[SAMPLES2] += events[0]
+
+ self.consume()
+ return True
+
+ def parse_association_spec(self):
+ line = self.lookahead()
+ if not line.startswith('calls='):
+ return False
+
+ _, values = line.split('=', 1)
+ values = values.strip().split()
+ calls = int(values[0])
+ call_position = values[1:]
+ self.consume()
+
+ self.parse_cost_line(calls)
+
+ return True
+
+ _position_re = re.compile(r'^(?P<position>[cj]?(?:ob|fl|fi|fe|fn))=\s*(?:\((?P<id>\d+)\))?(?:\s*(?P<name>.+))?')
+
+ _position_table_map = {
+ 'ob': 'ob',
+ 'fl': 'fl',
+ 'fi': 'fl',
+ 'fe': 'fl',
+ 'fn': 'fn',
+ 'cob': 'ob',
+ 'cfl': 'fl',
+ 'cfi': 'fl',
+ 'cfe': 'fl',
+ 'cfn': 'fn',
+ 'jfi': 'fl',
+ }
+
+ _position_map = {
+ 'ob': 'ob',
+ 'fl': 'fl',
+ 'fi': 'fl',
+ 'fe': 'fl',
+ 'fn': 'fn',
+ 'cob': 'cob',
+ 'cfl': 'cfl',
+ 'cfi': 'cfl',
+ 'cfe': 'cfl',
+ 'cfn': 'cfn',
+ 'jfi': 'jfi',
+ }
+
+ def parse_position_spec(self):
+ line = self.lookahead()
+
+ if line.startswith('jump=') or line.startswith('jcnd='):
+ self.consume()
+ return True
+
+ mo = self._position_re.match(line)
+ if not mo:
+ return False
+
+ position, id, name = mo.groups()
+ if id:
+ table = self._position_table_map[position]
+ if name:
+ self.position_ids[(table, id)] = name
+ else:
+ name = self.position_ids.get((table, id), '')
+ self.positions[self._position_map[position]] = name
+
+ self.consume()
+ return True
+
+ def parse_empty(self):
+ if self.eof():
+ return False
+ line = self.lookahead()
+ if line.strip():
+ return False
+ self.consume()
+ return True
+
+ def parse_comment(self):
+ line = self.lookahead()
+ if not line.startswith('#'):
+ return False
+ self.consume()
+ return True
+
+ _key_re = re.compile(r'^(\w+):')
+
+ def parse_key(self, key):
+ pair = self.parse_keys((key,))
+ if not pair:
+ return None
+ key, value = pair
+ return value
+
+ def parse_keys(self, keys):
+ line = self.lookahead()
+ mo = self._key_re.match(line)
+ if not mo:
+ return None
+ key, value = line.split(':', 1)
+ if key not in keys:
+ return None
+ value = value.strip()
+ self.consume()
+ return key, value
+
+ def make_function(self, module, filename, name):
+ # FIXME: module and filename are not being tracked reliably
+ #id = '|'.join((module, filename, name))
+ id = name
+ try:
+ function = self.profile.functions[id]
+ except KeyError:
+ function = Function(id, name)
+ if module:
+ function.module = os.path.basename(module)
+ function[SAMPLES] = 0
+ function.called = 0
+ self.profile.add_function(function)
+ return function
+
+ def get_function(self):
+ module = self.positions.get('ob', '')
+ filename = self.positions.get('fl', '')
+ function = self.positions.get('fn', '')
+ return self.make_function(module, filename, function)
+
+ def get_callee(self):
+ module = self.positions.get('cob', '')
+ filename = self.positions.get('cfi', '')
+ function = self.positions.get('cfn', '')
+ return self.make_function(module, filename, function)
+
+
+class PerfParser(LineParser):
+ """Parser for linux perf callgraph output.
+
+ It expects output generated with
+
+ perf record -g
+ perf script | gprof2dot.py --format=perf
+ """
+
+ def __init__(self, infile):
+ LineParser.__init__(self, infile)
+ self.profile = Profile()
+
+ def readline(self):
+ # Override LineParser.readline to ignore comment lines
+ while True:
+ LineParser.readline(self)
+ if self.eof() or not self.lookahead().startswith('#'):
+ break
+
+ def parse(self):
+ # read lookahead
+ self.readline()
+
+ profile = self.profile
+ profile[SAMPLES] = 0
+ while not self.eof():
+ self.parse_event()
+
+ # compute derived data
+ profile.validate()
+ profile.find_cycles()
+ profile.ratio(TIME_RATIO, SAMPLES)
+ profile.call_ratios(SAMPLES2)
+ if totalMethod == "callratios":
+ # Heuristic approach. TOTAL_SAMPLES is unused.
+ profile.integrate(TOTAL_TIME_RATIO, TIME_RATIO)
+ elif totalMethod == "callstacks":
+ # Use the actual call chains for functions.
+ profile[TOTAL_SAMPLES] = profile[SAMPLES]
+ profile.ratio(TOTAL_TIME_RATIO, TOTAL_SAMPLES)
+ # Then propagate that total time to the calls.
+ for function in compat_itervalues(profile.functions):
+ for call in compat_itervalues(function.calls):
+ if call.ratio is not None:
+ callee = profile.functions[call.callee_id]
+ call[TOTAL_TIME_RATIO] = call.ratio * callee[TOTAL_TIME_RATIO]
+ else:
+ assert False
+
+ return profile
+
+ def parse_event(self):
+ if self.eof():
+ return
+
+ line = self.consume()
+ assert line
+
+ callchain = self.parse_callchain()
+ if not callchain:
+ return
+
+ callee = callchain[0]
+ callee[SAMPLES] += 1
+ self.profile[SAMPLES] += 1
+
+ for caller in callchain[1:]:
+ try:
+ call = caller.calls[callee.id]
+ except KeyError:
+ call = Call(callee.id)
+ call[SAMPLES2] = 1
+ caller.add_call(call)
+ else:
+ call[SAMPLES2] += 1
+
+ callee = caller
+
+ # Increment TOTAL_SAMPLES only once on each function.
+ stack = set(callchain)
+ for function in stack:
+ function[TOTAL_SAMPLES] += 1
+
+ def parse_callchain(self):
+ callchain = []
+ while self.lookahead():
+ function = self.parse_call()
+ if function is None:
+ break
+ callchain.append(function)
+ if self.lookahead() == '':
+ self.consume()
+ return callchain
+
+ call_re = re.compile(r'^\s+(?P<address>[0-9a-fA-F]+)\s+(?P<symbol>.*)\s+\((?P<module>.*)\)$')
+ addr2_re = re.compile(r'\+0x[0-9a-fA-F]+$')
+
+ def parse_call(self):
+ line = self.consume()
+ mo = self.call_re.match(line)
+ assert mo
+ if not mo:
+ return None
+
+ function_name = mo.group('symbol')
+
+ # If present, amputate program counter from function name.
+ if function_name:
+ function_name = re.sub(self.addr2_re, '', function_name)
+
+ if not function_name or function_name == '[unknown]':
+ function_name = mo.group('address')
+
+ module = mo.group('module')
+
+ function_id = function_name + ':' + module
+
+ try:
+ function = self.profile.functions[function_id]
+ except KeyError:
+ function = Function(function_id, function_name)
+ function.module = os.path.basename(module)
+ function[SAMPLES] = 0
+ function[TOTAL_SAMPLES] = 0
+ self.profile.add_function(function)
+
+ return function
+
+
+class OprofileParser(LineParser):
+ """Parser for oprofile callgraph output.
+
+ See also:
+ - http://oprofile.sourceforge.net/doc/opreport.html#opreport-callgraph
+ """
+
+ _fields_re = {
+ 'samples': r'(\d+)',
+ '%': r'(\S+)',
+ 'linenr info': r'(?P<source>\(no location information\)|\S+:\d+)',
+ 'image name': r'(?P<image>\S+(?:\s\(tgid:[^)]*\))?)',
+ 'app name': r'(?P<application>\S+)',
+ 'symbol name': r'(?P<symbol>\(no symbols\)|.+?)',
+ }
+
+ def __init__(self, infile):
+ LineParser.__init__(self, infile)
+ self.entries = {}
+ self.entry_re = None
+
+ def add_entry(self, callers, function, callees):
+ try:
+ entry = self.entries[function.id]
+ except KeyError:
+ self.entries[function.id] = (callers, function, callees)
+ else:
+ callers_total, function_total, callees_total = entry
+ self.update_subentries_dict(callers_total, callers)
+ function_total.samples += function.samples
+ self.update_subentries_dict(callees_total, callees)
+
+ def update_subentries_dict(self, totals, partials):
+ for partial in compat_itervalues(partials):
+ try:
+ total = totals[partial.id]
+ except KeyError:
+ totals[partial.id] = partial
+ else:
+ total.samples += partial.samples
+
+ def parse(self):
+ # read lookahead
+ self.readline()
+
+ self.parse_header()
+ while self.lookahead():
+ self.parse_entry()
+
+ profile = Profile()
+
+ reverse_call_samples = {}
+
+ # populate the profile
+ profile[SAMPLES] = 0
+ for _callers, _function, _callees in compat_itervalues(self.entries):
+ function = Function(_function.id, _function.name)
+ function[SAMPLES] = _function.samples
+ profile.add_function(function)
+ profile[SAMPLES] += _function.samples
+
+ if _function.application:
+ function.process = os.path.basename(_function.application)
+ if _function.image:
+ function.module = os.path.basename(_function.image)
+
+ total_callee_samples = 0
+ for _callee in compat_itervalues(_callees):
+ total_callee_samples += _callee.samples
+
+ for _callee in compat_itervalues(_callees):
+ if not _callee.self:
+ call = Call(_callee.id)
+ call[SAMPLES2] = _callee.samples
+ function.add_call(call)
+
+ # compute derived data
+ profile.validate()
+ profile.find_cycles()
+ profile.ratio(TIME_RATIO, SAMPLES)
+ profile.call_ratios(SAMPLES2)
+ profile.integrate(TOTAL_TIME_RATIO, TIME_RATIO)
+
+ return profile
+
+ def parse_header(self):
+ while not self.match_header():
+ self.consume()
+ line = self.lookahead()
+ fields = re.split(r'\s\s+', line)
+ entry_re = r'^\s*' + r'\s+'.join([self._fields_re[field] for field in fields]) + r'(?P<self>\s+\[self\])?$'
+ self.entry_re = re.compile(entry_re)
+ self.skip_separator()
+
+ def parse_entry(self):
+ callers = self.parse_subentries()
+ if self.match_primary():
+ function = self.parse_subentry()
+ if function is not None:
+ callees = self.parse_subentries()
+ self.add_entry(callers, function, callees)
+ self.skip_separator()
+
+ def parse_subentries(self):
+ subentries = {}
+ while self.match_secondary():
+ subentry = self.parse_subentry()
+ subentries[subentry.id] = subentry
+ return subentries
+
+ def parse_subentry(self):
+ entry = Struct()
+ line = self.consume()
+ mo = self.entry_re.match(line)
+ if not mo:
+ raise ParseError('failed to parse', line)
+ fields = mo.groupdict()
+ entry.samples = int(mo.group(1))
+ if 'source' in fields and fields['source'] != '(no location information)':
+ source = fields['source']
+ filename, lineno = source.split(':')
+ entry.filename = filename
+ entry.lineno = int(lineno)
+ else:
+ source = ''
+ entry.filename = None
+ entry.lineno = None
+ entry.image = fields.get('image', '')
+ entry.application = fields.get('application', '')
+ if 'symbol' in fields and fields['symbol'] != '(no symbols)':
+ entry.symbol = fields['symbol']
+ else:
+ entry.symbol = ''
+ if entry.symbol.startswith('"') and entry.symbol.endswith('"'):
+ entry.symbol = entry.symbol[1:-1]
+ entry.id = ':'.join((entry.application, entry.image, source, entry.symbol))
+ entry.self = fields.get('self', None) != None
+ if entry.self:
+ entry.id += ':self'
+ if entry.symbol:
+ entry.name = entry.symbol
+ else:
+ entry.name = entry.image
+ return entry
+
+ def skip_separator(self):
+ while not self.match_separator():
+ self.consume()
+ self.consume()
+
+ def match_header(self):
+ line = self.lookahead()
+ return line.startswith('samples')
+
+ def match_separator(self):
+ line = self.lookahead()
+ return line == '-'*len(line)
+
+ def match_primary(self):
+ line = self.lookahead()
+ return not line[:1].isspace()
+
+ def match_secondary(self):
+ line = self.lookahead()
+ return line[:1].isspace()
+
+
+class HProfParser(LineParser):
+ """Parser for java hprof output
+
+ See also:
+ - http://java.sun.com/developer/technicalArticles/Programming/HPROF.html
+ """
+
+ trace_re = re.compile(r'\t(.*)\((.*):(.*)\)')
+ trace_id_re = re.compile(r'^TRACE (\d+):$')
+
+ def __init__(self, infile):
+ LineParser.__init__(self, infile)
+ self.traces = {}
+ self.samples = {}
+
+ def parse(self):
+ # read lookahead
+ self.readline()
+
+ while not self.lookahead().startswith('------'): self.consume()
+ while not self.lookahead().startswith('TRACE '): self.consume()
+
+ self.parse_traces()
+
+ while not self.lookahead().startswith('CPU'):
+ self.consume()
+
+ self.parse_samples()
+
+ # populate the profile
+ profile = Profile()
+ profile[SAMPLES] = 0
+
+ functions = {}
+
+ # build up callgraph
+ for id, trace in compat_iteritems(self.traces):
+ if not id in self.samples: continue
+ mtime = self.samples[id][0]
+ last = None
+
+ for func, file, line in trace:
+ if not func in functions:
+ function = Function(func, func)
+ function[SAMPLES] = 0
+ profile.add_function(function)
+ functions[func] = function
+
+ function = functions[func]
+ # allocate time to the deepest method in the trace
+ if not last:
+ function[SAMPLES] += mtime
+ profile[SAMPLES] += mtime
+ else:
+ c = function.get_call(last)
+ c[SAMPLES2] += mtime
+
+ last = func
+
+ # compute derived data
+ profile.validate()
+ profile.find_cycles()
+ profile.ratio(TIME_RATIO, SAMPLES)
+ profile.call_ratios(SAMPLES2)
+ profile.integrate(TOTAL_TIME_RATIO, TIME_RATIO)
+
+ return profile
+
+ def parse_traces(self):
+ while self.lookahead().startswith('TRACE '):
+ self.parse_trace()
+
+ def parse_trace(self):
+ l = self.consume()
+ mo = self.trace_id_re.match(l)
+ tid = mo.group(1)
+ last = None
+ trace = []
+
+ while self.lookahead().startswith('\t'):
+ l = self.consume()
+ match = self.trace_re.search(l)
+ if not match:
+ #sys.stderr.write('Invalid line: %s\n' % l)
+ break
+ else:
+ function_name, file, line = match.groups()
+ trace += [(function_name, file, line)]
+
+ self.traces[int(tid)] = trace
+
+ def parse_samples(self):
+ self.consume()
+ self.consume()
+
+ while not self.lookahead().startswith('CPU'):
+ rank, percent_self, percent_accum, count, traceid, method = self.lookahead().split()
+ self.samples[int(traceid)] = (int(count), method)
+ self.consume()
+
+
+class SysprofParser(XmlParser):
+
+ def __init__(self, stream):
+ XmlParser.__init__(self, stream)
+
+ def parse(self):
+ objects = {}
+ nodes = {}
+
+ self.element_start('profile')
+ while self.token.type == XML_ELEMENT_START:
+ if self.token.name_or_data == 'objects':
+ assert not objects
+ objects = self.parse_items('objects')
+ elif self.token.name_or_data == 'nodes':
+ assert not nodes
+ nodes = self.parse_items('nodes')
+ else:
+ self.parse_value(self.token.name_or_data)
+ self.element_end('profile')
+
+ return self.build_profile(objects, nodes)
+
+ def parse_items(self, name):
+ assert name[-1] == 's'
+ items = {}
+ self.element_start(name)
+ while self.token.type == XML_ELEMENT_START:
+ id, values = self.parse_item(name[:-1])
+ assert id not in items
+ items[id] = values
+ self.element_end(name)
+ return items
+
+ def parse_item(self, name):
+ attrs = self.element_start(name)
+ id = int(attrs['id'])
+ values = self.parse_values()
+ self.element_end(name)
+ return id, values
+
+ def parse_values(self):
+ values = {}
+ while self.token.type == XML_ELEMENT_START:
+ name = self.token.name_or_data
+ value = self.parse_value(name)
+ assert name not in values
+ values[name] = value
+ return values
+
+ def parse_value(self, tag):
+ self.element_start(tag)
+ value = self.character_data()
+ self.element_end(tag)
+ if value.isdigit():
+ return int(value)
+ if value.startswith('"') and value.endswith('"'):
+ return value[1:-1]
+ return value
+
+ def build_profile(self, objects, nodes):
+ profile = Profile()
+
+ profile[SAMPLES] = 0
+ for id, object in compat_iteritems(objects):
+ # Ignore fake objects (process names, modules, "Everything", "kernel", etc.)
+ if object['self'] == 0:
+ continue
+
+ function = Function(id, object['name'])
+ function[SAMPLES] = object['self']
+ profile.add_function(function)
+ profile[SAMPLES] += function[SAMPLES]
+
+ for id, node in compat_iteritems(nodes):
+ # Ignore fake calls
+ if node['self'] == 0:
+ continue
+
+ # Find a non-ignored parent
+ parent_id = node['parent']
+ while parent_id != 0:
+ parent = nodes[parent_id]
+ caller_id = parent['object']
+ if objects[caller_id]['self'] != 0:
+ break
+ parent_id = parent['parent']
+ if parent_id == 0:
+ continue
+
+ callee_id = node['object']
+
+ assert objects[caller_id]['self']
+ assert objects[callee_id]['self']
+
+ function = profile.functions[caller_id]
+
+ samples = node['self']
+ try:
+ call = function.calls[callee_id]
+ except KeyError:
+ call = Call(callee_id)
+ call[SAMPLES2] = samples
+ function.add_call(call)
+ else:
+ call[SAMPLES2] += samples
+
+ # Compute derived events
+ profile.validate()
+ profile.find_cycles()
+ profile.ratio(TIME_RATIO, SAMPLES)
+ profile.call_ratios(SAMPLES2)
+ profile.integrate(TOTAL_TIME_RATIO, TIME_RATIO)
+
+ return profile
+
+
+class XPerfParser(Parser):
+ """Parser for CSVs generted by XPerf, from Microsoft Windows Performance Tools.
+ """
+
+ def __init__(self, stream):
+ Parser.__init__(self)
+ self.stream = stream
+ self.profile = Profile()
+ self.profile[SAMPLES] = 0
+ self.column = {}
+
+ def parse(self):
+ import csv
+ reader = csv.reader(
+ self.stream,
+ delimiter = ',',
+ quotechar = None,
+ escapechar = None,
+ doublequote = False,
+ skipinitialspace = True,
+ lineterminator = '\r\n',
+ quoting = csv.QUOTE_NONE)
+ header = True
+ for row in reader:
+ if header:
+ self.parse_header(row)
+ header = False
+ else:
+ self.parse_row(row)
+
+ # compute derived data
+ self.profile.validate()
+ self.profile.find_cycles()
+ self.profile.ratio(TIME_RATIO, SAMPLES)
+ self.profile.call_ratios(SAMPLES2)
+ self.profile.integrate(TOTAL_TIME_RATIO, TIME_RATIO)
+
+ return self.profile
+
+ def parse_header(self, row):
+ for column in range(len(row)):
+ name = row[column]
+ assert name not in self.column
+ self.column[name] = column
+
+ def parse_row(self, row):
+ fields = {}
+ for name, column in compat_iteritems(self.column):
+ value = row[column]
+ for factory in int, float:
+ try:
+ value = factory(value)
+ except ValueError:
+ pass
+ else:
+ break
+ fields[name] = value
+
+ process = fields['Process Name']
+ symbol = fields['Module'] + '!' + fields['Function']
+ weight = fields['Weight']
+ count = fields['Count']
+
+ if process == 'Idle':
+ return
+
+ function = self.get_function(process, symbol)
+ function[SAMPLES] += weight * count
+ self.profile[SAMPLES] += weight * count
+
+ stack = fields['Stack']
+ if stack != '?':
+ stack = stack.split('/')
+ assert stack[0] == '[Root]'
+ if stack[-1] != symbol:
+ # XXX: some cases the sampled function does not appear in the stack
+ stack.append(symbol)
+ caller = None
+ for symbol in stack[1:]:
+ callee = self.get_function(process, symbol)
+ if caller is not None:
+ try:
+ call = caller.calls[callee.id]
+ except KeyError:
+ call = Call(callee.id)
+ call[SAMPLES2] = count
+ caller.add_call(call)
+ else:
+ call[SAMPLES2] += count
+ caller = callee
+
+ def get_function(self, process, symbol):
+ function_id = process + '!' + symbol
+
+ try:
+ function = self.profile.functions[function_id]
+ except KeyError:
+ module, name = symbol.split('!', 1)
+ function = Function(function_id, name)
+ function.process = process
+ function.module = module
+ function[SAMPLES] = 0
+ self.profile.add_function(function)
+
+ return function
+
+
+class SleepyParser(Parser):
+ """Parser for GNU gprof output.
+
+ See also:
+ - http://www.codersnotes.com/sleepy/
+ - http://sleepygraph.sourceforge.net/
+ """
+
+ stdinInput = False
+
+ def __init__(self, filename):
+ Parser.__init__(self)
+
+ from zipfile import ZipFile
+
+ self.database = ZipFile(filename)
+
+ self.symbols = {}
+ self.calls = {}
+
+ self.profile = Profile()
+
+ _symbol_re = re.compile(
+ r'^(?P<id>\w+)' +
+ r'\s+"(?P<module>[^"]*)"' +
+ r'\s+"(?P<procname>[^"]*)"' +
+ r'\s+"(?P<sourcefile>[^"]*)"' +
+ r'\s+(?P<sourceline>\d+)$'
+ )
+
+ def openEntry(self, name):
+ # Some versions of verysleepy use lowercase filenames
+ for database_name in self.database.namelist():
+ if name.lower() == database_name.lower():
+ name = database_name
+ break
+
+ return self.database.open(name, 'r')
+
+ def parse_symbols(self):
+ for line in self.openEntry('Symbols.txt'):
+ line = line.decode('UTF-8').rstrip('\r\n')
+
+ mo = self._symbol_re.match(line)
+ if mo:
+ symbol_id, module, procname, sourcefile, sourceline = mo.groups()
+
+ function_id = ':'.join([module, procname])
+
+ try:
+ function = self.profile.functions[function_id]
+ except KeyError:
+ function = Function(function_id, procname)
+ function.module = module
+ function[SAMPLES] = 0
+ self.profile.add_function(function)
+
+ self.symbols[symbol_id] = function
+
+ def parse_callstacks(self):
+ for line in self.openEntry('Callstacks.txt'):
+ line = line.decode('UTF-8').rstrip('\r\n')
+
+ fields = line.split()
+ samples = float(fields[0])
+ callstack = fields[1:]
+
+ callstack = [self.symbols[symbol_id] for symbol_id in callstack]
+
+ callee = callstack[0]
+
+ callee[SAMPLES] += samples
+ self.profile[SAMPLES] += samples
+
+ for caller in callstack[1:]:
+ try:
+ call = caller.calls[callee.id]
+ except KeyError:
+ call = Call(callee.id)
+ call[SAMPLES2] = samples
+ caller.add_call(call)
+ else:
+ call[SAMPLES2] += samples
+
+ callee = caller
+
+ def parse(self):
+ profile = self.profile
+ profile[SAMPLES] = 0
+
+ self.parse_symbols()
+ self.parse_callstacks()
+
+ # Compute derived events
+ profile.validate()
+ profile.find_cycles()
+ profile.ratio(TIME_RATIO, SAMPLES)
+ profile.call_ratios(SAMPLES2)
+ profile.integrate(TOTAL_TIME_RATIO, TIME_RATIO)
+
+ return profile
+
+
+class PstatsParser:
+ """Parser python profiling statistics saved with te pstats module."""
+
+ stdinInput = False
+ multipleInput = True
+
+ def __init__(self, *filename):
+ import pstats
+ try:
+ self.stats = pstats.Stats(*filename)
+ except ValueError:
+ if PYTHON_3:
+ sys.stderr.write('error: failed to load %s\n' % ', '.join(filename))
+ sys.exit(1)
+ import hotshot.stats
+ self.stats = hotshot.stats.load(filename[0])
+ self.profile = Profile()
+ self.function_ids = {}
+
+ def get_function_name(self, key):
+ filename, line, name = key
+ module = os.path.splitext(filename)[0]
+ module = os.path.basename(module)
+ return "%s:%d:%s" % (module, line, name)
+
+ def get_function(self, key):
+ try:
+ id = self.function_ids[key]
+ except KeyError:
+ id = len(self.function_ids)
+ name = self.get_function_name(key)
+ function = Function(id, name)
+ function.filename = key[0]
+ self.profile.functions[id] = function
+ self.function_ids[key] = id
+ else:
+ function = self.profile.functions[id]
+ return function
+
+ def parse(self):
+ self.profile[TIME] = 0.0
+ self.profile[TOTAL_TIME] = self.stats.total_tt
+ for fn, (cc, nc, tt, ct, callers) in compat_iteritems(self.stats.stats):
+ callee = self.get_function(fn)
+ callee.called = nc
+ callee[TOTAL_TIME] = ct
+ callee[TIME] = tt
+ self.profile[TIME] += tt
+ self.profile[TOTAL_TIME] = max(self.profile[TOTAL_TIME], ct)
+ for fn, value in compat_iteritems(callers):
+ caller = self.get_function(fn)
+ call = Call(callee.id)
+ if isinstance(value, tuple):
+ for i in xrange(0, len(value), 4):
+ nc, cc, tt, ct = value[i:i+4]
+ if CALLS in call:
+ call[CALLS] += cc
+ else:
+ call[CALLS] = cc
+
+ if TOTAL_TIME in call:
+ call[TOTAL_TIME] += ct
+ else:
+ call[TOTAL_TIME] = ct
+
+ else:
+ call[CALLS] = value
+ call[TOTAL_TIME] = ratio(value, nc)*ct
+
+ caller.add_call(call)
+
+ if False:
+ self.stats.print_stats()
+ self.stats.print_callees()
+
+ # Compute derived events
+ self.profile.validate()
+ self.profile.ratio(TIME_RATIO, TIME)
+ self.profile.ratio(TOTAL_TIME_RATIO, TOTAL_TIME)
+
+ return self.profile
+
+
+formats = {
+ "axe": AXEParser,
+ "callgrind": CallgrindParser,
+ "hprof": HProfParser,
+ "json": JsonParser,
+ "oprofile": OprofileParser,
+ "perf": PerfParser,
+ "prof": GprofParser,
+ "pstats": PstatsParser,
+ "sleepy": SleepyParser,
+ "sysprof": SysprofParser,
+ "xperf": XPerfParser,
+}
+
+
+########################################################################
+# Output
+
+
+class Theme:
+
+ def __init__(self,
+ bgcolor = (0.0, 0.0, 1.0),
+ mincolor = (0.0, 0.0, 0.0),
+ maxcolor = (0.0, 0.0, 1.0),
+ fontname = "Arial",
+ fontcolor = "white",
+ nodestyle = "filled",
+ minfontsize = 10.0,
+ maxfontsize = 10.0,
+ minpenwidth = 0.5,
+ maxpenwidth = 4.0,
+ gamma = 2.2,
+ skew = 1.0):
+ self.bgcolor = bgcolor
+ self.mincolor = mincolor
+ self.maxcolor = maxcolor
+ self.fontname = fontname
+ self.fontcolor = fontcolor
+ self.nodestyle = nodestyle
+ self.minfontsize = minfontsize
+ self.maxfontsize = maxfontsize
+ self.minpenwidth = minpenwidth
+ self.maxpenwidth = maxpenwidth
+ self.gamma = gamma
+ self.skew = skew
+
+ def graph_bgcolor(self):
+ return self.hsl_to_rgb(*self.bgcolor)
+
+ def graph_fontname(self):
+ return self.fontname
+
+ def graph_fontcolor(self):
+ return self.fontcolor
+
+ def graph_fontsize(self):
+ return self.minfontsize
+
+ def node_bgcolor(self, weight):
+ return self.color(weight)
+
+ def node_fgcolor(self, weight):
+ if self.nodestyle == "filled":
+ return self.graph_bgcolor()
+ else:
+ return self.color(weight)
+
+ def node_fontsize(self, weight):
+ return self.fontsize(weight)
+
+ def node_style(self):
+ return self.nodestyle
+
+ def edge_color(self, weight):
+ return self.color(weight)
+
+ def edge_fontsize(self, weight):
+ return self.fontsize(weight)
+
+ def edge_penwidth(self, weight):
+ return max(weight*self.maxpenwidth, self.minpenwidth)
+
+ def edge_arrowsize(self, weight):
+ return 0.5 * math.sqrt(self.edge_penwidth(weight))
+
+ def fontsize(self, weight):
+ return max(weight**2 * self.maxfontsize, self.minfontsize)
+
+ def color(self, weight):
+ weight = min(max(weight, 0.0), 1.0)
+
+ hmin, smin, lmin = self.mincolor
+ hmax, smax, lmax = self.maxcolor
+
+ if self.skew < 0:
+ raise ValueError("Skew must be greater than 0")
+ elif self.skew == 1.0:
+ h = hmin + weight*(hmax - hmin)
+ s = smin + weight*(smax - smin)
+ l = lmin + weight*(lmax - lmin)
+ else:
+ base = self.skew
+ h = hmin + ((hmax-hmin)*(-1.0 + (base ** weight)) / (base - 1.0))
+ s = smin + ((smax-smin)*(-1.0 + (base ** weight)) / (base - 1.0))
+ l = lmin + ((lmax-lmin)*(-1.0 + (base ** weight)) / (base - 1.0))
+
+ return self.hsl_to_rgb(h, s, l)
+
+ def hsl_to_rgb(self, h, s, l):
+ """Convert a color from HSL color-model to RGB.
+
+ See also:
+ - http://www.w3.org/TR/css3-color/#hsl-color
+ """
+
+ h = h % 1.0
+ s = min(max(s, 0.0), 1.0)
+ l = min(max(l, 0.0), 1.0)
+
+ if l <= 0.5:
+ m2 = l*(s + 1.0)
+ else:
+ m2 = l + s - l*s
+ m1 = l*2.0 - m2
+ r = self._hue_to_rgb(m1, m2, h + 1.0/3.0)
+ g = self._hue_to_rgb(m1, m2, h)
+ b = self._hue_to_rgb(m1, m2, h - 1.0/3.0)
+
+ # Apply gamma correction
+ r **= self.gamma
+ g **= self.gamma
+ b **= self.gamma
+
+ return (r, g, b)
+
+ def _hue_to_rgb(self, m1, m2, h):
+ if h < 0.0:
+ h += 1.0
+ elif h > 1.0:
+ h -= 1.0
+ if h*6 < 1.0:
+ return m1 + (m2 - m1)*h*6.0
+ elif h*2 < 1.0:
+ return m2
+ elif h*3 < 2.0:
+ return m1 + (m2 - m1)*(2.0/3.0 - h)*6.0
+ else:
+ return m1
+
+
+TEMPERATURE_COLORMAP = Theme(
+ mincolor = (2.0/3.0, 0.80, 0.25), # dark blue
+ maxcolor = (0.0, 1.0, 0.5), # satured red
+ gamma = 1.0
+)
+
+PINK_COLORMAP = Theme(
+ mincolor = (0.0, 1.0, 0.90), # pink
+ maxcolor = (0.0, 1.0, 0.5), # satured red
+)
+
+GRAY_COLORMAP = Theme(
+ mincolor = (0.0, 0.0, 0.85), # light gray
+ maxcolor = (0.0, 0.0, 0.0), # black
+)
+
+BW_COLORMAP = Theme(
+ minfontsize = 8.0,
+ maxfontsize = 24.0,
+ mincolor = (0.0, 0.0, 0.0), # black
+ maxcolor = (0.0, 0.0, 0.0), # black
+ minpenwidth = 0.1,
+ maxpenwidth = 8.0,
+)
+
+PRINT_COLORMAP = Theme(
+ minfontsize = 18.0,
+ maxfontsize = 30.0,
+ fontcolor = "black",
+ nodestyle = "solid",
+ mincolor = (0.0, 0.0, 0.0), # black
+ maxcolor = (0.0, 0.0, 0.0), # black
+ minpenwidth = 0.1,
+ maxpenwidth = 8.0,
+)
+
+
+themes = {
+ "color": TEMPERATURE_COLORMAP,
+ "pink": PINK_COLORMAP,
+ "gray": GRAY_COLORMAP,
+ "bw": BW_COLORMAP,
+ "print": PRINT_COLORMAP,
+}
+
+
+def sorted_iteritems(d):
+ # Used mostly for result reproducibility (while testing.)
+ keys = compat_keys(d)
+ keys.sort()
+ for key in keys:
+ value = d[key]
+ yield key, value
+
+
+class DotWriter:
+ """Writer for the DOT language.
+
+ See also:
+ - "The DOT Language" specification
+ http://www.graphviz.org/doc/info/lang.html
+ """
+
+ strip = False
+ wrap = False
+
+ def __init__(self, fp):
+ self.fp = fp
+
+ def wrap_function_name(self, name):
+ """Split the function name on multiple lines."""
+
+ if len(name) > 32:
+ ratio = 2.0/3.0
+ height = max(int(len(name)/(1.0 - ratio) + 0.5), 1)
+ width = max(len(name)/height, 32)
+ # TODO: break lines in symbols
+ name = textwrap.fill(name, width, break_long_words=False)
+
+ # Take away spaces
+ name = name.replace(", ", ",")
+ name = name.replace("> >", ">>")
+ name = name.replace("> >", ">>") # catch consecutive
+
+ return name
+
+ show_function_events = [TOTAL_TIME_RATIO, TIME_RATIO]
+ show_edge_events = [TOTAL_TIME_RATIO, CALLS]
+
+ def graph(self, profile, theme):
+ self.begin_graph()
+
+ fontname = theme.graph_fontname()
+ fontcolor = theme.graph_fontcolor()
+ nodestyle = theme.node_style()
+
+ self.attr('graph', fontname=fontname, ranksep=0.25, nodesep=0.125)
+ self.attr('node', fontname=fontname, shape="box", style=nodestyle, fontcolor=fontcolor, width=0, height=0)
+ self.attr('edge', fontname=fontname)
+
+ for _, function in sorted_iteritems(profile.functions):
+ labels = []
+ if function.process is not None:
+ labels.append(function.process)
+ if function.module is not None:
+ labels.append(function.module)
+
+ if self.strip:
+ function_name = function.stripped_name()
+ else:
+ function_name = function.name
+
+ # dot can't parse quoted strings longer than YY_BUF_SIZE, which
+ # defaults to 16K. But some annotated C++ functions (e.g., boost,
+ # https://github.com/jrfonseca/gprof2dot/issues/30) can exceed that
+ MAX_FUNCTION_NAME = 4096
+ if len(function_name) >= MAX_FUNCTION_NAME:
+ sys.stderr.write('warning: truncating function name with %u chars (%s)\n' % (len(function_name), function_name[:32] + '...'))
+ function_name = function_name[:MAX_FUNCTION_NAME - 1] + unichr(0x2026)
+
+ if self.wrap:
+ function_name = self.wrap_function_name(function_name)
+ labels.append(function_name)
+
+ for event in self.show_function_events:
+ if event in function.events:
+ label = event.format(function[event])
+ labels.append(label)
+ if function.called is not None:
+ labels.append("%u%s" % (function.called, MULTIPLICATION_SIGN))
+
+ if function.weight is not None:
+ weight = function.weight
+ else:
+ weight = 0.0
+
+ label = '\n'.join(labels)
+ self.node(function.id,
+ label = label,
+ color = self.color(theme.node_bgcolor(weight)),
+ fontcolor = self.color(theme.node_fgcolor(weight)),
+ fontsize = "%.2f" % theme.node_fontsize(weight),
+ tooltip = function.filename,
+ )
+
+ for _, call in sorted_iteritems(function.calls):
+ callee = profile.functions[call.callee_id]
+
+ labels = []
+ for event in self.show_edge_events:
+ if event in call.events:
+ label = event.format(call[event])
+ labels.append(label)
+
+ if call.weight is not None:
+ weight = call.weight
+ elif callee.weight is not None:
+ weight = callee.weight
+ else:
+ weight = 0.0
+
+ label = '\n'.join(labels)
+
+ self.edge(function.id, call.callee_id,
+ label = label,
+ color = self.color(theme.edge_color(weight)),
+ fontcolor = self.color(theme.edge_color(weight)),
+ fontsize = "%.2f" % theme.edge_fontsize(weight),
+ penwidth = "%.2f" % theme.edge_penwidth(weight),
+ labeldistance = "%.2f" % theme.edge_penwidth(weight),
+ arrowsize = "%.2f" % theme.edge_arrowsize(weight),
+ )
+
+ self.end_graph()
+
+ def begin_graph(self):
+ self.write('digraph {\n')
+
+ def end_graph(self):
+ self.write('}\n')
+
+ def attr(self, what, **attrs):
+ self.write("\t")
+ self.write(what)
+ self.attr_list(attrs)
+ self.write(";\n")
+
+ def node(self, node, **attrs):
+ self.write("\t")
+ self.id(node)
+ self.attr_list(attrs)
+ self.write(";\n")
+
+ def edge(self, src, dst, **attrs):
+ self.write("\t")
+ self.id(src)
+ self.write(" -> ")
+ self.id(dst)
+ self.attr_list(attrs)
+ self.write(";\n")
+
+ def attr_list(self, attrs):
+ if not attrs:
+ return
+ self.write(' [')
+ first = True
+ for name, value in sorted_iteritems(attrs):
+ if value is None:
+ continue
+ if first:
+ first = False
+ else:
+ self.write(", ")
+ self.id(name)
+ self.write('=')
+ self.id(value)
+ self.write(']')
+
+ def id(self, id):
+ if isinstance(id, (int, float)):
+ s = str(id)
+ elif isinstance(id, basestring):
+ if id.isalnum() and not id.startswith('0x'):
+ s = id
+ else:
+ s = self.escape(id)
+ else:
+ raise TypeError
+ self.write(s)
+
+ def color(self, rgb):
+ r, g, b = rgb
+
+ def float2int(f):
+ if f <= 0.0:
+ return 0
+ if f >= 1.0:
+ return 255
+ return int(255.0*f + 0.5)
+
+ return "#" + "".join(["%02x" % float2int(c) for c in (r, g, b)])
+
+ def escape(self, s):
+ if not PYTHON_3:
+ s = s.encode('utf-8')
+ s = s.replace('\\', r'\\')
+ s = s.replace('\n', r'\n')
+ s = s.replace('\t', r'\t')
+ s = s.replace('"', r'\"')
+ return '"' + s + '"'
+
+ def write(self, s):
+ self.fp.write(s)
+
+
+
+########################################################################
+# Main program
+
+
+def naturalJoin(values):
+ if len(values) >= 2:
+ return ', '.join(values[:-1]) + ' or ' + values[-1]
+
+ else:
+ return ''.join(values)
+
+
+def main():
+ """Main program."""
+
+ global totalMethod
+
+ formatNames = list(formats.keys())
+ formatNames.sort()
+
+ optparser = optparse.OptionParser(
+ usage="\n\t%prog [options] [file] ...")
+ optparser.add_option(
+ '-o', '--output', metavar='FILE',
+ type="string", dest="output",
+ help="output filename [stdout]")
+ optparser.add_option(
+ '-n', '--node-thres', metavar='PERCENTAGE',
+ type="float", dest="node_thres", default=0.5,
+ help="eliminate nodes below this threshold [default: %default]")
+ optparser.add_option(
+ '-e', '--edge-thres', metavar='PERCENTAGE',
+ type="float", dest="edge_thres", default=0.1,
+ help="eliminate edges below this threshold [default: %default]")
+ optparser.add_option(
+ '-f', '--format',
+ type="choice", choices=formatNames,
+ dest="format", default="prof",
+ help="profile format: %s [default: %%default]" % naturalJoin(formatNames))
+ optparser.add_option(
+ '--total',
+ type="choice", choices=('callratios', 'callstacks'),
+ dest="totalMethod", default=totalMethod,
+ help="preferred method of calculating total time: callratios or callstacks (currently affects only perf format) [default: %default]")
+ optparser.add_option(
+ '-c', '--colormap',
+ type="choice", choices=('color', 'pink', 'gray', 'bw', 'print'),
+ dest="theme", default="color",
+ help="color map: color, pink, gray, bw, or print [default: %default]")
+ optparser.add_option(
+ '-s', '--strip',
+ action="store_true",
+ dest="strip", default=False,
+ help="strip function parameters, template parameters, and const modifiers from demangled C++ function names")
+ optparser.add_option(
+ '--colour-nodes-by-selftime',
+ action="store_true",
+ dest="colour_nodes_by_selftime", default=False,
+ help="colour nodes by self time, rather than by total time (sum of self and descendants)")
+ optparser.add_option(
+ '-w', '--wrap',
+ action="store_true",
+ dest="wrap", default=False,
+ help="wrap function names")
+ optparser.add_option(
+ '--show-samples',
+ action="store_true",
+ dest="show_samples", default=False,
+ help="show function samples")
+ # add option to create subtree or show paths
+ optparser.add_option(
+ '-z', '--root',
+ type="string",
+ dest="root", default="",
+ help="prune call graph to show only descendants of specified root function")
+ optparser.add_option(
+ '-l', '--leaf',
+ type="string",
+ dest="leaf", default="",
+ help="prune call graph to show only ancestors of specified leaf function")
+ # add a new option to control skew of the colorization curve
+ optparser.add_option(
+ '--skew',
+ type="float", dest="theme_skew", default=1.0,
+ help="skew the colorization curve. Values < 1.0 give more variety to lower percentages. Values > 1.0 give less variety to lower percentages")
+ (options, args) = optparser.parse_args(sys.argv[1:])
+
+ if len(args) > 1 and options.format != 'pstats':
+ optparser.error('incorrect number of arguments')
+
+ try:
+ theme = themes[options.theme]
+ except KeyError:
+ optparser.error('invalid colormap \'%s\'' % options.theme)
+
+ # set skew on the theme now that it has been picked.
+ if options.theme_skew:
+ theme.skew = options.theme_skew
+
+ totalMethod = options.totalMethod
+
+ try:
+ Format = formats[options.format]
+ except KeyError:
+ optparser.error('invalid format \'%s\'' % options.format)
+
+ if Format.stdinInput:
+ if not args:
+ fp = sys.stdin
+ elif PYTHON_3:
+ fp = open(args[0], 'rt', encoding='UTF-8')
+ else:
+ fp = open(args[0], 'rt')
+ parser = Format(fp)
+ elif Format.multipleInput:
+ if not args:
+ optparser.error('at least a file must be specified for %s input' % options.format)
+ parser = Format(*args)
+ else:
+ if len(args) != 1:
+ optparser.error('exactly one file must be specified for %s input' % options.format)
+ parser = Format(args[0])
+
+ profile = parser.parse()
+
+ if options.output is None:
+ if PYTHON_3:
+ output = open(sys.stdout.fileno(), mode='wt', encoding='UTF-8', closefd=False)
+ else:
+ output = sys.stdout
+ else:
+ if PYTHON_3:
+ output = open(options.output, 'wt', encoding='UTF-8')
+ else:
+ output = open(options.output, 'wt')
+
+ dot = DotWriter(output)
+ dot.strip = options.strip
+ dot.wrap = options.wrap
+ if options.show_samples:
+ dot.show_function_events.append(SAMPLES)
+
+ profile = profile
+ profile.prune(options.node_thres/100.0, options.edge_thres/100.0, options.colour_nodes_by_selftime)
+
+ if options.root:
+ rootId = profile.getFunctionId(options.root)
+ if not rootId:
+ sys.stderr.write('root node ' + options.root + ' not found (might already be pruned : try -e0 -n0 flags)\n')
+ sys.exit(1)
+ profile.prune_root(rootId)
+ if options.leaf:
+ leafId = profile.getFunctionId(options.leaf)
+ if not leafId:
+ sys.stderr.write('leaf node ' + options.leaf + ' not found (maybe already pruned : try -e0 -n0 flags)\n')
+ sys.exit(1)
+ profile.prune_leaf(leafId)
+
+ dot.graph(profile, theme)
+
+
+if __name__ == '__main__':
+ main()
diff --git a/contrib/haskell/data/pseudo3.ui b/contrib/haskell/data/pseudo3.ui
new file mode 100644
index 0000000..5bb4d7e
--- /dev/null
+++ b/contrib/haskell/data/pseudo3.ui
@@ -0,0 +1,240 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- Generated with glade 3.20.0 -->
+<interface>
+ <requires lib="gtk+" version="3.14"/>
+ <object class="GtkImage" id="image1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-goto-bottom</property>
+ </object>
+ <object class="GtkListStore" id="store_mode">
+ <columns>
+ <!-- column-name name -->
+ <column type="gchararray"/>
+ <!-- column-name mode -->
+ <column type="gpointer"/>
+ </columns>
+ </object>
+ <object class="GtkListStore" id="store_mode_parameter">
+ <columns>
+ <!-- column-name name -->
+ <column type="gchararray"/>
+ <!-- column-name idx -->
+ <column type="guint"/>
+ <!-- column-name value -->
+ <column type="gdouble"/>
+ </columns>
+ </object>
+ <object class="GtkListStore" id="store_pseudo">
+ <columns>
+ <!-- column-name name -->
+ <column type="gchararray"/>
+ <!-- column-name idx -->
+ <column type="guint"/>
+ <!-- column-name value -->
+ <column type="gdouble"/>
+ </columns>
+ </object>
+ <object class="GtkFrame" id="frame1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label_xalign">0</property>
+ <property name="shadow_type">none</property>
+ <child>
+ <object class="GtkAlignment" id="alignment1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="left_padding">12</property>
+ <child>
+ <object class="GtkBox" id="vbox1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkTreeView" id="treeview1">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="model">store_pseudo</property>
+ <property name="headers_clickable">False</property>
+ <property name="search_column">0</property>
+ <property name="enable_grid_lines">both</property>
+ <property name="enable_tree_lines">True</property>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection" id="treeview-selection1"/>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn1">
+ <property name="title">pseudo axis</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext1"/>
+ <attributes>
+ <attribute name="text">0</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn2">
+ <property name="title">value</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrendererspin1">
+ <property name="editable">True</property>
+ </object>
+ <attributes>
+ <attribute name="text">2</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="hbox1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="spacing">3</property>
+ <child>
+ <object class="GtkLabel" id="label1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">mode</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkComboBox" id="combobox1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="model">store_mode</property>
+ <property name="add_tearoffs">True</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext2"/>
+ <attributes>
+ <attribute name="text">0</attribute>
+ </attributes>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="button1">
+ <property name="label">gtk-apply</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="button2">
+ <property name="label">Initialize</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <property name="image">image1</property>
+ <property name="image_position">right</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkExpander" id="expander1">
+ <property name="can_focus">True</property>
+ <property name="no_show_all">True</property>
+ <child>
+ <object class="GtkTreeView" id="treeview2">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="model">store_mode_parameter</property>
+ <property name="headers_visible">False</property>
+ <property name="headers_clickable">False</property>
+ <property name="rules_hint">True</property>
+ <property name="search_column">0</property>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection" id="treeview-selection2"/>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn3">
+ <property name="title">parameter</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrenderertext3"/>
+ <attributes>
+ <attribute name="text">0</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkTreeViewColumn" id="treeviewcolumn4">
+ <property name="title">value</property>
+ <child>
+ <object class="GtkCellRendererText" id="cellrendererspin2">
+ <property name="editable">True</property>
+ <signal name="edited" handler="cellrendererspin2_edited_cb" swapped="no"/>
+ </object>
+ <attributes>
+ <attribute name="text">2</attribute>
+ </attributes>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">parameters</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">frame1</property>
+ <attributes>
+ <attribute name="weight" value="bold"/>
+ </attributes>
+ </object>
+ </child>
+ </object>
+</interface>
diff --git a/contrib/haskell/hkl.cabal b/contrib/haskell/hkl.cabal
new file mode 100644
index 0000000..2c2ef08
--- /dev/null
+++ b/contrib/haskell/hkl.cabal
@@ -0,0 +1,192 @@
+name: hkl
+
+-- The package version. See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- http://www.haskell.org/haskellwiki/Package_versioning_policy
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.1.0.0
+license: GPL-3
+license-file: LICENSE
+author: Picca Frédéric-Emmanuel
+maintainer: picca@debian.org
+copyright: Synchrotron SOLEIL
+build-type: Simple
+cabal-version: >= 1.10
+Data-Files: data/ghkl3.ui
+ , data/gprof2dot.py
+ , data/pseudo3.ui
+ , data/3d3.ui
+
+Flag useHMatrixGsl
+ Description: Enable the HmatrixGSL package
+ Default: False
+
+executable ghkl
+ main-is: src/ghkl.hs
+ build-depends: attoparsec
+ , base >= 4.6 && < 4.10
+ , bindings-hdf5 >= 1.8.12
+ , containers >= 0.5 && < 0.6
+ , dimensional >= 0.10
+ , filepath >= 1.3.0
+ , Glob >= 0.7.5
+ , hkl
+ , hmatrix >= 0.15
+ , monad-loops >= 0.4.2
+ , pipes >= 4.1.2
+ , text
+ , transformers >= 0.3
+ , vector >= 0.10.0.1
+ default-language: Haskell2010
+ pkgconfig-depends: hkl
+ build-tools: hsc2hs
+ ghc-options: -Wall -threaded -O2
+ ghc-options: -Werror
+ ghc-prof-options: -fprof-auto "-with-rtsopts=-N -p -s -h -i0.1"
+
+executable xrd
+ main-is: src/xrd.hs
+ build-depends: attoparsec
+ , base >= 4.6 && < 4.10
+ , bindings-hdf5 >= 1.8.12
+ , containers >= 0.5 && < 0.6
+ , dimensional >= 0.10
+ , filepath >= 1.3.0
+ , Glob >= 0.7.5
+ , hkl
+ , hmatrix >= 0.15
+ , monad-loops >= 0.4.2
+ , pipes >= 4.1.2
+ , text
+ , transformers >= 0.3
+ , vector >= 0.10.0.1
+
+ default-language: Haskell2010
+ pkgconfig-depends: hkl
+ build-tools: hsc2hs
+ ghc-options: -Wall -threaded -O2
+ ghc-options: -Werror
+ ghc-prof-options: -fprof-auto "-with-rtsopts=-N -p -s -h -i0.1"
+
+executable hkl3d
+ main-is: src/hkl3d.hs
+ build-depends: base >= 4.6 && < 4.10
+ , bindings-hdf5 >= 1.8.12
+ , containers >= 0.5 && < 0.6
+ , dimensional >= 0.10
+ , filepath >= 1.3.0
+ , hkl
+ , hmatrix >= 0.15
+ , monad-loops >= 0.4.2
+ , pipes >= 4.1.2
+ , text
+ , transformers >= 0.3
+ , vector >= 0.10.0.1
+ default-language: Haskell2010
+ pkgconfig-depends: hkl
+ build-tools: hsc2hs
+ ghc-options: -Wall -threaded -O2
+ ghc-options: -Werror
+ ghc-prof-options: -fprof-auto "-with-rtsopts=-N -p -s -h -i0.1"
+
+library
+ exposed-modules: Hkl
+ , Hkl.C
+ , Hkl.C.DArray
+ , Hkl.C.Detector
+ , Hkl.C.Engine
+ , Hkl.C.EngineList
+ , Hkl.C.Geometry
+ , Hkl.C.GeometryList
+ , Hkl.C.Lattice
+ , Hkl.C.Sample
+ , Hkl.DataSource
+ , Hkl.Detector
+ , Hkl.Edf
+ , Hkl.Engine
+ , Hkl.Flat
+ , Hkl.H5
+ , Hkl.Lattice
+ , Hkl.MyMatrix
+ , Hkl.Nxs
+ , Hkl.Projects
+ , Hkl.Projects.D2AM
+ , Hkl.Projects.D2AM.XRD
+ , Hkl.Projects.Diffabs
+ , Hkl.Projects.Diffabs.Charlier
+ , Hkl.Projects.Diffabs.Hamon
+ , Hkl.Projects.Diffabs.Hercules
+ , Hkl.Projects.Diffabs.IRDRx
+ , Hkl.Projects.Diffabs.Laure
+ , Hkl.Projects.Diffabs.Melle
+ , Hkl.Projects.Diffabs.Martinetto
+ , Hkl.Projects.Mars
+ , Hkl.Projects.Mars.Romeden
+ , Hkl.Projects.Mars.Schlegel
+ , Hkl.Projects.Sixs
+ , Hkl.PyFAI
+ , Hkl.PyFAI.AzimuthalIntegrator
+ , Hkl.PyFAI.Calib
+ , Hkl.PyFAI.Calibrant
+ , Hkl.PyFAI.Detector
+ , Hkl.PyFAI.Poni
+ , Hkl.PyFAI.PoniExt
+ , Hkl.PyFAI.Npt
+ , Hkl.Script
+ , Hkl.Tiff
+ , Hkl.Types
+ , Hkl.Types.Parameter
+ , Hkl.Utils
+ , Hkl.Xrd
+ , Hkl.Xrd.Calibration
+ , Hkl.Xrd.Mesh
+ , Hkl.Xrd.OneD
+ , Hkl.Xrd.ZeroD
+ other-modules: Paths_hkl
+ , Hkl.Python
+ other-extensions: CPP
+ , ForeignFunctionInterface
+ , EmptyDataDecls
+ , TypeFamilies
+ , FlexibleInstances
+ , FlexibleContexts
+ , RecordWildCards
+ build-depends: async
+ , attoparsec
+ , base >= 4.6 && < 4.10
+ , bindings-hdf5 >= 1.8.12
+ , bytestring >= 0.10.0.2
+ , containers >= 0.5 && < 0.6
+ , dimensional >= 0.10
+ , directory >= 1.2.0
+ , errors
+ , filepath >= 1.3.0
+ , Glob >= 0.7.5
+ , hdf5
+ , hmatrix >= 0.15
+ , JuicyPixels >= 3.1.7
+ , mmorph >= 1.0.3
+ , monad-loops >= 0.4.2
+ , monads-tf
+ , pipes >= 4.1.2
+ , pipes-safe >= 2.2.0
+ , process >= 1.1
+ , repa
+ , text
+ , transformers >= 0.3
+ , unix >= 2.6.0.0
+ , vector >= 0.10.0.1
+
+ if flag(useHMatrixGsl)
+ build-depends: hmatrix-gsl >= 0.16
+
+ hs-source-dirs: src
+ build-tools: hsc2hs
+ default-language: Haskell2010
+ pkgconfig-depends: hkl
+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-import-lists -O2
+ -- ghc-options: -fno-warn-incomplete-patterns
+ -- ghc-options: -Werror
+ ghc-prof-options: -fprof-auto-top \ No newline at end of file
diff --git a/contrib/haskell/src/Hkl.hs b/contrib/haskell/src/Hkl.hs
new file mode 100644
index 0000000..d52a69a
--- /dev/null
+++ b/contrib/haskell/src/Hkl.hs
@@ -0,0 +1,16 @@
+module Hkl (module X) where
+
+import Hkl.C as X
+import Hkl.DataSource as X
+import Hkl.Detector as X
+import Hkl.Engine as X
+import Hkl.Flat as X
+import Hkl.H5 as X
+import Hkl.Lattice as X
+import Hkl.MyMatrix as X
+import Hkl.Nxs as X
+import Hkl.PyFAI as X
+import Hkl.Script as X
+import Hkl.Tiff as X
+import Hkl.Types as X
+import Hkl.Xrd as X
diff --git a/contrib/haskell/src/Hkl/C.hsc b/contrib/haskell/src/Hkl/C.hsc
new file mode 100644
index 0000000..6066d51
--- /dev/null
+++ b/contrib/haskell/src/Hkl/C.hsc
@@ -0,0 +1,160 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE CPP #-}
+
+module Hkl.C
+ ( compute
+ , computePipe
+ , solve
+ , solveTraj
+ , solveTrajPipe
+ , module X
+ ) where
+
+import Prelude hiding (min, max)
+
+import Control.Monad (forever)
+import Control.Monad.Trans.State.Strict
+import Foreign ( ForeignPtr
+ , FunPtr
+ , Ptr
+ , nullPtr
+ , newForeignPtr
+ , withForeignPtr
+ , withArray)
+import Foreign.C ( CInt(..), CSize(..), CString
+ , withCString)
+
+import Pipes (Pipe, await, lift, yield)
+
+import Hkl.C.Detector
+import Hkl.C.Engine
+import Hkl.C.EngineList
+import Hkl.C.Geometry as X
+import Hkl.C.GeometryList as X
+import Hkl.C.Sample
+import Hkl.Detector
+import Hkl.Types
+
+#include "hkl.h"
+
+-- Engine
+
+solve' :: Ptr HklEngine -> Engine -> IO (ForeignPtr HklGeometryList)
+solve' engine (Engine _ ps _) = do
+ let positions = [v | (Parameter _ v _) <- ps]
+ let n = toEnum (length positions)
+ withArray positions $ \values ->
+ c_hkl_engine_pseudo_axis_values_set engine values n unit nullPtr
+ >>= newForeignPtr c_hkl_geometry_list_free
+
+solve :: Geometry -> Detector a -> Sample b -> Engine -> IO [Geometry]
+solve g@(Geometry f _ _ _) d s e@(Engine name _ _) = do
+ withSample s $ \sample ->
+ withDetector d $ \detector ->
+ withGeometry g $ \geometry ->
+ withEngineList f $ \engines ->
+ withCString name $ \cname -> do
+ c_hkl_engine_list_init engines geometry detector sample
+ engine <- c_hkl_engine_list_engine_get_by_name engines cname nullPtr
+ solve' engine e >>= peekHklGeometryList
+
+solveTraj :: Geometry -> Detector a -> Sample b -> [Engine] -> IO [Geometry]
+solveTraj g@(Geometry f _ _ _) d s es = do
+ let name = engineName (head es)
+ withSample s $ \sample ->
+ withDetector d $ \detector ->
+ withGeometry g $ \geometry ->
+ withEngineList f $ \engines ->
+ withCString name $ \cname -> do
+ c_hkl_engine_list_init engines geometry detector sample
+ engine <- c_hkl_engine_list_engine_get_by_name engines cname nullPtr
+ mapM (\e -> solve' engine e >>= getSolution0) es
+
+-- Pipe
+
+data Diffractometer = Diffractometer { difEngineList :: (ForeignPtr HklEngineList)
+ , difGeometry :: (ForeignPtr Geometry)
+ , difDetector :: (ForeignPtr HklDetector)
+ , difSample :: (ForeignPtr HklSample)
+ }
+ deriving (Show)
+
+withDiffractometer :: Diffractometer -> (Ptr HklEngineList -> IO b) -> IO b
+withDiffractometer d fun = do
+ let f_engines = difEngineList d
+ withForeignPtr f_engines fun
+
+newDiffractometer :: Geometry -> Detector a -> Sample b -> IO Diffractometer
+newDiffractometer g@(Geometry f _ _ _) d s = do
+ f_engines <- newEngineList f
+ f_geometry <- newGeometry g
+ f_detector <- newDetector d
+ f_sample <- newSample s
+ withForeignPtr f_sample $ \sample ->
+ withForeignPtr f_detector $ \detector ->
+ withForeignPtr f_geometry $ \geometry ->
+ withForeignPtr f_engines $ \engines -> do
+ c_hkl_engine_list_init engines geometry detector sample
+ return $ Diffractometer { difEngineList = f_engines
+ , difGeometry = f_geometry
+ , difDetector = f_detector
+ , difSample = f_sample
+ }
+
+computePipe :: Detector a -> Sample b -> Pipe Geometry [Engine] IO ()
+computePipe d s = forever $ do
+ g <- await
+ e <- lift $ compute g d s
+ yield e
+
+solveTrajPipe :: Geometry -> Detector a -> Sample b -> Pipe Engine Geometry IO ()
+solveTrajPipe g d s = do
+ dif <- lift $ newDiffractometer g d s
+ solveTrajPipe' dif
+
+solveTrajPipe' :: Diffractometer -> Pipe Engine Geometry IO ()
+solveTrajPipe' dif = flip evalStateT dif $ forever $ do
+ -- Inside here we are using `StateT Diffractometer (Pipe Engine Geometry IO ()) r`
+ e <- lift await
+ dif_ <- get
+ let name = engineName e
+ solutions <- lift . lift $ withDiffractometer dif_ $ \engines ->
+ withCString name $ \cname -> do
+ engine <- c_hkl_engine_list_engine_get_by_name engines cname nullPtr
+ solve' engine e >>= getSolution0
+ put dif_
+ lift $ yield solutions
+
+foreign import ccall unsafe "hkl.h hkl_engine_list_engine_get_by_name"
+ c_hkl_engine_list_engine_get_by_name :: Ptr HklEngineList --engine list
+ -> CString -- engine name
+ -> Ptr () -- gerror need to deal about this
+ -> IO (Ptr HklEngine) -- the returned HklEngine
+
+foreign import ccall unsafe "hkl.h hkl_engine_pseudo_axis_values_set"
+ c_hkl_engine_pseudo_axis_values_set :: Ptr HklEngine
+ -> Ptr Double --values
+ -> CSize -- n_values
+ -> CInt -- unit_type
+ -> Ptr () -- GError **error
+ -> IO (Ptr HklGeometryList)
+
+foreign import ccall unsafe "hkl.h &hkl_geometry_list_free"
+ c_hkl_geometry_list_free :: FunPtr (Ptr HklGeometryList -> IO ())
+
+compute :: Geometry -> Detector a -> Sample b -> IO [Engine]
+compute g@(Geometry f _ _ _) d s = do
+ withSample s $ \sample ->
+ withDetector d $ \detector ->
+ withGeometry g $ \geometry ->
+ withEngineList f $ \engines -> do
+ c_hkl_engine_list_init engines geometry detector sample
+ c_hkl_engine_list_get engines
+ engineListEnginesGet engines
+
+foreign import ccall unsafe "hkl.h hkl_engine_list_init"
+ c_hkl_engine_list_init:: Ptr HklEngineList -> Ptr Geometry -> Ptr HklDetector -> Ptr HklSample -> IO ()
+
+foreign import ccall unsafe "hkl.h hkl_engine_list_get"
+ c_hkl_engine_list_get:: Ptr HklEngineList -> IO ()
diff --git a/contrib/haskell/src/Hkl/C/DArray.hsc b/contrib/haskell/src/Hkl/C/DArray.hsc
new file mode 100644
index 0000000..82520ee
--- /dev/null
+++ b/contrib/haskell/src/Hkl/C/DArray.hsc
@@ -0,0 +1,25 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Hkl.C.DArray
+ (DArray(..)) where
+
+import Foreign (peekArray)
+import Foreign.C (CSize, CString)
+import Foreign.Storable (Storable(..))
+
+#include "hkl.h"
+
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+
+data DArray a = DArray CSize [a] deriving Show
+
+instance Storable (DArray CString) where
+ alignment _ = #{alignment darray_string}
+ sizeOf _ = #{size darray_string}
+ peek ptr = do
+ n <- (#{peek darray_string, size} ptr)
+ items <- #{peek darray_string ,item} ptr
+ ss <- peekArray (fromEnum n) items
+ return $ DArray n ss
diff --git a/contrib/haskell/src/Hkl/C/Detector.hsc b/contrib/haskell/src/Hkl/C/Detector.hsc
new file mode 100644
index 0000000..73c6b1d
--- /dev/null
+++ b/contrib/haskell/src/Hkl/C/Detector.hsc
@@ -0,0 +1,41 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GADTs #-}
+
+module Hkl.C.Detector
+ ( HklDetector
+ , newDetector
+ , withDetector
+ ) where
+
+import Prelude hiding (min, max)
+
+import Foreign ( ForeignPtr
+ , FunPtr
+ , Ptr
+ , newForeignPtr
+ , withForeignPtr)
+import Foreign.C (CInt(..))
+
+import Hkl.Detector
+
+#include "hkl.h"
+
+data HklDetector
+
+-- Detector
+
+withDetector :: Detector a -> (Ptr HklDetector -> IO b) -> IO b
+withDetector d func = do
+ fptr <- newDetector d
+ withForeignPtr fptr func
+
+newDetector :: Detector a -> IO (ForeignPtr HklDetector)
+newDetector ZeroD = c_hkl_detector_new 0 >>= newForeignPtr c_hkl_detector_free
+newDetector _ = error "Can not use 2D detector with the hkl library"
+
+foreign import ccall unsafe "hkl.h hkl_detector_new"
+ c_hkl_detector_new:: CInt -> IO (Ptr HklDetector)
+
+foreign import ccall unsafe "hkl.h &hkl_detector_free"
+ c_hkl_detector_free :: FunPtr (Ptr HklDetector -> IO ())
diff --git a/contrib/haskell/src/Hkl/C/Engine.hsc b/contrib/haskell/src/Hkl/C/Engine.hsc
new file mode 100644
index 0000000..9d5eced
--- /dev/null
+++ b/contrib/haskell/src/Hkl/C/Engine.hsc
@@ -0,0 +1,81 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GADTs #-}
+
+module Hkl.C.Engine
+ ( HklEngine
+ , engineName
+ , peekEngine
+ ) where
+
+import Prelude hiding (min, max)
+
+import Foreign (Ptr, nullPtr)
+import Foreign.C (CString, peekCString)
+import Foreign.Storable
+
+import Hkl.C.DArray
+import Hkl.Types
+
+#include "hkl.h"
+
+-- private types
+
+data HklEngine
+
+-- Engine
+
+engineName :: Engine -> String
+engineName (Engine name _ _) = name
+
+-- Engine
+
+peekMode :: Ptr HklEngine -> IO Mode
+peekMode e = do
+ name <- c_hkl_engine_current_mode_get e >>= peekCString
+ (DArray _ ns) <- peek =<< c_hkl_engine_parameters_names_get e
+ parameters <- mapM f ns
+ return (Mode name parameters)
+ where
+ f n = (c_hkl_engine_parameter_get e n nullPtr >>= peek)
+
+foreign import ccall unsafe "hkl.h hkl_engine_current_mode_get"
+ c_hkl_engine_current_mode_get :: Ptr HklEngine -> IO CString
+
+foreign import ccall unsafe "hkl.h hkl_engine_parameters_names_get"
+ c_hkl_engine_parameters_names_get:: Ptr HklEngine -> IO (Ptr (DArray CString))
+
+foreign import ccall unsafe "hkl.h hkl_engine_parameter_get"
+ c_hkl_engine_parameter_get:: Ptr HklEngine -> CString -> Ptr () -> IO (Ptr Parameter) -- darray_string
+
+
+peekEngine :: Ptr HklEngine -> IO Engine
+peekEngine e = do
+ name <- peekCString =<< c_hkl_engine_name_get e
+ ps <- enginePseudoAxesGet e
+ mode <- peekMode e
+ return (Engine name ps mode)
+
+-- engineNameGet :: Ptr HklEngine -> IO String
+-- engineNameGet engine = c_hkl_engine_name_get engine >>= peekCString
+
+foreign import ccall unsafe "hkl.h hkl_engine_name_get"
+ c_hkl_engine_name_get :: Ptr HklEngine -> IO CString
+
+foreign import ccall unsafe "hkl.h hkl_engine_pseudo_axis_names_get"
+ c_hkl_engine_pseudo_axis_names_get:: Ptr HklEngine -> IO (Ptr (DArray CString))
+
+-- enginePseudoAxisNamesGet :: Ptr HklEngine -> IO [String]
+-- enginePseudoAxisNamesGet e = enginePseudoAxisNamesGet' e >>= mapM peekCString
+
+enginePseudoAxisGet :: Ptr HklEngine -> CString -> IO Parameter
+enginePseudoAxisGet e n = c_hkl_engine_pseudo_axis_get e n nullPtr >>= peek
+
+foreign import ccall unsafe "hkl.h hkl_engine_pseudo_axis_get"
+ c_hkl_engine_pseudo_axis_get:: Ptr HklEngine -> CString -> Ptr () -> IO (Ptr Parameter)
+
+enginePseudoAxesGet :: Ptr HklEngine -> IO [Parameter]
+enginePseudoAxesGet ptr = do
+ (DArray _ ns) <- peek =<< c_hkl_engine_pseudo_axis_names_get ptr
+ mapM (enginePseudoAxisGet ptr) ns
+
diff --git a/contrib/haskell/src/Hkl/C/EngineList.hsc b/contrib/haskell/src/Hkl/C/EngineList.hsc
new file mode 100644
index 0000000..08232f6
--- /dev/null
+++ b/contrib/haskell/src/Hkl/C/EngineList.hsc
@@ -0,0 +1,60 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GADTs #-}
+
+module Hkl.C.EngineList
+ ( HklEngineList
+ , engineListEnginesGet
+ , newEngineList
+ , withEngineList
+ ) where
+
+import Prelude hiding (min, max)
+
+import Foreign ( ForeignPtr
+ , FunPtr
+ , Ptr
+ , newForeignPtr
+ , withForeignPtr
+ , peekArray)
+import Foreign.C ( CSize(..) )
+import Foreign.Storable
+
+import Hkl.C.Engine
+import Hkl.C.Geometry
+import Hkl.Types
+
+#include "hkl.h"
+
+-- private types
+
+data HklEngineList
+
+-- EngineList
+
+withEngineList :: Factory -> (Ptr HklEngineList -> IO b) -> IO b
+withEngineList f func = do
+ fptr <- newEngineList f
+ withForeignPtr fptr func
+
+newEngineList :: Factory -> IO (ForeignPtr HklEngineList)
+newEngineList f = newFactory f
+ >>= c_hkl_factory_create_new_engine_list
+ >>= newForeignPtr c_hkl_engine_list_free
+
+foreign import ccall unsafe "hkl.h hkl_factory_create_new_engine_list"
+ c_hkl_factory_create_new_engine_list:: Ptr HklFactory -> IO (Ptr HklEngineList)
+
+foreign import ccall unsafe "hkl.h &hkl_engine_list_free"
+ c_hkl_engine_list_free :: FunPtr (Ptr HklEngineList -> IO ())
+
+engineListEnginesGet :: Ptr HklEngineList -> IO [Engine]
+engineListEnginesGet e = do
+ pdarray <- c_hkl_engine_list_engines_get e
+ n <- (#{peek darray_engine, size} pdarray) :: IO CSize
+ engines <- #{peek darray_engine ,item} pdarray :: IO (Ptr (Ptr HklEngine))
+ enginess <- peekArray (fromEnum n) engines
+ mapM peekEngine enginess
+
+foreign import ccall unsafe "hkl.h hkl_engine_list_engines_get"
+ c_hkl_engine_list_engines_get:: Ptr HklEngineList -> IO (Ptr ())
diff --git a/contrib/haskell/src/Hkl/C/Geometry.hsc b/contrib/haskell/src/Hkl/C/Geometry.hsc
new file mode 100644
index 0000000..406c65d
--- /dev/null
+++ b/contrib/haskell/src/Hkl/C/Geometry.hsc
@@ -0,0 +1,188 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GADTs #-}
+
+module Hkl.C.Geometry
+ ( Geometry(..)
+ , Factory(..)
+ , HklFactory
+ , HklMatrix
+ , HklQuaternion
+ , factoryFromString
+ , newFactory
+ , newGeometry
+ , withGeometry
+ ) where
+
+import Prelude hiding (min, max)
+
+import Numeric.LinearAlgebra
+import Foreign ( ForeignPtr
+ , FunPtr
+ , Ptr
+ , nullPtr
+ , newForeignPtr
+ , withForeignPtr)
+import Foreign.C (CInt(..), CDouble(..), CSize(..), CString,
+ peekCString, withCString)
+import Foreign.Storable
+
+import Numeric.Units.Dimensional.Prelude ( meter, nano
+ , (*~), (/~))
+
+import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable.Mutable as MV
+
+import Hkl.Types
+import Hkl.C.DArray
+
+#include "hkl.h"
+
+-- | Factory
+
+data Factory = K6c | Uhv | MedH | MedV | SoleilSiriusKappa
+
+instance Show Factory where
+ show K6c = "K6C"
+ show Uhv = "ZAXIS"
+ show MedH = "todo"
+ show MedV = "todo"
+ show SoleilSiriusKappa = "SOLEIL SIRIUS KAPPA"
+
+factoryFromString :: String -> Factory
+factoryFromString s
+ | s == "K6C" = K6c
+ | s == "ZAXIS" = Uhv
+ | s == "todo" = MedH
+ | s == "todo" = MedV
+ | s == "SOLEIL SIRIUS KAPPA" = SoleilSiriusKappa
+ | otherwise = error $ "unknown diffractometer type:" ++ s
+
+-- | Geometry
+
+data Geometry = Geometry
+ Factory -- ^ the type of diffractometer
+ Source -- ^ source
+ (Vector Double) -- ^ axes position
+ (Maybe [Parameter]) -- ^ axes configuration
+ deriving (Show)
+
+
+-- private types
+
+data HklFactory
+data HklMatrix
+data HklQuaternion
+
+#if __GLASGOW_HASKELL__ <= 710
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#endif
+
+-- Factory
+
+newFactory :: Factory -> IO (Ptr HklFactory)
+newFactory f = withCString (show f) $ \cname -> c_hkl_factory_get_by_name cname nullPtr
+
+foreign import ccall unsafe "hkl.h hkl_factory_get_by_name"
+ c_hkl_factory_get_by_name :: CString -- ^ name
+ -> Ptr () -- ^ GError (null for now)
+ -> IO (Ptr HklFactory)
+-- Geometry
+
+peekSource :: Ptr Geometry -> IO (Source)
+peekSource ptr = do
+ (CDouble w) <- c_hkl_geometry_wavelength_get ptr unit
+ return (Source (w *~ nano meter))
+
+foreign import ccall unsafe "hkl.h hkl_geometry_wavelength_set"
+ c_hkl_geometry_wavelength_set :: Ptr Geometry -- geometry
+ -> CDouble -- wavelength
+ -> CInt -- unit
+ -> Ptr () -- *gerror
+ -> IO () -- IO CInt but for now do not deal with the errors
+
+pokeSource :: Ptr Geometry -> Source -> IO ()
+pokeSource ptr (Source lw) = do
+ let wavelength = CDouble (lw /~ nano meter)
+ c_hkl_geometry_wavelength_set ptr wavelength unit nullPtr
+
+foreign import ccall unsafe "hkl.h hkl_geometry_wavelength_get"
+ c_hkl_geometry_wavelength_get :: Ptr Geometry -- geometry
+ -> CInt -- unit
+ -> IO CDouble -- wavelength
+
+peekAxis :: Ptr Geometry -> CString -> IO Parameter
+peekAxis ptr s = c_hkl_geometry_axis_get ptr s nullPtr >>= peek
+
+instance Storable Geometry where
+ alignment _ = #{alignment int}
+
+ sizeOf _ = #{size int}
+
+ peek ptr = do
+ f_name <- c_hkl_geometry_name_get ptr >>= peekCString
+ let factory = factoryFromString f_name
+
+ source <- peekSource ptr
+
+ (DArray n axis_names) <- peek =<< c_hkl_geometry_axis_names_get ptr
+ v <- MV.new (fromEnum n)
+ MV.unsafeWith v $ \values ->
+ c_hkl_geometry_axis_values_get ptr values n unit
+ vs <- V.freeze v
+
+ ps <- mapM (peekAxis ptr) axis_names
+
+ return $ Geometry factory source vs (Just ps)
+
+ poke ptr (Geometry _ s vs _) = do
+ pokeSource ptr s
+ (DArray n _) <- peek =<< c_hkl_geometry_axis_names_get ptr
+ V.unsafeWith vs $ \values ->
+ c_hkl_geometry_axis_values_set ptr values n unit nullPtr
+
+foreign import ccall unsafe "hkl.h hkl_geometry_axis_values_get"
+ c_hkl_geometry_axis_values_get :: Ptr Geometry -- geometry
+ -> Ptr Double -- axis values
+ -> CSize -- size of axis values
+ -> CInt -- unit
+ -> IO () -- IO CInt but for now do not deal with the errors
+
+foreign import ccall unsafe "hkl.h hkl_geometry_axis_names_get"
+ c_hkl_geometry_axis_names_get :: Ptr Geometry -- goemetry
+ -> IO (Ptr (DArray CString)) -- darray_string
+
+foreign import ccall unsafe "hkl.h hkl_geometry_axis_get"
+ c_hkl_geometry_axis_get :: Ptr Geometry -- geometry
+ -> CString -- axis name
+ -> Ptr () -- gerror
+ -> IO (Ptr Parameter) -- parameter or nullPtr
+
+foreign import ccall unsafe "hkl.h hkl_geometry_name_get"
+ c_hkl_geometry_name_get :: Ptr Geometry -> IO CString
+
+foreign import ccall unsafe "hkl.h hkl_geometry_axis_values_set"
+ c_hkl_geometry_axis_values_set :: Ptr Geometry -- geometry
+ -> Ptr Double -- axis values
+ -> CSize -- size of axis values
+ -> CInt -- unit
+ -> Ptr () -- gerror
+ -> IO () -- IO CInt but for now do not deal with the errors
+
+withGeometry :: Geometry -> (Ptr Geometry -> IO b) -> IO b
+withGeometry g fun = do
+ fptr <- newGeometry g
+ withForeignPtr fptr fun
+
+newGeometry :: Geometry -> IO (ForeignPtr Geometry)
+newGeometry g@(Geometry f _ _ _) = do
+ ptr <- c_hkl_factory_create_new_geometry =<< newFactory f
+ poke ptr g
+ newForeignPtr c_hkl_geometry_free ptr
+
+foreign import ccall unsafe "hkl.h hkl_factory_create_new_geometry"
+ c_hkl_factory_create_new_geometry :: Ptr HklFactory -> IO (Ptr Geometry)
+
+foreign import ccall unsafe "hkl.h &hkl_geometry_free"
+ c_hkl_geometry_free :: FunPtr (Ptr Geometry -> IO ())
diff --git a/contrib/haskell/src/Hkl/C/GeometryList.hsc b/contrib/haskell/src/Hkl/C/GeometryList.hsc
new file mode 100644
index 0000000..a51067c
--- /dev/null
+++ b/contrib/haskell/src/Hkl/C/GeometryList.hsc
@@ -0,0 +1,120 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE CPP #-}
+
+module Hkl.C.GeometryList
+ ( HklGeometryList
+ , geometryDetectorRotationGet
+ , getSolution0
+ , peekHklGeometryList
+ ) where
+
+import Prelude hiding (min, max)
+
+import Control.Monad.Loops (unfoldrM)
+import Numeric.LinearAlgebra
+import Foreign ( ForeignPtr
+ , FunPtr
+ , Ptr
+ , nullPtr
+ , newForeignPtr
+ , withForeignPtr)
+import Foreign.C (CInt(..), CDouble(..))
+import Foreign.Storable
+
+import Hkl.C.Detector
+import Hkl.C.Geometry
+import Hkl.Detector
+
+#include "hkl.h"
+
+-- private types
+
+data HklGeometryList
+data HklGeometryListItem
+
+-- | HklGeometryList
+
+getSolution0 :: ForeignPtr HklGeometryList -> IO Geometry
+getSolution0 gl = withForeignPtr gl $ \solutions ->
+ c_hkl_geometry_list_items_first_get solutions
+ >>= c_hkl_geometry_list_item_geometry_get
+ >>= peek
+
+buildMatrix' :: Element a => CInt -> CInt -> ((CInt, CInt) -> IO a) -> IO (Matrix a)
+buildMatrix' rc cc f = do
+ let coordinates' = map (\ ri -> map (\ ci -> (ri, ci)) [0 .. (cc - 1)]) [0 .. (rc - 1)]
+ l <- mapM (mapM f) coordinates'
+ return $ fromLists l
+
+
+ -- fromLists $ map (map f)
+ -- $ map (\ ri -> map (\ ci -> (ri, ci)) [0 .. (cc - 1)]) [0 .. (rc - 1)]
+
+geometryDetectorRotationGet :: Geometry -> Detector a -> IO (Matrix Double)
+geometryDetectorRotationGet g d = do
+ f_geometry <- newGeometry g
+ f_detector <- newDetector d
+ withForeignPtr f_detector $ \detector ->
+ withForeignPtr f_geometry $ \geometry -> do
+ f_q <- newForeignPtr c_hkl_quaternion_free =<< c_hkl_geometry_detector_rotation_get_binding geometry detector
+ withForeignPtr f_q $ \quaternion -> do
+ f_m <- newForeignPtr c_hkl_matrix_free =<< c_hkl_quaternion_to_matrix_binding quaternion
+ withForeignPtr f_m $ \matrix' ->
+ buildMatrix' 3 3 (getV matrix')
+ where
+ getV :: Ptr HklMatrix -> (CInt, CInt) -> IO Double
+ getV m (i', j') = do
+ (CDouble v) <- c_hkl_matrix_get m i' j'
+ return v
+
+foreign import ccall unsafe "hkl.h hkl_geometry_detector_rotation_get_binding"
+ c_hkl_geometry_detector_rotation_get_binding :: Ptr Geometry
+ -> Ptr HklDetector
+ -> IO (Ptr HklQuaternion)
+
+foreign import ccall unsafe "hkl.h hkl_quaternion_to_matrix_binding"
+ c_hkl_quaternion_to_matrix_binding :: Ptr HklQuaternion
+ -> IO (Ptr HklMatrix)
+
+foreign import ccall unsafe "hkl.h &hkl_quaternion_free"
+ c_hkl_quaternion_free :: FunPtr (Ptr HklQuaternion -> IO ())
+
+foreign import ccall unsafe "hkl.h &hkl_matrix_free"
+ c_hkl_matrix_free :: FunPtr (Ptr HklMatrix -> IO ())
+
+foreign import ccall unsafe "hkl.h hkl_matrix_get"
+ c_hkl_matrix_get :: Ptr HklMatrix
+ -> CInt
+ -> CInt
+ -> IO CDouble
+
+
+peekItems :: Ptr HklGeometryList -> IO [Ptr HklGeometryListItem]
+peekItems l = c_hkl_geometry_list_items_first_get l >>= unfoldrM go
+ where
+ go e
+ | e == nullPtr = return Nothing
+ | otherwise = do
+ next <- c_hkl_geometry_list_items_next_get l e
+ return (Just (e, next))
+
+peekHklGeometryList :: ForeignPtr HklGeometryList -> IO [Geometry]
+peekHklGeometryList l = withForeignPtr l $ \ls -> do
+ items <- peekItems ls
+ mapM extract items
+ where
+ extract it = c_hkl_geometry_list_item_geometry_get it >>= peek
+
+foreign import ccall unsafe "hkl.h hkl_geometry_list_items_first_get"
+ c_hkl_geometry_list_items_first_get :: Ptr HklGeometryList
+ -> IO (Ptr HklGeometryListItem)
+
+foreign import ccall unsafe "hkl.h hkl_geometry_list_items_next_get"
+ c_hkl_geometry_list_items_next_get :: Ptr HklGeometryList
+ -> Ptr HklGeometryListItem
+ -> IO (Ptr HklGeometryListItem)
+
+foreign import ccall unsafe "hkl.h hkl_geometry_list_item_geometry_get"
+ c_hkl_geometry_list_item_geometry_get :: Ptr HklGeometryListItem
+ -> IO (Ptr Geometry)
diff --git a/contrib/haskell/src/Hkl/C/Lattice.hsc b/contrib/haskell/src/Hkl/C/Lattice.hsc
new file mode 100644
index 0000000..5cb1d30
--- /dev/null
+++ b/contrib/haskell/src/Hkl/C/Lattice.hsc
@@ -0,0 +1,106 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GADTs #-}
+
+module Hkl.C.Lattice
+ ( HklLattice
+ , newLattice
+ , withLattice
+ ) where
+
+import Prelude hiding (min, max)
+
+import Foreign ( ForeignPtr
+ , FunPtr
+ , Ptr
+ , nullPtr
+ , newForeignPtr
+ , withForeignPtr)
+import Foreign.C (CDouble(..))
+
+import Numeric.Units.Dimensional.Prelude ( meter, degree, radian, nano
+ , (*~), (/~))
+import Hkl.Lattice
+
+#include "hkl.h"
+
+#if __GLASGOW_HASKELL__ <= 710
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#endif
+
+-- private types
+
+data HklLattice
+
+-- Lattice
+
+withLattice :: Lattice a -> (Ptr HklLattice -> IO r) -> IO r
+withLattice l func = do
+ fptr <- newLattice l
+ withForeignPtr fptr func
+
+newLattice' :: CDouble
+ -> CDouble
+ -> CDouble
+ -> CDouble
+ -> CDouble
+ -> CDouble
+ -> IO (ForeignPtr HklLattice)
+newLattice' a b c alpha beta gamma = do
+ lattice <- c_hkl_lattice_new a b c alpha beta gamma nullPtr
+ newForeignPtr c_hkl_lattice_free lattice
+
+newLattice :: Lattice a -> IO (ForeignPtr HklLattice)
+newLattice (Cubic la) = do
+ let a = CDouble (la /~ nano meter)
+ let alpha = CDouble ((90 *~ degree) /~ radian)
+ newLattice' a a a alpha alpha alpha
+newLattice (Tetragonal la lc) = do
+ let a = CDouble (la /~ nano meter)
+ let c = CDouble (lc /~ nano meter)
+ let alpha = CDouble ((90 *~ degree) /~ radian)
+ newLattice' a a c alpha alpha alpha
+newLattice (Orthorhombic la lb lc) = do
+ let a = CDouble (la /~ nano meter)
+ let b = CDouble (lb /~ nano meter)
+ let c = CDouble (lc /~ nano meter)
+ let alpha = CDouble ((90 *~ degree) /~ radian)
+ newLattice' a b c alpha alpha alpha
+newLattice (Rhombohedral la aalpha) = do
+ let a = CDouble (la /~ nano meter)
+ let alpha = CDouble (aalpha /~ radian)
+ newLattice' a a a alpha alpha alpha
+newLattice (Hexagonal la lc) = do
+ let a = CDouble (la /~ nano meter)
+ let c = CDouble (lc /~ nano meter)
+ let alpha = CDouble ((90 *~ degree) /~ radian)
+ let gamma = CDouble ((120 *~ degree) /~ radian)
+ newLattice' a a c alpha alpha gamma
+newLattice (Monoclinic la lb lc abeta) = do
+ let a = CDouble (la /~ nano meter)
+ let b = CDouble (lb /~ nano meter)
+ let c = CDouble (lc /~ nano meter)
+ let alpha = CDouble ((90 *~ degree) /~ radian)
+ let beta = CDouble (abeta /~ radian)
+ newLattice' a b c alpha beta alpha
+newLattice (Triclinic la lb lc aalpha abeta agamma) = do
+ let a = CDouble (la /~ nano meter)
+ let b = CDouble (lb /~ nano meter)
+ let c = CDouble (lc /~ nano meter)
+ let alpha = CDouble (aalpha /~ radian)
+ let beta = CDouble (abeta /~ radian)
+ let gamma = CDouble (agamma /~ radian)
+ newLattice' a b c alpha beta gamma
+
+foreign import ccall unsafe "hkl.h hkl_lattice_new"
+ c_hkl_lattice_new :: CDouble -- a
+ -> CDouble -- b
+ -> CDouble -- c
+ -> CDouble -- alpha
+ -> CDouble -- beta
+ -> CDouble -- gamma
+ -> Ptr () -- *gerror
+ -> IO (Ptr HklLattice)
+
+foreign import ccall unsafe "hkl.h &hkl_lattice_free"
+ c_hkl_lattice_free :: FunPtr (Ptr HklLattice -> IO ())
diff --git a/contrib/haskell/src/Hkl/C/Sample.hsc b/contrib/haskell/src/Hkl/C/Sample.hsc
new file mode 100644
index 0000000..d9c106c
--- /dev/null
+++ b/contrib/haskell/src/Hkl/C/Sample.hsc
@@ -0,0 +1,91 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE CPP #-}
+
+module Hkl.C.Sample
+ ( HklSample
+ , newSample
+ , withSample
+ ) where
+
+import Control.Monad (void)
+import Foreign ( ForeignPtr
+ , FunPtr
+ , Ptr
+ , nullPtr
+ , newForeignPtr
+ , withForeignPtr)
+import Foreign.C (CInt(..), CString, withCString)
+import Foreign.Storable
+
+import Hkl.C.Lattice
+import Hkl.Types
+
+#include "hkl.h"
+
+-- private types
+
+data HklSample
+
+-- Sample
+
+withSample :: Sample a -> (Ptr HklSample -> IO r) -> IO r
+withSample s fun = do
+ fptr <- newSample s
+ withForeignPtr fptr fun
+
+newSample :: Sample a -> IO (ForeignPtr HklSample)
+newSample (Sample name l ux uy uz) =
+ withCString name $ \cname -> do
+ sample <- c_hkl_sample_new cname
+ withLattice l $ \lattice -> do
+ c_hkl_sample_lattice_set sample lattice
+ go sample ux c_hkl_sample_ux_get c_hkl_sample_ux_set
+ go sample uy c_hkl_sample_uy_get c_hkl_sample_uy_set
+ go sample uz c_hkl_sample_uz_get c_hkl_sample_uz_set
+ newForeignPtr c_hkl_sample_free sample
+ where
+ go s p getter setter = do
+ fptr <- copyParameter =<< (getter s)
+ withForeignPtr fptr $ \ptr -> do
+ poke ptr p
+ void $ setter s ptr nullPtr
+
+foreign import ccall unsafe "hkl.h hkl_sample_new"
+ c_hkl_sample_new:: CString -> IO (Ptr HklSample)
+
+foreign import ccall unsafe "hkl.h hkl_sample_lattice_set"
+ c_hkl_sample_lattice_set :: Ptr HklSample -> Ptr HklLattice -> IO ()
+
+foreign import ccall unsafe "hkl.h &hkl_sample_free"
+ c_hkl_sample_free :: FunPtr (Ptr HklSample -> IO ())
+
+foreign import ccall unsafe "hkl.h hkl_sample_ux_get"
+ c_hkl_sample_ux_get :: Ptr HklSample
+ -> IO (Ptr Parameter)
+
+foreign import ccall unsafe "hkl.h hkl_sample_uy_get"
+ c_hkl_sample_uy_get :: Ptr HklSample
+ -> IO (Ptr Parameter)
+
+foreign import ccall unsafe "hkl.h hkl_sample_uz_get"
+ c_hkl_sample_uz_get :: Ptr HklSample
+ -> IO (Ptr Parameter)
+
+foreign import ccall unsafe "hkl.h hkl_sample_ux_set"
+ c_hkl_sample_ux_set :: Ptr HklSample
+ -> Ptr Parameter
+ -> Ptr ()
+ -> IO CInt
+
+foreign import ccall unsafe "hkl.h hkl_sample_uy_set"
+ c_hkl_sample_uy_set :: Ptr HklSample
+ -> Ptr Parameter
+ -> Ptr ()
+ -> IO CInt
+
+foreign import ccall unsafe "hkl.h hkl_sample_uz_set"
+ c_hkl_sample_uz_set :: Ptr HklSample
+ -> Ptr Parameter
+ -> Ptr ()
+ -> IO CInt
diff --git a/contrib/haskell/src/Hkl/DataSource.hs b/contrib/haskell/src/Hkl/DataSource.hs
new file mode 100644
index 0000000..87a4b16
--- /dev/null
+++ b/contrib/haskell/src/Hkl/DataSource.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Hkl.DataSource ( ExtendDims(..)
+ , DataItem(..)
+ , DataSource(..)
+ , atIndex'
+ , openDataSource
+ , closeDataSource
+ ) where
+
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>), (<*>))
+#endif
+
+import Control.Monad.Trans.Maybe (MaybeT)
+import Data.Array.Repa (Shape)
+import Data.ByteString.Char8 (pack)
+import Data.Vector.Storable (Vector, any, singleton)
+import Pipes (lift)
+import Prelude hiding ( any )
+
+import Hkl.H5
+
+data ExtendDims = ExtendDims | StrictDims deriving (Show)
+
+data DataItem a where
+ DataItemH5 :: H5Path -> ExtendDims -> DataItem H5
+ DataItemConst :: Double -> DataItem Double
+deriving instance Show (DataItem a)
+
+data DataSource a where
+ DataSourceH5 :: DataItem H5 -> Dataset -> DataSource H5
+ DataSourceConst :: Double -> DataSource Double
+
+openDataSource :: File -> DataItem a -> IO (DataSource a)
+openDataSource hid di@(DataItemH5 name _) = DataSourceH5
+ <$> return di
+ <*> openDataset hid (pack name) Nothing
+openDataSource _ (DataItemConst v) = return $ DataSourceConst v
+
+closeDataSource :: DataSource a -> IO ()
+closeDataSource (DataSourceH5 _ d) = closeDataset d
+closeDataSource (DataSourceConst _) = return ()
+
+atIndex' :: Shape sh => DataSource a -> sh -> MaybeT IO (Vector Double)
+atIndex' (DataSourceH5 _ a ) b = lift $ do
+ v <- get_position_new a b
+ if any isNaN v then fail "File contains Nan" else return v
+atIndex' (DataSourceConst v) _ = lift $ return $ singleton v
diff --git a/contrib/haskell/src/Hkl/Detector.hs b/contrib/haskell/src/Hkl/Detector.hs
new file mode 100644
index 0000000..f5ffaf4
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Detector.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Hkl.Detector
+ ( Detector(..)
+ , ImXpadS140
+ , Xpad32
+ , ZeroD
+ , coordinates
+ ) where
+
+import Data.Vector.Storable ( Vector
+ , fromList
+ )
+
+import Hkl.PyFAI.Npt ( NptPoint ( NptPoint ) )
+
+
+data ImXpadS140
+data Xpad32
+data ZeroD
+
+data Detector a where
+ ImXpadS140 :: Detector ImXpadS140
+ Xpad32 :: Detector Xpad32
+ ZeroD :: Detector ZeroD
+
+deriving instance Show (Detector a)
+
+-- | Xpad Family
+
+type Gap = Double
+type Width = Int
+type Index = Int
+
+-- an xpad line is like this (pixel size, index)
+-- | s 0 | s 1 | s 2 | ... | 5/2 s (w - 1) || 5/2 s w | s (w + 1) | ...
+xpadLine :: Width -> Index -> Double
+xpadLine w i'
+ | i' == 0 = s / 2
+ | i' == 1 = s * 3 / 2
+ | idx == 0 = s * (fromIntegral i' + 3 * fromIntegral c - 1 / 4)
+ | idx <= (w - 2) = s * (fromIntegral i' + 3 * fromIntegral c + 1 / 2)
+ | idx == (w - 1) = s * (fromIntegral i' + 3 * fromIntegral c + 5 / 4)
+ | otherwise = error $ "wront coordinates" ++ show i'
+ where
+ s = 130e-6
+ (c, idx) = divMod i' w
+
+xpadLineWithGap :: Width -> Gap -> Index -> Double
+xpadLineWithGap w g i' = s / 2 + (s * fromIntegral i') + g * fromIntegral (div i' w)
+ where
+ s = 130e-6
+
+interp :: (Int -> Double) -> Double -> Double
+interp f p
+ | p0 == p1 = f p0
+ | otherwise = (p - fromIntegral p0) * (f p1 - f p0) + f p0
+ where
+ p0 :: Int
+ p0 = floor p
+
+ p1 :: Int
+ p1 = ceiling p
+
+-- compute the coordinated at a given point
+
+coordinates :: Detector a -> NptPoint -> Vector Double
+coordinates ZeroD (NptPoint 0 0) = fromList [0, 0, 0]
+coordinates ZeroD _ = error "No coordinates in a ZeroD detecteor"
+
+coordinates ImXpadS140 (NptPoint x y) =
+ fromList [ interp (xpadLine 120) y
+ , interp (xpadLine 80) x
+ , 0
+ ]
+
+coordinates Xpad32 (NptPoint x y) =
+ fromList [ interp (xpadLineWithGap 120 3.57e-3) y
+ , interp (xpadLine 80) x
+ , 0]
diff --git a/contrib/haskell/src/Hkl/Edf.hs b/contrib/haskell/src/Hkl/Edf.hs
new file mode 100644
index 0000000..4c33739
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Edf.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Edf
+ ( Edf(..)
+ , ExtractEdf(..)
+ , edfP
+ , edfFromFile
+ ) where
+
+import Data.Attoparsec.Text ( Parser
+ , (<?>)
+ , anyChar
+ , double
+ , many1
+ , manyTill
+ , parseOnly
+ , skipSpace
+ , string
+ , takeTill
+ , try
+ )
+import Data.ByteString.Char8 (readFile, split)
+import Data.Text (Text, words)
+import Data.Text.Encoding (decodeUtf8)
+import Numeric.Units.Dimensional.Prelude (Length, (*~), nano, meter)
+
+data Edf = Edf { edf'Lambda :: Length Double
+ , edf'Motors :: [(Text, Double)]
+ }
+ deriving (Show)
+
+class ExtractEdf a where
+ extractEdf ∷ a → IO ()
+
+
+edf'LambdaP :: Parser (Length Double)
+edf'LambdaP = do
+ _ <- manyTill anyChar (try $ string "Lambda = ")
+ value <- double
+ pure $ value *~ nano meter
+
+edf'MotorsP :: Parser [(Text, Double)]
+edf'MotorsP = do
+ _ <- manyTill anyChar (try $ string "motor_pos = ")
+ vs <- many1 (skipSpace *> double)
+ _ <- manyTill anyChar (try $ string "motor_mne = ")
+ ns <- takeTill (\c -> c == ';')
+ return $ zip (Data.Text.words ns) vs
+
+edfP :: Parser Edf
+edfP = Edf
+ <$> edf'LambdaP
+ <*> edf'MotorsP
+ <?> "edfP"
+
+edfFromFile :: FilePath -> IO Edf
+edfFromFile filename = do
+ content <- Data.ByteString.Char8.readFile filename
+ let header = head (split '}' content)
+ return $ case parseOnly edfP (decodeUtf8 header) of
+ Left _ -> error $ "Can not parse the " ++ filename ++ " edf file"
+ Right a -> a
+
+-- main :: IO ()
+-- main = do
+-- edf <- edfFromFile "/home/picca/test.edf"
+-- print edf
+-- return ()
diff --git a/contrib/haskell/src/Hkl/Engine.hs b/contrib/haskell/src/Hkl/Engine.hs
new file mode 100644
index 0000000..56cb3c9
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Engine.hs
@@ -0,0 +1,27 @@
+module Hkl.Engine
+ ( enginesTrajectoryPipe
+ , fromToPipe
+ ) where
+
+import Control.Monad ( forever, forM_ )
+import Numeric.LinearAlgebra ( Vector, toList )
+import Pipes ( Pipe, Producer, await, yield )
+
+import Hkl.Types ( Engine ( Engine )
+ , Parameter ( Parameter )
+ )
+
+engineSetValues :: Engine -> Vector Double -> Engine
+engineSetValues (Engine name ps mode) vs = Engine name nps mode
+ where
+ nps = zipWith set ps (toList vs)
+ set (Parameter n _ range) newValue = Parameter n newValue range
+
+fromToPipe :: Int -> Vector Double -> Vector Double -> Producer (Vector Double) IO ()
+fromToPipe n from to = forM_ [0..n-1] $ \i -> yield $ vs i
+ where
+ vs i = from + step * fromIntegral i
+ step = (to - from) / (fromIntegral n - 1)
+
+enginesTrajectoryPipe :: Engine -> Pipe (Vector Double) Engine IO ()
+enginesTrajectoryPipe e = forever $ await >>= yield . engineSetValues e
diff --git a/contrib/haskell/src/Hkl/Flat.hs b/contrib/haskell/src/Hkl/Flat.hs
new file mode 100644
index 0000000..62746e4
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Flat.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Flat
+ ( Flat(..)
+ , Npy
+ , computeFlat
+ )
+ where
+
+import Data.Text ( unlines, pack )
+import System.Exit ( ExitCode( ExitSuccess ) )
+import System.FilePath.Posix ( replaceExtension )
+
+import Hkl.DataSource ( DataItem ( DataItemH5 ) )
+import Hkl.Nxs ( Nxs ( Nxs )
+ , XrdFlat
+ , DataFrameH5Path ( XrdFlatH5Path )
+ )
+import Hkl.Python ( PyVal
+ , toPyVal
+ )
+import Hkl.Script ( Py2
+ , Script ( Py2Script )
+ , run
+ )
+
+data Npy
+
+data Flat a where
+ FlatNpy ∷ FilePath → Flat Npy
+deriving instance (Show) (Flat a)
+
+scriptPy2Flat ∷ [Nxs XrdFlat] → FilePath → Script Py2
+scriptPy2Flat ns output = Py2Script (script, scriptName)
+ where
+ script = Data.Text.unlines $
+ map pack ["#!/bin/env python"
+ , ""
+ , "import numpy"
+ , "from h5py import File"
+ , ""
+ , "NEXUSFILES = " ++ toPyVal nxs'
+ , "IMAGEPATHS = " ++ toPyVal hpaths
+ , "OUTPUT = " ++ toPyVal output
+ , ""
+ , "flat = None"
+ , "n = None"
+ , "with File(NEXUSFILES[0], mode='r') as f:"
+ , " imgs = f[IMAGEPATHS[0]]"
+ , " flat = numpy.sum(imgs[:], axis=0)"
+ , " n = imgs.shape[0]"
+ , "for idx, (nxs, h5path) in enumerate(zip(NEXUSFILES[1:], IMAGEPATHS[1:])):"
+ , " with File(nxs, mode='r') as f:"
+ , " imgs = f[h5path]"
+ , " flat += numpy.sum(imgs[:], axis=0)"
+ , " n += imgs.shape[0]"
+ , "numpy.save(OUTPUT, flat.astype('f') / n)"
+ ]
+ nxs' ∷ [String]
+ nxs' = [f | (Nxs f _) ← ns]
+
+ hpaths ∷ [String]
+ hpaths = [h | (Nxs _ (XrdFlatH5Path (DataItemH5 h _))) ← ns]
+
+ scriptName ∷ FilePath
+ scriptName = output `replaceExtension` "py"
+
+computeFlat ∷ [Nxs XrdFlat] → FilePath → IO (Flat Npy)
+computeFlat ns o = do
+ -- create the python script.
+ let script = scriptPy2Flat ns o
+ -- execute this script.
+ ExitSuccess ← run script False
+ -- return the filepath of the generated file.
+ return (FlatNpy o)
+
+instance PyVal (Flat a) where
+ toPyVal (FlatNpy v) = "numpy.load(" ++ show v ++ ")"
diff --git a/contrib/haskell/src/Hkl/H5.hs b/contrib/haskell/src/Hkl/H5.hs
new file mode 100644
index 0000000..5858bfa
--- /dev/null
+++ b/contrib/haskell/src/Hkl/H5.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Hkl.H5
+ ( Dataset
+ , File
+ , H5
+ , H5Path
+ , check_ndims
+ , closeDataset
+ , closeFile
+ , get_position
+ , get_position_new
+ , get_ub
+ , lenH5Dataspace
+ , nxEntries
+ , openDataset
+ , openH5
+ , withH5File
+ )
+ where
+
+import Bindings.HDF5.Core ( HSize(HSize)
+ , IndexType(ByName)
+ , IterOrder(Native)
+ , hid
+ , hSize
+ , indexTypeCode
+ , iterOrderCode
+ )
+import Bindings.HDF5.File ( File
+ , AccFlags(ReadOnly)
+ , openFile
+ , closeFile
+ )
+import Bindings.HDF5.Dataset ( Dataset
+ , openDataset
+ , closeDataset
+ , getDatasetSpace
+ , readDataset
+ , readDatasetInto
+ )
+import Bindings.HDF5.Dataspace ( Dataspace
+ , SelectionOperator(Set)
+ , closeDataspace
+ , createSimpleDataspace
+ , getSimpleDataspaceExtentNDims
+ , getSimpleDataspaceExtentNPoints
+ , selectHyperslab
+ )
+import Bindings.HDF5.Raw ( HErr_t(HErr_t)
+ , HId_t(HId_t)
+ , H5L_info_t
+ , h5l_iterate
+ )
+import Control.Exception (bracket)
+import Data.Array.Repa (Shape, listOfShape)
+import Data.ByteString.Char8 ( pack )
+import Data.IORef ( newIORef, readIORef, writeIORef )
+import Data.Vector.Storable (Vector, freeze)
+import Data.Vector.Storable.Mutable (replicate)
+import Foreign.StablePtr ( castPtrToStablePtr
+ , castStablePtrToPtr
+ , deRefStablePtr
+ , freeStablePtr
+ , newStablePtr
+ )
+import Foreign.Ptr ( FunPtr, freeHaskellFunPtr )
+import Foreign.Ptr.Conventions ( In(In)
+ , InOut(InOut)
+ , castWrappedPtr
+ , withInOut_
+ )
+import Foreign.C.String ( CString, peekCString )
+import Foreign.C.Types (CInt(CInt))
+import Numeric.LinearAlgebra (Matrix, reshape)
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
+data H5
+
+type H5Path = String
+
+
+check_ndims :: Dataset -> Int -> IO Bool
+check_ndims d expected = do
+ space_id <- getDatasetSpace d
+ (CInt ndims) <- getSimpleDataspaceExtentNDims space_id
+ return $ expected == fromEnum ndims
+
+toHyperslab :: Shape sh => sh -> [(HSize, Maybe HSize, HSize, Maybe HSize)]
+toHyperslab s = [(HSize (fromIntegral n), Just (HSize 1), HSize 1, Just (HSize 1)) | n <- listOfShape s]
+
+get_position_new :: Shape sh => Dataset -> sh -> IO (Vector Double)
+get_position_new dataset s =
+ withDataspace dataset $ \dataspace -> do
+ selectHyperslab dataspace Set (toHyperslab s)
+ withDataspace' $ \memspace -> do
+ data_out <- Data.Vector.Storable.Mutable.replicate 1 (0.0 :: Double)
+ readDatasetInto dataset (Just memspace) (Just dataspace) Nothing data_out
+ freeze data_out
+
+get_position :: Dataset -> Int -> IO (Vector Double)
+get_position dataset n =
+ withDataspace dataset $ \dataspace -> do
+ let start = HSize (fromIntegral n)
+ let stride = Just (HSize 1)
+ let count = HSize 1
+ let block = Just (HSize 1)
+ selectHyperslab dataspace Set [(start, stride, count, block)]
+ withDataspace' $ \memspace -> do
+ data_out <- Data.Vector.Storable.Mutable.replicate 1 (0.0 :: Double)
+ readDatasetInto dataset (Just memspace) (Just dataspace) Nothing data_out
+ freeze data_out
+
+get_ub :: Dataset -> IO (Matrix Double)
+get_ub dataset = do
+ v <- readDataset dataset Nothing Nothing
+ return $ reshape 3 v
+
+-- | File
+
+withH5File :: FilePath -> (File -> IO r) -> IO r
+withH5File fp = bracket acquire release
+ where
+ acquire = openFile (pack fp) [ReadOnly] Nothing
+ release = closeFile
+
+openH5 ∷ FilePath → IO File
+openH5 f = openFile (pack f) [ReadOnly] Nothing
+
+-- | Dataspace
+
+-- check how to merge both methods
+
+withDataspace' :: (Dataspace -> IO r) -> IO r
+withDataspace' = bracket acquire release
+ where
+ acquire = createSimpleDataspace [HSize 1]
+ release = closeDataspace
+
+withDataspace :: Dataset -> (Dataspace -> IO r) -> IO r
+withDataspace d = bracket acquire release
+ where
+ acquire = getDatasetSpace d
+ release = closeDataspace
+
+lenH5Dataspace :: Dataset -> IO (Maybe Int)
+lenH5Dataspace = withDataspace'' len
+ where
+ withDataspace'' f d = withDataspace d f
+ len space_id = do
+ (HSize n) <- getSimpleDataspaceExtentNPoints space_id
+ return $ if n < 0 then Nothing else Just (fromIntegral n)
+
+
+-- | WIP until I have decided what is the right way to go
+
+type H5Iterate a = HId_t -> CString -> In H5L_info_t -> InOut a -> IO HErr_t
+
+foreign import ccall "wrapper" mkOp :: H5Iterate a -> IO (FunPtr (H5Iterate a))
+
+nxEntries ∷ FilePath → IO [String]
+nxEntries f = withH5File f $ \h → do
+ state <- newIORef []
+ statePtr <- newStablePtr state
+ let opData = InOut $ castStablePtrToPtr statePtr
+ let startIndex = Nothing
+ let indexType = ByName
+ let order = Native
+ iop <- mkOp callback
+ _ <- withInOut_ (maybe 0 hSize startIndex) $ \ioStartIndex ->
+ h5l_iterate (hid h) (indexTypeCode indexType) (iterOrderCode order) ioStartIndex iop opData
+
+ freeHaskellFunPtr iop
+ freeStablePtr statePtr
+
+ -- retrieve the final state
+ readIORef state
+ where
+ callback ∷ H5Iterate a
+ callback _g n _i (InOut dataptr) =
+ do
+ let opData = castWrappedPtr dataptr
+ -- get the state
+ stRef <- deRefStablePtr (castPtrToStablePtr opData)
+ st <- readIORef stRef
+
+ -- compute the new state
+ name <- peekCString n
+ let newSt = st ++ [name]
+
+ -- store the new state
+ writeIORef stRef newSt
+ return $ HErr_t 0
diff --git a/contrib/haskell/src/Hkl/Lattice.hs b/contrib/haskell/src/Hkl/Lattice.hs
new file mode 100644
index 0000000..9578402
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Lattice.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Lattice ( Lattice(..)
+ , Cubic
+ , Tetragonal
+ , Orthorhombic
+ , Rhombohedral
+ , Hexagonal
+ , Monoclinic
+ , Triclinic
+ ) where
+
+import Numeric.Units.Dimensional.Prelude (Length, Angle)
+
+-- | Lattice
+
+data Cubic
+data Tetragonal
+data Orthorhombic
+data Rhombohedral
+data Hexagonal
+data Monoclinic
+data Triclinic
+
+data Lattice a where
+ -- ^ a = b = c, alpha = beta = gamma = 90
+ Cubic ∷ Length Double
+ → Lattice Cubic -- ^ a = b = c, alpha = beta = gamma = 90
+ -- a = b != c, alpha = beta = gamma = 90
+ Tetragonal ∷ (Length Double) -- ^ a, b
+ → (Length Double) -- ^ c
+ → Lattice Tetragonal
+ -- ^ a != b != c, alpha = beta = gamma = 90
+ Orthorhombic ∷ (Length Double) -- ^ a
+ → (Length Double) -- ^ b
+ → (Length Double) -- ^ c
+ → Lattice Orthorhombic
+ -- ^ a = b = c, alpha = beta = gamma != 90
+ Rhombohedral ∷ (Length Double) -- ^ a, b, c
+ → (Angle Double) -- ^ alpha, beta, gamma
+ → Lattice Rhombohedral
+ -- ^ a = b != c, alpha = beta = 90, gamma = 120
+ Hexagonal ∷ (Length Double) -- ^ a, b
+ → (Length Double) -- ^ c
+ → Lattice Hexagonal
+ -- a != b != c, alpha = gamma = 90, beta != 90
+ Monoclinic ∷ (Length Double) -- ^ a
+ → (Length Double) -- ^ b
+ → (Length Double) -- ^ c
+ → (Angle Double) -- ^ beta
+ → Lattice Monoclinic
+ -- a != b != c, alpha != beta != gamma != 90
+ Triclinic ∷ (Length Double)
+ → (Length Double) -- ^ b
+ → (Length Double) -- ^ c
+ → (Angle Double) -- ^ alpha
+ → (Angle Double) -- ^ beta
+ → (Angle Double) -- ^ gamma
+ → Lattice Triclinic
+
+deriving instance Show (Lattice a)
diff --git a/contrib/haskell/src/Hkl/MyMatrix.hs b/contrib/haskell/src/Hkl/MyMatrix.hs
new file mode 100644
index 0000000..57877d9
--- /dev/null
+++ b/contrib/haskell/src/Hkl/MyMatrix.hs
@@ -0,0 +1,50 @@
+module Hkl.MyMatrix
+ ( Basis(..)
+ , MyMatrix(..)
+ , changeBase
+ , toEulerians
+ ) where
+
+import Numeric.LinearAlgebra (Matrix, atIndex, fromLists, inv, (<>))
+import Numeric.Units.Dimensional.Prelude (Angle, (*~), radian)
+
+data Basis = PyFAIB -- the pyFAI (1, 2, 3) detector coordinates
+ | HklB -- the hkl coordinates
+ deriving (Show)
+
+data MyMatrix a = MyMatrix Basis (Matrix a) deriving (Show)
+
+changeBase :: MyMatrix Double -> Basis -> MyMatrix Double
+changeBase (MyMatrix PyFAIB m) HklB = MyMatrix HklB (passage m p2)
+changeBase (MyMatrix HklB m) PyFAIB = MyMatrix PyFAIB (passage m p1)
+changeBase m@(MyMatrix PyFAIB _) PyFAIB = m
+changeBase m@(MyMatrix HklB _) HklB = m
+
+passage :: Matrix Double -> Matrix Double -> Matrix Double
+passage r p = inv p <> r <> p
+
+p1 :: Matrix Double -- hkl -> pyFAI
+p1 = fromLists [ [0, 0, 1]
+ , [0, -1, 0]
+ , [1, 0, 0]]
+
+p2 :: Matrix Double -- pyFAI -> hkl:
+p2 = fromLists [ [ 0, 0, 1]
+ , [ 0, -1, 0]
+ , [ 1, 0, 0]]
+
+toEulerians :: Matrix Double -> (Angle Double, Angle Double, Angle Double)
+toEulerians m
+ | abs c > epsilon = ( atan2 ((m `atIndex` (2, 1)) / c) ((m `atIndex` (2, 2)) / c) *~ radian
+ , rot2 *~ radian
+ , atan2 ((m `atIndex` (1, 0)) / c) ((m `atIndex` (0, 0)) / c) *~ radian
+ )
+ | otherwise = ( 0 *~ radian
+ , rot2 *~ radian
+ , atan2 (-(m `atIndex` (0, 1))) (m `atIndex` (1, 1)) *~ radian
+ )
+ where
+ epsilon = 1e-10
+ rot2 = asin (-(m `atIndex` (2, 0)))
+ c = cos rot2
+
diff --git a/contrib/haskell/src/Hkl/Nxs.hs b/contrib/haskell/src/Hkl/Nxs.hs
new file mode 100644
index 0000000..a7934cc
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Nxs.hs
@@ -0,0 +1,237 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Nxs
+ ( DataFrameH5(..)
+ , DataFrameH5Path(..)
+ , NxEntry
+ , Nxs(..)
+ , PoniGenerator
+ , XrdFlat
+ , XrdOneD
+ , XrdMesh
+ , XrdZeroD
+ , mkNxs
+ , withDataFrameH5
+ , withDataSource
+ ) where
+
+import Bindings.HDF5.Dataset ( readDataset
+ , getDatasetSpace )
+import Bindings.HDF5.Dataspace ( getSimpleDataspaceExtent )
+import Codec.Picture ( DynamicImage( ImageY16 )
+ , Image ( Image )
+ )
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>), (<*>), pure)
+#endif
+import Control.Exception.Base (bracket)
+import Control.Monad.IO.Class (liftIO)
+import Pipes.Safe ( MonadSafe, bracket )
+
+import Hkl.DataSource ( DataItem
+ , DataSource ( DataSourceH5 )
+ , closeDataSource
+ , openDataSource
+ )
+import Hkl.H5 ( File, H5
+ , closeFile
+ , openH5
+ )
+import Hkl.PyFAI ( Pose, PoniExt )
+import Hkl.Tiff ( ToTiff
+ , toTiff
+ )
+
+type NxEntry = String
+
+-- to remove an put directly into OneD
+type PoniGenerator = Pose -> Int -> IO PoniExt
+
+data XrdFlat
+data XrdOneD
+data XrdMesh
+data XrdZeroD
+
+data DataFrameH5Path a where
+ XrdFlatH5Path ∷ (DataItem H5) -- ^ image
+ → DataFrameH5Path XrdFlat
+ XrdOneDH5Path ∷ (DataItem H5) -- ^ image
+ → (DataItem H5) -- ^ gamma
+ → (DataItem H5) -- ^ delta
+ → (DataItem H5) -- ^ wavelength
+ → DataFrameH5Path XrdOneD
+ XrdMeshH5Path ∷ (DataItem H5) -- ^ Image
+ → (DataItem H5) -- ^ meshx
+ → (DataItem H5) -- ^ meshy
+ → (DataItem H5) -- ^ gamma
+ → (DataItem H5) -- ^ delta
+ → (DataItem H5) -- ^ wavelength
+ → DataFrameH5Path XrdMesh
+ XrdMeshFlyH5Path ∷ (DataItem H5) -- ^ Image
+ → (DataItem H5) -- ^ meshx
+ → (DataItem H5) -- ^ meshy
+ → (DataItem Double) -- ^ gamma
+ → (DataItem Double) -- ^ delta
+ → (DataItem Double) -- ^ wavelength
+ → DataFrameH5Path XrdMesh
+ XrdZeroDH5Path ∷ (DataItem H5) -- ^ image
+ → (DataItem Double) -- ^ wavelength
+ → DataFrameH5Path XrdZeroD -- used to integrate one static image
+
+deriving instance Show (DataFrameH5Path a)
+
+data Nxs a where
+ Nxs ∷ FilePath → DataFrameH5Path a → Nxs a
+
+deriving instance Show (Nxs a)
+
+data DataFrameH5 a where
+ XrdFlatH5 ∷ (Nxs XrdFlat) -- Nexus Source file
+ → File -- h5file handler
+ → (DataSource H5) --images
+ → DataFrameH5 XrdFlat
+ DataFrameH5 ∷ (Nxs XrdOneD) -- Nexus file
+ → File -- h5file handler
+ → (DataSource H5) -- gamma
+ → (DataSource H5) -- delta
+ → (DataSource H5) -- wavelength
+ → PoniGenerator -- ponie generator
+ → DataFrameH5 XrdOneD
+ XrdMeshH5 ∷ (Nxs XrdMesh) -- NexusFile Source File
+ → File -- h5file handler
+ → (DataSource H5) -- image
+ → (DataSource H5) -- meshx
+ → (DataSource H5) -- meshy
+ → (DataSource H5) -- gamma
+ → (DataSource H5) -- delta
+ → (DataSource H5) -- wavelength
+ → DataFrameH5 XrdMesh
+ XrdMeshFlyH5 ∷ (Nxs XrdMesh) -- NexusFile Source File
+ → File -- h5file handler
+ → (DataSource H5) -- image
+ → (DataSource H5) -- meshx
+ → (DataSource H5) -- meshy
+ → (DataSource Double) -- gamma
+ → (DataSource Double) -- delta
+ → (DataSource Double) -- wavelength
+ → DataFrameH5 XrdMesh
+ XrdZeroDH5 ∷ (Nxs XrdZeroD) -- NexusFile Source File
+ → File -- h5file handler
+ → (DataSource H5) -- image
+ → (DataSource Double) -- wavelength
+ → DataFrameH5 XrdZeroD
+
+mkNxs ∷ FilePath → NxEntry → (NxEntry → DataFrameH5Path a) → Nxs a
+mkNxs f e h = Nxs f (h e)
+
+-- | Instanciate a DataFrameH5 from a DataFrameH5Path
+-- acquire and release the resources
+
+after ∷ DataFrameH5 a → IO ()
+after (XrdFlatH5 _ f i) = do
+ closeDataSource i
+ closeFile f
+after (DataFrameH5 _ f g d w _) = do
+ closeDataSource g
+ closeDataSource d
+ closeDataSource w
+ closeFile f
+after (XrdMeshH5 _ f i x y g d w) = do
+ closeDataSource i
+ closeDataSource x
+ closeDataSource y
+ closeDataSource g
+ closeDataSource d
+ closeDataSource w
+ closeFile f
+after (XrdMeshFlyH5 _ f i x y g d w) = do
+ closeDataSource i
+ closeDataSource x
+ closeDataSource y
+ closeDataSource g
+ closeDataSource d
+ closeDataSource w
+ closeFile f
+after (XrdZeroDH5 _ f i w) = do
+ closeDataSource i
+ closeDataSource w
+ closeFile f
+
+before :: Nxs a → IO (DataFrameH5 a)
+before nxs'@(Nxs f (XrdFlatH5Path i)) = do
+ h ← openH5 f
+ XrdFlatH5
+ <$> return nxs'
+ <*> return h
+ <*> openDataSource h i
+-- before nxs'@(Nxs f (XrdOneDH5Path i g d w)) = do
+-- h ← openH5 f
+-- DataFrameH5
+-- <$> return nxs'
+-- <*> return h
+-- <*> openDataSource h g
+-- <*> openDataSource h d
+-- <*> openDataSource h w
+-- <*> return gen
+before nxs'@(Nxs f (XrdMeshH5Path i x y g d w)) = do
+ h ← openH5 f
+ XrdMeshH5
+ <$> return nxs'
+ <*> return h
+ <*> openDataSource h i
+ <*> openDataSource h x
+ <*> openDataSource h y
+ <*> openDataSource h g
+ <*> openDataSource h d
+ <*> openDataSource h w
+before nxs'@(Nxs f (XrdMeshFlyH5Path i x y g d w))= do
+ h ← openH5 f
+ XrdMeshFlyH5
+ <$> return nxs'
+ <*> return h
+ <*> openDataSource h i
+ <*> openDataSource h x
+ <*> openDataSource h y
+ <*> openDataSource h g
+ <*> openDataSource h d
+ <*> openDataSource h w
+before nxs'@(Nxs f (XrdZeroDH5Path i w)) = do
+ h ← openH5 f
+ XrdZeroDH5
+ <$> return nxs'
+ <*> return h
+ <*> openDataSource h i
+ <*> openDataSource h w
+
+withDataSource :: Nxs a -> (DataFrameH5 a -> IO r) -> IO r
+withDataSource s = Control.Exception.Base.bracket (before s) after
+
+-- | Pipe
+
+withDataFrameH5 :: (MonadSafe m) => Nxs XrdOneD -> PoniGenerator -> (DataFrameH5 XrdOneD -> m r) -> m r
+withDataFrameH5 nxs'@(Nxs f (XrdOneDH5Path _ g d w)) gen = Pipes.Safe.bracket (liftIO before') (liftIO . after)
+ where
+ -- before :: File -> DataFrameH5Path -> m DataFrameH5
+ before' :: IO (DataFrameH5 XrdOneD)
+ before' = do
+ h ← openH5 f
+ DataFrameH5
+ <$> return nxs'
+ <*> return h
+ <*> openDataSource h g
+ <*> openDataSource h d
+ <*> openDataSource h w
+ <*> return gen
+
+instance ToTiff (Nxs XrdFlat) where
+ toTiff n = withDataSource n $
+ \(XrdFlatH5 _ _ (DataSourceH5 _ i)) → do
+ ([w, h], _) ← getSimpleDataspaceExtent =<< (getDatasetSpace i)
+ ImageY16 <$> ( Image
+ <$> pure (fromIntegral w)
+ <*> pure (fromIntegral h)
+ <*> readDataset i Nothing Nothing )
diff --git a/contrib/haskell/src/Hkl/Projects.hs b/contrib/haskell/src/Hkl/Projects.hs
new file mode 100644
index 0000000..0a69776
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects.hs
@@ -0,0 +1,6 @@
+module Hkl.Projects ( module X ) where
+
+import Hkl.Projects.D2AM as X
+import Hkl.Projects.Diffabs as X
+import Hkl.Projects.Mars as X
+import Hkl.Projects.Sixs as X
diff --git a/contrib/haskell/src/Hkl/Projects/D2AM.hs b/contrib/haskell/src/Hkl/Projects/D2AM.hs
new file mode 100644
index 0000000..1a71b06
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/D2AM.hs
@@ -0,0 +1,3 @@
+module Hkl.Projects.D2AM (module X) where
+
+import Hkl.Projects.D2AM.XRD as X
diff --git a/contrib/haskell/src/Hkl/Projects/D2AM/XRD.hs b/contrib/haskell/src/Hkl/Projects/D2AM/XRD.hs
new file mode 100644
index 0000000..0b431af
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/D2AM/XRD.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hkl.Projects.D2AM.XRD
+ ( d2am ) where
+
+import Data.Array.Repa (DIM1, ix1)
+-- import Data.Char (toUpper)
+import Numeric.LinearAlgebra (ident)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+
+import Prelude hiding (concat, lookup, readFile, writeFile)
+
+import Hkl.MyMatrix
+import Hkl.PyFAI
+import Hkl.Xrd
+import Hkl.Detector
+
+-- | Samples
+
+project :: FilePath
+project = "/home/experiences/instrumentation/picca/data/d2am"
+-- project = "/nfs/ruche-diffabs/diffabs-soleil/com-diffabs/"
+
+published :: FilePath
+published = project </> "published-data"
+
+sampleRef :: XRDRef
+sampleRef = XRDRef "reference"
+ (published </> "calibration")
+ (XrdRefEdf
+ (project </> "16Dec08D5_0268-rsz.edf")
+ (project </> "16Dec08D5_0268-rsz.poni")
+ )
+
+sampleCalibration :: XRDCalibration Xpad32
+sampleCalibration = XRDCalibration { xrdCalibrationName = "calibration"
+ , xrdCalibrationOutputDir = published </> "calibration" -- TODO pourquoi ce output
+ , xrdCalibrationDetector = Xpad32
+ , xrdCalibrationCalibrant = CeO2
+ , xrdCalibrationEntries = entries
+ }
+ where
+
+ idxs :: [Int]
+ idxs = [268, 271, 285, 295]
+
+ entry :: Int -> XRDCalibrationEntry
+ entry idx = XRDCalibrationEntryEdf
+ { xrdCalibrationEntryEdf'Edf = project </> printf "16Dec08D5_%04d-rsz.edf" idx
+ , xrdCalibrationEntryEdf'NptPath = project </> printf "16Dec08D5_%04d-rsz.npt" idx
+ }
+
+ entries :: [XRDCalibrationEntry]
+ entries = [ entry idx | idx <- idxs]
+
+bins :: DIM1
+bins = ix1 1000
+
+multibins :: DIM1
+multibins = ix1 10000
+
+threshold :: Maybe Threshold
+threshold = Just (Threshold 5000)
+
+skipedFrames :: [Int]
+skipedFrames = []
+
+lab6 :: XRDSample
+lab6 = XRDSample "test"
+ (published </> "test")
+ [XrdNxs bins multibins threshold skipedFrames entries]
+ where
+ idxs :: [Int]
+ idxs = [268, 271, 285, 295]
+
+ entry :: Int -> FilePath
+ entry idx = project </> printf "16Dec08D5_%04d-rsz.edf" idx
+
+ entries :: XrdSource
+ entries = XrdSourceEdf [entry idx | idx <- idxs]
+
+-- | Main
+
+d2am :: IO ()
+d2am = do
+ let samples = [lab6]
+
+ p <- getPoniExtRef sampleRef
+
+ -- let poniextref = setPose (Hkl.PyFAI.PoniExt.flip p) (MyMatrix HklB (ident 3))
+ let poniextref = move p (Pose (MyMatrix HklB (ident 3)))
+
+ -- full calibration
+ poniextref' <- calibrate sampleCalibration poniextref
+
+ print poniextref
+ print poniextref'
+
+ -- integrate each step of the scan
+ let params = XrdOneDParams poniextref' Nothing Csr -- waiting for PyFAI to manage method in multi geometry
+ integrateMulti params samples
+
+ return ()
diff --git a/contrib/haskell/src/Hkl/Projects/Diffabs.hs b/contrib/haskell/src/Hkl/Projects/Diffabs.hs
new file mode 100644
index 0000000..1a7b753
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Diffabs.hs
@@ -0,0 +1,9 @@
+module Hkl.Projects.Diffabs (module X) where
+
+import Hkl.Projects.Diffabs.Charlier as X
+import Hkl.Projects.Diffabs.Hamon as X
+import Hkl.Projects.Diffabs.Hercules as X
+import Hkl.Projects.Diffabs.IRDRx as X
+import Hkl.Projects.Diffabs.Laure as X
+import Hkl.Projects.Diffabs.Martinetto as X
+import Hkl.Projects.Diffabs.Melle as X
diff --git a/contrib/haskell/src/Hkl/Projects/Diffabs/Charlier.hs b/contrib/haskell/src/Hkl/Projects/Diffabs/Charlier.hs
new file mode 100644
index 0000000..49d28a6
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Diffabs/Charlier.hs
@@ -0,0 +1,164 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hkl.Projects.Diffabs.Charlier
+ ( charlier ) where
+
+import Data.Array.Repa (DIM1, ix1)
+import Numeric.LinearAlgebra (ident)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+
+import Prelude hiding (concat, lookup, readFile, writeFile)
+
+import Hkl
+
+-- | TODO
+-- ⋅ gerer le dummy correctement en focntion du type de données des images uint32, int16
+-- ∘ couper la fin du spectre qui nous embète.
+-- | Samples
+
+project :: FilePath
+project = "/nfs/ruche-diffabs/diffabs-users/20151386/"
+
+published :: FilePath
+published = project </> "published-data" </> "xrd"
+
+-- | Calibration part
+
+project' :: FilePath
+project' = "/nfs/ruche-diffabs/diffabs-users/99160066/"
+
+published':: FilePath
+published' = project' </> "published-data"
+
+h5path' :: NxEntry -> DataFrameH5Path XrdOneD
+h5path' nxentry =
+ XrdOneDH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) ExtendDims)
+ (DataItemH5 (nxentry </> delta) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_53"
+ gamma = "d13-1-cx1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "scan_data/actuator_1_1"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+sampleCalibration :: XRDCalibration Xpad32
+sampleCalibration = XRDCalibration { xrdCalibrationName = "calibration"
+ , xrdCalibrationOutputDir = published' </> "calibration"
+ , xrdCalibrationDetector = Xpad32
+ , xrdCalibrationCalibrant = CeO2
+ , xrdCalibrationEntries = entries
+ }
+ where
+ idxs :: [Int]
+ idxs = [3, 6, 9, 15, 18, 21, 24, 27, 30, 33, 36, 39, 43]
+
+ entry :: Int -> XRDCalibrationEntry
+ entry idx = XRDCalibrationEntryNxs
+ { xrdCalibrationEntryNxs'Nxs = mkNxs (published' </> "calibration" </> "XRD18keV_26.nxs") "scan_26" h5path'
+ , xrdCalibrationEntryNxs'Idx = idx
+ , xrdCalibrationEntryNxs'NptPath = published' </> "calibration" </> printf "XRD18keV_26.nxs_%02d.npt" idx
+ }
+
+ entries :: [XRDCalibrationEntry]
+ entries = [ entry idx | idx <- idxs]
+
+
+sampleRef :: XRDRef
+sampleRef = XRDRef "reference"
+ (published' </> "calibration")
+ (XrdRefNxs
+ (mkNxs (published' </> "calibration" </> "XRD18keV_26.nxs") "scan_26" h5path')
+ 6 -- BEWARE only the 6th poni was generated with the right Xpad_flat geometry.
+ )
+
+bins :: DIM1
+bins = ix1 8000
+
+multibins :: DIM1
+multibins = ix1 25000
+
+threshold :: Maybe Threshold
+threshold = Just (Threshold 1200)
+
+h5path :: NxEntry -> DataFrameH5Path XrdMesh
+h5path nxentry = XrdMeshH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> meshx) StrictDims)
+ (DataItemH5 (nxentry </> meshy) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> delta) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_53"
+ meshx = "scan_data/actuator_1_1"
+ meshy = "scan_data/actuator_2_1"
+ gamma = "d13-1-cx1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "d13-1-cx1__EX__DIF.1-DELTA__#1/raw_value"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+charlemagne :: XrdMeshSample
+charlemagne = XrdMeshSample "Charlemagne"
+ (published </> "Charlemagne")
+ [ XrdMesh bins multibins threshold (XrdMeshSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-23" </> "XRD18keV_31.nxs") "scan_31" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-23" </> "XRD18keV_32.nxs") "scan_32" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-23" </> "XRD18keV_33.nxs") "scan_33" h5path
+ ]
+ ]
+
+charlesLeChauve :: XrdMeshSample
+charlesLeChauve = XrdMeshSample "Charles le Chauve"
+ (published </> "Charles le Chauve")
+ [ XrdMesh bins multibins threshold (XrdMeshSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-24" </> "XRD18keV_34.nxs") "scan_34" h5path ]
+ ]
+
+louisLePieux :: XrdMeshSample
+louisLePieux = XrdMeshSample "Louis le Pieux"
+ (published </> "Louis Le Pieux")
+ [ XrdMesh bins multibins threshold (XrdMeshSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-24" </> "XRD18keV_35.nxs") "scan_35" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-24" </> "XRD18keV_36.nxs") "scan_36" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-24" </> "XRD18keV_37.nxs") "scan_37" h5path
+ ]
+ ]
+
+-- | Main
+
+charlier :: IO ()
+charlier = do
+ let samples = [ charlemagne, charlesLeChauve, louisLePieux]
+ -- let samples = [ louisLePieux ]
+ -- # need to run f30 by itself because of a segfault in the hkl library
+ -- for now f30 whcih is an incomplet scan stop the script so put it at the end.
+ -- let samples = [f30, ceo2]
+ -- let samples = [ceo2]
+ let mflat = Nothing
+ let method = CsrOcl
+
+ p <- getPoniExtRef sampleRef
+
+ -- flip the ref poni in order to fit the reality
+ -- let poniextref = p
+ let poniextref = move p (Pose (MyMatrix HklB (ident 3)))
+ -- let poniextref = setPose (Hkl.PyFAI.PoniExt.flip p) (MyMatrix HklB (ident 3))
+
+ -- full calibration
+ poniextref' <- calibrate sampleCalibration poniextref
+ -- print p
+ print poniextref
+ print poniextref'
+
+ -- integrate each step of the scan
+ integrateMesh (XrdMeshParams poniextref' mflat method) samples
+ return ()
diff --git a/contrib/haskell/src/Hkl/Projects/Diffabs/Hamon.hs b/contrib/haskell/src/Hkl/Projects/Diffabs/Hamon.hs
new file mode 100644
index 0000000..8923efc
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Diffabs/Hamon.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hkl.Projects.Diffabs.Hamon
+ ( hamon ) where
+
+import Data.Array.Repa (DIM1, ix1)
+import Numeric.LinearAlgebra (ident)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+
+import Prelude hiding (concat, lookup, readFile, writeFile)
+
+import Hkl
+
+-- | TODO
+-- * take into account a non-centered sample.
+-- * find a way to use integrateMulti with a small amount of memory.
+-- * better mask for each detector.
+
+-- | Samples
+
+project :: FilePath
+project = "/nfs/ruche-diffabs/diffabs-soleil/com-diffabs/"
+
+published :: FilePath
+published = project </> "2016" </> "Run4B" </> "OutilsMetallo_CarolineHamon"
+
+sampleRef :: XRDRef
+sampleRef = XRDRef "reference"
+ (published </> "xrd" </> "calibration")
+ (XrdRefNxs
+ (mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_30.nxs") "scan_30" h5path')
+ 33
+ )
+
+h5path' :: NxEntry -> DataFrameH5Path XrdOneD
+h5path' nxentry =
+ XrdOneDH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) ExtendDims)
+ (DataItemH5 (nxentry </> delta) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_02"
+ gamma = "D13-1-CX1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "scan_data/actuator_1_1"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+sampleCalibration :: XRDCalibration Xpad32
+sampleCalibration = XRDCalibration { xrdCalibrationName = "calibration"
+ , xrdCalibrationOutputDir = published </> "xrd" </> "calibration" -- TODO pourquoi ce output
+ , xrdCalibrationDetector = Xpad32
+ , xrdCalibrationCalibrant = CeO2
+ , xrdCalibrationEntries = entries
+ }
+ where
+
+ idxs :: [Int]
+ idxs = [5, 33, 100, 246, 300, 436]
+
+ entry :: Int -> XRDCalibrationEntry
+ entry idx = XRDCalibrationEntryNxs
+ { xrdCalibrationEntryNxs'Nxs = mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_30.nxs") "scan_30" h5path'
+ , xrdCalibrationEntryNxs'Idx = idx
+ , xrdCalibrationEntryNxs'NptPath = published </> "xrd" </> "calibration" </> printf "IHR_30.nxs_%02d.npt" idx
+ }
+
+ entries :: [XRDCalibrationEntry]
+ entries = [ entry idx | idx <- idxs]
+
+
+bins :: DIM1
+bins = ix1 1000
+
+multibins :: DIM1
+multibins = ix1 10000
+
+threshold :: Maybe Threshold
+threshold = Just (Threshold 5000)
+
+skipedFrames :: [Int]
+skipedFrames = []
+
+ceo2 :: XRDSample
+ceo2 = XRDSample "CeO2"
+ (published </> "xrd" </> "CeO2")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_29.nxs") "scan_29" h5path'
+ , mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_30.nxs") "scan_30" h5path'
+ , mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_56.nxs") "scan_56" h5path'
+ , mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_58.nxs") "scan_58" h5path'
+ ]
+ ]
+
+-- | Main
+
+hamon :: IO ()
+hamon = do
+ -- | pre-calibrate (extract from nexus to edf in order to do the
+ -- calibration)
+ extractEdf sampleCalibration
+
+ p <- getPoniExtRef sampleRef
+
+ let poniextref = move p (Pose (MyMatrix HklB (ident 3)))
+
+ -- full calibration
+ poniextref' <- calibrate sampleCalibration poniextref
+
+ print poniextref
+ print poniextref'
+
+ -- Integrate the flyscan mesh
+ -- 4.680504680504681e-3 per images (2*60+18) / 29484 this contain
+ -- read/write and computation
+ -- integrateMesh (XrdMeshParams poniextref' mflat method) [fly]
+
+ -- | set the integration parameters
+ let mflat = Nothing
+ let aiMethod = Csr
+ let params = XrdOneDParams poniextref' mflat aiMethod
+
+ -- integrate each step of the scan
+ integrate params [ceo2]
+
+ -- this code doesn not work because there is not enought memory on
+ -- the computer.
+ -- integrateMulti params [ceo2]
+
+ return ()
diff --git a/contrib/haskell/src/Hkl/Projects/Diffabs/Hercules.hs b/contrib/haskell/src/Hkl/Projects/Diffabs/Hercules.hs
new file mode 100644
index 0000000..7c43650
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Diffabs/Hercules.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Projects.Diffabs.Hercules
+ ( hercules ) where
+
+import Data.Array.Repa (DIM1, ix1)
+import Numeric.Units.Dimensional.Prelude ((*~), centi, degree, meter)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+
+import Prelude hiding (lookup, readFile, writeFile)
+
+import Hkl
+
+-- | Samples
+
+project ∷ FilePath
+project = "/nfs/ruche-diffabs/diffabs-soleil/com-diffabs/"
+
+published ∷ FilePath
+published = "/nfs/ruche-diffabs/diffabs-soleil/com-diffabs/2017/Run2B/TPHercules"
+
+-- | Calibration part
+
+mkNxs' ∷ FilePath → Int → (NxEntry → DataFrameH5Path a ) → Nxs a
+mkNxs' d idx h = mkNxs f' e h
+ where
+ f ∷ FilePath → Int → (FilePath, NxEntry)
+ f d' i' = (d' </> printf "scan_%d.nxs" i', printf "scan_%d" i')
+
+ (f', e) = f d idx
+
+h5path ∷ NxEntry → DataFrameH5Path XrdOneD
+h5path nxentry =
+ XrdOneDH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) ExtendDims)
+ (DataItemH5 (nxentry </> delta) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_03"
+ gamma = "D13-1-CX1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "scan_data/actuator_1_1"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+sampleRef ∷ XRDRef
+sampleRef = XRDRef "reference"
+ (published </> "calibration")
+ (XrdRefNxs
+ (mkNxs' (project </> "2017" </> "Run2" </> "2017-03-21") 91 h5path)
+ 15 -- BEWARE only the 6th poni was generated with the right Xpad_flat geometry.
+ )
+
+sampleCalibration ∷ XRDCalibration ImXpadS140
+sampleCalibration = XRDCalibration { xrdCalibrationName = "calibration"
+ , xrdCalibrationOutputDir = published </> "calibration"
+ , xrdCalibrationDetector = ImXpadS140
+ , xrdCalibrationCalibrant = CeO2
+ , xrdCalibrationEntries = entries
+ }
+ where
+ idxs ∷ [Int]
+ idxs = [15, 16, 17, 18, 19]
+
+ entry ∷ Int -> XRDCalibrationEntry
+ entry idx = XRDCalibrationEntryNxs
+ { xrdCalibrationEntryNxs'Nxs = mkNxs' (project </> "2017" </> "Run2" </> "2017-03-21") 91 h5path
+ , xrdCalibrationEntryNxs'Idx = idx
+ , xrdCalibrationEntryNxs'NptPath = published </> "calibration" </> printf "scan_91.nxs_%02d.npt" idx
+ }
+
+ entries ∷ [XRDCalibrationEntry]
+ entries = map entry idxs
+
+-- | Data treatment
+
+bins ∷ DIM1
+bins = ix1 3000
+
+multibins ∷ DIM1
+multibins = ix1 25000
+
+threshold ∷ Maybe Threshold
+threshold = Just (Threshold 800)
+
+skipedFrames ∷ [Int]
+skipedFrames = []
+
+-- Flat
+
+-- flat ∷ [Nxs XrdFlat]
+-- flat = [mkNxs' (project </> "2017" </> "Run1" </> "2017-02-15") idx h5path | idx ← [57, 60 ∷ Int]] -- skip 58 59 for now (problème de droits d'accès)
+-- where
+-- h5path :: NxEntry -> DataFrameH5Path XrdFlat
+-- h5path nxentry = XrdFlatH5Path (DataItemH5 (nxentry </> "scan_data/data_02") StrictDims)
+
+-- Scan en delta
+
+mkXRDSample ∷ String → [(FilePath, [Int])] -> XRDSample
+mkXRDSample n ps = XRDSample n
+ (published </> "xrd" </> n)
+ [ XrdNxs bins multibins threshold skipedFrames n' | n' ← concatMap nxs''' ps ]
+ where
+ nxs''' ∷ (FilePath, [Int]) → [XrdSource]
+ nxs''' (p, idxs) = [XrdSourceNxs (mkNxs' p idx h5path) | idx ← idxs]
+
+
+samples :: [XRDSample]
+samples = map (uncurry mkXRDSample)
+ [ ("CeO2", [ ((project </> "2017" </> "Run2" </> "2017-03-21"), [91 :: Int]) ])
+ , ("zgso4_room", [ ((project </> "2017" </> "Run2" </> "2017-03-21"), [96 :: Int]) ])
+ , ("zgso4_450C", [ ((project </> "2017" </> "Run2" </> "2017-03-21"), [192 :: Int]) ])
+ , ("zgso4_heating", [ ((project </> "2017" </> "Run2" </> "2017-03-21"), [100..190 :: Int]) ])
+ , ("zgso4_cooling", [ ((project </> "2017" </> "Run2" </> "2017-03-21"), [199..214 :: Int]) ])
+ ]
+
+-- | Main
+
+hercules ∷ IO ()
+hercules = do
+
+ -- | pre-calibrate (extract from nexus to edf in order to do the
+ -- calibration)
+ extractEdf sampleCalibration
+
+ -- | compute the flat
+ -- flat' ← computeFlat flat (published </> "flat" </> "flat.npy")
+
+ -- | get a first ref poniExt
+ p ← getPoniExtRef sampleRef
+ -- set the initial position of the poni (pyFAI calibration is not
+ -- accurate with only one ring)
+ let poniextref = set p
+ (63 *~ centi meter) -- distance
+ (0 *~ meter) -- poni1
+ (0 *~ meter) -- poni2
+ (0 *~ degree) -- rot1
+ (0 *~ degree) -- rot2
+ (0 *~ degree) -- rot3
+ print poniextref
+
+ -- | full calibration
+ poniextref' ← calibrate sampleCalibration poniextref
+ print poniextref'
+
+ -- | set the integration parameters
+ let mflat = Nothing
+ let aiMethod = Csr
+ let params = XrdOneDParams poniextref' mflat aiMethod
+
+ -- -- integrate scan with multi geometry
+ -- -- splitPixel (the only available now) → 17m47.825s
+ integrateMulti params samples
+
+ -- -- Integrate each image of the scans
+ -- -- Lut → 21.52 minutes
+ -- -- Csr → 21.9 minutes
+ -- integrate params samples
+
+ -- -- substrack the air from all samples
+ -- substract params air samples
+ -- substractMulti params air samples
+
+ return ()
diff --git a/contrib/haskell/src/Hkl/Projects/Diffabs/IRDRx.hs b/contrib/haskell/src/Hkl/Projects/Diffabs/IRDRx.hs
new file mode 100644
index 0000000..86b7a68
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Diffabs/IRDRx.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hkl.Projects.Diffabs.IRDRx
+ ( irdrx ) where
+
+import Data.Array.Repa (DIM1, ix1)
+import Numeric.LinearAlgebra (ident)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+
+import Prelude hiding (concat, lookup, readFile, writeFile)
+
+import Hkl
+
+-- | Samples
+
+project :: FilePath
+project = "/nfs/ruche-diffabs/diffabs-soleil/com-diffabs/"
+
+published :: FilePath
+published = project </> "2016" </> "Run5B" </> "irdrx"
+
+sampleRef :: XRDRef
+sampleRef = XRDRef "reference"
+ (published </> "calibration")
+ (XrdRefNxs
+ (mkNxs (project </> "2016" </> "Run5" </> "2016-11-09" </> "scan_39.nxs") "scan_39" h5path')
+ 10
+ )
+
+h5path' :: NxEntry -> DataFrameH5Path XrdOneD
+h5path' nxentry =
+ XrdOneDH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) ExtendDims)
+ (DataItemH5 (nxentry </> delta) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_05"
+ gamma = "D13-1-CX1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "scan_data/data_03"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+sampleCalibration :: XRDCalibration ImXpadS140
+sampleCalibration = XRDCalibration { xrdCalibrationName = "calibration"
+ , xrdCalibrationOutputDir = published </> "calibration" -- TODO pourquoi ce output
+ , xrdCalibrationDetector = ImXpadS140
+ , xrdCalibrationCalibrant = CeO2
+ , xrdCalibrationEntries = entries
+ }
+ where
+
+ idxs :: [Int]
+ idxs = [0, 1, 10, 30]
+
+ entry :: Int -> XRDCalibrationEntry
+ entry idx = XRDCalibrationEntryNxs
+ { xrdCalibrationEntryNxs'Nxs = mkNxs (project </> "2016" </> "Run5" </> "2016-11-09" </> "scan_39.nxs") "scan_39" h5path'
+ , xrdCalibrationEntryNxs'Idx = idx
+ , xrdCalibrationEntryNxs'NptPath = published </> "calibration" </> printf "scan_39.nxs_%02d.npt" idx
+ }
+
+ entries :: [XRDCalibrationEntry]
+ entries = [ entry idx | idx <- idxs]
+
+
+bins :: DIM1
+bins = ix1 1000
+
+multibins :: DIM1
+multibins = ix1 10000
+
+threshold :: Maybe Threshold
+threshold = Just (Threshold 5000)
+
+skipedFrames :: [Int]
+skipedFrames = []
+
+lab6 :: XRDSample
+lab6 = XRDSample "LaB6"
+ (published </> "LaB6")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run5" </> "2016-11-09" </> "scan_39.nxs") "scan_39" h5path'
+ , mkNxs (project </> "2016" </> "Run5" </> "2016-11-09" </> "scan_40.nxs") "scan_40" h5path'
+ , mkNxs (project </> "2016" </> "Run5" </> "2016-11-09" </> "scan_41.nxs") "scan_41" h5path'
+ , mkNxs (project </> "2016" </> "Run5" </> "2016-11-09" </> "scan_42.nxs") "scan_42" h5path'
+ , mkNxs (project </> "2016" </> "Run5" </> "2016-11-09" </> "scan_43.nxs") "scan_43" h5path'
+ , mkNxs (project </> "2016" </> "Run5" </> "2016-11-09" </> "scan_44.nxs") "scan_44" h5path'
+ , mkNxs (project </> "2016" </> "Run5" </> "2016-11-09" </> "scan_45.nxs") "scan_45" h5path'
+ ]
+ ]
+
+
+
+-- meshSample :: String
+-- meshSample :: project </> "2016" </> Run5 </> "2016-11-fly" </> "scan5 </> "*"
+-- h5path nxentry = exptest_01368
+-- scan_data, sxpos szpos xpad_image 12x273 x 10 (fichiers)
+-- delta = -6.2
+-- gamma = 0.0
+-- nrj 18.2 keV
+fly :: XrdMeshSample
+fly = XrdMeshSample "scan5"
+ (published </> "scan5")
+ [ XrdMesh bins multibins threshold
+ ( XrdMeshSourceNxsFly [mkNxs (project </> "2016" </> "Run5" </> "2016-11-fly" </> "scan5" </> printf "flyscan_%05d.nxs" n) "exptest_01368" h5path |
+ n <- [7087, 7088, 7089, 7090, 7091, 7092, 7093, 7094, 7095] :: [Int]
+ ]
+ )
+ ]
+ where
+ h5path :: NxEntry -> (DataFrameH5Path XrdMesh)
+ h5path nxentry = XrdMeshFlyH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> meshx) StrictDims)
+ (DataItemH5 (nxentry </> meshy) StrictDims)
+ (DataItemConst gamma)
+ (DataItemConst delta)
+ (DataItemConst wavelength)
+
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/xpad_image"
+ meshx = "scan_data/sxpos"
+ meshy = "scan_data/szpos"
+ gamma = 0.0 / 180.0 * 3.14159
+ delta = -6.2 / 180.0 * 3.14159
+ wavelength = 1.54 -- TODO vérifier
+
+-- | Main
+
+irdrx :: IO ()
+irdrx = do
+ let mflat = Nothing
+ let method = CsrOcl
+
+ p <- getPoniExtRef sampleRef
+
+ let poniextref = move (Hkl.flip p) (Pose (MyMatrix HklB (ident 3)))
+
+ -- full calibration
+ poniextref' <- calibrate sampleCalibration poniextref
+
+ print poniextref'
+
+ -- Integrate the flyscan mesh
+ -- 4.680504680504681e-3 per images (2*60+18) / 29484 this contain
+ -- read/write and computation
+ integrateMesh (XrdMeshParams poniextref' mflat method) [fly]
+
+ -- integrate each step of the scan
+ -- _ <- mapConcurrently (integrate poniextref') [lab6]
+ return ()
diff --git a/contrib/haskell/src/Hkl/Projects/Diffabs/Laure.hs b/contrib/haskell/src/Hkl/Projects/Diffabs/Laure.hs
new file mode 100644
index 0000000..05706c6
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Diffabs/Laure.hs
@@ -0,0 +1,206 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Projects.Diffabs.Laure
+ ( laure ) where
+
+import Data.Array.Repa (DIM1, ix1)
+import Numeric.LinearAlgebra (ident)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+
+import Prelude hiding (lookup, readFile, writeFile)
+
+import Hkl
+
+-- | TODO
+-- * Livre 45 p159
+-- * simplify with the list of nxs using list comprehension.
+-- * add the flyscan mesh
+-- * add possibility to sum a bunch of pixel coordinates from a mesh. on a mask
+
+-- | Samples
+
+project ∷ FilePath
+project = "/nfs/ruche-diffabs/diffabs-users/20160370/"
+
+published ∷ FilePath
+published = project </> "published-data"
+
+h5path ∷ NxEntry → DataFrameH5Path XrdOneD
+h5path nxentry =
+ XrdOneDH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) ExtendDims)
+ (DataItemH5 (nxentry </> delta) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_02"
+ gamma = "D13-1-CX1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "scan_data/actuator_1_1"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+mkNxs' ∷ FilePath → Int → (NxEntry → DataFrameH5Path a ) → Nxs a
+mkNxs' d idx h = mkNxs f' e h
+ where
+ f ∷ FilePath → Int → (FilePath, NxEntry)
+ f d' i' = (d' </> printf "scan_%d.nxs" i', printf "scan_%d" (i' - 1))
+
+ (f', e) = f d idx
+
+-- | Calibration part
+
+sampleRef ∷ XRDRef
+sampleRef = XRDRef "reference"
+ (published </> "calibration")
+ (XrdRefNxs
+ (mkNxs' (published </> "calibration") 45 h5path)
+ 10 -- BEWARE only the 6th poni was generated with the right Xpad_flat geometry.
+ )
+
+sampleCalibration ∷ XRDCalibration ImXpadS140
+sampleCalibration = XRDCalibration { xrdCalibrationName = "calibration"
+ , xrdCalibrationOutputDir = published </> "calibration"
+ , xrdCalibrationDetector = ImXpadS140
+ , xrdCalibrationCalibrant = CeO2
+ , xrdCalibrationEntries = entries
+ }
+ where
+ idxs ∷ [Int]
+ idxs = [00, 01, 02, 03, 04, 09, 10, 11, 12, 14, 15, 18, 19, 22, 23, 26, 29, 33, 38, 42, 49, 53]
+
+ entry ∷ Int -> XRDCalibrationEntry
+ entry idx = XRDCalibrationEntryNxs
+ { xrdCalibrationEntryNxs'Nxs = mkNxs' (published </> "calibration") 45 h5path
+ , xrdCalibrationEntryNxs'Idx = idx
+ , xrdCalibrationEntryNxs'NptPath = published </> "calibration" </> printf "scan_45.nxs_%02d.npt" idx
+ }
+
+ entries ∷ [XRDCalibrationEntry]
+ entries = map entry idxs
+
+-- | Data treatment
+
+bins ∷ DIM1
+bins = ix1 3000
+
+multibins ∷ DIM1
+multibins = ix1 25000
+
+threshold ∷ Maybe Threshold
+threshold = Just (Threshold 800)
+
+skipedFrames ∷ [Int]
+skipedFrames = [4]
+
+-- Flat
+
+flat ∷ [Nxs XrdFlat]
+flat = [mkNxs' (project </> "2017" </> "Run1" </> "2017-02-15") idx h5path' | idx ← [57, 60 ∷ Int]] -- skip 58 59 for now (problème de droits d'accès)
+ where
+ h5path' :: NxEntry -> DataFrameH5Path XrdFlat
+ h5path' nxentry = XrdFlatH5Path (DataItemH5 (nxentry </> "scan_data/data_02") StrictDims)
+
+-- Scan en delta
+
+mkXRDSample ∷ String → [(FilePath, [Int])] -> XRDSample
+mkXRDSample n ps = XRDSample n
+ (published </> "xrd" </> n)
+ [ XrdNxs bins multibins threshold skipedFrames n' | n' ← concatMap nxs''' ps ]
+ where
+ nxs''' ∷ (FilePath, [Int]) → [XrdSource]
+ nxs''' (p, idxs) = [XrdSourceNxs (mkNxs' p idx h5path) | idx ← idxs]
+
+
+air ∷ XRDSample
+air = mkXRDSample "air" [ ((project </> "2017" </> "Run1" </> "2017-02-17"), [198 :: Int]) ]
+
+samples :: [XRDSample]
+samples = air : map (uncurry mkXRDSample)
+ [ ("CeO2", [ ((project </> "2017" </> "Run1" </> "2017-02-15"), [45 :: Int]) ])
+ , ("kapton", [ ((project </> "2017" </> "Run1" </> "2017-02-17"), [197 :: Int]) ])
+ , ("chlorite", [ ((project </> "2017" </> "Run1" </> "2017-02-15"), [53 :: Int]) ])
+ , ("dMnO2", [ ((project </> "2017" </> "Run1" </> "2017-02-16"), [135 :: Int]) ])
+ , ("bulk_L2", [ ((project </> "2017" </> "Shutdown1-2" </> "2017-02-19"), [315..316 :: Int]) ])
+ , ("L1-H_3", [ ((project </> "2017" </> "Run1" </> "2017-02-15"), concat [ [62..63 :: Int]
+ , [65..70 :: Int]
+ , [74, 75 :: Int]
+ ])
+ , ((project </> "2017" </> "Run1" </> "2017-02-16"), [76..89 :: Int])
+ ])
+ , ("L1-H_4", [ ((project </> "2017" </> "Run1" </> "2017-02-15"), [71..73 :: Int])
+ , ((project </> "2017" </> "Run1" </> "2017-02-16"), concat [ [90..94 :: Int]
+ , [96..103 :: Int]
+ , [119..127 :: Int]
+ ])
+ ])
+ , ("L1-H_5", [ ((project </> "2017" </> "Run1" </> "2017-02-16"), [104..118 :: Int]) ])
+ , ("L1-Patine_1", [ ((project </> "2017" </> "Run1" </> "2017-02-16"), [136..151 :: Int])
+ , ((project </> "2017" </> "Run1" </> "2017-02-17"), concat [ [152..184 :: Int]
+ , [186 :: Int]
+ ])
+ ])
+ , ("L1-Patine_2", [ ((project </> "2017" </> "Run1" </> "2017-02-17"), [187..196 :: Int]) ])
+ , ("L2-H_1", [ ((project </> "2017" </> "Run1" </> "2017-02-17"), [199..213 :: Int]) ])
+ , ("L2-H_2", [ ((project </> "2017" </> "Run1" </> "2017-02-17"), [214..220 :: Int])
+ , ((project </> "2017" </> "Run1" </> "2017-02-18"), concat [ [221..228 :: Int]
+ , [259..262 :: Int]
+ ])
+ ])
+ , ("L2-H_3", [ ((project </> "2017" </> "Run1" </> "2017-02-18"), [229..248 :: Int]) ])
+ , ("L2-PatineFoncee", [ ((project </> "2017" </> "Run1" </> "2017-02-18"), [249..258 :: Int]) ])
+ , ("L2-PatineFonceeNew", [ ((project </> "2017" </> "Run1" </> "2017-02-18"), concat [ [263, 264, 266, 267 :: Int]
+ , [269..273 :: Int]])
+ ])
+ , ("L2-patineLabo_1", [ ((project </> "2017" </> "Shutdown1-2" </> "2017-02-19"),[295..313 :: Int]) ])
+ , ("L2-PatineClaire_1", [ ((project </> "2017" </> "Shutdown1-2" </> "2017-02-19"), [317..324 :: Int])
+ , ((project </> "2017" </> "Shutdown1-2" </> "2017-02-20"), [325..356 :: Int])
+ ])
+ , ("L3-patine_1", [ ((project </> "2017" </> "Run1" </> "2017-02-19"), [274..293 :: Int])
+ , ((project </> "2017" </> "Shutdown1-2" </> "2017-02-19"), [294, 295 :: Int])
+ ])
+ ]
+
+-- | Main
+
+laure ∷ IO ()
+laure = do
+
+ -- | compute the flat
+ flat' ← computeFlat flat (published </> "flat" </> "flat.npy")
+
+ -- | get a first ref poniExt
+ p ← getPoniExtRef sampleRef
+ -- flip the ref poni in order to fit the reality
+ -- let poniextref = p
+ let poniextref = move p (Pose (MyMatrix HklB (ident 3)))
+ -- let poniextref = setPose (Hkl.PyFAI.PoniExt.flip p) (MyMatrix HklB (ident 3))
+ print poniextref
+
+ -- | full calibration
+ poniextref' ← calibrate sampleCalibration poniextref
+ print poniextref'
+
+ -- | set the integration parameters
+ let mflat = Just flat'
+ let aiMethod = Csr
+ let params = XrdOneDParams poniextref' mflat aiMethod
+
+ -- integrate scan with multi geometry
+ -- splitPixel (the only available now) → 17m47.825s
+ integrateMulti params samples
+
+ -- Integrate each image of the scans
+ -- Lut → 21.52 minutes
+ -- Csr → 21.9 minutes
+ integrate params samples
+
+ -- substrack the air from all samples
+ substract params air samples
+ substractMulti params air samples
+
+ return ()
diff --git a/contrib/haskell/src/Hkl/Projects/Diffabs/Martinetto.hs b/contrib/haskell/src/Hkl/Projects/Diffabs/Martinetto.hs
new file mode 100644
index 0000000..977d9b3
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Diffabs/Martinetto.hs
@@ -0,0 +1,294 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hkl.Projects.Diffabs.Martinetto
+ ( martinetto
+ , martinetto'
+ ) where
+
+import Data.Array.Repa (DIM1, ix1)
+import Numeric.LinearAlgebra (ident)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+
+import Prelude hiding (concat, lookup, readFile, writeFile)
+
+import Hkl
+
+-- | Samples
+
+project :: FilePath
+project = "/nfs/ruche-diffabs/diffabs-users/99160066/"
+
+published :: FilePath
+published = project </> "published-data"
+
+h5path' :: NxEntry -> DataFrameH5Path XrdOneD
+h5path' nxentry =
+ XrdOneDH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) ExtendDims)
+ (DataItemH5 (nxentry </> delta) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_53"
+ gamma = "d13-1-cx1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "scan_data/actuator_1_1"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+sampleCalibration :: XRDCalibration Xpad32
+sampleCalibration = XRDCalibration { xrdCalibrationName = "calibration"
+ , xrdCalibrationOutputDir = published </> "calibration"
+ , xrdCalibrationDetector = Xpad32
+ , xrdCalibrationCalibrant = CeO2
+ , xrdCalibrationEntries = entries
+ }
+ where
+
+ idxs :: [Int]
+ idxs = [3, 6, 9, 15, 18, 21, 24, 27, 30, 33, 36, 39, 43]
+
+ entry :: Int -> XRDCalibrationEntry
+ entry idx = XRDCalibrationEntryNxs
+ { xrdCalibrationEntryNxs'Nxs = mkNxs (published </> "calibration" </> "XRD18keV_26.nxs") "scan_26" h5path'
+ , xrdCalibrationEntryNxs'Idx = idx
+ , xrdCalibrationEntryNxs'NptPath = published </> "calibration" </> printf "XRD18keV_26.nxs_%02d.npt" idx
+ }
+
+ entries :: [XRDCalibrationEntry]
+ entries = [ entry idx | idx <- idxs]
+
+
+sampleRef :: XRDRef
+sampleRef = XRDRef "reference"
+ (published </> "calibration")
+ (XrdRefNxs
+ (mkNxs (published </> "calibration" </> "XRD18keV_26.nxs") "scan_26" h5path')
+ 6 -- BEWARE only the 6th poni was generated with the right Xpad_flat geometry.
+ )
+
+h5path :: NxEntry -> DataFrameH5Path XrdOneD
+h5path nxentry =
+ XrdOneDH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) ExtendDims)
+ (DataItemH5 (nxentry </> delta) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_58"
+ gamma = "D13-1-CX1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "scan_data/actuator_1_1"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+bins :: DIM1
+bins = ix1 8000
+
+multibins :: DIM1
+multibins = ix1 25000
+
+threshold :: Maybe Threshold
+threshold = Just (Threshold 800)
+
+skipedFrames :: [Int]
+skipedFrames = []
+
+ceo2 :: XRDSample
+ceo2 = XRDSample "CeO2"
+ (published </> "CeO2")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (published </> "calibration" </> "XRD18keV_26.nxs") "scan_26" h5path' ]
+ ]
+
+n27t2 :: XRDSample
+n27t2 = XRDSample "N27T2"
+ (published </> "N27T2")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "N27T2_14.nxs") "scan_14" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "N27T2_17.nxs") "scan_17" h5path
+ ]
+ ]
+
+r23 :: XRDSample
+r23 = XRDSample "R23"
+ (published </> "R23")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "R23_6.nxs") "scan_6" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "R23_12.nxs") "scan_12" h5path
+ ]
+ ]
+
+r18 :: XRDSample
+r18 = XRDSample "R18"
+ (published </> "R18")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "R18_20.nxs") "scan_20" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "R18_24.nxs") "scan_24" h5path
+ ]
+ ]
+
+a3 :: XRDSample
+a3 = XRDSample "A3"
+ (published </> "A3")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "A3_13.nxs") "scan_13" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "A3_14.nxs") "scan_14" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "A3_15.nxs") "scan_15" h5path
+ ]
+ ]
+
+a2 :: XRDSample
+a2 = XRDSample "A2"
+ (published </> "A2")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "A2_14.nxs") "scan_14" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "A2_17.nxs") "scan_17" h5path
+ ]
+ ]
+
+a26 :: XRDSample
+a26 = XRDSample "A26"
+ (published </> "A26")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "A26_50.nxs") "scan_50" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "A26_51.nxs") "scan_51" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "A26_52.nxs") "scan_52" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "A26_53.nxs") "scan_53" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "A26_54.nxs") "scan_54" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "A26_55.nxs") "scan_55" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "A26_56.nxs") "scan_56" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "A26_57.nxs") "scan_57" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "A26_58.nxs") "scan_58" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "A26_59.nxs") "scan_59" h5path
+ ]
+ ]
+
+d2 :: XRDSample
+d2 = XRDSample "D2"
+ (published </> "D2")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "D2_16.nxs") "scan_16" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "D2_17.nxs") "scan_17" h5path
+ ]
+ ]
+
+d3 :: XRDSample
+d3 = XRDSample "D3"
+ (published </> "D3")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "D3_14.nxs") "scan_14" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "D3_15.nxs") "scan_15" h5path
+ ]
+ ]
+
+f30 :: XRDSample
+f30 = XRDSample "F30"
+ (published </> "F30")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "F30_11.nxs") "scan_11" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "F30_12.nxs") "scan_12" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "F30_13.nxs") "scan_13" h5path
+ ]
+ ]
+
+r11 :: XRDSample
+r11 = XRDSample "R11"
+ (published </> "R11")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "R11_5.nxs") "scan_5" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "R11_6.nxs") "scan_6" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "R11_7.nxs") "scan_7" h5path
+ ]
+ ]
+
+d16 :: XRDSample
+d16 = XRDSample "D16"
+ (published </> "D16")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "D16_12.nxs") "scan_12" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "D16_15.nxs") "scan_15" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "D16_17.nxs") "scan_17" h5path
+ ]
+ ]
+
+k9a2 :: XRDSample
+k9a2 = XRDSample "K9A2"
+ (published </> "K9A2")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "K9A2_1_31.nxs") "scan_31" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "K9A2_1_32.nxs") "scan_32" h5path
+ ]
+ ]
+
+r34n1 :: XRDSample
+r34n1 = XRDSample "R34N1"
+ (published </> "R34N1")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "R34N1_28.nxs") "scan_28" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-27" </> "R34N1_37.nxs") "scan_37" h5path
+ ]
+ ]
+
+r35n1 :: XRDSample
+r35n1 = XRDSample "R35N1"
+ (published </> "R35N1")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "R35N1_25.nxs") "scan_19" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "R35N1_26.nxs") "scan_20" h5path
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-26" </> "R35N1_27.nxs") "scan_21" h5path
+ ]
+ ]
+
+-- meshSample :: String
+-- meshSample = project </> "2016" "Run2" "2016-03-28" "MELLE_29.nxs"
+-- scan_29 scan_data actuator_1_1 actuator_2_1 data_58 (images)
+
+-- | Main
+
+martinetto :: IO ()
+martinetto = do
+ -- lire le ou les ponis de référence ainsi que leur géométrie
+ -- associée.
+
+ -- let samples = [ceo2, a2, a3, a26, d2, d3, d16, f30, k9a2, n27t2, r11, r18, r23, r34n1, r35n1]
+ let samples = [ceo2]
+
+ p <- getPoniExtRef sampleRef
+
+ -- flip the ref poni in order to fit the reality
+ -- let poniextref = Hkl.PyFAI.PoniExt.flip p
+ let poniextref = p
+ -- integrate each step of the scan
+ let params = XrdOneDParams poniextref Nothing Lut
+ integrate params samples
+
+ -- plot de la figure. (script python ou autre ?)
+ return ()
+
+martinetto' :: IO ()
+martinetto' = do
+ let samples = [ceo2, a2, a3, a26, d2, d3, d16, f30, k9a2, n27t2, r11, r18, r23, r34n1, r35n1]
+ let mflat = Nothing
+
+ p <- getPoniExtRef sampleRef
+
+ -- flip the ref poni in order to fit the reality
+ -- let poniextref = p
+ let poniextref = move p (Pose (MyMatrix HklB (ident 3)))
+ -- let poniextref = setPose (Hkl.PyFAI.PoniExt.flip p) (MyMatrix HklB (ident 3))
+
+ -- full calibration
+ poniextref' <- calibrate sampleCalibration poniextref
+ -- print p
+ print poniextref
+ print poniextref'
+
+ -- integrate each step of the scan
+ integrateMulti (XrdOneDParams poniextref' mflat Csr) samples
+
+ return ()
diff --git a/contrib/haskell/src/Hkl/Projects/Diffabs/Melle.hs b/contrib/haskell/src/Hkl/Projects/Diffabs/Melle.hs
new file mode 100644
index 0000000..de837f0
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Diffabs/Melle.hs
@@ -0,0 +1,439 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Projects.Diffabs.Melle
+ ( melle ) where
+
+-- import Control.Concurrent (setNumCapabilities)
+-- import Control.Concurrent.Async (mapConcurrently)
+import Data.Array.Repa (DIM1, ix1)
+-- import Data.Char (toUpper)
+-- import Numeric.LinearAlgebra (ident)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+
+-- import Prelude hiding (concat, lookup, readFile, writeFile)
+
+import Hkl
+
+published ∷ FilePath
+published = "/nfs/ruche-diffabs/diffabs-soleil/com-diffabs/Reguer/USERSexperiences/melle"
+
+-- | TODO
+
+-- | MELLE / VIALAS
+-- Session 1 MACRO - 16-17 février 2016 (Logbook n° 42 p 169)
+-- Session 2 MICRO KB --28 mars 2016 (Logbook 42 + Logbook 43 p3)
+-- Session 3 MICRO pinhole - 22-24 juillet 2016 (Logbook 44 p33)
+-- Session 4 MACRO - septembre 2016 (Logbook 44 p63)
+
+-- | Session 1
+
+-- macrofaisceau
+-- 16keV
+-- Λ = 0,775
+-- detection : XPAD S140 / image = data 54
+-- sample : ω = 5 et χ = 70
+
+-- calibration = beam direct
+
+-- - 3 MESH pour 3 positions du détecteur de diffraction (delta = -4, 3, 10),
+
+-- macro python:
+-- for i in range (10):
+-- myx = -12+i*0,5
+-- mv(samplex, myx)
+-- ascan(sampley, -8, 12, 100, 10)
+
+-- scan_26 à 55.nxs
+-- diffabs-soleil/com-diffabs/2016/Run1/2016-02-16 ou 02-17
+
+-- 2THETA = 1 DELTA SCAN
+-- scan_56 = ascan(delta, -4, 70, 18, 3)
+-- scan_58 = ascan(delta, -4, 70, 18, 3)
+
+
+-- | Session 2
+
+-- microbeam
+-- 18keV, ?= 0,6888Å
+-- detection : XPAD 3.2 / image = data 58
+-- sample : ? = 5° et ? = 80°.
+-- calibration CeO2
+-- data dans le dossier du proposal de Philippe Charlier 2015 1386
+-- voir aussi script Martinetto proposal IHR 99160066
+-- scan_25 = ascan(delta, -14.5, 60.5, 75, 0.5)
+-- scan_26 = ascan(delta, -14, 60, 75, 1)
+-- scan_27 = ascan(delta, -14, 60, 46, 1)
+
+-- MESH : MELLE_29.nxs
+-- dossier: diffabs-soleil/com-diffabs/2016/Run2/2016-03-28
+
+-- calibration
+
+project2 :: FilePath
+project2 = "/nfs/ruche-diffabs/diffabs-users/99160066/"
+
+published2:: FilePath
+published2 = project2 </> "published-data"
+
+h5path2 :: NxEntry -> DataFrameH5Path XrdOneD
+h5path2 nxentry =
+ XrdOneDH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) ExtendDims)
+ (DataItemH5 (nxentry </> delta) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_53"
+ gamma = "d13-1-cx1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "scan_data/actuator_1_1"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+sampleCalibration2 :: XRDCalibration Xpad32
+sampleCalibration2 = XRDCalibration { xrdCalibrationName = "calibration2"
+ , xrdCalibrationOutputDir = published </> "calibration2"
+ , xrdCalibrationDetector = Xpad32
+ , xrdCalibrationCalibrant = CeO2
+ , xrdCalibrationEntries = entries
+ }
+ where
+ idxs :: [Int]
+ idxs = [3, 6, 9, 15, 18, 21, 24, 27, 30, 33, 36, 39, 43]
+
+ entry :: Int -> XRDCalibrationEntry
+ entry idx = XRDCalibrationEntryNxs
+ { xrdCalibrationEntryNxs'Nxs = mkNxs (published2 </> "calibration" </> "XRD18keV_26.nxs") "scan_26" h5path2
+ , xrdCalibrationEntryNxs'Idx = idx
+ , xrdCalibrationEntryNxs'NptPath = published2 </> "calibration" </> printf "XRD18keV_26.nxs_%02d.npt" idx
+ }
+
+ entries :: [XRDCalibrationEntry]
+ entries = [ entry idx | idx <- idxs]
+
+sampleRef2 :: XRDRef
+sampleRef2 = XRDRef "reference"
+ (published2 </> "calibration")
+ (XrdRefNxs
+ (mkNxs (published2 </> "calibration" </> "XRD18keV_26.nxs") "scan_26" h5path2)
+ 6 -- BEWARE only the 6th poni was generated with the right Xpad_flat geometry.
+ )
+
+bins :: DIM1
+bins = ix1 8000
+
+multibins :: DIM1
+multibins = ix1 25000
+
+threshold :: Maybe Threshold
+threshold = Just (Threshold 800)
+
+skipedFrames :: [Int]
+skipedFrames = []
+
+melleScan :: XRDSample
+melleScan = XRDSample "CeO2"
+ (published </> "xrd" </> "session2" </> "oned")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run2" </> "2016-03-23" </> "XRD18keV_25.nxs") "scan_25" h5path2
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-23" </> "XRD18keV_26.nxs") "scan_26" h5path2
+ , mkNxs (project </> "2016" </> "Run2" </> "2016-03-23" </> "XRD18keV_27.nxs") "scan_27" h5path2
+ ]
+ ]
+ where
+ project ∷ FilePath
+ project = "/nfs/ruche-diffabs/diffabs-users/20151386/"
+
+
+melleMesh :: XrdMeshSample
+melleMesh = XrdMeshSample "MELLE_29"
+ (published </> "xrd" </> "session2" </> "mesh")
+ [ XrdMesh bins multibins threshold (XrdMeshSourceNxs n) | n <-
+ [ mkNxs (project2' </> "2016" </> "Run2" </> "2016-03-28" </> "MELLE_29.nxs") "scan_29" h5path2'
+ ]
+ ]
+ where
+ project2' :: FilePath
+ project2' = "/nfs/ruche-diffabs/diffabs-users/99160066/"
+
+ h5path2' :: NxEntry -> DataFrameH5Path XrdMesh
+ h5path2' nxentry =
+ XrdMeshH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> meshX) StrictDims)
+ (DataItemH5 (nxentry </> meshY) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> delta) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_58"
+ meshX = "scan_data/actuator_1_1"
+ meshY = "scan_data/actuator_2_1"
+ gamma = "D13-1-CX1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "D13-1-CX1__EX__DIF.1-DELTA__#1/raw_value"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+
+session2 :: IO ()
+session2 = do
+ -- compute the ref poni
+ p ← getPoniExtRef sampleRef2
+ poniextref <- calibrate sampleCalibration2 p
+
+ -- integrate the mesh
+ let mflat = Nothing
+ integrateMesh (XrdMeshParams poniextref mflat CsrOcl) [melleMesh]
+
+ -- integrate the scan parts
+ let params = XrdOneDParams poniextref mflat Csr
+ integrate params [melleScan]
+ integrateMulti params [melleScan]
+
+ return ()
+
+-- | session 4
+-- macro
+-- 18keV, ?= 0,6888Å
+-- detection : XPAD 3.2
+
+session4 ∷ IO ()
+session4 = do
+ -- calibration
+ p ← getPoniExtRef sampleRef
+ poniextref <- calibrate sampleCalibration p
+
+-- calibration : CeO2
+-- On peut utiliser la calib de IHR_30, mais il faut prendre en compte le décentrage.
+-- IHR_56
+-- IHR_58
+-- sont deux autres possibilité de calibration.
+-- diffabs-soleil\com-diffabs\2016\Run4\2016-09-07
+
+ -- | set the integration parameters
+ let mflat = Nothing
+ let params = XrdOneDParams poniextref mflat Csr
+
+ -- integrate each step of the scan
+ integrate params [ceo2]
+
+-- 1 seul "MESH"(20, 49) à partir d'une serie 2THETA
+-- IHR_63 à 95
+-- diffabs-soleil\com-diffabs\2016\Run4\2016-09-07
+-- IHR_96 à 190
+-- diffabs-soleil\com-diffabs\2016\Run4\2016-09-08
+-- obtenu via la macro suivante.
+-- for i in range(20):
+-- myx = -11 + i
+-- mv(txs, myx) # exhantillon à 45 degree donc ce double déplacement correspond au vrai x
+-- mv(tys, myx)
+-- for j in range(29):
+-- myy = 12 + j
+-- mv(tabV, myy)
+-- ascan(δ, -13.6, 30, 109, 5)
+
+ return ()
+
+ where
+
+ project :: FilePath
+ project = "/nfs/ruche-diffabs/diffabs-soleil/com-diffabs/"
+
+ published' :: FilePath
+ published' = project </> "2016" </> "Run4B" </> "OutilsMetallo_CarolineHamon"
+
+ sampleRef :: XRDRef
+ sampleRef = XRDRef "reference"
+ (published' </> "xrd" </> "calibration")
+ (XrdRefNxs
+ (mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_30.nxs") "scan_30" h5path')
+ 33
+ )
+
+ h5path' :: NxEntry -> DataFrameH5Path XrdOneD
+ h5path' nxentry =
+ XrdOneDH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemH5 (nxentry </> beamline </> gamma) ExtendDims)
+ (DataItemH5 (nxentry </> delta) ExtendDims)
+ (DataItemH5 (nxentry </> beamline </> wavelength) StrictDims)
+ where
+ beamline :: String
+ beamline = beamlineUpper Diffabs
+
+ image = "scan_data/data_02"
+ gamma = "D13-1-CX1__EX__DIF.1-GAMMA__#1/raw_value"
+ delta = "scan_data/actuator_1_1"
+ wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+ sampleCalibration :: XRDCalibration Xpad32
+ sampleCalibration = XRDCalibration { xrdCalibrationName = "calibration"
+ , xrdCalibrationOutputDir = published' </> "xrd" </> "calibration" -- TODO pourquoi ce output
+ , xrdCalibrationDetector = Xpad32
+ , xrdCalibrationCalibrant = CeO2
+ , xrdCalibrationEntries = entries
+ }
+ where
+
+ idxs :: [Int]
+ idxs = [5, 33, 100, 246, 300, 436]
+
+ entry :: Int -> XRDCalibrationEntry
+ entry idx = XRDCalibrationEntryNxs
+ { xrdCalibrationEntryNxs'Nxs = mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_30.nxs") "scan_30" h5path'
+ , xrdCalibrationEntryNxs'Idx = idx
+ , xrdCalibrationEntryNxs'NptPath = published' </> "xrd" </> "calibration" </> printf "IHR_30.nxs_%02d.npt" idx
+ }
+
+ entries :: [XRDCalibrationEntry]
+ entries = [ entry idx | idx <- idxs]
+
+ bins :: DIM1
+ bins = ix1 1000
+
+ multibins :: DIM1
+ multibins = ix1 10000
+
+ threshold :: Maybe Threshold
+ threshold = Just (Threshold 5000)
+
+ skipedFrames :: [Int]
+ skipedFrames = []
+
+ ceo2 :: XRDSample
+ ceo2 = XRDSample "CeO2"
+ (published </> "session4" </> "xrd" </> "CeO2")
+ [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+ [ mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_29.nxs") "scan_29" h5path'
+ , mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_30.nxs") "scan_30" h5path'
+ , mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_56.nxs") "scan_56" h5path'
+ , mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_58.nxs") "scan_58" h5path'
+ ]
+ ]
+
+-- ** session 5
+-- micro
+-- 18.05keV
+-- detection XPAD S140
+
+-- calibration CeO2
+-- gam = 9 phi = 170
+-- 18p1kev_71
+-- gam = 9 phi = 175
+-- 18p1kev_73
+-- gam = 0 phi = 205
+-- 18p1kev_74
+-- gam = 0.3 phi = 205
+-- 18p1kev_75
+-- ruche-diffabs\diffabs-users\99170085\2017\Run3\2017-05-14
+
+-- FLAT (à verifier si suffisant) (faire la somme des trois fichiers)
+-- 18p1kev_82
+-- 18p1kev_83
+-- 18p1kev_84
+-- ruche-diffabs\diffabs-users\99170085\2017\Run3\2017-05-14
+
+-- FLY -- ????
+-- flyscan_16602
+-- diffabs-soleil\com-diffabs\2017\Run3\fly_IHRSol
+
+-- 2THETA = 1 DELTA SCAN
+-- 18p1kev_85
+-- 18p1kev_86
+-- ruche-diffabs\diffabs-users\99170085\2017\Run3\2017-05-14
+
+-- | Samples
+
+-- published :: FilePath
+-- published = project </> "published-data"
+
+-- beamlineUpper :: Beamline -> String
+-- beamlineUpper b = [Data.Char.toUpper x | x <- show b]
+
+-- nxs :: FilePath -> NxEntry -> (NxEntry -> DataFrameH5Path) -> Nxs
+-- nxs f e h = Nxs f e (h e)
+
+-- nxs' :: FilePath -> NxEntry -> (NxEntry -> a) -> Nxs' a
+-- nxs' f e h = Nxs' f e (h e)
+
+-- h5path :: NxEntry -> DataFrameH5Path
+-- h5path nxentry =
+-- DataFrameH5Path { h5pImage = DataItem (nxentry </> image) StrictDims
+-- , h5pGamma = DataItem (nxentry </> beamline </> gamma) ExtendDims
+-- , h5pDelta = DataItem (nxentry </> delta) ExtendDims
+-- , h5pWavelength = DataItem (nxentry </> beamline </> wavelength) StrictDims
+-- }
+-- where
+-- beamline :: String
+-- beamline = beamlineUpper Diffabs
+
+-- image = "scan_data/data_53"
+-- gamma = "d13-1-cx1__EX__DIF.1-GAMMA__#1/raw_value"
+-- delta = "scan_data/actuator_1_1"
+-- wavelength = "D13-1-C03__OP__MONO__#1/wavelength"
+
+-- sampleCalibration :: XRDCalibration
+-- sampleCalibration = XRDCalibration { xrdCalibrationName = "calibration"
+-- , xrdCalibrationOutputDir = published </> "calibration"
+-- , xrdCalibrationEntries = entries
+-- }
+-- where
+
+-- idxs :: [Int]
+-- idxs = [3, 6, 9, 15, 18, 21, 24, 27, 30, 33, 36, 39, 43]
+
+-- entry :: Int -> XRDCalibrationEntry
+-- entry idx = XRDCalibrationEntryNxs
+-- { xrdCalibrationEntryNxs'Nxs = nxs (published </> "calibration" </> "XRD18keV_26.nxs") "scan_26" h5path
+-- , xrdCalibrationEntryNxs'Idx = idx
+-- , xrdCalibrationEntryNxs'NptPath = published </> "calibration" </> printf "XRD18keV_26.nxs_%02d.npt" idx
+-- }
+
+-- entries :: [XRDCalibrationEntry]
+-- entries = [ entry idx | idx <- idxs]
+
+
+-- sampleRef :: XRDRef
+-- sampleRef = XRDRef "reference"
+-- (published </> "calibration")
+-- (nxs (published </> "calibration" </> "XRD18keV_26.nxs") "scan_26" h5path)
+-- 6 -- BEWARE only the 6th poni was generated with the right Xpad_flat geometry.
+
+-- bins :: DIM1
+-- bins = ix1 8000
+
+-- multibins :: DIM1
+-- multibins = ix1 25000
+
+-- threshold :: Threshold
+-- threshold = Threshold 800
+
+
+-- p <- getPoniExtRef sampleRef
+
+-- -- flip the ref poni in order to fit the reality
+-- -- let poniextref = p
+-- let poniextref = setPose p (MyMatrix HklB (ident 3))
+-- -- let poniextref = setPose (Hkl.PyFAI.PoniExt.flip p) (MyMatrix HklB (ident 3))
+
+-- -- full calibration
+-- poniextref' <- calibrate sampleCalibration poniextref Xpad32
+-- -- print p
+-- print poniextref
+-- print poniextref'
+
+-- -- integrate each step of the scan
+-- _ <- mapM_ (integrateMesh poniextref') samples
+
+-- return ()
+
+melle ∷ IO ()
+melle = do
+ session2
+ session4
diff --git a/contrib/haskell/src/Hkl/Projects/Mars.hs b/contrib/haskell/src/Hkl/Projects/Mars.hs
new file mode 100644
index 0000000..75b46d6
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Mars.hs
@@ -0,0 +1,4 @@
+module Hkl.Projects.Mars (module X) where
+
+import Hkl.Projects.Mars.Schlegel as X
+import Hkl.Projects.Mars.Romeden as X
diff --git a/contrib/haskell/src/Hkl/Projects/Mars/Romeden.hs b/contrib/haskell/src/Hkl/Projects/Mars/Romeden.hs
new file mode 100644
index 0000000..f89589d
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Mars/Romeden.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Projects.Mars.Romeden
+ ( romeden ) where
+
+import Codec.Picture ( saveTiffImage )
+import Control.Arrow ( (&&&) )
+import System.FilePath ((</>))
+import System.FilePath.Glob ( compile, globDir1 )
+
+import Prelude hiding (concat, lookup, readFile, writeFile)
+
+import Hkl
+
+-- | TODO
+-- ne pas planter lorsque l'image est manquante dans une nx entry.
+
+project ∷ FilePath
+-- project = "/nfs/ruche-mars/mars-soleil/com-mars/2017_Run2/comisioning_microfaisceau"
+-- project = "/home/experiences/instrumentation/picca"
+project = "/media/picca/Transcend/ROMEDENNE"
+
+h5path ∷ NxEntry → DataFrameH5Path XrdFlat
+h5path nxentry =
+ XrdFlatH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ where
+ image ∷ H5Path
+ image = "image#0/data"
+
+saveAsTiff' ∷ (Nxs XrdFlat, FilePath) → IO ()
+saveAsTiff' (n, o) = saveTiffImage o =<< toTiff n
+
+saveAsTiff ∷ (NxEntry -> DataFrameH5Path XrdFlat) → FilePath → IO ()
+saveAsTiff h5path' n = mapM_ (saveAsTiff' . (nxs &&& out)) =<< nxEntries n
+ where
+ nxs ∷ FilePath → Nxs XrdFlat
+ nxs nx = mkNxs (project </> n) nx h5path'
+
+ out ∷ FilePath → FilePath
+ out nx = (project </> n) ++ nx ++ ".tiff"
+
+-- | Main
+
+romeden ∷ IO ()
+romeden = mapM_ (saveAsTiff h5path) =<< globDir1 (compile "*.nxs") project
diff --git a/contrib/haskell/src/Hkl/Projects/Mars/Schlegel.hs b/contrib/haskell/src/Hkl/Projects/Mars/Schlegel.hs
new file mode 100644
index 0000000..6ada48a
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Mars/Schlegel.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Projects.Mars.Schlegel
+ ( schlegel ) where
+
+import Numeric.LinearAlgebra (ident)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+
+import Prelude hiding (concat, lookup, readFile, writeFile)
+
+import Hkl
+
+-- | TODO
+-- * check if the
+-- * find a way to use integrateMulti with a small amount of memory.
+-- * better mask for each detector.
+
+-- | Samples
+
+project :: FilePath
+project = "/nfs/share-temp/picca/20160800"
+
+published :: FilePath
+published = project </> "published-data"
+
+h5path :: NxEntry -> DataFrameH5Path XrdZeroD
+h5path nxentry =
+ XrdZeroDH5Path
+ (DataItemH5 (nxentry </> image) StrictDims)
+ (DataItemConst 0.0485945)
+ where
+ image ∷ H5Path
+ image = "scan_data/data_01"
+
+sampleCalibration ∷ XrdZeroDCalibration Xpad32
+sampleCalibration = XrdZeroDCalibration (XrdZeroDSample name outputdir entries) Xpad32 LaB6
+ where
+ name ∷ String
+ name = "lab6"
+
+ outputdir ∷ AbsDirPath
+ outputdir = published </> "xrd" </> "calibration"
+
+ entries :: [XrdZeroDSource]
+ entries = [ XrdZeroDSourceNxs $
+ mkNxs (project </> "2017" </> "Run3" </> "scan_5_01.nxs") "_5" h5path
+ ]
+
+
+-- bins :: DIM1
+-- bins = ix1 1000
+
+-- multibins :: DIM1
+-- multibins = ix1 10000
+
+-- threshold :: Maybe Threshold
+-- threshold = Just (Threshold 5000)
+
+-- skipedFrames :: [Int]
+-- skipedFrames = []
+
+-- ceo2 :: XRDSample
+-- ceo2 = XRDSample "CeO2"
+-- (published </> "xrd" </> "CeO2")
+-- [ XrdNxs bins multibins threshold skipedFrames (XrdSourceNxs n) | n <-
+-- [ mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_29.nxs") "scan_29" h5path'
+-- , mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_30.nxs") "scan_30" h5path'
+-- , mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_56.nxs") "scan_56" h5path'
+-- , mkNxs (project </> "2016" </> "Run4" </> "2016-09-07" </> "IHR_58.nxs") "scan_58" h5path'
+-- ]
+-- ]
+
+-- | Main
+
+schlegel :: IO ()
+schlegel = do
+ -- | pre-calibrate (extract from nexus to edf in order to do the
+ -- calibration)
+ extractEdf sampleCalibration
+
+ -- p <- getPoniExtRef sampleRef
+
+ -- let poniextref = move p (Pose (MyMatrix HklB (ident 3)))
+
+ -- -- full calibration
+ -- poniextref' <- calibrate sampleCalibration poniextref
+
+ -- print poniextref
+ -- print poniextref'
+
+ -- -- Integrate the flyscan mesh
+ -- -- 4.680504680504681e-3 per images (2*60+18) / 29484 this contain
+ -- -- read/write and computation
+ -- -- integrateMesh (XrdMeshParams poniextref' mflat method) [fly]
+
+ -- -- | set the integration parameters
+ -- let mflat = Nothing
+ -- let aiMethod = Csr
+ -- let params = XrdOneDParams poniextref' mflat aiMethod
+
+ -- -- integrate each step of the scan
+ -- integrate params [ceo2]
+
+ -- -- this code doesn not work because there is not enought memory on
+ -- -- the computer.
+ -- -- integrateMulti params [ceo2]
+
+ return ()
diff --git a/contrib/haskell/src/Hkl/Projects/Sixs.hs b/contrib/haskell/src/Hkl/Projects/Sixs.hs
new file mode 100644
index 0000000..1c6cdb5
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Projects/Sixs.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+module Hkl.Projects.Sixs
+ ( main_sixs )
+ where
+
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>), (<*>))
+#endif
+
+import Data.ByteString.Char8 (pack)
+import Data.Vector.Storable (concat, head)
+import Control.Exception (bracket)
+import Control.Monad (forM_)
+import Numeric.LinearAlgebra (Matrix)
+import Numeric.Units.Dimensional.Prelude (meter, nano, (*~))
+import Pipes (Producer, runEffect, (>->), lift, yield)
+import Pipes.Prelude (print)
+import System.FilePath.Posix ((</>))
+
+import Hkl ( DataItem ( DataItemH5 )
+ , Dataset
+ , ExtendDims ( ExtendDims, StrictDims )
+ , Factory(Uhv)
+ , File
+ , Geometry(Geometry)
+ , H5
+ , Source(Source)
+ , check_ndims
+ , closeDataset
+ , get_position
+ , get_ub
+ , lenH5Dataspace
+ , openDataset
+ , withH5File
+ )
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
+data DataFrameHklH5Path
+ = DataFrameHklH5Path
+ (DataItem H5) -- Image
+ (DataItem H5) -- Mu
+ (DataItem H5) -- Omega
+ (DataItem H5) -- delta
+ (DataItem H5) -- gamma
+ (DataItem H5) -- UB
+ (DataItem H5) -- Wavelength
+ (DataItem H5) -- DiffractometerType
+ deriving (Show)
+
+data DataFrameHklH5
+ = DataFrameHklH5
+ Dataset -- image
+ Dataset -- mu
+ Dataset -- omega
+ Dataset -- delta
+ Dataset -- gamma
+ Dataset -- ub
+ Dataset -- wavelength
+ Dataset -- dtype
+
+data DataFrame
+ = DataFrame
+ Int -- n
+ Geometry -- geometry
+ (Matrix Double) -- ub
+ deriving (Show)
+
+withDataframeH5 :: File -> DataFrameHklH5Path -> (DataFrameHklH5 -> IO r) -> IO r
+withDataframeH5 h5file dfp = bracket (hkl_h5_open h5file dfp) hkl_h5_close
+
+hkl_h5_open :: File -> DataFrameHklH5Path -> IO DataFrameHklH5
+hkl_h5_open h5file (DataFrameHklH5Path i m o d g u w t) = DataFrameHklH5
+ <$> openDataset' h5file i
+ <*> openDataset' h5file m
+ <*> openDataset' h5file o
+ <*> openDataset' h5file d
+ <*> openDataset' h5file g
+ <*> openDataset' h5file u
+ <*> openDataset' h5file w
+ <*> openDataset' h5file t
+ where
+ openDataset' :: File -> DataItem H5 -> IO Dataset
+ openDataset' hid (DataItemH5 name _) = openDataset hid (pack name) Nothing
+
+hkl_h5_is_valid :: DataFrameHklH5 -> IO Bool
+hkl_h5_is_valid (DataFrameHklH5 _ m o d g _ _ _) = do
+ True <- check_ndims m 1
+ True <- check_ndims o 1
+ True <- check_ndims d 1
+ True <- check_ndims g 1
+ return True
+
+hkl_h5_close :: DataFrameHklH5 -> IO ()
+hkl_h5_close (DataFrameHklH5 i m o d g u w t) = do
+ closeDataset i
+ closeDataset m
+ closeDataset o
+ closeDataset d
+ closeDataset g
+ closeDataset u
+ closeDataset w
+ closeDataset t
+
+getDataFrame' :: DataFrameHklH5 -> Int -> IO DataFrame
+getDataFrame' (DataFrameHklH5 _ m o d g u w _) i = do
+ mu <- get_position m i
+ omega <- get_position o i
+ delta <- get_position d i
+ gamma <- get_position g i
+ wavelength <- get_position w 0
+ ub <- get_ub u
+ let positions = Data.Vector.Storable.concat [mu, omega, delta, gamma]
+ let source = Source (Data.Vector.Storable.head wavelength *~ nano meter)
+ return $ DataFrame i (Geometry Uhv source positions Nothing) ub
+
+getDataFrame :: DataFrameHklH5 -> Producer DataFrame IO ()
+getDataFrame d@(DataFrameHklH5 _ m _ _ _ _ _ _) = do
+ (Just n) <- lift $ lenH5Dataspace m
+ forM_ [0..n-1] (\i -> lift (getDataFrame' d i) >>= yield)
+
+main_sixs :: IO ()
+main_sixs = do
+ let root = "/nfs/ruche-sixs/sixs-soleil/com-sixs/2015/Shutdown4-5/XpadAu111/"
+ let filename = "align_FLY2_omega_00045.nxs"
+ let dataframe_h5p = DataFrameHklH5Path
+ (DataItemH5 "com_113934/scan_data/xpad_image" StrictDims)
+ (DataItemH5 "com_113934/scan_data/UHV_MU" ExtendDims)
+ (DataItemH5 "com_113934/scan_data/UHV_OMEGA" ExtendDims)
+ (DataItemH5 "com_113934/scan_data/UHV_DELTA" ExtendDims)
+ (DataItemH5 "com_113934/scan_data/UHV_GAMMA" ExtendDims)
+ (DataItemH5 "com_113934/SIXS/I14-C-CX2__EX__DIFF-UHV__#1/UB" StrictDims)
+ (DataItemH5 "com_113934/SIXS/Monochromator/wavelength" StrictDims)
+ (DataItemH5 "com_113934/SIXS/I14-C-CX2__EX__DIFF-UHV__#1/type" StrictDims)
+
+ withH5File (root </> filename) $ \h5file ->
+ withDataframeH5 h5file dataframe_h5p $ \dataframe_h5 -> do
+ True <- hkl_h5_is_valid dataframe_h5
+ runEffect $ getDataFrame dataframe_h5
+ >-> Pipes.Prelude.print
diff --git a/contrib/haskell/src/Hkl/PyFAI.hs b/contrib/haskell/src/Hkl/PyFAI.hs
new file mode 100644
index 0000000..eeed0e9
--- /dev/null
+++ b/contrib/haskell/src/Hkl/PyFAI.hs
@@ -0,0 +1,9 @@
+module Hkl.PyFAI (module X) where
+
+import Hkl.PyFAI.AzimuthalIntegrator as X
+import Hkl.PyFAI.Calib as X
+import Hkl.PyFAI.Calibrant as X
+import Hkl.PyFAI.Detector as X
+import Hkl.PyFAI.Poni as X
+import Hkl.PyFAI.PoniExt as X
+import Hkl.PyFAI.Npt as X
diff --git a/contrib/haskell/src/Hkl/PyFAI/AzimuthalIntegrator.hs b/contrib/haskell/src/Hkl/PyFAI/AzimuthalIntegrator.hs
new file mode 100644
index 0000000..e29df7d
--- /dev/null
+++ b/contrib/haskell/src/Hkl/PyFAI/AzimuthalIntegrator.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.PyFAI.AzimuthalIntegrator
+ ( AIMethod(..)
+ ) where
+
+data AIMethod = Numpy | Cython | SplitPixel | Lut | Csr | NoSplitCsr | FullCsr | LutOcl | CsrOcl
+
+instance Show AIMethod where
+ show Numpy = "numpy"
+ show Cython = "cython"
+ show SplitPixel = "splitpixel"
+ show Lut = "lut"
+ show Csr = "csr"
+ show NoSplitCsr = "nosplit_csr"
+ show FullCsr = "full_csr"
+ show LutOcl = "lut_ocl"
+ show CsrOcl = "csr_ocl"
diff --git a/contrib/haskell/src/Hkl/PyFAI/Calib.hs b/contrib/haskell/src/Hkl/PyFAI/Calib.hs
new file mode 100644
index 0000000..1c41a09
--- /dev/null
+++ b/contrib/haskell/src/Hkl/PyFAI/Calib.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.PyFAI.Calib
+ ( ToPyFAICalibArg(..) ) where
+
+import Data.Text (unpack)
+import Numeric.Units.Dimensional.Prelude ((/~), nano, meter)
+
+import Hkl.Types ( WaveLength )
+import Hkl.Detector ( Detector )
+import Hkl.PyFAI.Calibrant ( Calibrant )
+import Hkl.PyFAI.Detector ( toPyFAI )
+
+class ToPyFAICalibArg a where
+ toPyFAICalibArg ∷ a → String
+
+instance ToPyFAICalibArg FilePath where
+ toPyFAICalibArg f = f
+
+instance ToPyFAICalibArg (Detector a) where
+ toPyFAICalibArg d = "-D" ++ unpack (toPyFAI d)
+
+instance ToPyFAICalibArg Calibrant where
+ toPyFAICalibArg c = "-c " ++ show c
+
+instance ToPyFAICalibArg WaveLength where
+ toPyFAICalibArg w = "-w " ++ show ((w /~ nano meter) * 10)
diff --git a/contrib/haskell/src/Hkl/PyFAI/Calibrant.hs b/contrib/haskell/src/Hkl/PyFAI/Calibrant.hs
new file mode 100644
index 0000000..f6bd110
--- /dev/null
+++ b/contrib/haskell/src/Hkl/PyFAI/Calibrant.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.PyFAI.Calibrant
+ ( Calibrant(..) ) where
+
+data Calibrant = CeO2 | LaB6
+
+instance Show Calibrant where
+ show CeO2 = "CeO2"
+ show LaB6 = "LaB6"
diff --git a/contrib/haskell/src/Hkl/PyFAI/Detector.hs b/contrib/haskell/src/Hkl/PyFAI/Detector.hs
new file mode 100644
index 0000000..9c7e172
--- /dev/null
+++ b/contrib/haskell/src/Hkl/PyFAI/Detector.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.PyFAI.Detector
+ ( ToPyFAI(..)
+ ) where
+
+import Data.Text (Text)
+
+import Hkl.Detector ( Detector ( Xpad32, ImXpadS140, ZeroD ) )
+
+class ToPyFAI a where
+ toPyFAI ∷ a → Text
+
+instance ToPyFAI (Detector a) where
+ toPyFAI Xpad32 = "Xpad_flat"
+ toPyFAI ImXpadS140 = "imxpad_s140"
+ toPyFAI ZeroD = error "Unsupported Detector"
diff --git a/contrib/haskell/src/Hkl/PyFAI/Npt.hs b/contrib/haskell/src/Hkl/PyFAI/Npt.hs
new file mode 100644
index 0000000..a7567cf
--- /dev/null
+++ b/contrib/haskell/src/Hkl/PyFAI/Npt.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hkl.PyFAI.Npt
+ ( Npt(..)
+ , NptEntry(..)
+ , NptPoint(..)
+ , nptP
+ , nptFromFile
+ ) where
+
+import Control.Applicative
+import Data.Attoparsec.Text
+import Data.Text
+import Data.Text.IO (readFile)
+import Numeric.Units.Dimensional.Prelude (Angle, Length, (*~), meter, radian)
+
+type Calibrant = Text
+
+data NptPoint = NptPoint { nptPointX :: Double
+ , nptPointY :: Double
+ }
+ deriving (Show)
+
+data NptEntry = NptEntry { nptEntryId :: Int
+ , nptEntryTth :: Angle Double
+ , nptEntryRing :: Int
+ , nptPoints :: [NptPoint]
+ }
+ deriving (Show)
+
+data Npt = Npt { nptComment :: [Text]
+ , nptCalibrant :: Calibrant
+ , nptWavelength :: Length Double
+ , npdDSpacing :: [Length Double]
+ , nptEntries :: [NptEntry]
+ }
+ deriving (Show)
+
+commentP :: Parser Text
+commentP = "#" *> takeTill isEndOfLine <* endOfLine <?> "commentP"
+
+headerP :: Parser [Text]
+headerP = many1 commentP <?> "headerP"
+
+calibrantP :: Parser Text
+calibrantP = "calibrant: " *> takeTill isEndOfLine <* endOfLine <?> "calibrantP"
+
+dspacingP :: Parser [Length Double]
+dspacingP = "dspacing:" *> many1 lengthP' <* endOfLine <?> "dspasingP"
+
+doubleP :: Text -> Parser Double
+doubleP key = string key *> double <* endOfLine <?> "doubleP"
+
+lengthP' :: Parser (Length Double)
+lengthP' = do
+ skipSpace
+ value <- double
+ pure $ value *~ meter
+
+lengthP :: Text -> Parser (Length Double)
+lengthP key = do
+ value <- doubleP key
+ pure $ value *~ meter
+
+angleP :: Text -> Parser (Angle Double)
+angleP key = do
+ value <-doubleP key
+ pure $ value *~ radian
+
+intP :: Text -> Parser Int
+intP key = string key *> decimal <* endOfLine <?> "intP"
+
+nptPointP :: Parser NptPoint
+nptPointP = NptPoint
+ <$> ("point: x=" *> double)
+ <*> (" y=" *> double <* endOfLine)
+
+nptEntryP :: Parser NptEntry
+nptEntryP = NptEntry
+ <$> (skipSpace *> intP "New group of points: ")
+ <*> angleP "2theta: "
+ <*> intP "ring: "
+ <*> many nptPointP
+
+nptP :: Parser Npt
+nptP = Npt
+ <$> headerP
+ <*> calibrantP
+ <*> lengthP "wavelength: "
+ <*> dspacingP
+ <*> many1 nptEntryP
+ <?> "nptP"
+
+nptFromFile :: FilePath -> IO Npt
+nptFromFile filename = do
+ content <- Data.Text.IO.readFile filename
+ return $ case parseOnly nptP content of
+ Left _ -> error $ "Can not parse the " ++ filename ++ " npt file"
+ Right a -> a
diff --git a/contrib/haskell/src/Hkl/PyFAI/Poni.hs b/contrib/haskell/src/Hkl/PyFAI/Poni.hs
new file mode 100644
index 0000000..f8ec7eb
--- /dev/null
+++ b/contrib/haskell/src/Hkl/PyFAI/Poni.hs
@@ -0,0 +1,257 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.PyFAI.Poni
+ ( Pose(..)
+ -- Poni
+ , Poni
+ , PoniPath
+ , poniP
+ , poniToText
+ -- PoniEntry
+ , PoniEntry
+ , poniEntryFlip
+ , poniEntryFromList
+ , poniEntryRotation
+ , poniEntryTranslation
+ , poniEntryToList
+ , poniEntrySet
+ , poniEntryMove
+ -- other
+ , fromAxisAndAngle
+ ) where
+
+import Control.Applicative ((<$>), (<|>), (<*>), (*>), (<*), many, optional, pure)
+import Data.Attoparsec.Text (Parser, (<?>), endOfLine, isEndOfLine, many1, double, string, takeTill)
+import Data.Text (Text, append, intercalate, pack)
+import Data.Vector.Storable (Vector, fromList)
+import Numeric.LinearAlgebra (Matrix, (<>), atIndex, fromLists, ident, scalar)
+import Numeric.Units.Dimensional.Prelude (Angle, Length, (+), (*~), (/~), (/~~), one, meter, radian, degree)
+
+import Hkl.Detector
+import Hkl.MyMatrix
+import Hkl.PyFAI.Detector
+import Hkl.Types
+
+#if !MIN_VERSION_hmatrix(0, 17, 0)
+import Numeric.LinearAlgebra (trans)
+tr:: Matrix t -> Matrix t
+tr = trans
+#else
+import Numeric.LinearAlgebra (tr)
+#endif
+
+type PoniPath = FilePath
+
+-- | Pose
+
+data Pose = Pose (MyMatrix Double) deriving (Show)
+
+-- | ADetector
+
+data ADetector = forall a. ADetector (Detector a)
+
+instance Show ADetector where
+ show (ADetector v) = show v
+
+instance ToPyFAI ADetector where
+ toPyFAI (ADetector v) = toPyFAI v
+
+-- | Poni
+
+data PoniEntry = PoniEntry { poniEntryHeader :: [Text]
+ , poniEntryDetector :: (Maybe ADetector) -- ^ Detector Name
+ , poniEntryPixelSize1 :: (Length Double) -- ^ pixels size 1
+ , poniEntryPixelSize2 :: (Length Double) -- ^ pixels size 1
+ , poniEntryDistance :: (Length Double) -- ^ pixels size 2
+ , poniEntryPoni1 :: (Length Double) -- ^ poni1
+ , poniEntryPoni2 :: (Length Double) -- ^ poni2
+ , poniEntryRot1 :: (Angle Double) -- ^ rot1
+ , poniEntryRot2 :: (Angle Double) -- ^ rot2
+ , poniEntryRot3 :: (Angle Double) -- ^ rot3
+ , poniEntrySpline :: (Maybe Text) -- ^ spline file
+ , poniEntryWavelength :: WaveLength -- ^ wavelength
+ }
+ deriving (Show)
+
+type Poni = [PoniEntry]
+
+class ToPoni a where
+ toPoni ∷ a → Text
+
+instance ToPoni ADetector where
+ toPoni (ADetector v) = toPyFAI v
+
+instance ToPoni Double where
+ toPoni v = pack $ show v
+
+instance ToPoni Text where
+ toPoni = id
+
+commentP :: Parser Text
+commentP = "#" *> takeTill isEndOfLine <* endOfLine <?> "commentP"
+
+headerP :: Parser [Text]
+headerP = many1 commentP <?> "headerP"
+
+doubleP :: Text -> Parser Double
+doubleP key = string key *> double <* endOfLine <?> "doubleP"
+
+lengthP :: Text -> Parser (Length Double)
+lengthP key = do
+ value <-doubleP key
+ pure $ value *~ meter
+
+angleP :: Text -> Parser (Angle Double)
+angleP key = do
+ value <-doubleP key
+ pure $ value *~ radian
+
+detectorP ∷ ToPyFAI a ⇒ a → Parser a
+detectorP d = do
+ _ ← "Detector: " *> string (toPyFAI d) <* endOfLine
+ pure d
+
+aDetectorP ∷ Parser ADetector
+aDetectorP = (ADetector <$> detectorP Xpad32) <|> (ADetector <$> detectorP ImXpadS140)
+
+poniEntryP :: Parser PoniEntry
+poniEntryP = PoniEntry
+ <$> headerP
+ <*> optional aDetectorP
+ <*> lengthP "PixelSize1: "
+ <*> lengthP "PixelSize2: "
+ <*> lengthP "Distance: "
+ <*> lengthP "Poni1: "
+ <*> lengthP "Poni2: "
+ <*> angleP "Rot1: "
+ <*> angleP "Rot2: "
+ <*> angleP "Rot3: "
+ <*> optional ("SplineFile: " *> takeTill isEndOfLine <* endOfLine)
+ <*> lengthP "Wavelength: "
+ <?> "poniEntryP"
+
+poniP :: Parser Poni
+poniP = many poniEntryP
+
+poniToText :: Poni -> Text
+poniToText p = Data.Text.intercalate (Data.Text.pack "\n") (map poniEntryToText p)
+
+poniEntryToText :: PoniEntry -> Text
+poniEntryToText p = intercalate (Data.Text.pack "\n") $
+ map (Data.Text.append "#") (poniEntryHeader p)
+ ++ maybe [] (poniLine "Detector: ") (poniEntryDetector p)
+ ++ poniLine "PixelSize1: " (poniEntryPixelSize1 p /~ meter)
+ ++ poniLine "PixelSize2: " (poniEntryPixelSize2 p /~ meter)
+ ++ poniLine "Distance: " (poniEntryDistance p /~ meter)
+ ++ poniLine "Poni1: " (poniEntryPoni1 p /~ meter)
+ ++ poniLine "Poni2: " (poniEntryPoni2 p /~ meter)
+ ++ poniLine "Rot1: " (poniEntryRot1 p /~ radian)
+ ++ poniLine "Rot2: " (poniEntryRot2 p /~ radian)
+ ++ poniLine "Rot3: " (poniEntryRot3 p /~ radian)
+ ++ maybe [] (poniLine "SplineFile: ") (poniEntrySpline p)
+ ++ poniLine "Wavelength: " (poniEntryWavelength p /~ meter)
+ where
+ poniLine :: ToPoni a ⇒ String → a → [Text]
+ poniLine key v = [Data.Text.append (Data.Text.pack key) (toPoni v)]
+
+crossprod :: Vector Double -> Matrix Double
+crossprod axis = fromLists [[ 0, -z, y],
+ [ z, 0, -x],
+ [-y, x, 0]]
+ where
+ x = axis `atIndex` 0
+ y = axis `atIndex` 1
+ z = axis `atIndex` 2
+
+fromAxisAndAngle :: Vector Double -> Angle Double -> Matrix Double
+fromAxisAndAngle axis angle = ident 3 Prelude.+ s * q Prelude.+ c * (q <> q)
+ where
+ c = scalar (1 - cos (angle /~ one))
+ s = scalar (sin (angle /~ one))
+ q = crossprod axis
+
+poniEntryFlip :: PoniEntry -> PoniEntry
+poniEntryFlip p = p { poniEntryRot3 = new_rot3 }
+ where
+ rot3 = poniEntryRot3 p
+ new_rot3 = rot3 Numeric.Units.Dimensional.Prelude.+ 180 *~ degree
+
+poniEntryRotation :: PoniEntry -> Matrix Double -- TODO MyMatrix PyFAIB
+poniEntryRotation e = Prelude.foldl (<>) (ident 3) rotations
+ where
+ rot1 = poniEntryRot1 e
+ rot2 = poniEntryRot2 e
+ rot3 = poniEntryRot3 e
+ rotations = Prelude.map (uncurry fromAxisAndAngle)
+ [ (fromList [0, 0, 1], rot3)
+ , (fromList [0, 1, 0], rot2)
+ , (fromList [1, 0, 0], rot1)]
+
+poniEntryTranslation :: PoniEntry -> Vector Double
+poniEntryTranslation e = fromList ( [ poniEntryPoni1 e
+ , poniEntryPoni2 e
+ , poniEntryDistance e
+ ] /~~ meter )
+
+poniEntryMove :: MyMatrix Double -> MyMatrix Double -> PoniEntry -> PoniEntry
+poniEntryMove mym1 mym2 e = e { poniEntryRot1 = new_rot1
+ , poniEntryRot2 = new_rot2
+ , poniEntryRot3 = new_rot3
+ }
+ where
+ rot1 = poniEntryRot1 e
+ rot2 = poniEntryRot2 e
+ rot3 = poniEntryRot3 e
+ rotations = Prelude.map (uncurry fromAxisAndAngle)
+ [ (Data.Vector.Storable.fromList [0, 0, 1], rot3)
+ , (Data.Vector.Storable.fromList [0, 1, 0], rot2)
+ , (Data.Vector.Storable.fromList [1, 0, 0], rot1)]
+ -- M1 . R0 = R1
+ r1 = Prelude.foldl (<>) (ident 3) rotations -- pyFAIB
+ -- M2 . R0 = R2
+ -- R2 = M2 . M1.T . R1
+ r2 = Prelude.foldl (<>) m2 [tr m1, r1]
+ (new_rot1, new_rot2, new_rot3) = toEulerians r2
+
+ (MyMatrix _ m1) = changeBase mym1 PyFAIB
+ (MyMatrix _ m2) = changeBase mym2 PyFAIB
+
+poniEntrySet ∷ (Length Double) -- ^ distance
+ → (Length Double) -- ^ poni1
+ → (Length Double) -- ^ poni2
+ → (Angle Double) -- ^ rot1
+ → (Angle Double) -- ^ rot2
+ → (Angle Double) -- ^ rot3
+ → PoniEntry
+ → PoniEntry
+poniEntrySet d p1 p2 r1 r2 r3 p =
+ p { poniEntryDistance = d
+ , poniEntryPoni1 = p1
+ , poniEntryPoni2 = p2
+ , poniEntryRot1 = r1
+ , poniEntryRot2 = r2
+ , poniEntryRot3 = r3
+ }
+
+poniEntryFromList :: PoniEntry -> [Double] -> PoniEntry
+poniEntryFromList p [rot1, rot2, rot3, poni1, poni2, d] =
+ p { poniEntryDistance = d *~ meter
+ , poniEntryPoni1 = poni1 *~ meter
+ , poniEntryPoni2 = poni2 *~ meter
+ , poniEntryRot1 = rot1 *~ radian
+ , poniEntryRot2 = rot2 *~ radian
+ , poniEntryRot3 = rot3 *~ radian
+ }
+poniEntryFromList _ _ = error "Can not convert to a PoniEntry"
+
+poniEntryToList :: PoniEntry -> [Double]
+poniEntryToList p = [ poniEntryRot1 p /~ radian
+ , poniEntryRot2 p /~ radian
+ , poniEntryRot3 p /~ radian
+ , poniEntryPoni1 p /~ meter
+ , poniEntryPoni2 p /~ meter
+ , poniEntryDistance p /~ meter
+ ]
diff --git a/contrib/haskell/src/Hkl/PyFAI/PoniExt.hs b/contrib/haskell/src/Hkl/PyFAI/PoniExt.hs
new file mode 100644
index 0000000..63234f1
--- /dev/null
+++ b/contrib/haskell/src/Hkl/PyFAI/PoniExt.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.PyFAI.PoniExt
+ ( PoniExt(..)
+ , flip
+ , move
+ , set
+ ) where
+
+import Numeric.LinearAlgebra (ident)
+import Numeric.Units.Dimensional.Prelude (Angle, Length)
+
+import Hkl.MyMatrix
+import Hkl.PyFAI.Poni
+
+import Prelude hiding (flip)
+
+data PoniExt = PoniExt Poni Pose deriving (Show)
+
+flip :: PoniExt -> PoniExt
+flip (PoniExt ps mym1) = PoniExt p mym1
+ where
+ p = map poniEntryFlip ps
+
+set ∷ PoniExt
+ → (Length Double) -- ^ distance
+ → (Length Double) -- ^ poni1
+ → (Length Double) -- ^ poni2
+ → (Angle Double) -- ^ rot1
+ → (Angle Double) -- ^ rot2
+ → (Angle Double) -- ^ rot3
+ → PoniExt
+set (PoniExt ps _) d p1 p2 r1 r2 r3 = PoniExt p pose
+ where
+ p = map (poniEntrySet d p1 p2 r1 r2 r3) ps
+ pose = Pose (MyMatrix HklB (ident 3))
+
+move :: PoniExt -> Pose -> PoniExt
+move (PoniExt p1 (Pose mym1)) (Pose mym2) = PoniExt p (Pose mym2)
+ where
+ p = map (poniEntryMove mym1 mym2) p1
diff --git a/contrib/haskell/src/Hkl/Python.hs b/contrib/haskell/src/Hkl/Python.hs
new file mode 100644
index 0000000..7ede8ae
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Python.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Python
+ ( PyVal(..) )
+ where
+
+import Data.List (intercalate)
+
+class PyVal a where
+ toPyVal ∷ a → String
+
+instance PyVal a ⇒ PyVal (Maybe a) where
+ toPyVal (Just v) = toPyVal v
+ toPyVal Nothing = "None"
+
+instance PyVal String where
+ toPyVal s = show s
+
+instance PyVal [String] where
+ toPyVal vs = "[" ++ intercalate ",\n" (map toPyVal vs) ++ "]"
+
+instance PyVal Int where
+ toPyVal i = show i
+
+instance PyVal [Int] where
+ toPyVal is = "[" ++ intercalate ",\n" (map toPyVal is) ++ "]"
+
+instance PyVal Double where
+ toPyVal d = show d
diff --git a/contrib/haskell/src/Hkl/Script.hs b/contrib/haskell/src/Hkl/Script.hs
new file mode 100644
index 0000000..bffc3ec
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Script.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Script
+ ( Gnuplot
+ , Py2
+ , Sh
+ , Script(..)
+ , run
+ , scriptRun
+ , scriptSave )
+ where
+
+import Control.Monad (when)
+import Data.Bits ((.|.))
+import Data.Text (Text)
+import Data.Text.IO (writeFile)
+import System.Directory (createDirectoryIfMissing)
+import System.Exit ( ExitCode ( ExitSuccess ) )
+import System.FilePath ( (<.>), takeDirectory)
+import System.Posix.Files (accessModes, groupModes, ownerModes, setFileMode)
+import System.Posix.Types (FileMode)
+import System.Process ( rawSystem ) -- callProcess for futur
+
+import Paths_hkl (getDataFileName)
+
+#if MIN_VERSION_directory(1, 3, 0)
+import System.Directory (withCurrentDirectory)
+#else
+import Control.Exception.Base (bracket)
+import System.Directory (getCurrentDirectory, setCurrentDirectory)
+withCurrentDirectory :: FilePath -- ^ Directory to execute in
+ -> IO a -- ^ Action to be executed
+ -> IO a
+withCurrentDirectory dir action =
+ bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do
+ setCurrentDirectory dir
+ action
+#endif
+
+type Profile = Bool
+
+data Gnuplot
+data Py2
+data Sh
+
+data Script a where
+ Py2Script ∷ (Text, FilePath) → Script Py2
+ ScriptGnuplot ∷ (Text, FilePath) → Script Gnuplot
+ ScriptSh ∷ (Text, FilePath) → Script Sh
+
+scriptSave' ∷ Text → FilePath → FileMode → IO ()
+scriptSave' c f m = do
+ createDirectoryIfMissing True (takeDirectory f)
+ Data.Text.IO.writeFile f c
+ setFileMode f m
+ print $ "--> created : " ++ f
+
+scriptSave ∷ Script a → IO ()
+scriptSave (Py2Script (c, f)) = scriptSave' c f (ownerModes .|. groupModes)
+scriptSave (ScriptGnuplot (c, f)) = scriptSave' c f accessModes
+scriptSave (ScriptSh (c, f)) = scriptSave' c f (ownerModes .|. groupModes)
+
+scriptRun' ∷ FilePath → String → [String] → Bool → IO ExitCode
+scriptRun' f prog args d
+ | d == True = withCurrentDirectory directory go
+ | otherwise = go
+ where
+ go :: IO ExitCode
+ go = rawSystem prog args
+
+ directory :: FilePath
+ directory = takeDirectory f
+
+scriptRun ∷ Script a → Bool → IO ExitCode
+scriptRun (Py2Script (_, p)) d = do
+ ExitSuccess ← scriptRun' p "python" args d
+ when p' ( do
+ gprof2dot ← getDataFileName "data/gprof2dot.py"
+ ExitSuccess ← rawSystem gprof2dot ["-f", "pstats", stats, "-o", stats <.> "dot"]
+ ExitSuccess ← rawSystem dot ["-Tsvg", "-o", stats <.> "svg", stats <.> "dot"]
+ return ()
+ )
+ return ExitSuccess
+ where
+ -- BEWARE once actived the profiling multiply by two the computing time.
+ p' ∷ Profile
+ p' = True
+
+ dot ∷ String
+ dot = "dot"
+
+ stats ∷ String
+ stats = p <.> "pstats"
+
+ args :: [String]
+ args
+ | p' == True = ["-m" , "cProfile", "-o", stats, p]
+ | otherwise = [p]
+scriptRun (ScriptGnuplot (_, p)) d = scriptRun' p "gnuplot" [p] d
+scriptRun (ScriptSh (_, p)) d = scriptRun' p p [] d
+
+run ∷ Script a → Bool → IO ExitCode
+run s b = do
+ scriptSave s
+ scriptRun s b
diff --git a/contrib/haskell/src/Hkl/Tiff.hs b/contrib/haskell/src/Hkl/Tiff.hs
new file mode 100644
index 0000000..a604395
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Tiff.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Tiff
+ ( ToTiff(..) ) where
+
+import Codec.Picture ( DynamicImage )
+
+class ToTiff a where
+ toTiff ∷ a → IO DynamicImage
diff --git a/contrib/haskell/src/Hkl/Types.hs b/contrib/haskell/src/Hkl/Types.hs
new file mode 100644
index 0000000..adc56d0
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Types.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Types ( AbsDirPath
+ , Beamline(..)
+ , beamlineUpper
+ , Mode(..)
+ , Engine(..)
+ , SampleName
+ , Sample(..)
+ , Source(..)
+ , Trajectory
+ , WaveLength
+ -- hdf5
+ , H5Path
+ , module X
+ ) where
+
+import Data.Char (toUpper)
+
+import Hkl.Types.Parameter as X
+import Hkl.H5
+import Hkl.Lattice
+import Numeric.Units.Dimensional.Prelude (Length)
+
+-- Common
+
+type AbsDirPath = FilePath
+type SampleName = String
+
+-- | Beamline
+
+data Beamline = Diffabs | Sixs
+
+instance Show Beamline where
+ show Diffabs = "diffabs"
+ show Sixs = "sixs"
+
+beamlineUpper ∷ Beamline → String
+beamlineUpper b = [toUpper x | x ← show b]
+
+-- | Engine
+
+data Mode
+ = Mode
+ String -- ^ name
+ [Parameter] -- ^ parameters of the @Mode@
+ deriving (Show)
+
+data Engine
+ = Engine
+ String -- ^ name
+ [Parameter] -- ^ pseudo axes values of the @Engine@
+ Mode -- ^ current Mode
+ deriving (Show)
+
+-- | Sample
+
+data Sample a
+ = Sample
+ String -- ^ name of the sample
+ (Lattice a) -- ^ the lattice of the sample
+ Parameter -- ^ ux
+ Parameter -- ^ uy
+ Parameter -- ^ uz
+ deriving (Show)
+
+-- | Source
+
+type WaveLength = Length Double
+
+data Source = Source WaveLength deriving (Show)
+
+-- | Trajectory
+
+type Trajectory = [[Double]]
diff --git a/contrib/haskell/src/Hkl/Types/Parameter.hsc b/contrib/haskell/src/Hkl/Types/Parameter.hsc
new file mode 100644
index 0000000..e29ecde
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Types/Parameter.hsc
@@ -0,0 +1,85 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE CPP #-}
+
+module Hkl.Types.Parameter
+ ( Parameter(..)
+ , Range(..)
+ , copyParameter
+ , unit
+ ) where
+
+import Control.Monad (void)
+import Foreign (nullPtr, Ptr, ForeignPtr, newForeignPtr, FunPtr)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.C ( CInt ( CInt )
+ , CDouble ( CDouble )
+ )
+import Foreign.C.String ( CString, peekCString )
+import Foreign.Storable ( Storable
+ , alignment
+ , sizeOf
+ , peek
+ , poke
+ )
+
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+
+unit :: CInt
+unit = 1
+
+-- | Range
+
+data Range
+ = Range
+ Double -- ^ minimum value
+ Double -- ^ maximum value
+ deriving (Show)
+
+-- | Parameter
+
+data Parameter
+ = Parameter
+ String -- ^ name
+ Double -- ^ value
+ Range -- ^ range
+ deriving (Show)
+
+instance Storable Parameter where
+ alignment _ = #{alignment int}
+ sizeOf _ = #{size int}
+ peek ptr = alloca $ \pmin ->
+ alloca $ \pmax -> do
+ cname <- c_hkl_parameter_name_get ptr
+ name <- peekCString cname
+ value <- c_hkl_parameter_value_get ptr unit
+ c_hkl_parameter_min_max_get ptr pmin pmax unit
+ min_ <- peek pmin
+ max_ <- peek pmax
+ return (Parameter name value (Range min_ max_))
+ poke ptr (Parameter _name value (Range min_ max_)) = do
+ void $ c_hkl_parameter_value_set ptr (CDouble value) unit nullPtr
+ void $ c_hkl_parameter_min_max_set ptr (CDouble min_) (CDouble max_) unit nullPtr
+
+copyParameter :: Ptr Parameter -> IO (ForeignPtr Parameter)
+copyParameter p = newForeignPtr c_hkl_parameter_free =<< c_hkl_parameter_new_copy p
+
+foreign import ccall unsafe "hkl.h hkl_parameter_name_get"
+ c_hkl_parameter_name_get:: Ptr Parameter -> IO CString
+
+foreign import ccall unsafe "hkl.h hkl_parameter_value_get"
+ c_hkl_parameter_value_get:: Ptr Parameter -> CInt -> IO Double
+
+foreign import ccall unsafe "hkl.h hkl_parameter_min_max_get"
+ c_hkl_parameter_min_max_get :: Ptr Parameter -> Ptr Double -> Ptr Double -> CInt -> IO ()
+
+foreign import ccall unsafe "hkl.h &hkl_parameter_free"
+ c_hkl_parameter_free :: FunPtr (Ptr Parameter -> IO ())
+
+foreign import ccall unsafe "hkl.h hkl_parameter_new_copy"
+ c_hkl_parameter_new_copy:: Ptr Parameter -> IO (Ptr Parameter)
+
+foreign import ccall unsafe "hkl.h hkl_parameter_value_set"
+ c_hkl_parameter_value_set:: Ptr Parameter -> CDouble -> CInt -> Ptr () -> IO (CInt)
+
+foreign import ccall unsafe "hkl.h hkl_parameter_min_max_set"
+ c_hkl_parameter_min_max_set :: Ptr Parameter -> CDouble -> CDouble -> CInt -> Ptr () -> IO (CInt)
diff --git a/contrib/haskell/src/Hkl/Utils.hs b/contrib/haskell/src/Hkl/Utils.hs
new file mode 100644
index 0000000..130db10
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Utils.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Utils
+ ( hasContent )
+ where
+
+import Data.Text (Text)
+import Data.Text.IO (writeFile)
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath (takeDirectory)
+
+hasContent ∷ FilePath → Text → IO ()
+hasContent f c = do
+ createDirectoryIfMissing True (takeDirectory f)
+ Data.Text.IO.writeFile f c
+ print $ "--> created : " ++ f
diff --git a/contrib/haskell/src/Hkl/Xrd.hs b/contrib/haskell/src/Hkl/Xrd.hs
new file mode 100644
index 0000000..efc682c
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Xrd.hs
@@ -0,0 +1,6 @@
+module Hkl.Xrd ( module X ) where
+
+import Hkl.Xrd.Calibration as X
+import Hkl.Xrd.OneD as X
+import Hkl.Xrd.Mesh as X
+import Hkl.Xrd.ZeroD as X
diff --git a/contrib/haskell/src/Hkl/Xrd/Calibration.hs b/contrib/haskell/src/Hkl/Xrd/Calibration.hs
new file mode 100644
index 0000000..30797cc
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Xrd/Calibration.hs
@@ -0,0 +1,355 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Xrd.Calibration
+ ( NptExt(..)
+ , XRDCalibrationEntry(..)
+ , XRDCalibration(..)
+ , calibrate
+ , extractEdf
+ ) where
+
+import Control.Applicative ((<$>), (<*>), pure)
+import Control.Monad.IO.Class (liftIO)
+import Data.ByteString.Char8 (pack)
+import Data.List (foldl', intercalate)
+import Data.Text (unlines, pack)
+import Data.Vector.Storable
+ ( Vector
+ , head
+ , concat
+ , fromList
+ , slice
+ , toList
+ )
+import Numeric.LinearAlgebra
+ ( Matrix
+ , (<>)
+ , atIndex
+ , ident
+ )
+import Numeric.GSL.Minimization
+ ( MinimizeMethod ( NMSimplex2 )
+ , minimizeV
+ )
+import Numeric.Units.Dimensional.Prelude (meter, radian, nano, (/~), (*~))
+import Pipes.Safe ( MonadSafe
+ , runSafeT, bracket
+ )
+import System.Exit ( ExitCode( ExitSuccess ) )
+import System.FilePath.Posix ((</>), takeFileName)
+import Text.Printf ( printf )
+
+-- import Hkl.C ( Geometry ( Geometry )
+-- , Factory ( K6c )
+-- , geometryDetectorRotationGet
+-- )
+-- import Hkl.DataSource ( DataItem ( DataItemH5 ) )
+-- import Hkl.Detector ( Detector ( ZeroD )
+-- , coordinates
+-- )
+-- import Hkl.Edf ( ExtractEdf()
+-- , extractEdf
+-- )
+-- import Hkl.H5 ( Dataset, File, H5
+-- , closeDataset
+-- , get_position
+-- , openDataset
+-- , withH5File
+-- )
+-- import Hkl.PyFAI ( Calibrant, Npt
+-- , NptEntry ( NptEntry )
+-- , Poni
+-- , PoniExt ( PoniExt )
+-- , Pose ( Pose )
+-- , fromAxisAndAngle
+-- , nptEntries
+-- , nptFromFile
+-- , nptWavelength
+-- , poniEntryFromList
+-- , poniEntryToList
+-- , toPyFAICalibArg
+-- )
+-- import Hkl.Python ( toPyVal )
+-- import Hkl.MyMatrix ( Basis ( HklB, PyFAIB )
+-- , MyMatrix ( MyMatrix )
+-- , changeBase
+-- )
+-- import Hkl.Nxs ( DataFrameH5Path ( XrdOneDH5Path )
+-- , Nxs ( Nxs )
+-- )
+-- import Hkl.Script ( Py2, Sh
+-- , Script ( Py2Script, ScriptSh )
+-- , run
+-- , scriptSave
+-- )
+-- import Hkl.Types ( AbsDirPath, SampleName
+-- , Source ( Source )
+-- , WaveLength )
+-- import Hkl.Xrd.OneD ( XrdOneD
+-- , getPoseEdf
+-- )
+
+import Hkl.C
+import Hkl.DataSource
+import Hkl.Detector
+import Hkl.Edf
+import Hkl.H5
+import Hkl.PyFAI
+import Hkl.Python
+import Hkl.MyMatrix
+import Hkl.Nxs
+import Hkl.Script
+import Hkl.Types
+import Hkl.Xrd.OneD
+
+#if !MIN_VERSION_hmatrix(0, 17, 0)
+(#>) :: Matrix Double -> Vector Double -> Vector Double
+(#>) = (<>)
+#else
+import Numeric.LinearAlgebra ((#>))
+#endif
+
+-- | Calibration
+
+data NptExt a = NptExt { nptExtNpt :: Npt
+ , nptExtPose :: Pose
+ , nptExtDetector :: Detector a
+ }
+ deriving (Show)
+
+data XRDCalibrationEntry = XRDCalibrationEntryNxs { xrdCalibrationEntryNxs'Nxs :: Nxs XrdOneD
+ , xrdCalibrationEntryNxs'Idx :: Int
+ , xrdCalibrationEntryNxs'NptPath :: FilePath
+ }
+ | XRDCalibrationEntryEdf { xrdCalibrationEntryEdf'Edf :: FilePath
+ , xrdCalibrationEntryEdf'NptPath :: FilePath
+ }
+ deriving (Show)
+
+data XRDCalibration a = XRDCalibration { xrdCalibrationName :: SampleName
+ , xrdCalibrationOutputDir :: AbsDirPath
+ , xrdCalibrationDetector ∷ Detector a
+ , xrdCalibrationCalibrant ∷ Calibrant
+ , xrdCalibrationEntries :: [XRDCalibrationEntry]
+ }
+ deriving (Show)
+
+withDataItem :: MonadSafe m => File -> DataItem H5 -> (Dataset -> m r) -> m r
+withDataItem hid (DataItemH5 name _) = bracket (liftIO acquire') (liftIO . release')
+ where
+ acquire' :: IO Dataset
+ acquire' = openDataset hid (Data.ByteString.Char8.pack name) Nothing
+
+ release' :: Dataset -> IO ()
+ release' = closeDataset
+
+getPoseNxs :: File -> DataFrameH5Path XrdOneD -> Int -> IO Pose -- TODO move to XRD
+getPoseNxs f (XrdOneDH5Path _ g d w) i' = runSafeT $
+ withDataItem f g $ \g' ->
+ withDataItem f d $ \d' ->
+ withDataItem f w $ \w' -> liftIO $ do
+ let mu = 0.0
+ let komega = 0.0
+ let kappa = 0.0
+ let kphi = 0.0
+ gamma <- get_position g' 0
+ delta <- get_position d' i'
+ wavelength <- get_position w' 0
+ let source = Source (Data.Vector.Storable.head wavelength *~ nano meter)
+ let positions = Data.Vector.Storable.concat [mu, komega, kappa, kphi, gamma, delta]
+ let geometry = Geometry K6c source positions Nothing
+ let detector = ZeroD
+ m <- geometryDetectorRotationGet geometry detector
+ return $ Pose (MyMatrix HklB m)
+
+
+getWavelength ∷ File → DataFrameH5Path XrdOneD → IO WaveLength
+getWavelength f (XrdOneDH5Path _ _ _ w) = runSafeT $
+ withDataItem f w $ \w' -> liftIO $ do
+ wavelength <- get_position w' 0
+ return $ Data.Vector.Storable.head wavelength *~ nano meter
+
+readWavelength :: XRDCalibrationEntry -> IO WaveLength
+readWavelength e =
+ withH5File f $ \h5file -> getWavelength h5file p
+ where
+ (Nxs f p) = xrdCalibrationEntryNxs'Nxs e
+
+
+readXRDCalibrationEntry :: Detector a -> XRDCalibrationEntry -> IO (NptExt a)
+readXRDCalibrationEntry d e@(XRDCalibrationEntryNxs _ _ _) =
+ withH5File f $ \h5file -> NptExt
+ <$> nptFromFile (xrdCalibrationEntryNxs'NptPath e)
+ <*> getPoseNxs h5file p idx
+ <*> pure d
+ where
+ idx = xrdCalibrationEntryNxs'Idx e
+ (Nxs f p) = xrdCalibrationEntryNxs'Nxs e
+readXRDCalibrationEntry d e@(XRDCalibrationEntryEdf _ _) =
+ NptExt
+ <$> nptFromFile (xrdCalibrationEntryEdf'NptPath e)
+ <*> getPoseEdf (xrdCalibrationEntryEdf'Edf e)
+ <*> pure d
+
+-- | Poni Calibration
+
+-- The minimized function is the quadratic difference of the
+-- theoretical tth angle and for each pixel, the computed tth angle.
+
+-- synonyme types use in order to improve the calibration performance
+
+type NptEntry' = (Double, [Vector Double]) -- tth, detector pixels coordinates
+type Npt' = (Double, [NptEntry']) -- wavelength, [NptEntry']
+type NptExt' a = (Npt', Matrix Double, Detector a)
+
+class ToGsl a where
+ toGsl ∷ a → Vector Double
+
+class FromGsl a where
+ fromGsl ∷ a → Vector Double → a
+
+class ToGslFunc a where
+ toGslFunc ∷ a → [NptExt b] → (Vector Double → Double)
+
+instance ToGsl PoniExt where
+ toGsl (PoniExt p _) = fromList $ poniEntryToList (last p)
+
+instance FromGsl PoniExt where
+ fromGsl (PoniExt p pose) v = PoniExt poni pose
+ where
+ poni ∷ Poni
+ poni = [poniEntryFromList (last p) (toList v)]
+
+instance ToGslFunc PoniExt where
+ toGslFunc _ npts = f (preCalibrate npts)
+ where
+ preCalibrate''' ∷ Detector a → NptEntry → NptEntry'
+ preCalibrate''' detector (NptEntry _ tth _ points) = (tth /~ radian, map (coordinates detector) points)
+
+ preCalibrate'' ∷ Npt → Detector a → Npt'
+ preCalibrate'' n detector = (nptWavelength n /~ meter, map (preCalibrate''' detector) (nptEntries n))
+
+ preCalibrate' ∷ NptExt a → NptExt' a
+ preCalibrate' (NptExt n (Pose m) detector) = (preCalibrate'' n detector, m', detector)
+ where
+ (MyMatrix _ m') = changeBase m PyFAIB
+
+ preCalibrate ∷ [NptExt a] → [NptExt' a]
+ preCalibrate = map preCalibrate'
+
+ f :: [NptExt' a] → Vector Double → Double
+ f ns params = foldl' (f' rotation translation) 0 ns
+ where
+ rot1 = params `atIndex` 0
+ rot2 = params `atIndex` 1
+ rot3 = params `atIndex` 2
+
+ rotations = map (uncurry fromAxisAndAngle)
+ [ (fromList [0, 0, 1], rot3 *~ radian)
+ , (fromList [0, 1, 0], rot2 *~ radian)
+ , (fromList [1, 0, 0], rot1 *~ radian)]
+
+ rotation = foldl' (<>) (ident 3) rotations
+
+ translation :: Vector Double
+ translation = slice 3 3 params
+
+ f' ∷ Matrix Double → Vector Double → Double → NptExt' a → Double
+ f' rotation translation x ((_wavelength, entries), m, _detector) =
+ foldl' (f'' translation r) x entries
+ where
+ r :: Matrix Double
+ r = m <> rotation
+
+ f'' ∷ Vector Double → Matrix Double → Double → NptEntry' → Double
+ {-# INLINE f'' #-}
+ f'' translation r x (tth, pixels) = foldl' (f''' translation r tth) x pixels
+
+ f''' ∷ Vector Double → Matrix Double → Double → Double → Vector Double → Double
+ {-# INLINE f''' #-}
+ f''' translation r tth x pixel = x + dtth * dtth
+ where
+ kf = r #> (pixel - translation)
+ x' = kf `atIndex` 0
+ y' = kf `atIndex` 1
+ z' = kf `atIndex` 2
+
+ dtth = tth - atan2 (sqrt (x'*x' + y'*y')) (-z')
+
+calibrate ∷ XRDCalibration a → PoniExt → IO PoniExt
+calibrate (XRDCalibration _ _ d _ es) p = do
+ npts ← mapM (readXRDCalibrationEntry d) es
+ let guess = toGsl p
+ let f = toGslFunc p npts
+ let box = fromList [0.1, 0.1, 0.1, 0.01, 0.01, 0.01]
+ let (solution, _p) = minimizeV NMSimplex2 1E-16 3000 box f guess
+ print _p
+ return $ fromGsl p solution
+
+-- | Edf extraction before calibration
+
+edf ∷ AbsDirPath → FilePath → Int → FilePath
+edf o n i = o </> f
+ where
+ f = (takeFileName n) ++ printf "_%02d.edf" i
+
+scriptExtractEdf ∷ AbsDirPath → [XRDCalibrationEntry] → Script Py2
+scriptExtractEdf o es = Py2Script (content, scriptPath)
+ where
+ content = Data.Text.unlines $
+ map Data.Text.pack [ "#!/bin/env python"
+ , ""
+ , "from fabio.edfimage import edfimage"
+ , "from h5py import File"
+ , ""
+ , "NEXUSFILES = " ++ toPyVal nxss
+ , "IDXS = " ++ toPyVal idxs
+ , "IMAGEPATHS = " ++ toPyVal (imgs ∷ [String])
+ , "OUTPUTS = " ++ toPyVal outputs
+ , ""
+ , "for filename, i, p, o in zip(NEXUSFILES, IDXS, IMAGEPATHS, OUTPUTS):"
+ , " with File(filename, mode='r') as f:"
+ , " edfimage(f[p][i]).write(o)"
+ ]
+
+ (nxss, idxs, imgs) = unzip3 [(f, i, img) | (XRDCalibrationEntryNxs (Nxs f (XrdOneDH5Path (DataItemH5 img _) _ _ _)) i _) ← es]
+
+ outputs ∷ [FilePath]
+ outputs = zipWith (edf o) nxss idxs
+
+ scriptPath ∷ FilePath
+ scriptPath = o </> "pre-calibration.py"
+
+scriptPyFAICalib ∷ AbsDirPath → XRDCalibrationEntry → Detector a → Calibrant → WaveLength → Script Sh
+scriptPyFAICalib o e d c w = ScriptSh (content, scriptPath)
+ where
+ content = Data.Text.unlines $
+ map Data.Text.pack [ "#!/usr/bin/env sh"
+ , ""
+ , "pyFAI-calib " ++ intercalate " " args
+ ]
+
+ args = [ toPyFAICalibArg w
+ , toPyFAICalibArg c
+ , toPyFAICalibArg d
+ , toPyFAICalibArg (edf o n i) ]
+
+ (XRDCalibrationEntryNxs (Nxs n _) i _) = e
+
+ scriptPath ∷ FilePath
+ scriptPath = o </> (takeFileName n) ++ printf "_%02d.sh" i
+
+
+instance ExtractEdf (XRDCalibration a) where
+ extractEdf (XRDCalibration _ o d c es) = do
+ let script = scriptExtractEdf o es
+ ExitSuccess ← run script False
+ mapM_ go es
+ return ()
+ where
+ go e = do
+ w ← readWavelength e
+ scriptSave $ scriptPyFAICalib o e d c w
diff --git a/contrib/haskell/src/Hkl/Xrd/Mesh.hs b/contrib/haskell/src/Hkl/Xrd/Mesh.hs
new file mode 100644
index 0000000..b99387a
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Xrd/Mesh.hs
@@ -0,0 +1,270 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Xrd.Mesh
+ ( XrdMeshSample(..)
+ , XrdMesh'(..)
+ , XrdMeshParams(..)
+ , XrdMeshSource(..)
+ , integrateMesh
+ ) where
+
+import Control.Concurrent.Async (mapConcurrently)
+import Control.Monad (void)
+import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
+import Data.Array.Repa (Shape, DIM1, ix1, size)
+import Data.Maybe (fromJust)
+import Data.Vector.Storable (Vector, any, concat, head, singleton)
+import Numeric.Units.Dimensional.Prelude (meter, nano, (/~), (*~))
+import System.Exit ( ExitCode( ExitSuccess ) )
+import System.FilePath ((</>), (<.>), dropExtension, splitDirectories, takeFileName)
+
+import qualified Data.Text as Text (unlines, pack)
+
+import Prelude hiding
+ ( any
+ , concat
+ , head
+ , lookup
+ , readFile
+ , unlines
+ )
+import Pipes ( lift )
+
+import Hkl.C
+import Hkl.DataSource
+import Hkl.Detector
+import Hkl.Flat
+import Hkl.H5
+import Hkl.PyFAI
+import Hkl.Python
+import Hkl.MyMatrix
+import Hkl.Nxs
+import Hkl.Script
+import Hkl.Types
+import Hkl.Utils
+import Hkl.Xrd.OneD
+
+-- | Types
+
+data XrdMeshSource = XrdMeshSourceNxs (Nxs XrdMesh)
+ | XrdMeshSourceNxsFly [Nxs XrdMesh]
+ deriving (Show)
+
+data XrdMesh' = XrdMesh DIM1 DIM1 (Maybe Threshold) XrdMeshSource deriving (Show)
+
+data XrdMeshSample = XrdMeshSample SampleName AbsDirPath [XrdMesh'] deriving (Show) -- ^ nxss
+
+data XrdMeshParams a = XrdMeshParams PoniExt (Maybe (Flat a)) AIMethod
+
+data XrdMeshFrame = XrdMeshFrame
+ WaveLength
+ Pose
+ deriving (Show)
+
+class FrameND t where
+ rowND :: t -> MaybeT IO XrdMeshFrame
+
+instance FrameND (DataFrameH5 XrdMesh) where
+
+ rowND (XrdMeshH5 _ _ _ _ _ g d w) = do
+ let mu = 0.0
+ let komega = 0.0
+ let kappa = 0.0
+ let kphi = 0.0
+ gamma <- get_position' g (ix1 0)
+ delta <- get_position' d (ix1 0)
+ wavelength <- get_position' w (ix1 0)
+ let source@(Source w') = Source (head wavelength *~ nano meter)
+ let positions = concat [mu, komega, kappa, kphi, gamma, delta]
+ let geometry = Geometry K6c source positions Nothing
+ let detector = ZeroD
+ m <- lift $ geometryDetectorRotationGet geometry detector
+ let pose = Pose (MyMatrix HklB m)
+ return $ XrdMeshFrame w' pose
+ where
+ get_position' :: Shape sh => DataSource a -> sh -> MaybeT IO (Vector Double)
+ get_position' (DataSourceH5 _ a ) b = lift $ do
+ v <- get_position_new a b
+ if any isNaN v then fail "File contains Nan" else return v
+ get_position' (DataSourceConst v) _ = lift $ return $ singleton v
+
+ rowND (XrdMeshFlyH5 _ _ _ _ _ g d w) = do
+ let mu = 0.0
+ let komega = 0.0
+ let kappa = 0.0
+ let kphi = 0.0
+ gamma <- get_position' g (ix1 0)
+ delta <- get_position' d (ix1 0)
+ wavelength <- get_position' w (ix1 0)
+ let source@(Source w') = Source (head wavelength *~ nano meter)
+ let positions = concat [mu, komega, kappa, kphi, gamma, delta]
+ let geometry = Geometry K6c source positions Nothing
+ let detector = ZeroD
+ m <- lift $ geometryDetectorRotationGet geometry detector
+ let pose = Pose (MyMatrix HklB m)
+ return $ XrdMeshFrame w' pose
+ where
+ get_position' :: Shape sh => DataSource a -> sh -> MaybeT IO (Vector Double)
+ get_position' (DataSourceH5 _ a ) b = lift $ do
+ v <- get_position_new a b
+ if any isNaN v then fail "File contains Nan" else return v
+ get_position' (DataSourceConst v) _ = lift $ return $ singleton v
+
+integrateMesh ∷ XrdMeshParams a → [XrdMeshSample] → IO ()
+integrateMesh p ss = void $ mapConcurrently (integrateMesh' p) ss
+
+integrateMesh' ∷ XrdMeshParams a → XrdMeshSample → IO ()
+integrateMesh' p (XrdMeshSample _ output nxss) = mapM_ (integrateMesh'' p output) nxss
+
+getWaveLengthAndPoniExt' ∷ XrdMeshParams a → Nxs XrdMesh → IO (WaveLength, PoniExt)
+getWaveLengthAndPoniExt' (XrdMeshParams ref _ _) nxs =
+ withDataSource nxs $ \h -> do
+ -- read the first frame and get the poni used for all the integration.
+ d <- runMaybeT $ rowND h
+ let (XrdMeshFrame w p) = fromJust d
+ let poniext = move ref p
+ return (w, poniext)
+
+getWaveLengthAndPoniExt ∷ XrdMeshParams a → XrdMeshSource → IO (WaveLength, PoniExt)
+getWaveLengthAndPoniExt p (XrdMeshSourceNxs nxs) = getWaveLengthAndPoniExt' p nxs
+getWaveLengthAndPoniExt p (XrdMeshSourceNxsFly (nxs:_)) = getWaveLengthAndPoniExt' p nxs
+getWaveLengthAndPoniExt _ (XrdMeshSourceNxsFly []) = error "getWaveLengthAndPoniExt"
+
+getOutputPath' ∷ AbsDirPath → FilePath → (FilePath, FilePath, FilePath)
+getOutputPath' o d = (poni, h5, py)
+ where
+ poni = o </> d </> d <.> "poni"
+ h5 = o </> d </> d <.> "h5"
+ py = o </> d </> d <.> "py"
+
+getOutputPath ∷ AbsDirPath → XrdMeshSource → (FilePath, FilePath, FilePath)
+getOutputPath o (XrdMeshSourceNxs (Nxs f _)) = getOutputPath' o dir
+ where
+ dir ∷ FilePath
+ dir = (dropExtension . takeFileName) f
+getOutputPath o (XrdMeshSourceNxsFly (Nxs _ h:_)) = getOutputPath' o dir
+ where
+ (XrdMeshFlyH5Path (DataItemH5 i _) _ _ _ _ _) = h
+ dir:_ = splitDirectories i
+getOutputPath _ (XrdMeshSourceNxsFly []) = error "getOutputPath"
+
+
+xrdMeshPy'' ∷ Maybe (Flat a)
+ → AIMethod -- pyFAI azimuthal integration method
+ → [FilePath] -- nexus files
+ → H5Path -- image path
+ → H5Path -- meshx path
+ → H5Path -- meshy path
+ → FilePath -- ponipath
+ → DIM1 -- bins
+ → (Maybe Threshold) -- threshold
+ → WaveLength -- wavelength
+ → FilePath -- output h5
+ → FilePath -- script name
+ → Script Py2
+xrdMeshPy'' mflat m fs i x y p b mt w o scriptPath = Py2Script (content, scriptPath)
+ where
+ content = Text.unlines $
+ map Text.pack ["#!/bin/env python"
+ , ""
+ , "import itertools"
+ , "import numpy"
+ , "from h5py import File"
+ , "from pyFAI import load"
+ , ""
+ , "PONIFILE = " ++ toPyVal p
+ , "NEXUSFILES = " ++ toPyVal fs
+ , "MESHX = " ++ toPyVal x
+ , "MESHY = " ++ toPyVal y
+ , "IMAGEPATH = " ++ toPyVal i
+ , "N = " ++ toPyVal (size b)
+ , "OUTPUT = " ++ toPyVal o
+ , "WAVELENGTH = " ++ toPyVal (w /~ meter)
+ , ""
+ , "# Load the flat"
+ , "flat = " ++ toPyVal mflat
+ , ""
+ , "# Load and prepare the common Azimuthal Integrator"
+ , "ai = load(PONIFILE)"
+ , "ai.wavelength = WAVELENGTH"
+ , "ai._empty = numpy.nan"
+ , ""
+ , "# Compute the fix part of the mask"
+ , "mask = numpy.zeros_like(ai.detector.mask, dtype=bool)"
+ , "mask[0:50, :] = True"
+ , "mask[910:960, :] = True"
+ , "mask[:,0:50] = True"
+ , "mask[:,510:560] = True"
+ , "if flat is None:"
+ , " mask = numpy.logical_or(mask, ai.detector.mask)"
+ , ""
+ , dummiesForPy mt
+ , ""
+ , "# Compute the size of the output"
+ , "FS = [File(n, mode='r') for n in NEXUSFILES]"
+ , "NX = 0"
+ , "NY = 0"
+ , "for f in FS:"
+ , " NX = f[MESHX].shape[1]"
+ , " NY += f[MESHY].shape[0]"
+ , ""
+ , "def gen(fs):"
+ , " for f in fs:"
+ , " for i in f[IMAGEPATH]:"
+ , " yield i"
+ , ""
+ , "# Create and fill the ouput file"
+ , "with File(OUTPUT, mode='w') as o:"
+ , " dataset = o.create_dataset('map', shape=(NY, NX, N), dtype='float')"
+ , " lines = gen(FS)"
+ , " for j, line in enumerate(lines):"
+ , " for i, img in enumerate(line):"
+ , " tth, I, sigma = ai.integrate1d(img, N, unit=\"2th_deg\","
+ , " error_model=\"poisson\", correctSolidAngle=False,"
+ , " method=\"" ++ show m ++ "\","
+ , " mask=mask,"
+ , " dummy=DUMMY, delta_dummy=DELTA_DUMMY,"
+ , " safe=False, flat=flat)"
+ , " dataset[j, i] = I"
+ ]
+
+xrdMeshPy' ∷ XrdMeshParams a
+ → XrdMeshSource -- data source
+ → FilePath -- ponipath
+ → DIM1 -- bins
+ → (Maybe Threshold) -- threshold
+ → WaveLength -- wavelength
+ → FilePath -- output h5
+ → FilePath -- script name
+ → Script Py2
+xrdMeshPy' (XrdMeshParams _ mflat m) (XrdMeshSourceNxs (Nxs f h5path)) p b mt w o scriptPath =
+ xrdMeshPy'' mflat m [f] i x y p b mt w o scriptPath
+ where
+ (XrdMeshH5Path (DataItemH5 i _) (DataItemH5 x _) (DataItemH5 y _) _ _ _) = h5path
+xrdMeshPy' (XrdMeshParams _ mflat m) (XrdMeshSourceNxsFly nxss) p b mt w o scriptPath =
+ xrdMeshPy'' mflat m fs i x y p b mt w o scriptPath
+ where
+ fs ∷ [FilePath]
+ fs = [f | (Nxs f _) ← nxss]
+
+ (Nxs _ h5path):_ = nxss
+
+ (XrdMeshFlyH5Path (DataItemH5 i _) (DataItemH5 x _) (DataItemH5 y _) _ _ _) = h5path
+
+integrateMesh'' ∷ XrdMeshParams a → AbsDirPath → XrdMesh' → IO ()
+integrateMesh'' p' output (XrdMesh b _ mt s) = do
+ -- get the poniext for all the scan
+ (w, PoniExt p _) <- getWaveLengthAndPoniExt p' s
+
+ -- save this poni at the right place
+ let (ponipath, h5, py) = getOutputPath output s
+ ponipath `hasContent` poniToText p
+
+ -- create the python script to do the integration
+ let script = xrdMeshPy' p' s ponipath b mt w h5 py
+ ExitSuccess ← run script False
+
+ return ()
diff --git a/contrib/haskell/src/Hkl/Xrd/OneD.hs b/contrib/haskell/src/Hkl/Xrd/OneD.hs
new file mode 100644
index 0000000..e3a2ae5
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Xrd/OneD.hs
@@ -0,0 +1,667 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Xrd.OneD
+ ( XrdOneD
+ , XRDRef(..)
+ , XrdRefSource(..)
+ , XRDSample(..)
+ , Threshold(..)
+ , XrdNxs(..)
+ , XrdOneDParams(..)
+ , XrdSource(..)
+ , PoniExt(..)
+ -- reference
+ , getPoseEdf
+ , getPoniExtRef
+ -- integration
+ , integrate
+ , substract
+ -- integrateMulti
+ , integrateMulti
+ , substractMulti
+ -- tools
+ , dummiesForPy
+ ) where
+
+import Control.Applicative ((<$>), (<*>), pure)
+import Control.Concurrent.Async (mapConcurrently)
+import Control.Monad (forM_, forever, void, when, zipWithM_)
+import Control.Monad.Morph (hoist)
+import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
+import Control.Monad.Trans.State.Strict (StateT, get, put)
+import Data.Array.Repa (DIM1, ix1, size)
+import Data.Attoparsec.Text (parseOnly)
+import qualified Data.List as List (lookup)
+import Data.Maybe (fromJust, fromMaybe, isJust)
+import Data.Text (Text)
+import qualified Data.Text as Text (unlines, pack, intercalate)
+import Data.Text.IO (readFile)
+import Data.Vector.Storable (concat, head)
+import Numeric.LinearAlgebra (fromList)
+import Numeric.Units.Dimensional.Prelude (meter, nano, (/~), (*~))
+import System.Exit ( ExitCode( ExitSuccess ) )
+import System.FilePath ((<.>), (</>), dropExtension, replaceExtension, takeFileName, takeDirectory)
+import Text.Printf ( printf )
+
+import Pipes
+ ( Consumer
+ , Pipe
+ , lift
+ , (>->)
+ , runEffect
+ , await
+ , yield
+ )
+import Pipes.Lift ( evalStateP )
+import Pipes.Prelude ( drain, filter, toListM )
+import Pipes.Safe ( runSafeT )
+
+import Hkl.C ( Factory ( K6c )
+ , Geometry ( Geometry )
+ , geometryDetectorRotationGet
+ )
+import Hkl.DataSource ( DataItem ( DataItemH5 )
+ , DataSource( DataSourceH5 )
+ , atIndex'
+ )
+import Hkl.Detector ( Detector ( ZeroD ) )
+import Hkl.Edf ( Edf ( Edf )
+ , edfFromFile
+ )
+import Hkl.Flat ( Flat )
+import Hkl.H5 ( lenH5Dataspace )
+import Hkl.PyFAI ( AIMethod, Poni
+ , PoniExt ( PoniExt )
+ , PoniPath
+ , Pose ( Pose )
+ , move
+ , poniP
+ , poniToText
+ )
+import Hkl.Python ( PyVal
+ , toPyVal
+ )
+import Hkl.MyMatrix ( Basis ( HklB )
+ , MyMatrix ( MyMatrix )
+ )
+import Hkl.Nxs ( DataFrameH5 ( DataFrameH5 )
+ , Nxs ( Nxs )
+ , XrdOneD
+ , DataFrameH5Path ( XrdOneDH5Path )
+ , withDataFrameH5
+ )
+import Hkl.Script ( Gnuplot, Py2
+ , Script ( ScriptGnuplot, Py2Script )
+ , run
+ , scriptSave
+ )
+import Hkl.Types ( AbsDirPath, SampleName
+ , Source ( Source )
+ )
+import Hkl.Utils ( hasContent )
+
+-- | TODO
+-- * When we skip the last frame there is problem.
+
+-- * Let's add a method in order to customize the movement of the poni.
+
+-- | Types
+
+data Threshold = Threshold Int deriving (Show)
+
+instance PyVal Threshold where
+ toPyVal (Threshold i) = toPyVal i
+
+data XrdRefSource = XrdRefNxs (Nxs XrdOneD) Int
+ | XrdRefEdf FilePath PoniPath
+ deriving (Show)
+
+data XRDRef = XRDRef SampleName AbsDirPath XrdRefSource
+ deriving (Show)
+
+data XrdSource = XrdSourceNxs (Nxs XrdOneD)
+ | XrdSourceEdf [FilePath]
+ deriving (Show)
+
+data XrdNxs
+ = XrdNxs
+ DIM1 -- bins
+ DIM1 -- bins for the multibins
+ (Maybe Threshold) -- threshold use to remove image Intensity
+ [Int] -- Index of the frames to skip
+ XrdSource -- data source
+ deriving (Show)
+
+data XRDSample = XRDSample SampleName AbsDirPath [XrdNxs] -- ^ nxss
+ deriving (Show)
+
+data XrdOneDParams a = XrdOneDParams PoniExt (Maybe (Flat a)) AIMethod
+
+data DifTomoFrame sh =
+ DifTomoFrame { difTomoFrameNxs :: Nxs XrdOneD-- ^ nexus of the current frame
+ , difTomoFrameIdx :: Int -- ^ index of the current frame
+ , difTomoFrameEOF :: Bool -- ^ is it the eof of the stream
+ , difTomoFrameGeometry :: Geometry -- ^ diffractometer geometry
+ , difTomoFramePoniExt :: PoniExt -- ^ the ref poniext
+ } deriving (Show)
+
+class Frame t where
+ len :: t -> IO (Maybe Int)
+ row :: t -> Int -> MaybeT IO (DifTomoFrame DIM1)
+
+instance Frame (DataFrameH5 XrdOneD) where
+ len (DataFrameH5 _ _ _ (DataSourceH5 _ d) _ _) = lenH5Dataspace d
+
+ row d@(DataFrameH5 nxs' _ g d' w ponigen) idx = do
+ n <- lift $ len d
+ let eof = fromJust n - 1 == idx
+ let mu = 0.0
+ let komega = 0.0
+ let kappa = 0.0
+ let kphi = 0.0
+ gamma <- g `atIndex'` (ix1 0)
+ delta <- d' `atIndex'` (ix1 idx)
+ wavelength <- w `atIndex'` (ix1 0)
+ let source = Source (Data.Vector.Storable.head wavelength *~ nano meter)
+ let positions = Data.Vector.Storable.concat [mu, komega, kappa, kphi, gamma, delta]
+ -- print positions
+ let geometry = Geometry K6c source positions Nothing
+ let detector = ZeroD
+ m <- lift $ geometryDetectorRotationGet geometry detector
+ let pose = Pose (MyMatrix HklB m)
+ poniext <- lift $ ponigen pose idx
+ return $ DifTomoFrame { difTomoFrameNxs = nxs'
+ , difTomoFrameIdx = idx
+ , difTomoFrameEOF = eof
+ , difTomoFrameGeometry = geometry
+ , difTomoFramePoniExt = poniext
+ }
+
+-- type PipeE e a b m r = EitherT e (Pipe a b m) r
+
+frames :: (Frame a) => Pipe a (DifTomoFrame DIM1) IO ()
+frames = do
+ d <- await
+ (Just n) <- lift $ len d
+ forM_ [0..n-1] (\i' -> do
+ f <- lift $ runMaybeT $ row d i'
+ when (isJust f) (yield (fromJust f)))
+
+frames' :: (Frame a) => [Int] -> Pipe a (DifTomoFrame DIM1) IO ()
+frames' is = do
+ d <- await
+ forM_ is (\i' -> do
+ f <- lift $ runMaybeT $ row d i'
+ when (isJust f) (yield (fromJust f)))
+
+skip :: [Int] -> DifTomoFrame sh -> Bool
+skip is' (DifTomoFrame _ i _ _ _) = notElem i is'
+
+-- {-# ANN module "HLint: ignore Use camelCase" #-}
+
+
+-- import Graphics.Rendering.Chart.Easy
+-- import Graphics.Rendering.Chart.Backend.Diagrams
+
+-- plotPonies :: FilePath -> [PoniEntry] -> IO ()
+-- plotPonies f entries = toFile def f $ do
+-- layout_title .= "Ponies"
+-- setColors [opaque blue]
+-- let values = map extract entries
+-- plot (line "am" [values [0,(0.5)..400]])
+-- -- plot (points "am points" (signal [0,7..400]))
+-- where
+-- extract (PoniEntry _ _ (Length poni1) _ _ _ _ _ _) = poni1
+
+-- | Usual methods
+
+dummiesForPy ∷ Maybe Threshold → String
+dummiesForPy mt = unlines [ "# Compute the dummy values for the dynamic mask"
+ , "DUMMY=" ++ dummy
+ , "DELTA_DUMMY=" ++ delta_dummy
+ ]
+ where
+ dummy = maybe "None" (\_ → "4294967296") mt -- TODO the default value depends on the number od bits per pixels.
+ delta_dummy = maybe "None" (\(Threshold t) → show (4294967296 - t)) mt
+
+getScanDir ∷ AbsDirPath → FilePath → FilePath
+getScanDir o f = o </> (dropExtension . takeFileName) f
+
+pgen :: AbsDirPath -> FilePath -> Int -> FilePath
+pgen o f i = o </> scandir </> scandir ++ printf "_%02d.poni" i
+ where
+ scandir = (dropExtension . takeFileName) f
+
+getPoseEdf :: FilePath -> IO Pose
+getPoseEdf f = do
+ edf@(Edf lambda _) <- edfFromFile f
+ let mnes = map Text.pack ["_mu", "_keta", "_kap", "_kphi", "nu", "del"]
+ let source = Source lambda
+ let positions = fromList $ map (extract edf) mnes
+ let geometry = Geometry K6c source positions Nothing
+ let detector = ZeroD
+ m <- geometryDetectorRotationGet geometry detector
+ return $ Pose (MyMatrix HklB m)
+ where
+ extract :: Edf -> Text -> Double
+ extract (Edf _ ms) key = fromMaybe 0.0 (List.lookup key ms)
+
+poniFromFile :: FilePath -> IO Poni
+poniFromFile filename = do
+ content <- Data.Text.IO.readFile filename
+ return $ case parseOnly poniP content of
+ Left _ -> error $ "Can not parse the " ++ filename ++ " poni file"
+ Right poni -> poni
+
+getPoniExtRef :: XRDRef -> IO PoniExt
+getPoniExtRef (XRDRef _ output (XrdRefNxs nxs'@(Nxs f _) idx)) = do
+ poniExtRefs <- runSafeT $
+ toListM ( withDataFrameH5 nxs' (gen output f) yield
+ >-> hoist lift ( frames' [idx]))
+ return $ difTomoFramePoniExt (Prelude.last poniExtRefs)
+ where
+ gen :: FilePath -> FilePath -> Pose -> Int -> IO PoniExt
+ gen root nxs'' p idx' = PoniExt
+ <$> poniFromFile (root </> scandir ++ printf "_%02d.poni" idx')
+ <*> pure p
+ where
+ scandir = takeFileName nxs''
+getPoniExtRef (XRDRef _ _ (XrdRefEdf e p)) = PoniExt
+ <$> poniFromFile p
+ <*> getPoseEdf e
+
+integrate ∷ XrdOneDParams a → [XRDSample] → IO ()
+integrate p ss = void $ mapConcurrently (integrate' p) ss
+
+integrate' ∷ XrdOneDParams a → XRDSample → IO ()
+integrate' p (XRDSample _ output nxss) = void $ mapConcurrently (integrate'' p output) nxss
+
+integrate'' ∷ XrdOneDParams a → AbsDirPath → XrdNxs → IO ()
+integrate'' p output (XrdNxs b _ mt is (XrdSourceNxs nxs'@(Nxs f _))) = do
+ print f
+ runSafeT $ runEffect $
+ withDataFrameH5 nxs' (gen p) yield
+ >-> hoist lift (frames
+ >-> Pipes.Prelude.filter (skip is)
+ >-> savePonies (pgen output f)
+ >-> savePy p b mt
+ >-> saveGnuplot
+ >-> drain)
+ where
+ gen :: XrdOneDParams a -> Pose -> Int -> IO PoniExt
+ gen (XrdOneDParams ref' _ _) m _idx = return $ move ref' m
+
+createPy ∷ XrdOneDParams a → DIM1 → Maybe Threshold → FilePath → DifTomoFrame' sh → (Script Py2, FilePath)
+createPy (XrdOneDParams _ mflat m) b mt scriptPath (DifTomoFrame' f poniPath) = (Py2Script (script, scriptPath), output)
+ where
+ script = Text.unlines $
+ map Text.pack ["#!/bin/env python"
+ , ""
+ , "import numpy"
+ , "from h5py import File"
+ , "from pyFAI import load"
+ , ""
+ , "PONIFILE = " ++ toPyVal poniPath
+ , "NEXUSFILE = " ++ toPyVal nxs'
+ , "IMAGEPATH = " ++ toPyVal i'
+ , "IDX = " ++ toPyVal idx
+ , "N = " ++ toPyVal (size b)
+ , "OUTPUT = " ++ toPyVal output
+ , "WAVELENGTH = " ++ toPyVal (w /~ meter)
+ , ""
+ , "# load the flat"
+ , "flat = " ++ toPyVal mflat
+ , ""
+ , dummiesForPy mt
+ , ""
+ , "ai = load(PONIFILE)"
+ , "ai.wavelength = WAVELENGTH"
+ , "ai._empty = numpy.nan"
+ , ""
+ , "with File(NEXUSFILE, mode='r') as f:"
+ , " img = f[IMAGEPATH][IDX]"
+ , ""
+ , " # Compute the mask"
+ , " mask = numpy.zeros_like(img, dtype=bool)"
+ , " mask[:,550:] = True"
+ , " #mask_module[0:50, :] = True"
+ , " #mask_module[910:960, :] = True"
+ , " #mask_module[:,0:10] = True"
+ , " if flat is not None: # this should be removed for pyFAI >= 0.13.1 it is now done by PyFAI"
+ , " mask = numpy.logical_or(mask, flat == 0.0)"
+ , ""
+ , " ai.integrate1d(img, N, filename=OUTPUT, unit=\"2th_deg\", error_model=\"poisson\", correctSolidAngle=False, method=\"" ++ show m ++ "\", mask=mask, flat=flat, dummy=DUMMY, delta_dummy=DELTA_DUMMY)"
+ ]
+ (Nxs nxs' (XrdOneDH5Path (DataItemH5 i' _) _ _ _)) = difTomoFrameNxs f
+ idx = difTomoFrameIdx f
+ output = poniPath `replaceExtension` "dat"
+ (Geometry _ (Source w) _ _) = difTomoFrameGeometry f
+
+-- | Pipes
+
+data DifTomoFrame' sh = DifTomoFrame' { difTomoFrame'DifTomoFrame :: DifTomoFrame sh
+ , difTomoFrame'PoniPath :: FilePath
+ }
+
+savePonies :: (Int -> FilePath) -> Pipe (DifTomoFrame sh) (DifTomoFrame' sh) IO ()
+savePonies g = forever $ do
+ f <- await
+ let filename = g (difTomoFrameIdx f)
+ let (PoniExt p _) = difTomoFramePoniExt f
+ lift $ filename `hasContent` (poniToText p)
+ yield $ DifTomoFrame' { difTomoFrame'DifTomoFrame = f
+ , difTomoFrame'PoniPath = filename
+ }
+
+data DifTomoFrame'' sh = DifTomoFrame'' { difTomoFrame''DifTomoFrame' :: DifTomoFrame' sh
+ , difTomoFrame''PySCript :: Script Py2
+ , difTomoFrame''DataPath :: FilePath
+ }
+
+savePy ∷ XrdOneDParams a → DIM1 → Maybe Threshold → Pipe (DifTomoFrame' sh) (DifTomoFrame'' sh) IO ()
+savePy p b mt = forever $ do
+ f@(DifTomoFrame' _difTomoFrame poniPath) <- await
+ let scriptPath = poniPath `replaceExtension`"py"
+ let (script, dataPath) = createPy p b mt scriptPath f
+ ExitSuccess <- lift $ run script True
+ yield $ DifTomoFrame'' { difTomoFrame''DifTomoFrame' = f
+ , difTomoFrame''PySCript = script
+ , difTomoFrame''DataPath = dataPath
+ }
+
+data DifTomoFrame''' sh = DifTomoFrame''' { difTomoFrame'''DifTomoFrame'' ∷ DifTomoFrame'' sh
+ , difTomoFrame'''GnuplotScript ∷ Script Gnuplot
+ , difTomoFrame'''Curves ∷ [FilePath]
+ }
+
+mkGnuplot ∷ [FilePath] → FilePath → Script Gnuplot
+mkGnuplot fs o = ScriptGnuplot (content, o)
+ where
+ content = Text.unlines $
+ ["plot \\"]
+ ++ [Text.intercalate ",\\\n" [ Text.pack (show f ++ " u 1:2 w l") | f <- fs ]]
+ ++ ["pause -1"]
+
+saveGnuplot' :: Pipe (DifTomoFrame'' sh) (DifTomoFrame''' sh) (StateT [FilePath] IO) r
+saveGnuplot' = forever $ do
+ curves <- lift get
+ f@(DifTomoFrame'' (DifTomoFrame' _ poniPath) _ dataPath) <- await
+ let curves' = curves ++ [dataPath]
+ let script = mkGnuplot curves' (takeDirectory poniPath </> "plot.gnuplot")
+ lift . lift $ scriptSave script
+ lift $ put $! curves'
+ yield $ DifTomoFrame''' { difTomoFrame'''DifTomoFrame'' = f
+ , difTomoFrame'''GnuplotScript = script
+ , difTomoFrame'''Curves = curves'
+ }
+
+saveGnuplot :: Pipe (DifTomoFrame'' sh) (DifTomoFrame''' sh) IO r
+saveGnuplot = evalStateP [] saveGnuplot'
+
+-- substract a sample from another one
+
+substractPy ∷ [FilePath] → [FilePath] → [FilePath] → FilePath → Script Py2
+substractPy fs1 fs2 os scriptPath = Py2Script (content, scriptPath)
+ where
+ content ∷ Text
+ content = Text.unlines $
+ map Text.pack ["#!/bin/env python"
+ , ""
+ , "import numpy"
+ , ""
+ , "S1 = " ++ toPyVal fs1
+ , "S2 = " ++ toPyVal fs2
+ , "OUTPUTS = " ++ toPyVal os
+ , ""
+ , "def substract(f1, f2, o):"
+ , " a1 = numpy.genfromtxt(f1)"
+ , " a2 = numpy.genfromtxt(f2)"
+ , " res = numpy.copy(a2)"
+ , " res[:,1] -= a1[:,1]"
+ , " # TODO deal with the error propagation"
+ , " numpy.savetxt(output, res)"
+ , ""
+ , "for (s1, s2, output) in zip(S1, S2, OUTPUTS):"
+ , " substract(s1, s2, output)"
+ ]
+
+targetP ∷ (Int → FilePath) → Pipe (DifTomoFrame sh) FilePath IO ()
+targetP g = forever $ do
+ f ← await
+ let poniPath = g (difTomoFrameIdx f)
+ let dataPath = poniPath `replaceExtension` "dat"
+ yield dataPath
+
+target' ∷ XrdOneDParams a → AbsDirPath → XrdNxs → IO (FilePath, [FilePath])
+target' p output (XrdNxs _ _ _ is (XrdSourceNxs nxs'@(Nxs f _))) = do
+ fs ← runSafeT $ toListM $
+ withDataFrameH5 nxs' (gen p) yield
+ >-> hoist lift (frames
+ >-> Pipes.Prelude.filter (skip is)
+ >-> targetP (pgen output f)
+ )
+ return (getScanDir output f, fs)
+ where
+ gen :: XrdOneDParams a -> Pose -> Int -> IO PoniExt
+ gen (XrdOneDParams ref' _ _) m _idx = return $ move ref' m
+
+targets ∷ XrdOneDParams a → XRDSample → IO [(FilePath, [FilePath])]
+targets p (XRDSample _ output nxss) = mapConcurrently (target' p output) nxss
+
+substract' ∷ XrdOneDParams a → XRDSample → XRDSample → IO ()
+substract' p s1@(XRDSample name _ _) s2 = do
+ -- compute the output of the s1 sample
+ -- we take only the first list of the sample
+ f1s:_ ← targets p s1
+ -- compute the output of the s2 sample
+ f2s ← targets p s2
+ -- do the substraction via a python script and add the gnuplot file
+ _ ← mapConcurrently (go f1s) f2s
+ return ()
+ where
+ go ∷ (FilePath, [FilePath]) → (FilePath, [FilePath]) → IO ()
+ go (_, f1) (d, f2) = do
+ -- compute the substracted output file names take into account
+ -- that f1 and f2 could have different length
+ let outputs = [dropExtension f ++ "-" ++ name <.> "dat" | (_, f) ← zip f1 f2]
+ -- compute the script name
+ let scriptPath = d </> "substract.py"
+ let script = substractPy f1 f2 outputs scriptPath
+ ExitSuccess ← run script False
+ -- gnuplot
+ let gnuplotPath = d </> "substract.gnuplot"
+ scriptSave $ mkGnuplot outputs gnuplotPath
+ return ()
+
+substract ∷ XrdOneDParams a → XRDSample → [XRDSample] → IO ()
+substract p s ss = mapM_ (substract' p s) ss
+
+-- | PyFAI MultiGeometry
+
+integrateMulti ∷ XrdOneDParams a → [XRDSample] → IO ()
+integrateMulti p samples = mapM_ (integrateMulti' p) samples
+
+integrateMulti' ∷ XrdOneDParams a → XRDSample → IO ()
+integrateMulti' p (XRDSample _ output nxss) = mapM_ (integrateMulti'' p output) nxss
+
+integrateMulti'' ∷ XrdOneDParams a → AbsDirPath → XrdNxs → IO ()
+integrateMulti'' p output (XrdNxs _ mb mt is (XrdSourceNxs nxs'@(Nxs f _))) = do
+ print f
+ runSafeT $ runEffect $
+ withDataFrameH5 nxs' (gen p) yield
+ >-> hoist lift (frames
+ >-> Pipes.Prelude.filter (skip is)
+ >-> savePonies (pgen output f)
+ >-> saveMultiGeometry p mb mt)
+ where
+ gen :: XrdOneDParams a -> Pose -> Int -> IO PoniExt
+ gen (XrdOneDParams ref' _ _) m _idx = return $ move ref' m
+
+integrateMulti'' p output (XrdNxs b _ mt _ (XrdSourceEdf fs)) = do
+ -- generate all the ponies
+ zipWithM_ (go p) fs ponies
+
+ -- generate the multi.py python script
+ let scriptPath = output </> "multi.py"
+ let (script, _) = createMultiPyEdf p b mt fs ponies scriptPath (output </> "multi.dat")
+ scriptSave script
+ where
+ ponies = [output </> (dropExtension . takeFileName) f ++ ".poni" | f <- fs]
+
+ go ∷ XrdOneDParams a → FilePath → FilePath → IO ()
+ go (XrdOneDParams ref _ _) f o = do
+ m <- getPoseEdf f
+ let (PoniExt p' _) = move ref m
+ o `hasContent` (poniToText p')
+
+createMultiPy ∷ XrdOneDParams a → DIM1 → Maybe Threshold → FilePath → DifTomoFrame' sh → [(Int, FilePath)] → (Script Py2, FilePath)
+createMultiPy (XrdOneDParams _ mflat _) b mt scriptPath (DifTomoFrame' f _) idxPonies = (Py2Script (content, scriptPath), output)
+ where
+ content = Text.unlines $
+ map Text.pack ["#!/bin/env python"
+ , ""
+ , "import numpy"
+ , "from h5py import File"
+ , "from pyFAI.multi_geometry import MultiGeometry"
+ , ""
+ , "NEXUSFILE = " ++ toPyVal nxs'
+ , "IMAGEPATH = " ++ toPyVal i'
+ , "BINS = " ++ toPyVal (size b)
+ , "OUTPUT = " ++ toPyVal output
+ , "WAVELENGTH = " ++ toPyVal (w /~ meter)
+ , "THRESHOLD = " ++ toPyVal mt
+ , ""
+ , "# load the flat"
+ , "flat = " ++ toPyVal mflat
+ , ""
+ , "# Load all images"
+ , "PONIES = " ++ toPyVal ponies
+ , "IDXS = " ++ toPyVal idxs
+ , ""
+ , "# Read all the images"
+ , "imgs = []"
+ , "with File(NEXUSFILE, mode='r') as f:"
+ , " for idx in IDXS:"
+ , " imgs.append(f[IMAGEPATH][idx])"
+ , ""
+ , "# Compute the mask"
+ , "mask = numpy.zeros_like(imgs[0], dtype=bool)"
+ , "mask[:,550:] = True"
+ , "if flat is not None: # this should be removed for pyFAI >= 0.13.1 it is now done by PyFAI"
+ , " mask = numpy.logical_or(mask, flat == 0.0)"
+ , "lst_mask = []"
+ , "for img in imgs: # remove all pixels above the threshold"
+ , " if THRESHOLD is not None:"
+ , " mask_t = numpy.where(img > THRESHOLD, True, False)"
+ , " lst_mask.append(numpy.logical_or(mask, mask_t))"
+ , " else:"
+ , " lst_mask.append(mask)"
+ , ""
+ , "# Integration multi-geometry 1D"
+ , "mg = MultiGeometry(PONIES, unit=\"2th_deg\", radial_range=(0,80))"
+ , "p = mg.integrate1d(imgs, BINS, lst_mask=lst_mask, lst_flat=flat)"
+ , ""
+ , "# Save the datas"
+ , "numpy.savetxt(OUTPUT, numpy.array(p).T)"
+ ]
+ (Nxs nxs' (XrdOneDH5Path (DataItemH5 i' _) _ _ _)) = difTomoFrameNxs f
+ output = "multi.dat"
+ (Geometry _ (Source w) _ _) = difTomoFrameGeometry f
+ (idxs, ponies) = unzip idxPonies
+
+createMultiPyEdf ∷ XrdOneDParams a → DIM1 → Maybe Threshold → [FilePath] → [FilePath] → FilePath → FilePath → (Script Py2, FilePath)
+createMultiPyEdf (XrdOneDParams _ mflat _) b mt edfs ponies scriptPath output = (Py2Script (content, scriptPath), output)
+ where
+ content = Text.unlines $
+ map Text.pack ["#!/bin/env python"
+ , ""
+ , "import numpy"
+ , "from fabio import open"
+ , "from pyFAI.multi_geometry import MultiGeometry"
+ , ""
+ , "EDFS = " ++ toPyVal edfs
+ , "PONIES = " ++ toPyVal ponies
+ , "BINS = " ++ toPyVal (size b)
+ , "OUTPUT = " ++ toPyVal output
+ , "THRESHOLD = " ++ toPyVal mt
+ , ""
+ , "# load the flat"
+ , "flat = " ++ toPyVal mflat
+ , ""
+ , "# Read all the images"
+ , "imgs = [open(edf).data for edf in EDFS]"
+ , ""
+ , "# Compute the mask"
+ , "mask = numpy.zeros_like(imgs[0], dtype=bool)"
+ , "if THRESHOLD is not None:"
+ , " for img in imgs:"
+ , " mask_t = numpy.where(img > THRESHOLD, True, False)"
+ , " mask = numpy.logical_or(mask, mask_t)"
+ , ""
+ , "# Integration multi-geometry 1D"
+ , "mg = MultiGeometry(PONIES, unit=\"2th_deg\", radial_range=(0,80))"
+ , "p = mg.integrate1d(imgs, BINS, lst_mask=mask)"
+ , ""
+ , "# Save the datas"
+ , "numpy.savetxt(OUTPUT, numpy.array(p).T)"
+ ]
+
+saveMulti' ∷ XrdOneDParams a → DIM1 → Maybe Threshold → Consumer (DifTomoFrame' sh) (StateT [(Int, FilePath)] IO) r
+saveMulti' p b mt = forever $ do
+ idxPonies <- lift get
+ f'@(DifTomoFrame' f@(DifTomoFrame _ idx _ _ _) poniPath) <- await
+ let directory = takeDirectory poniPath
+ let filename = directory </> "multi.py"
+ let (script, _) = createMultiPy p b mt filename f' idxPonies
+ ExitSuccess ← lift . lift $ if (difTomoFrameEOF f) then (run script True) else return ExitSuccess
+ lift $ put $! (idxPonies ++ [(idx, poniPath)])
+
+saveMultiGeometry ∷ XrdOneDParams a → DIM1 → Maybe Threshold → Consumer (DifTomoFrame' sh) IO r
+saveMultiGeometry p b mt = evalStateP [] (saveMulti' p b mt)
+
+
+-- substract a sample from another one
+
+targetMulti' ∷ XrdOneDParams a → AbsDirPath → XrdNxs → (FilePath, FilePath)
+targetMulti' _ output (XrdNxs _ _ _ _ (XrdSourceNxs (Nxs f _))) = (d, o)
+ where
+ d = getScanDir output f
+ o = d </> "multi.dat"
+
+targetMulti ∷ XrdOneDParams a → XRDSample → [(FilePath, FilePath)]
+targetMulti p (XRDSample _ output nxss) = map (targetMulti' p output) nxss
+
+substractMulti' ∷ XrdOneDParams a → XRDSample → XRDSample → IO ()
+substractMulti' p s1@(XRDSample name _ _) s2 = do
+ -- compute the output of the s1 sample
+ -- we take only the first list of the sample
+ let f1s:_ = targetMulti p s1
+ -- compute the output of the s2 sample
+ let f2s = targetMulti p s2
+ -- do the substraction via a python script and add the gnuplot file
+ _ ← mapConcurrently (go f1s) f2s
+
+ return ()
+ where
+ go ∷ (FilePath, FilePath) → (FilePath, FilePath) → IO ()
+ go (_, f1) (d, f2) = do
+ -- compute the substracted output file names
+ let outputs = dropExtension f2 ++ "-" ++ name <.> "dat"
+ -- compute the script name
+ let scriptPath = d </> "multi-substract.py"
+ let script = substractPy [f1] [f2] [outputs] scriptPath
+ ExitSuccess ← run script False
+ -- gnuplot
+ let gnuplotPath = d </> "multi-substract.gnuplot"
+ scriptSave $ mkGnuplot [outputs] gnuplotPath
+ return ()
+
+substractMulti ∷ XrdOneDParams a → XRDSample → [XRDSample] → IO ()
+substractMulti p s ss = mapM_ (substractMulti' p s) ss
diff --git a/contrib/haskell/src/Hkl/Xrd/ZeroD.hs b/contrib/haskell/src/Hkl/Xrd/ZeroD.hs
new file mode 100644
index 0000000..5de2a42
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Xrd/ZeroD.hs
@@ -0,0 +1,118 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Hkl.Xrd.ZeroD
+ ( XrdZeroDCalibration(..)
+ , XrdZeroDSample(..)
+ , XrdZeroDSource(..)
+ , XrdZeroDParams(..)
+ ) where
+
+import Data.List (intercalate)
+import Data.Text (unlines, pack)
+import Numeric.Units.Dimensional.Prelude (meter, nano, (*~))
+import System.Exit ( ExitCode( ExitSuccess ) )
+import System.FilePath.Posix ((</>), takeFileName)
+import Text.Printf ( printf )
+
+import Hkl.DataSource ( DataItem ( DataItemH5, DataItemConst ) )
+import Hkl.Detector ( Detector )
+import Hkl.Edf ( ExtractEdf, extractEdf )
+import Hkl.Flat ( Flat )
+import Hkl.PyFAI ( AIMethod,Calibrant, PoniExt, Pose
+ , toPyFAICalibArg )
+import Hkl.Python ( toPyVal )
+import Hkl.Nxs ( DataFrameH5Path( XrdZeroDH5Path )
+ , Nxs ( Nxs )
+ , XrdZeroD
+ )
+import Hkl.Script ( Script ( Py2Script, ScriptSh )
+ , Py2, Sh
+ , run
+ , scriptSave
+ )
+import Hkl.Types ( AbsDirPath, SampleName, WaveLength )
+
+-- | Types
+
+data XrdZeroDSource = XrdZeroDSourceNxs (Nxs XrdZeroD) deriving (Show)
+
+data XrdZeroDSample = XrdZeroDSample SampleName AbsDirPath [XrdZeroDSource] deriving (Show)
+
+data XrdZeroDCalibration a = XrdZeroDCalibration XrdZeroDSample (Detector a) Calibrant deriving (Show)
+
+data XrdZeroDParams a = XrdZeroDParams PoniExt (Maybe (Flat a)) AIMethod deriving (Show)
+
+data XrdZeroDFrame = XrdMeshFrame WaveLength Pose deriving (Show)
+
+edf ∷ AbsDirPath → FilePath → Int → FilePath
+edf o n i = o </> f
+ where
+ f = (takeFileName n) ++ printf "_%02d.edf" i
+
+scriptExtractEdf ∷ AbsDirPath → [XrdZeroDSource] → Script Py2
+scriptExtractEdf o es = Py2Script (content, scriptPath)
+ where
+ content = Data.Text.unlines $
+ map Data.Text.pack [ "#!/usr/bin/env python"
+ , ""
+ , "from fabio.edfimage import edfimage"
+ , "from h5py import File"
+ , ""
+ , "NEXUSFILES = " ++ toPyVal nxss
+ , "IDXS = " ++ toPyVal idxs
+ , "IMAGEPATHS = " ++ toPyVal (imgs ∷ [String])
+ , "OUTPUTS = " ++ toPyVal outputs
+ , ""
+ , "for filename, i, p, o in zip(NEXUSFILES, IDXS, IMAGEPATHS, OUTPUTS):"
+ , " with File(filename, mode='r') as f:"
+ , " edfimage(f[p][i]).write(o)"
+ ]
+
+ idx ∷ Int
+ idx = 0
+
+ (nxss, idxs, imgs) = unzip3 [(f, idx, img)
+ | (XrdZeroDSourceNxs (Nxs f (XrdZeroDH5Path (DataItemH5 img _) _))) ← es]
+
+ outputs ∷ [FilePath]
+ outputs = zipWith (edf o) nxss idxs
+
+ scriptPath ∷ FilePath
+ scriptPath = o </> "pre-calibration.py"
+
+scriptPyFAICalib ∷ AbsDirPath → XrdZeroDSource → Detector a → Calibrant → Script Sh
+scriptPyFAICalib o e@(XrdZeroDSourceNxs (Nxs n _)) d c = ScriptSh (content, scriptPath)
+ where
+ content = Data.Text.unlines $
+ map Data.Text.pack [ "#!/usr/bin/env sh"
+ , ""
+ , "pyFAI-calib " ++ intercalate " " args
+ ]
+
+ args = [ toPyFAICalibArg (readWavelength e)
+ , toPyFAICalibArg c
+ , toPyFAICalibArg d
+ , toPyFAICalibArg (edf o n i) ]
+
+ scriptPath ∷ FilePath
+ scriptPath = o </> (takeFileName n) ++ printf "_%02d.sh" i
+
+ i ∷ Int
+ i = 0
+
+readWavelength :: XrdZeroDSource -> WaveLength
+readWavelength (XrdZeroDSourceNxs (Nxs _ (XrdZeroDH5Path _ (DataItemConst w)))) = w *~ nano meter
+
+instance ExtractEdf (XrdZeroDCalibration a) where
+ extractEdf (XrdZeroDCalibration s d c) = do
+ let script = scriptExtractEdf o es
+ ExitSuccess ← run script False
+ mapM_ go es
+ return ()
+ where
+ go e = scriptSave $ scriptPyFAICalib o e d c
+
+ (XrdZeroDSample _ o es) = s
diff --git a/contrib/haskell/src/Tango/DeviceProxy.hsc b/contrib/haskell/src/Tango/DeviceProxy.hsc
new file mode 100644
index 0000000..923ccf0
--- /dev/null
+++ b/contrib/haskell/src/Tango/DeviceProxy.hsc
@@ -0,0 +1,47 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Tango.DeviceProxy (
+ deviceproxy
+ , DeviceProxy ) where
+
+import Control.Exception
+
+import Foreign.C
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.Marshal.Array
+import Foreign.Marshal.Alloc
+
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+#include "tango.h"
+
+data DeviceProxy = DeviceProxy
+
+foreign import ccall "_ZN5Tango11DeviceProxyC1EPKcPN5CORBA3ORBE" deviceproxy_DeviceProxy :: (Ptr DeviceProxy) -> CString -> Ptr a -> IO ()
+
+class New a where
+ new :: IO (Ptr a)
+
+instance Storable DeviceProxy where
+ sizeOf _ = #{size Tango::DeviceProxy}
+
+deviceproxy :: String -> IO (Ptr DeviceProxy)
+deviceproxy d = do
+ device <- newCString d
+ dev <- malloc :: IO (Ptr DeviceProxy)
+ deviceproxy_DeviceProxy dev device nullPtr
+ return dev
+
+main :: IO ()
+main = do
+ diffractometer <- catch (deviceproxy "toto")
+ (\e -> do let err = show (e :: IOException)
+ hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
+ return "")
+ return ()
diff --git a/contrib/haskell/src/ghkl.hs b/contrib/haskell/src/ghkl.hs
new file mode 100644
index 0000000..0ae7f19
--- /dev/null
+++ b/contrib/haskell/src/ghkl.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Main where
+
+import Data.Vector.Storable (Vector, fromList)
+import Numeric.Units.Dimensional.Prelude (nano, meter, (*~))
+import Pipes
+import qualified Pipes.Prelude as P
+
+import Hkl
+
+testSirius :: IO ()
+testSirius = runEffect $ fromToPipe 6 from to
+ >-> enginesTrajectoryPipe engine
+ >-> solveTrajPipe geometry detector gaAs
+ >-> P.tee P.print
+ >-> P.drain
+ -- >-> computePipe detector gaAs
+ -- >-> P.print
+ where
+ gaAs :: Sample Cubic
+ gaAs = Sample "GaAs" (Cubic (0.56533 *~ nano meter))
+ (Parameter "ux" (-90.003382) (Range (-180) 180))
+ (Parameter "uy" 0.12907 (Range (-180) 180))
+ (Parameter "uz" (-159.91372) (Range (-180) 180))
+
+ geometry ∷ Geometry
+ geometry = Geometry SoleilSiriusKappa (Source (0.1458637 *~ nano meter))
+ (fromList [-0.5193202, 64.7853160, 133.5621380, -80.9690000, -0.0223369, 30.0000299])
+ (Just [ Parameter "mu" (-0.5193202) (Range (-180) 180)
+ , Parameter "komega" 64.7853160 (Range (-180) 180)
+ , Parameter "kappa" 133.5621380 (Range (-180) 180)
+ , Parameter "kphi" (-80.9690000) (Range (-180) 180)
+ , Parameter "delta" (-0.0223369) (Range (-180) 180)
+ , Parameter "gamma" 30.0000299 (Range (-180) 180)])
+
+ detector ∷ Detector ZeroD
+ detector = ZeroD
+
+ engine ∷ Engine
+ engine = Engine "hkl" [ Parameter "h" 0.0 (Range (-1.0) 1.0)
+ , Parameter "k" 0.0 (Range (-1.0) 1.0)
+ , Parameter "l" 2.0 (Range (-1.0) 1.0)
+ ]
+ (Mode "bissector_vertical" [])
+
+ from ∷ Vector Double
+ from = fromList [0, 0, 1]
+
+ to ∷ Vector Double
+ to = fromList [0, 0, 6]
+
+test :: IO ()
+test = do
+ let sample = Sample "test" (Orthorhombic
+ (1.05394 *~ nano meter)
+ (0.25560 *~ nano meter)
+ (1.49050 *~ nano meter))
+ (Parameter "ux" (-89.8821) (Range (-180) 180))
+ (Parameter "uy" 0.1733 (Range (-180) 180))
+ (Parameter "uz" (-84.0081) (Range (-180) 180))
+
+ let geometry = Geometry Uhv (Source (0.0672929 *~ nano meter))
+ (fromList [0.1794, -160.0013, 21.1381, 0.5194])
+ (Just [ Parameter "mu" 0.1794 (Range (-180) 180)
+ , Parameter "omega" (-160.0013) (Range (-180) 180)
+ , Parameter "delta" 21.1381 (Range (-180) 180)
+ , Parameter "gamma" 0.5194 (Range (-180) 180)])
+ let detector = ZeroD
+
+ -- compute the pseudo axes values
+ pseudoAxes <- compute geometry detector sample
+ print pseudoAxes
+
+ -- solve a pseudo axis problem for the given engine
+ let engine = Engine "hkl" [ Parameter "h" 4.0 (Range (-1.0) 1.0)
+ , Parameter "k" 1.0 (Range (-1.0) 1.0)
+ , Parameter "l" 0.3 (Range (-1.0) 1.0)
+ ]
+ (Mode "zaxis" [])
+
+ print =<< solve geometry detector sample engine
+
+ -- let from = fromList [0, 0, 1 :: Double]
+ -- let to = fromList [0, 1, 1 :: Double]
+ -- runEffect $ fromToPipe 20 from to
+ -- >-> P.print
+ -- -- solve a trajectory with Pipes
+ -- runEffect $ fromToPipe 10000 from to
+ -- >-> enginesTrajectoryPipe engine
+ -- >-> solveTrajPipe factory geometry detector sample
+ -- >-> P.print
+ -- -- >-> P.drain
+
+ return ()
+
+main :: IO ()
+main = testSirius
diff --git a/contrib/haskell/src/hkl.hs b/contrib/haskell/src/hkl.hs
new file mode 100644
index 0000000..4e46a8f
--- /dev/null
+++ b/contrib/haskell/src/hkl.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-
+ Copyright : Copyright (C) 2014-2018 Synchrotron Soleil
+ License : GPL3+
+
+ Maintainer : picca@synchrotron-soleil.fr
+ Stability : Experimental
+ Portability: GHC only?
+-}
+
+import Numeric.LinearAlgebra (Vector, Matrix,
+ vecdisp, disps,
+ dispf)
+
+import Numeric.Units.Dimensional.Prelude (nano, meter, degree,
+ (*~),
+ (*~~), (/~~))
+
+import Options.Applicative hiding ((<>))
+
+import Hkl.Lattice
+import Hkl.Diffractometer
+
+dispv :: Vector Double -> IO ()
+dispv = putStr . vecdisp (disps 2)
+
+disp :: Matrix Double -> IO ()
+disp = putStr . dispf 3
+
+-- command parsing
+data Command
+ = Ca Double Double Double -- ca command
+
+data Options
+ = Options Command
+
+withInfo :: Parser a -> String -> ParserInfo a
+withInfo opts desc = info (helper <*> opts) $ progDesc desc
+
+parseCa :: Parser Command
+parseCa = Ca
+ <$> argument auto (metavar "H")
+ <*> argument auto (metavar "K")
+ <*> argument auto (metavar "L")
+
+parseCommand :: Parser Command
+parseCommand = subparser $
+ command "ca" (parseCa `withInfo` "compute angles for the given hkl")
+
+parseOptions :: Parser Options
+parseOptions = Options <$> parseCommand
+
+-- Actual program logic
+run :: Options -> IO ()
+run (Options cmd) =
+ case cmd of
+ Ca h k l-> do
+ print (solution /~~ degree)
+ dispv (computeHkl e4c solution lattice)
+ disp path
+ where
+ (sol, path) = computeAngles e4c angles lattice mode [h, k, l]
+ s = [30.0, 0.0, 0.0, 0.0, 10.0, 0.0]
+ d = [60.0]
+ angles = (s ++ d) *~~ degree
+ solution = fromMode mode sol angles
+ lattice = Cubic (1.54 *~ nano meter)
+ mode = ModeHklE4CConstantPhi
+
+main :: IO ()
+main = run =<< execParser
+ (parseOptions `withInfo` "Interact with hkl API")
diff --git a/contrib/haskell/src/hkl3d.hs b/contrib/haskell/src/hkl3d.hs
new file mode 100644
index 0000000..751a617
--- /dev/null
+++ b/contrib/haskell/src/hkl3d.hs
@@ -0,0 +1,8 @@
+import Hkl.Projects
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
+main :: IO ()
+-- main = main_calibration
+-- main = main_diffabs
+main = main_sixs
diff --git a/contrib/haskell/src/xrd.hs b/contrib/haskell/src/xrd.hs
new file mode 100644
index 0000000..ced23c6
--- /dev/null
+++ b/contrib/haskell/src/xrd.hs
@@ -0,0 +1,16 @@
+module Main where
+
+import Hkl.Projects
+
+main :: IO ()
+main = do
+ -- irdrx
+ -- martinetto'
+ -- melle
+ -- d2am
+ charlier
+ -- laure
+ -- hercules
+ -- hamon
+ -- schlegel
+ -- romeden