pango (empty) → 0.11.0
raw patch · 18 files changed
+4821/−0 lines, 18 filesdep +arraydep +basedep +cairobuild-type:Customsetup-changed
Dependencies added: array, base, cairo, containers, directory, glib, haskell98, pretty, process
Files
- COPYING +504/−0
- Graphics/Rendering/Pango/Attributes.chs +217/−0
- Graphics/Rendering/Pango/BasicTypes.chs +350/−0
- Graphics/Rendering/Pango/Context.chs +232/−0
- Graphics/Rendering/Pango/Description.chs +254/−0
- Graphics/Rendering/Pango/Enums.chs +147/−0
- Graphics/Rendering/Pango/Font.chs +172/−0
- Graphics/Rendering/Pango/GlyphStorage.chs +193/−0
- Graphics/Rendering/Pango/Layout.chs +1064/−0
- Graphics/Rendering/Pango/Markup.chs +179/−0
- Graphics/Rendering/Pango/Rendering.chs +142/−0
- Graphics/Rendering/Pango/Structs.hsc +457/−0
- Graphics/Rendering/Pango/Types.chs +248/−0
- Gtk2HsSetup.hs +486/−0
- Setup.hs +43/−0
- hspango.h +40/−0
- pango.cabal +76/−0
- template-hsc-gtk2hs.h +17/−0
+ COPYING view
@@ -0,0 +1,504 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 2.1, February 1999++ Copyright (C) 1991, 1999 Free Software Foundation, Inc.+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++[This is the first released version of the Lesser GPL. It also counts+ as the successor of the GNU Library Public License, version 2, hence+ the version number 2.1.]++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+Licenses are intended to guarantee your freedom to share and change+free software--to make sure the software is free for all its users.++ This license, the Lesser General Public License, applies to some+specially designated software packages--typically libraries--of the+Free Software Foundation and other authors who decide to use it. You+can use it too, but we suggest you first think carefully about whether+this license or the ordinary General Public License is the better+strategy to use in any particular case, based on the explanations below.++ When we speak of free software, we are referring to freedom of use,+not price. Our General Public Licenses are designed to make sure that+you have the freedom to distribute copies of free software (and charge+for this service if you wish); that you receive source code or can get+it if you want it; that you can change the software and use pieces of+it in new free programs; and that you are informed that you can do+these things.++ To protect your rights, we need to make restrictions that forbid+distributors to deny you these rights or to ask you to surrender these+rights. These restrictions translate to certain responsibilities for+you if you distribute copies of the library or if you modify it.++ For example, if you distribute copies of the library, whether gratis+or for a fee, you must give the recipients all the rights that we gave+you. You must make sure that they, too, receive or can get the source+code. If you link other code with the library, you must provide+complete object files to the recipients, so that they can relink them+with the library after making changes to the library and recompiling+it. And you must show them these terms so they know their rights.++ We protect your rights with a two-step method: (1) we copyright the+library, and (2) we offer you this license, which gives you legal+permission to copy, distribute and/or modify the library.++ To protect each distributor, we want to make it very clear that+there is no warranty for the free library. Also, if the library is+modified by someone else and passed on, the recipients should know+that what they have is not the original version, so that the original+author's reputation will not be affected by problems that might be+introduced by others.++ Finally, software patents pose a constant threat to the existence of+any free program. We wish to make sure that a company cannot+effectively restrict the users of a free program by obtaining a+restrictive license from a patent holder. Therefore, we insist that+any patent license obtained for a version of the library must be+consistent with the full freedom of use specified in this license.++ Most GNU software, including some libraries, is covered by the+ordinary GNU General Public License. This license, the GNU Lesser+General Public License, applies to certain designated libraries, and+is quite different from the ordinary General Public License. We use+this license for certain libraries in order to permit linking those+libraries into non-free programs.++ When a program is linked with a library, whether statically or using+a shared library, the combination of the two is legally speaking a+combined work, a derivative of the original library. The ordinary+General Public License therefore permits such linking only if the+entire combination fits its criteria of freedom. The Lesser General+Public License permits more lax criteria for linking other code with+the library.++ We call this license the "Lesser" General Public License because it+does Less to protect the user's freedom than the ordinary General+Public License. It also provides other free software developers Less+of an advantage over competing non-free programs. These disadvantages+are the reason we use the ordinary General Public License for many+libraries. However, the Lesser license provides advantages in certain+special circumstances.++ For example, on rare occasions, there may be a special need to+encourage the widest possible use of a certain library, so that it becomes+a de-facto standard. To achieve this, non-free programs must be+allowed to use the library. A more frequent case is that a free+library does the same job as widely used non-free libraries. In this+case, there is little to gain by limiting the free library to free+software only, so we use the Lesser General Public License.++ In other cases, permission to use a particular library in non-free+programs enables a greater number of people to use a large body of+free software. For example, permission to use the GNU C Library in+non-free programs enables many more people to use the whole GNU+operating system, as well as its variant, the GNU/Linux operating+system.++ Although the Lesser General Public License is Less protective of the+users' freedom, it does ensure that the user of a program that is+linked with the Library has the freedom and the wherewithal to run+that program using a modified version of the Library.++ The precise terms and conditions for copying, distribution and+modification follow. Pay close attention to the difference between a+"work based on the library" and a "work that uses the library". The+former contains code derived from the library, whereas the latter must+be combined with the library in order to run.++ GNU LESSER GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License Agreement applies to any software library or other+program which contains a notice placed by the copyright holder or+other authorized party saying it may be distributed under the terms of+this Lesser General Public License (also called "this License").+Each licensee is addressed as "you".++ A "library" means a collection of software functions and/or data+prepared so as to be conveniently linked with application programs+(which use some of those functions and data) to form executables.++ The "Library", below, refers to any such software library or work+which has been distributed under these terms. A "work based on the+Library" means either the Library or any derivative work under+copyright law: that is to say, a work containing the Library or a+portion of it, either verbatim or with modifications and/or translated+straightforwardly into another language. (Hereinafter, translation is+included without limitation in the term "modification".)++ "Source code" for a work means the preferred form of the work for+making modifications to it. For a library, complete source code means+all the source code for all modules it contains, plus any associated+interface definition files, plus the scripts used to control compilation+and installation of the library.++ Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running a program using the Library is not restricted, and output from+such a program is covered only if its contents constitute a work based+on the Library (independent of the use of the Library in a tool for+writing it). Whether that is true depends on what the Library does+and what the program that uses the Library does.+ + 1. You may copy and distribute verbatim copies of the Library's+complete source code as you receive it, in any medium, provided that+you conspicuously and appropriately publish on each copy an+appropriate copyright notice and disclaimer of warranty; keep intact+all the notices that refer to this License and to the absence of any+warranty; and distribute a copy of this License along with the+Library.++ You may charge a fee for the physical act of transferring a copy,+and you may at your option offer warranty protection in exchange for a+fee.++ 2. You may modify your copy or copies of the Library or any portion+of it, thus forming a work based on the Library, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) The modified work must itself be a software library.++ b) You must cause the files modified to carry prominent notices+ stating that you changed the files and the date of any change.++ c) You must cause the whole of the work to be licensed at no+ charge to all third parties under the terms of this License.++ d) If a facility in the modified Library refers to a function or a+ table of data to be supplied by an application program that uses+ the facility, other than as an argument passed when the facility+ is invoked, then you must make a good faith effort to ensure that,+ in the event an application does not supply such function or+ table, the facility still operates, and performs whatever part of+ its purpose remains meaningful.++ (For example, a function in a library to compute square roots has+ a purpose that is entirely well-defined independent of the+ application. Therefore, Subsection 2d requires that any+ application-supplied function or table used by this function must+ be optional: if the application does not supply it, the square+ root function must still compute square roots.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Library,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Library, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote+it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Library.++In addition, mere aggregation of another work not based on the Library+with the Library (or with a work based on the Library) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may opt to apply the terms of the ordinary GNU General Public+License instead of this License to a given copy of the Library. To do+this, you must alter all the notices that refer to this License, so+that they refer to the ordinary GNU General Public License, version 2,+instead of to this License. (If a newer version than version 2 of the+ordinary GNU General Public License has appeared, then you can specify+that version instead if you wish.) Do not make any other change in+these notices.++ Once this change is made in a given copy, it is irreversible for+that copy, so the ordinary GNU General Public License applies to all+subsequent copies and derivative works made from that copy.++ This option is useful when you wish to copy part of the code of+the Library into a program that is not a library.++ 4. You may copy and distribute the Library (or a portion or+derivative of it, under Section 2) in object code or executable form+under the terms of Sections 1 and 2 above provided that you accompany+it with the complete corresponding machine-readable source code, which+must be distributed under the terms of Sections 1 and 2 above on a+medium customarily used for software interchange.++ If distribution of object code is made by offering access to copy+from a designated place, then offering equivalent access to copy the+source code from the same place satisfies the requirement to+distribute the source code, even though third parties are not+compelled to copy the source along with the object code.++ 5. A program that contains no derivative of any portion of the+Library, but is designed to work with the Library by being compiled or+linked with it, is called a "work that uses the Library". Such a+work, in isolation, is not a derivative work of the Library, and+therefore falls outside the scope of this License.++ However, linking a "work that uses the Library" with the Library+creates an executable that is a derivative of the Library (because it+contains portions of the Library), rather than a "work that uses the+library". The executable is therefore covered by this License.+Section 6 states terms for distribution of such executables.++ When a "work that uses the Library" uses material from a header file+that is part of the Library, the object code for the work may be a+derivative work of the Library even though the source code is not.+Whether this is true is especially significant if the work can be+linked without the Library, or if the work is itself a library. The+threshold for this to be true is not precisely defined by law.++ If such an object file uses only numerical parameters, data+structure layouts and accessors, and small macros and small inline+functions (ten lines or less in length), then the use of the object+file is unrestricted, regardless of whether it is legally a derivative+work. (Executables containing this object code plus portions of the+Library will still fall under Section 6.)++ Otherwise, if the work is a derivative of the Library, you may+distribute the object code for the work under the terms of Section 6.+Any executables containing that work also fall under Section 6,+whether or not they are linked directly with the Library itself.++ 6. As an exception to the Sections above, you may also combine or+link a "work that uses the Library" with the Library to produce a+work containing portions of the Library, and distribute that work+under terms of your choice, provided that the terms permit+modification of the work for the customer's own use and reverse+engineering for debugging such modifications.++ You must give prominent notice with each copy of the work that the+Library is used in it and that the Library and its use are covered by+this License. You must supply a copy of this License. If the work+during execution displays copyright notices, you must include the+copyright notice for the Library among them, as well as a reference+directing the user to the copy of this License. Also, you must do one+of these things:++ a) Accompany the work with the complete corresponding+ machine-readable source code for the Library including whatever+ changes were used in the work (which must be distributed under+ Sections 1 and 2 above); and, if the work is an executable linked+ with the Library, with the complete machine-readable "work that+ uses the Library", as object code and/or source code, so that the+ user can modify the Library and then relink to produce a modified+ executable containing the modified Library. (It is understood+ that the user who changes the contents of definitions files in the+ Library will not necessarily be able to recompile the application+ to use the modified definitions.)++ b) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (1) uses at run time a+ copy of the library already present on the user's computer system,+ rather than copying library functions into the executable, and (2)+ will operate properly with a modified version of the library, if+ the user installs one, as long as the modified version is+ interface-compatible with the version that the work was made with.++ c) Accompany the work with a written offer, valid for at+ least three years, to give the same user the materials+ specified in Subsection 6a, above, for a charge no more+ than the cost of performing this distribution.++ d) If distribution of the work is made by offering access to copy+ from a designated place, offer equivalent access to copy the above+ specified materials from the same place.++ e) Verify that the user has already received a copy of these+ materials or that you have already sent this user a copy.++ For an executable, the required form of the "work that uses the+Library" must include any data and utility programs needed for+reproducing the executable from it. However, as a special exception,+the materials to be distributed need not include anything that is+normally distributed (in either source or binary form) with the major+components (compiler, kernel, and so on) of the operating system on+which the executable runs, unless that component itself accompanies+the executable.++ It may happen that this requirement contradicts the license+restrictions of other proprietary libraries that do not normally+accompany the operating system. Such a contradiction means you cannot+use both them and the Library together in an executable that you+distribute.++ 7. You may place library facilities that are a work based on the+Library side-by-side in a single library together with other library+facilities not covered by this License, and distribute such a combined+library, provided that the separate distribution of the work based on+the Library and of the other library facilities is otherwise+permitted, and provided that you do these two things:++ a) Accompany the combined library with a copy of the same work+ based on the Library, uncombined with any other library+ facilities. This must be distributed under the terms of the+ Sections above.++ b) Give prominent notice with the combined library of the fact+ that part of it is a work based on the Library, and explaining+ where to find the accompanying uncombined form of the same work.++ 8. You may not copy, modify, sublicense, link with, or distribute+the Library except as expressly provided under this License. Any+attempt otherwise to copy, modify, sublicense, link with, or+distribute the Library is void, and will automatically terminate your+rights under this License. However, parties who have received copies,+or rights, from you under this License will not have their licenses+terminated so long as such parties remain in full compliance.++ 9. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Library or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Library (or any work based on the+Library), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Library or works based on it.++ 10. Each time you redistribute the Library (or any work based on the+Library), the recipient automatically receives a license from the+original licensor to copy, distribute, link with or modify the Library+subject to these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties with+this License.++ 11. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Library at all. For example, if a patent+license would not permit royalty-free redistribution of the Library by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Library.++If any portion of this section is held invalid or unenforceable under any+particular circumstance, the balance of the section is intended to apply,+and the section as a whole is intended to apply in other circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 12. If the distribution and/or use of the Library is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Library under this License may add+an explicit geographical distribution limitation excluding those countries,+so that distribution is permitted only in or among countries not thus+excluded. In such case, this License incorporates the limitation as if+written in the body of this License.++ 13. The Free Software Foundation may publish revised and/or new+versions of the Lesser General Public License from time to time.+Such new versions will be similar in spirit to the present version,+but may differ in detail to address new problems or concerns.++Each version is given a distinguishing version number. If the Library+specifies a version number of this License which applies to it and+"any later version", you have the option of following the terms and+conditions either of that version or of any later version published by+the Free Software Foundation. If the Library does not specify a+license version number, you may choose any version ever published by+the Free Software Foundation.++ 14. If you wish to incorporate parts of the Library into other free+programs whose distribution conditions are incompatible with these,+write to the author to ask for permission. For software which is+copyrighted by the Free Software Foundation, write to the Free+Software Foundation; we sometimes make exceptions for this. Our+decision will be guided by the two goals of preserving the free status+of all derivatives of our free software and of promoting the sharing+and reuse of software generally.++ NO WARRANTY++ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH+DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Libraries++ If you develop a new library, and you want it to be of the greatest+possible use to the public, we recommend making it free software that+everyone can redistribute and change. You can do so by permitting+redistribution under these terms (or, alternatively, under the terms of the+ordinary General Public License).++ To apply these terms, attach the following notices to the library. It is+safest to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least the+"copyright" line and a pointer to where the full notice is found.++ <one line to give the library's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This library is free software; you can redistribute it and/or+ modify it under the terms of the GNU Lesser General Public+ License as published by the Free Software Foundation; either+ version 2.1 of the License, or (at your option) any later version.++ This library is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+ Lesser General Public License for more details.++ You should have received a copy of the GNU Lesser General Public+ License along with this library; if not, write to the Free Software+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA++Also add information on how to contact you by electronic and paper mail.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the library, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the+ library `Frob' (a library for tweaking knobs) written by James Random Hacker.++ <signature of Ty Coon>, 1 April 1990+ Ty Coon, President of Vice++That's all there is to it!++
+ Graphics/Rendering/Pango/Attributes.chs view
@@ -0,0 +1,217 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) - pango text attributes+--+-- Author : Axel Simon+--+-- Created: 20 October 2005+--+-- Copyright (C) 1999-2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- #hide++-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- Defines text attributes.+--+module Graphics.Rendering.Pango.Attributes (+ withAttrList,+ parseMarkup,+ fromAttrList,+ readAttrList+ ) where++import System.Glib.FFI+import System.Glib.UTFString+import System.Glib.GError+import System.Glib.GList+import Graphics.Rendering.Pango.Structs+{#import Graphics.Rendering.Pango.BasicTypes#}+import Data.List ( sortBy )+import Data.Char ( ord, chr )+import Control.Monad ( liftM )++{# context lib="pango" prefix="pango" #}++foreign import ccall unsafe "pango_attr_list_unref"+ pango_attr_list_unref :: PangoAttrList -> IO ()++-- Create an attribute list.+withAttrList :: PangoString -> [PangoAttribute] -> (Ptr () -> IO a) -> IO a+withAttrList _ [] act = act nullPtr+withAttrList (PangoString correct _ _) pas act = do+ alPtr <- {#call unsafe attr_list_new#}+ let pas' = sortBy (\pa1 pa2 -> case compare (paStart pa1) (paStart pa2) of+ EQ -> compare (paEnd pa1) (paEnd pa2)+ other -> other) pas+ mapM_ (\pa -> do+ paPtr <- crAttr correct pa+ {#call unsafe pango_attr_list_insert#} alPtr (castPtr paPtr)) pas'+ res <- act alPtr+ pango_attr_list_unref alPtr+ return res++-- Create a PangoAttribute.+crAttr :: UTFCorrection -> PangoAttribute -> IO CPangoAttribute+crAttr c AttrLanguage { paStart=s, paEnd=e, paLang = lang } =+ setAttrPos c s e $ {#call unsafe attr_language_new#} lang+crAttr c AttrFamily { paStart=s, paEnd=e, paFamily = fam } =+ setAttrPos c s e $ withUTFString fam $ {#call unsafe attr_family_new#}+crAttr c AttrStyle { paStart=s, paEnd=e, paStyle = style } =+ setAttrPos c s e $+ {#call unsafe attr_style_new#} (fromIntegral (fromEnum style))+crAttr c AttrWeight { paStart=s, paEnd=e, paWeight = weight } =+ setAttrPos c s e $+ {#call unsafe attr_weight_new#} (fromIntegral (fromEnum weight))+crAttr c AttrVariant { paStart=s, paEnd=e, paVariant = variant } =+ setAttrPos c s e $+ {#call unsafe attr_variant_new#} (fromIntegral (fromEnum variant))+crAttr c AttrStretch { paStart=s, paEnd=e, paStretch = stretch } =+ setAttrPos c s e $+ {#call unsafe attr_stretch_new#} (fromIntegral (fromEnum stretch))+crAttr c AttrSize { paStart=s, paEnd=e, paSize = pu } =+ setAttrPos c s e $ {#call unsafe attr_size_new#} (puToInt pu)+#if PANGO_VERSION_CHECK(1,8,0)+crAttr c AttrAbsSize { paStart=s, paEnd=e, paSize = pu } =+ setAttrPos c s e $ {#call unsafe attr_size_new_absolute#} (puToInt pu)+#endif+crAttr c AttrFontDescription { paStart=s, paEnd=e, paFontDescription = fd } =+ setAttrPos c s e $ {#call unsafe attr_font_desc_new#} fd+crAttr c AttrForeground { paStart=s, paEnd=e, paColor = Color r g b } =+ setAttrPos c s e $ {#call unsafe attr_foreground_new#}+ (fromIntegral r) (fromIntegral g) (fromIntegral b)+crAttr c AttrBackground { paStart=s, paEnd=e, paColor = Color r g b } =+ setAttrPos c s e $ {#call unsafe attr_background_new#}+ (fromIntegral r) (fromIntegral g) (fromIntegral b)+crAttr c AttrUnderline { paStart=s, paEnd=e, paUnderline = underline } =+ setAttrPos c s e $ do+ {#call unsafe attr_underline_new#} (fromIntegral (fromEnum underline))+#if (defined (WIN32) && PANGO_VERSION_CHECK(1,10,0)) \+ || (!defined (WIN32) && PANGO_VERSION_CHECK(1,8,0))+crAttr c AttrUnderlineColor {paStart=s, paEnd=e, paColor = Color r g b } =+ setAttrPos c s e $ {#call unsafe attr_underline_color_new#}+ (fromIntegral r) (fromIntegral g) (fromIntegral b)+#endif+crAttr c AttrStrikethrough { paStart=s, paEnd=e, paStrikethrough = st } =+ setAttrPos c s e $ do+ {#call unsafe attr_strikethrough_new#} (fromIntegral (fromEnum st))+#if (defined (WIN32) && PANGO_VERSION_CHECK(1,10,0)) \+ || (!defined (WIN32) && PANGO_VERSION_CHECK(1,8,0))+crAttr c AttrStrikethroughColor {paStart=s, paEnd=e, paColor = Color r g b } =+ setAttrPos c s e $ {#call unsafe attr_strikethrough_color_new#}+ (fromIntegral r) (fromIntegral g) (fromIntegral b)+#endif+crAttr c AttrRise { paStart=s, paEnd=e, paRise = pu } =+ setAttrPos c s e $ {#call unsafe attr_rise_new#} (puToInt pu)+#if PANGO_VERSION_CHECK(1,8,0)+crAttr c AttrShape { paStart=s, paEnd=e, paInk = rect1, paLogical = rect2 } =+ setAttrPos c s e $ alloca $ \rect1Ptr -> alloca $ \rect2Ptr -> do+ poke rect1Ptr rect1+ poke rect2Ptr rect2+ {#call unsafe attr_shape_new#} (castPtr rect1Ptr) (castPtr rect2Ptr)+#endif+crAttr c AttrScale { paStart=s, paEnd=e, paScale = scale } =+ setAttrPos c s e $ + {#call unsafe attr_scale_new#} (realToFrac scale)+#if PANGO_VERSION_CHECK(1,4,0)+crAttr c AttrFallback { paStart=s, paEnd=e, paFallback = fb } =+ setAttrPos c s e $+ {#call unsafe attr_fallback_new#} (fromBool fb)+#endif+#if PANGO_VERSION_CHECK(1,6,0)+crAttr c AttrLetterSpacing { paStart=s, paEnd=e, paLetterSpacing = pu } =+ setAttrPos c s e $+ {#call unsafe attr_letter_spacing_new#} (puToInt pu)+#endif+#if PANGO_VERSION_CHECK(1,16,0)+crAttr c AttrGravity { paStart=s, paEnd=e, paGravity = g } =+ setAttrPos c s e $+ {#call unsafe attr_gravity_new#} (fromIntegral (fromEnum g))+crAttr c AttrGravityHint { paStart=s, paEnd=e, paGravityHint = g } =+ setAttrPos c s e $+ {#call unsafe attr_gravity_hint_new#} (fromIntegral (fromEnum g))+#endif++-- | Parse the marked-up text (see 'Graphics.UI.Gtk.Pango.Markup.Markup'+-- format) to create a plain-text string and an attribute list.+--+-- * The attribute list is a list of lists of attribute. Each list describes+-- the attributes for the same span.+--+-- * If @accelMarker@ is not @'\0'@ (a zero character), the given character+-- will mark the character following it as an accelerator. For example,+-- @accelMarker@ might be an ampersand or underscore. All characters marked+-- as an accelerator will receive a 'UnderlineLow' attribute, and the+-- first character so marked will be returned as @accelChar@. If no+-- accelerator character is found, the @accelMarker@ character itself is+-- returned. Two @accelMarker@ characters following each other produce a+-- single literal @accelMarker@ character.+--+-- * If a parsing error occurs a 'System.Glib.GError.GError' is thrown.+--+parseMarkup :: Markup -- ^ the string containing markup+ -> Char -- ^ @accelMarker@ - the character that prefixes an accelerator+ -> IO ([[PangoAttribute]], Char, String) -- ^ list of attributes, the accelerator character found and the input string+ -- without markup+parseMarkup markup accelMarker = propagateGError $ \errPtr ->+ withUTFStringLen markup $ \(markupPtr,markupLen) ->+ alloca $ \attrListPtr ->+ alloca $ \strPtrPtr ->+ alloca $ \accelPtr -> do+ poke accelPtr (fromIntegral (ord accelMarker))+ success <- {#call unsafe pango_parse_markup#} markupPtr+ (fromIntegral markupLen) (fromIntegral (ord accelMarker))+ (castPtr attrListPtr) strPtrPtr accelPtr errPtr+ if not (toBool success) then return undefined else do+ accel <- peek accelPtr+ strPtr <- peek strPtrPtr+ str <- peekUTFString strPtr+ {#call unsafe g_free#} (castPtr strPtr)+ attrList <- peek attrListPtr+ attrs <- fromAttrList (genUTFOfs str) attrList+ return (attrs, chr (fromIntegral accel), str)++{#pointer *PangoAttrIterator #}++-- | Convert an attribute list into a list of attributes.+fromAttrList :: UTFCorrection -> PangoAttrList -> IO [[PangoAttribute]]+fromAttrList correct attrListPtr = do+ iter <- {#call unsafe pango_attr_list_get_iterator#} attrListPtr+ let readIter = do+ list <- {#call unsafe pango_attr_iterator_get_attrs#} iter+ attrs <- if list==nullPtr then return [] else do+ attrPtrs <- fromGSList list+ mapM (fromAttr correct) attrPtrs+ more <- {#call unsafe pango_attr_iterator_next#} iter+ if toBool more then liftM ((:) attrs) $ readIter else return []+ elems <- readIter+ {#call unsafe pango_attr_iterator_destroy#} iter+ return elems++-- | Extract and delete an attribute.+--+fromAttr :: UTFCorrection -> CPangoAttribute -> IO PangoAttribute+fromAttr correct attrPtr = do+ attr <- readAttr correct attrPtr+ {#call unsafe pango_attribute_destroy#} attrPtr+ return attr++readAttrList :: UTFCorrection -> PangoAttrList -> IO [[PangoAttribute]]+readAttrList correct attrListPtr = do+ elems <- fromAttrList correct attrListPtr+ pango_attr_list_unref attrListPtr+ return elems
+ Graphics/Rendering/Pango/BasicTypes.chs view
@@ -0,0 +1,350 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) - pango non-GObject types PangoTypes+--+-- Author : Axel Simon+--+-- Created: 9 Feburary 2003+--+-- Copyright (C) 1999-2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- #hide++-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- Define types used in Pango which are not derived from GObject.+--+module Graphics.Rendering.Pango.BasicTypes (+ GInt,+ + Language(Language),+ emptyLanguage,+ languageFromString,++ FontStyle(..),+ Weight(..),+ Variant(..),+ Stretch(..),+ Underline(..),+#if PANGO_VERSION_CHECK(1,16,0)+ PangoGravity(..),+ PangoGravityHint(..),+#endif+ PangoString(PangoString),+ makeNewPangoString,+ withPangoString,++ PangoItem(PangoItem),+ PangoItemRaw(PangoItemRaw),+ makeNewPangoItemRaw,+ withPangoItemRaw,++ GlyphItem(GlyphItem),+ GlyphStringRaw(GlyphStringRaw),+ makeNewGlyphStringRaw,++ PangoLayout(PangoLayout),++ LayoutIter(LayoutIter),+ LayoutIterRaw(LayoutIterRaw),+ makeNewLayoutIterRaw,++ LayoutLine(LayoutLine),+ LayoutLineRaw(LayoutLineRaw),+ makeNewLayoutLineRaw,+ FontDescription(FontDescription),+ makeNewFontDescription,++ PangoAttrList,+ CPangoAttribute,+ ) where++import Control.Monad (liftM)+import Data.IORef ( IORef )+import System.Glib.FFI+import System.Glib.UTFString+{#import Graphics.Rendering.Pango.Types#} (Font, PangoLayoutRaw)+-- {#import Graphics.Rendering.Pango.Enums#}++{# context lib="pango" prefix="pango" #}++-- | An RFC-3066 language designator to choose scripts.+--+{#pointer* Language newtype#} deriving Eq++-- | Define the gint that c2hs is the Haskell type.+type GInt = {#type gint#}++instance Show Language where+ show (Language ptr)+ | ptr==nullPtr = ""+ | otherwise = unsafePerformIO $ peekUTFString (castPtr ptr)++-- | Specifying no particular language.+emptyLanguage :: Language+emptyLanguage = Language nullPtr++-- | Take a RFC-3066 format language tag as a string and convert it to a+-- 'Language' type that can be efficiently passed around and compared with+-- other language tags.+--+-- * This function first canonicalizes the string by converting it to+-- lowercase, mapping \'_\' to \'-\', and stripping all characters+-- other than letters and \'-\'.+--+languageFromString :: String -> IO Language+languageFromString language = liftM Language $+ withUTFString language {#call language_from_string#}++-- | The style of a font.+--+-- * 'StyleOblique' is a slanted font like 'StyleItalic', +-- but in a roman style.+--+{#enum Style as FontStyle {underscoreToCase} deriving (Eq)#}++instance Show FontStyle where+ showsPrec _ StyleNormal = shows "normal"+ showsPrec _ StyleOblique = shows "oblique"+ showsPrec _ StyleItalic = shows "italic"++-- | Define attributes for 'Weight'.+--+{#enum Weight {underscoreToCase} deriving (Eq)#}++instance Show Weight where+ showsPrec _ WeightUltralight = shows "ultralight"+ showsPrec _ WeightLight = shows "light"+ showsPrec _ WeightNormal = shows "normal"+ showsPrec _ WeightBold = shows "bold"+ showsPrec _ WeightUltrabold = shows "ultrabold"+ showsPrec _ WeightHeavy = shows "heavy"++-- | The variant of a font.+--+-- * The 'VariantSmallCaps' is a version of a font where lower case+-- letters are shown as physically smaller upper case letters.+--+{#enum Variant {underscoreToCase} deriving (Eq)#}++instance Show Variant where+ showsPrec _ VariantNormal = shows "normal"+ showsPrec _ VariantSmallCaps = shows "smallcaps"++-- | Define how wide characters are.+--+{#enum Stretch {underscoreToCase} deriving (Eq)#}++instance Show Stretch where+ showsPrec _ StretchUltraCondensed = shows "ultracondensed"+ showsPrec _ StretchExtraCondensed = shows "extracondensed"+ showsPrec _ StretchCondensed = shows "condensed"+ showsPrec _ StretchSemiCondensed = shows "semicondensed"+ showsPrec _ StretchNormal = shows "normal"+ showsPrec _ StretchSemiExpanded = shows "semiexpanded"+ showsPrec _ StretchExpanded = shows "expanded"+ showsPrec _ StretchExtraExpanded = shows "extraexpanded"+ showsPrec _ StretchUltraExpanded = shows "ultraexpanded"++-- | Define attributes for 'Underline'.+--+-- * The squiggly underline for errors is only available in Gtk 2.4 and higher.+--+{#enum Underline {underscoreToCase} deriving (Eq)#}++instance Show Underline where+ showsPrec _ UnderlineNone = shows "none"+ showsPrec _ UnderlineSingle = shows "single"+ showsPrec _ UnderlineDouble = shows "double"+ showsPrec _ UnderlineLow = shows "low"+ showsPrec _ UnderlineError = shows "error"++#if PANGO_VERSION_CHECK(1,16,0)+-- | The 'PangoGravity' type represents the orientation of glyphs in a+-- segment of text. The value 'GravitySouth', for instance, indicates that the+-- text stands upright, i.e. that the base of the letter is directed+-- downwards.+--+-- This is useful when rendering vertical text layouts. In those situations,+-- the layout is rotated using a non-identity 'PangoMatrix', and then glyph+-- orientation is controlled using 'PangoGravity'. Not every value in this+-- enumeration makes sense for every usage of 'Gravity'; for example,+-- 'PangoGravityAuto' only can be passed to 'pangoContextSetBaseGravity' and+-- can only be returned by 'pangoContextGetBaseGravity'.+--+-- * See also: 'PangoGravityHint'+--+-- * Gravity is resolved from the context matrix.+--+-- * Since Pango 1.16+--+{#enum PangoGravity {underscoreToCase} with prefix="" deriving (Eq)#}++instance Show PangoGravity where+ show PangoGravitySouth = "south"+ show PangoGravityEast = "east"+ show PangoGravityNorth = "north"+ show PangoGravityWest = "west"+ show PangoGravityAuto = "auto"+ +-- | The 'PangoGravityHint' defines how horizontal scripts should behave in a+-- vertical context.+--+-- * 'PangoGravityHintNatural': scripts will take their natural gravity based+-- on the base gravity and the script. This is the default.+--+-- * 'PangoGravityHintStrong': always use the base gravity set, regardless of+-- the script.+--+-- * 'PangoGravityHintLine': for scripts not in their natural direction (eg.+-- Latin in East gravity), choose per-script gravity such that every script+-- respects the line progression. This means, Latin and Arabic will take+-- opposite gravities and both flow top-to-bottom for example.+--+{#enum PangoGravityHint {underscoreToCase} with prefix="" deriving (Eq)#}++instance Show PangoGravityHint where+ show PangoGravityHintNatural = "natural"+ show PangoGravityHintStrong = "strong"+ show PangoGravityHintLine = "line"++#endif++-- A string that is stored with each GlyphString, PangoItem+data PangoString = PangoString UTFCorrection CInt (ForeignPtr CChar)++makeNewPangoString :: String -> IO PangoString+makeNewPangoString str = do+ let correct = genUTFOfs str+ (strPtr, len) <- newUTFStringLen str+ let cLen = fromIntegral len+ liftM (PangoString correct cLen) $ newForeignPtr strPtr finalizerFree++withPangoString :: PangoString -> + (UTFCorrection -> CInt -> Ptr CChar -> IO a) -> IO a+withPangoString (PangoString c l ptr) act = withForeignPtr ptr $ \strPtr ->+ act c l strPtr++-- paired with PangoString to create a Haskell GlyphString+{#pointer *PangoGlyphString as GlyphStringRaw foreign newtype #}++makeNewGlyphStringRaw :: Ptr GlyphStringRaw -> IO GlyphStringRaw+makeNewGlyphStringRaw llPtr = do+ liftM GlyphStringRaw $ newForeignPtr llPtr pango_glyph_string_free++foreign import ccall unsafe "&pango_glyph_string_free"+ pango_glyph_string_free :: FinalizerPtr GlyphStringRaw++-- paired with PangoString and UTFCorrection to create a Haskell PangoItem+{#pointer *PangoItem as PangoItemRaw foreign newtype #}++makeNewPangoItemRaw :: Ptr PangoItemRaw -> IO PangoItemRaw+makeNewPangoItemRaw llPtr = do+ liftM PangoItemRaw $ newForeignPtr llPtr pango_item_free++withPangoItemRaw :: PangoItemRaw -> (Ptr PangoItemRaw -> IO a) -> IO a+withPangoItemRaw (PangoItemRaw pir) act = withForeignPtr pir act++foreign import ccall unsafe "&pango_item_free"+ pango_item_free :: FinalizerPtr PangoItemRaw++#if PANGO_VERSION_CHECK(1,2,0)+{#pointer *PangoGlyphItem as GlyphItemRaw #}+#endif++-- With each GlyphString we pair a UTFCorrection+-- and the marshalled UTF8 string. Together, this data+-- enables us to bind all functions that take or return+-- indices into the CString, rather then unicode position. Note that text+-- handling is particularly horrible with UTF8: Several UTF8 bytes can make+-- up one Unicode character (a Haskell Char), and several Unicode characters+-- can form a cluster (e.g. a letter and an accent). We protect the user from+-- UTF8\/Haskell String conversions, but not from clusters.++-- | A sequence of characters that are rendered with the same settings.+--+-- * A preprocessing stage done by 'itemize' splits the input text into+-- several chunks such that each chunk can be rendered with the same+-- font, direction, slant, etc. Some attributes such as the color,+-- underline or strikethrough do not affect a break into several+-- 'PangoItem's. See also 'GlyphItem'.+--+data PangoItem = PangoItem PangoString PangoItemRaw++-- | A sequence of glyphs for a chunk of a string.+--+-- * A glyph item contains the graphical representation of a 'PangoItem'.+-- Clusters (like @e@ and an accent modifier) as well as legatures+-- (such as @ffi@ turning into a single letter that omits the dot over the+-- @i@) are usually represented as a single glyph. +--+data GlyphItem = GlyphItem PangoItem GlyphStringRaw ++-- | A rendered paragraph.+data PangoLayout = PangoLayout (IORef PangoString) PangoLayoutRaw++-- | An iterator to examine a layout.+--+data LayoutIter = LayoutIter (IORef PangoString) LayoutIterRaw++{#pointer *PangoLayoutIter as LayoutIterRaw foreign newtype #}++makeNewLayoutIterRaw :: Ptr LayoutIterRaw -> IO LayoutIterRaw+makeNewLayoutIterRaw liPtr =+ liftM LayoutIterRaw $ newForeignPtr liPtr layout_iter_free++foreign import ccall unsafe "&pango_layout_iter_free"+ layout_iter_free :: FinalizerPtr LayoutIterRaw++-- | A single line in a 'PangoLayout'.+--+data LayoutLine = LayoutLine (IORef PangoString) LayoutLineRaw++{#pointer *PangoLayoutLine as LayoutLineRaw foreign newtype #}++makeNewLayoutLineRaw :: Ptr LayoutLineRaw -> IO LayoutLineRaw+makeNewLayoutLineRaw llPtr = do+ liftM LayoutLineRaw $ newForeignPtr llPtr pango_layout_line_unref++foreign import ccall unsafe "&pango_layout_line_unref"+ pango_layout_line_unref :: FinalizerPtr LayoutLineRaw++-- | A possibly partial description of font(s).+--+{#pointer *PangoFontDescription as FontDescription foreign newtype #}++makeNewFontDescription :: Ptr FontDescription -> IO FontDescription+makeNewFontDescription llPtr = do+ liftM FontDescription $ newForeignPtr llPtr pango_font_description_free++foreign import ccall unsafe "&pango_font_description_free"+ pango_font_description_free :: FinalizerPtr FontDescription++-- Attributes+{#pointer *PangoAttrList #}++{#pointer *PangoAttribute as CPangoAttribute#}++-- dirty hack to make PangoAttribute showable+instance Show FontDescription where+ show fd = unsafePerformIO $ do+ strPtr <- {#call unsafe font_description_to_string#} fd+ str <- peekUTFString strPtr+ {#call unsafe g_free#} (castPtr strPtr)+ return str++
+ Graphics/Rendering/Pango/Context.chs view
@@ -0,0 +1,232 @@+{-# LANGUAGE CPP #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) - text layout functions Context+--+-- Author : Axel Simon+--+-- Created: 16 October 2005+--+-- Copyright (C) 1999-2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+--+-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- This module defines 'PangoContext's,+-- an environment that provides information on available fonts,+-- internationalization and output capabilities of the medium. Given+-- such a context, text can be rendered into strings of glyphs (see +-- 'Graphics.UI.Gtk.Pango.Rendering') or, at a more abstract level, using+-- layouts (see 'Graphics.UI.Gtk.Pango.Layout').+--+-- * A 'PangoContext' is a prerequisite for all text rendering functions.+-- A context can be created from scratch or, more conveniently, by using+-- default settings that are already used in the application. When text+-- is rendered through Gdk, use+-- 'Graphics.UI.Gtk.Abstract.Widget.widgetCreatePangoContext', if you use+-- the Cairo rendering engine, a new context can be acquired using+-- 'Graphics.UI.Gtk.Cairo.cairoCreateContext'.+--+-- * The properties of a 'PangoContext' can be changed which, in turn, has+-- an effect on how text is rendered. To reflect such a change in the+-- rendered text, call 'Graphics.UI.Gtk.Pango.Layout.layoutContextChanged'.+--+module Graphics.Rendering.Pango.Context (+-- * Types and Methods for 'PangoContext's+ PangoContext,+ contextListFamilies,+-- contextLoadFont,+-- contextLoadFontSet,+ contextGetMetrics,+ contextSetFontDescription,+ contextGetFontDescription,+ Language,+ emptyLanguage,+ languageFromString,+ contextSetLanguage,+ contextGetLanguage,+ contextSetTextDir,+ contextGetTextDir,+#if PANGO_VERSION_CHECK(1,16,0)+ contextSetTextGravity,+ contextGetTextGravity,+ contextSetTextGravityHint,+ contextGetTextGravityHint,+#endif+#if PANGO_VERSION_CHECK(1,6,0)+ contextGetMatrix,+ contextSetMatrix,+#endif+ ) where++import Control.Monad (liftM)++import System.Glib.FFI+import Graphics.Rendering.Pango.Enums+import Graphics.Rendering.Pango.Structs+import System.Glib.GObject (makeNewGObject)+{#import Graphics.Rendering.Pango.Types#}+{#import Graphics.Rendering.Pango.BasicTypes#}+{#import Graphics.Rendering.Pango.Enums#} ( FontMetrics(..) )+{#import Graphics.Rendering.Cairo.Matrix#}+++{# context lib="pango" prefix="pango" #}+++-- | Retrieve a list of all available font families.+--+-- * A font family is the name of the font without further attributes+-- like slant, variant or size.+--+contextListFamilies :: PangoContext -> IO [FontFamily]+contextListFamilies c = alloca $ \sizePtr -> alloca $ \ptrPtr -> do+ {#call unsafe context_list_families#} c ptrPtr sizePtr+ ptr <- peek ptrPtr+ size <- peek sizePtr+ -- c2hs gets FontFamily*** wrong as FontFamily**, therefore the cast+ familyPtrs <- peekArray (fromIntegral size) (castPtr ptr)+ fams <- mapM (makeNewGObject mkFontFamily . return) familyPtrs+ {#call unsafe g_free#} (castPtr ptr)+ return fams++-- | Query the metrics of the given font implied by the font description.+--+contextGetMetrics :: PangoContext -> FontDescription -> Language ->+ IO FontMetrics+contextGetMetrics pc fd l = do+ mPtr <- {#call unsafe context_get_metrics#} pc fd l+ ascent <- {#call unsafe font_metrics_get_ascent#} mPtr+ descent <- {#call unsafe font_metrics_get_descent#} mPtr+ approximate_char_width <-+ {#call unsafe font_metrics_get_approximate_char_width#} mPtr+ approximate_digit_width <-+ {#call unsafe font_metrics_get_approximate_digit_width#} mPtr+#if PANGO_VERSION_CHECK(1,6,0)+ underline_position <-+ {#call unsafe font_metrics_get_underline_position#} mPtr+ underline_thickness <-+ {#call unsafe font_metrics_get_underline_thickness#} mPtr+ strikethrough_position <-+ {#call unsafe font_metrics_get_strikethrough_position#} mPtr+ strikethrough_thickness <-+ {#call unsafe font_metrics_get_strikethrough_thickness#} mPtr+#endif+ return (FontMetrics+ (intToPu ascent)+ (intToPu descent)+ (intToPu approximate_char_width)+ (intToPu approximate_digit_width)+#if PANGO_VERSION_CHECK(1,6,0)+ (intToPu underline_thickness)+ (intToPu underline_position)+ (intToPu strikethrough_thickness)+ (intToPu strikethrough_position)+#endif+ )++-- | Set the default 'FontDescription' of this context.+--+contextSetFontDescription :: PangoContext -> FontDescription -> IO ()+contextSetFontDescription pc fd =+ {#call unsafe context_set_font_description#} pc fd++-- | Get the current 'FontDescription' of this context.+--+contextGetFontDescription :: PangoContext -> IO FontDescription+contextGetFontDescription pc = do+ fdPtrConst <- {#call unsafe context_get_font_description#} pc+ fdPtr <- pango_font_description_copy fdPtrConst+ makeNewFontDescription fdPtr++foreign import ccall unsafe "pango_font_description_copy"+ pango_font_description_copy :: Ptr FontDescription -> + IO (Ptr FontDescription)++-- | Set the default 'Language' of this context.+--+contextSetLanguage :: PangoContext -> Language -> IO ()+contextSetLanguage = {#call unsafe context_set_language#}++-- | Get the current 'Language' of this context.+--+contextGetLanguage :: PangoContext -> IO Language+contextGetLanguage pc = liftM Language $+ {#call unsafe context_get_language#} pc++-- | Set the default text direction of this context.+--+contextSetTextDir :: PangoContext -> PangoDirection -> IO ()+contextSetTextDir pc dir =+ {#call unsafe context_set_base_dir#} pc (fromIntegral (fromEnum dir))++-- | Get the current text direction of this context.+--+contextGetTextDir :: PangoContext -> IO PangoDirection+contextGetTextDir pc = liftM (toEnum . fromIntegral) $+ {#call unsafe context_get_base_dir#} pc++#if PANGO_VERSION_CHECK(1,16,0)+-- | Set the text gravity of this context. If the given value is+-- 'PangoGravityAuto' then the gravity is derived from the current rotation+-- matrix.+--+contextSetTextGravity :: PangoContext -> PangoGravity -> IO ()+contextSetTextGravity pc gravity =+ {#call unsafe context_set_base_gravity#} pc (fromIntegral (fromEnum gravity))++-- | Get the current text gravity of this context.+--+contextGetTextGravity :: PangoContext -> IO PangoGravity+contextGetTextGravity pc = liftM (toEnum . fromIntegral) $+ {#call unsafe context_get_base_gravity#} pc++-- | Set the text gravity hint of this context.+--+contextSetTextGravityHint :: PangoContext -> PangoGravityHint -> IO ()+contextSetTextGravityHint pc gravity =+ {#call unsafe context_set_gravity_hint#} pc (fromIntegral (fromEnum gravity))++-- | Get the current text gravity of this context.+--+contextGetTextGravityHint :: PangoContext -> IO PangoGravityHint+contextGetTextGravityHint pc = liftM (toEnum . fromIntegral) $+ {#call unsafe context_get_gravity_hint#} pc+#endif++#if PANGO_VERSION_CHECK(1,6,0)+-- | Gets the transformation matrix that will be applied when rendering with+-- this context.+--+-- * Since Pango 1.6+contextGetMatrix :: PangoContext -> IO Matrix+contextGetMatrix pc = do+ matPtr <- {#call unsafe context_get_matrix#} pc+ if matPtr==nullPtr then return identity else peek (castPtr matPtr)+ +-- | Sets the transformation matrix that will be applied when rendering with+-- this context. Note that any metrics reported by other functions are in user+-- space coordinates before the application of the matrix, not device-space+-- coordinates after the application of the matrix. So, they don't scale with+-- the matrix, though they may change slightly for different matrices,+-- depending on how the text is fit to the pixel grid.+--+-- * Since Pango 1.6+contextSetMatrix :: PangoContext -> Matrix -> IO ()+contextSetMatrix pc mat+ | mat==identity = {#call unsafe context_set_matrix#} pc nullPtr+ | otherwise = with mat $ \matPtr -> + {#call unsafe context_set_matrix#} pc (castPtr matPtr)+#endif
+ Graphics/Rendering/Pango/Description.chs view
@@ -0,0 +1,254 @@+{-# OPTIONS_HADDOCK hide #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) - text layout functions: Font Descriptions+--+-- Author : Axel Simon+--+-- Created: 8 Feburary 2003+--+-- Copyright (C) 1999-2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- #hide++-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- Functions to manage font descriptions.+--+-- * Font descriptions provide a way to query and state requirements on+-- fonts. This data structure has several fields describing different+-- characteristics of a font. Each of these fields can be set of left+-- unspecified.+--+module Graphics.Rendering.Pango.Description (+ FontDescription,+ fontDescriptionNew,+ fontDescriptionCopy,+ fontDescriptionSetFamily,+ fontDescriptionGetFamily,+ fontDescriptionSetStyle,+ fontDescriptionGetStyle,+ fontDescriptionSetVariant,+ fontDescriptionGetVariant,+ fontDescriptionSetWeight,+ fontDescriptionGetWeight,+ fontDescriptionSetStretch,+ fontDescriptionGetStretch,+ fontDescriptionSetSize,+ fontDescriptionGetSize,+ FontMask(..),+ fontDescriptionUnsetFields,+ fontDescriptionMerge,+ fontDescriptionBetterMatch,+ fontDescriptionFromString,+ fontDescriptionToString+ ) where++import Control.Monad (liftM)++import System.Glib.FFI+import System.Glib.Flags (Flags, fromFlags)+import System.Glib.UTFString+{#import Graphics.Rendering.Pango.Types#}+{#import Graphics.Rendering.Pango.Enums#}+import Graphics.Rendering.Pango.Structs ( puToInt, intToPu )+import Graphics.Rendering.Pango.BasicTypes++{# context lib="pango" prefix="pango_font_description" #}++-- | Create a new font description.+--+-- * All field are unset.+--+fontDescriptionNew :: IO FontDescription+fontDescriptionNew = {#call unsafe new#} >>= makeNewFontDescription ++-- | Make a deep copy of a font description.+--+fontDescriptionCopy :: FontDescription -> IO FontDescription+fontDescriptionCopy fd = {#call unsafe copy#} fd >>= makeNewFontDescription ++-- | Set the font famliy.+--+-- * A font family is a name designating the design of the font (e.g. Sans+-- or Times) without the variant.+--+-- * In some contexts a comma separated list of font families can be used.+--+fontDescriptionSetFamily :: FontDescription -> String -> IO ()+fontDescriptionSetFamily fd family = withUTFString family $ \strPtr ->+ {#call unsafe set_family#} fd strPtr++-- | Get the font family.+--+-- * 'Nothing' is returned if the font family is not set.+--+fontDescriptionGetFamily :: FontDescription -> IO (Maybe String)+fontDescriptionGetFamily fd = do+ strPtr <- {#call unsafe get_family#} fd+ if strPtr==nullPtr then return Nothing else+ liftM Just $ peekUTFString strPtr++-- | Flags denoting which fields in a font description are set.+{#enum PangoFontMask as FontMask {underscoreToCase} deriving(Bounded) #}++instance Flags FontMask++-- | Set the style field.+--+-- * Most fonts will have either a 'StyleItalic' or 'StyleOblique'+-- but rarely both.+--+fontDescriptionSetStyle :: FontDescription -> FontStyle -> IO ()+fontDescriptionSetStyle fd p =+ {#call unsafe set_style#} fd (fromIntegral (fromEnum p))++-- | Get the style field.+fontDescriptionGetStyle :: FontDescription -> IO (Maybe FontStyle)+fontDescriptionGetStyle fd = do+ fields <- {#call unsafe get_set_fields#} fd+ if (fromEnum PangoFontMaskStyle) .&. (fromIntegral fields) /=0+ then liftM (Just . toEnum . fromIntegral) $+ {#call unsafe get_style#} fd+ else return Nothing++-- | Set the variant field.+--+fontDescriptionSetVariant :: FontDescription -> Variant -> IO ()+fontDescriptionSetVariant fd p =+ {#call unsafe set_variant#} fd (fromIntegral (fromEnum p))++-- | Get the variant field.+fontDescriptionGetVariant :: FontDescription -> IO (Maybe Variant)+fontDescriptionGetVariant fd = do+ fields <- {#call unsafe get_set_fields#} fd+ if (fromEnum PangoFontMaskVariant) .&. (fromIntegral fields) /=0+ then liftM (Just . toEnum . fromIntegral) $+ {#call unsafe get_variant#} fd+ else return Nothing++-- | Set the weight field.+--+fontDescriptionSetWeight :: FontDescription -> Weight -> IO ()+fontDescriptionSetWeight fd p =+ {#call unsafe set_weight#} fd (fromIntegral (fromEnum p))++-- | Get the weight field.+fontDescriptionGetWeight :: FontDescription -> IO (Maybe Weight)+fontDescriptionGetWeight fd = do+ fields <- {#call unsafe get_set_fields#} fd+ if (fromEnum PangoFontMaskWeight) .&. (fromIntegral fields) /=0+ then liftM (Just . toEnum . fromIntegral) $+ {#call unsafe get_weight#} fd+ else return Nothing++-- | Set the stretch field.+--+fontDescriptionSetStretch :: FontDescription -> Stretch -> IO ()+fontDescriptionSetStretch fd p =+ {#call unsafe set_stretch#} fd (fromIntegral (fromEnum p))++-- | Get the stretch field.+fontDescriptionGetStretch :: FontDescription -> IO (Maybe Stretch)+fontDescriptionGetStretch fd = do+ fields <- {#call unsafe get_set_fields#} fd+ if (fromEnum PangoFontMaskStretch) .&. (fromIntegral fields) /=0+ then liftM (Just . toEnum . fromIntegral) $ + {#call unsafe get_stretch#} fd+ else return Nothing++-- | Set the size field.+--+-- * The given size is in points (pts). One point is 1\/72 inch.+--+fontDescriptionSetSize :: FontDescription -> Double -> IO ()+fontDescriptionSetSize fd p = + {#call unsafe set_size#} fd (puToInt p)++-- | Get the size field.+fontDescriptionGetSize :: FontDescription -> IO (Maybe Double)+fontDescriptionGetSize fd = do+ fields <- {#call unsafe get_set_fields#} fd+ if (fromEnum PangoFontMaskSize) .&. (fromIntegral fields) /=0+ then liftM (\x -> Just (intToPu x)) $ + {#call unsafe get_size#} fd+ else return Nothing++-- | Reset fields in a font description.+--+fontDescriptionUnsetFields :: FontDescription -> [FontMask] -> IO ()+fontDescriptionUnsetFields fd mask =+ {#call unsafe unset_fields#} fd (fromIntegral (fromFlags mask))++-- | Merge two font descriptions.+--+-- * Copy fields from the second description to the first. If the boolean+-- parameter is set, existing fields in the first description will be+-- replaced.+--+fontDescriptionMerge :: FontDescription -> FontDescription -> Bool -> IO ()+fontDescriptionMerge fd1 fd2 replace =+ {#call unsafe merge#} fd1 fd2 (fromBool replace)++-- | Determine if two descriptions are simliar.+--+-- * Returns 'True' if the two descriptions only differ in weight or style.+--+fontDescriptionIsMatch :: FontDescription -> FontDescription -> Bool+fontDescriptionIsMatch fdA fdB = unsafePerformIO $ liftM toBool $+ {#call unsafe better_match#} fdA (FontDescription nullForeignPtr) fdB++-- | Determine which of two descriptions matches a given description better.+--+-- * Returns @True@ if the last description is a better match to the first+-- arguement than the middle one.+--+-- * Approximate matching is done on weight and style. If the other+-- attributes do not match, the function returns @False@.+--+fontDescriptionBetterMatch :: FontDescription -> FontDescription -> + FontDescription -> Bool+fontDescriptionBetterMatch fd fdA fdB = unsafePerformIO $ liftM toBool $+ {#call unsafe better_match#} fd fdA fdB++-- | Create a font description from a string.+--+-- * The given argument must have the form +-- @[FAMILY-LIST] [STYLE-OPTIONS] [SIZE]@ where @FAMILY_LIST@ is a comma+-- separated list of font families optionally terminated by a comma,+-- @STYLE_OPTIONS@ is a whitespace separated list of words where each+-- word describes one of style, variant, weight or stretch. @SIZE@ is+-- a decimal number giving the size of the font in points. If any of+-- these fields is absent, the resulting 'FontDescription' will have+-- the corresponing fields unset.+--+fontDescriptionFromString :: String -> IO FontDescription+fontDescriptionFromString descr = withUTFString descr $ \strPtr ->+ {#call unsafe from_string#} strPtr >>= makeNewFontDescription++-- | Convert a font description to a string.+--+-- * Creates a string representation of a font description. See+-- 'fontDescriptionFromString' for the format of the string.+--+fontDescriptionToString :: FontDescription -> IO String+fontDescriptionToString fd = do+ strPtr <- {#call unsafe to_string#} fd+ str <- peekUTFString strPtr+ {#call unsafe g_free#} (castPtr strPtr)+ return str+++
+ Graphics/Rendering/Pango/Enums.chs view
@@ -0,0 +1,147 @@+{-# LANGUAGE CPP #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) Enumerations for Pango.+--+-- Author : Axel Simon+--+-- Created: 12 September 2004+--+-- Copyright (C) 1999-2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- Enumerations for describing font characteristics.+--+module Graphics.Rendering.Pango.Enums (+ Markup,+ PangoUnit,+ pangoScale,+ Color(..),+ Rectangle(..),+ PangoRectangle(..),+ Language,+ emptyLanguage,+ languageFromString,++ FontMetrics(..),+ Size(..),+ FontStyle(..),+ Weight(..),+ Variant(..),+ Stretch(..),+ Underline(..),+ PangoDirection(..),+ PangoAttribute(..),+#if PANGO_VERSION_CHECK(1,6,0)+ EllipsizeMode(..),+#endif+#if PANGO_VERSION_CHECK(1,16,0)+ PangoGravity(..),+ PangoGravityHint(..),+#endif+ ) where++{#import Graphics.Rendering.Pango.Types#}+{#import Graphics.Rendering.Pango.BasicTypes#}+import Graphics.Rendering.Pango.Structs++{# context lib="pango" prefix="pango" #}++-- | Define attributes for 'FontSize'.+--+data Size+ = SizePoint Double+ | SizeUnreadable+ | SizeTiny+ | SizeSmall+ | SizeMedium+ | SizeLarge+ | SizeHuge+ | SizeGiant+ | SizeSmaller+ | SizeLarger++instance Show Size where+ showsPrec _ (SizePoint v) = shows $ show (round (v*1000))+ showsPrec _ (SizeUnreadable) = shows "xx-small"+ showsPrec _ (SizeTiny) = shows "x-small"+ showsPrec _ (SizeSmall) = shows "small"+ showsPrec _ (SizeMedium) = shows "medium"+ showsPrec _ (SizeLarge) = shows "large"+ showsPrec _ (SizeHuge) = shows "x-large"+ showsPrec _ (SizeGiant) = shows "xx-large"+ showsPrec _ (SizeSmaller) = shows "smaller"+ showsPrec _ (SizeLarger) = shows "larger"++++#if PANGO_VERSION_CHECK(1,6,0)+-- | The 'EllipsizeMode' type describes what sort of (if any) ellipsization+-- should be applied to a line of text. In the ellipsization process characters+-- are removed from the text in order to make it fit to a given width and+-- replaced with an ellipsis.+--+{# enum EllipsizeMode {underscoreToCase} deriving (Eq) #}+#endif+++-- | The characteristic measurements of a font.+--+-- * All values are measured in pixels.+--+-- * In Pango versions before 1.6 only 'ascent', 'descent',+-- 'approximateCharWidth' and 'approximateDigitWidth' are available.+--+data FontMetrics = FontMetrics {+ -- | The ascent is the distance from the baseline to the logical top+ -- of a line of text. (The logical top may be above or below the+ -- top of the actual drawn ink. It is necessary to lay out the+ -- text to figure where the ink will be.)+ ascent :: Double,+ -- | The descent is the distance from the baseline to the logical+ -- bottom of a line of text. (The logical bottom may be above or+ -- below the bottom of the actual drawn ink. It is necessary to+ -- lay out the text to figure where the ink will be.)+ descent :: Double,+ -- | The approximate character width. This is merely a+ -- representative value useful, for example, for determining the+ -- initial size for a window. Actual characters in text will be+ -- wider and narrower than this.+ approximateCharWidth :: Double,+ -- | The approximate digit width. This is merely a representative+ -- value useful, for example, for determining the initial size for+ -- a window. Actual digits in text can be wider and narrower than+ -- this, though this value is generally somewhat more accurate+ -- than 'approximateCharWidth'.+ approximateDigitWidth :: Double+#if PANGO_VERSION_CHECK(1,6,0)+ ,+ -- | The suggested thickness to draw an underline.+ underlineThickness :: Double,+ -- | The suggested position to draw the underline. The value returned is+ -- the distance above the baseline of the top of the underline. Since+ -- most fonts have underline positions beneath the baseline, this value+ -- is typically negative.+ underlinePosition :: Double,+ -- | The suggested thickness to draw for the strikethrough.+ strikethroughThickenss :: Double,+ -- | The suggested position to draw the strikethrough. The value+ -- returned is the distance above the baseline of the top of the+ -- strikethrough.+ strikethroughPosition :: Double+#endif+ } deriving Show+
+ Graphics/Rendering/Pango/Font.chs view
@@ -0,0 +1,172 @@+{-# LANGUAGE CPP #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) - text layout functions: Font+--+-- Author : Axel Simon+--+-- Created: 16 October 2005+--+-- Copyright (C) 1999-2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- Fonts. The selection of an appropriate font to render text becomes a+-- substantial task in the presence of Unicode where a single font does not+-- cover the whole range of possible characters. Pango provides several+-- concepts to find appropriate fonts and to query information about them:+--+-- * 'FontDescription': Font descriptions provide a way to query and state+-- requirements on+-- fonts. This data structure has several fields describing different+-- characteristics of a font. Each of these fields can be set of left+-- unspecified.+--+-- * 'FontMap' : A font map represents the set of fonts available for a+-- particular rendering system. In particular this map defines the+-- relation between font size and pixel size in terms of the output medium.+--+-- * 'FontFamily' : A font family represents a set of fonts that have+-- related faces, that is, their faces share a common design, but differ+-- in slant, weight, width and other aspects.+--+-- * 'FontFace': A face is a specific font where all characteristics are+-- fixed except for the size.+--+-- * 'Font': A font in the underlying rendering system.+--+-- * 'FontMetrics': Information about the font that will be used to render+-- a specific 'Context' or 'PangoItem'.+--+module Graphics.Rendering.Pango.Font (+ -- Functions to manage font descriptions.+ module Graphics.Rendering.Pango.Description,+ -- Font metrics.+ FontMap,+ pangoFontMapListFamilies,+ FontFamily,+#if PANGO_VERSION_CHECK(1,4,0)+ pangoFontFamilyIsMonospace,+#endif+ pangoFontFamilyListFaces,+ FontFace,+#if PANGO_VERSION_CHECK(1,4,0)+ pangoFontFaceListSizes,+#endif+ pangoFontFaceDescribe,+ Font,+ ) where++import Control.Monad (liftM)++import System.Glib.FFI+import System.Glib.UTFString+import System.Glib.GObject (makeNewGObject)+{#import Graphics.Rendering.Pango.BasicTypes#}+{#import Graphics.Rendering.Pango.Types#}+{#import Graphics.Rendering.Pango.Enums#} (FontMetrics)+import Graphics.Rendering.Pango.Description+import Graphics.Rendering.Pango.Structs++{# context lib="pango" prefix="pango" #}+++-- | Ask for the different font families that a particular back-end supports.+--+-- * The 'FontMap' can be acquired by calling+-- 'Graphics.UI.Gtk.Cairo.cairoFontMapGetDefault'. +--+pangoFontMapListFamilies :: FontMap -> IO [FontFamily]+pangoFontMapListFamilies fm = alloca $ \arrPtrPtr -> alloca $ \sizePtr -> do+ {#call unsafe font_map_list_families#} fm arrPtrPtr sizePtr+ arrPtr <- peek arrPtrPtr+ size <- peek sizePtr+ ffsPtr <- peekArray (fromIntegral size) + (castPtr arrPtr::Ptr (Ptr FontFamily)) -- c2hs is wrong here+ {#call unsafe g_free#} (castPtr arrPtr)+ mapM (makeNewGObject mkFontFamily . return . castPtr) ffsPtr++instance Show FontFamily where+ show ff = unsafePerformIO $ do+ strPtr <- {#call unsafe font_family_get_name#} ff+ peekUTFString strPtr++#if PANGO_VERSION_CHECK(1,4,0)+-- | Ask if the given family contains monospace fonts.+--+-- * A monospace font is a font designed for text display where the+-- characters form a regular grid. For Western languages this would+-- mean that the advance width of all characters are the same, but+-- this categorization also includes Asian fonts which include+-- double-width characters: characters that occupy two grid cells.+--+-- * The best way to find out the grid-cell size is to query the members+-- of the according 'FontMetrics' structure.+--+pangoFontFamilyIsMonospace :: FontFamily -> Bool+pangoFontFamilyIsMonospace ff = unsafePerformIO $+ liftM toBool $ {#call unsafe font_family_is_monospace#} ff+#endif++-- | Ask for the faces contained in a particular family.+--+-- * Asks for all font faces in the given family. The faces in a family+-- share a common design, but differ in slant, weight, width and other+-- aspects. For example, the font family "Sans" contains several fonts+-- such as Helvetica and Arial.+--+pangoFontFamilyListFaces :: FontFamily -> IO [FontFace]+pangoFontFamilyListFaces ff = alloca $ \arrPtrPtr -> alloca $ \sizePtr -> do+ {#call unsafe font_family_list_faces#} ff arrPtrPtr sizePtr+ arrPtr <- peek arrPtrPtr+ size <- peek sizePtr+ ffsPtr <- peekArray (fromIntegral size) + (castPtr arrPtr::Ptr (Ptr FontFace)) -- c2hs is wrong here+ {#call unsafe g_free#} (castPtr arrPtr)+ mapM (makeNewGObject mkFontFace . return . castPtr) ffsPtr++instance Show FontFace where+ show ff = unsafePerformIO $ do+ strPtr <- {#call unsafe font_face_get_face_name#} ff+ peekUTFString strPtr++#if PANGO_VERSION_CHECK(1,4,0)+-- | Ask for available sizes of this font face.+--+-- * List the available sizes for a font. This is only applicable to bitmap+-- fonts since all other fonts can be scaled arbitrarily. For scalable+-- fonts, this function returns @Nothing@. The sizes returned are in+-- ascending order, their unit is points (1\/72 inch).+--+pangoFontFaceListSizes :: FontFace -> IO (Maybe [Double])+pangoFontFaceListSizes ff = alloca $ \arrPtrPtr -> alloca $ \sizePtr -> do+ {#call unsafe font_face_list_sizes#} ff arrPtrPtr sizePtr+ arrPtr <- peek arrPtrPtr+ size <- peek sizePtr+ if arrPtr==nullPtr then return Nothing else do+ sizes <- peekArray (fromIntegral size) arrPtr+ {#call unsafe g_free#} (castPtr arrPtr)+ return (Just (map intToPu sizes))+#endif++-- | Ask for a description of this face.+--+-- * Returns the family, style, variant, weight and stretch of a 'FontFace'.+-- The size field of the resulting font description will be unset.+--+pangoFontFaceDescribe :: FontFace -> IO FontDescription+pangoFontFaceDescribe ff = do+ fdPtr <- {#call unsafe font_face_describe#} ff+ makeNewFontDescription fdPtr
+ Graphics/Rendering/Pango/GlyphStorage.chs view
@@ -0,0 +1,193 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) Glyph Storage of Pango+--+-- Author : Axel Simon+--+-- Created: 31 July 2005+--+-- Copyright (C) 2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+--+-- #hide++-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- +--+module Graphics.Rendering.Pango.GlyphStorage (+ glyphItemExtents,+ glyphItemExtentsRange,+ glyphItemIndexToX,+ glyphItemXToIndex,+ glyphItemGetLogicalWidths,+#if PANGO_VERSION_CHECK(1,2,0)+ glyphItemSplit+#endif+ ) where++import Control.Monad (liftM)+import System.Glib.FFI+{#import Graphics.Rendering.Pango.Types#} (Font(..))+import System.Glib.UTFString+{#import Graphics.Rendering.Pango.BasicTypes#}+import Graphics.Rendering.Pango.Structs+#ifdef HAVE_NEW_CONTROL_EXCEPTION+import Control.OldException ( Exception(ArrayException),+ ArrayException(IndexOutOfBounds) )+#else+import Control.Exception ( Exception(ArrayException),+ ArrayException(IndexOutOfBounds) )+#endif+import Control.Exception (throwIO)++{# context lib="pango" prefix="pango" #}++--------------------+-- Methods++-- | Ask for bounding rectangles of this glyph sequence.+--+-- * Compute the logical and ink extents of a glyph string. The+-- logical extend is used for positioning, the ink size is the smallest+-- bounding box that includes all character pixels. The ink size can be+-- smaller or larger that the logical layout.+--+--+glyphItemExtents :: GlyphItem -> IO (PangoRectangle, PangoRectangle)+glyphItemExtents (GlyphItem pi self) = do+ font <- pangoItemGetFont pi+ alloca $ \logPtr -> alloca $ \inkPtr -> do+ {#call unsafe glyph_string_extents#} self font+ (castPtr logPtr) (castPtr inkPtr)+ log <- peek logPtr+ ink <- peek inkPtr+ return (log, ink)++-- | Ask for bounding rectangles for a sub-range of a glyph sequence.+--+-- * The returned rectangles are relative to the given sub-range, that is,+-- the result of this function is the same as if 'glyphItemExtents'+-- were called on the sub-string.+--+glyphItemExtentsRange :: GlyphItem -> Int -> Int -> + IO (PangoRectangle, PangoRectangle)++glyphItemExtentsRange (GlyphItem pi@(PangoItem (PangoString uc _ _) _) self)+ start end = do+ font <- pangoItemGetFont pi+ alloca $ \logPtr -> alloca $ \inkPtr -> do+ {#call unsafe glyph_string_extents_range#} self+ (fromIntegral (ofsToUTF start uc)) (fromIntegral (ofsToUTF end uc))+ font (castPtr logPtr) (castPtr inkPtr)+ log <- peek logPtr+ ink <- peek inkPtr+ return (log, ink)++-- | Get the horizontal position of a character.+--+-- * Clusters (e.g. \"e\" with an accent modifier) are divided up into equal+-- portions.+--+glyphItemIndexToX :: GlyphItem -- ^ the rendered string+ -> Int -- ^ the index into the string+ -> Bool -- ^ return the beginning (@False@) or the end + -- of the character+ -> IO Double+glyphItemIndexToX (GlyphItem (PangoItem ps pir) gs) pos beg =+ withPangoItemRaw pir $ \pirPtr -> alloca $ \intPtr -> + withPangoString ps $ \uc l strPtr -> do+ {# call unsafe glyph_string_index_to_x #} gs strPtr+ (fromIntegral l) (pangoItemRawAnalysis pirPtr) + (fromIntegral (ofsToUTF pos uc)) (fromBool beg) intPtr+ liftM intToPu $ peek intPtr++-- | Get the character at the given horizontal position.+--+-- * The position is clipped to the width of this line.+--+-- * The function returns the position in the string that corresponds+-- to the given horizontal location. Furthermore, if the position lies+-- on the first half of the character, @False@ is returned.+--+glyphItemXToIndex :: GlyphItem -> Double -> IO (Int, Bool)+glyphItemXToIndex (GlyphItem (PangoItem ps pir) gs) pos =+ withPangoItemRaw pir $ \pirPtr -> alloca $ \intPtr -> + alloca $ \boolPtr -> withPangoString ps $ \uc l strPtr -> do+ {# call unsafe pango_glyph_string_x_to_index #} gs strPtr+ (fromIntegral l) (pangoItemRawAnalysis pirPtr) (puToInt pos)+ intPtr boolPtr+ int <- peek intPtr+ bool <- peek boolPtr+ return (ofsFromUTF (fromIntegral int) uc, toBool bool)++-- | Retrieve the width of every character in a string.+--+-- * The boolean parameter+-- determines if the returned array starts with the leftmost glyph+-- (@False@) or with the rightmost glyph (@True@). If @Nothing@ is+-- passed in, the direction is taken from the 'GlyphItem', i.e.,+-- the array starts with the leftmost glyph for left-to-rigth text+-- and with the rightmost glyph for right-to-left text. When multiple+-- characters compose a single glyph, the width of this glyph is+-- divided among the characters that compose this cluster.+--+glyphItemGetLogicalWidths :: GlyphItem -> Maybe Bool -> IO [Double]+glyphItemGetLogicalWidths (GlyphItem (PangoItem ps pir) gs) mDir = do+ dir <- case mDir of+ Just dir -> return dir+ Nothing -> withPangoItemRaw pir pangoItemRawGetLevel+ withPangoString ps $ \uc l strPtr -> do+ logLen <- {#call unsafe g_utf8_strlen#} strPtr (fromIntegral l)+ allocaArray (fromIntegral logLen) $ \arrPtr -> do+ {# call unsafe pango_glyph_string_get_logical_widths #}+ gs strPtr (fromIntegral l) (fromBool dir) arrPtr+ elems <- peekArray (fromIntegral logLen) arrPtr+ return (map intToPu elems)++#if PANGO_VERSION_CHECK(1,2,0)+-- | Split a 'GlyphItem' at the given index.+--+-- * The given 'GlyphItem' is split at the given index. The index must be+-- at least one and not greater or equal to length, i.e. the item must+-- be split into two non-empty segments. The function throws an+-- 'ArrayException' if the index is out of bounds.+--+glyphItemSplit :: GlyphItem -> Int -> IO (GlyphItem, GlyphItem)+glyphItemSplit (GlyphItem (PangoItem ps pir) gs) pos = do+ pirPtr1 <- {#call unsafe pango_item_copy#} pir+ gsrPtr1 <- {#call unsafe glyph_string_copy#} gs+ pir1 <- makeNewPangoItemRaw pirPtr1+ gsr1 <- makeNewGlyphStringRaw gsrPtr1+ allocaBytes {#sizeof PangoGlyphItem#} $ \giPtr1 -> do+ {#set PangoGlyphItem.item#} giPtr1 pirPtr1+ {#set PangoGlyphItem.glyphs#} giPtr1 gsrPtr1+ giPtr2 <- withPangoString ps $ \uc l strPtr ->+ {#call unsafe pango_glyph_item_split#} giPtr1 strPtr+ (fromIntegral (ofsToUTF pos uc))+ if giPtr2==nullPtr then + throwIO (ArrayException (IndexOutOfBounds+ ("Graphics.Rendering.Pango.GlyphStorage."+++ "glyphItemSplit: cannot split item at index "++show pos))) else do+ pirPtr2 <- {#get PangoGlyphItem.item#} giPtr2+ gsrPtr2 <- {#get PangoGlyphItem.glyphs#} giPtr2+ {#call unsafe g_free#} giPtr2+ pir2 <- makeNewPangoItemRaw pirPtr2+ gsr2 <- makeNewGlyphStringRaw gsrPtr2+ return (GlyphItem (PangoItem ps pir2) gsr2,+ GlyphItem (PangoItem ps pir1) gsr1)+#endif
+ Graphics/Rendering/Pango/Layout.chs view
@@ -0,0 +1,1064 @@+{-# LANGUAGE CPP #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) Pango text layout functions+--+-- Author : Axel Simon+--+-- Created: 8 Feburary 2003+--+-- Copyright (C) 1999-2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- Not bound:+--+-- - pango_layout_get_log_attrs : difficult since it returns an array, where+-- each element corresponds to a UTF8 character, conversion to wide+-- characters means we need to do some semantic merging+--+-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- Functions to run the rendering pipeline.+--+-- * The 'PangoLayout' object defined in this module contain a rendered+-- paragraph of text. This interface is the easiest way to render text into+-- a 'Graphics.UI.Gtk.Gdk.DrawWindow.DrawWindow' using Cairo.+--+module Graphics.Rendering.Pango.Layout (+ PangoRectangle(..),+ PangoLayout,+ layoutEmpty,+ layoutText,+ layoutCopy,+ layoutGetContext,+ layoutContextChanged,+ layoutSetText,+ layoutGetText,+ layoutSetMarkup,+ escapeMarkup,+ layoutSetMarkupWithAccel,+ layoutSetAttributes,+ layoutGetAttributes,+ layoutSetFontDescription,+#if PANGO_VERSION_CHECK(1,8,0)+ layoutGetFontDescription,+#endif+ layoutSetWidth,+ layoutGetWidth,+ LayoutWrapMode(..),+ layoutSetWrap,+ layoutGetWrap,+#if PANGO_VERSION_CHECK(1,6,0)+ EllipsizeMode(..),+ layoutSetEllipsize,+ layoutGetEllipsize,+#endif+ layoutSetIndent,+ layoutGetIndent,+ layoutSetSpacing,+ layoutGetSpacing,+ layoutSetJustify,+ layoutGetJustify,+#if PANGO_VERSION_CHECK(1,4,0)+ layoutSetAutoDir,+ layoutGetAutoDir,+#endif+ LayoutAlignment(..),+ layoutSetAlignment,+ layoutGetAlignment,+ TabAlign,+ TabPosition,+ layoutSetTabs,+ layoutResetTabs,+ layoutGetTabs,+ layoutSetSingleParagraphMode,+ layoutGetSingleParagraphMode,+ layoutXYToIndex,+ layoutIndexToPos,+ layoutGetCursorPos,+ CursorPos(..),+ layoutMoveCursorVisually,+ layoutGetExtents,+ layoutGetPixelExtents,+ layoutGetLineCount,+ layoutGetLine,+ layoutGetLines,+ LayoutIter,+ layoutGetIter,+ layoutIterNextItem,+ layoutIterNextChar,+ layoutIterNextCluster,+ layoutIterNextLine,+ layoutIterAtLastLine,+ layoutIterGetIndex,+ layoutIterGetBaseline,+#if PANGO_VERSION_CHECK(1,2,0)+ layoutIterGetItem,+#endif+ layoutIterGetLine,+ layoutIterGetCharExtents,+ layoutIterGetClusterExtents,+ layoutIterGetRunExtents,+ layoutIterGetLineYRange,+ layoutIterGetLineExtents,+ LayoutLine,+ layoutLineGetExtents,+ layoutLineGetPixelExtents,+ layoutLineIndexToX,+ layoutLineXToIndex,+ layoutLineGetXRanges+ ) where++import Control.Monad (liftM)+import Data.Char (ord, chr)++import System.Glib.FFI+import System.Glib.UTFString+import System.Glib.GList (readGSList)+import System.Glib.GObject (constructNewGObject, makeNewGObject)+import Graphics.Rendering.Pango.Structs+{#import Graphics.Rendering.Pango.BasicTypes#}+import Graphics.Rendering.Pango.Types+#if PANGO_VERSION_CHECK(1,6,0)+{#import Graphics.Rendering.Pango.Enums#} (EllipsizeMode(..))+#endif+import Graphics.Rendering.Pango.Rendering -- for haddock+import Graphics.Rendering.Pango.Attributes ( withAttrList, fromAttrList)+import Data.IORef+#ifdef HAVE_NEW_CONTROL_EXCEPTION+import Control.OldException ( Exception(ArrayException),+ ArrayException(IndexOutOfBounds),+ throwIO )+#else+import Control.Exception ( Exception(ArrayException),+ ArrayException(IndexOutOfBounds),+ throwIO )+#endif++{# context lib="pango" prefix="pango" #}++-- | Create an empty 'Layout'.+--+layoutEmpty :: PangoContext -> IO PangoLayout+layoutEmpty pc = do+ pl <- constructNewGObject mkPangoLayoutRaw+ ({#call unsafe layout_new#} (toPangoContext pc))+ ps <- makeNewPangoString ""+ psRef <- newIORef ps+ return (PangoLayout psRef pl)++-- | Create a new layout.+--+layoutText :: PangoContext -> String -> IO PangoLayout+layoutText pc txt = do+ pl <- constructNewGObject mkPangoLayoutRaw+ ({#call unsafe layout_new#} (toPangoContext pc))+ withUTFStringLen txt $ \(strPtr,len) ->+ {#call unsafe layout_set_text#} pl strPtr (fromIntegral len)+ ps <- makeNewPangoString txt+ psRef <- newIORef ps+ return (PangoLayout psRef pl)++-- | Create a copy of the 'Layout'.+--+layoutCopy :: PangoLayout -> IO PangoLayout+layoutCopy (PangoLayout uc pl) = do+ pl <- constructNewGObject mkPangoLayoutRaw+ ({#call unsafe layout_copy#} pl)+ return (PangoLayout uc pl)++-- | Retrieves the 'PangoContext' from this layout.+--+layoutGetContext :: PangoLayout -> IO PangoContext+layoutGetContext (PangoLayout _ pl) = makeNewGObject mkPangoContext $ do+ {#call unsafe layout_get_context#} pl++-- | Signal a 'PangoContext' change.+--+-- * Forces recomputation of any state in the 'PangoLayout' that+-- might depend on the layout's context. This function should+-- be called if you make changes to the context subsequent+-- to creating the layout.+--+layoutContextChanged :: PangoLayout -> IO ()+layoutContextChanged (PangoLayout _ pl) =+ {#call unsafe layout_context_changed#} pl++-- | Set the string in the layout.+--+layoutSetText :: PangoLayout -> String -> IO ()+layoutSetText (PangoLayout psRef pl) txt = do+ withUTFStringLen txt $ \(strPtr,len) ->+ {#call unsafe layout_set_text#} pl strPtr (fromIntegral len)+ ps <- makeNewPangoString txt+ writeIORef psRef ps++-- | Retrieve the string in the layout.+--+layoutGetText :: PangoLayout -> IO String+layoutGetText (PangoLayout _ pl) =+ {#call unsafe layout_get_text#} pl >>= peekUTFString++-- | Set the text of the layout, including attributes.+--+-- The string may include 'Markup'. To print markup characters like+-- @\'<\'@, or @\'-\'@, apply 'escapeMarkup' to the string first.+--+-- The function returns the text that is actually shown.+--+layoutSetMarkup :: PangoLayout -> Markup -> IO String+layoutSetMarkup pl@(PangoLayout psRef plr) txt = do+ withUTFStringLen txt $ \(strPtr,len) ->+ {#call unsafe layout_set_markup#} plr strPtr (fromIntegral len)+ txt' <- layoutGetText pl+ ps <- makeNewPangoString txt'+ writeIORef psRef ps+ return txt'++-- | Escape markup characters.+--+-- * Used to display characters that normally denote markup. Note that this+-- function is strict in that it forces all characters in the input string+-- as soon as a single output character is requested.+--+escapeMarkup :: String -> String+escapeMarkup str = unsafePerformIO $ withUTFStringLen str $ \(strPtr,l) -> do+ resPtr <- {#call unsafe g_markup_escape_text#} strPtr (fromIntegral l)+ res <- peekUTFString resPtr+ {#call unsafe g_free#} (castPtr resPtr)+ return res++-- | Set the string in the layout.+--+-- * The string may include 'Markup'. Furthermore, any underscore+-- character indicates that the next character will be+-- marked as accelerator (i.e. underlined). A literal underscore character+-- can be produced by placing it twice in the string.+--+-- * The character which follows the underscore is+-- returned so it can be used to add the actual keyboard shortcut.+-- The second element is the string after parsing.+--+layoutSetMarkupWithAccel :: PangoLayout -> Markup -> IO (Char, String)+layoutSetMarkupWithAccel pl@(PangoLayout psRef plr) txt = do+ modif <- alloca $ \chrPtr -> + withUTFStringLen txt $ \(strPtr,len) -> do+ {#call unsafe layout_set_markup_with_accel#} plr strPtr+ (fromIntegral len) (fromIntegral (ord '_')) chrPtr+ liftM (chr.fromIntegral) $ peek chrPtr+ txt' <- layoutGetText pl+ ps <- makeNewPangoString txt'+ writeIORef psRef ps+ return (modif, txt')+++-- | Set text attributes of the text in the layout.+--+-- * This function replaces any text attributes that this layout contained,+-- even those that were set by using 'layoutSetMarkup'.+--+layoutSetAttributes :: PangoLayout -> [PangoAttribute] -> IO ()+layoutSetAttributes (PangoLayout psRef plr) attrs = do+ ps <- readIORef psRef+ withAttrList ps attrs $ \alPtr ->+ {#call unsafe pango_layout_set_attributes#} plr alPtr++-- | Gets the list of attributes of the layout, if any.+--+-- * The attribute list is a list of lists of attribute. Each list describes+-- the attributes for the same span.+--+layoutGetAttributes :: PangoLayout -> IO [[PangoAttribute]]+layoutGetAttributes (PangoLayout psRef plr) = do+ (PangoString correct _ _) <- readIORef psRef+ attrListPtr <- {#call unsafe pango_layout_get_attributes#} plr+ fromAttrList correct attrListPtr++-- | Set a specific font description for this layout.+--+-- * Specifying @Nothing@ will unset the current font description, that is,+-- the 'PangoLayout' will use the font description in the current+-- 'PangoContext'.+--+layoutSetFontDescription :: PangoLayout -> Maybe FontDescription -> IO ()+layoutSetFontDescription (PangoLayout _ plr) (Just fd) =+ {#call unsafe layout_set_font_description#} plr fd+layoutSetFontDescription (PangoLayout _ (PangoLayoutRaw plr)) Nothing =+ withForeignPtr plr $ \plrPtr ->+ pango_layout_set_font_description plrPtr nullPtr++#if PANGO_VERSION_CHECK(1,8,0)+-- | Ask for the specifically set font description of this layout.+--+-- * Returns @Nothing@ if this layout uses the font description in the+-- 'PangoContext' it was created in.+--+-- * Only available in Pango 1.8.0 or higher.+--+layoutGetFontDescription :: PangoLayout -> IO (Maybe FontDescription)+layoutGetFontDescription (PangoLayout _ plr) = do+ fdPtr <- {#call unsafe layout_get_font_description#} plr+ if fdPtr==nullPtr then return Nothing else liftM Just $ do+ fdPtr' <- font_description_copy fdPtr+ makeNewFontDescription fdPtr'++foreign import ccall unsafe "pango_font_description_copy"+ font_description_copy :: Ptr FontDescription -> IO (Ptr FontDescription)+#endif+++-- | Set the width of this paragraph.+--+-- * Sets the width to which the lines of the 'PangoLayout'+-- should be wrapped.+--+-- * Pass in @Nothing@ to indicate that no wrapping is to be performed.+--+layoutSetWidth :: PangoLayout -> Maybe Double -> IO ()+layoutSetWidth (PangoLayout _ pl) Nothing =+ {#call unsafe layout_set_width#} pl (-1)+layoutSetWidth (PangoLayout _ pl) (Just pu) =+ {#call unsafe layout_set_width#} pl (puToInt pu)++-- | Gets the width of this paragraph.+--+-- * Gets the width to which the lines of the 'PangoLayout'+-- should be wrapped.+--+-- * Returns is the current width, or @Nothing@ to indicate that+-- no wrapping is performed.+--+layoutGetWidth :: PangoLayout -> IO (Maybe Double)+layoutGetWidth (PangoLayout _ pl) = do+ w <- {#call unsafe layout_get_width#} pl+ return (if w==(-1) then Nothing else Just (intToPu w))++-- | Enumerates how a line can be wrapped.+--+-- [@WrapWholeWords@] Breaks lines only between words.+--+-- * This variant does not guarantee that the requested width is not+-- exceeded. A word that is longer than the paragraph width is not+-- split.+--+-- [@WrapAnywhere@] Break lines anywhere.+--+-- [@WrapPartialWords@] Wrap within a word if it is the only one on+-- this line.+--+-- * This option acts like 'WrapWholeWords' but will split+-- a word if it is the only one on this line and it exceeds the+-- specified width.+--+{#enum PangoWrapMode as LayoutWrapMode + {underscoreToCase,+ PANGO_WRAP_WORD as WrapWholeWords,+ PANGO_WRAP_CHAR as WrapAnywhere,+ PANGO_WRAP_WORD_CHAR as WrapPartialWords}#}++-- | Set how this paragraph is wrapped.+--+-- * Sets the wrap style; the wrap style only has an effect if a width+-- is set on the layout with 'layoutSetWidth'. To turn off+-- wrapping, call 'layoutSetWidth' with @Nothing@.+--+layoutSetWrap :: PangoLayout -> LayoutWrapMode -> IO ()+layoutSetWrap (PangoLayout _ pl) wm =+ {#call unsafe layout_set_wrap#} pl ((fromIntegral.fromEnum) wm)+++-- | Get the wrap mode for the layout.+--+layoutGetWrap :: PangoLayout -> IO LayoutWrapMode+layoutGetWrap (PangoLayout _ pl) = liftM (toEnum.fromIntegral) $+ {#call unsafe layout_get_wrap#} pl++#if PANGO_VERSION_CHECK(1,6,0)+-- | Set how long lines should be abbreviated.+--+layoutSetEllipsize :: PangoLayout -> EllipsizeMode -> IO ()+layoutSetEllipsize (PangoLayout _ pl) em =+ {#call unsafe layout_set_ellipsize#} pl ((fromIntegral.fromEnum) em)++-- | Get the ellipsize mode for this layout.+--+layoutGetEllipsize :: PangoLayout -> IO EllipsizeMode+layoutGetEllipsize (PangoLayout _ pl) = liftM (toEnum.fromIntegral) $+ {#call unsafe layout_get_ellipsize#} pl+#endif++-- | Set the indentation of this paragraph.+--+-- * Sets the amount by which the first line should+-- be indented. A negative value will produce a hanging indent, that is,+-- all subsequent lines will be indented while the first line has full+-- width.+--+layoutSetIndent :: PangoLayout -> Double -> IO ()+layoutSetIndent (PangoLayout _ pl) indent =+ {#call unsafe layout_set_indent#} pl (puToInt indent)++-- | Gets the indentation of this paragraph.+--+-- * Gets the amount by which the first line or the rest of the paragraph+-- is indented.+--+layoutGetIndent :: PangoLayout -> IO Double+layoutGetIndent (PangoLayout _ pl) = + liftM intToPu $ {#call unsafe layout_get_indent#} pl+++-- | Set the spacing between lines of this paragraph.+--+layoutSetSpacing :: PangoLayout -> Double -> IO ()+layoutSetSpacing (PangoLayout _ pl) spacing =+ {#call unsafe layout_set_spacing#} pl (puToInt spacing)++-- | Gets the spacing between the lines.+--+layoutGetSpacing :: PangoLayout -> IO Double+layoutGetSpacing (PangoLayout _ pl) = + liftM intToPu $ {#call unsafe layout_get_spacing#} pl++-- | Set if text should be streched to fit width.+--+-- * Sets whether or not each complete line should be stretched to+-- fill the entire width of the layout. This stretching is typically+-- done by adding whitespace, but for some scripts (such as Arabic),+-- the justification is done by extending the characters.+--+-- * Note that as of Pango 1.4, this functionality is not yet implemented.+--+layoutSetJustify :: PangoLayout -> Bool -> IO ()+layoutSetJustify (PangoLayout _ pl) j = + {#call unsafe layout_set_justify#} pl (fromBool j)++-- | Retrieve the justification flag.+--+-- * See 'layoutSetJustify'.+--+layoutGetJustify :: PangoLayout -> IO Bool+layoutGetJustify (PangoLayout _ pl) = + liftM toBool $ {#call unsafe layout_get_justify#} pl++#if PANGO_VERSION_CHECK(1,4,0)+-- | Set if the base text direction should be overridden.+--+-- * Sets whether to calculate the bidirectional base direction for the+-- layout according to the contents of the layout; when this flag is on+-- (the default), then paragraphs in layout that begin with strong+-- right-to-left characters (Arabic and Hebrew principally), will have+-- right-to-left layout, paragraphs with letters from other scripts will+-- have left-to-right layout. Paragraphs with only neutral characters get+-- their direction from the surrounding paragraphs.+--+-- * When @False@, the choice between left-to-right and right-to-left+-- layout is done by according to the base direction of the layout's+-- 'PangoContext'. (See 'Graphics.UI.Gtk.Pango.Context.contextSetTextDir').+--+-- * When the auto-computed direction or a paragraph differs from the base+-- direction of the context, then the interpretation of+-- 'AlignLeft' and 'AlignRight' are swapped.+--+layoutSetAutoDir :: PangoLayout -> Bool -> IO ()+layoutSetAutoDir (PangoLayout _ pl) j = + {#call unsafe layout_set_auto_dir#} pl (fromBool j)++-- | Retrieve the auto direction flag.+--+-- * See 'layoutSetAutoDir'.+--+layoutGetAutoDir :: PangoLayout -> IO Bool+layoutGetAutoDir (PangoLayout _ pl) = + liftM toBool $ {#call unsafe layout_get_auto_dir#} pl+#endif+++-- | Enumerate to which side incomplete lines are flushed.+--+{#enum PangoAlignment as LayoutAlignment {underscoreToCase}#}++-- | Set how this paragraph is aligned.+--+-- * Sets the alignment for the layout (how partial lines are+-- positioned within the horizontal space available.)+--+layoutSetAlignment :: PangoLayout -> LayoutAlignment -> IO ()+layoutSetAlignment (PangoLayout _ pl) am =+ {#call unsafe layout_set_alignment#} pl ((fromIntegral.fromEnum) am)+++-- | Get the alignment for the layout.+--+layoutGetAlignment :: PangoLayout -> IO LayoutAlignment+layoutGetAlignment (PangoLayout _ pl) = liftM (toEnum.fromIntegral) $+ {#call unsafe layout_get_alignment#} pl++-- | Specify where the Tab stop appears relative to the text.+--+-- * Only Tab stops that align text to the left are supported right now.+--+{#enum PangoTabAlign as TabAlign {underscoreToCase}#}++-- | A Tab position.+--+type TabPosition = (Double, TabAlign)++-- | Set a list of Tab positoins.+--+layoutSetTabs :: PangoLayout -> [TabPosition] -> IO ()+layoutSetTabs (PangoLayout _ pl) tabs = do+ let len = fromIntegral (length tabs)+ tabPtr <- {#call unsafe tab_array_new#} len (fromBool False)+ mapM_ (\(idx, (pos, align)) ->+ {#call unsafe tab_array_set_tab#} tabPtr idx+ (fromIntegral (fromEnum align)) (puToInt pos)) (zip [0..] tabs)+ {#call unsafe layout_set_tabs#} pl tabPtr+ {#call unsafe tab_array_free#} tabPtr++-- | Reset the original set of Tab positions.+--+-- * Restore the default which is a Tab stop every eight characters.+--+layoutResetTabs :: PangoLayout -> IO ()+layoutResetTabs (PangoLayout _ pl) = {#call unsafe layout_set_tabs#} pl nullPtr++-- | Retrieve the list of current Tab positions.+--+-- * If no Tab position where set, @Nothing@ is returned. In this case, Tab+-- positions are implicit at every eight characters.+--+layoutGetTabs :: PangoLayout -> IO (Maybe [TabPosition])+layoutGetTabs (PangoLayout _ pl) = do+ tabPtr <- {#call unsafe layout_get_tabs#} pl+ if tabPtr == nullPtr then return Nothing else liftM Just $ do+ len <- {#call unsafe tab_array_get_size#} tabPtr+ mapM (\idx -> alloca $ \posPtr -> alloca $ \alignPtr -> do+ {#call unsafe tab_array_get_tab#} tabPtr idx alignPtr posPtr+ align <- peek alignPtr+ pos <- peek posPtr+ return (intToPu pos, toEnum (fromIntegral align))) [0..len-1]++-- | Honor newlines or not.+--+-- * If @honor@ is @True@, do not treat newlines and+-- similar characters as paragraph separators; instead, keep all text in+-- a single paragraph, and display a glyph for paragraph separator+-- characters. Used when you want to allow editing of newlines on a+-- single text line.+--+layoutSetSingleParagraphMode :: PangoLayout -> Bool -> IO ()+layoutSetSingleParagraphMode (PangoLayout _ pl) honor = + {#call unsafe layout_set_single_paragraph_mode#} pl (fromBool honor)++-- | Retrieve if newlines are honored.+--+-- * See 'layoutSetSingleParagraphMode'.+--+layoutGetSingleParagraphMode :: PangoLayout -> IO Bool+layoutGetSingleParagraphMode (PangoLayout _ pl) = + liftM toBool $ {#call unsafe layout_get_single_paragraph_mode#} pl++-- a function is missing here++-- | Converts a device unit to a character index.+--+-- * Converts from @x@ and @y@ position within a layout to the index of+-- the closest character. If the @y@ position is not inside the layout,+-- the closest position is chosen (the position will be clamped inside+-- the layout). If the @x@ position is not within the layout, then the+-- start or the end of the line is chosen. If either the @x@ or @y@+-- positions were not inside the layout, then the function returns @False@;+-- on an exact hit, it returns @True@.+--+-- * The function returns the flag for the exact hit and the index into+-- the string. The third value is zero if the character corresponds to+-- one grapheme. If the grapheme is the result of a cluster, this value+-- may be greater than one, indicating where in the grapheme the position+-- lies. Zero represents the trailing edge on the grapheme.+--+layoutXYToIndex :: PangoLayout -> Double -- ^ the @x@ position+ -> Double -- ^ the @y@ position+ -> IO (Bool, Int, Int)+layoutXYToIndex (PangoLayout psRef pl) x y = + alloca $ \idxPtr -> alloca $ \trailPtr -> do+ res <- {#call unsafe layout_xy_to_index#} pl (puToInt x) (puToInt y)+ idxPtr trailPtr+ idx <- peek idxPtr+ trail <- peek trailPtr+ (PangoString uc _ _) <- readIORef psRef+ return (toBool res,+ ofsFromUTF (fromIntegral idx) uc,+ ofsFromUTF (fromIntegral trail) uc)++-- | Return the rectangle of the glyph at the given index.+--+-- * Converts from an index within a 'PangoLayout' to the onscreen position+-- corresponding to the grapheme at that index, which is represented as+-- rectangle. Note that, given a @PangoRectangle x y width height@, @x@+-- is always the leading edge of the grapheme and @x + width@ the+-- trailing edge of the grapheme. If the directionality of the grapheme+-- is right-to-left, then @width@ will be negative.+--+layoutIndexToPos :: PangoLayout -> Int -> IO PangoRectangle+layoutIndexToPos (PangoLayout psRef plr) pos = do+ (PangoString uc _ _) <- readIORef psRef+ alloca $ \rectPtr -> do+ {#call unsafe layout_index_to_pos#} plr (fromIntegral (ofsToUTF pos uc))+ (castPtr rectPtr)+ peek rectPtr++twoRect :: (Ptr () -> Ptr () -> IO ()) ->+ IO (PangoRectangle, PangoRectangle)+twoRect f =+ alloca $ \inkPtr -> alloca $ \logPtr -> do+ f (castPtr inkPtr) (castPtr logPtr)+ ink <- peek inkPtr+ log <- peek logPtr+ return (ink, log)++-- | Return a cursor position.+--+-- * Given an index within a layout, determines the positions that of the+-- strong and weak cursors if the insertion point is at that index.+-- The position of each cursor is stored as a zero-width rectangle.+-- The strong cursor location is the location where characters of the+-- directionality equal to the base direction of the layout are inserted.+-- The weak cursor location is the location where characters of the+-- directionality opposite to the base direction of the layout are+-- inserted. The first element of the typle is the strong position,+-- the second the weak.+--+layoutGetCursorPos :: PangoLayout -> Int ->+ IO (PangoRectangle, PangoRectangle) -- ^ @(strong, weak)@+layoutGetCursorPos (PangoLayout psRef plr) pos = do+ (PangoString uc _ _) <- readIORef psRef+ twoRect $ {#call unsafe layout_get_cursor_pos#} plr (fromIntegral (ofsToUTF pos uc))++-- | A new cursor position.+--+-- See 'layoutMoveCursorVisually'.+--+data CursorPos+ = CursorPosPrevPara -- ^ The cursor should move to the previous paragraph.+ | CursorPos Int Int -- ^ The sum of the indices is the new cursor position.+ | CursorPosNextPara -- ^ The cursor should advance to the next paragraph.++-- | Move a cursor visually.+--+-- * Compute a new cursor position from a previous cursor position. A value+-- of @True@ for the direction will move it to the right, independant of+-- the underlying direction. Hence the cursor position might jump if+-- left-to-right text is mixed with right-to-left text.+--+-- * The first flag should be @True@ if this cursor is the strong cursor.+-- The strong cursor is the cursor of the base direction of the current+-- layout (see 'layoutSetAutoDir'). The weak cursor is that of the+-- opposite direction.+--+-- * The previous cursor position is given by @idx@. If this text at this+-- position is a cluster, the cursor will only move to the end or+-- beginning of the cluster as opposed to past the next character.+-- The return value is either 'CursorPosNextPara' if the cursor moved+-- beyond this paragraph, it is 'CursorPosPrevPara' if the cursor moved+-- in front of this paragraph and it is 'CursorPos' @idx@ @trail@ to denote+-- the new cursor position @idx@. Note that @idx@ will always denote an+-- insertion point, that is, @idx@ will never point into the middle of+-- a cluster. The @trail@ value can contain a positive+-- value if the current cursor position is at the end of the current line.+-- In this case, @idx@ points past the last character of this line while+-- @trail@ contains the number of characters that are reponsible for the+-- line break such as newlines. The actual cursor position is always+-- @idx+trail@ where the visual cursor should be shown.+--+layoutMoveCursorVisually :: PangoLayout+ -> Bool -- ^ @True@ to create a strong cursor.+ -> Int -- ^ The previous position.+ -> Bool -- ^ @True@ if the cursor should move right.+ -> IO CursorPos+layoutMoveCursorVisually (PangoLayout psRef plr) strong index dir = do+ (PangoString uc _ _) <- readIORef psRef+ alloca $ \idxPtr -> alloca $ \trailPtr -> do+ {#call unsafe layout_move_cursor_visually#} plr (fromBool strong)+ (fromIntegral (ofsToUTF index uc)) 0+ (if dir then 1 else (-1)) idxPtr trailPtr+ idx <- peek idxPtr+ trail <- peek trailPtr+ return (if idx==(-1) then CursorPosPrevPara else+ if idx==maxBound then CursorPosNextPara else+ CursorPos (ofsFromUTF (fromIntegral idx) uc) (fromIntegral trail))++-- | Computes the logical and ink extents of the 'PangoLayout'.+--+-- Logical extents are usually what you want for positioning things. Note that+-- both extents may have non-zero x and y. You may want to use those to offset+-- where you render the layout. Not doing that is a very typical bug that+-- shows up as right-to-left layouts not being correctly positioned in a+-- layout with a set width.+--+-- Layout coordinates begin at the top left corner of the layout.+--+layoutGetExtents :: PangoLayout+ -> IO (PangoRectangle, PangoRectangle) -- ^ @(ink, logical)@+layoutGetExtents (PangoLayout _ pl) =+ twoRect $ {#call unsafe layout_get_extents#} pl+ +-- | Compute the physical size of the layout.+--+-- * Computes the ink and the logical size of the 'Layout' in device units,+-- that is, pixels for a screen. Identical to 'layoutGetExtents' and+-- converting the 'Double's in the 'PangoRectangle' to integers.+--+layoutGetPixelExtents :: PangoLayout -> IO (Rectangle, Rectangle) -- ^ @(ink, logical)@+layoutGetPixelExtents (PangoLayout _ pl) =+ alloca $ \inkPtr -> alloca $ \logPtr -> do+ {#call unsafe layout_get_pixel_extents#} pl (castPtr inkPtr) (castPtr logPtr)+ ink <- peekIntPangoRectangle inkPtr+ log <- peekIntPangoRectangle logPtr+ return (ink,log)++-- | Ask for the number of lines in this layout.+--+layoutGetLineCount :: PangoLayout -> IO Int+layoutGetLineCount (PangoLayout _ pl) = liftM fromIntegral $+ {#call unsafe layout_get_line_count#} pl++-- | Extract a single lines of the layout.+--+-- * The given index starts from 0. The function throws an+-- 'ArrayException' if the index is out of bounds.+--+-- * The lines of each layout are regenerated if any attribute changes.+-- Thus the returned list does not reflect the current state of lines+-- after a change has been made.+--+layoutGetLine :: PangoLayout -> Int -> IO LayoutLine+layoutGetLine (PangoLayout psRef pl) idx = do+ llPtr <-+#if PANGO_VERSION_CHECK(1,16,0)+ -- use the optimised read-only version if available+ {#call unsafe layout_get_line_readonly#}+#else+ {#call unsafe layout_get_line#}+#endif+ pl (fromIntegral idx)+ if llPtr==nullPtr then + throwIO (ArrayException (IndexOutOfBounds+ ("Graphics.UI.Gtk.Pango.Layout.layoutGetLine: "+++ "no line at index "++show idx))) else do+ ll <- makeNewLayoutLineRaw llPtr+ {#call unsafe layout_line_ref#} ll+ return (LayoutLine psRef ll)++-- | Extract the lines of the layout.+--+-- * The lines of each layout are regenerated if any attribute changes.+-- Thus the returned list does not reflect the current state of lines+-- after a change has been made.+--+layoutGetLines :: PangoLayout -> IO [LayoutLine]+layoutGetLines (PangoLayout psRef pl) = do+ listPtr <-+#if PANGO_VERSION_CHECK(1,16,0)+ -- use the optimised read-only version if available+ {#call unsafe layout_get_lines_readonly#}+#else+ {#call unsafe layout_get_lines#}+#endif+ pl+ list <- readGSList listPtr+ pls <- mapM makeNewLayoutLineRaw list+ mapM_ {#call unsafe layout_line_ref#} pls+ return (map (LayoutLine psRef) pls)++-- | Create an iterator to examine a layout.+--+layoutGetIter :: PangoLayout -> IO LayoutIter+layoutGetIter (PangoLayout psRef pl) = do+ iterPtr <- {#call unsafe layout_get_iter#} pl+ liftM (LayoutIter psRef) $ makeNewLayoutIterRaw iterPtr++-- | Move to the next 'GlyphItem'.+--+-- * Returns @False@ if this was the last item in the layout.+--+layoutIterNextItem :: LayoutIter -> IO Bool+layoutIterNextItem (LayoutIter _ li) =+ liftM toBool $ {#call unsafe layout_iter_next_run#} li++-- | Move to the next char.+--+-- * Returns @False@ if this was the last char in the layout.+--+layoutIterNextChar :: LayoutIter -> IO Bool+layoutIterNextChar (LayoutIter _ li) =+ liftM toBool $ {#call unsafe layout_iter_next_char#} li++-- | Move to the next cluster.+--+-- * Returns @False@ if this was the last cluster in the layout.+--+layoutIterNextCluster :: LayoutIter -> IO Bool+layoutIterNextCluster (LayoutIter _ li) =+ liftM toBool $ {#call unsafe layout_iter_next_cluster#} li++-- | Move to the next line.+--+-- * Returns @False@ if this was the last line in the layout.+--+layoutIterNextLine :: LayoutIter -> IO Bool+layoutIterNextLine (LayoutIter _ li) =+ liftM toBool $ {#call unsafe layout_iter_next_line#} li++-- | Check if the iterator is on the last line.+--+-- * Returns @True@ if the iterator is on the last line of this+-- paragraph.+--+layoutIterAtLastLine :: LayoutIter -> IO Bool+layoutIterAtLastLine (LayoutIter _ li) =+ liftM toBool $ {#call unsafe layout_iter_at_last_line#} li++-- | Get the character index.+--+-- * Note that iterating forward by char moves in visual order, not+-- logical order, so indexes may not be sequential. Also, the index+-- may be equal to the length of the text in the layout.+--+layoutIterGetIndex :: LayoutIter -> IO Int+layoutIterGetIndex (LayoutIter psRef li) = do+ (PangoString uc _ _) <- readIORef psRef+ idx <- {#call unsafe layout_iter_get_index#} li+ return (ofsFromUTF (fromIntegral idx) uc)++-- | Query the vertical position within the layout.+--+-- * Gets the y position of the current line's baseline (origin at top+-- left of the entire layout).+--+layoutIterGetBaseline :: LayoutIter -> IO Double+layoutIterGetBaseline (LayoutIter _ li) = + liftM intToPu $ {#call unsafe pango_layout_iter_get_baseline#} li++#if PANGO_VERSION_CHECK(1,2,0)+-- | Retrieve the current 'GlyphItem' under the iterator.+--+-- * Each 'LayoutLine' contains a list of 'GlyphItem's. This function+-- returns the 'GlyphItem' under the current iterator. If the iterator+-- is positioned past the last charactor of the paragraph, the function+-- returns @Nothing@.+--+layoutIterGetItem :: LayoutIter -> IO (Maybe GlyphItem)+layoutIterGetItem (LayoutIter psRef li) = do+ giPtr <- {#call unsafe layout_iter_get_run#} li+ if giPtr==nullPtr then return Nothing else liftM Just $ do+ (PangoString uc _ _) <- readIORef psRef+ pirPtr <- {#get PangoGlyphItem.item#} giPtr+ gsrPtr <- {#get PangoGlyphItem.glyphs#} giPtr+ let dummy = {#call unsafe pango_item_copy#}+ let dummy = {#call unsafe pango_glyph_string_copy#}+ pirPtr' <- pango_item_copy pirPtr+ gsrPtr' <- pango_glyph_string_copy gsrPtr+ pir <- makeNewPangoItemRaw pirPtr'+ gsr <- makeNewGlyphStringRaw gsrPtr'+ ps <- readIORef psRef+ return (GlyphItem (PangoItem ps pir) gsr)+#endif++-- | Extract the line under the iterator.+--+layoutIterGetLine :: LayoutIter -> IO (Maybe LayoutLine)+layoutIterGetLine (LayoutIter psRef li) = do+ llPtr <- liftM castPtr $ {#call unsafe pango_layout_iter_get_line#} li+ if (llPtr==nullPtr) then return Nothing else do+ ll <- makeNewLayoutLineRaw llPtr+ {#call unsafe layout_line_ref#} ll+ return (Just (LayoutLine psRef ll))++-- | Retrieve a rectangle surrounding a character.+--+-- * Get the extents of the current character+-- (origin is the top left of the entire layout). Only logical extents+-- can sensibly be obtained for characters; ink extents make sense only+-- down to the level of clusters. +--+layoutIterGetCharExtents :: LayoutIter -> IO PangoRectangle+layoutIterGetCharExtents (LayoutIter _ li) = alloca $ \logPtr -> + {#call unsafe layout_iter_get_char_extents#} li (castPtr logPtr) >>+ peek logPtr++-- | Compute the physical size of the cluster.+--+-- * Computes the ink and the logical size of the cluster pointed to by+-- 'LayoutIter'.+--+layoutIterGetClusterExtents :: LayoutIter -> IO (PangoRectangle, PangoRectangle) -- ^ @(ink, logical)@+layoutIterGetClusterExtents (LayoutIter _ li) =+ twoRect $ {#call unsafe layout_iter_get_cluster_extents#} li++-- | Compute the physical size of the run.+--+-- * Computes the ink and the logical size of the run pointed to by+-- 'LayoutIter'.+--+layoutIterGetRunExtents :: LayoutIter -> IO (PangoRectangle, PangoRectangle)+layoutIterGetRunExtents (LayoutIter _ li) =+ twoRect $ {#call unsafe layout_iter_get_run_extents#} li++-- | Retrieve vertical extent of this line.+--+-- * Divides the vertical space in the 'PangoLayout' being+-- iterated over between the lines in the layout, and returns the+-- space belonging to the current line. A line's range includes the+-- line's logical extents, plus half of the spacing above and below+-- the line, if 'layoutSetSpacing' has been called+-- to set layout spacing. The y positions are in layout coordinates+-- (origin at top left of the entire layout).+--+-- * The first element in the returned tuple is the start, the second is+-- the end of this line.+--+layoutIterGetLineYRange :: LayoutIter -> IO (Double, Double)+layoutIterGetLineYRange (LayoutIter _ li) =+ alloca $ \sPtr -> alloca $ \ePtr -> do+ {#call unsafe layout_iter_get_line_extents#} li (castPtr sPtr) (castPtr ePtr)+ start <- peek sPtr+ end <- peek ePtr+ return (intToPu start, intToPu end)++-- | Compute the physical size of the line.+--+-- * Computes the ink and the logical size of the line pointed to by+-- 'LayoutIter'. See 'layoutGetExtents'.+--+-- * Extents are in layout coordinates (origin is the top-left corner+-- of the entire 'PangoLayout'). Thus the extents returned+-- by this function will be the same width\/height but not at the+-- same x\/y as the extents returned from+-- 'layoutLineGetExtents'.+--+layoutIterGetLineExtents :: LayoutIter -> IO (PangoRectangle, PangoRectangle)+layoutIterGetLineExtents (LayoutIter _ li) =+ twoRect $ {#call unsafe layout_iter_get_line_extents#} li++-- | Compute the physical size of the line.+--+-- * Computes the ink and the logical size of the 'LayoutLine'. +-- See 'layoutGetExtents'.+--+layoutLineGetExtents :: LayoutLine -> IO (PangoRectangle, PangoRectangle)+layoutLineGetExtents (LayoutLine _ ll) =+ twoRect $ {#call unsafe layout_line_get_extents#} ll++-- | Compute the physical size of the line.+--+-- * Computes the ink and the logical size of the 'LayoutLine'. +-- See 'layoutGetExtents'. The returned values are in device units, that+-- is, pixels for the screen and points for printers.+--+layoutLineGetPixelExtents :: LayoutLine -> IO (Rectangle, Rectangle) -- ^ (ink, logical)+layoutLineGetPixelExtents (LayoutLine _ ll) =+ alloca $ \inkPtr -> alloca $ \logPtr -> do+ {#call unsafe layout_line_get_pixel_extents#} ll (castPtr inkPtr) (castPtr logPtr)+ ink <- peekIntPangoRectangle inkPtr+ log <- peekIntPangoRectangle logPtr+ return (ink,log)++-- | Request the horizontal position of a character.+--+layoutLineIndexToX :: LayoutLine+ -> Int -- ^ the index into the string+ -> Bool -- ^ return the beginning (@False@) or the end + -- of the character+ -> IO Double+layoutLineIndexToX (LayoutLine psRef ll) pos beg =+ alloca $ \intPtr -> do+ (PangoString uc _ _) <- readIORef psRef+ {#call unsafe layout_line_index_to_x#} ll (fromIntegral (ofsToUTF pos uc))+ (fromBool beg) intPtr+ liftM intToPu $ peek intPtr+++-- | Request the character index of a given horizontal position.+--+-- * Converts from an x offset to the index of the corresponding+-- character within the text of the layout. If the @x@ parameter is+-- outside the line, a triple @(False, index, trailing)@ is returned+-- where @index@ and @trailing@ will point to the very+-- first or very last position in the line. This notion of first and last+-- position is based on the direction of the paragraph; for example,+-- if the direction is right-to-left, then an @x@ position to the+-- right of the line results in 0 being returned for @index@ and+-- @trailing@. An @x@ position to the left of the line results in+-- @index@ pointing to the (logical) last grapheme in the line and+-- trailing pointing to the number of characters in that grapheme.+-- The reverse is true for a left-to-right line. If the boolean flag in+-- the result is @True@ then @x@ was within the layout line and+-- @trailing@ indicates where in a cluster the @x@ position lay. It is+-- 0 for the trailing edge of the cluster.+--+layoutLineXToIndex :: LayoutLine + -> Double -- ^ The @x@ position.+ -> IO (Bool, Int, Int)+layoutLineXToIndex (LayoutLine psRef ll) pos =+ alloca $ \idxPtr -> alloca $ \trailPtr -> do+ (PangoString uc _ _) <- readIORef psRef+ inside <- {#call unsafe layout_line_x_to_index#} ll+ (puToInt pos) idxPtr trailPtr+ idx <- peek idxPtr+ trail <- peek trailPtr+ return (toBool inside, ofsFromUTF (fromIntegral idx) uc,+ fromIntegral trail)++-- | Retrieve bounding boxes for a given piece of text contained in this+-- 'LayoutLine'.+--+-- * The result is a list to accommodate for mixed left-to-right and+-- right-to-left text. Even if the text is not mixed, several+-- ranges might be returned that are adjacent. The ranges are always+-- sorted from left to right. The values are with respect to the left+-- edge of the entire layout, not with respect to the line (which might+-- be indented or not left aligned).+--+layoutLineGetXRanges :: LayoutLine -- ^ The line of interest.+ -> Int -- ^ The index of the start character+ -- (counting from 0). If this value is+ -- less than the start index for the line,+ -- then the first range will extend all the+ -- way to the leading edge of the layout. + -- Otherwise it will start at the leading+ -- edge of the first character.+ -> Int -- ^ The index after the last character. + -- If this value is greater than the end+ -- index for the line, then the last range+ -- will extend all the way to the trailing+ -- edge of the layout. Otherwise, it will end+ -- at the trailing edge of the last+ -- character.+ -> IO [(Double, Double)]+layoutLineGetXRanges (LayoutLine psRef ll) start end = do+ PangoString uc _ _ <- readIORef psRef+ alloca $ \arrPtr -> alloca $ \szPtr -> do+ {#call unsafe layout_line_get_x_ranges#} ll+ (fromIntegral (ofsToUTF start uc))+ (fromIntegral (ofsToUTF end uc))+ arrPtr szPtr+ sz <- peek szPtr+ arr <- peek arrPtr+ elems <- peekArray (2*fromIntegral sz) (castPtr arr:: Ptr {#type gint#})+ {#call unsafe g_free#} (castPtr arr)+ let toRange (s:e:rs) = (intToPu s, intToPu e):toRange rs+ toRange [] = []+ return (toRange elems)+
+ Graphics/Rendering/Pango/Markup.chs view
@@ -0,0 +1,179 @@+{-# LANGUAGE CPP #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) Markup+--+-- Author : Axel Simon+--+-- Created: 5 June 2001+--+-- Copyright (C) 1999-2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- This module defines some helper functions for generating texts with+-- embedded attributes. Note that there is no need to use these functions.+-- In particular, if you set markup in labels that are subject to+-- internationalization, it can be of advantage to write out the markup+-- instead of using the functions in this module.+--+-- In order to display a string that may contain markup characters, use+-- 'Graphics.UI.Gtk.Pango.Layout.escapeMarkup'.+--+-- When you write markup directly, you can make use of the following+-- convenience tags:+--+-- [@b@] Bold+--+-- [@big@] Makes font relatively larger+--+-- [@i@] Italic+--+-- [@s@] Strikethrough+--+-- [@sub@] Subscript+--+-- [@sup@] Superscript+--+-- [@small@] Makes font relatively smaller+--+-- [@tt@] Monospace font+--+-- [@u@] Underline +--+-- The full markup language can be found at+-- <http://library.gnome.org/devel/pango/stable/PangoMarkupFormat.html>.+--+module Graphics.Rendering.Pango.Markup (+ Pango.Markup,+ SpanAttribute(..),+ markSpan,+ parseMarkup+ ) where++import qualified Graphics.Rendering.Pango.Enums as Pango+import Graphics.Rendering.Pango.Attributes ( parseMarkup )++-- | These are all the attributes the 'markSpan' function can express.+--+data SpanAttribute+ -- | Choose a font by textual description.+ --+ -- * Takes a string to completely describe the font, example:+ -- @FontDescr@ \"Sans Italic 12\"+ = FontDescr String++ -- | Specify the family of font to use.+ --+ -- * Example: @FontFamily@ \"Sans\"+ | FontFamily String++ -- | Change the size of the current font.+ --+ -- * The constuctor takes the size in points (pt) or a predefined+ -- sizes. Setting the absolute size 12.5pt can be achieved by passing+ -- 'FontSize' ('SizePoint' 12.5) to 'markSpan'. Next to predefined+ -- absolute sizes such as 'Pango.SizeSmall' the size can be changed by + -- asking for the next larger or smaller front with+ -- 'Pango.SizeLarger' and 'Pango.SizeSmaller', respectively.+ | FontSize Pango.Size++ -- | Change the slant of the current font.+ --+ | FontStyle Pango.FontStyle++ -- | Change the thickness of the current font.+ --+ -- * The constructor takes one of the six predefined weights. Most likely to+ -- be supported: 'Pango.WeightBold'.+ --+ | FontWeight Pango.Weight++ -- | Choosing an alternative rendering for lower case letters.+ --+ -- * The argument 'Pango.VariantSmallCaps' will display lower case letters+ -- as smaller upper case letters, if this option is available.+ | FontVariant Pango.Variant++ -- | Choose a different width.+ --+ -- * Takes one of nine font widths, e.g. 'Pango.WidthExpanded'.+ --+ | FontStretch Pango.Stretch++ -- | Foreground color.+ --+ -- * This constructor and 'FontBackground' take both a description+ -- of the color to be used for rendering. The name is either a + -- hex code of the form \"#RRGGBB\" or an X11 color name like+ -- \"dark olive green\".+ --+ | FontForeground String -- FIXME: should be ColorName from GDK or so++ -- | Background color.+ | FontBackground String++ -- | Specify underlining of text.+ --+ | FontUnderline Pango.Underline++ -- | Specify a vertical displacement.+ --+ -- * Takes the vertical displacement in em (the width of the \'m\' character+ -- in the current font).+ | FontRise Double++ -- | Give a hint about the language to be displayed.+ --+ -- * This hint might help the system rendering a particular piece of text+ -- with different fonts that are more suitable for the given language.+ --+ | FontLang Pango.Language++#if PANGO_VERSION_CHECK(1,16,0)+ -- | Gravity of text, use for ratation.+ | FontGravity Pango.PangoGravity+ + -- | Intensity of gravity.+ | FontGravityHint Pango.PangoGravityHint+#endif+ +instance Show SpanAttribute where+ showsPrec _ (FontDescr str) = showString " font_desc=".shows str+ showsPrec _ (FontFamily str) = showString " font_family=".shows str+ showsPrec _ (FontSize size) = showString " size=".shows size+ showsPrec _ (FontStyle style) = showString " style=".shows style+ showsPrec _ (FontWeight w) = showString " weight=".shows w+ showsPrec _ (FontVariant v) = showString " variant=".shows v+ showsPrec _ (FontStretch s) = showString " stretch=".shows s+ showsPrec _ (FontForeground c) = showString " foreground=".shows c+ showsPrec _ (FontBackground c) = showString " background=".shows c+ showsPrec _ (FontUnderline u) = showString " underline=".shows u+ showsPrec _ (FontRise r) = showString " rise=".shows + (show (round (r*10000)))+ showsPrec _ (FontLang l) = showString " lang=".shows l+#if PANGO_VERSION_CHECK(1,16,0)+ showsPrec _ (FontGravity g) = showString " gravity=".shows g+ showsPrec _ (FontGravityHint h) = showString " gravity_hint".shows h+#endif+ +-- | Create the most generic span attribute.+--+markSpan :: [SpanAttribute] -> String -> String+markSpan attrs text = showString "<span".+ foldr (.) (showChar '>') (map shows attrs).+ showString text.+ showString "</span>" $ ""+
+ Graphics/Rendering/Pango/Rendering.chs view
@@ -0,0 +1,142 @@+{-# LANGUAGE CPP #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) - text layout functions Rendering+--+-- Author : Axel Simon+--+-- Created: 8 Feburary 2003+--+-- Copyright (C) 1999-2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+--+-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- Functions to run the rendering pipeline.+--+-- * This module provides elementary rendering functions. For a simpler+-- interface, consider using 'PangoLayout's.+--+-- * The Pango rendering pipeline takes a string of Unicode characters,+-- divides them into sequences of letters that have the same characteristics+-- such as font, size, color, etc. Such a sequence is called 'PangoItem'.+-- Each 'PangoItem' is then converted into one 'GlyphItem', that is+-- an actual sequence of glyphs,+-- where several characters might be turned into legatures or clusters,+-- e.g. an \"e\" and an accent modifier are turned into a single glyph. These+-- 'GlyphItem's can then be rendered onto the output device with functions+-- such as 'Graphics.UI.Gtk.Cairo.cairoShowGlyphString'.+--+module Graphics.Rendering.Pango.Rendering (+ -- * 'PangoItem': Partition text into units with similar attributes.+ PangoItem,+ pangoItemize,+ pangoItemGetFontMetrics,+ pangoItemGetFont,+ pangoItemGetLanguage,+ + -- * 'GlyphItem': Turn text segments into glyph sequences.+ GlyphItem,+ pangoShape,+ glyphItemExtents,+ glyphItemExtentsRange,+ glyphItemIndexToX,+ glyphItemXToIndex,+ glyphItemGetLogicalWidths,+#if PANGO_VERSION_CHECK(1,2,0)+ glyphItemSplit+#endif+ ) where++import System.Glib.FFI+import Graphics.Rendering.Pango.Structs ( pangoItemRawAnalysis, intToPu,+ pangoItemGetFont, pangoItemGetLanguage)+{#import Graphics.Rendering.Pango.Types#} (PangoContext(..), Font(..))+{#import Graphics.Rendering.Pango.BasicTypes#}+{#import Graphics.Rendering.Pango.Enums#}+{#import Graphics.Rendering.Pango.Attributes#}+import Graphics.Rendering.Pango.GlyphStorage+{#import System.Glib.GList#}++{# context lib="pango" prefix="pango" #}++-- | Turn a string into a sequence of glyphs.+--+-- * Partitions the input string into segments with the same text direction+-- and shaping engine. The generated list of items will be in logical order+-- (the start offsets of the items are ascending).+--+pangoItemize :: PangoContext -> String -> [PangoAttribute] -> IO [PangoItem]+pangoItemize pc str attrs = do+ ps <- makeNewPangoString str+ withAttrList ps attrs $ \alPtr -> do+ glist <- withPangoString ps $ \_ l strPtr ->+ {#call unsafe itemize#} pc strPtr 0 l alPtr nullPtr+ piPtrs <- fromGList glist+ piRaws <- mapM makeNewPangoItemRaw piPtrs+ return (map (PangoItem ps) piRaws)+++-- | Retrieve the metrics of the font that was chosen to break the given+-- 'PangoItem'.+--+pangoItemGetFontMetrics :: PangoItem -> IO FontMetrics+pangoItemGetFontMetrics pi = do+ font <- pangoItemGetFont pi+ lang <- pangoItemGetLanguage pi+ mPtr <- {#call unsafe font_get_metrics#} font lang+ ascent <- {#call unsafe font_metrics_get_ascent#} mPtr+ descent <- {#call unsafe font_metrics_get_descent#} mPtr+ approximate_char_width <-+ {#call unsafe font_metrics_get_approximate_char_width#} mPtr+ approximate_digit_width <-+ {#call unsafe font_metrics_get_approximate_digit_width#} mPtr+#if PANGO_VERSION_CHECK(1,6,0)+ underline_position <-+ {#call unsafe font_metrics_get_underline_position#} mPtr+ underline_thickness <-+ {#call unsafe font_metrics_get_underline_thickness#} mPtr+ strikethrough_position <-+ {#call unsafe font_metrics_get_strikethrough_position#} mPtr+ strikethrough_thickness <-+ {#call unsafe font_metrics_get_strikethrough_thickness#} mPtr+#endif+ return (FontMetrics+ (intToPu ascent)+ (intToPu descent)+ (intToPu approximate_char_width)+ (intToPu approximate_digit_width)+#if PANGO_VERSION_CHECK(1,6,0)+ (intToPu underline_position)+ (intToPu underline_thickness)+ (intToPu strikethrough_position)+ (intToPu strikethrough_thickness)+#endif+ )++-- | Turn a 'PangoItem' into a 'GlyphItem'.+--+-- * Turns a 'PangoItem', that is, sequence of characters with the same+-- attributes such as font, size and color, into a 'GlyphItem' which+-- contains the graphical representation of these characters. 'GlyphItem's+-- can be rendered directly (and several times) onto screens.+--+pangoShape :: PangoItem -> IO GlyphItem+pangoShape pi@(PangoItem ps pir) =+ withPangoString ps $ \_ l strPtr -> withPangoItemRaw pir $ \pirPtr -> do+ gsPtr <- {#call unsafe glyph_string_new#}+ gs <- makeNewGlyphStringRaw gsPtr+ {#call unsafe shape#} strPtr l (pangoItemRawAnalysis pirPtr) gs+ return (GlyphItem pi gs)
+ Graphics/Rendering/Pango/Structs.hsc view
@@ -0,0 +1,457 @@+{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK hide #-}+-- -*-haskell-*-+-- GIMP Toolkit (GTK) Structures for Pango+--+-- Author : Axel Simon+--+-- Created: 2 March 2008+--+-- Copyright (C) 2008 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- #hide++#include "hspango.h"+#include <glib-2.0/glib.h>+#include "template-hsc-gtk2hs.h"++-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+module Graphics.Rendering.Pango.Structs (+ Markup,+ PangoUnit,+ Color(..),+ Rectangle(..),+ PangoRectangle(..),+ peekIntPangoRectangle,++ PangoDirection(..),++ pangoScale,+ puToInt, puToUInt,+ intToPu, uIntToPu,+ pangodirToLevel,+ PangoAttribute(..),+ setAttrPos,+ pangoItemGetFont,+ pangoItemGetLanguage,+ pangoItemRawAnalysis,+ pangoItemRawGetLevel,+ readAttr+ ) where++import Control.Monad (liftM)+import Data.IORef+import Control.Exception++import System.Glib.FFI+import System.Glib.UTFString ( peekUTFString, UTFCorrection,+ ofsToUTF, ofsFromUTF )+import System.Glib.GObject (makeNewGObject)+import Graphics.Rendering.Pango.Types+import Graphics.Rendering.Pango.BasicTypes++-- | Define a synonym for text with embedded markup commands.+--+-- * Markup strings are just simple strings. But it's easier to tell if a+-- method expects text with or without markup.+--+type Markup = String++-- A pango unit is an internal euclidian metric, that is, a measure for +-- lengths and position.+--+-- * Deprecated. Replaced by Double.+type PangoUnit = Double++-- | Color+--+-- * Specifies a color with three integer values for red, green and blue.+-- All values range from 0 (least intense) to 65535 (highest intensity).+--+data Color = Color (#gtk2hs_type guint16) (#gtk2hs_type guint16) (#gtk2hs_type guint16)+ deriving (Eq,Show)++-- PangoColor is different from GdkColor, but for the Gtk2Hs user we pretend they+-- are the same. To do this, we need a different marshalling routine for PangoColors.++peekPangoColor :: Ptr Color -> IO Color+peekPangoColor ptr = do+ red <- #{peek PangoColor, red} ptr+ green <- #{peek PangoColor, green} ptr+ blue <- #{peek PangoColor, blue} ptr+ return $ Color red green blue++-- | Rectangle+--+-- * Specifies x, y, width and height+--+data Rectangle = Rectangle Int Int Int Int deriving (Eq,Show)++-- | Rectangles describing an area in 'Double's.+--+-- * Specifies x, y, width and height+--+data PangoRectangle = PangoRectangle Double Double Double Double+ deriving Show++instance Storable PangoRectangle where+ sizeOf _ = #{const sizeof(PangoRectangle)}+ alignment _ = alignment (undefined:: #gtk2hs_type gint)+ peek ptr = do+ (Rectangle x_ y_ w_ h_) <- peekIntPangoRectangle ptr+ return $ PangoRectangle (fromIntegral x_/pangoScale) (fromIntegral y_/pangoScale)+ (fromIntegral w_/pangoScale) (fromIntegral h_/pangoScale)+ poke ptr (PangoRectangle x y w h) = do+ #{poke PangoRectangle, x} ptr ((truncate (x*pangoScale))::#gtk2hs_type gint)+ #{poke PangoRectangle, y} ptr ((truncate (y*pangoScale))::#gtk2hs_type gint)+ #{poke PangoRectangle, width} ptr ((truncate (w*pangoScale))::#gtk2hs_type gint)+ #{poke PangoRectangle, height} ptr ((truncate (h*pangoScale))::#gtk2hs_type gint)++peekIntPangoRectangle :: Ptr PangoRectangle -> IO Rectangle+peekIntPangoRectangle ptr = do+ (x_ ::#gtk2hs_type gint) <- #{peek PangoRectangle, x} ptr+ (y_ ::#gtk2hs_type gint) <- #{peek PangoRectangle, y} ptr+ (w_ ::#gtk2hs_type gint) <- #{peek PangoRectangle, width} ptr+ (h_ ::#gtk2hs_type gint) <- #{peek PangoRectangle, height} ptr+ return (Rectangle (fromIntegral x_) (fromIntegral y_)+ (fromIntegral w_) (fromIntegral h_))++-- | The 'PangoDirection' type represents a direction in the Unicode+-- bidirectional algorithm.+--+-- * The \"weak\" values denote a left-to-right or right-to-left direction+-- only if there is no character with a strong direction in a paragraph.+-- An example is a sequence of special, graphical characters which are+-- neutral with respect to their rendering direction. A fresh+-- 'Graphics.UI.Gtk.Pango.Rendering.PangoContext' is by default weakly+-- left-to-right.+--+-- * Not every value in this enumeration makes sense for every usage+-- of 'PangoDirection'; for example, the return value of+-- 'unicharDirection' and 'findBaseDir' cannot be 'PangoDirectionWeakLtr'+-- or 'PangoDirectionWeakRtl', since every character is either neutral or+-- has a strong direction; on the other hand 'PangoDirectionNeutral'+-- doesn't make sense to pass to 'log2visGetEmbeddingLevels'.+--+data PangoDirection = PangoDirectionLtr+ | PangoDirectionRtl+#if PANGO_VERSION_CHECK(1,4,0)+ | PangoDirectionWeakLtr+ | PangoDirectionWeakRtl+ | PangoDirectionNeutral+#endif+ deriving (Eq,Ord)++++-- Internal unit of measuring sizes.+--+-- * This constant represents the scale between+-- dimensions used for distances in text rendering and Pango device units.+-- The+-- definition of device unit is dependent on the output device; it will+-- typically be pixels for a screen, and points for a printer. When+-- setting font sizes, device units are always considered to be points+-- (as in \"12 point font\"), rather than pixels.+--+pangoScale :: Double+pangoScale = #const PANGO_SCALE++puToInt :: Double -> GInt+puToInt u = truncate (u*pangoScale)++puToUInt :: Double -> GInt+puToUInt u = let u' = u*pangoScale in if u'<0 then 0 else truncate u'++intToPu :: GInt -> Double+intToPu i = fromIntegral i/pangoScale++uIntToPu :: GInt -> Double+uIntToPu i = fromIntegral i/pangoScale++instance Enum PangoDirection where+ fromEnum PangoDirectionLtr = #{const PANGO_DIRECTION_LTR }+ fromEnum PangoDirectionRtl = #{const PANGO_DIRECTION_RTL }+#if PANGO_VERSION_CHECK(1,4,0)+ fromEnum PangoDirectionWeakLtr = #{const PANGO_DIRECTION_WEAK_LTR }+ fromEnum PangoDirectionWeakRtl = #{const PANGO_DIRECTION_WEAK_RTL }+ fromEnum PangoDirectionNeutral = #{const PANGO_DIRECTION_NEUTRAL }+#endif+ toEnum #{const PANGO_DIRECTION_LTR } = PangoDirectionLtr+ toEnum #{const PANGO_DIRECTION_RTL } = PangoDirectionRtl+ toEnum #{const PANGO_DIRECTION_TTB_LTR } = PangoDirectionLtr+ toEnum #{const PANGO_DIRECTION_TTB_RTL } = PangoDirectionRtl+#if PANGO_VERSION_CHECK(1,4,0)+ toEnum #{const PANGO_DIRECTION_WEAK_LTR } = PangoDirectionWeakLtr+ toEnum #{const PANGO_DIRECTION_WEAK_RTL } = PangoDirectionWeakRtl+ toEnum #{const PANGO_DIRECTION_NEUTRAL } = PangoDirectionNeutral+#endif++-- This is a copy of the local function direction_simple in pango-layout.c+pangodirToLevel :: PangoDirection -> Int+pangodirToLevel PangoDirectionLtr = 1+pangodirToLevel PangoDirectionRtl = -1+#if PANGO_VERSION_CHECK(1,4,0)+pangodirToLevel PangoDirectionWeakLtr = 1+pangodirToLevel PangoDirectionWeakRtl = -1+pangodirToLevel PangoDirectionNeutral = 0+#endif++-- | Extract the font used for this 'PangoItem'.+--+pangoItemGetFont :: PangoItem -> IO Font+pangoItemGetFont (PangoItem _ (PangoItemRaw pir)) =+ withForeignPtr pir pangoItemRawGetFont++-- | Extract the 'Language' used for this 'PangoItem'.+--+pangoItemGetLanguage :: PangoItem -> IO Language+pangoItemGetLanguage (PangoItem _ (PangoItemRaw pir)) =+ liftM (Language . castPtr) $ withForeignPtr pir pangoItemRawGetLanguage++-- Get the font of a PangoAnalysis within a PangoItem.+pangoItemRawGetFont :: Ptr pangoItem -> IO Font+pangoItemRawGetFont ptr =+ makeNewGObject mkFont (#{peek PangoItem, analysis.font} ptr)++-- Get the font of a PangoAnalysis within a PangoItem.+pangoItemRawGetLanguage :: Ptr pangoItem -> IO (Ptr CChar)+pangoItemRawGetLanguage ptr =+ #{peek PangoItem, analysis.language} ptr++-- Get the PangoAnalysis within a PangoItem+pangoItemRawAnalysis :: Ptr pangoItem -> Ptr pangoAnalysis+pangoItemRawAnalysis = #{ptr PangoItem, analysis}++-- Get the text direction of this PangoItem.+pangoItemRawGetLevel :: Ptr pangoItem -> IO Bool+pangoItemRawGetLevel ptr = do+ level <- #{peek PangoItem, analysis.level} ptr+ return (toBool (level :: #{gtk2hs_type guint8}))++-- Set the start and end position of an attribute+setAttrPos :: UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())+setAttrPos correct start end act = do+ atPtr <- act+ #{poke PangoAttribute, start_index} atPtr+ (fromIntegral (ofsToUTF start correct) :: #{gtk2hs_type guint})+ #{poke PangoAttribute, end_index} atPtr+ (fromIntegral (ofsToUTF end correct) :: #{gtk2hs_type guint})+ return atPtr++-- | Attributes for 'PangoItem's.+--+-- * A given attribute is applied from its start position 'paStart' up,+-- but not including the end position, 'paEnd'.+--+data PangoAttribute+ -- | A hint as to what language this piece of text is written in.+ = AttrLanguage { paStart :: Int, paEnd :: Int, paLang :: Language }+ -- | The font family, e.g. @sans serif@.+ | AttrFamily { paStart :: Int, paEnd :: Int, paFamily :: String }+ -- | The slant of the current font.+ | AttrStyle { paStart :: Int, paEnd :: Int, paStyle :: FontStyle }+ -- | Weight of font, e.g. 'WeightBold'.+ | AttrWeight { paStart :: Int, paEnd :: Int, paWeight :: Weight }+ -- | 'VariantSmallCaps' will display lower case letters as small+ -- upper case letters (if the font supports this).+ | AttrVariant { paStart :: Int, paEnd :: Int, paVariant :: Variant }+ -- | Stretch or condense the width of the letters.+ | AttrStretch { paStart :: Int, paEnd :: Int, paStretch :: Stretch }+ -- | Specify the size of the font in points.+ | AttrSize { paStart :: Int, paEnd :: Int, paSize :: Double }+#if PANGO_VERSION_CHECK(1,8,0)+ -- | Specify the size of the font in device units (pixels).+ --+ -- * Available in Pango 1.8.0 and higher.+ --+ | AttrAbsSize { paStart :: Int, paEnd :: Int, paSize :: Double }+#endif+ -- | Specify several attributes of a font at once. Note that no deep copy+ -- of the description is made when this attributes is passed to or received+ -- from functions.+ | AttrFontDescription { paStart :: Int, paEnd :: Int,+ paFontDescription :: FontDescription }+ -- | Specify the foreground color.+ | AttrForeground { paStart :: Int, paEnd :: Int, paColor :: Color }+ -- | Specify the background color.+ | AttrBackground { paStart :: Int, paEnd :: Int, paColor :: Color }+ -- | Specify the kind of underline, e.g. 'UnderlineSingle'.+ | AttrUnderline { paStart :: Int, paEnd :: Int, paUnderline :: Underline }+#if (defined (WIN32) && PANGO_VERSION_CHECK(1,10,0)) \+ || (!defined (WIN32) && PANGO_VERSION_CHECK(1,8,0))+ -- | Specify the color of an underline.+ --+ -- * Available in Pango 1.8.0 and higher.+ --+ | AttrUnderlineColor { paStart :: Int, paEnd :: Int, paColor :: Color }+#endif+ -- | Specify if this piece of text should have a line through it.+ | AttrStrikethrough { paStart :: Int, paEnd :: Int, paStrikethrough :: Bool }+#if (defined (WIN32) && PANGO_VERSION_CHECK(1,10,0)) \+ || (!defined (WIN32) && PANGO_VERSION_CHECK(1,8,0))+ -- | Specify the color of the strike through line.+ --+ -- * Available in Pango 1.8.0 and higher.+ --+ | AttrStrikethroughColor { paStart :: Int, paEnd :: Int, paColor :: Color }+#endif+ -- | Displace the text vertically. Positive values move the text upwards.+ | AttrRise { paStart :: Int, paEnd :: Int, paRise :: Double }+#if PANGO_VERSION_CHECK(1,8,0)+ -- | Restrict the amount of what is drawn of the marked shapes.+ --+ -- * Available in Pango 1.8.0 and higher.+ --+ | AttrShape { paStart :: Int, paEnd :: Int, paInk :: PangoRectangle,+ paLogical :: PangoRectangle }+#endif+ -- | Scale the font up (values greater than one) or shrink the font.+ | AttrScale { paStart :: Int, paEnd :: Int, paScale :: Double }+#if PANGO_VERSION_CHECK(1,4,0)+ -- | Determine if a fall back font should be substituted if no matching+ -- font is available.+ | AttrFallback { paStart :: Int, paEnd :: Int, paFallback :: Bool }+#endif+#if PANGO_VERSION_CHECK(1,6,0)+ -- | Add extra space between graphemes of the text.+ --+ -- * Available in Pango 1.6.0 and higher.+ --+ | AttrLetterSpacing { paStart :: Int, paEnd :: Int, + paLetterSpacing :: Double }+#endif+#if PANGO_VERSION_CHECK(1,16,0)+ -- | Sets the gravity field of a font description. The gravity field specifies+ -- how the glyphs should be rotated. If gravity is 'GravityAuto', this+ -- actually unsets the gravity mask on the font description.+ --+ -- * This function is seldom useful to the user. Gravity should normally be+ -- set on a 'PangoContext'.+ --+ -- * Available in Pango 1.16.0 and higher.+ --+ | AttrGravity { paStart :: Int, paEnd :: Int, + paGravity :: PangoGravity }++ -- | Set the way horizontal scripts behave in a vertical context.+ --+ -- * Available in Pango 1.16.0 and higher.+ --+ | AttrGravityHint { paStart :: Int, paEnd :: Int, + paGravityHint :: PangoGravityHint }+#endif+ deriving Show++-- | Convert a pointer to an attribute to an attribute.+readAttr :: UTFCorrection -> CPangoAttribute -> IO PangoAttribute+readAttr correct attrPtr = do+ klassPtr <- #{peek PangoAttribute, klass} attrPtr+ startByte <- #{peek PangoAttribute, start_index} attrPtr+ endByte <- #{peek PangoAttribute, end_index} attrPtr+ ty <- #{peek PangoAttrClass, type} klassPtr+ let b :: Int+ b = ofsFromUTF (fromIntegral (startByte :: #{gtk2hs_type guint})) correct+ e :: Int+ e = ofsFromUTF (fromIntegral (endByte :: #{gtk2hs_type guint})) correct+ case ty :: #{gtk2hs_type PangoAttrType} of+ #{const PANGO_ATTR_LANGUAGE} -> do+ lang <- #{peek PangoAttrLanguage, value} attrPtr+ return $ AttrLanguage b e (Language lang)+ #{const PANGO_ATTR_FAMILY} -> do+ strPtr <- #{peek PangoAttrString, value} attrPtr+ str <- peekUTFString strPtr+ return $ AttrFamily b e str+ #{const PANGO_ATTR_STYLE} -> do+ v <- #{peek PangoAttrInt, value} attrPtr+ return $ AttrStyle b e (toEnum (fromIntegral (v::#{gtk2hs_type int})))+ #{const PANGO_ATTR_WEIGHT} -> do+ v <- #{peek PangoAttrInt, value} attrPtr+ return $ AttrWeight b e (toEnum (fromIntegral (v::#{gtk2hs_type int})))+ #{const PANGO_ATTR_VARIANT} -> do+ v <- #{peek PangoAttrInt, value} attrPtr+ return $ AttrVariant b e (toEnum (fromIntegral (v::#{gtk2hs_type int})))+ #{const PANGO_ATTR_STRETCH} -> do+ v <- #{peek PangoAttrInt, value} attrPtr+ return $ AttrStretch b e (toEnum (fromIntegral (v::#{gtk2hs_type int})))+ #{const PANGO_ATTR_SIZE} -> do+ v <- #{peek PangoAttrFloat, value} attrPtr+ return $ AttrSize b e (realToFrac (v::#{gtk2hs_type double}))+#if PANGO_VERSION_CHECK(1,8,0)+ #{const PANGO_ATTR_ABSOLUTE_SIZE} -> do+ v <- #{peek PangoAttrFloat, value} attrPtr+ return $ AttrAbsSize b e (realToFrac (v::#{gtk2hs_type double}))+#endif+ #{const PANGO_ATTR_FONT_DESC} -> do+ fdPtr <- #{peek PangoAttrFontDesc, desc} attrPtr+ fd <- makeNewFontDescription fdPtr+ return $ AttrFontDescription b e fd+ #{const PANGO_ATTR_FOREGROUND} -> do+ col <- peekPangoColor (#{ptr PangoAttrColor, color} attrPtr)+ return $ AttrForeground b e col+ #{const PANGO_ATTR_BACKGROUND} -> do+ col <- peekPangoColor (#{ptr PangoAttrColor, color} attrPtr)+ return $ AttrBackground b e col+ #{const PANGO_ATTR_UNDERLINE} -> do+ v <- #{peek PangoAttrInt, value} attrPtr+ return $ AttrUnderline b e (toEnum (fromIntegral (v::#{gtk2hs_type int})))+#if (defined (WIN32) && PANGO_VERSION_CHECK(1,10,0)) \+ || (!defined (WIN32) && PANGO_VERSION_CHECK(1,8,0))+ #{const PANGO_ATTR_UNDERLINE_COLOR} -> do+ col <- peekPangoColor (#{ptr PangoAttrColor, color} attrPtr)+ return $ AttrUnderlineColor b e col+#endif+ #{const PANGO_ATTR_STRIKETHROUGH} -> do+ v <- #{peek PangoAttrInt, value} attrPtr+ return $ AttrStrikethrough b e (toEnum (fromIntegral (v::#{gtk2hs_type int})))+#if (defined (WIN32) && PANGO_VERSION_CHECK(1,10,0)) \+ || (!defined (WIN32) && PANGO_VERSION_CHECK(1,8,0))+ #{const PANGO_ATTR_STRIKETHROUGH_COLOR} -> do+ col <- peekPangoColor (#{ptr PangoAttrColor, color} attrPtr)+ return $ AttrStrikethroughColor b e col+#endif+ #{const PANGO_ATTR_RISE} -> do+ v <- #{peek PangoAttrFloat, value} attrPtr+ return $ AttrRise b e (realToFrac (v::#{gtk2hs_type double}))+#if PANGO_VERSION_CHECK(1,8,0)+ #{const PANGO_ATTR_SHAPE} -> do+ rect1 <- #{peek PangoAttrShape, ink_rect} attrPtr+ rect2 <- #{peek PangoAttrShape, logical_rect} attrPtr+ return $ AttrShape b e rect1 rect2+#endif+ #{const PANGO_ATTR_SCALE} -> do+ v <- #{peek PangoAttrFloat, value} attrPtr+ return $ AttrScale b e (realToFrac (v::#{gtk2hs_type double}))+#if PANGO_VERSION_CHECK(1,4,0)+ #{const PANGO_ATTR_FALLBACK} -> do+ v <- #{peek PangoAttrInt, value} attrPtr+ return $ AttrFallback b e (toBool (v::#{gtk2hs_type int}))+#endif+#if PANGO_VERSION_CHECK(1,6,0)+ #{const PANGO_ATTR_LETTER_SPACING} -> do+ v <- #{peek PangoAttrFloat, value} attrPtr+ return $ AttrLetterSpacing b e (realToFrac (v::#{gtk2hs_type double}))+#endif+#if PANGO_VERSION_CHECK(1,16,0)+ #{const PANGO_ATTR_GRAVITY} -> do+ v <- #{peek PangoAttrInt, value} attrPtr+ return $ AttrGravity b e (toEnum (fromIntegral (v::#{gtk2hs_type int})))+ #{const PANGO_ATTR_GRAVITY_HINT} -> do+ v <- #{peek PangoAttrInt, value} attrPtr+ return $ AttrGravityHint b e (toEnum (fromIntegral (v::#{gtk2hs_type int})))+#endif+ _ -> error "extracting pango attributes: unknown attribute type"
+ Graphics/Rendering/Pango/Types.chs view
@@ -0,0 +1,248 @@+{-# OPTIONS_HADDOCK hide #-}+-- -*-haskell-*-+-- -------------------- automatically generated file - do not edit ----------+-- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell+--+-- Author : Axel Simon+--+-- Copyright (C) 2001-2005 Axel Simon+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- #hide++-- |+-- Maintainer : gtk2hs-users@lists.sourceforge.net+-- Stability : provisional+-- Portability : portable (depends on GHC)+--+-- This file reflects the Gtk+ object hierarchy in terms of Haskell classes.+--+-- Note: the mk... functions were originally meant to simply be an alias+-- for the constructor. However, in order to communicate the destructor+-- of an object to objectNew, the mk... functions are now a tuple containing+-- Haskell constructor and the destructor function pointer. This hack avoids+-- changing all modules that simply pass mk... to objectNew.+--+module Graphics.Rendering.Pango.Types (++ module System.Glib.GObject,+ PangoContext(PangoContext), PangoContextClass,+ toPangoContext, + mkPangoContext, unPangoContext,+ castToPangoContext, gTypePangoContext,+ PangoLayoutRaw(PangoLayoutRaw), PangoLayoutRawClass,+ toPangoLayoutRaw, + mkPangoLayoutRaw, unPangoLayoutRaw,+ castToPangoLayoutRaw, gTypePangoLayoutRaw,+ Font(Font), FontClass,+ toFont, + mkFont, unFont,+ castToFont, gTypeFont,+ FontFamily(FontFamily), FontFamilyClass,+ toFontFamily, + mkFontFamily, unFontFamily,+ castToFontFamily, gTypeFontFamily,+ FontFace(FontFace), FontFaceClass,+ toFontFace, + mkFontFace, unFontFace,+ castToFontFace, gTypeFontFace,+ FontMap(FontMap), FontMapClass,+ toFontMap, + mkFontMap, unFontMap,+ castToFontMap, gTypeFontMap,+ FontSet(FontSet), FontSetClass,+ toFontSet, + mkFontSet, unFontSet,+ castToFontSet, gTypeFontSet+ ) where++import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr)+import Foreign.C.Types (CULong, CUInt)+import System.Glib.GType (GType, typeInstanceIsA)+{#import System.Glib.GObject#}++{# context lib="gtk" prefix="gtk" #}++-- The usage of foreignPtrToPtr should be safe as the evaluation will only be+-- forced if the object is used afterwards+--+castTo :: (GObjectClass obj, GObjectClass obj') => GType -> String+ -> (obj -> obj')+castTo gtype objTypeName obj =+ case toGObject obj of+ gobj@(GObject objFPtr)+ | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype+ -> unsafeCastGObject gobj+ | otherwise -> error $ "Cannot cast object to " ++ objTypeName+++-- *************************************************************** PangoContext++{#pointer *PangoContext foreign newtype #} deriving (Eq,Ord)++mkPangoContext = (PangoContext, objectUnref)+unPangoContext (PangoContext o) = o++class GObjectClass o => PangoContextClass o+toPangoContext :: PangoContextClass o => o -> PangoContext+toPangoContext = unsafeCastGObject . toGObject++instance PangoContextClass PangoContext+instance GObjectClass PangoContext where+ toGObject = GObject . castForeignPtr . unPangoContext+ unsafeCastGObject = PangoContext . castForeignPtr . unGObject++castToPangoContext :: GObjectClass obj => obj -> PangoContext+castToPangoContext = castTo gTypePangoContext "PangoContext"++gTypePangoContext :: GType+gTypePangoContext =+ {# call fun unsafe pango_context_get_type #}++-- ************************************************************* PangoLayoutRaw++{#pointer *PangoLayout as PangoLayoutRaw foreign newtype #} deriving (Eq,Ord)++mkPangoLayoutRaw = (PangoLayoutRaw, objectUnref)+unPangoLayoutRaw (PangoLayoutRaw o) = o++class GObjectClass o => PangoLayoutRawClass o+toPangoLayoutRaw :: PangoLayoutRawClass o => o -> PangoLayoutRaw+toPangoLayoutRaw = unsafeCastGObject . toGObject++instance PangoLayoutRawClass PangoLayoutRaw+instance GObjectClass PangoLayoutRaw where+ toGObject = GObject . castForeignPtr . unPangoLayoutRaw+ unsafeCastGObject = PangoLayoutRaw . castForeignPtr . unGObject++castToPangoLayoutRaw :: GObjectClass obj => obj -> PangoLayoutRaw+castToPangoLayoutRaw = castTo gTypePangoLayoutRaw "PangoLayoutRaw"++gTypePangoLayoutRaw :: GType+gTypePangoLayoutRaw =+ {# call fun unsafe pango_layout_get_type #}++-- *********************************************************************** Font++{#pointer *PangoFont as Font foreign newtype #} deriving (Eq,Ord)++mkFont = (Font, objectUnref)+unFont (Font o) = o++class GObjectClass o => FontClass o+toFont :: FontClass o => o -> Font+toFont = unsafeCastGObject . toGObject++instance FontClass Font+instance GObjectClass Font where+ toGObject = GObject . castForeignPtr . unFont+ unsafeCastGObject = Font . castForeignPtr . unGObject++castToFont :: GObjectClass obj => obj -> Font+castToFont = castTo gTypeFont "Font"++gTypeFont :: GType+gTypeFont =+ {# call fun unsafe pango_font_get_type #}++-- ***************************************************************** FontFamily++{#pointer *PangoFontFamily as FontFamily foreign newtype #} deriving (Eq,Ord)++mkFontFamily = (FontFamily, objectUnref)+unFontFamily (FontFamily o) = o++class GObjectClass o => FontFamilyClass o+toFontFamily :: FontFamilyClass o => o -> FontFamily+toFontFamily = unsafeCastGObject . toGObject++instance FontFamilyClass FontFamily+instance GObjectClass FontFamily where+ toGObject = GObject . castForeignPtr . unFontFamily+ unsafeCastGObject = FontFamily . castForeignPtr . unGObject++castToFontFamily :: GObjectClass obj => obj -> FontFamily+castToFontFamily = castTo gTypeFontFamily "FontFamily"++gTypeFontFamily :: GType+gTypeFontFamily =+ {# call fun unsafe pango_font_family_get_type #}++-- ******************************************************************* FontFace++{#pointer *PangoFontFace as FontFace foreign newtype #} deriving (Eq,Ord)++mkFontFace = (FontFace, objectUnref)+unFontFace (FontFace o) = o++class GObjectClass o => FontFaceClass o+toFontFace :: FontFaceClass o => o -> FontFace+toFontFace = unsafeCastGObject . toGObject++instance FontFaceClass FontFace+instance GObjectClass FontFace where+ toGObject = GObject . castForeignPtr . unFontFace+ unsafeCastGObject = FontFace . castForeignPtr . unGObject++castToFontFace :: GObjectClass obj => obj -> FontFace+castToFontFace = castTo gTypeFontFace "FontFace"++gTypeFontFace :: GType+gTypeFontFace =+ {# call fun unsafe pango_font_face_get_type #}++-- ******************************************************************** FontMap++{#pointer *PangoFontMap as FontMap foreign newtype #} deriving (Eq,Ord)++mkFontMap = (FontMap, objectUnref)+unFontMap (FontMap o) = o++class GObjectClass o => FontMapClass o+toFontMap :: FontMapClass o => o -> FontMap+toFontMap = unsafeCastGObject . toGObject++instance FontMapClass FontMap+instance GObjectClass FontMap where+ toGObject = GObject . castForeignPtr . unFontMap+ unsafeCastGObject = FontMap . castForeignPtr . unGObject++castToFontMap :: GObjectClass obj => obj -> FontMap+castToFontMap = castTo gTypeFontMap "FontMap"++gTypeFontMap :: GType+gTypeFontMap =+ {# call fun unsafe pango_font_face_get_type #}++-- ******************************************************************** FontSet++{#pointer *PangoFontset as FontSet foreign newtype #} deriving (Eq,Ord)++mkFontSet = (FontSet, objectUnref)+unFontSet (FontSet o) = o++class GObjectClass o => FontSetClass o+toFontSet :: FontSetClass o => o -> FontSet+toFontSet = unsafeCastGObject . toGObject++instance FontSetClass FontSet+instance GObjectClass FontSet where+ toGObject = GObject . castForeignPtr . unFontSet+ unsafeCastGObject = FontSet . castForeignPtr . unGObject++castToFontSet :: GObjectClass obj => obj -> FontSet+castToFontSet = castTo gTypeFontSet "FontSet"++gTypeFontSet :: GType+gTypeFontSet =+ {# call fun unsafe pango_fontset_get_type #}+
+ Gtk2HsSetup.hs view
@@ -0,0 +1,486 @@+{-# LANGUAGE CPP #-}++#define CABAL_VERSION_ENCODE(major, minor, micro) ( \+ ((major) * 10000) \+ + ((minor) * 100) \+ + ((micro) * 1))++#define CABAL_VERSION_CHECK(major,minor,micro) \+ (CABAL_VERSION >= CABAL_VERSION_ENCODE(major,minor,micro))++-- now, this is bad, but Cabal doesn't seem to actually pass any information about+-- its version to CPP, so guess the version depending on the version of GHC+#ifdef CABAL_VERSION_MINOR+#ifndef CABAL_VERSION_MAJOR+#define CABAL_VERSION_MAJOR 1+#endif+#ifndef CABAL_VERSION_MICRO+#define CABAL_VERSION_MICRO 0+#endif+#define CABAL_VERSION CABAL_VERSION_ENCODE( \+ CABAL_VERSION_MAJOR, \+ CABAL_VERSION_MINOR, \+ CABAL_VERSION_MICRO)+#else+#warning Setup.hs is guessing the version of Cabal. If compilation of Setup.hs fails use -DCABAL_VERSION_MINOR=x for Cabal version 1.x.0 when building (prefixed by --ghc-option= when using the 'cabal' command)+#if (__GLASGOW_HASKELL__ >= 612)+#define CABAL_VERSION CABAL_VERSION_ENCODE(1,8,0)+#else+#define CABAL_VERSION CABAL_VERSION_ENCODE(1,6,0)+#endif+#endif++-- | Build a Gtk2hs package.+--+module Gtk2HsSetup ( gtk2hsUserHooks, getPkgConfigPackages ) where++import Distribution.Simple+import Distribution.Simple.PreProcess+import Distribution.InstalledPackageInfo ( importDirs,+ showInstalledPackageInfo,+ libraryDirs,+ extraLibraries,+ extraGHCiLibraries )+import Distribution.Simple.PackageIndex (+#if CABAL_VERSION_CHECK(1,8,0)+ lookupInstalledPackageId+#else+ lookupPackageId+#endif+ )+import Distribution.PackageDescription as PD ( PackageDescription(..),+ updatePackageDescription,+ BuildInfo(..),+ emptyBuildInfo, allBuildInfo,+ Library(..),+ libModules, hasLibs)+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..),+ InstallDirs(..),+#if CABAL_VERSION_CHECK(1,8,0)+ componentPackageDeps,+#else+ packageDeps,+#endif+ absoluteInstallDirs)+import Distribution.Simple.Compiler ( Compiler(..) )+import Distribution.Simple.Program (+ Program(..), ConfiguredProgram(..),+ rawSystemProgramConf, rawSystemProgramStdoutConf,+ c2hsProgram, pkgConfigProgram, requireProgram, ghcPkgProgram,+ simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg)+import Distribution.ModuleName ( ModuleName, components, toFilePath )+import Distribution.Simple.Utils+import Distribution.Simple.Setup (CopyFlags(..), InstallFlags(..), CopyDest(..),+ defaultCopyFlags, ConfigFlags(configVerbosity),+ fromFlag, toFlag, RegisterFlags(..), flagToMaybe,+ fromFlagOrDefault, defaultRegisterFlags)+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Install ( install )+#if CABAL_VERSION_CHECK(1,8,0)+import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage )+#else+import qualified Distribution.Simple.Register as Register ( register )+#endif+import Distribution.Text ( simpleParse, display )+import System.FilePath+import System.Directory ( doesFileExist )+import Distribution.Version (Version(..))+import Distribution.Verbosity+import Control.Monad (when, unless, filterM)+import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList )+import Data.List (isPrefixOf, isSuffixOf, nub)+import Data.Char (isAlpha)+import qualified Data.Map as M+import qualified Data.Set as S++import Control.Applicative ((<$>))+import System.Directory (getDirectoryContents, doesDirectoryExist)++-- the name of the c2hs pre-compiled header file+precompFile = "precompchs.bin"++gtk2hsUserHooks = simpleUserHooks {+ hookedPrograms = [typeGenProgram, signalGenProgram, c2hsLocal],+ hookedPreProcessors = [("chs", ourC2hs)],+ confHook = \pd cf ->+ confHook simpleUserHooks pd cf >>= return . adjustLocalBuildInfo,+ postConf = \args cf pd lbi -> do+ genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi+ postConf simpleUserHooks args cf pd lbi,+ buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd ->+ (buildHook simpleUserHooks) pd lbi uh bf,+ copyHook = \pd lbi uh flags -> (copyHook simpleUserHooks) pd lbi uh flags >>+ installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)),+ instHook = \pd lbi uh flags ->+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+ installHook pd lbi uh flags >>+ installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest,+ regHook = registerHook+#else+ instHook simpleUserHooks pd lbi uh flags >>+ installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest+#endif+ }++------------------------------------------------------------------------------+-- Lots of stuff for windows ghci support+------------------------------------------------------------------------------++getDlls :: [FilePath] -> IO [FilePath]+getDlls dirs = filter ((== ".dll") . takeExtension) . concat <$>+ mapM getDirectoryContents dirs++fixLibs :: [FilePath] -> [String] -> [String]+fixLibs dlls = concatMap $ \ lib ->+ case filter (("lib" ++ lib) `isPrefixOf`) dlls of+ dll:_ -> [dropExtension dll]+ _ -> if lib == "z" then [] else [lib]++-- The following code is a big copy-and-paste job from the sources of+-- Cabal 1.8 just to be able to fix a field in the package file. Yuck.++#if CABAL_VERSION_CHECK(1,8,0)+ +installHook :: PackageDescription -> LocalBuildInfo+ -> UserHooks -> InstallFlags -> IO ()+installHook pkg_descr localbuildinfo _ flags = do+ let copyFlags = defaultCopyFlags {+ copyDistPref = installDistPref flags,+ copyDest = toFlag NoCopyDest,+ copyVerbosity = installVerbosity flags+ }+ install pkg_descr localbuildinfo copyFlags+ let registerFlags = defaultRegisterFlags {+ regDistPref = installDistPref flags,+ regInPlace = installInPlace flags,+ regPackageDB = installPackageDB flags,+ regVerbosity = installVerbosity flags+ }+ when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags++registerHook :: PackageDescription -> LocalBuildInfo+ -> UserHooks -> RegisterFlags -> IO ()+registerHook pkg_descr localbuildinfo _ flags =+ if hasLibs pkg_descr+ then register pkg_descr localbuildinfo flags+ else setupMessage verbosity+ "Package contains no library to register:" (packageId pkg_descr)+ where verbosity = fromFlag (regVerbosity flags)++register :: PackageDescription -> LocalBuildInfo+ -> RegisterFlags -- ^Install in the user's database?; verbose+ -> IO ()+register pkg@PackageDescription { library = Just lib }+ lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags+ = do++ installedPkgInfoRaw <- generateRegistrationInfo+ verbosity pkg lib lbi clbi inplace distPref++ dllsInScope <- getSearchPath >>= (filterM doesDirectoryExist) >>= getDlls+ let libs = fixLibs dllsInScope (extraLibraries installedPkgInfoRaw)+ installedPkgInfo = installedPkgInfoRaw {+ extraGHCiLibraries = libs }++ -- Three different modes:+ case () of+ _ | modeGenerateRegFile -> die "Generate Reg File not supported"+ | modeGenerateRegScript -> die "Generate Reg Script not supported"+ | otherwise -> registerPackage verbosity+ installedPkgInfo pkg lbi inplace packageDb++ where+ modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))+ modeGenerateRegScript = fromFlag (regGenScript regFlags)+ inplace = fromFlag (regInPlace regFlags)+ packageDb = case flagToMaybe (regPackageDB regFlags) of+ Just db -> db+ Nothing -> registrationPackageDB (withPackageDB lbi)+ distPref = fromFlag (regDistPref regFlags)+ verbosity = fromFlag (regVerbosity regFlags)++register _ _ regFlags = notice verbosity "No package to register"+ where+ verbosity = fromFlag (regVerbosity regFlags)++#else+installHook :: PackageDescription -> LocalBuildInfo+ -> UserHooks -> InstallFlags -> IO ()+installHook pkg_descr localbuildinfo _ flags = do+ let copyFlags = defaultCopyFlags {+ copyDistPref = installDistPref flags,+ copyInPlace = installInPlace flags,+ copyUseWrapper = installUseWrapper flags,+ copyDest = toFlag NoCopyDest,+ copyVerbosity = installVerbosity flags+ }+ install pkg_descr localbuildinfo copyFlags+ let registerFlags = defaultRegisterFlags {+ regDistPref = installDistPref flags,+ regInPlace = installInPlace flags,+ regPackageDB = installPackageDB flags,+ regVerbosity = installVerbosity flags+ }+ when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags++registerHook :: PackageDescription -> LocalBuildInfo+ -> UserHooks -> RegisterFlags -> IO ()+registerHook pkg_descr localbuildinfo _ flags =+ if hasLibs pkg_descr+ then register pkg_descr localbuildinfo flags+ else setupMessage verbosity+ "Package contains no library to register:" (packageId pkg_descr)+ where verbosity = fromFlag (regVerbosity flags)++register :: PackageDescription -> LocalBuildInfo+ -> RegisterFlags -- ^Install in the user's database?; verbose+ -> IO ()+register pkg_descr lbi regFlags = do+ let verbosity = fromFlag (regVerbosity regFlags)+ warn verbosity "Cannot register ghci libraries with Cabal 1.6 (need 1.8)."+ Register.register pkg_descr lbi regFlags+ +#endif++------------------------------------------------------------------------------+-- This is a hack for Cabal-1.8, It is not needed in Cabal-1.9.1 or later+------------------------------------------------------------------------------++adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo+adjustLocalBuildInfo lbi =+ let extra = (Just libBi, [])+ libBi = emptyBuildInfo { includeDirs = [ autogenModulesDir lbi+ , buildDir lbi ] }+ in lbi { localPkgDescr = updatePackageDescription extra (localPkgDescr lbi) }++------------------------------------------------------------------------------+-- Processing .chs files with our local c2hs.+------------------------------------------------------------------------------++ourC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor+ourC2hs bi lbi = PreProcessor {+ platformIndependent = False,+ runPreProcessor = runC2HS bi lbi+}++runC2HS :: BuildInfo -> LocalBuildInfo ->+ (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO ()+runC2HS bi lbi (inDir, inFile) (outDir, outFile) verbosity = do+ -- have the header file name if we don't have the precompiled header yet+ header <- case lookup "x-c2hs-header" (customFieldsBI bi) of+ Just h -> return h+ Nothing -> die ("Need x-c2hs-Header definition in the .cabal Library section "+++ "that sets the C header file to process .chs.pp files.")++ -- c2hs will output files in out dir, removing any leading path of the input file.+ -- Thus, append the dir of the input file to the output dir.+ let (outFileDir, newOutFile) = splitFileName outFile+ let newOutDir = outDir </> outFileDir+ -- additional .chi files might be needed that other packages have installed;+ -- we assume that these are installed in the same place as .hi files+ let chiDirs = [ dir |+#if CABAL_VERSION_CHECK(1,8,0)+ ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi),+ dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ]+#else+ ipi <- packageDeps lbi,+ dir <- maybe [] importDirs (lookupPackageId (installedPkgs lbi) ipi) ]+#endif+ rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $+ map ("--include=" ++) (outDir:chiDirs)+ ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi]+ ++ ["--output-dir=" ++ newOutDir,+ "--output=" ++ newOutFile,+ "--precomp=" ++ buildDir lbi </> precompFile,+ header, inDir </> inFile]++getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]+getCppOptions bi lbi+ = nub $+ ["-I" ++ dir | dir <- PD.includeDirs bi]+ ++ [opt | opt@('-':c:_) <- (PD.cppOptions bi ++ PD.ccOptions bi), c `elem` "DIU"]++installCHI :: PackageDescription -- ^information from the .cabal file+ -> LocalBuildInfo -- ^information from the configure step+ -> Verbosity -> CopyDest -- ^flags sent to copy or install+ -> IO ()+installCHI pkg@PD.PackageDescription { library = Just lib } lbi verbosity copydest = do+ let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest+ -- cannot use the recommended 'findModuleFiles' since it fails if there exists+ -- a modules that does not have a .chi file+ mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi])+ (map toFilePath+#if CABAL_VERSION_CHECK(1,8,0)+ (PD.libModules lib)+#else+ (PD.libModules pkg)+#endif+ )+ let files = [ f | Just f <- mFiles ]+#if CABAL_VERSION_CHECK(1,8,0)+ installOrdinaryFiles verbosity libPref files+#else+ copyFiles verbosity libPref files+#endif++ +installCHI _ _ _ _ = return ()++------------------------------------------------------------------------------+-- Generating the type hierarchy and signal callback .hs files.+------------------------------------------------------------------------------++typeGenProgram :: Program+typeGenProgram = (simpleProgram "gtk2hsTypeGen")++signalGenProgram :: Program+signalGenProgram = (simpleProgram "gtk2hsHookGenerator")++c2hsLocal :: Program+c2hsLocal = (simpleProgram "gtk2hsC2hs")++genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+genSynthezisedFiles verb pd lbi = do++ cPkgs <- getPkgConfigPackages verb lbi pd++ let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd)+ ++customFieldsPD pd+ typeOpts :: String -> [ProgArg]+ typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field++'=':val) (words content)+ | (field,content) <- xList,+ tag `isPrefixOf` field,+ field /= (tag++"file")]+ ++ [ "--tag=" ++ tag+ | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs+ , let name' = filter isAlpha (display name)+ , tag <- name'+ : [ name' ++ "-" ++ show major ++ "." ++ show digit+ | digit <- [0,2..minor] ]+ ]++ signalsOpts :: [ProgArg]+ signalsOpts = concat [ map (\val -> '-':'-':drop 10 field++'=':val) (words content)+ | (field,content) <- xList,+ "x-signals-" `isPrefixOf` field,+ field /= "x-signals-file"]++ genFile :: Program -> [ProgArg] -> FilePath -> IO ()+ genFile prog args outFile = do+ res <- rawSystemProgramStdoutConf verb prog (withPrograms lbi) args+ rewriteFile outFile res++ (flip mapM_) (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $+ \(fileTag, f) -> do+ let tag = reverse (drop 4 (reverse fileTag))+ info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.")+ genFile typeGenProgram (typeOpts tag) f++ case lookup "x-signals-file" xList of+ Nothing -> return ()+ Just f -> do+ info verb ("Ensuring that callback hooks in "++f++" are up-to-date.")+ genFile signalGenProgram signalsOpts f++--FIXME: Cabal should tell us the selected pkg-config package versions in the+-- LocalBuildInfo or equivalent.+-- In the mean time, ask pkg-config again.++getPkgConfigPackages :: Verbosity -> LocalBuildInfo -> PackageDescription -> IO [PackageId]+getPkgConfigPackages verbosity lbi pkg =+ sequence+ [ do version <- pkgconfig ["--modversion", display pkgname]+ case simpleParse version of+ Nothing -> die $ "parsing output of pkg-config --modversion failed"+ Just v -> return (PackageIdentifier pkgname v)+ | Dependency pkgname _ <- concatMap pkgconfigDepends (allBuildInfo pkg) ]+ where+ pkgconfig = rawSystemProgramStdoutConf verbosity+ pkgConfigProgram (withPrograms lbi)++------------------------------------------------------------------------------+-- Dependency calculation amongst .chs files.+------------------------------------------------------------------------------++-- Given all files of the package, find those that end in .chs and extract the+-- .chs files they depend upon. Then return the PackageDescription with these+-- files rearranged so that they are built in a sequence that files that are+-- needed by other files are built first.+fixDeps :: PackageDescription -> IO PackageDescription+fixDeps pd@PD.PackageDescription {+ PD.library = Just lib@PD.Library {+ PD.exposedModules = expMods,+ PD.libBuildInfo = bi@PD.BuildInfo {+ PD.hsSourceDirs = srcDirs,+ PD.otherModules = othMods+ }}} = do+ let findModule m = findFileWithExtension [".chs.pp",".chs"] srcDirs+ (joinPath (components m))+ mExpFiles <- mapM findModule expMods+ mOthFiles <- mapM findModule othMods++ -- tag all exposed files with True so we throw an error if we need to build+ -- an exposed module before an internal modules (we cannot express this)+ let modDeps = zipWith (ModDep True []) expMods mExpFiles+++ zipWith (ModDep False []) othMods mOthFiles+ modDeps <- mapM extractDeps modDeps+ let (expMods, othMods) = span mdExposed $ sortTopological modDeps+ badOther = map (fromMaybe "<no file>" . mdLocation) $+ filter (not . mdExposed) expMods+ unless (null badOther) $+ die ("internal chs modules "++intercalate "," badOther+++ " depend on exposed chs modules; cabal needs to build internal modules first")+ return pd { PD.library = Just lib {+ PD.exposedModules = map mdOriginal expMods,+ PD.libBuildInfo = bi { PD.otherModules = map mdOriginal othMods }+ }}++data ModDep = ModDep {+ mdExposed :: Bool,+ mdRequires :: [ModuleName],+ mdOriginal :: ModuleName,+ mdLocation :: Maybe FilePath+}++instance Show ModDep where+ show x = show (mdLocation x)++instance Eq ModDep where+ ModDep { mdOriginal = m1 } == ModDep { mdOriginal = m2 } = m1==m2+instance Ord ModDep where+ compare ModDep { mdOriginal = m1 } ModDep { mdOriginal = m2 } = compare m1 m2++-- Extract the dependencies of this file. This is intentionally rather naive as it+-- ignores CPP conditionals. We just require everything which means that the+-- existance of a .chs module may not depend on some CPP condition. +extractDeps :: ModDep -> IO ModDep+extractDeps md@ModDep { mdLocation = Nothing } = return md+extractDeps md@ModDep { mdLocation = Just f } = withFileContents f $ \con -> do+ let findImports acc (('{':'#':xs):xxs) = case (dropWhile ((==) ' ') xs) of+ ('i':'m':'p':'o':'r':'t':' ':ys) ->+ case simpleParse (takeWhile ((/=) '#') ys) of+ Just m -> findImports (m:acc) xxs + Nothing -> die ("cannot parse chs import in "++f++":\n"+++ "offending line is {#"++xs)+ -- no more imports after the first non-import hook+ _ -> return acc+ findImports acc (_:xxs) = findImports acc xxs+ findImports acc [] = return acc+ mods <- findImports [] (lines con)+ return md { mdRequires = mods }++-- Find a total order of the set of modules that are partially sorted by their+-- dependencies on each other. The function returns the sorted list of modules+-- together with a list of modules that are required but not supplied by this+-- in the input set of modules.+sortTopological :: [ModDep] -> [ModDep]+sortTopological ms = reverse $ fst $ foldl visit ([], S.empty) (map mdOriginal ms)+ where+ set = M.fromList (map (\m -> (mdOriginal m, m)) ms)+ visit (out,visited) m+ | m `S.member` visited = (out,visited)+ | otherwise = case m `M.lookup` set of+ Nothing -> (out, m `S.insert` visited)+ Just md -> (md:out', visited')+ where+ (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md)
+ Setup.hs view
@@ -0,0 +1,43 @@+-- Setup file for a Gtk2Hs module. Contains only adjustments specific to this module,+-- all Gtk2Hs-specific boilerplate is stored in Gtk2HsSetup.hs which should be kept+-- identical across all modules.+import Distribution.Simple ( defaultMainWithHooks, UserHooks(postConf),+ PackageIdentifier(..), PackageName(..) )+import Gtk2HsSetup ( gtk2hsUserHooks, getPkgConfigPackages )+import Distribution.Simple.Setup ( ConfigFlags(configVerbosity), fromFlag)+import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Text ( display )+import Distribution.Version ( Version(..) )+import Distribution.Verbosity+import Distribution.Simple.Utils+import System.FilePath++main = defaultMainWithHooks gtk2hsUserHooks {++ postConf = \args cf pd lbi -> do+ let verb = (fromFlag (configVerbosity cf))+ cPkgs <- getPkgConfigPackages verb lbi pd+ let [pangoVersion] = [ v | PackageIdentifier (PackageName "pango") v <- cPkgs ]+ writePangoVersionHeaderFile verb lbi pangoVersion+ postConf gtk2hsUserHooks args cf pd lbi+ }++------------------------------------------------------------------------------+-- Generate CPP defines for version of C libs.+------------------------------------------------------------------------------++writePangoVersionHeaderFile :: Verbosity -> LocalBuildInfo -> Version -> IO ()+writePangoVersionHeaderFile verbosity lbi (Version (major:minor:micro:_) []) = do+ createDirectoryIfMissingVerbose verbosity True targetDir+ rewriteFile targetFile $ unlines+ [ "#define PANGO_VERSION_MAJOR " ++ show major+ , "#define PANGO_VERSION_MINOR " ++ show minor+ , "#define PANGO_VERSION_MICRO " ++ show micro+ ]+ where+ targetDir = autogenModulesDir lbi+ targetFile = targetDir </> "hspangoversion.h"++writeVersionHeaderFile _ _ version =+ die $ "unexpected pango version number: " ++ display version
+ hspango.h view
@@ -0,0 +1,40 @@+/* Impedance matching file to include pango/pango.h and at the same time+ ensuring that the pango version macros are defined even for versions+ before 1.6.0. We basically define the version check macros if they+ haven't been defined yet. These macros use the values of the macros+ PANGO_VERSION_... that are defined by pango/pango.h after version 1.6+ and must be defined by the cabal file for earlier versions.+*/++#include<pango/pango.h>++#ifndef PANGO_VERSION_MINOR+#include "hspangoversion.h"+#endif++/* This is copied from pango/pango-utils.h */++/* Pango version checking */++/* Encode a Pango version as an integer */+#ifndef PANGO_VERSION_ENCODE+#define PANGO_VERSION_ENCODE(major, minor, micro) ( \+ ((major) * 10000) \+ + ((minor) * 100) \+ + ((micro) * 1))+#endif++/* Encoded version of Pango at compile-time */+#ifndef PANGO_VERSION+#define PANGO_VERSION PANGO_VERSION_ENCODE( \+ PANGO_VERSION_MAJOR, \+ PANGO_VERSION_MINOR, \+ PANGO_VERSION_MICRO)+#endif++/* Check that compile-time Pango is as new as required */+#ifndef PANGO_VERSION_CHECK+#define PANGO_VERSION_CHECK(major,minor,micro) \+ (PANGO_VERSION >= PANGO_VERSION_ENCODE(major,minor,micro))+#endif+
+ pango.cabal view
@@ -0,0 +1,76 @@+Name: pango+Version: 0.11.0+License: LGPL-2.1+License-file: COPYING+Copyright: (c) 2001-2010 The Gtk2Hs Team+Author: Axel Simon, Duncan Coutts+Maintainer: gtk2hs-users@sourceforge.net+Build-Type: Custom+Cabal-Version: >= 1.6+Stability: stable+homepage: http://www.haskell.org/gtk2hs/+bug-reports: http://hackage.haskell.org/trac/gtk2hs/+Synopsis: Binding to the Pango text rendering engine.+Description: This package provides a wrapper around the Pango C library that+ allows high-quality rendering of Unicode text. It can be used+ either with Cairo to output text in PDF, PS or other+ documents or with Gtk+ to display text on-screen.+Category: Graphics+Tested-With: GHC == 6.10.4+extra-source-files: template-hsc-gtk2hs.h+ hspango.h+ Gtk2HsSetup.hs++x-Types-File: Graphics/Rendering/Pango/Types.chs+x-Types-ModName: Graphics.Rendering.Pango.Types+x-Types-Forward: *System.Glib.GObject++Source-Repository head+ type: darcs+ location: http://code.haskell.org/gtk2hs/+ subdir: pango++Flag new-exception+ Description: Enable build with a base library that contains the new exception library.++Library+ build-depends: base >= 3 && < 5,+ process, directory, array, containers, pretty, haskell98,+ glib >= 0.11 && < 0.12,+ cairo >= 0.11 && < 0.12++ if flag(new-exception)+ build-depends: base >= 4+ cpp-options: -DHAVE_NEW_CONTROL_EXCEPTION+ else+ build-depends: base < 4++ build-tools: gtk2hsC2hs, gtk2hsTypeGen++ exposed-modules: Graphics.Rendering.Pango.Font+ Graphics.Rendering.Pango.Enums+ Graphics.Rendering.Pango.Context+ Graphics.Rendering.Pango.Layout+ Graphics.Rendering.Pango.Rendering+ Graphics.Rendering.Pango.Markup+ -- these four modules are only used in code that creates+ -- Pango data structures themselves+ Graphics.Rendering.Pango.Types+ Graphics.Rendering.Pango.BasicTypes+ Graphics.Rendering.Pango.Structs+ Graphics.Rendering.Pango.Attributes+ other-modules: Graphics.Rendering.Pango.GlyphStorage+ Graphics.Rendering.Pango.Description+ extensions: ForeignFunctionInterface+ x-c2hs-Header: hspango.h+ includes: hspango.h+ include-dirs: .+ -- Pango 1.26 has a mysterious bug that makes it go into an infinite+ -- loop. Don't allow the user to build against this version. (Omit the+ -- >= 1.0 constraint in this case since Cabal 1.6 can't parse it.)+ if os(darwin)+ pkgconfig-depends: pango < 1.26.0 || > 1.26.2+ else+ pkgconfig-depends: pango >= 1.0++
+ template-hsc-gtk2hs.h view
@@ -0,0 +1,17 @@+#ifndef _TEMPLATE_HSC_GTK2HS_H_+#define _TEMPLATE_HSC_GTK2HS_H_++#include <glib.h>++#define hsc_gtk2hs_type(t) \+ if ((t)(int)(t)1.4 == (t)1.4) \+ printf ("%s%" G_GSIZE_FORMAT, \+ (t)(-1) < (t)0 ? "Int" : "Word", \+ sizeof (t) * 8); \+ else \+ printf ("%s", \+ sizeof (t) > sizeof (double) ? "LDouble" : \+ sizeof (t) == sizeof (double) ? "Double" : \+ "Float");++#endif