pax_global_header00006660000000000000000000000064150237452050014515gustar00rootroot0000000000000052 comment=9f1c7c84e294231d5d268a26a0f73d8803bf1034 ocaml-graphics-9f1c7c8/000077500000000000000000000000001502374520500150345ustar00rootroot00000000000000ocaml-graphics-9f1c7c8/.github/000077500000000000000000000000001502374520500163745ustar00rootroot00000000000000ocaml-graphics-9f1c7c8/.github/dependabot.yml000066400000000000000000000001601502374520500212210ustar00rootroot00000000000000version: 2 updates: - package-ecosystem: github-actions directory: / schedule: interval: weekly ocaml-graphics-9f1c7c8/.github/workflows/000077500000000000000000000000001502374520500204315ustar00rootroot00000000000000ocaml-graphics-9f1c7c8/.github/workflows/test.yml000066400000000000000000000011731502374520500221350ustar00rootroot00000000000000name: CI on: - push - pull_request jobs: build: strategy: fail-fast: false matrix: os: - ubuntu-latest - macos-latest - windows-latest ocaml-version: - 5 - 4 runs-on: ${{ matrix.os }} steps: - name: Checkout code uses: actions/checkout@v4 - name: Use OCaml ${{ matrix.ocaml-version }} uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-version }} - run: opam install . --deps-only - run: opam exec -- dune build @install - run: opam exec -- dune runtest ocaml-graphics-9f1c7c8/.gitignore000066400000000000000000000000401502374520500170160ustar00rootroot00000000000000_build _opam *.install *.merlin ocaml-graphics-9f1c7c8/.ocamlformat000066400000000000000000000001061502374520500173360ustar00rootroot00000000000000version=0.18.0 profile=conventional break-collection-expressions=wrap ocaml-graphics-9f1c7c8/CHANGES.md000066400000000000000000000016701502374520500164320ustar00rootroot000000000000005.2.0 (16/06/2025) ------------------ - Use modern X fonts instead of X core fonts (#38, @nchataing, Richard Jones) - Handle windows closing gracefully under X11 (#42, @xavierleroy) 5.1.2 (24/05/2021) ------------------ - Fix `PKG_CONFIG_PATH` for latest macOS xquartz (#36, @smorimoto) 5.1.1 (02/02/2021) ------------------ - Fix configurator detection on native Windows (#19, @fdopen) - Use `caml_alloc_custom_mem` when available (#23, @hhugo) - Fix windows dependencies (#20, @jeremiedimino) - Safe-string updates for native Windows (#28, fixes #27, @dra27) 5.1.0 (05/12/2019) ------------------ - Use pkg-config to query x11 compilation and linking flags + hardcode a few pkg-config paths for OSX (#17, fixes #16, @jeremiedimino) 5.0.0 (16/09/2019) ------------------ Initial release for OCaml >= 4.09.0. 2.0.0 (12/03/2019) ------------------ Initial release. It never made it to the opam repository as the version number was too low. ocaml-graphics-9f1c7c8/LICENSE000066400000000000000000000650531502374520500160520ustar00rootroot00000000000000In the following, "the OCaml Core System" refers to all files marked "Copyright INRIA" in this distribution. The OCaml Core System is distributed under the terms of the GNU Lesser General Public License (LGPL) version 2.1 (included below). As a special exception to the GNU Lesser General Public License, you may link, statically or dynamically, a "work that uses the OCaml Core System" with a publicly distributed version of the OCaml Core System to produce an executable file containing portions of the OCaml Core System, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Lesser General Public License. By "a publicly distributed version of the OCaml Core System", we mean either the unmodified OCaml Core System as distributed by INRIA, or a modified version of the OCaml Core System that is distributed under the conditions defined in clause 2 of the GNU Lesser General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Lesser General Public License. ---------------------------------------------------------------------- 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. 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 an 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! -------------------------------------------------- ocaml-graphics-9f1c7c8/Makefile000066400000000000000000000004031502374520500164710ustar00rootroot00000000000000INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) default: dune build install: dune install $(INSTALL_ARGS) uninstall: dune uninstall $(INSTALL_ARGS) reinstall: uninstall install clean: dune clean .PHONY: default install uninstall reinstall clean ocaml-graphics-9f1c7c8/README.md000066400000000000000000000035661502374520500163250ustar00rootroot00000000000000Graphics ======== The graphics library provides a set of portable drawing primitives. Drawing takes place in a separate window that is created when Graphics.open_graph is called. It used to be distributed with OCaml up to OCaml 4.08. ![Screenshot](libgraph.png) Documentation ------------- The API is documented [here](https://ocaml.org/p/graphics/latest/doc/Graphics/index.html) and as comments in the source file `src/graphics.mli`. On Linux, macOS, and other Unix systems --------------------------------------- The Graphics library uses the X11 windows system. macOS users need to install [XQuartz](https://www.xquartz.org/). Here are the graphics mode specifications supported by `Graphics.open_graph` on the X11 implementation of this library: the argument to `Graphics.open_graph` has the format `"display-name geometry"`, where display-name is the name of the X-windows display to connect to, and geometry is a standard X-windows geometry specification. The two components are separated by a space. Either can be omitted, or both. Examples: - `Graphics.open_graph "foo:0"`: connects to the display foo:0 and creates a window with the default geometry - `Graphics.open_graph "foo:0 300x100+50-0"` connects to the display foo:0 and creates a window 300 pixels wide by 100 pixels tall, at location (50,0) - `Graphics.open_graph " 300x100+50-0"` connects to the default display and creates a window 300 pixels wide by 100 pixels tall, at location (50,0) - `Graphics.open_graph ""` connects to the default display and creates a window with the default geometry. On Windows ---------- On Windows, the Graphics library uses the native Win32 API. Examples -------- The `examples/` directory contains a few examples. You can run them with: - `dune exec examples/sorts.exe` - `dune exec examples/graph_example.exe` - `dune exec examples/graph_test.exe` - `dune exec examples/fonts.exe` ocaml-graphics-9f1c7c8/dune-project000066400000000000000000000015131502374520500173560ustar00rootroot00000000000000(lang dune 2.7) (name graphics) (generate_opam_files true) (license "LGPL-2.1-only with OCaml-LGPL-linking-exception") (maintainers david.allsopp@metastack.com) (authors "Xavier Leroy" "Jun Furuse" "J-M Geffroy" "Jacob Navia" "Pierre Weis") (source (github ocaml/graphics)) (documentation https://ocaml.github.io/graphics/) (package (name graphics) (depends "dune-configurator" ("conf-libX11" (<> :os win32)) ("conf-libXft" (<> :os win32)) ("conf-pkg-config" (<> :os win32)) ("ocaml" (>= "4.09.0~~"))) (synopsis "The OCaml graphics library") (description "\ The graphics library provides a set of portable drawing primitives. Drawing takes place in a separate window that is created when Graphics.open_graph is called. This library used to be distributed with OCaml up to OCaml 4.08. ")) ocaml-graphics-9f1c7c8/dune-workspace.dev000066400000000000000000000004151502374520500204630ustar00rootroot00000000000000(lang dune 1.0) ;; Run the following command to test against all supported versions of ;; OCaml: ;; ;; $ dune build --workspace dune-workspace.dev (context (opam (switch 4.06.1))) (context (opam (switch 4.07.0))) (context (opam (switch ocaml-variants.4.08.0+beta2))) ocaml-graphics-9f1c7c8/examples/000077500000000000000000000000001502374520500166525ustar00rootroot00000000000000ocaml-graphics-9f1c7c8/examples/dune000066400000000000000000000001311502374520500175230ustar00rootroot00000000000000(executables (names font graph_example graph_test sorts) (libraries graphics threads)) ocaml-graphics-9f1c7c8/examples/font.ml000066400000000000000000000007051502374520500201540ustar00rootroot00000000000000 open Graphics let () = open_graph ""; set_font "monospace"; moveto 10 200; draw_string "Hello, graphics"; set_font "monospace:italic"; moveto 250 200; draw_string "(italics)"; set_font "monospace:bold"; moveto 400 200; draw_string "(bold)"; set_font "monospace-20"; moveto 10 130; draw_string "20 point type"; set_font "monospace-40"; moveto 10 10; draw_string "40 point type"; ignore (wait_next_event [Key_pressed]) ocaml-graphics-9f1c7c8/examples/graph_example.ml000066400000000000000000000170321502374520500220230ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml *) (* *) (* Damien Doligez, projet Para, INRIA Rocquencourt *) (* *) (* Copyright 1999 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* To run this example: ******************** 1. Select all the text in this window. 2. Drag it to the toplevel window. 3. Watch the colors. 4. Drag the mouse over the graphics window and click here and there. 5. Type any key to the graphics window to stop the program. *) open Graphics ;; open_graph " 480x270" let xr = (size_x () / 2) - 30 and yr = (size_y () / 2) - 26 and xg = (size_x () / 2) + 30 and yg = (size_y () / 2) - 26 and xb = size_x () / 2 and yb = (size_y () / 2) + 26 let point x y = let dr = ((x - xr) * (x - xr)) + ((y - yr) * (y - yr)) and dg = ((x - xg) * (x - xg)) + ((y - yg) * (y - yg)) and db = ((x - xb) * (x - xb)) + ((y - yb) * (y - yb)) in if dr > dg && dr > db then set_color (rgb 255 (255 * dg / dr) (255 * db / dr)) else if dg > db then set_color (rgb (255 * dr / dg) 255 (255 * db / dg)) else set_color (rgb (255 * dr / db) (255 * dg / db) 255); fill_rect x y 2 2 ;; for y = (size_y () - 1) / 2 downto 0 do for x = 0 to (size_x () - 1) / 2 do point (2 * x) (2 * y) done done let n = 0x000000 and w = 0xFFFFFF and b = 0xFFCC99 and y = 0xFFFF00 and o = 0xCC9966 and v = 0x00BB00 and g = 0x888888 and c = 0xDDDDDD and t = transp let caml = make_image [| [| t; t; t; t; t; t; t; t; t; t; t; n; n; n; n; n; n; t; t; t; t; t; t; t; t; t; t; t; t; t; t; t; |]; [| t; t; t; t; t; t; t; t; t; t; n; n; n; n; n; n; n; n; n; t; t; t; t; t; t; t; t; t; t; t; t; t; |]; [| t; t; t; t; t; t; t; t; n; n; n; n; n; n; n; n; n; n; n; n; t; t; t; t; t; t; t; t; t; t; t; t; |]; [| n; n; n; n; n; n; t; n; n; n; n; n; b; b; b; b; b; b; b; n; n; t; t; t; t; t; n; n; n; n; n; t; |]; [| n; o; o; o; o; o; n; n; n; n; b; b; b; b; b; b; b; b; b; b; b; n; n; n; n; n; n; n; n; n; n; t; |]; [| n; o; o; o; o; o; o; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; t; |]; [| n; o; o; o; o; o; o; o; n; n; n; g; g; g; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; t; t; |]; [| n; n; o; o; o; o; o; o; o; n; n; n; c; c; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; t; t; |]; [| t; n; n; o; o; o; o; o; o; o; n; n; n; c; n; n; n; n; n; n; n; b; b; n; n; n; n; n; n; t; t; t; |]; [| t; t; n; n; n; o; o; o; o; o; o; n; n; n; n; n; n; n; n; n; b; b; b; b; n; n; n; n; t; t; t; t; |]; [| t; t; t; t; n; n; o; o; o; o; o; o; n; n; n; n; n; n; n; n; b; b; b; b; b; b; n; n; t; t; t; t; |]; [| t; t; t; t; t; n; n; o; o; o; o; o; o; n; n; n; n; n; n; o; o; b; b; b; b; b; b; n; n; t; t; t; |]; [| t; t; t; t; t; n; n; o; o; o; o; o; o; b; b; b; b; b; n; n; o; o; b; b; b; b; b; b; n; n; t; t; |]; [| t; t; t; t; n; n; n; o; o; o; o; o; b; b; b; b; b; b; b; n; n; o; o; b; b; b; b; b; b; n; n; t; |]; [| t; t; t; t; n; n; n; o; o; o; o; b; b; b; b; b; b; b; b; b; n; n; o; o; b; b; b; b; b; b; n; n; |]; [| t; t; t; t; n; n; n; o; o; o; o; b; b; b; b; b; n; n; b; b; b; n; n; o; o; b; b; b; b; b; n; n; |]; [| t; t; t; t; n; n; n; o; o; o; o; b; b; b; b; b; n; n; b; b; b; b; n; n; o; o; b; o; b; b; n; n; |]; [| t; t; t; t; n; n; n; o; o; o; o; b; b; b; b; b; n; n; b; b; b; b; b; n; n; o; o; o; o; o; n; n; |]; [| t; t; t; t; n; n; n; o; o; o; o; b; b; b; b; b; n; n; b; b; b; b; b; b; n; n; o; o; o; o; n; n; |]; [| t; t; t; t; n; n; n; o; o; o; o; o; b; b; b; b; n; n; b; b; b; b; b; b; b; n; n; o; o; n; n; n; |]; [| t; t; t; t; n; n; n; n; o; o; o; o; o; b; b; b; n; n; n; b; b; b; b; b; b; b; n; n; o; n; b; n; |]; [| t; t; t; t; t; n; n; n; o; o; o; o; o; o; b; b; n; n; n; b; b; b; b; b; b; b; b; n; n; n; b; n; |]; [| t; t; t; t; t; t; n; n; o; o; o; o; o; o; o; y; v; y; n; b; b; b; b; b; b; b; b; n; n; b; b; n; |]; [| t; t; t; t; t; t; t; n; o; o; o; o; o; v; y; o; o; n; n; n; b; b; b; b; b; b; b; n; n; b; b; n; |]; [| t; t; t; t; t; t; t; n; o; o; o; y; v; o; o; o; o; n; n; n; n; b; b; b; b; b; b; n; n; b; b; n; |]; [| t; t; t; t; t; t; n; n; o; v; y; o; y; o; o; o; o; o; o; n; n; n; b; b; b; b; b; n; n; b; b; n; |]; [| t; t; t; t; t; t; n; o; y; y; o; o; v; o; o; o; o; o; o; o; n; n; n; b; b; b; n; n; n; b; n; t; |]; [| t; t; t; t; t; n; n; v; o; v; o; o; o; o; o; o; o; o; o; o; o; n; n; n; b; n; n; n; n; b; n; t; |]; [| t; t; t; t; t; n; v; o; o; v; o; o; o; o; o; o; o; o; o; o; o; o; n; n; n; n; n; n; n; n; t; t; |]; [| t; t; t; t; n; n; o; o; o; o; o; o; o; o; o; o; o; o; o; o; o; n; n; n; n; n; n; t; t; t; t; t; |]; [| t; t; t; t; n; o; o; o; o; o; o; o; o; o; o; o; o; o; o; o; n; n; t; t; t; t; t; t; t; t; t; t; |]; [| t; t; t; t; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; n; t; t; t; t; t; t; t; t; t; t; t; |]; |] (* let x = ref 0 and y = ref 0;; let bg = get_image !x !y 32 32;; while true do let st = wait_next_event [Mouse_motion; Button_down] in if not st.button then draw_image bg !x !y; x := st.mouse_x; y := st.mouse_y; blit_image bg !x !y; draw_image caml !x !y; done;; *) ;; set_color (rgb 0 0 0); remember_mode false; try while true do let st = wait_next_event [ Mouse_motion; Button_down; Key_pressed ] in synchronize (); if st.keypressed then raise Exit; if st.button then ( remember_mode true; draw_image caml st.mouse_x st.mouse_y; remember_mode false); let x = st.mouse_x + 16 and y = st.mouse_y + 16 in moveto 0 y; lineto (x - 25) y; moveto 10000 y; lineto (x + 25) y; moveto x 0; lineto x (y - 25); moveto x 10000; lineto x (y + 25); draw_image caml st.mouse_x st.mouse_y done with Exit -> () (* To run this example: ******************** 1. Select all the text in this window. 2. Drag it to the toplevel window. 3. Watch the colors. 4. Drag the mouse over the graphics window and click here and there. 5. Type any key to the graphics window to stop the program. *) ocaml-graphics-9f1c7c8/examples/graph_test.ml000066400000000000000000000156671502374520500213630ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml *) (* *) (* Pierre Weis, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2000 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* graph_test.ml : tests various drawing and filling primitives of the Graphics library. *) (* To run this example just load this file into a suitable toplevel. Alternatively execute ocamlc graphics.cma graph_test.ml *) open Graphics ;; auto_synchronize false ;; display_mode false ;; remember_mode true let sz = 450 ;; open_graph (Printf.sprintf " %ix%i" sz sz) (* To be defined for older versions of OCaml Lineto, moveto and draw_rect. let rlineto x y = let xc, yc = current_point () in lineto (x + xc) (y + yc);; let rmoveto x y = let xc, yc = current_point () in moveto (x + xc) (y + yc);; let draw_rect x y w h = let x0, y0 = current_point () in moveto x y; rlineto w 0; rlineto 0 h; rlineto (- w) 0; rlineto 0 (-h); moveto x0 y0;; *) (* A set of points. *) ;; set_color foreground let dashes y = for i = 1 to 100 do plot y (2 * i); plot y (3 * i); plot y (4 * i) done ;; dashes 3 ;; set_line_width 20 ;; dashes (sz - 20) (* Drawing chars *) ;; draw_char 'C'; draw_char 'a'; draw_char 'm'; draw_char 'l' (* More and more red enlarging squares *) ;; moveto 10 10 ;; set_line_width 5 let carre c = rlineto 0 c; rlineto c 0; rlineto 0 (-c); rlineto (-c) 0 ;; for i = 1 to 10 do moveto (10 * i) (10 * i); set_color (rgb (155 + (10 * i)) 0 0); carre (10 * i) done (* Blue squares in arithmetic progression *) ;; moveto 10 210 ;; set_color blue ;; set_line_width 1 ;; for i = 1 to 10 do carre (10 * i) done (* Tiny circles filled or not *) ;; rmoveto 0 120 (* Must not change the current point *) ;; fill_circle 20 190 10 ;; set_color green ;; rlineto 0 10 ;; rmoveto 50 10 ;; let x, y = current_point () in (* Must not change the current point *) draw_circle x y 20 ;; set_color black ;; rlineto 0 20 (* Cyan rectangles as a kind of graphical representation *) ;; set_color cyan let lw = 15 ;; set_line_width lw let go_caption l = moveto 210 (130 - lw + l) let go_legend () = go_caption (-3 * lw) ;; go_caption 0 ;; fill_rect 210 130 5 10 ;; fill_rect 220 130 10 20 ;; fill_rect 235 130 15 40 ;; fill_rect 255 130 20 80 ;; fill_rect 280 130 25 160 (* A green rectangle below the graph. *) ;; set_color green ;; rlineto 50 0 (* A black frame for each of our rectangles *) ;; set_color black ;; set_line_width (lw / 4) ;; draw_rect 210 130 5 10 ;; draw_rect 220 130 10 20 ;; draw_rect 235 130 15 40 ;; draw_rect 255 130 20 80 ;; draw_rect 280 130 25 160 (* A black rectangle after the green one, below the graph. *) ;; set_line_width lw ;; rlineto 50 0 (* Write a text in yellow on a blue background. *) (* x = 210, y = 70 *) ;; go_legend () ;; set_text_size 10 ;; set_color (rgb 150 100 250) ;; let x, y = current_point () in fill_rect x (y - 5) (8 * 20) 25 ;; set_color yellow ;; go_legend () ;; draw_string "Graphics (OCaml)" (* Pie parts in different colors. *) let draw_green_string s = set_color green; draw_string s let draw_red_string s = set_color red; draw_string s ;; moveto 120 210 ;; set_color red ;; fill_arc 150 260 25 25 60 300; draw_green_string "A "; draw_red_string "red"; draw_green_string " pie."; set_text_size 5; moveto 180 240; draw_red_string "A "; draw_green_string "green"; draw_red_string " slice." ;; set_color green; fill_arc 200 260 25 25 0 60; set_color black; set_line_width 2; draw_arc 200 260 27 27 0 60 (* Should do nothing since this is a line *) ;; set_color red ;; fill_poly [| (40, 10); (150, 70); (150, 10); (40, 10) |] ;; set_color blue (* Drawing polygones. *) (* Redefining the draw_poly primitive for the usual library. *) let draw_poly v = let l = Array.length v in if l > 0 then ( let x0, y0 = current_point () in let p0 = v.(0) in let x, y = p0 in moveto x y; for i = 1 to l - 1 do let x, y = v.(i) in lineto x y done; lineto x y; moveto x0 y0) ;; draw_poly [| (150, 10); (150, 70); (260, 10); (150, 10) |] (* Filling polygones. *) (* Two equilateral triangles, one red and one blue, and their inside filled in black. *) let equi x y l = [| (x - (l / 2), y); (x, y + int_of_float (float_of_int l *. (sqrt 3.0 /. 2.0))); (x + (l / 2), y); |] ;; set_color black ;; fill_poly (Array.append (equi 300 20 40) (equi 300 44 (-40))) ;; set_line_width 1 ;; set_color cyan ;; draw_poly (equi 300 20 40) ;; set_color red ;; draw_poly (equi 300 44 (-40)) (* Drawing and filling ellipses. *) ;; let x, y = current_point () in rlineto 10 10; moveto x y; moveto 395 100 ;; let x, y = current_point () in fill_ellipse x y 25 15 ;; set_color (rgb 0xFF 0x00 0xFF) ;; rmoveto 0 (-50) ;; let x, y = current_point () in fill_ellipse x y 15 30 ;; rmoveto (-45) 0 ;; let x, y = current_point () in draw_ellipse x y 25 10 (* Drawing and filling arcs. *) let draw_arc_ellipse x y r1 r2 = set_color green; draw_arc x y r1 r2 60 120; set_color black; draw_arc x y r1 r2 120 420 ;; set_line_width 3 let draw_arc_ellipses x y r1 r2 = let step = 5 in for i = 0 to (r1 - step) / (2 * step) do for j = 0 to (r2 - step) / (2 * step) do draw_arc_ellipse x y (3 * i * step) (3 * j * step) done done ;; draw_arc_ellipses 20 128 15 50 let fill_arc_ellipse x y r1 r2 c1 c2 = set_color c1; fill_arc x y r1 r2 60 120; set_color c2; fill_arc x y r1 r2 120 420 let fill_arc_ellipses x y r1 r2 = let step = 3 in let c1 = ref black and c2 = ref yellow in let exchange r1 r2 = let tmp = !r1 in r1 := !r2; r2 := tmp in for i = r1 / (2 * step) downto 10 do for j = r2 / (2 * step) downto 30 do exchange c1 c2; fill_arc_ellipse x y (3 * i) (3 * j) !c1 !c2 done done ;; fill_arc_ellipses 400 240 150 200 ;; synchronize () (* transparent color drawing *) ;; set_color transp ;; draw_circle 400 240 50 ;; draw_circle 400 240 40 ;; draw_circle 400 240 30 (* try to go back a normal color *) ;; set_color red ;; draw_circle 400 240 20 ;; synchronize () ;; ignore (wait_next_event [ Key_pressed ]) ocaml-graphics-9f1c7c8/examples/sorts.ml000066400000000000000000000234611502374520500203640ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* Animation of sorting algorithms. *) open Graphics (* Information on a given sorting process *) type graphic_context = { id: int; (* Identifier *) array : int array; (* Data to sort *) x0 : int; (* X coordinate, lower left corner *) y0 : int; (* Y coordinate, lower left corner *) width : int; (* Width in pixels *) height : int; (* Height in pixels *) nelts : int; (* Number of elements in the array *) maxval : int; (* Max val in the array + 1 *) rad : int (* Dimension of the rectangles *) } (* Array assignment and exchange with screen update *) let screen_mutex = Mutex.create () let draw gc i v = fill_rect (gc.x0 + (gc.width * i / gc.nelts)) (gc.y0 + (gc.height * v / gc.maxval)) gc.rad gc.rad let assign gc i v = Mutex.lock screen_mutex; set_color background; draw gc i gc.array.(i); set_color foreground; draw gc i v; gc.array.(i) <- v; Mutex.unlock screen_mutex let exchange gc i j = let val_i = gc.array.(i) in assign gc i gc.array.(j); assign gc j val_i (* Construction of a graphic context *) let initialize i name array maxval x y w h = let _, label_height = text_size name in let rad = ((w - 2) / Array.length array) - 1 in let gc = { id = i; array = Array.copy array; x0 = x + 1; (* Leave one pixel left for Y axis *) y0 = y + 1; (* Leave one pixel below for X axis *) width = w - 2; (* 1 pixel left, 1 pixel right *) height = h - 1 - label_height - rad; nelts = Array.length array; maxval; rad; } in moveto (gc.x0 - 1) (gc.y0 + gc.height); lineto (gc.x0 - 1) (gc.y0 - 1); lineto (gc.x0 + gc.width) (gc.y0 - 1); moveto (gc.x0 - 1) (gc.y0 + gc.height); draw_string name; for i = 0 to Array.length array - 1 do draw gc i array.(i) done; gc (* Synchronization barrier *) type barrier = { lock: Mutex.t; mutable participants: int; (* number of participating threads *) mutable flag: bool; (* true = can go ahead, false = should wait *) mutable arrive: int; (* number of threads that arrived *) mutable leave: int; (* number of threads that left *) restart: Condition.t; (* signaled when status becomes false again *) all_arrived: Condition.t; (* signaled when arrive = participants *) all_left: Condition.t (* signaled when leave = participants *) } let b = { lock = Mutex.create(); participants = 0; flag = true; arrive = 0; leave = 0; restart = Condition.create(); all_arrived = Condition.create(); all_left = Condition.create() } let barrier_init num_participants = Mutex.lock b.lock; b.participants <- num_participants; b.leave <- num_participants; Mutex.unlock b.lock let barrier_enter () = Mutex.lock b.lock; if b.arrive = 0 then begin (* Wait for all to leave before clearing flag *) while b.leave < b.participants do Condition.wait b.all_left b.lock done; (* First arriver clears flag *) b.flag <- false end; b.arrive <- b.arrive + 1; if b.arrive = b.participants then begin (* Last arriver signals the manager, who will set the flag *) Condition.signal b.all_arrived end; (* Wait for flag *) while not b.flag do Condition.wait b.restart b.lock done; b.leave <- b.leave + 1; if b.leave = b.participants then Condition.broadcast b.all_left; Mutex.unlock b.lock let barrier_terminate () = Mutex.lock b.lock; b.participants <- b.participants - 1; if b.arrive = b.participants then Condition.signal b.all_arrived; Mutex.unlock b.lock let barrier_wait_all () = Mutex.lock b.lock; while b.arrive <> b.participants do Condition.wait b.all_arrived b.lock done (* keep the lock *) let barrier_restart_all () = (* lock must be held *) b.arrive <- 0; b.leave <- 0; b.flag <- true; Condition.broadcast b.restart; Mutex.unlock b.lock (* To stop all threads cleanly *) let terminated = ref false exception Terminated (* Main animation function *) let delta_t = 0.02 let display functs nelts maxval = let a = Array.make nelts 0 in for i = 0 to nelts - 1 do a.(i) <- Random.int maxval done; barrier_init (Array.length functs); terminated := false; let th = Array.mapi (fun i (name, funct, x, y, w, h) -> let gc = initialize i name a maxval x y w h in Thread.create (fun () -> try funct gc; barrier_terminate() with Terminated -> ()) ()) functs in let delay = ref (3.0 *. delta_t) in while not !terminated do barrier_wait_all(); if b.participants = 0 then begin ignore (read_key()); terminated := true end; Unix.sleepf !delay; if key_pressed() then begin match read_key() with | 'q'|'Q' -> terminated := true | '0'..'9' as c -> delay := float (Char.code c - 48) *. delta_t | _ -> () end; barrier_restart_all() done; Array.iter Thread.join th (* Comparison functions that synchronize *) let sync () = if !terminated then raise Terminated else barrier_enter () let (?) x y = sync(); x > y let (<=?) x y = sync(); x <= y let (>=?) x y = sync(); x >= y (* The sorting functions. *) (* Bubble sort *) let bubble_sort gc = let ordered = ref false in while not !ordered do ordered := true; for i = 0 to Array.length gc.array - 2 do if gc.array.(i + 1) = 0 && val_i lo && gc.array.(!j) >=? pivot do decr j done; if !i < !j then exchange gc !i !j done; exchange gc !i hi; quick lo (!i - 1); quick (!i + 1) hi) in quick 0 (Array.length gc.array - 1) (* Heap sort *) let rec heapify gc n i = let l = 2 * i + 1 and r = 2 * i + 2 in (* Find largest among root, left child, right child *) let largest = ref i in if l < n && gc.array.(l) >? gc.array.(!largest) then largest := l; if r < n && gc.array.(r) >? gc.array.(!largest) then largest := r; if !largest <> i then begin (* Swap and continue heapify-ing *) exchange gc i !largest; heapify gc n !largest end let heap_sort gc = let n = Array.length gc.array in (* Build max heap *) for i = n / 2 - 1 downto 0 do heapify gc n i done; (* Repeatedly extract max element and restore heap structure *) for i = n - 1 downto 1 do exchange gc 0 i; heapify gc i 0 done (* Merge sort *) let merge_sort gc = let rec merge i l1 l2 = match (l1, l2) with | [], [] -> () | [], v2 :: r2 -> assign gc i v2; merge (i + 1) l1 r2 | v1 :: r1, [] -> assign gc i v1; merge (i + 1) r1 l2 | v1 :: r1, v2 :: r2 -> if v1 = "2.7"} "dune-configurator" "conf-libX11" {os != "win32"} "conf-libXft" {os != "win32"} "conf-pkg-config" {os != "win32"} "ocaml" {>= "4.09.0~~"} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/ocaml/graphics.git" x-maintenance-intent: ["(latest)"] ocaml-graphics-9f1c7c8/graphics.opam.template000066400000000000000000000000431502374520500213210ustar00rootroot00000000000000x-maintenance-intent: ["(latest)"] ocaml-graphics-9f1c7c8/libgraph.png000066400000000000000000000442631502374520500173430ustar00rootroot00000000000000‰PNG  IHDR!h¨+¾ ÒzTXtRaw profile type exifxÚ­™ir#»„ÿã>B ëq°Fø>¾¿B“µ=Í8,Ùl¥–Ì,Ž[ÿù÷vÿâOc¸\ˆ¹¤šÒÅ_¨¡úÆ—rÝõ|ÊÎçùórùGë‡v—Êã«çª\õîÈí¾J£=¾?ð\CúÇvW=¾<&zt<'T[Ùö0_7I»¿Û%<&ªëþ’jɯ[í÷®ñx¶òx‹J>»zÌj÷îµ!d¬4# ©÷KE¯óYîèýn¼•OÑhã¸6êÝizîƒ|8Þóz]¯ú`äç7÷Ùúíi„OÆ÷í1B?Ù2=lÄ—o;$~oücâ—…õmGþcÆ_Žóxï=ËÞë>] ‹¦GD]îi{†“ëy,ñʼ#ßóyU^åj×Àå“å:¯!U<^ÙN‚Li²eëÁƒ_>sõ~àk+š}õá{ÉöY«N-xnøåpePÿ¶9ëÖ³ÞÂÊSê…É„G~|¹êü›—ÛÛl+bÆÄõr;Øû“ŸfFµOFáÙ¿Åcàçëáþë%°U<™ lW¿§èQÞcKŸ•q‘ëBâò|L€‰X;²R'È•ÈIreï³v,8¨±s¯Áw< 1úÉ&}PMÞe_¼­Í3YÎX}òÖ 6ረI3¾©ÚpV‘øÉ¡C-‚h1Æs,.ÖØ’¦bJ)'¹–5‡sÊ9—\s+ZB‰%•\J©¥U_ Œ5Õ\K­µ5ï 5æjŒo´tßµ‡{ê¹—^{„Ï#Ž4ò(£Ž6ýÔ LÌ4ó,³Î¶Ä-b…WZy•UWÛÄÚÖvÜiç]vÝíÍk¯~yý…×äá5Ãc>ÏæڛϮ"!xóœù쪞¤ˆžMFó›bÃ…a‰[Þ|÷î¹?ò›‹åüæóœ3×ý?<çpÝW¿}ãµi<7ŽÇî,4›^Jö1¦ùâx“­¾|º¶rÙ^´uéq䵊ߵö-³·4÷X­ ¶›yT1cq+ãŽI«*ÙrÍÔuL»2g`³6߯½À½Z ¼îGš2–\k_]´]ä°ýV)km&¼:zªÂxß[‡'}Ä4WѵÃe‰¢±ëç«û©ão¯Ÿ'’k =•–êI½„®v’N´¯ë^Ògôa&hÇrpMeEÇ!Ö&¢ˆÕ #NÇx.ím’AgË{fµE,:p‡)Ž/W÷SÇß][w£æº„¬Äà*d“úE¸Œ‚çcisIëÄ»ßËï´ÉÐIjsÓ ãêYV@û¤F¼ R‘X©Ìd3Š‘RÝÃ×)‹ø'm…Ša¥®D•xíÅõQÖJ©ƒssz¿=àË×Ê>·dåžH¢.Su÷k™iG“ʾCÉ~„nèr«ž-Ë%ŒÚáõ·–Ù{IYWÅ’…Å9ðž«XYþ\}/Ý%º¨Þ]K²FGÄw}{,îœH¥¤ƒ8@/dY5ìÒÙ8&ò B.±jïírdƒ lóÛ€„5O·h!?„€⧶[˜pRõájcÍ*Dµ˜j‰æö¨{Ы >¶˜µrËîê‡õ‘ƒÆg³ÖtRYº¬f|ùqÜ=êË ¯Ó¹ÇÈïzû–‰Áuì ðÃ)Q"ÁgSœÝëZ  ûÔ€ur0Sa°Éð±{³ù^î˜÷Å:y4Û£%haUµ{Ts'Û²SÐRó} Nð»Ï`F±–ZÄÁÕ2 „°*,éúB{X);H~<¯c$bjƒ:l) –L¼éÈÍQŒ‘Ÿt[ xŒ¬±­FANžl˜e óé²ÐTèd®6RŸØ”Ÿ _©ÎÃwqhC©šsbW"Î(É> ÐX€×±AåkBø«][Cöì3Ã$¡uÅTÑEWÖMŠ°E‹1è5g™Ý×ÏÔ5ÄÖc§|§„S#ª9ÚÊó ƒRD*¹]e6ã:l3þ#úˆœåaªIR´†eÒZ6IÕYª.ÔV]°!ª%ó±i©hã¡b%*u¦Öäû0Âë'b@ÌG(¹ïºþ*œ ù; #´° ÀÒË0JHhzl`^;~« _ÐåŠ.'®,4"¹âmc ËàHƯ-çƒêqcë›.µƒçؘ×°ë0Ü>nr&*·¶ûöqSO,‹œs^î óÛ û¾Å+Î"=ä•ÈŠ±½’prnŒÏ-ÐdI0X´p/2»œÛÇMÝ$T&L»x#7Z¾ãæwê~ƒÐ?EP÷„þ)‚ºß 4!FWãMg2fDR—(úl÷¿Øã;s¸ÿÅß]Ýwö/˵ÐØwù¡-†R‘? 1!zòµ¼L]¦9A­x‡B¹‹Q}ɬ4_šSL§E;Œƒ<"ÉFØ æ°Hwõm&³“Q­¾ô÷—Ç¡ƒ"®©qؾZº¬‚¼ö#{ŸðL™\†À/št¬ïÛÝï‹–¤G Ü/ý?vÿÈý¤Êû)¬n‡ :Ùë¶J»l¯A%u}=q¡ì\«cWì’a›u¡Àì7ÃbÔæIJ­c?Óy {‡$ ›)Ð¥¥>Wì#k®ÔB°† ;ÔpRs ?&v¥H(ÔF*ôLš^Jô³æX)þ[à'rØ]ë4ö}ÔDZù^s.T÷£ Áó¢ê` ’ «[Q¯BÝ?£Õ¦[ªwKöŠ¡¾ÊùÓÓ2vi_z ½­H8²žï5Æ~6ÔžåÃ{|Z”ç܇|™³9!ûUÆ~ŸÅØC)— # y5ô+"#q Ž¥)$šù`è3Ú¾4ØOí˜ ZÍ]¯t!!¨!ÑÚVÆ‹2Á^âÄùð|·_B åƒ&@Roº‡id¦ôw’w@xÑR>Æ÷>÷Þ©g†›)æÔýi¸>Kš·É_[š›H´AÅd£–GI…m?$‰²bA_ˆ‘BžŠ¶˜Å–YÒ˜ÓŠ®ŒÉIAg§É?*rÛÄRhil¡F¥¨ FjO a¢Q¼éâí0 ÐEq¸ÈmAŸUâ¨Àh”W3¢APjÒ`jIT/Ä> ìGÚ]±!ü²ŒÒGa‡Óû)W—y ö2´6T(^Ò8g‹5ðä&"c-×®L€3 (Å’&ÕØik¦p‘ÑÒT©>Ûï9ƒÂ?î´ê ž-ܽ‡ÕHÖ“JD¦Í^rN–Ú[c ”øÅ;ä¬VÉÚ5÷²AHÝé³â©PúPË`«ÚV¸–-#ž ù4Qµ¹œx=P6ÔP31iÿñA †˜‹²(uYP¤!ÉÈöÛL¢h{Ër÷7ÿŸ®ßN”:)àÛšU$bO)Ô†z}VÀÒ¤ªŒÐBx‡m}S4oËæÿKe-ÒÕÃ0ƒiCCPICC profilexœ}‘=HÃ@Å_SE‘J3ˆ8d¨NÄqÔ*¡B¨Zu0¹~B“†$ÅÅQp-8ø±XupqÖÕÁU?@œ]¤Äÿ%…1÷ãݽÇÝ;@hV™fõLšn›édBÊæV¥¾W†ˆâ ³Œ9YNÁw|Ý#À×»(Ïò?÷çÌ,$âYf˜6ññô¦mpÞ'YYÉŸO˜tAâG®«¿q.¹,ðLÑ̤ç‰Eb©ÔÅj³²©lj#yM§|!ëqžóg­Zgí{ò† úÊ2×iŽ"‰E,A†uTP…(­:)Ò´Ÿðñ¸~™\*¹*`äX@ ×þ¿»µŠ±)/)”z_çc èÛZ Çù>vœÖ |®ôŽ¿Öf>Iot´ÈÞ.®;šº\îÃO†b*®¤)‹Àû}SºÖ¼ÞÚû8}2ÔUê88ÆK”½îóîþîÞþ=ÓîïÊ rÊŸdîhbKGDÿÿÿ ½§“ pHYs\L\LOàˆ­tIMEä4nx|x IDATxÚíÝy\õâÿñ÷9€l"‚‚Š "‚¦‰‰R(¹§V¦–~-L ­¼j¥×[™-¶Ûf·¬¬¼Zf¿[¹dešf.™æ‚KX "n¨ˆˆìû2¿?Ôs=rXÄ%Å×óñ83ŸùÌÌçŒÌ›Ï|fŽÉ0 CW™™&„@ „B!B!€@„@ „B!B!€‚Ð4mÚ4¥¥¥ÑB®žôôt=ùä“ÊÏϧ1Åd†A3àRBȱcÇÔ¬Y39::Ò BHuSRR"“É$“ÉTæ|³¹r[yyy*((ƒƒƒœœœJÕYRR"I6ë3 C†aXæ]ø³­õØÙÙÉÑÑQööö| .Ç\ŠŠŠô¯ýK_ýµÍùË—/×!C”™™Yn=›6mÒرc wwwÕ«WOO=õ”L!äzboo¯Î;ë駟Vvvv©€òÉ'Ÿ(44TnnnåÖsüøq úHûöíÓC=dé=),,ÔÂ… U\\l)7eÊíܹSß~û­Ž;¦„„½öÚkrvvæÃXp9æ:qêÔ)yyyiÕªUºãŽ;,ÓwíÚ¥›o¾Y»wïVË–-/ºÞììluéÒES¦LÑ]wÝe™ž››«üãrssÓ| U«Véž{îQLLŒÚ´ic)·}ûvµoß^'NœP½zõ”­   }ñÅêÚµ+ ì?²i‚ëCݺuõöÛokþüùêÑ£‡e ÆâÅ‹5hÐ Tªžââb¥¤¤(##CÅÅÅ2›Íò÷÷׬Ê9;;ë7ÞPXX˜êׯ¯ÿûßš?¾U±¥FjÚ´©V¬X¡V­Z©N:•«¸±pv¸ŽÜ}÷Ýš={¶:$éLïÈ /¼ G}Tvvv.¿sçN 2DõêÕS÷îÝ5bÄ=òÈ#Z·n222J•oÒ¤‰fÍš¥—_~Y4hP…ëpppÐÔ©Sõý÷ßËÛÛ[#FŒÐ矮ØØX>@!äzÕªU+ 0@Ë—/—$EFFªQ£Fêرc…˦¦¦ê®»îRXX˜RRRtäÈEFFê÷ß×½÷Þ+[Wå ´téRIgµ¦¦¦Vj;Û·o¯¨¨(mÛ¶M½zõÒ/¿ü¢Ö­[kæÌ™|ˆBÈõÈÎÎN=ö˜Þÿ}¥¥¥é³Ï>Ó“O>)ww÷ —Ý¿¿.OOOËôÂÂBíÞ½Ûæ2 ,Ð/¿ü¢]»vÉßß_o¾ù¦ŠŠŠ*µ­5kÖT‡4|øp-\¸P³gÏÖ˜1c¬À!¸ŽÜzë­’¤©S§ê§Ÿ~²LZžsw³\xwÍÖ­[µ~ýúRå·oß®‡zH3gÎT«V­ôöÛoköìÙZ°`A¹ë)))±‘›››† f5ÏÎÎNãÇWbb¢.\ÈQ¸!Ù_î SSSuàÀegg«V­ZjÚ´©Š‹‹U·n]«ôñãÇUPP IÊËËSII‰ÌæÒ™èøñãÊÏÏ·¹.wwwyxxØ\NNŽêÔ©£æÍ›ËÑѱJûrúôieddÈd2ÉËËK...’¤äädegg—š~¾]»vé³Ï>ÓôéÓU¯^½RóÛ·o¯#FhÒ¤I /µTw—µ'dõêÕjÙ²¥BBBÔ­[7Ë××W·Ýv›rrr,åöîÝ«† ÊÏÏO~~~:t¨ŠŠŠlÖ9mÚ4K¹ _›6m²”+..ÖÂ… -ëïÚµ«n¾ùfõëׯÔåÊ(((P:uäç秦M›jÊ”)–ãïïo™þïÿÛæò¿ýö›$éŽ;î°9ßd2iÈ!ÊÌÌÔüÁ‘ „TUzzºzõê¥***JûöíÓ† Ô¯_?ÅÇÇ[…Œ¦M›jíÚµZ±b…"""Ê­×d2)88XË—/׊+,a U«Vjݺµ¥Ü‚ tÿý÷+<<ܲþÕ«W+''G÷Üs/jjÔ¨a }ûöÕ¨Q£,½/ß}÷$éÁÔðáÃK-[\\llÛ¼yó2×(IÚ²e G"à†sÙ.ǘL&IRvv¶N:%GGGµlÙRÓ¦MÓ˜1cäææf)ëè訮]»J’¶mÛ¦ýû÷—Yo·nÝÔ¢E Ýy犋‹Ó¸qã¬ï¾ûNM›6•$eeeiÒ¤I0`€&Nœ¨5jH’Ú´i£ÿûßêÝ»·¾ûî;M˜0á¢ö©[·nzë­·ôæ›oÊÁÁáLj3›•••%I?~¼üüüJ-WXX¨Å‹køðá²·/»‰ëÔ©#IÚ¾}{¹ÛqìØ1ÅÅÅUés9tèRSSõÛo¿É0 Žx7µk׎†¸Ö—Ñš5kŒ   C’å5`ÀcóæÍe.3eÊ#,,ÌÈÏÏ/·îØØX£Y³fFhh¨o5ïСCVë´õêÑ£G•öéðáÆ›››ñÎ;ï†aéééFPP1lØ0£¨¨Èæ2YYY†$ã±Ç+·îœœC’Ñ«W¯rËmØ°¡ÂýãÅ‹/^ÿ{M™2ÅÀµï²õ„äççËÏÏOüñ‡uòäI%&&jÑ¢E ÕÔ¬Y³*Õ«~ýúÉÛÛ[óçÏ—¯¯¯òóóeoo/;;;999I:sy¤_¿~6ë°5èµ2š4i¢É“'kÒ¤Iºÿþû¥˜˜}ñŲ³³³¹Œƒƒƒš5k¦ƒ–[wnn®$©qãÆå–kß¾}•nå5›Íš°Œ)ùî»ïÊì9÷Ÿ¥gÏžš1c†¢££Õ¹sg›å¢¢¢$I·ÝvG"€RU;vÔ’%K”““£mÛ¶)))I-Z´ÐðáÃÕ»woËs0jÔ¨qæÁ‰6ëquu•§§§åç>ú¨ÌK)¾¾¾–÷7ÖO?ý¤+VhË–-JIIQ“&MôᇪU«Vjß¾ý%íßÝwß­ &h̘1jÛ¶m…å»té"Iš7ožÂÂÂJíCvv¶ÞyçõéÓÇê.!©^½z–ñ<ð€ ðÙ}f2™Ô»wïJ×;bĈJ—õððPxx¸ÂÃÃË\UEFFJ’þñTj|‰———f̘¡±cÇêá‡V‡¬æ/]ºT±±±š6m]‡€Ò{lû•@uµÖ¿gÏmÙ²Eëׯ×o¼¡   9;;WzùÁƒ«U«Vš?¾Õô¢¢"}òÉ'ŠˆˆP÷îÝ9 7${šÀ¶‚‚µlÙ²Ôô›nºIyyy•z|:u´råÊRãGìíí5gÎyxxÐ  „ÜV­Z¥ 6Tê¡]uêÔÑ®]»TXXh5ÝÓÓ󢾋¦aÆ6§ûûûsô!7ŠC‡YÆvT&„<ôÐC|±„K7jÔ(9²Reíììþöq-BªÓÛ3 €k™&„@ „B!B!€@„@ „B!B!€@„B „B4€«Êž&nÜпg—öDoщ„8äeËÉÕ]žÞååÓTüÕ¨isš !Àåõë’yÚðý?JM?töߦ·ŒÓˆ'ß–aÐC€à29vä %€˜í¼tËÏÈÛ§© ”t4^þZ.U"|˜L•*V9Y™I&Uº„d—žB€¿+„$Ä[Þ÷ú‘Âîèoéñ0™L*,|B§N³¹lvV¦âãvèÔ‰DæËÅÍ]õùÉ׿¥ìjH’bÿÚª’’™LR@ëvÊÊHÓî?·(;+]{ö—[-wIRaaÄíÔ‰#ñ*ÈË‘‹›»|›·Vc¿ægµââ"ÅïÙ©ã ”—›-×ZjìßR¾þ-΄˜³ŠŠ e ­Ûݦ”ä“Úý×åådÉËÇW­ÛÝ&‡58B€«©¤¸Øò>åÄÈÞÁA’d†ìíT¿¡o©K1QÕò9«¸0±TMÞ*¿€Ö2™¤g<®‚ÜX™Ìnê?f~š¡’âdIÒ-{È­–»ÇkÁGÿRfòêRuµîòŠ ¯ŽN–i'Ñ‚'étâ¥ÊÜúŒ>2QÎ.®gÂMA¾û°¿Œ’LIRÞ˜ŸôÓúYïK›±Šxjªìíù5B\5õúZÞo_ùŒbÖÎP‹Ð5ö¿Y>¾þòiÜTvöVËìús‹–Î`ùÙ¿ýSjØVy9YŠÛö³L6z.Œ’L-ùϲ¯Ñ@õ›ß£ŒSñ’a(ítŠ¾|½¿Š ÊdvSçAÊ»¡¯öüµI;Ö¾¨]¿¿¢N.0ìqI&egehÎC•—ù‡$)ì¾™òi øÝ*ê—§´oëT-qpÔý£Ÿ•ÉTz;~úO?5™(‡NÚ½ñuIRÂŽ:°{˜Z´ æ€!®–&þºµï‡ÚºìŸ’¤¢‚ƒÚõû+Úõû™ùµ¼{ëž‘/) Õ-–Þ‘_¾žbY¾ûƒ_©KŸû$™d2I=û?¨üü<›ëjÔj¨Â{E.®n*).’L&ý¾ü{”$õŽøB{ô• C­n¹U)ÇãulÏý¹òu¹ûyxz)zëï–Òõ9êqO¸ jÝî6¥%Õ¨÷µ{ãëJê?Lõ}š”Ú†;†ÏÕí½ï•I&­¬×X83æH|! „¸šL2éÎÁ#uS»NŠÞ¼Z±¿RAn¬e~FÒJÍ{7RcÞØ&oŸFJMIRÖ©ß,ó;Ü~‡ÎÙ0 ÉÎÞA.ôœXÀÿ–kM7I’ÝÙKvn²Ì?~h~]œnù¹ ?ÛòþÄ‘CòðôÒá=Z¦%;¤ÕKæZ~ÎÉL±¼?vø€ÍÒöÖ®–žšzüþ·lVº¨ B\í b2«iÀMjp“ú}\§’O(aßn­š÷Šò³þ”Q’©=;΄‚ z9\\Ý*½:^¥¦e¥µ¼ùmr™ËæådK&);ý”eZìúWË,Ÿ›“esºKÍZ–÷vvçýÚãöc€àê*,,´ D•$“Ù,¯z>òªç£¬ŒÓZ»`¤$);3]&“INήVËgf¤É­–GÅAÇì&³©ôƒ™kÕõUÚñ3ïûþI^>ÿ·ÌycKÜ=ëJ†äæQß2­ÏÈïÔÈ/ÀæúÜÜ=Ë\¦ó¶ÉÄ\#xl;pÚ³#J ?W‡öíVA~ž £D’¡¼ÜÚ³ÝR®vo†¡ÚžuåÙè^ËôÈÕKd”Ëd:sgl~^®23R+½þæm:YÞ§$Sc¿59÷j ›*7;ÓrÇï¦ÿÛH>vH›6Wc¿€³ËʧI3åfg[Ê 'ÀµÊ0»þUÅ®Uf;/ÕiÒCvöŽJ9²Y…y{-½-‚B,‹Ü5ì}óö™Ûc#?¦;Ö«I‹[•—“¡ýÛÒÿœQ©ÞI îÔS‘ËnSnúmZ4Z§Ž”ßMd%:u¸Àj¾cÍvºoì‡Vã9ZµÕýOþ¦Ÿf?«Üô-JŠŸ§¤øyçåšÊ¯¨YË]OþF‹>CÇöÌÑÞÍokïfë2>-FZ.£8;»jĤ™Züå»:ý±â·OSüöiVå=ö—ÙŽÎ]àzb2øbˆjí駟Öñ£‰úú‹ÿ¨¤¤äÌÉâü@¶ï 0,ˆ$“©tã¼ Êúc[*õìˆ ë©pýç-1ªaÙ4S¹ëV9ë¾°LéåMåo—©¢ ¼”± ¦òoê0•³S:3F¡ӧ’”|¸ æš.m¼‰é’—¯Äqó·mÛÕ[¾wïÞêÚµ«^xáNô„¸Fÿ‘gÝzò¬[rp¨¡f-Û¨Y‹6e–ñmXéKÃ&~jØįô™Ô°½Íõùª~#ßrëµ³³“¯K›óÜÜkËͽ6?p  ïB!€!„@ „B!B!€!„@ „B!B!€!„@ „B!B!€@„@ „B!B!€@„B „B!B!€@pmÈÌÌÔøxåT»}KNNÖɤ¤¿eÝ©©©JLL”‰C „°mÏÞ=jÝúf¥¥¥Uiù‚%&&*;'ûŠlßé”Ó:~üøE/—““£aÆéhbâßÒ®yyyêܹ³ŽüMë!®yîµÜõꫯª†C*-*%EÍ›h÷î¸Ë¿q&éû~иqãeÆE-ºzõ*Õ¯__mo¹åoi× hüøñúæ›oè !l г“ž‘‡GíkrûL&ÉÞÞþ¢–ÉÍÍÑë¯OÑÈ‘#egþû~mÞsÏ=š›­é,³ÙN'“’ÔÀM›öJJJ¬ÊýÍ\ÝÒ.XÛþØ&'''EFnV› ¶úî»ï¬ÊILÔ]wÝ¥¬ì¬ÿ…—½{t×]wé矗멧žVZjšN:¥‘?¬ç_xAEÅÅ’¤ÌÌ ý%Iڣ͛7kóæÍJH8Rî¾lß¾]O<1N»ãâää䤌ÌL½ð 2D)))gCƒ´sçNíß¿_ÉÉÉÚ¼y³"##©¼¼¼rëß¼y³†®ÚµkŸŸ"äí]Oÿú׿ôßÿþWç_ÜY´h‘†ª:uê”ýË×lÖþýû5dÈåÛXÿâÅ‹õì³ÏÊÅÅÅj™{î¹GK–,¹èËI=!®)7nT·n]õùg³doï “¤.]:«W¯Þ íªÛÃÂÎöÄhÔ¨Qúú«¯4pà}2›Í*))Q‡í5ü¡‡ÔºukÝtÓM®o붭Zøí·–žîݺ©{1"Bmƒ‚äï﯎§÷ß_?ü°Ú·oæ|/C*çœÛªU+­Xñ‹œœœ$ãL¯GDD„"""ôâE5êQ%†yä2´jÕj=÷Üs:ÛRî Ý$iáÂ…2dˆÌf³t^ÙúõêiÆŒOÕµk7µiÓF:uRLLŒ† ¦%K–ÈÏϯÌz ÃPïÞ½õè£ê¨(…mkIÊÎÎÖû￯ɓ'ŸÙ§ó4oî¯qãÆiÆŒrwwç =!®_ .{{‡³'{éöN¡¥K—Zʬùí7………©_¿{d2™dH2™Ìxß@iݺu•Z×#<"''G†!Ã0Ü>X5RBB‚¥w¡äìI¾älÃ(?€H’»»»ÏÔk2™$“äé顇†×ÿûÿO¦³C9 –Àa%ÿ«¿Ù99Ú¶m›4h`³lÇŽôÉ'ë±ÇÓŽ;ô¯ýK¯½öšúôî]a{Ô¯__Ï>û¬/^l5ýÏ?·kïÞ½êÖ­[©e<=Ïô®œJNæà=!®_AAAòöö¾àO“:uì¨9_~©¢¢"ÙÛÛkëÖmêÞ½»åDŽ‹‹³îèÙSEGWj}õêÕ³úÙÎÎN7Ýt“²³s.i? ÃPtt´6nܤ;v(==]’tüøqmÛ¶M…r8´.Ö¹K5öHœ·r >\[·nSûöíÕ·o_=þøã2Urkÿ~ýÔ),Lÿüç?Õ¨Q#IÒ¼yóõÔSO©~ýú¥Ê;::ð§ÇIDATJ’r+¸„Ðàšæææ&{ûÒP]\\”˜˜h IIIeÜtwwשS§*÷ ÇTúWŽÙl¾äñ ?þ¸X½zõ–£££FŽ©É“'ë¥_Ôøà;F5jØ~Ø[BB‚‚ƒƒË½ó „¸æ¹¹¹é½÷§)99Yf³Y……š;o¾V­Z¥þú[ÊÝÑó%''ë?ÿ™©ììlÙ™ÍÊÌÌÐôéËÙÙYÝ»u¿lÛäQÛC5Rdd¤NŸ>­Ì¬Låææ–Y¾–››:w—-SNvŽÌf³òóó5oÞ\ýùç_¥Ê7lØP«V­ÒîÝ»•‘ž¡ÌŒL—}¹ÆÔ¹sg­\¹R99ÖcWòòóõòË/«OŸ>>l˜L&“}ôÝÔ²¥¦L™¢‚ó¾?'##Cöööš=û‹RëðööÖSO=¥ûï@±±±êܹ‹ím1 mÚ´IC‡µù€àºqË-·hØÐÕ­{ ò ºõ衧'NÔ?|¯–-ZXÊ5nÜH?/[¦ù èÖÛB5àÞûÚ±“V¬\©%‹«AƒÖgíR'ϲ·¡°°ÐjLˆ½ƒ½fÏž­¹óæɧaC5k毹óæ–¹¼ÉlÒÔwÞÑ÷?ü ÐŽ5lø0u QB½üÒK¥{:vÔ¸qãÔ®]°¼¼½å׬Y…ß%Ó®];ÅÆÆjÿþ}çí¦¡/¾øB¿ýö›^zé%KÏ…³³‹¦¼ñ†¾ùæÍŸ?ÿ=3g{vœm†‹ûî»O™™™zöÙgåããcs;RRR4kÖ,uíÚ•ƒÕwÇ7¸.]ºhÝÚßtà@¼ £D~~~ª_¿~©Á¢!!,å223ä^Ë]þþþªYÓÕ*d´jÕJöï—çycBCoÓýûU£†õ`J;³fÏþ\ÎNÖ'æn]»è÷u딞‘¡â¢"9Ù8qŸ/88X[·nÑTXX$Ÿ äë뫬¬,ÅÇ°Äéâê¢w§NÕä^PNn® ×—W¹õ׫WOo¿ý¶~üq±Úµ•a*..Ñ€ôÀ¨ÎÙ'šžãë뫸¸8¨¸¸XvvvJHH›››ºw·Ýktî¡d (s;Ö­[§ûï¿ßæVB€ë¡ºuëªnݺV™Ûúk½fÍšjÛ6èÌØÃv/‡‹‹‹åqíçÔrsS-wŒ˜LR·¡:sKl™·Å–*oÈÓÓSžžž–g‚HR­ZµT«V-›½'µ=j«v%¿ßÆ0 …‡? Ûo﬑#F¨qãƲ·³SÃ2z,$• 6111zû­·l<“ɤŸ~úI;wVPPÍúrrr4}út½÷Þ{gšBàÆàÓÀG_}õ_JI©ÒÝ@]ºt‘—W]«RPP ;wêHB‚ž|òI­X±¢Ì©'OžÔĉO+88˜„×7'''ùúúJ|1|¥’:u «rk5mÚ´Ô´ÜÜ\=ûì³òððÐܹsËëáççWîcàB€ëÆ€þýÕ¿_?ºöÿFîîîZ±b…L&“Í“Õ¿}€”Éd"€\#Ÿƒ$¾„B¨ÖàouáE“Õe ÆI„\qGULLŒBCCm~1ÕÆe2™Ô©S' ÕÊöíjýúõ¥fÚÛÛ«ß=÷¨I“&4@Á•T«V-1B3fÌÐÀ­æ>}Z·ß~»~þùg ÕN^^žž}öÙRÓƒƒƒu÷ÝwÑ@@5Ƙk„›››^{í5}ñÅ–ï˜8ç÷ß—›››BCCi(!—_Ïž=µlÙ2ÅÆÆZ¦éóÏ?×k¯½fó2 „\²æÍ›ë‘GÑ÷ßo™§eË–é®»è–Bp9RÓ¦MSrr²$iñâźÿþûÕ¼ysP­00õÓ®];hÓ¦M ÓäÉ“õË/¿ÈÎήTÙììl%&&–Y—ÉdRJJŠÒ32´3nŸJJJ$Ù¸%ò‚Û +õÜFãL¹ Ÿ4}®€Qöì*?'²rpeª®ÄºMå,ZWô1Þn»©RmtQÕÖûvîÇÄ#G.WWW«âNŽŽüB!¸š\\\4nÜ8}ôÑG***R£FÔ±cG›eÍf³ËùEm2™dggw¦\*1 Kx(ïda\ðÃù'ŒòN¶U ¥K WäDm\âòU !e==ÃÖÓ¾+^µé’>–K 0Ì®ëå¥_|QõëÕ+U´¬o”@ÁÒ§O9Rk֬ѴiÓT«V-›åœm~3çùj×®­Üì,4óµÙb*ãœznšéì‰Þ(³@¡‚^– ×ÞòsR4,›f*wÝe S¹Ûn*»®h€2•Ýx¶Öm”8—ôM%¤”‹ÙµÔÔ4¹º¸ÈÕÕÅza¾J¨ör ª_¿¾ž{î9Ib@*€‚«Çd2ÉÙÙYÇW`` ¨–¸s :yò¤^zé%­ZµêÊN€IŠ×Ñ£G5wî\õéÓGaaa4  ÚârÌ5$&&F³gÏVƒ ôùçŸËÙÙ™FT[ô„\C  p @ÁÕEøÜH¸!€@„B „B!€!€@„B „B!€!„@„B „B!€!„@ „B „B!€!„@ „B!B!€!„@ „B!B!€!„@ „B!B!€@„@ „B!B!€@„pÍËÊÊÒ±cÇT\\LWOTT”6l¨œœB¸zj×®­çž{NvvvWlö43¸PÛ¶mÕ¶mÛ+ºB0 Crtt¼ìuÇÆÆ*--MíÛ··ª¿¤¤D[¶l‘³³³n¹å–rëÈÉÉÑ®]»tðàAeddÈÍÍMmÚ´Q«V­¬Êíß¿_'OžT»víäââbµQQQ2 C!!!’¤ãÇ+>>^!!!ªQ£†Uýõ—ÒÒÒäèè(ÉËËë¢÷Ë1TÀd2)&&F¯¼òŠV¯^­ÄÄÄËV·»»»†®¯¿þÚjúâÅ‹Õ©S'9;;WXÇ«¯¾ª^xA *..Öæ͛պuk}úé§Våj×®­ñãÇë“O>‘a–ék×®UHHˆL&“eÚÞ½{uûí·+??ß2íÇT@@€¶mÛ&IÊÈÈÐ_|¡… ÒÀ•r®‡ gÏžÊÌÌTŸ>}4tèPµmÛVÍš5SÍš5«ToÆ 5gÎuíÚUmÚ´Ñ­·Þª={öhàÀZ´h‘Z´hQa?þ¸7nl" ¤Î;«[·n–‘ºuëêóÏ?Wpp°Ú·o¯=zèÈ‘#zôÑG5gÎuèСÌuäççë¾ûîÓ·ß~«Áƒ[­;55µJûNOÈ Æ¨àg«i†íùçÊeL3Œ3¯sËŸ?]ÆÿæçÕo\ð’éîÌù“ÏmC a”³îŠÖo”½ ý9T©NãòWêX«¨}ë1ˆüúë¯jÔ¨‘V¬X¡‡zÈ2vbÒ¤IZ¹r¥Ž?~Ñ·µvîÜY~ø¡F¥}ûöiܸqzþùçÕ¯_¿J-ߤI«"I·ß~»zõê¥èèh«éíÚµÓ—_~©!C†(66VÏ<óŒî¸ã=øàƒå®#//O’äááQjž­iô„T©©©zúé§eoñ׆ ”™™¡G›ð·ž®ÈI± ™ÌgþSš®á}¯ “©úüýœœ,WWW«ëÓåﻩÚþ_7›oÜ¿ /çç­””%$$\±Ïéü1’¯©S§jêÔ©’¤ûî»O}ûöU‡Ô¢E 999U¸ÿ£FÒ–-[¨Î;kâĉ•¾3¥°°P6lжmÛtôèQJ’8 äääRå|ðAEEE©uëÖ ÒÊ•+KíÓ…ÜÝÝ5iÒ$=ZO>ù¤:tè €€yzzV¹- !×É/&Ÿ*Ý&åêêz&%7õ³ºþ\+ìììäææ&777—%ÌÔ¨QC®®®jРÁ[GE—^¼¼¼äáá!ggçJ,ggguêÔIsçÎÕ AƒT»víJ§žzJÛ·o×øñãf  ****µŒƒƒƒn»í6MŸ>] ··w¥ÖõÒK/)44T‹/ÖOþøc;VNNNzôÑGµråJÕ©S§ÜeSSSåíí­ºuëZMOLLÔÚµkK+IKKÓã?®W_}U/¾ø¢|}}5räH­[·N5ªô6»»»«S§Nš8q¢ºuëfÙŽ‹êéç b6lÐöíÛ©ƒjöìÙ4hš7o~I¤  @/¿ü²n¾ùf=üðÃ2›Ízâ‰'äëë«7ß|Óæå”óy{{+))ÉrÛ¬$¥§§kêÔ©¥BEqq±Þ}÷]988h„ 2™L>|¸ºwï®É“'[ŸÚ’’’¢¨¨(ËxI***Òü¡   ÕªUë¢÷ž*`†BCCuûí·_öºçΫ¥K—jãÆ–g‚¸ººêÝwßUóæÍ¢ððð2—Ð;ï¼£>}úhĈòööÖŒ34oÞ¼R¡bÙ²eš>}º¶mÛf ŽŽŽzýõ×uÇwèË/¿Ô˜1cl®'//O:t···|ðA¹¸¸hýúõ:yò¤æÏŸ_áà[BU`2™ªt‡bE Õ±cGEFF–êµð÷÷WBB‚rrrT\\\æÍ vvvš8q¢úöí«„„9::êŸÿü§|||ÔªU+Ë Õ’’µhÑB111jÚ´©U 4ЪU«”™™©‚‚Õ¨QCAAAŠ‹‹³£† *--MñññJNNVqq±ú÷ï¯Ö­[Wù)„+{{ûj}Û-P‡rFÖ¸qãJ‡¤Ö­[«uëÖVÓýüü,ïÍfs¹ëòññ±úÙÃãÔó?ÜÝÝÕ®]»Ë÷ÿŸCÀß©M›6„àÅÀT+@ „B\6EEE:xð ’’’JÍËÍÍÕÁƒuúôi „Àåeoo¯+V¨cÇŽ:vì˜ezII‰¦M›Vá·x „@•9RÝ»w׋/¾¨üü|IÒªU«ô /hæÌ™—ôœ!P&GGG½öÚkZ»v­æÌ™£øøx >>úꫯ¦   =úè£zàh\o¾ù¦\]]iˆë€É0 ƒf¨¾N:¥’’’‹þfCàJ+((Ð]wÝ¥5kÖ(&&FmÚ´¡Qª©ÜÜ\I’““Sµ|.LII‰RSSK}ÛmQQ‘²²²T»vm‚2p9¦š«[·.פo¿ýV{÷îU¿~ýô駟ª  €F©¦š6m*¥§§WËý[°`üüütêÔ)«é?üðƒÚ·o¯'Np”Ë1®º¿þúKÇתU«Ô²eKµoß^!!!zøá‡iœj(<<\EEEe~ÛõìèÑ£=z´\ªÇ£M›6Š×¬Y³ôÒK/q ØÀåWUJJŠ  ~ýúiâĉ2›Íúí·ßÔ£GýñÇjß¾=„ëÆǬqãÆiçÎ¥¾ø@¾¾¾=z´$)44T6lP@@@™Ë%''KR…—7n,IÊÌÌTýúõ9ˆÎ?Fh@e 0@¿ÿþ»Ö¯_¯Í›7kêÔ©’¤V­ZiÉ’%ò÷÷¿è:¬èèhõîÝ[7ß|³þûßÿªaÆçPJJŠ$iìرeÖ•‘‘Q¥ýrrrR`` åç    Ç&ÙÛŸ9…Vô@È¢¢"I²9fäFG‹*¥¨¨HÿùÏÔ°aC=ÿüóZ²d‰òòò«¢¢"}ôÑGU®ûÏ?ÿTïÞ½Õ¶m[K9yò¤6mÚ$I2™L–»O¶oß®””«×éÓ§•ššªæÍ›Wi¿fÎœ©ÁƒëÉ'ŸÔ¢E‹4kÖ, :T‰‰‰e.w®çç\8*K\\œ$Uià,!¹“äñÇ×c=¦U«Viß¾}:xð âââ”––&'''KÙ£GjñâÅZ´h‘Ö¬Y#éÌÝ2‹-ÒâÅ‹uôèQKÙ;v¨ÿþJJJR=´uëVýøãzûí·¦œœIÒ Aƒäæ榧Ÿ~Züñ‡RRR”””¤èèh}õÕWš4iÒE÷„>|X¯¾úªÆŽ+ooo?^ýû÷׋/¾¨åË—«oß¾Z±b…ÍÞŽs='»ví*³þœœÍ™3G}úôáËmaX  2²²²Ê¼‹%""Â8qâ„¥ì—_~YfYIÆœ9s,e,XPnÙôôtKÙ¿þúËêΕó_?ü°qúôé‹Ú§Ï>û̪Ž¥K—éééVwÌH2ÒÒÒJ-›——g½zõ*óΗ7’ŒyóæqÙÀsB•–žž.8p@)))²³³Sýúõåïïo5桨¨HÉÉÉ6{Ìf³¼¼¼,c*ÒÒÒ”]æ:ëׯoõ´Õ¼¼<íÝ»W)))²··—»»»4h //¯‹ÞŸÂÂBËwlÙÙÙÉËËKvvvJOOWVV–$ÉÕÕµÌïY¸p¡î¿ÿ~­]»V]»vµšWRR¢Q£FiéÒ¥Ú¹sg•¶¯º#„p ¡¬K—.òôôÔÏ?ÿ,ggg˼õë׫K—.úüóÏõÈ#ÐX60&€*rww×Ì™3åææ¦ÂÂB«yùùùŠˆˆPxx8 UzBÕ†a:yò¤å¶Ørÿ 7›åíím¹,„«–T›7oV§N*]~Ñ¢Eº÷Þ{i¸¿ =!€j#==]7n,uiÄ;;;Ýzë­V_ºB¸00B!€!„@ „B!B!€!„@ „€ëÔÿÍüÔêEÀ' IEND®B`‚ocaml-graphics-9f1c7c8/src/000077500000000000000000000000001502374520500156235ustar00rootroot00000000000000ocaml-graphics-9f1c7c8/src/discover/000077500000000000000000000000001502374520500174415ustar00rootroot00000000000000ocaml-graphics-9f1c7c8/src/discover/discover.ml000066400000000000000000000024471502374520500216200ustar00rootroot00000000000000module C = Configurator.V1 type os = Win32 | Darwin | Other let os c = let win32 = C.ocaml_config_var c "os_type" = Some "Win32" in if win32 then Win32 else match C.Process.run c "uname" [ "-s" ] with | { exit_code = 0; stdout; _ } when String.trim stdout = "Darwin" -> Darwin | _ -> Other let from_pkg_config c = let fallback = ([], [ "-lXft"; "-lX11" ]) in match C.Pkg_config.get c with | None -> fallback | Some pc -> match C.Pkg_config.query pc ~package:"xft x11" with | None -> fallback | Some { cflags; libs } -> (cflags, libs) let () = C.main ~name:"discover" (fun c -> let cflags, libs = match os c with | Other -> from_pkg_config c | Win32 -> ([], [ "-lkernel32"; "-lgdi32"; "-luser32" ]) | Darwin -> let pkg_config_path = "/usr/local/lib/pkgconfig:/opt/X11/lib/pkgconfig:/opt/X11/share/pkgconfig" in let pkg_config_path = match Sys.getenv "PKG_CONFIG_PATH" with | exception Not_found -> pkg_config_path | s -> s ^ ":" ^ pkg_config_path in Unix.putenv "PKG_CONFIG_PATH" pkg_config_path; from_pkg_config c in C.Flags.write_sexp "cflags" cflags; C.Flags.write_sexp "libs" libs) ocaml-graphics-9f1c7c8/src/discover/dune000066400000000000000000000001021502374520500203100ustar00rootroot00000000000000(executable (name discover) (libraries unix dune-configurator)) ocaml-graphics-9f1c7c8/src/dune000066400000000000000000000013341502374520500165020ustar00rootroot00000000000000(* -*- tuareg -*- *) open StdLabels open Jbuild_plugin.V1 let subdir = match List.assoc "os_type" ocamlc_config with | "Win32" -> "win32" | _ -> "unix" let c_names = Sys.readdir subdir |> Array.to_list |> List.filter ~f:(fun fn -> Filename.check_suffix fn ".c") |> List.map ~f:Filename.chop_extension |> List.sort ~cmp:String.compare let () = Printf.ksprintf send {| (library (public_name graphics) (wrapped false) (synopsis "Portable drawing primitives") (foreign_stubs (language c) (names %s) (flags (:include cflags))) (c_library_flags (:include libs))) (copy_files# %s/*) (rule (targets cflags libs) (action (run discover/discover.exe))) |} (String.concat c_names ~sep:" ") subdir ocaml-graphics-9f1c7c8/src/graphics.ml000066400000000000000000000205541502374520500177630ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) exception Graphic_failure of string (* Initializations *) let _ = Callback.register_exception "Graphics.Graphic_failure" (Graphic_failure "") external raw_open_graph : string -> unit = "caml_gr_open_graph" external raw_close_graph : unit -> unit = "caml_gr_close_graph" external sigio_signal : unit -> int = "caml_gr_sigio_signal" external sigio_handler : int -> unit = "caml_gr_sigio_handler" let unix_open_graph arg = Sys.set_signal (sigio_signal ()) (Sys.Signal_handle sigio_handler); raw_open_graph arg let unix_close_graph () = Sys.set_signal (sigio_signal ()) Sys.Signal_ignore; raw_close_graph () let open_graph, close_graph = match Sys.os_type with | "Unix" | "Cygwin" -> (unix_open_graph, unix_close_graph) | "Win32" -> (raw_open_graph, raw_close_graph) | "MacOS" -> (raw_open_graph, raw_close_graph) | _ -> invalid_arg ("Graphics: unknown OS type: " ^ Sys.os_type) external set_window_title : string -> unit = "caml_gr_set_window_title" external resize_window : int -> int -> unit = "caml_gr_resize_window" external clear_graph : unit -> unit = "caml_gr_clear_graph" external size_x : unit -> int = "caml_gr_size_x" external size_y : unit -> int = "caml_gr_size_y" (* Double-buffering *) external display_mode : bool -> unit = "caml_gr_display_mode" external remember_mode : bool -> unit = "caml_gr_remember_mode" external synchronize : unit -> unit = "caml_gr_synchronize" let auto_synchronize = function | true -> display_mode true; remember_mode true; synchronize () | false -> display_mode false; remember_mode true (* Colors *) type color = int let rgb r g b = (r lsl 16) + (g lsl 8) + b external set_color : color -> unit = "caml_gr_set_color" let black = 0x000000 and white = 0xFFFFFF and red = 0xFF0000 and green = 0x00FF00 and blue = 0x0000FF and yellow = 0xFFFF00 and cyan = 0x00FFFF and magenta = 0xFF00FF let background = white and foreground = black (* Drawing *) external plot : int -> int -> unit = "caml_gr_plot" let plots points = for i = 0 to Array.length points - 1 do let x, y = points.(i) in plot x y done external point_color : int -> int -> color = "caml_gr_point_color" external moveto : int -> int -> unit = "caml_gr_moveto" external current_x : unit -> int = "caml_gr_current_x" external current_y : unit -> int = "caml_gr_current_y" let current_point () = (current_x (), current_y ()) external lineto : int -> int -> unit = "caml_gr_lineto" let rlineto x y = lineto (current_x () + x) (current_y () + y) let rmoveto x y = moveto (current_x () + x) (current_y () + y) external raw_draw_rect : int -> int -> int -> int -> unit = "caml_gr_draw_rect" let draw_rect x y w h = if w < 0 || h < 0 then raise (Invalid_argument "draw_rect") else raw_draw_rect x y w h let draw_poly, draw_poly_line = let dodraw close_flag points = if Array.length points > 0 then ( let savex, savey = current_point () in moveto (fst points.(0)) (snd points.(0)); for i = 1 to Array.length points - 1 do let x, y = points.(i) in lineto x y done; if close_flag then lineto (fst points.(0)) (snd points.(0)); moveto savex savey) in (dodraw true, dodraw false) let draw_segments segs = let savex, savey = current_point () in for i = 0 to Array.length segs - 1 do let x1, y1, x2, y2 = segs.(i) in moveto x1 y1; lineto x2 y2 done; moveto savex savey external raw_draw_arc : int -> int -> int -> int -> int -> int -> unit = "caml_gr_draw_arc" "caml_gr_draw_arc_nat" let draw_arc x y rx ry a1 a2 = if rx < 0 || ry < 0 then raise (Invalid_argument "draw_arc/ellipse/circle") else raw_draw_arc x y rx ry a1 a2 let draw_ellipse x y rx ry = draw_arc x y rx ry 0 360 let draw_circle x y r = draw_arc x y r r 0 360 external raw_set_line_width : int -> unit = "caml_gr_set_line_width" let set_line_width w = if w < 0 then raise (Invalid_argument "set_line_width") else raw_set_line_width w external raw_fill_rect : int -> int -> int -> int -> unit = "caml_gr_fill_rect" let fill_rect x y w h = if w < 0 || h < 0 then raise (Invalid_argument "fill_rect") else raw_fill_rect x y w h external fill_poly : (int * int) array -> unit = "caml_gr_fill_poly" external raw_fill_arc : int -> int -> int -> int -> int -> int -> unit = "caml_gr_fill_arc" "caml_gr_fill_arc_nat" let fill_arc x y rx ry a1 a2 = if rx < 0 || ry < 0 then raise (Invalid_argument "fill_arc/ellipse/circle") else raw_fill_arc x y rx ry a1 a2 let fill_ellipse x y rx ry = fill_arc x y rx ry 0 360 let fill_circle x y r = fill_arc x y r r 0 360 (* Text *) external draw_char : char -> unit = "caml_gr_draw_char" external draw_string : string -> unit = "caml_gr_draw_string" external set_font : string -> unit = "caml_gr_set_font" external set_text_size : int -> unit = "caml_gr_set_text_size" external text_size : string -> int * int = "caml_gr_text_size" (* Images *) type image let transp = -1 external make_image : color array array -> image = "caml_gr_make_image" external dump_image : image -> color array array = "caml_gr_dump_image" external draw_image : image -> int -> int -> unit = "caml_gr_draw_image" external create_image : int -> int -> image = "caml_gr_create_image" external blit_image : image -> int -> int -> unit = "caml_gr_blit_image" let get_image x y w h = let image = create_image w h in blit_image image x y; image (* Events *) type status = { mouse_x : int; mouse_y : int; button : bool; keypressed : bool; key : char; } type event = Button_down | Button_up | Key_pressed | Mouse_motion | Poll external wait_next_event : event list -> status = "caml_gr_wait_event" let mouse_pos () = let e = wait_next_event [ Poll ] in (e.mouse_x, e.mouse_y) let button_down () = let e = wait_next_event [ Poll ] in e.button let read_key () = let e = wait_next_event [ Key_pressed ] in e.key let key_pressed () = let e = wait_next_event [ Poll ] in e.keypressed let loop_at_exit events handler = let events = List.filter (fun e -> e <> Poll) events in at_exit (fun _ -> try while true do let e = wait_next_event events in handler e done with | Exit -> close_graph () | e -> close_graph (); raise e) (*** Sound *) external sound : int -> int -> unit = "caml_gr_sound" (* Splines *) let sub (x1, y1) (x2, y2) = (x1 -. x2, y1 -. y2) and middle (x1, y1) (x2, y2) = ((x1 +. x2) /. 2.0, (y1 +. y2) /. 2.0) and area (x1, y1) (x2, y2) = abs_float ((x1 *. y2) -. (x2 *. y1)) and norm (x1, y1) = sqrt ((x1 *. x1) +. (y1 *. y1)) let test a b c d = let v = sub d a in let s = norm v in area v (sub a b) <= s && area v (sub a c) <= s let spline a b c d = let rec spl accu a b c d = if test a b c d then d :: accu else let a' = middle a b and o = middle b c in let b' = middle a' o and d' = middle c d in let c' = middle o d' in let i = middle b' c' in spl (spl accu a a' b' i) i c' d' d in spl [ a ] a b c d let curveto b c ((x, y) as d) = let float_point (x, y) = (float_of_int x, float_of_int y) in let round f = int_of_float (f +. 0.5) in let int_point (x, y) = (round x, round y) in let points = spline (float_point (current_point ())) (float_point b) (float_point c) (float_point d) in draw_poly_line (Array.of_list (List.map int_point points)); moveto x y ocaml-graphics-9f1c7c8/src/graphics.mli000066400000000000000000000365451502374520500201430ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Machine-independent graphics primitives. *) exception Graphic_failure of string (** Raised by the functions below when they encounter an error. *) (** {1 Initializations} *) val open_graph : string -> unit (** Show the graphics window or switch the screen to graphic mode. The graphics window is cleared and the current point is set to (0, 0). The string argument is used to pass optional information on the desired graphics mode, the graphics window size, and so on. Its interpretation is implementation-dependent. If the empty string is given, a sensible default is selected. *) val close_graph : unit -> unit (** Delete the graphics window or switch the screen back to text mode. *) val set_window_title : string -> unit (** Set the title of the graphics window. *) val resize_window : int -> int -> unit (** Resize and erase the graphics window. *) external clear_graph : unit -> unit = "caml_gr_clear_graph" (** Erase the graphics window. *) external size_x : unit -> int = "caml_gr_size_x" (** See {!Graphics.size_y}. *) external size_y : unit -> int = "caml_gr_size_y" (** Return the size of the graphics window. Coordinates of the screen pixels range over [0 .. size_x()-1] and [0 .. size_y()-1]. Drawings outside of this rectangle are clipped, without causing an error. The origin (0,0) is at the lower left corner. Some implementation (e.g. X Windows) represent coordinates by 16-bit integers, hence wrong clipping may occur with coordinates below [-32768] or above [32676]. *) (** {1 Colors} *) type color = int (** A color is specified by its R, G, B components. Each component is in the range [0..255]. The three components are packed in an [int]: [0xRRGGBB], where [RR] are the two hexadecimal digits for the red component, [GG] for the green component, [BB] for the blue component. *) val rgb : int -> int -> int -> color (** [rgb r g b] returns the integer encoding the color with red component [r], green component [g], and blue component [b]. [r], [g] and [b] are in the range [0..255]. *) external set_color : color -> unit = "caml_gr_set_color" (** Set the current drawing color. *) val background : color (** See {!Graphics.foreground}.*) val foreground : color (** Default background and foreground colors (usually, either black foreground on a white background or white foreground on a black background). {!Graphics.clear_graph} fills the screen with the [background] color. The initial drawing color is [foreground]. *) (** {7 Some predefined colors} *) val black : color val white : color val red : color val green : color val blue : color val yellow : color val cyan : color val magenta : color (** {1 Point and line drawing} *) external plot : int -> int -> unit = "caml_gr_plot" (** Plot the given point with the current drawing color. *) val plots : (int * int) array -> unit (** Plot the given points with the current drawing color. *) external point_color : int -> int -> color = "caml_gr_point_color" (** Return the color of the given point in the backing store (see "Double buffering" below). *) external moveto : int -> int -> unit = "caml_gr_moveto" (** Position the current point. *) val rmoveto : int -> int -> unit (** [rmoveto dx dy] translates the current point by the given vector. *) external current_x : unit -> int = "caml_gr_current_x" (** Return the abscissa of the current point. *) external current_y : unit -> int = "caml_gr_current_y" (** Return the ordinate of the current point. *) val current_point : unit -> int * int (** Return the position of the current point. *) external lineto : int -> int -> unit = "caml_gr_lineto" (** Draw a line with endpoints the current point and the given point, and move the current point to the given point. *) val rlineto : int -> int -> unit (** Draw a line with endpoints the current point and the current point translated of the given vector, and move the current point to this point. *) val curveto : int * int -> int * int -> int * int -> unit (** [curveto b c d] draws a cubic Bezier curve starting from the current point to point [d], with control points [b] and [c], and moves the current point to [d]. *) val draw_rect : int -> int -> int -> int -> unit (** [draw_rect x y w h] draws the rectangle with lower left corner at [x,y], width [w] and height [h]. The current point is unchanged. Raise [Invalid_argument] if [w] or [h] is negative. *) val draw_poly_line : (int * int) array -> unit (** [draw_poly_line points] draws the line that joins the points given by the array argument. The array contains the coordinates of the vertices of the polygonal line, which need not be closed. The current point is unchanged. *) val draw_poly : (int * int) array -> unit (** [draw_poly polygon] draws the given polygon. The array contains the coordinates of the vertices of the polygon. The current point is unchanged. *) val draw_segments : (int * int * int * int) array -> unit (** [draw_segments segments] draws the segments given in the array argument. Each segment is specified as a quadruple [(x0, y0, x1, y1)] where [(x0, y0)] and [(x1, y1)] are the coordinates of the end points of the segment. The current point is unchanged. *) val draw_arc : int -> int -> int -> int -> int -> int -> unit (** [draw_arc x y rx ry a1 a2] draws an elliptical arc with center [x,y], horizontal radius [rx], vertical radius [ry], from angle [a1] to angle [a2] (in degrees). The current point is unchanged. Raise [Invalid_argument] if [rx] or [ry] is negative. *) val draw_ellipse : int -> int -> int -> int -> unit (** [draw_ellipse x y rx ry] draws an ellipse with center [x,y], horizontal radius [rx] and vertical radius [ry]. The current point is unchanged. Raise [Invalid_argument] if [rx] or [ry] is negative. *) val draw_circle : int -> int -> int -> unit (** [draw_circle x y r] draws a circle with center [x,y] and radius [r]. The current point is unchanged. Raise [Invalid_argument] if [r] is negative. *) val set_line_width : int -> unit (** Set the width of points and lines drawn with the functions above. Under X Windows, [set_line_width 0] selects a width of 1 pixel and a faster, but less precise drawing algorithm than the one used when [set_line_width 1] is specified. Raise [Invalid_argument] if the argument is negative. *) (** {1 Text drawing} *) external draw_char : char -> unit = "caml_gr_draw_char" (** See {!Graphics.draw_string}.*) external draw_string : string -> unit = "caml_gr_draw_string" (** Draw a character or a character string with lower left corner at current position. After drawing, the current position is set to the lower right corner of the text drawn. *) external set_font : string -> unit = "caml_gr_set_font" (** Set the font used for drawing text. The interpretation of the argument to [set_font] is implementation-dependent. *) val set_text_size : int -> unit (** Set the character size used for drawing text. The interpretation of the argument to [set_text_size] is implementation-dependent. *) external text_size : string -> int * int = "caml_gr_text_size" (** Return the dimensions of the given text, if it were drawn with the current font and size. *) (** {1 Filling} *) val fill_rect : int -> int -> int -> int -> unit (** [fill_rect x y w h] fills the rectangle with lower left corner at [x,y], width [w] and height [h], with the current color. Raise [Invalid_argument] if [w] or [h] is negative. *) external fill_poly : (int * int) array -> unit = "caml_gr_fill_poly" (** Fill the given polygon with the current color. The array contains the coordinates of the vertices of the polygon. *) val fill_arc : int -> int -> int -> int -> int -> int -> unit (** Fill an elliptical pie slice with the current color. The parameters are the same as for {!Graphics.draw_arc}. *) val fill_ellipse : int -> int -> int -> int -> unit (** Fill an ellipse with the current color. The parameters are the same as for {!Graphics.draw_ellipse}. *) val fill_circle : int -> int -> int -> unit (** Fill a circle with the current color. The parameters are the same as for {!Graphics.draw_circle}. *) (** {1 Images} *) type image (** The abstract type for images, in internal representation. Externally, images are represented as matrices of colors. Images are bound to the current graphics window and should not be reused after closing this graphics window with {!close_graph}. *) val transp : color (** In matrices of colors, this color represent a 'transparent' point: when drawing the corresponding image, all pixels on the screen corresponding to a transparent pixel in the image will not be modified, while other points will be set to the color of the corresponding point in the image. This allows superimposing an image over an existing background. *) external make_image : color array array -> image = "caml_gr_make_image" (** Convert the given color matrix to an image. Each sub-array represents one horizontal line. All sub-arrays must have the same length; otherwise, exception [Graphic_failure] is raised. *) external dump_image : image -> color array array = "caml_gr_dump_image" (** Convert an image to a color matrix. *) external draw_image : image -> int -> int -> unit = "caml_gr_draw_image" (** Draw the given image with lower left corner at the given point. *) val get_image : int -> int -> int -> int -> image (** Capture the contents of a rectangle on the screen as an image. The parameters are the same as for {!Graphics.fill_rect}. *) external create_image : int -> int -> image = "caml_gr_create_image" (** [create_image w h] returns a new image [w] pixels wide and [h] pixels tall, to be used in conjunction with [blit_image]. The initial image contents are random, except that no point is transparent. *) external blit_image : image -> int -> int -> unit = "caml_gr_blit_image" (** [blit_image img x y] copies screen pixels into the image [img], modifying [img] in-place. The pixels copied are those inside the rectangle with lower left corner at [x,y], and width and height equal to those of the image. Pixels that were transparent in [img] are left unchanged. *) (** {1 Mouse and keyboard events} *) type status = { mouse_x : int; (** X coordinate of the mouse *) mouse_y : int; (** Y coordinate of the mouse *) button : bool; (** true if a mouse button is pressed *) keypressed : bool; (** true if a key has been pressed *) key : char; (** the character for the key pressed *) } (** To report events. *) (** To specify events to wait for. *) type event = | Button_down (** A mouse button is pressed *) | Button_up (** A mouse button is released *) | Key_pressed (** A key is pressed *) | Mouse_motion (** The mouse is moved *) | Poll (** Don't wait; return immediately *) external wait_next_event : event list -> status = "caml_gr_wait_event" (** Wait until one of the events specified in the given event list occurs, and return the status of the mouse and keyboard at that time. If [Poll] is given in the event list, return immediately with the current status. If the mouse cursor is outside of the graphics window, the [mouse_x] and [mouse_y] fields of the event are outside the range [0..size_x()-1, 0..size_y()-1]. Keypresses are queued, and dequeued one by one when the [Key_pressed] event is specified and the [Poll] event is not specified. *) val loop_at_exit : event list -> (status -> unit) -> unit (** Loop before exiting the program, the list given as argument is the list of handlers and the events on which these handlers are called. To exit cleanly the loop, the handler should raise Exit. Any other exception will be propagated outside of the loop. @since 4.01 *) (** {1 Mouse and keyboard polling} *) val mouse_pos : unit -> int * int (** Return the position of the mouse cursor, relative to the graphics window. If the mouse cursor is outside of the graphics window, [mouse_pos()] returns a point outside of the range [0..size_x()-1, 0..size_y()-1]. *) val button_down : unit -> bool (** Return [true] if the mouse button is pressed, [false] otherwise. *) val read_key : unit -> char (** Wait for a key to be pressed, and return the corresponding character. Keypresses are queued. *) val key_pressed : unit -> bool (** Return [true] if a keypress is available; that is, if [read_key] would not block. *) (** {1 Sound} *) external sound : int -> int -> unit = "caml_gr_sound" (** [sound freq dur] plays a sound at frequency [freq] (in hertz) for a duration [dur] (in milliseconds). *) (** {1 Double buffering} *) val auto_synchronize : bool -> unit (** By default, drawing takes place both on the window displayed on screen, and in a memory area (the 'backing store'). The backing store image is used to re-paint the on-screen window when necessary. To avoid flicker during animations, it is possible to turn off on-screen drawing, perform a number of drawing operations in the backing store only, then refresh the on-screen window explicitly. [auto_synchronize false] turns on-screen drawing off. All subsequent drawing commands are performed on the backing store only. [auto_synchronize true] refreshes the on-screen window from the backing store (as per [synchronize]), then turns on-screen drawing back on. All subsequent drawing commands are performed both on screen and in the backing store. The default drawing mode corresponds to [auto_synchronize true]. *) external synchronize : unit -> unit = "caml_gr_synchronize" (** Synchronize the backing store and the on-screen window, by copying the contents of the backing store onto the graphics window. *) external display_mode : bool -> unit = "caml_gr_display_mode" (** Set display mode on or off. When turned on, drawings are done in the graphics window; when turned off, drawings do not affect the graphics window. This occurs independently of drawing into the backing store (see the function {!Graphics.remember_mode} below). Default display mode is on. *) external remember_mode : bool -> unit = "caml_gr_remember_mode" (** Set remember mode on or off. When turned on, drawings are done in the backing store; when turned off, the backing store is unaffected by drawings. This occurs independently of drawing onto the graphics window (see the function {!Graphics.display_mode} above). Default remember mode is on. *) ocaml-graphics-9f1c7c8/src/unix/000077500000000000000000000000001502374520500166065ustar00rootroot00000000000000ocaml-graphics-9f1c7c8/src/unix/color.c000066400000000000000000000160631502374520500200760ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "libgraph.h" #include /* Cache to speed up the translation rgb -> pixel value. */ struct color_cache_entry { int rgb; /* RGB value with format 0xRRGGBB */ unsigned long pixel; /* Pixel value */ }; #define Color_cache_size 512 static struct color_cache_entry color_cache[Color_cache_size]; #define Empty (-1) #define Hash_rgb(r,g,b) \ ((((r) & 0xE0) << 1) + (((g) & 0xE0) >> 2) + (((b) & 0xE0) >> 5)) #define Color_cache_slack 16 static int num_overflows = 0; /* rgb -> pixel conversion *without* display connection */ Bool caml_gr_direct_rgb = False; int caml_gr_red_l, caml_gr_red_r; int caml_gr_green_l, caml_gr_green_r; int caml_gr_blue_l, caml_gr_blue_r; unsigned long caml_gr_red_mask, caml_gr_green_mask, caml_gr_blue_mask; /* rgb -> pixel table */ unsigned long caml_gr_red_vals[256]; unsigned long caml_gr_green_vals[256]; unsigned long caml_gr_blue_vals[256]; void caml_gr_get_shifts( unsigned long mask, int *lsl, int *lsr ) { int l = 0; int r = 0; int bit = 1; if ( mask == 0 ){ *lsl = -1; *lsr = -1; return; } for( l = 0; l < 32; l++ ){ if( bit & mask ){ break; } bit = bit << 1; } for( r = l; r < 32; r++ ){ if( ! (bit & mask) ){ break; } bit = bit << 1; } /* fix r */ if ( r == 32 ) { r = 31; } *lsl = l; *lsr = 16 - (r - l); } void caml_gr_init_direct_rgb_to_pixel(void) { Visual *visual; int i; visual = DefaultVisual(caml_gr_display,caml_gr_screen); if ( visual->class == TrueColor || visual->class == DirectColor ){ caml_gr_red_mask = visual->red_mask; caml_gr_green_mask = visual->green_mask; caml_gr_blue_mask = visual->blue_mask; #ifdef QUICKCOLORDEBUG fprintf(stderr, "visual %lx %lx %lx\n", caml_gr_red_mask, caml_gr_green_mask, caml_gr_blue_mask); #endif caml_gr_get_shifts(caml_gr_red_mask, &caml_gr_red_l, &caml_gr_red_r); #ifdef QUICKCOLORDEBUG fprintf(stderr, "red %d %d\n", caml_gr_red_l, caml_gr_red_r); #endif for(i=0; i<256; i++){ caml_gr_red_vals[i] = (((i << 8) + i) >> caml_gr_red_r) << caml_gr_red_l; } caml_gr_get_shifts(caml_gr_green_mask, &caml_gr_green_l, &caml_gr_green_r); #ifdef QUICKCOLORDEBUG fprintf(stderr, "green %d %d\n", caml_gr_green_l, caml_gr_green_r); #endif for(i=0; i<256; i++){ caml_gr_green_vals[i] = (((i << 8) + i) >> caml_gr_green_r) << caml_gr_green_l; } caml_gr_get_shifts(caml_gr_blue_mask, &caml_gr_blue_l, &caml_gr_blue_r); #ifdef QUICKCOLORDEBUG fprintf(stderr, "blue %d %d\n", caml_gr_blue_l, caml_gr_blue_r); #endif for(i=0; i<256; i++){ caml_gr_blue_vals[i] = (((i << 8) + i) >> caml_gr_blue_r) << caml_gr_blue_l; } if( caml_gr_red_l < 0 || caml_gr_red_r < 0 || caml_gr_green_l < 0 || caml_gr_green_r < 0 || caml_gr_blue_l < 0 || caml_gr_blue_r < 0 ){ #ifdef QUICKCOLORDEBUG fprintf(stderr, "Damn, boost failed\n"); #endif caml_gr_direct_rgb = False; } else { #ifdef QUICKCOLORDEBUG fprintf(stderr, "Boost ok\n"); #endif caml_gr_direct_rgb = True; } } else { /* we cannot use direct_rgb_to_pixel */ #ifdef QUICKCOLORDEBUG fprintf(stderr, "No boost!\n"); #endif caml_gr_direct_rgb = False; } } void caml_gr_init_color_cache(void) { int i; for (i = 0; i < Color_cache_size; i++) color_cache[i].rgb = Empty; i = Hash_rgb(0, 0, 0); color_cache[i].rgb = 0; color_cache[i].pixel = caml_gr_black; i = Hash_rgb(0xFF, 0xFF, 0xFF); color_cache[i].rgb = 0xFFFFFF; color_cache[i].pixel = caml_gr_white; } unsigned long caml_gr_pixel_rgb(int rgb) { unsigned int r, g, b; int h, i; XColor color; r = (rgb >> 16) & 0xFF; g = (rgb >> 8) & 0xFF; b = rgb & 0xFF; if (caml_gr_direct_rgb){ return caml_gr_red_vals[r] | caml_gr_green_vals[g] | caml_gr_blue_vals[b]; } h = Hash_rgb(r, g, b); i = h; while(1) { if (color_cache[i].rgb == Empty) break; if (color_cache[i].rgb == rgb) return color_cache[i].pixel; i = (i + 1) & (Color_cache_size - 1); if (i == h) { /* Cache is full. Instead of inserting at slot h, which causes thrashing if many colors hash to the same value, insert at h + n where n is pseudo-random and smaller than Color_cache_slack */ int slack = num_overflows++ & (Color_cache_slack - 1); i = (i + slack) & (Color_cache_size - 1); break; } } color.red = r * 0x101; color.green = g * 0x101; color.blue = b * 0x101; XAllocColor(caml_gr_display, caml_gr_colormap, &color); color_cache[i].rgb = rgb; color_cache[i].pixel = color.pixel; return color.pixel; } int caml_gr_rgb_pixel(long unsigned int pixel) { register int r,g,b; XColor color; int i; if (caml_gr_direct_rgb) { r = (((pixel & caml_gr_red_mask) >> caml_gr_red_l) << 8) >> (16 - caml_gr_red_r); g = (((pixel & caml_gr_green_mask) >> caml_gr_green_l) << 8) >> (16 - caml_gr_green_r); b = (((pixel & caml_gr_blue_mask) >> caml_gr_blue_l) << 8) >> (16 - caml_gr_blue_r); return (r << 16) + (g << 8) + b; } if (pixel == caml_gr_black) return 0; if (pixel == caml_gr_white) return 0xFFFFFF; /* Probably faster to do a linear search than to query the X server. */ for (i = 0; i < Color_cache_size; i++) { if (color_cache[i].rgb != Empty && color_cache[i].pixel == pixel) return color_cache[i].rgb; } color.pixel = pixel; XQueryColor(caml_gr_display, caml_gr_colormap, &color); return ((color.red >> 8) << 16) + ((color.green >> 8) << 8) + (color.blue >> 8); } value caml_gr_set_color(value vrgb) { int xcolor; caml_gr_check_open(); caml_gr_color = Int_val(vrgb); if (caml_gr_color >= 0 ){ xcolor = caml_gr_pixel_rgb(Int_val(vrgb)); XSetForeground(caml_gr_display, caml_gr_window.gc, xcolor); XSetForeground(caml_gr_display, caml_gr_bstore.gc, xcolor); } else { XSetForeground(caml_gr_display, caml_gr_window.gc, caml_gr_background); XSetForeground(caml_gr_display, caml_gr_bstore.gc, caml_gr_background); } return Val_unit; } ocaml-graphics-9f1c7c8/src/unix/draw.c000066400000000000000000000077531502374520500177230ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "libgraph.h" #include value caml_gr_plot(value vx, value vy) { int x = Int_val(vx); int y = Int_val(vy); caml_gr_check_open(); if(caml_gr_remember_modeflag) XDrawPoint(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, x, Bcvt(y)); if(caml_gr_display_modeflag) { XDrawPoint(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, x, Wcvt(y)); XFlush(caml_gr_display); } return Val_unit; } value caml_gr_moveto(value vx, value vy) { caml_gr_x = Int_val(vx); caml_gr_y = Int_val(vy); return Val_unit; } value caml_gr_current_x(void) { return Val_int(caml_gr_x); } value caml_gr_current_y(void) { return Val_int(caml_gr_y); } value caml_gr_lineto(value vx, value vy) { int x = Int_val(vx); int y = Int_val(vy); caml_gr_check_open(); if(caml_gr_remember_modeflag) XDrawLine(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, caml_gr_x, Bcvt(caml_gr_y), x, Bcvt(y)); if(caml_gr_display_modeflag) { XDrawLine(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, caml_gr_x, Wcvt(caml_gr_y), x, Wcvt(y)); XFlush(caml_gr_display); } caml_gr_x = x; caml_gr_y = y; return Val_unit; } value caml_gr_draw_rect(value vx, value vy, value vw, value vh) { int x = Int_val(vx); int y = Int_val(vy); int w = Int_val(vw); int h = Int_val(vh); caml_gr_check_open(); if(caml_gr_remember_modeflag) XDrawRectangle(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, x, Bcvt(y) - h, w, h); if(caml_gr_display_modeflag) { XDrawRectangle(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, x, Wcvt(y) - h, w, h); XFlush(caml_gr_display); } return Val_unit; } value caml_gr_draw_arc_nat(value vx, value vy, value vrx, value vry, value va1, value va2) { int x = Int_val(vx); int y = Int_val(vy); int rx = Int_val(vrx); int ry = Int_val(vry); int a1 = Int_val(va1); int a2 = Int_val(va2); caml_gr_check_open(); if(caml_gr_remember_modeflag) XDrawArc(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, x - rx, Bcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64); if(caml_gr_display_modeflag) { XDrawArc(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, x - rx, Wcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64); XFlush(caml_gr_display); } return Val_unit; } value caml_gr_draw_arc(value *argv, int argc) { return caml_gr_draw_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } value caml_gr_set_line_width(value vwidth) { int width = Int_val(vwidth); caml_gr_check_open(); XSetLineAttributes(caml_gr_display, caml_gr_window.gc, width, LineSolid, CapRound, JoinRound); XSetLineAttributes(caml_gr_display, caml_gr_bstore.gc, width, LineSolid, CapRound, JoinRound); return Val_unit; } ocaml-graphics-9f1c7c8/src/unix/dump_img.c000066400000000000000000000042721502374520500205600ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "libgraph.h" #include "image.h" #include #include value caml_gr_dump_image(value image) { int width, height, i, j; XImage * idata, * imask; value m = Val_unit; Begin_roots2(image, m); caml_gr_check_open(); width = Width_im(image); height = Height_im(image); m = caml_alloc(height, 0); for (i = 0; i < height; i++) { value v = caml_alloc(width, 0); caml_modify(&Field(m, i), v); } idata = XGetImage(caml_gr_display, Data_im(image), 0, 0, width, height, (-1), ZPixmap); for (i = 0; i < height; i++) for (j = 0; j < width; j++) Field(Field(m, i), j) = Val_int(caml_gr_rgb_pixel(XGetPixel(idata, j, i))); XDestroyImage(idata); if (Mask_im(image) != None) { imask = XGetImage(caml_gr_display, Mask_im(image), 0, 0, width, height, 1, ZPixmap); for (i = 0; i < height; i++) for (j = 0; j < width; j++) if (XGetPixel(imask, j, i) == 0) Field(Field(m, i), j) = Val_int(Transparent); XDestroyImage(imask); } End_roots(); return m; } ocaml-graphics-9f1c7c8/src/unix/events.c000066400000000000000000000232321502374520500202600ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #define CAML_INTERNALS #include #include "libgraph.h" #include #include #include #include #ifdef HAS_SYS_SELECT_H #include #endif #include #include struct event_data { short kind; short mouse_x, mouse_y; unsigned char button; unsigned char key; }; static struct event_data caml_gr_queue[SIZE_QUEUE]; static unsigned int caml_gr_head = 0; /* position of next read */ static unsigned int caml_gr_tail = 0; /* position of next write */ #define QueueIsEmpty (caml_gr_tail == caml_gr_head) static void caml_gr_enqueue_event(int kind, int mouse_x, int mouse_y, int button, int key) { struct event_data * ev; ev = &(caml_gr_queue[caml_gr_tail]); ev->kind = kind; ev->mouse_x = mouse_x; ev->mouse_y = mouse_y; ev->button = (button != 0); ev->key = key; caml_gr_tail = (caml_gr_tail + 1) % SIZE_QUEUE; /* If queue was full, it now appears empty; drop oldest entry from queue. */ if (QueueIsEmpty) caml_gr_head = (caml_gr_head + 1) % SIZE_QUEUE; } #define BUTTON_STATE(state) \ ((state) & (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)) void caml_gr_handle_event(XEvent * event) { switch (event->type) { case Expose: XCopyArea(caml_gr_display, caml_gr_bstore.win, caml_gr_window.win, caml_gr_window.gc, event->xexpose.x, event->xexpose.y + caml_gr_bstore.h - caml_gr_window.h, event->xexpose.width, event->xexpose.height, event->xexpose.x, event->xexpose.y); XFlush(caml_gr_display); break; case ConfigureNotify: caml_gr_window.w = event->xconfigure.width; caml_gr_window.h = event->xconfigure.height; if (caml_gr_window.w > caml_gr_bstore.w || caml_gr_window.h > caml_gr_bstore.h) { /* Allocate a new backing store large enough to accommodate both the old backing store and the current window. */ struct canvas newbstore; newbstore.w = max(caml_gr_window.w, caml_gr_bstore.w); newbstore.h = max(caml_gr_window.h, caml_gr_bstore.h); newbstore.win = XCreatePixmap(caml_gr_display, caml_gr_window.win, newbstore.w, newbstore.h, XDefaultDepth(caml_gr_display, caml_gr_screen)); newbstore.gc = XCreateGC(caml_gr_display, newbstore.win, 0, NULL); XSetBackground(caml_gr_display, newbstore.gc, caml_gr_white); XSetForeground(caml_gr_display, newbstore.gc, caml_gr_white); XFillRectangle(caml_gr_display, newbstore.win, newbstore.gc, 0, 0, newbstore.w, newbstore.h); XSetForeground(caml_gr_display, newbstore.gc, caml_gr_color); /* Copy the old backing store into the new one */ XCopyArea(caml_gr_display, caml_gr_bstore.win, newbstore.win, newbstore.gc, 0, 0, caml_gr_bstore.w, caml_gr_bstore.h, 0, newbstore.h - caml_gr_bstore.h); /* Free the old backing store */ XFreeGC(caml_gr_display, caml_gr_bstore.gc); XFreePixmap(caml_gr_display, caml_gr_bstore.win); /* Use the new backing store */ caml_gr_bstore = newbstore; XFlush(caml_gr_display); } break; case MappingNotify: XRefreshKeyboardMapping(&(event->xmapping)); break; case KeyPress: { KeySym thekey; char keytxt[256]; int nchars; char * p; nchars = XLookupString(&(event->xkey), keytxt, sizeof(keytxt), &thekey, 0); for (p = keytxt; nchars > 0; p++, nchars--) caml_gr_enqueue_event(event->type, event->xkey.x, event->xkey.y, BUTTON_STATE(event->xkey.state), *p); break; } case ButtonPress: case ButtonRelease: caml_gr_enqueue_event(event->type, event->xbutton.x, event->xbutton.y, event->type == ButtonPress, 0); break; case MotionNotify: caml_gr_enqueue_event(event->type, event->xmotion.x, event->xmotion.y, BUTTON_STATE(event->xmotion.state), 0); break; case ClientMessage: if ((Atom) event->xclient.data.l[0] == caml_wm_delete_window) { caml_gr_close_graph(); } break; } } static value caml_gr_wait_allocate_result(int mouse_x, int mouse_y, int button, int keypressed, int key) { value res = caml_alloc_small(5, 0); Field(res, 0) = Val_int(mouse_x); Field(res, 1) = Val_int(mouse_y == -1 ? -1 : Wcvt(mouse_y)); Field(res, 2) = Val_bool(button); Field(res, 3) = Val_bool(keypressed); Field(res, 4) = Val_int(key & 0xFF); return res; } static value caml_gr_wait_event_poll(void) { XEvent grevent; int mouse_x, mouse_y, button, key, keypressed; Window rootwin, childwin; int root_x, root_y, win_x, win_y; unsigned int modifiers; unsigned int i; /* Process pending X events before polling */ while (XPending(caml_gr_display)) { XNextEvent(caml_gr_display, &grevent); caml_gr_handle_event(&grevent); caml_gr_check_open(); } /* Poll the mouse state */ if (XQueryPointer(caml_gr_display, caml_gr_window.win, &rootwin, &childwin, &root_x, &root_y, &win_x, &win_y, &modifiers)) { mouse_x = win_x; mouse_y = win_y; } else { mouse_x = -1; mouse_y = -1; } button = modifiers & (Button1Mask | Button2Mask | Button3Mask | Button4Mask | Button5Mask); /* Look inside event queue for pending KeyPress events */ key = 0; keypressed = False; for (i = caml_gr_head; i != caml_gr_tail; i = (i + 1) % SIZE_QUEUE) { if (caml_gr_queue[i].kind == KeyPress) { keypressed = True; key = caml_gr_queue[i].key; break; } } return caml_gr_wait_allocate_result(mouse_x, mouse_y, button, keypressed, key); } static value caml_gr_wait_event_in_queue(long mask) { struct event_data * ev; /* Pop events in queue until one matches mask. */ while (caml_gr_head != caml_gr_tail) { ev = &(caml_gr_queue[caml_gr_head]); caml_gr_head = (caml_gr_head + 1) % SIZE_QUEUE; if ((ev->kind == KeyPress && (mask & KeyPressMask)) || (ev->kind == ButtonPress && (mask & ButtonPressMask)) || (ev->kind == ButtonRelease && (mask & ButtonReleaseMask)) || (ev->kind == MotionNotify && (mask & PointerMotionMask))) return caml_gr_wait_allocate_result(ev->mouse_x, ev->mouse_y, ev->button, ev->kind == KeyPress, ev->key); } return Val_false; } static value caml_gr_wait_event_blocking(long mask) { XEvent event; fd_set readfds; value res; /* First see if we have a matching event in the queue */ res = caml_gr_wait_event_in_queue(mask); if (res != Val_false) return res; /* Increase the selected events if required */ if ((mask & ~caml_gr_selected_events) != 0) { caml_gr_selected_events |= mask; XSelectInput(caml_gr_display, caml_gr_window.win, caml_gr_selected_events); } /* Replenish our event queue from that of X11 */ caml_gr_ignore_sigio = True; while (1) { if (XPending(caml_gr_display)) { /* One event available: add it to our queue */ XNextEvent(caml_gr_display, &event); caml_gr_handle_event(&event); /* See if we now have a matching event */ res = caml_gr_wait_event_in_queue(mask); if (res != Val_false) break; } else { /* No event available: block on input socket until one is */ FD_ZERO(&readfds); FD_SET(ConnectionNumber(caml_gr_display), &readfds); caml_enter_blocking_section(); select(FD_SETSIZE, &readfds, NULL, NULL, NULL); caml_leave_blocking_section(); } caml_gr_check_open(); /* in case the display was closed in the meantime */ } caml_gr_ignore_sigio = False; /* Return result */ return res; } value caml_gr_wait_event(value eventlist) /* ML */ { int mask; Bool poll; caml_gr_check_open(); mask = 0; poll = False; while (eventlist != Val_int(0)) { switch (Int_val(Field(eventlist, 0))) { case 0: /* Button_down */ mask |= ButtonPressMask | OwnerGrabButtonMask; break; case 1: /* Button_up */ mask |= ButtonReleaseMask | OwnerGrabButtonMask; break; case 2: /* Key_pressed */ mask |= KeyPressMask; break; case 3: /* Mouse_motion */ mask |= PointerMotionMask; break; case 4: /* Poll */ poll = True; break; } eventlist = Field(eventlist, 1); } if (poll) return caml_gr_wait_event_poll(); else return caml_gr_wait_event_blocking(mask); } ocaml-graphics-9f1c7c8/src/unix/fill.c000066400000000000000000000064551502374520500177120ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "libgraph.h" #include value caml_gr_fill_rect(value vx, value vy, value vw, value vh) { int x = Int_val(vx); int y = Int_val(vy); int w = Int_val(vw); int h = Int_val(vh); caml_gr_check_open(); if(caml_gr_remember_modeflag) XFillRectangle(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, x, Bcvt(y) - h, w + 1, h + 1); if(caml_gr_display_modeflag) { XFillRectangle(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, x, Wcvt(y) - h, w + 1, h + 1); XFlush(caml_gr_display); } return Val_unit; } value caml_gr_fill_poly(value array) { XPoint * points; int npoints, i; caml_gr_check_open(); npoints = Wosize_val(array); points = (XPoint *) caml_stat_alloc(npoints * sizeof(XPoint)); for (i = 0; i < npoints; i++) { points[i].x = Int_val(Field(Field(array, i), 0)); points[i].y = Bcvt(Int_val(Field(Field(array, i), 1))); } if(caml_gr_remember_modeflag) XFillPolygon(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, points, npoints, Complex, CoordModeOrigin); if(caml_gr_display_modeflag) { for (i = 0; i < npoints; i++) points[i].y = BtoW(points[i].y); XFillPolygon(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, points, npoints, Complex, CoordModeOrigin); XFlush(caml_gr_display); } caml_stat_free((char *) points); return Val_unit; } value caml_gr_fill_arc_nat(value vx, value vy, value vrx, value vry, value va1, value va2) { int x = Int_val(vx); int y = Int_val(vy); int rx = Int_val(vrx); int ry = Int_val(vry); int a1 = Int_val(va1); int a2 = Int_val(va2); caml_gr_check_open(); if(caml_gr_remember_modeflag) XFillArc(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, x - rx, Bcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64); if(caml_gr_display_modeflag) { XFillArc(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, x - rx, Wcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64); XFlush(caml_gr_display); } return Val_unit; } value caml_gr_fill_arc(value *argv, int argc) { return caml_gr_fill_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } ocaml-graphics-9f1c7c8/src/unix/graphicsX11.ml000066400000000000000000000034211502374520500212320ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml *) (* *) (* Pierre Weis and Jun Furuse, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* Module [GraphicsX11]: additional graphics primitives for the X Windows system *) type window_id = string external window_id : unit -> window_id = "caml_gr_window_id" let subwindows = Hashtbl.create 13 external open_subwindow : int -> int -> int -> int -> window_id = "caml_gr_open_subwindow" external close_subwindow : window_id -> unit = "caml_gr_close_subwindow" let open_subwindow ~x ~y ~width ~height = let wid = open_subwindow x y width height in Hashtbl.add subwindows wid (); wid let close_subwindow wid = if Hashtbl.mem subwindows wid then ( close_subwindow wid; Hashtbl.remove subwindows wid) else raise (Graphics.Graphic_failure ("close_subwindow: no such subwindow: " ^ wid)) ocaml-graphics-9f1c7c8/src/unix/graphicsX11.mli000066400000000000000000000031141502374520500214020ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml *) (* *) (* Pierre Weis and Jun Furuse, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Additional graphics primitives for the X Windows system. *) type window_id = string val window_id : unit -> window_id (** Return the unique identifier of the OCaml graphics window. The returned string is an unsigned 32 bits integer in decimal form. *) val open_subwindow : x:int -> y:int -> width:int -> height:int -> window_id (** Create a sub-window of the current OCaml graphics window and return its identifier. *) val close_subwindow : window_id -> unit (** Close the sub-window having the given identifier. *) ocaml-graphics-9f1c7c8/src/unix/image.c000066400000000000000000000074721502374520500200460ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "libgraph.h" #include "image.h" #include #include #include static void caml_gr_free_image(value im) { XFreePixmap(caml_gr_display, Data_im(im)); if (Mask_im(im) != None) XFreePixmap(caml_gr_display, Mask_im(im)); } static struct custom_operations image_ops = { "_image", caml_gr_free_image, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default, custom_compare_ext_default }; #define Max_image_mem 2000000 value caml_gr_new_image(int w, int h) { #if OCAML_VERSION < 40800 value res = caml_alloc_custom(&image_ops, sizeof(struct grimage), w * h, Max_image_mem); #else value res = caml_alloc_custom_mem(&image_ops, sizeof(struct grimage), w * h); #endif Width_im(res) = w; Height_im(res) = h; Data_im(res) = XCreatePixmap(caml_gr_display, caml_gr_window.win, w, h, XDefaultDepth(caml_gr_display, caml_gr_screen)); Mask_im(res) = None; return res; } value caml_gr_create_image(value vw, value vh) { caml_gr_check_open(); return caml_gr_new_image(Int_val(vw), Int_val(vh)); } value caml_gr_blit_image(value im, value vx, value vy) { int x = Int_val(vx); int y = Int_val(vy); caml_gr_check_open(); XCopyArea(caml_gr_display, caml_gr_bstore.win, Data_im(im), caml_gr_bstore.gc, x, Bcvt(y) + 1 - Height_im(im), Width_im(im), Height_im(im), 0, 0); return Val_unit; } value caml_gr_draw_image(value im, value vx, value vy) { int x = Int_val(vx); int y = Int_val(vy); int wy = Wcvt(y) + 1 - Height_im(im); int by = Bcvt(y) + 1 - Height_im(im); caml_gr_check_open(); if (Mask_im(im) != None) { if(caml_gr_remember_modeflag) { XSetClipOrigin(caml_gr_display, caml_gr_bstore.gc, x, by); XSetClipMask(caml_gr_display, caml_gr_bstore.gc, Mask_im(im)); } if(caml_gr_display_modeflag) { XSetClipOrigin(caml_gr_display, caml_gr_window.gc, x, wy); XSetClipMask(caml_gr_display, caml_gr_window.gc, Mask_im(im)); } } if(caml_gr_remember_modeflag) XCopyArea(caml_gr_display, Data_im(im), caml_gr_bstore.win, caml_gr_bstore.gc, 0, 0, Width_im(im), Height_im(im), x, by); if(caml_gr_display_modeflag) XCopyArea(caml_gr_display, Data_im(im), caml_gr_window.win, caml_gr_window.gc, 0, 0, Width_im(im), Height_im(im), x, wy); if (Mask_im(im) != None) { if(caml_gr_remember_modeflag) XSetClipMask(caml_gr_display, caml_gr_bstore.gc, None); if(caml_gr_display_modeflag) XSetClipMask(caml_gr_display, caml_gr_window.gc, None); } if(caml_gr_display_modeflag) XFlush(caml_gr_display); return Val_unit; } ocaml-graphics-9f1c7c8/src/unix/image.h000066400000000000000000000031221502374520500200370ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ struct grimage { int width, height; /* Dimensions of the image */ Pixmap data; /* Pixels */ Pixmap mask; /* Mask for transparent points, or None */ }; #define Width_im(i) (((struct grimage *)Data_custom_val(i))->width) #define Height_im(i) (((struct grimage *)Data_custom_val(i))->height) #define Data_im(i) (((struct grimage *)Data_custom_val(i))->data) #define Mask_im(i) (((struct grimage *)Data_custom_val(i))->mask) #define Transparent (-1) value caml_gr_new_image(int w, int h); ocaml-graphics-9f1c7c8/src/unix/libgraph.h000066400000000000000000000076431502374520500205610ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include #include #include #include #include #include #include struct canvas { int w, h; /* Dimensions of the drawable */ Drawable win; /* The drawable itself */ GC gc; /* The associated graphics context */ }; extern Display * caml_gr_display; /* The display connection */ extern int caml_gr_screen; /* The screen number */ extern Colormap caml_gr_colormap; /* The color map */ extern struct canvas caml_gr_window; /* The graphics window */ extern struct canvas caml_gr_bstore; /* The pixmap used for backing store */ extern int caml_gr_white, caml_gr_black; /* Black and white pixels for X */ extern int caml_gr_background; /* Background color for X (used for CAML color -1) */ extern Bool caml_gr_display_modeflag; /* Display-mode flag */ extern Bool caml_gr_remember_modeflag; /* Remember-mode flag */ extern int caml_gr_x, caml_gr_y; /* Coordinates of the current point */ extern int caml_gr_color; /* Current *CAML* drawing color (can be -1) */ extern XftFont * caml_gr_font; /* Current font */ extern long caml_gr_selected_events; /* Events we are interested in */ extern Bool caml_gr_ignore_sigio; /* Whether to consume events on sigio */ extern Atom caml_wm_delete_window; /* "WM_DELETE_WINDOW" atom */ extern Bool caml_gr_direct_rgb; extern int caml_gr_byte_order; extern int caml_gr_bitmap_unit; extern int caml_gr_bits_per_pixel; #define Wcvt(y) (caml_gr_window.h - 1 - (y)) #define Bcvt(y) (caml_gr_bstore.h - 1 - (y)) #define WtoB(y) ((y) + caml_gr_bstore.h - caml_gr_window.h) #define BtoW(y) ((y) + caml_gr_window.h - caml_gr_bstore.h) #define min(a,b) ((a) < (b) ? (a) : (b)) #define max(a,b) ((a) > (b) ? (a) : (b)) #define DEFAULT_SCREEN_WIDTH 1024 #define DEFAULT_SCREEN_HEIGHT 768 #define BORDER_WIDTH 2 #define DEFAULT_WINDOW_NAME "OCaml graphics" #define DEFAULT_SELECTED_EVENTS \ (ExposureMask | KeyPressMask | StructureNotifyMask) #define DEFAULT_FONT "fixed" #define SIZE_QUEUE 256 /* To handle events asynchronously */ #ifdef HAS_ASYNC_IO #define USE_ASYNC_IO #define EVENT_SIGNAL SIGIO #else #ifdef HAS_SETITIMER #define USE_INTERVAL_TIMER #define EVENT_SIGNAL SIGALRM #else #define USE_ALARM #define EVENT_SIGNAL SIGALRM #endif #endif CAMLnoreturn_start extern void caml_gr_fail(const char *fmt, const char *arg) CAMLnoreturn_end; extern void caml_gr_check_open(void); extern unsigned long caml_gr_pixel_rgb(int rgb); extern int caml_gr_rgb_pixel(long unsigned int pixel); extern void caml_gr_handle_event(XEvent *e); extern void caml_gr_init_color_cache(void); extern void caml_gr_init_direct_rgb_to_pixel(void); extern value caml_gr_id_of_window( Window w ); extern value caml_gr_close_graph(void); ocaml-graphics-9f1c7c8/src/unix/make_img.c000066400000000000000000000071421502374520500205270ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "libgraph.h" #include "image.h" #include value caml_gr_make_image(value m) { int width, height; value im; Bool has_transp; XImage * idata, * imask; char * bdata, * bmask; int i, j, rgb; value line; GC gc; caml_gr_check_open(); height = Wosize_val(m); if (height == 0) return caml_gr_new_image(0, 0); width = Wosize_val(Field(m, 0)); for (i = 1; i < height; i++) if (Wosize_val(Field(m, i)) != width) caml_gr_fail("make_image: lines of different lengths", NULL); /* Build an XImage for the data part of the image */ idata = XCreateImage(caml_gr_display, DefaultVisual(caml_gr_display, caml_gr_screen), XDefaultDepth(caml_gr_display, caml_gr_screen), ZPixmap, 0, NULL, width, height, BitmapPad(caml_gr_display), 0); bdata = (char *) caml_stat_alloc(height * idata->bytes_per_line); idata->data = bdata; has_transp = False; for (i = 0; i < height; i++) { line = Field(m, i); for (j = 0; j < width; j++) { rgb = Int_val(Field(line, j)); if (rgb == Transparent) { has_transp = True; rgb = 0; } XPutPixel(idata, j, i, caml_gr_pixel_rgb(rgb)); } } /* If the matrix contains transparent points, build an XImage for the mask part of the image */ if (has_transp) { imask = XCreateImage(caml_gr_display, DefaultVisual(caml_gr_display, caml_gr_screen), 1, ZPixmap, 0, NULL, width, height, BitmapPad(caml_gr_display), 0); bmask = (char *) caml_stat_alloc(height * imask->bytes_per_line); imask->data = bmask; for (i = 0; i < height; i++) { line = Field(m, i); for (j = 0; j < width; j++) { rgb = Int_val(Field(line, j)); XPutPixel(imask, j, i, rgb != Transparent); } } } else { imask = NULL; } /* Allocate the image and store the XImages into the Pixmaps */ im = caml_gr_new_image(width, height); gc = XCreateGC(caml_gr_display, Data_im(im), 0, NULL); XPutImage(caml_gr_display, Data_im(im), gc, idata, 0, 0, 0, 0, width, height); XDestroyImage(idata); XFreeGC(caml_gr_display, gc); if (has_transp) { Mask_im(im) = XCreatePixmap(caml_gr_display, caml_gr_window.win, width, height, 1); gc = XCreateGC(caml_gr_display, Mask_im(im), 0, NULL); XPutImage(caml_gr_display, Mask_im(im), gc, imask, 0, 0, 0, 0, width, height); XDestroyImage(imask); XFreeGC(caml_gr_display, gc); } XFlush(caml_gr_display); return im; } ocaml-graphics-9f1c7c8/src/unix/open.c000066400000000000000000000321551502374520500177210ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include #include #include #include "libgraph.h" #include #include #include #include #ifdef HAS_UNISTD #include #endif #ifdef HAS_SETITIMER #include #endif Display * caml_gr_display = NULL; int caml_gr_screen; Colormap caml_gr_colormap; int caml_gr_white, caml_gr_black, caml_gr_background; struct canvas caml_gr_window; struct canvas caml_gr_bstore; Bool caml_gr_display_modeflag; Bool caml_gr_remember_modeflag; int caml_gr_x, caml_gr_y; int caml_gr_color; extern XftFont * caml_gr_font; long caml_gr_selected_events; Bool caml_gr_ignore_sigio = False; static Bool caml_gr_initialized = False; static char * window_name = NULL; Atom caml_wm_delete_window; static int caml_gr_error_handler(Display *display, XErrorEvent *error); static int caml_gr_ioerror_handler(Display *display); value caml_gr_clear_graph(void); value caml_gr_open_graph(value arg) { char display_name[256], geometry_spec[64]; const char * p; char * q; XSizeHints hints; int ret; XEvent event; int x, y, w, h; XWindowAttributes attributes; if (caml_gr_initialized) { caml_gr_clear_graph(); } else { /* Parse the argument */ for (p = String_val(arg), q = display_name; *p != 0 && *p != ' '; p++) if (q < display_name + sizeof(display_name) - 1) *q++ = *p; *q = 0; while (*p == ' ') p++; for (q = geometry_spec; *p != 0; p++) if (q < geometry_spec + sizeof(geometry_spec) - 1) *q++ = *p; *q = 0; /* Open the display */ if (caml_gr_display == NULL) { caml_gr_display = XOpenDisplay(display_name); if (caml_gr_display == NULL) caml_gr_fail("Cannot open display %s", XDisplayName(display_name)); caml_gr_screen = DefaultScreen(caml_gr_display); caml_gr_black = BlackPixel(caml_gr_display, caml_gr_screen); caml_gr_white = WhitePixel(caml_gr_display, caml_gr_screen); caml_gr_background = caml_gr_white; caml_gr_colormap = DefaultColormap(caml_gr_display, caml_gr_screen); } /* Set up the error handlers */ XSetErrorHandler(caml_gr_error_handler); XSetIOErrorHandler(caml_gr_ioerror_handler); /* Parse the geometry specification */ hints.x = 0; hints.y = 0; hints.width = DEFAULT_SCREEN_WIDTH; hints.height = DEFAULT_SCREEN_HEIGHT; hints.flags = PPosition | PSize; hints.win_gravity = 0; ret = XWMGeometry(caml_gr_display, caml_gr_screen, geometry_spec, "", BORDER_WIDTH, &hints, &x, &y, &w, &h, &hints.win_gravity); if (ret & (XValue | YValue)) { hints.x = x; hints.y = y; hints.flags |= USPosition; } if (ret & (WidthValue | HeightValue)) { hints.width = w; hints.height = h; hints.flags |= USSize; } /* Initial drawing color is black */ caml_gr_color = 0; /* CAML COLOR */ /* Create the on-screen window */ caml_gr_window.w = hints.width; caml_gr_window.h = hints.height; caml_gr_window.win = XCreateSimpleWindow(caml_gr_display, DefaultRootWindow(caml_gr_display), hints.x, hints.y, hints.width, hints.height, BORDER_WIDTH, caml_gr_black, caml_gr_background); p = window_name; if (p == NULL) p = DEFAULT_WINDOW_NAME; /* What not use XSetWMProperties? */ XSetStandardProperties(caml_gr_display, caml_gr_window.win, p, p, None, NULL, 0, &hints); /* Handle "please delete window" requests from window manager */ caml_wm_delete_window = XInternAtom(caml_gr_display, "WM_DELETE_WINDOW", False); XSetWMProtocols(caml_gr_display, caml_gr_window.win, &caml_wm_delete_window, 1); caml_gr_window.gc = XCreateGC(caml_gr_display, caml_gr_window.win, 0, NULL); XSetBackground(caml_gr_display, caml_gr_window.gc, caml_gr_background); XSetForeground(caml_gr_display, caml_gr_window.gc, caml_gr_black); /* Require exposure, resize and keyboard events */ caml_gr_selected_events = DEFAULT_SELECTED_EVENTS; XSelectInput(caml_gr_display, caml_gr_window.win, caml_gr_selected_events); /* Map the window on the screen and wait for the first Expose event */ XMapWindow(caml_gr_display, caml_gr_window.win); do { XNextEvent(caml_gr_display, &event); } while (event.type != Expose); /* Get the actual window dimensions */ XGetWindowAttributes(caml_gr_display, caml_gr_window.win, &attributes); caml_gr_window.w = attributes.width; caml_gr_window.h = attributes.height; /* Create the pixmap used for backing store */ caml_gr_bstore.w = caml_gr_window.w; caml_gr_bstore.h = caml_gr_window.h; caml_gr_bstore.win = XCreatePixmap(caml_gr_display, caml_gr_window.win, caml_gr_bstore.w, caml_gr_bstore.h, XDefaultDepth(caml_gr_display, caml_gr_screen)); caml_gr_bstore.gc = XCreateGC(caml_gr_display, caml_gr_bstore.win, 0, NULL); XSetBackground(caml_gr_display, caml_gr_bstore.gc, caml_gr_background); /* Clear the pixmap */ XSetForeground(caml_gr_display, caml_gr_bstore.gc, caml_gr_background); XFillRectangle(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, 0, 0, caml_gr_bstore.w, caml_gr_bstore.h); XSetForeground(caml_gr_display, caml_gr_bstore.gc, caml_gr_black); /* Set the display and remember modes on */ caml_gr_display_modeflag = True ; caml_gr_remember_modeflag = True ; /* The global data structures are now correctly initialized. In particular, caml_gr_sigio_handler can now handle events safely. */ caml_gr_initialized = True; /* If possible, request that system calls be restarted after the EVENT_SIGNAL signal. */ #ifdef POSIX_SIGNALS #ifdef SA_RESTART { struct sigaction action; sigaction(EVENT_SIGNAL, NULL, &action); action.sa_flags |= SA_RESTART; sigaction(EVENT_SIGNAL, &action, NULL); } #endif #endif #ifdef USE_ASYNC_IO /* If BSD-style asynchronous I/O are supported: arrange for I/O on the connection to trigger the SIGIO signal */ ret = fcntl(ConnectionNumber(caml_gr_display), F_GETFL, 0); fcntl(ConnectionNumber(caml_gr_display), F_SETFL, ret | FASYNC); fcntl(ConnectionNumber(caml_gr_display), F_SETOWN, getpid()); #endif } #ifdef USE_INTERVAL_TIMER /* If BSD-style interval timers are provided, use the real-time timer to poll events. */ { struct itimerval it; it.it_interval.tv_sec = 0; it.it_interval.tv_usec = 250000; it.it_value.tv_sec = 0; it.it_value.tv_usec = 250000; setitimer(ITIMER_REAL, &it, NULL); } #endif #ifdef USE_ALARM /* The poor man's solution: use alarm to poll events. */ alarm(1); #endif /* Position the current point at origin */ caml_gr_x = 0; caml_gr_y = 0; /* Reset the color cache */ caml_gr_init_color_cache(); caml_gr_init_direct_rgb_to_pixel(); return Val_unit; } value caml_gr_close_graph(void) { if (caml_gr_initialized) { #ifdef USE_INTERVAL_TIMER struct itimerval it; it.it_value.tv_sec = 0; it.it_value.tv_usec = 0; setitimer(ITIMER_REAL, &it, NULL); #endif caml_gr_initialized = False; if (caml_gr_font != NULL) { XftFontClose(caml_gr_display, caml_gr_font); caml_gr_font = NULL; } XFreeGC(caml_gr_display, caml_gr_window.gc); XDestroyWindow(caml_gr_display, caml_gr_window.win); XFreeGC(caml_gr_display, caml_gr_bstore.gc); XFreePixmap(caml_gr_display, caml_gr_bstore.win); XFlush(caml_gr_display); XCloseDisplay (caml_gr_display); caml_gr_display = NULL; } return Val_unit; } value caml_gr_id_of_window(Window win) { char tmp[256]; sprintf(tmp, "%lu", (unsigned long)win); return caml_copy_string( tmp ); } value caml_gr_window_id(void) { caml_gr_check_open(); return caml_gr_id_of_window(caml_gr_window.win); } value caml_gr_set_window_title(value n) { if (window_name != NULL) caml_stat_free(window_name); window_name = caml_stat_strdup(String_val(n)); if (caml_gr_initialized) { XStoreName(caml_gr_display, caml_gr_window.win, window_name); XSetIconName(caml_gr_display, caml_gr_window.win, window_name); XFlush(caml_gr_display); } return Val_unit; } value caml_gr_resize_window (value vx, value vy) { caml_gr_check_open (); caml_gr_window.w = Int_val (vx); caml_gr_window.h = Int_val (vy); XResizeWindow (caml_gr_display, caml_gr_window.win, caml_gr_window.w, caml_gr_window.h); XFreeGC(caml_gr_display, caml_gr_bstore.gc); XFreePixmap(caml_gr_display, caml_gr_bstore.win); caml_gr_bstore.w = caml_gr_window.w; caml_gr_bstore.h = caml_gr_window.h; caml_gr_bstore.win = XCreatePixmap(caml_gr_display, caml_gr_window.win, caml_gr_bstore.w, caml_gr_bstore.h, XDefaultDepth(caml_gr_display, caml_gr_screen)); caml_gr_bstore.gc = XCreateGC(caml_gr_display, caml_gr_bstore.win, 0, NULL); XSetBackground(caml_gr_display, caml_gr_bstore.gc, caml_gr_background); caml_gr_clear_graph (); return Val_unit; } value caml_gr_clear_graph(void) { caml_gr_check_open(); if(caml_gr_remember_modeflag) { XSetForeground(caml_gr_display, caml_gr_bstore.gc, caml_gr_white); XFillRectangle(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, 0, 0, caml_gr_bstore.w, caml_gr_bstore.h); XSetForeground(caml_gr_display, caml_gr_bstore.gc, caml_gr_color); } if(caml_gr_display_modeflag) { XSetForeground(caml_gr_display, caml_gr_window.gc, caml_gr_white); XFillRectangle(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, 0, 0, caml_gr_window.w, caml_gr_window.h); XSetForeground(caml_gr_display, caml_gr_window.gc, caml_gr_color); XFlush(caml_gr_display); } caml_gr_init_color_cache(); caml_gr_init_direct_rgb_to_pixel(); return Val_unit; } value caml_gr_size_x(void) { caml_gr_check_open(); return Val_int(caml_gr_window.w); } value caml_gr_size_y(void) { caml_gr_check_open(); return Val_int(caml_gr_window.h); } value caml_gr_synchronize(void) { caml_gr_check_open(); XCopyArea(caml_gr_display, caml_gr_bstore.win, caml_gr_window.win, caml_gr_window.gc, 0, caml_gr_bstore.h - caml_gr_window.h, caml_gr_window.w, caml_gr_window.h, 0, 0); XFlush(caml_gr_display); return Val_unit ; } value caml_gr_display_mode(value flag) { caml_gr_display_modeflag = Bool_val (flag); return Val_unit ; } value caml_gr_remember_mode(value flag) { caml_gr_remember_modeflag = Bool_val(flag); return Val_unit ; } /* The caml_gr_sigio_handler is called via the signal machinery in the bytecode interpreter. The signal system ensures that this function will be called either between two bytecode instructions, or during a blocking primitive. In either case, not in the middle of an Xlib call. */ value caml_gr_sigio_signal(value unit) { return Val_int(EVENT_SIGNAL); } value caml_gr_sigio_handler(void) { XEvent grevent; if (caml_gr_initialized && !caml_gr_ignore_sigio) { while (XPending(caml_gr_display)) { XNextEvent(caml_gr_display, &grevent); caml_gr_handle_event(&grevent); } } #ifdef USE_ALARM alarm(1); #endif return Val_unit; } /* Processing of graphic errors */ static const value * graphic_failure_exn = NULL; void caml_gr_fail(const char *fmt, const char *arg) { char buffer[1024]; if (graphic_failure_exn == NULL) { graphic_failure_exn = caml_named_value("Graphics.Graphic_failure"); if (graphic_failure_exn == NULL) caml_invalid_argument("Exception Graphics.Graphic_failure not " "initialized, must link graphics.cma"); } sprintf(buffer, fmt, arg); caml_raise_with_string(*graphic_failure_exn, buffer); } void caml_gr_check_open(void) { if (!caml_gr_initialized) caml_gr_fail("graphic screen not opened", NULL); } static int caml_gr_error_handler(Display *display, XErrorEvent *error) { char errmsg[512]; XGetErrorText(error->display, error->error_code, errmsg, sizeof(errmsg)); caml_gr_fail("Xlib error: %s", errmsg); return 0; } static int caml_gr_ioerror_handler(Display *display) { caml_gr_fail("fatal I/O error", NULL); return 0; } ocaml-graphics-9f1c7c8/src/unix/point_col.c000066400000000000000000000026461502374520500207500ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "libgraph.h" value caml_gr_point_color(value vx, value vy) { int x = Int_val(vx); int y = Int_val(vy); XImage * im; int rgb; caml_gr_check_open(); im = XGetImage(caml_gr_display, caml_gr_bstore.win, x, Bcvt(y), 1, 1, (-1), ZPixmap); rgb = caml_gr_rgb_pixel(XGetPixel(im, 0, 0)); XDestroyImage(im); return Val_int(rgb); } ocaml-graphics-9f1c7c8/src/unix/sound.c000066400000000000000000000032571502374520500201110ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "libgraph.h" value caml_gr_sound(value vfreq, value vdur) { XKeyboardControl kbdcontrol; caml_gr_check_open(); kbdcontrol.bell_pitch = Int_val(vfreq); kbdcontrol.bell_duration = Int_val(vdur); XChangeKeyboardControl(caml_gr_display, KBBellPitch | KBBellDuration, &kbdcontrol); XBell(caml_gr_display, 0); kbdcontrol.bell_pitch = -1; /* restore default value */ kbdcontrol.bell_duration = -1; /* restore default value */ XChangeKeyboardControl(caml_gr_display, KBBellPitch | KBBellDuration, &kbdcontrol); XFlush(caml_gr_display); return Val_unit; } ocaml-graphics-9f1c7c8/src/unix/subwindow.c000066400000000000000000000034551502374520500210020ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Jun Furuse, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2001 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "libgraph.h" value caml_gr_open_subwindow(value vx, value vy, value width, value height) { Window win; int h = Int_val(height); int w = Int_val(width); int x = Int_val(vx); int y = Int_val(vy); caml_gr_check_open(); win = XCreateSimpleWindow(caml_gr_display, caml_gr_window.win, x, Wcvt(y + h), w, h, 0, caml_gr_black, caml_gr_background); XMapWindow(caml_gr_display, win); XFlush(caml_gr_display); return (caml_gr_id_of_window (win)); } value caml_gr_close_subwindow(value wid) { Window win; caml_gr_check_open(); sscanf( String_val(wid), "%lu", (unsigned long *)(&win) ); XDestroyWindow(caml_gr_display, win); XFlush(caml_gr_display); return Val_unit; } ocaml-graphics-9f1c7c8/src/unix/text.c000066400000000000000000000074521502374520500177460ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "libgraph.h" #include XftFont * caml_gr_font = NULL; static void caml_gr_get_font(const char *fontname) { XftFont * font; /* Is it a X Logical Font Description? LFDs start with a '-' character. * If not, use nicer FontConfig names like "Courier-12". */ if (fontname[0] == '-') font = XftFontOpenXlfd (caml_gr_display, caml_gr_screen, fontname); else font = XftFontOpenName (caml_gr_display, caml_gr_screen, fontname); if (font == NULL) caml_gr_fail("cannot find font %s", fontname); if (caml_gr_font != NULL) XftFontClose (caml_gr_display, caml_gr_font); caml_gr_font = font; } value caml_gr_set_font(value fontname) { caml_gr_check_open(); caml_gr_get_font(String_val(fontname)); return Val_unit; } value caml_gr_set_text_size (value sz) { return Val_unit; } static void caml_gr_draw_text(const char *txt, int len) { int rgb; XftColor xftcol; XftDraw *d; Visual *visual = DefaultVisual (caml_gr_display, caml_gr_screen); XGlyphInfo info; rgb = caml_gr_rgb_pixel (caml_gr_color); xftcol.pixel = rgb; /* The range of these fields is 0..0xffff */ xftcol.color.red = rgb >> 8;; xftcol.color.green = (rgb & 0xff00); xftcol.color.blue = (rgb & 0xff) << 8; xftcol.color.alpha = 0xffff; if (caml_gr_font == NULL) caml_gr_get_font(DEFAULT_FONT); if (caml_gr_remember_modeflag) { d = XftDrawCreate (caml_gr_display, caml_gr_bstore.win, visual, caml_gr_colormap); XftDrawString8 (d, &xftcol, caml_gr_font, caml_gr_x, Bcvt(caml_gr_y) - caml_gr_font->descent + 1, (const FcChar8 *) txt, len); XftDrawDestroy (d); } if (caml_gr_display_modeflag) { d = XftDrawCreate (caml_gr_display, caml_gr_window.win, visual, caml_gr_colormap); XftDrawString8 (d, &xftcol, caml_gr_font, caml_gr_x, Wcvt(caml_gr_y) - caml_gr_font->descent + 1, (const FcChar8 *) txt, len); XFlush(caml_gr_display); XftDrawDestroy (d); } XftTextExtents8 (caml_gr_display, caml_gr_font, (const FcChar8 *) txt, len, &info); caml_gr_x += info.width; } value caml_gr_draw_char(value chr) { char str[1]; caml_gr_check_open(); str[0] = Int_val(chr); caml_gr_draw_text(str, 1); return Val_unit; } value caml_gr_draw_string(value str) { caml_gr_check_open(); caml_gr_draw_text(String_val(str), caml_string_length(str)); return Val_unit; } value caml_gr_text_size(value str) { XGlyphInfo info; value res; caml_gr_check_open(); if (caml_gr_font == NULL) caml_gr_get_font(DEFAULT_FONT); XftTextExtents8 (caml_gr_display, caml_gr_font, (const FcChar8 *) (String_val(str)), caml_string_length(str), &info); res = caml_alloc_small(2, 0); Field(res, 0) = Val_int(info.width); Field(res, 1) = Val_int(info.height); return res; } ocaml-graphics-9f1c7c8/src/win32/000077500000000000000000000000001502374520500165655ustar00rootroot00000000000000ocaml-graphics-9f1c7c8/src/win32/draw.c000066400000000000000000000513161502374520500176740ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Developed by Jacob Navia, based on code by J-M Geffroy and X Leroy */ /* */ /* Copyright 2001 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include #include "caml/mlvalues.h" #include "caml/alloc.h" #include "caml/fail.h" #include "libgraph.h" #include "caml/custom.h" #include "caml/memory.h" #include "caml/version.h" HDC gcMetaFile; GR_WINDOW grwindow; static void GetCurrentPosition(HDC hDC,POINT *pt) { MoveToEx(hDC,0,0,pt); MoveToEx(hDC,pt->x,pt->y,0); } static value gr_draw_or_fill_arc(value vx, value vy, value vrx, value vry, value vstart, value vend, BOOL fill); CAMLprim value caml_gr_plot(value vx, value vy) { int x = Int_val(vx); int y = Int_val(vy); gr_check_open(); if(grremember_mode) SetPixel(grwindow.gcBitmap, x, Wcvt(y),grwindow.CurrentColor); if(grdisplay_mode) { SetPixel(grwindow.gc, x, Wcvt(y),grwindow.CurrentColor); } return Val_unit; } CAMLprim value caml_gr_moveto(value vx, value vy) { grwindow.grx = Int_val(vx); grwindow.gry = Int_val(vy); if(grremember_mode) MoveToEx(grwindow.gcBitmap,grwindow.grx,Wcvt(grwindow.gry),0); if (grdisplay_mode) MoveToEx(grwindow.gc,grwindow.grx,Wcvt(grwindow.gry),0); return Val_unit; } CAMLprim value caml_gr_current_x(value unit) { return Val_int(grwindow.grx); } CAMLprim value caml_gr_current_y(value unit) { return Val_int(grwindow.gry); } CAMLprim value caml_gr_lineto(value vx, value vy) { int x = Int_val(vx); int y = Int_val(vy); gr_check_open(); SelectObject(grwindow.gc,grwindow.CurrentPen); SelectObject(grwindow.gcBitmap,grwindow.CurrentPen); if (grremember_mode) LineTo(grwindow.gcBitmap,x,Wcvt(y)); if (grdisplay_mode) LineTo(grwindow.gc, x, Wcvt(y)); grwindow.grx = x; grwindow.gry = y; return Val_unit; } CAMLprim value caml_gr_draw_rect(value vx, value vy, value vw, value vh) { int x, y, w, h; POINT pt[5]; x=Int_val(vx); y=Wcvt(Int_val(vy)); w=Int_val(vw); h=Int_val(vh); pt[0].x = x; pt[0].y = y - h; pt[1].x = x + w; pt[1].y = y - h; pt[2].x = x + w; pt[2].y = y; pt[3].x = x; pt[3].y = y; pt[4].x = x; pt[4].y = y - h; if (grremember_mode) { Polyline(grwindow.gcBitmap,pt, 5); } if (grdisplay_mode) { Polyline(grwindow.gc,pt, 5); } return Val_unit; } CAMLprim value caml_gr_draw_text(value text,value x) { POINT pt; int oldmode = SetBkMode(grwindow.gc,TRANSPARENT); SetBkMode(grwindow.gcBitmap,TRANSPARENT); SetTextAlign(grwindow.gcBitmap, TA_UPDATECP|TA_BOTTOM); SetTextAlign(grwindow.gc, TA_UPDATECP|TA_BOTTOM); if (grremember_mode) { TextOutA(grwindow.gcBitmap,0,0,String_val(text),x); } if(grdisplay_mode) { TextOutA(grwindow.gc,0,0,String_val(text),x); } GetCurrentPosition(grwindow.gc,&pt); grwindow.grx = pt.x; grwindow.gry = grwindow.height - pt.y; SetBkMode(grwindow.gc,oldmode); SetBkMode(grwindow.gcBitmap,oldmode); return Val_unit; } CAMLprim value caml_gr_fill_rect(value vx, value vy, value vw, value vh) { int x = Int_val(vx); int y = Int_val(vy); int w = Int_val(vw); int h = Int_val(vh); RECT rc; gr_check_open(); rc.left = x; rc.top = Wcvt(y); rc.right = x+w; rc.bottom = Wcvt(y)-h; if (grdisplay_mode) FillRect(grwindow.gc,&rc,grwindow.CurrentBrush); if (grremember_mode) FillRect(grwindow.gcBitmap,&rc,grwindow.CurrentBrush); return Val_unit; } CAMLprim value caml_gr_sound(value freq, value vdur) { Beep(freq,vdur); return Val_unit; } CAMLprim value caml_gr_point_color(value vx, value vy) { int x = Int_val(vx); int y = Int_val(vy); COLORREF rgb; unsigned long b,g,r; gr_check_open(); rgb = GetPixel(grwindow.gcBitmap,x,Wcvt(y)); b = (unsigned long)((rgb & 0xFF0000) >> 16); g = (unsigned long)((rgb & 0x00FF00) >> 8); r = (unsigned long)(rgb & 0x0000FF); return Val_long((r<<16) + (g<<8) + b); } CAMLprim value caml_gr_circle(value x,value y,value radius) { int left,top,right,bottom; gr_check_open(); left = x - radius/2; top = Wcvt(y) - radius/2; right = left+radius; bottom = top+radius; Ellipse(grwindow.gcBitmap,left,top,right,bottom); return Val_unit; } CAMLprim value caml_gr_set_window_title(value text) { SetWindowTextA(grwindow.hwnd,(char *)text); return Val_unit; } CAMLprim value caml_gr_draw_arc(value *argv, int argc) { return gr_draw_or_fill_arc(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], FALSE); } CAMLprim value caml_gr_draw_arc_nat(value vx, value vy, value vrx, value vry, value vstart, value vend) { return gr_draw_or_fill_arc(vx, vy, vrx, vry, vstart, vend, FALSE); } CAMLprim value caml_gr_set_line_width(value vwidth) { int width = Int_val(vwidth); HPEN oldPen,newPen; gr_check_open(); oldPen = grwindow.CurrentPen; newPen = CreatePen(PS_SOLID,width,grwindow.CurrentColor); SelectObject(grwindow.gcBitmap,newPen); SelectObject(grwindow.gc,newPen); DeleteObject(oldPen); grwindow.CurrentPen = newPen; return Val_unit; } CAMLprim value caml_gr_set_color(value vcolor) { HBRUSH oldBrush, newBrush; LOGBRUSH lb; LOGPEN pen; HPEN newPen; int color = Long_val(vcolor); int r = (color & 0xFF0000) >> 16, g = (color & 0x00FF00) >> 8 , b = color & 0x0000FF; COLORREF c = RGB(r,g,b); memset(&lb,0,sizeof(lb)); memset(&pen,0,sizeof(LOGPEN)); gr_check_open(); GetObject(grwindow.CurrentPen,sizeof(LOGPEN),&pen); pen.lopnColor = c; newPen = CreatePenIndirect(&pen); SelectObject(grwindow.gcBitmap,newPen); SelectObject(grwindow.gc,newPen); DeleteObject(grwindow.CurrentPen); grwindow.CurrentPen = newPen; SetTextColor(grwindow.gc,c); SetTextColor(grwindow.gcBitmap,c); oldBrush = grwindow.CurrentBrush; lb.lbStyle = BS_SOLID; lb.lbColor = c; newBrush = CreateBrushIndirect(&lb); SelectObject(grwindow.gc,newBrush); SelectObject(grwindow.gcBitmap,newBrush); DeleteObject(oldBrush); grwindow.CurrentBrush = newBrush; grwindow.CurrentColor = c; return Val_unit; } static value gr_draw_or_fill_arc(value vx, value vy, value vrx, value vry, value vstart, value vend, BOOL fill) { int x, y, r_x, r_y, start, end; int x1, y1, x2, y2, x3, y3, x4, y4; double cvt = 3.141592653/180.0; r_x = Int_val(vrx); r_y = Int_val(vry); if ((r_x < 0) || (r_y < 0)) caml_invalid_argument("draw_arc: radius must be positive"); x = Int_val(vx); y = Int_val(vy); start = Int_val(vstart); end = Int_val(vend); // Upper-left corner of bounding rect. x1= x - r_x; y1= y + r_y; // Lower-right corner of bounding rect. x2= x + r_x; y2= y - r_y; // Starting point x3=x + (int)(100.0*cos(cvt*start)); y3=y + (int)(100.0*sin(cvt*start)); // Ending point x4=x + (int)(100.0*cos(cvt*end)); y4=y + (int)(100.0*sin(cvt*end)); if (grremember_mode) { SelectObject(grwindow.gcBitmap,grwindow.CurrentPen); SelectObject(grwindow.gcBitmap,grwindow.CurrentBrush); if( fill ) Pie(grwindow.gcBitmap,x1, Wcvt(y1), x2, Wcvt(y2), x3, Wcvt(y3), x4, Wcvt(y4)); else Arc(grwindow.gcBitmap,x1, Wcvt(y1), x2, Wcvt(y2), x3, Wcvt(y3), x4, Wcvt(y4)); } if( grdisplay_mode ) { SelectObject(grwindow.gc,grwindow.CurrentPen); SelectObject(grwindow.gc,grwindow.CurrentBrush); if (fill) Pie(grwindow.gc,x1, Wcvt(y1), x2, Wcvt(y2), x3, Wcvt(y3), x4, Wcvt(y4)); else Arc(grwindow.gc,x1, Wcvt(y1), x2, Wcvt(y2), x3, Wcvt(y3), x4, Wcvt(y4)); } return Val_unit; } CAMLprim value caml_gr_get_mousex(value unit) { POINT pt; GetCursorPos(&pt); MapWindowPoints(HWND_DESKTOP,grwindow.hwnd,&pt,1); return pt.x; } CAMLprim value caml_gr_get_mousey(value unit) { POINT pt; GetCursorPos(&pt); MapWindowPoints(HWND_DESKTOP,grwindow.hwnd,&pt,1); return grwindow.height - pt.y - 1; } static void gr_font(const char *fontname) { HFONT hf = CreationFont(fontname); if (hf && hf != INVALID_HANDLE_VALUE) { HFONT oldFont = SelectObject(grwindow.gc,hf); SelectObject(grwindow.gcBitmap,hf); DeleteObject(grwindow.CurrentFont); grwindow.CurrentFont = hf; } } CAMLprim value caml_gr_set_font(value fontname) { gr_check_open(); gr_font(String_val(fontname)); return Val_unit; } CAMLprim value caml_gr_set_text_size (value sz) { return Val_unit; } CAMLprim value caml_gr_draw_char(value chr) { char str[1]; gr_check_open(); str[0] = Int_val(chr); caml_gr_draw_text((value)str, 1); return Val_unit; } CAMLprim value caml_gr_draw_string(value str) { gr_check_open(); caml_gr_draw_text(str, caml_string_length(str)); return Val_unit; } CAMLprim value caml_gr_text_size(value str) { SIZE extent; value res; mlsize_t len = caml_string_length(str); if (len > 32767) len = 32767; GetTextExtentPointA(grwindow.gc,String_val(str), len,&extent); res = caml_alloc_tuple(2); Field(res, 0) = Val_long(extent.cx); Field(res, 1) = Val_long(extent.cy); return res; } CAMLprim value caml_gr_fill_poly(value vect) { int n_points, i; POINT *p,*poly; n_points = Wosize_val(vect); if (n_points < 3) gr_fail("fill_poly: not enough points",0); poly = (POINT *)caml_stat_alloc(n_points*sizeof(POINT)); p = poly; for( i = 0; i < n_points; i++ ){ p->x = Int_val(Field(Field(vect,i),0)); p->y = Wcvt(Int_val(Field(Field(vect,i),1))); p++; } if (grremember_mode) { SelectObject(grwindow.gcBitmap,grwindow.CurrentBrush); Polygon(grwindow.gcBitmap,poly,n_points); } if (grdisplay_mode) { SelectObject(grwindow.gcBitmap,grwindow.CurrentBrush); Polygon(grwindow.gc,poly,n_points); } caml_stat_free(poly); return Val_unit; } CAMLprim value caml_gr_fill_arc(value *argv, int argc) { return gr_draw_or_fill_arc(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], TRUE); } CAMLprim value caml_gr_fill_arc_nat(value vx, value vy, value vrx, value vry, value vstart, value vend) { return gr_draw_or_fill_arc(vx, vy, vrx, vry, vstart, vend, TRUE); } // Image primitives struct image { int w; int h; HBITMAP data; HBITMAP mask; }; #define Width(i) (((struct image *)Data_custom_val(i))->w) #define Height(i) (((struct image *)Data_custom_val(i))->h) #define Data(i) (((struct image *)Data_custom_val(i))->data) #define Mask(i) (((struct image *)Data_custom_val(i))->mask) #define Max_image_mem 2000000 static void finalize_image (value i) { DeleteObject (Data(i)); if (Mask(i) != NULL) DeleteObject(Mask(i)); } static struct custom_operations image_ops = { "_image", finalize_image, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default, custom_compare_ext_default, custom_fixed_length_default }; CAMLprim value caml_gr_create_image(value vw, value vh) { HBITMAP cbm; value res; int w = Int_val(vw); int h = Int_val(vh); if (w < 0 || h < 0) gr_fail("create_image: width and height must be positive",0); cbm = CreateCompatibleBitmap(grwindow.gc, w, h); if (cbm == NULL) gr_fail("create_image: cannot create bitmap", 0); #if OCAML_VERSION < 40800 res = caml_alloc_custom(&image_ops, sizeof(struct image), w * h, Max_image_mem); #else res = caml_alloc_custom_mem(&image_ops, sizeof(struct image), w * h); #endif if (res) { Width (res) = w; Height (res) = h; Data (res) = cbm; Mask (res) = NULL; } return res; } CAMLprim value caml_gr_blit_image (value i, value x, value y) { HBITMAP oldBmp = SelectObject(grwindow.tempDC,Data(i)); int xsrc = Int_val(x); int ysrc = Wcvt(Int_val(y) + Height(i) - 1); BitBlt(grwindow.tempDC,0, 0, Width(i), Height(i), grwindow.gcBitmap, xsrc, ysrc, SRCCOPY); SelectObject(grwindow.tempDC,oldBmp); return Val_unit; } CAMLprim value caml_gr_draw_image(value i, value x, value y) { HBITMAP oldBmp; int xdst = Int_val(x); int ydst = Wcvt(Int_val(y)+Height(i)-1); if (Mask(i) == NULL) { if (grremember_mode) { oldBmp = SelectObject(grwindow.tempDC,Data(i)); BitBlt(grwindow.gcBitmap,xdst, ydst, Width(i), Height(i), grwindow.tempDC, 0, 0, SRCCOPY); SelectObject(grwindow.tempDC,oldBmp); } if (grdisplay_mode) { oldBmp = SelectObject(grwindow.tempDC,Data(i)); BitBlt(grwindow.gc,xdst, ydst, Width(i), Height(i), grwindow.tempDC, 0, 0, SRCCOPY); SelectObject(grwindow.tempDC,oldBmp); } } else { if (grremember_mode) { oldBmp = SelectObject(grwindow.tempDC,Mask(i)); BitBlt(grwindow.gcBitmap,xdst, ydst, Width(i), Height(i), grwindow.tempDC, 0, 0, SRCAND); SelectObject(grwindow.tempDC,Data(i)); BitBlt(grwindow.gcBitmap,xdst, ydst, Width(i), Height(i), grwindow.tempDC, 0, 0, SRCPAINT); SelectObject(grwindow.tempDC,oldBmp); } if (grdisplay_mode) { oldBmp = SelectObject(grwindow.tempDC,Mask(i)); BitBlt(grwindow.gc,xdst, ydst, Width(i), Height(i), grwindow.tempDC, 0, 0, SRCAND); SelectObject(grwindow.tempDC,Data(i)); BitBlt(grwindow.gc,xdst, ydst, Width(i), Height(i), grwindow.tempDC, 0, 0, SRCPAINT); SelectObject(grwindow.tempDC,oldBmp); } } return Val_unit; } CAMLprim value caml_gr_make_image(value matrix) { int width, height,has_transp,i,j; value img; HBITMAP oldBmp; height = Wosize_val(matrix); if (height == 0) { width = 0; } else { width = Wosize_val(Field(matrix, 0)); for (i = 1; i < height; i++) { if (width != (int) Wosize_val(Field(matrix, i))) gr_fail("make_image: non-rectangular matrix",0); } } Begin_roots1(matrix) img = caml_gr_create_image(Val_int(width), Val_int(height)); End_roots(); has_transp = 0; oldBmp = SelectObject(grwindow.tempDC,Data(img)); for (i = 0; i < height; i++) { for (j = 0; j < width; j++) { int col = Long_val (Field (Field (matrix, i), j)); if (col == -1){ has_transp = 1; SetPixel(grwindow.tempDC,j, i, 0); } else { int red = (col >> 16) & 0xFF; int green = (col >> 8) & 0xFF; int blue = col & 0xFF; SetPixel(grwindow.tempDC,j, i, RGB(red, green, blue)); } } } SelectObject(grwindow.tempDC,oldBmp); if (has_transp) { HBITMAP cbm; cbm = CreateCompatibleBitmap(grwindow.gc, width, height); Mask(img) = cbm; oldBmp = SelectObject(grwindow.tempDC,Mask(img)); for (i = 0; i < height; i++) { for (j = 0; j < width; j++) { int col = Long_val (Field (Field (matrix,i),j)); SetPixel(grwindow.tempDC,j, i, col == -1 ? 0xFFFFFF : 0); } } SelectObject(grwindow.tempDC,oldBmp); } return img; } static value alloc_int_vect(mlsize_t size) { value res; mlsize_t i; if (size == 0) return Atom(0); if (size <= Max_young_wosize) { res = caml_alloc(size, 0); } else { res = caml_alloc_shr(size, 0); } for (i = 0; i < size; i++) { Field(res, i) = Val_long(0); } return res; } CAMLprim value caml_gr_dump_image (value img) { int height = Height(img); int width = Width(img); value matrix = Val_unit; int i, j; HBITMAP oldBmp; Begin_roots2(img, matrix) matrix = alloc_int_vect (height); for (i = 0; i < height; i++) { caml_modify (&Field (matrix, i), alloc_int_vect (width)); } End_roots(); oldBmp = SelectObject(grwindow.tempDC,Data(img)); for (i = 0; i < height; i++) { for (j = 0; j < width; j++) { int col = GetPixel(grwindow.tempDC,j, i); int blue = (col >> 16) & 0xFF; int green = (col >> 8) & 0xFF; int red = col & 0xFF; Field(Field(matrix, i), j) = Val_long((red << 16) + (green << 8) + blue); } } SelectObject(grwindow.tempDC,oldBmp); if (Mask(img) != NULL) { oldBmp = SelectObject(grwindow.tempDC,Mask(img)); for (i = 0; i < height; i++) { for (j = 0; j < width; j++) { if (GetPixel(grwindow.tempDC,j, i) != 0) Field(Field(matrix, i), j) = Val_long(-1); } } SelectObject(grwindow.tempDC,oldBmp); } return matrix; } ocaml-graphics-9f1c7c8/src/win32/events.c000066400000000000000000000150651502374520500202440ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2004 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include "caml/mlvalues.h" #include "caml/alloc.h" #include "libgraph.h" #include enum { EVENT_BUTTON_DOWN = 1, EVENT_BUTTON_UP = 2, EVENT_KEY_PRESSED = 4, EVENT_MOUSE_MOTION = 8, EVENT_WINDOW_CLOSED = 16 }; struct event_data { short mouse_x, mouse_y; unsigned char kind; unsigned char button; unsigned char key; }; static struct event_data caml_gr_queue[SIZE_QUEUE]; static unsigned int caml_gr_head = 0; /* position of next read */ static unsigned int caml_gr_tail = 0; /* position of next write */ static int caml_gr_event_mask = EVENT_KEY_PRESSED; static int last_button = 0; static LPARAM last_pos = 0; HANDLE caml_gr_queue_semaphore = NULL; CRITICAL_SECTION caml_gr_queue_mutex; void caml_gr_init_event_queue(void) { if (caml_gr_queue_semaphore == NULL) { caml_gr_queue_semaphore = CreateSemaphore(NULL, 0, SIZE_QUEUE, NULL); InitializeCriticalSection(&caml_gr_queue_mutex); } } #define QueueIsEmpty (caml_gr_tail == caml_gr_head) static void caml_gr_enqueue_event(int kind, LPARAM mouse_xy, int button, int key) { struct event_data * ev; if ((caml_gr_event_mask & kind) == 0) return; EnterCriticalSection(&caml_gr_queue_mutex); ev = &(caml_gr_queue[caml_gr_tail]); ev->kind = kind; ev->mouse_x = GET_X_LPARAM(mouse_xy); ev->mouse_y = GET_Y_LPARAM(mouse_xy); ev->button = (button != 0); ev->key = key; caml_gr_tail = (caml_gr_tail + 1) % SIZE_QUEUE; /* If queue was full, it now appears empty; drop oldest entry from queue. */ if (QueueIsEmpty) { caml_gr_head = (caml_gr_head + 1) % SIZE_QUEUE; } else { /* One more event in queue */ ReleaseSemaphore(caml_gr_queue_semaphore, 1, NULL); } LeaveCriticalSection(&caml_gr_queue_mutex); } void caml_gr_handle_event(UINT msg, WPARAM wParam, LPARAM lParam) { switch (msg) { case WM_LBUTTONDOWN: case WM_RBUTTONDOWN: case WM_MBUTTONDOWN: last_button = 1; last_pos = lParam; caml_gr_enqueue_event(EVENT_BUTTON_DOWN, lParam, 1, 0); break; case WM_LBUTTONUP: case WM_RBUTTONUP: case WM_MBUTTONUP: last_button = 0; last_pos = lParam; caml_gr_enqueue_event(EVENT_BUTTON_UP, lParam, 0, 0); break; case WM_CHAR: caml_gr_enqueue_event(EVENT_KEY_PRESSED, last_pos, last_button, wParam); break; case WM_MOUSEMOVE: last_pos = lParam; caml_gr_enqueue_event(EVENT_MOUSE_MOTION, lParam, last_button, 0); break; case WM_DESTROY: // Release any calls to Graphics.wait_next_event ReleaseSemaphore(caml_gr_queue_semaphore, 1, NULL); break; } } static value caml_gr_wait_allocate_result(int mouse_x, int mouse_y, int button, int keypressed, int key) { value res = caml_alloc_small(5, 0); Field(res, 0) = Val_int(mouse_x); Field(res, 1) = Val_int(grwindow.height - 1 - mouse_y); Field(res, 2) = Val_bool(button); Field(res, 3) = Val_bool(keypressed); Field(res, 4) = Val_int(key & 0xFF); return res; } static value caml_gr_wait_event_poll(void) { int key, keypressed, i; /* Look inside event queue for pending KeyPress events */ EnterCriticalSection(&caml_gr_queue_mutex); key = 0; keypressed = 0; for (i = caml_gr_head; i != caml_gr_tail; i = (i + 1) % SIZE_QUEUE) { if (caml_gr_queue[i].kind == EVENT_KEY_PRESSED) { keypressed = 1; key = caml_gr_queue[i].key; break; } } LeaveCriticalSection(&caml_gr_queue_mutex); /* Use global vars for mouse position and buttons */ return caml_gr_wait_allocate_result(GET_X_LPARAM(last_pos), GET_Y_LPARAM(last_pos), last_button, keypressed, key); } static value caml_gr_wait_event_blocking(int mask) { struct event_data ev; /* Increase the selected events if needed */ caml_gr_event_mask |= mask; /* Pop events from queue until one matches */ do { /* Wait for event queue to be non-empty */ WaitForSingleObject(caml_gr_queue_semaphore, INFINITE); /* Pop oldest event in queue */ EnterCriticalSection(&caml_gr_queue_mutex); ev = caml_gr_queue[caml_gr_head]; /* Empty queue means the window was closed */ if (QueueIsEmpty) { ev.kind = EVENT_WINDOW_CLOSED; } else { caml_gr_head = (caml_gr_head + 1) % SIZE_QUEUE; } LeaveCriticalSection(&caml_gr_queue_mutex); /* Check if it matches */ } while ((ev.kind & mask) == 0); if (ev.kind == EVENT_WINDOW_CLOSED) { gr_fail("graphic screen not opened", NULL); } return caml_gr_wait_allocate_result(ev.mouse_x, ev.mouse_y, ev.button, ev.kind == EVENT_KEY_PRESSED, ev.key); } CAMLprim value caml_gr_wait_event(value eventlist) /* ML */ { int mask, poll; gr_check_open(); mask = EVENT_WINDOW_CLOSED; poll = 0; while (eventlist != Val_int(0)) { switch (Int_val(Field(eventlist, 0))) { case 0: /* Button_down */ mask |= EVENT_BUTTON_DOWN; break; case 1: /* Button_up */ mask |= EVENT_BUTTON_UP; break; case 2: /* Key_pressed */ mask |= EVENT_KEY_PRESSED; break; case 3: /* Mouse_motion */ mask |= EVENT_MOUSE_MOTION; break; case 4: /* Poll */ poll = 1; break; } eventlist = Field(eventlist, 1); } if (poll) return caml_gr_wait_event_poll(); else return caml_gr_wait_event_blocking(mask); } ocaml-graphics-9f1c7c8/src/win32/libgraph.h000066400000000000000000000056001502374520500205270ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Jacob Navia, after Xavier Leroy */ /* */ /* Copyright 2001 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include #include #include struct canvas { int w, h; /* Dimensions of the drawable */ HWND win; /* The drawable itself */ HDC gc; /* The associated graphics context */ }; extern HWND grdisplay; /* The display connection */ extern COLORREF grbackground; extern BOOL grdisplay_mode; /* Display-mode flag */ extern BOOL grremember_mode; /* Remember-mode flag */ extern int grx, gry; /* Coordinates of the current point */ extern int grcolor; /* Current *CAML* drawing color (can be -1) */ extern HFONT * grfont; /* Current font */ extern BOOL direct_rgb; extern int byte_order; extern int bitmap_unit; extern int bits_per_pixel; #define Wcvt(y) (grwindow.height - 1 - (y)) #define Bcvt(y) (grwindow.height - 1 - (y)) #define WtoB(y) ((y) + WindowRect.bottom - grwindow.h) #define DEFAULT_SCREEN_WIDTH 1024 #define DEFAULT_SCREEN_HEIGHT 768 #define BORDER_WIDTH 2 #define WINDOW_NAME "OCaml graphics" #define ICON_NAME "OCaml graphics" #define SIZE_QUEUE 256 void gr_fail(char *fmt, char *arg); void gr_check_open(void); CAMLprim value caml_gr_set_color(value vcolor); // Windows specific definitions extern RECT WindowRect; extern int grCurrentColor; typedef struct tagWindow { HDC gc; HDC gcBitmap; HWND hwnd; HBRUSH CurrentBrush; HPEN CurrentPen; DWORD CurrentColor; int width; int height; int grx; int gry; HBITMAP hBitmap; HFONT CurrentFont; int CurrentFontSize; HDC tempDC; // For image operations; } GR_WINDOW; extern GR_WINDOW grwindow; HFONT CreationFont(const char *name); extern void caml_gr_init_event_queue(void); extern void caml_gr_handle_event(UINT msg, WPARAM wParam, LPARAM lParam); ocaml-graphics-9f1c7c8/src/win32/open.c000066400000000000000000000260661502374520500177040ustar00rootroot00000000000000/**************************************************************************/ /* */ /* OCaml */ /* */ /* Developed by Jacob Navia, based on code by J-M Geffroy and X Leroy */ /* */ /* Copyright 2001 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #include #include #include "caml/mlvalues.h" #include "caml/fail.h" #include "libgraph.h" #include "caml/callback.h" #include static value gr_reset(void); static long tid; static HANDLE threadHandle; HWND grdisplay = NULL; int grscreen; COLORREF grwhite, grblack; COLORREF grbackground; int grCurrentColor; struct canvas grbstore; BOOL grdisplay_mode; BOOL grremember_mode; int grx, gry; int grcolor; extern HFONT * grfont; MSG msg; static char *szOcamlWindowClass = "OcamlWindowClass"; static BOOL gr_initialized = 0; CAMLprim value caml_gr_clear_graph(value unit); HANDLE hInst; HFONT CreationFont(const char *name) { LOGFONTA CurrentFont; memset(&CurrentFont, 0, sizeof(LOGFONTA)); CurrentFont.lfCharSet = ANSI_CHARSET; CurrentFont.lfWeight = FW_NORMAL; CurrentFont.lfHeight = grwindow.CurrentFontSize; CurrentFont.lfPitchAndFamily = (BYTE) (FIXED_PITCH | FF_MODERN); strncpy(CurrentFont.lfFaceName, name, sizeof(CurrentFont.lfFaceName)); CurrentFont.lfFaceName[sizeof(CurrentFont.lfFaceName) - 1] = 0; return (CreateFontIndirectA(&CurrentFont)); } void SetCoordinates(HWND hwnd) { RECT rc; GetClientRect(hwnd,&rc); grwindow.width = rc.right; grwindow.height = rc.bottom; gr_reset(); } void ResetForClose(HWND hwnd) { DeleteDC(grwindow.tempDC); DeleteDC(grwindow.gcBitmap); DeleteObject(grwindow.hBitmap); memset(&grwindow,0,sizeof(grwindow)); gr_initialized = 0; } static LRESULT CALLBACK GraphicsWndProc(HWND hwnd,UINT msg,WPARAM wParam, LPARAM lParam) { PAINTSTRUCT ps; HDC hdc; switch (msg) { // Create the MDI client invisible window case WM_CREATE: break; case WM_PAINT: hdc = BeginPaint(hwnd,&ps); BitBlt(hdc,0,0,grwindow.width,grwindow.height, grwindow.gcBitmap,0,0,SRCCOPY); EndPaint(hwnd,&ps); break; // Move the child windows case WM_SIZE: // Position the MDI client window between the tool and // status bars if (wParam != SIZE_MINIMIZED) { SetCoordinates(hwnd); } return 0; // End application case WM_DESTROY: ResetForClose(hwnd); break; } caml_gr_handle_event(msg, wParam, lParam); return DefWindowProcA(hwnd, msg, wParam, lParam); } int DoRegisterClass(void) { WNDCLASSA wc; memset(&wc,0,sizeof(WNDCLASS)); wc.style = CS_HREDRAW|CS_VREDRAW|CS_OWNDC ; wc.lpfnWndProc = (WNDPROC)GraphicsWndProc; wc.hInstance = hInst; wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1); wc.lpszClassName = szOcamlWindowClass; wc.lpszMenuName = 0; wc.hCursor = LoadCursor(NULL,IDC_ARROW); wc.hIcon = 0; return RegisterClassA(&wc); } static value gr_reset(void) { RECT rc; int screenx,screeny; screenx = GetSystemMetrics(SM_CXSCREEN); screeny = GetSystemMetrics(SM_CYSCREEN); GetClientRect(grwindow.hwnd,&rc); grwindow.gc = GetDC(grwindow.hwnd); grwindow.width = rc.right; grwindow.height = rc.bottom; if (grwindow.gcBitmap == (HDC)0) { grwindow.hBitmap = CreateCompatibleBitmap(grwindow.gc,screenx, screeny); grwindow.gcBitmap = CreateCompatibleDC(grwindow.gc); grwindow.tempDC = CreateCompatibleDC(grwindow.gc); SelectObject(grwindow.gcBitmap,grwindow.hBitmap); SetMapMode(grwindow.gcBitmap,MM_TEXT); MoveToEx(grwindow.gcBitmap,0,grwindow.height-1,0); BitBlt(grwindow.gcBitmap,0,0,screenx,screeny, grwindow.gcBitmap,0,0,WHITENESS); grwindow.CurrentFontSize = 15; grwindow.CurrentFont = CreationFont("Courier"); } grwindow.CurrentColor = GetSysColor(COLOR_WINDOWTEXT); grwindow.grx = 0; grwindow.gry = 0; grwindow.CurrentPen = SelectObject(grwindow.gc, GetStockObject(WHITE_PEN)); SelectObject(grwindow.gc,grwindow.CurrentPen); SelectObject(grwindow.gcBitmap,grwindow.CurrentPen); grwindow.CurrentBrush = SelectObject(grwindow.gc, GetStockObject(WHITE_BRUSH)); SelectObject(grwindow.gc,grwindow.CurrentBrush); SelectObject(grwindow.gcBitmap,grwindow.CurrentBrush); caml_gr_set_color(Val_long(0)); SelectObject(grwindow.gc,grwindow.CurrentFont); SelectObject(grwindow.gcBitmap,grwindow.CurrentFont); grdisplay_mode = grremember_mode = 1; MoveToEx(grwindow.gc,0,grwindow.height-1,0); MoveToEx(grwindow.gcBitmap,0,grwindow.height-1,0); SetTextAlign(grwindow.gcBitmap,TA_BOTTOM); SetTextAlign(grwindow.gc,TA_BOTTOM); return Val_unit; } void SuspendGraphicThread(void) { SuspendThread(threadHandle); } void ResumeGraphicThread(void) { ResumeThread(threadHandle); } /* For handshake between the event handling thread and the main thread */ static char * open_graph_errmsg; static HANDLE open_graph_event; static DWORD WINAPI gr_open_graph_internal(value arg) { RECT rc; int ret; int event; int x, y, w, h; int screenx,screeny; int attributes; static int registered; MSG msg; gr_initialized = TRUE; hInst = GetModuleHandle(NULL); x = y = w = h = CW_USEDEFAULT; sscanf(String_val(arg), "%dx%d+%d+%d", &w, &h, &x, &y); /* Open the display */ if (grwindow.hwnd == NULL || !IsWindow(grwindow.hwnd)) { if (!registered) { registered = DoRegisterClass(); if (!registered) { open_graph_errmsg = "Cannot register the window class"; SetEvent(open_graph_event); return 1; } } grwindow.hwnd = CreateWindowA(szOcamlWindowClass, WINDOW_NAME, WS_OVERLAPPEDWINDOW, x,y, w,h, NULL,0,hInst,NULL); if (grwindow.hwnd == NULL) { open_graph_errmsg = "Cannot create window"; SetEvent(open_graph_event); return 1; } #if 0 if (x != CW_USEDEFAULT) { rc.left = 0; rc.top = 0; rc.right = w; rc.bottom = h; AdjustWindowRect(&rc,GetWindowLong(grwindow.hwnd,GWL_STYLE),0); MoveWindow(grwindow.hwnd,x,y,rc.right-rc.left,rc.bottom-rc.top,1); } #endif } gr_reset(); ShowWindow(grwindow.hwnd,SW_SHOWNORMAL); /* Position the current point at origin */ grwindow.grx = 0; grwindow.gry = 0; caml_gr_init_event_queue(); /* The global data structures are now correctly initialized. Restart the OCaml main thread. */ open_graph_errmsg = NULL; SetEvent(open_graph_event); /* Enter the message handling loop */ while (GetMessage(&msg,NULL,0,0)) { TranslateMessage(&msg); // Translates virtual key codes DispatchMessage(&msg); // Dispatches message to window if (!IsWindow(grwindow.hwnd)) break; } return 0; } CAMLprim value caml_gr_open_graph(value arg) { DWORD tid; if (gr_initialized) return Val_unit; open_graph_event = CreateEvent(NULL, FALSE, FALSE, NULL); threadHandle = CreateThread(NULL,0, (LPTHREAD_START_ROUTINE)gr_open_graph_internal,(void **)arg, 0, &tid); WaitForSingleObject(open_graph_event, INFINITE); CloseHandle(open_graph_event); if (open_graph_errmsg != NULL) gr_fail("%s", open_graph_errmsg); return Val_unit; } CAMLprim value caml_gr_close_graph(value unit) { if (gr_initialized) { PostMessage(grwindow.hwnd, WM_CLOSE, 0, 0); WaitForSingleObject(threadHandle, INFINITE); } return Val_unit; } CAMLprim value caml_gr_clear_graph(value unit) { gr_check_open(); if(grremember_mode) { BitBlt(grwindow.gcBitmap,0,0,grwindow.width,grwindow.height, grwindow.gcBitmap,0,0,WHITENESS); } if(grdisplay_mode) { BitBlt(grwindow.gc,0,0,grwindow.width,grwindow.height, grwindow.gc,0,0,WHITENESS); } return Val_unit; } CAMLprim value caml_gr_size_x(value unit) { gr_check_open(); return Val_int(grwindow.width); } CAMLprim value caml_gr_size_y(value unit) { gr_check_open(); return Val_int(grwindow.height); } CAMLprim value caml_gr_resize_window (value vx, value vy) { gr_check_open (); /* FIXME TODO implement this function... */ return Val_unit; } CAMLprim value caml_gr_synchronize(value unit) { gr_check_open(); BitBlt(grwindow.gc,0,0,grwindow.width,grwindow.height, grwindow.gcBitmap,0,0,SRCCOPY); return Val_unit ; } CAMLprim value caml_gr_display_mode(value flag) { grdisplay_mode = (Int_val(flag)) ? 1 : 0; return Val_unit ; } CAMLprim value caml_gr_remember_mode(value flag) { grremember_mode = (Int_val(flag)) ? 1 : 0; return Val_unit ; } CAMLprim value caml_gr_sigio_signal(value unit) { return Val_unit; } CAMLprim value caml_gr_sigio_handler(value unit) { return Val_unit; } /* Processing of graphic errors */ static const value * graphic_failure_exn = NULL; void gr_fail(char *fmt, char *arg) { char buffer[1024]; if (graphic_failure_exn == NULL) { graphic_failure_exn = caml_named_value("Graphics.Graphic_failure"); if (graphic_failure_exn == NULL) caml_invalid_argument("Exception Graphics.Graphic_failure not " "initialized, must link graphics.cma"); } sprintf(buffer, fmt, arg); caml_raise_with_string(*graphic_failure_exn, buffer); } void gr_check_open(void) { if (!gr_initialized) gr_fail("graphic screen not opened", NULL); } ocaml-graphics-9f1c7c8/test/000077500000000000000000000000001502374520500160135ustar00rootroot00000000000000ocaml-graphics-9f1c7c8/test/dune000066400000000000000000000000521502374520500166660ustar00rootroot00000000000000(test (name test) (libraries graphics)) ocaml-graphics-9f1c7c8/test/test.ml000066400000000000000000000001061502374520500173210ustar00rootroot00000000000000let () = if Array.length Sys.argv > 1 then Graphics.open_graph "test"