[ { "path": ".appveyor.yml", "content": "platform:\n - x86\n\nenvironment:\n FORK_USER: ocaml\n FORK_BRANCH: master\n CYG_ROOT: C:\\cygwin64\n PACKAGE: plotkicadsch\n OPAM_SWITCH: 4.09.0+mingw64c\n PINS: kicadsch:. plotkicadsch:.\n\ninstall:\n - ps: iex ((new-object net.webclient).DownloadString(\"https://raw.githubusercontent.com/$env:FORK_USER/ocaml-ci-scripts/$env:FORK_BRANCH/appveyor-install.ps1\"))\n\nbuild_script:\n - call %CYG_ROOT%\\bin\\bash.exe -l %APPVEYOR_BUILD_FOLDER%\\appveyor-opam.sh\n - call %CYG_ROOT%\\bin\\bash.exe -l -c 'opam install plotkicadsch'\n - mv %CYG_ROOT%\\home\\appveyor\\.opam %APPVEYOR_BUILD_FOLDER%\\opam\n\nartifacts:\n - name: Binaries\n path: 'opam\\*\\bin\\plot*'\n\ndeploy:\n provider: GitHub\n auth_token:\n secure: c4q0Y7feAIuCOOJebzyrIGMQ/9CPTpzZKyyJHvqrZCiQOr9UBVYQXbuTmStkYsdn\n artifact: /plot.*\\.exe/\n draft: false\n prerelease: false\n on:\n appveyor_repo_tag: true\n" }, { "path": ".gitignore", "content": "_build/\n*.byte\n*.native\nconfigure\nsetup.*\n.merlin\n*.pdf" }, { "path": ".travis.yml", "content": "language: c\nsudo: false\nservices:\n - docker\ninstall: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh\nscript: bash -ex ./.travis-docker.sh\nenv:\n - OCAML_VERSION=4.09 DISTRO=\"ubuntu-16.04\" PACKAGE=kicadsch\n - PINS=\"kicadsch:.\" OCAML_VERSION=4.09 DISTRO=\"ubuntu-16.04\" PACKAGE=plotkicadsch\n" }, { "path": "CHANGES.md", "content": "v0.9.0\n------\n\n - plotgitsch: introduce alpha channel for background in internal diff\n - plotgitsch: add revisions in diff plots\n - plotgitsch: allow missing components in libs\n - plotgitsch: add --relative option\n\nv0.8.0\n------\n\n - plotgitsch: split wires with respect to jonction points to refine diff\n - manage escaped strings in fields\n - Remove dependency to Core_kernel\n\n\nv0.7.0\n------\n\n - plotgitsch: introduce -z option to highlight zones of changes\n - plotgitsch: implement home made internal diff\n - plotgitsch: fix bug in keep option (#39)\n - plotgitsch: z-order shapes in SVG according to new, old, idem status\n\nv0.6.1\n------\n\n - Switch to ocaml 4.09.0 and JaneStreet libs 0.13.x\n\nv0.6.0\n------\n\n - Search libs and schs recursively from working directory (fixes #33)\n\nv0.5.2\n------\n\n - Manage Fields with delimited strings\n - Use environment variables for internal differ\n - add dependency to an implementation of digestif\n\nv0.5.1\n------\n\n - fix compatibility with kicad 5.x\n\nv0.5.0\n------\n\n - add compatibility with kicad 5.x\n - update 'massaging' with rescue lib\n - become independent on line endings types\n - add an option to select output directory in plotkicadsch\n - update lib versions\n\nv0.4.0\n------\n\n - add the -l option\n - add the -c option\n - add the -t option\n - add the -k option\n - enhance svg drawing\n - add appveyor builds and Windows binaries\n - switch to dune\n - add a small user's guide\n\nv0.3.0\n------\n\n - rework opam interaction\n - fix version watermark\n - allow to have project in subdir of git working dir\n - update Readme for installation procedure\n - fix arc drawing (works for arcs less than 180°)\n - set up documentation of lib\n\nv0.2.0\n------\n\n - Add plotgitsch internal diffing\n - fix #2, #3 and #4\n\nv0.0.1\n------\n\n - Initial release\n" }, { "path": "COPYING", "content": "\n Note that the only valid version of the GPL as far as this project\n is concerned is _this_ particular version of the license (ie v2, not\n v2.2 or v3.x or whatever), unless explicitly otherwise stated.\n\n HOWEVER, in order to allow a migration to GPLv3 if that seems like\n a good idea, I also ask that people involved with the project make\n their preferences known. In particular, if you trust me to make that\n decision, you might note so in your copyright message, ie something\n like\n\n\tThis file is licensed under the GPL v2, or a later version\n\tat the discretion of Linus.\n\n might avoid issues. But we can also just decide to synchronize and\n contact all copyright holders on record if/when the occasion arises.\n\n\t\t\tLinus Torvalds\n\n----------------------------------------\n\n\t\t GNU GENERAL PUBLIC LICENSE\n\t\t Version 2, June 1991\n\n Copyright (C) 1989, 1991 Free Software Foundation, Inc.,\n 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n Everyone is permitted to copy and distribute verbatim copies\n of this license document, but changing it is not allowed.\n\n\t\t\t Preamble\n\n The licenses for most software are designed to take away your\nfreedom to share and change it. By contrast, the GNU General Public\nLicense is intended to guarantee your freedom to share and change free\nsoftware--to make sure the software is free for all its users. This\nGeneral Public License applies to most of the Free Software\nFoundation's software and to any other program whose authors commit to\nusing it. (Some other Free Software Foundation software is covered by\nthe GNU Lesser General Public License instead.) You can apply it to\nyour programs, too.\n\n When we speak of free software, we are referring to freedom, not\nprice. Our General Public Licenses are designed to make sure that you\nhave the freedom to distribute copies of free software (and charge for\nthis service if you wish), that you receive source code or can get it\nif you want it, that you can change the software or use pieces of it\nin new free programs; and that you know you can do these things.\n\n To protect your rights, we need to make restrictions that forbid\nanyone to deny you these rights or to ask you to surrender the rights.\nThese restrictions translate to certain responsibilities for you if you\ndistribute copies of the software, or if you modify it.\n\n For example, if you distribute copies of such a program, whether\ngratis or for a fee, you must give the recipients all the rights that\nyou have. You must make sure that they, too, receive or can get the\nsource code. And you must show them these terms so they know their\nrights.\n\n We protect your rights with two steps: (1) copyright the software, and\n(2) offer you this license which gives you legal permission to copy,\ndistribute and/or modify the software.\n\n Also, for each author's protection and ours, we want to make certain\nthat everyone understands that there is no warranty for this free\nsoftware. If the software is modified by someone else and passed on, we\nwant its recipients to know that what they have is not the original, so\nthat any problems introduced by others will not reflect on the original\nauthors' reputations.\n\n Finally, any free program is threatened constantly by software\npatents. We wish to avoid the danger that redistributors of a free\nprogram will individually obtain patent licenses, in effect making the\nprogram proprietary. To prevent this, we have made it clear that any\npatent must be licensed for everyone's free use or not licensed at all.\n\n The precise terms and conditions for copying, distribution and\nmodification follow.\n\n\t\t GNU GENERAL PUBLIC LICENSE\n TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION\n\n 0. This License applies to any program or other work which contains\na notice placed by the copyright holder saying it may be distributed\nunder the terms of this General Public License. The \"Program\", below,\nrefers to any such program or work, and a \"work based on the Program\"\nmeans either the Program or any derivative work under copyright law:\nthat is to say, a work containing the Program or a portion of it,\neither verbatim or with modifications and/or translated into another\nlanguage. (Hereinafter, translation is included without limitation in\nthe term \"modification\".) Each licensee is addressed as \"you\".\n\nActivities other than copying, distribution and modification are not\ncovered by this License; they are outside its scope. The act of\nrunning the Program is not restricted, and the output from the Program\nis covered only if its contents constitute a work based on the\nProgram (independent of having been made by running the Program).\nWhether that is true depends on what the Program does.\n\n 1. You may copy and distribute verbatim copies of the Program's\nsource code as you receive it, in any medium, provided that you\nconspicuously and appropriately publish on each copy an appropriate\ncopyright notice and disclaimer of warranty; keep intact all the\nnotices that refer to this License and to the absence of any warranty;\nand give any other recipients of the Program a copy of this License\nalong with the Program.\n\nYou may charge a fee for the physical act of transferring a copy, and\nyou may at your option offer warranty protection in exchange for a fee.\n\n 2. You may modify your copy or copies of the Program or any portion\nof it, thus forming a work based on the Program, and copy and\ndistribute such modifications or work under the terms of Section 1\nabove, provided that you also meet all of these conditions:\n\n a) You must cause the modified files to carry prominent notices\n stating that you changed the files and the date of any change.\n\n b) You must cause any work that you distribute or publish, that in\n whole or in part contains or is derived from the Program or any\n part thereof, to be licensed as a whole at no charge to all third\n parties under the terms of this License.\n\n c) If the modified program normally reads commands interactively\n when run, you must cause it, when started running for such\n interactive use in the most ordinary way, to print or display an\n announcement including an appropriate copyright notice and a\n notice that there is no warranty (or else, saying that you provide\n a warranty) and that users may redistribute the program under\n these conditions, and telling the user how to view a copy of this\n License. (Exception: if the Program itself is interactive but\n does not normally print such an announcement, your work based on\n the Program is not required to print an announcement.)\n\nThese requirements apply to the modified work as a whole. If\nidentifiable sections of that work are not derived from the Program,\nand can be reasonably considered independent and separate works in\nthemselves, then this License, and its terms, do not apply to those\nsections when you distribute them as separate works. But when you\ndistribute the same sections as part of a whole which is a work based\non the Program, the distribution of the whole must be on the terms of\nthis License, whose permissions for other licensees extend to the\nentire whole, and thus to each and every part regardless of who wrote it.\n\nThus, it is not the intent of this section to claim rights or contest\nyour rights to work written entirely by you; rather, the intent is to\nexercise the right to control the distribution of derivative or\ncollective works based on the Program.\n\nIn addition, mere aggregation of another work not based on the Program\nwith the Program (or with a work based on the Program) on a volume of\na storage or distribution medium does not bring the other work under\nthe scope of this License.\n\n 3. You may copy and distribute the Program (or a work based on it,\nunder Section 2) in object code or executable form under the terms of\nSections 1 and 2 above provided that you also do one of the following:\n\n a) Accompany it with the complete corresponding machine-readable\n source code, which must be distributed under the terms of Sections\n 1 and 2 above on a medium customarily used for software interchange; or,\n\n b) Accompany it with a written offer, valid for at least three\n years, to give any third party, for a charge no more than your\n cost of physically performing source distribution, a complete\n machine-readable copy of the corresponding source code, to be\n distributed under the terms of Sections 1 and 2 above on a medium\n customarily used for software interchange; or,\n\n c) Accompany it with the information you received as to the offer\n to distribute corresponding source code. (This alternative is\n allowed only for noncommercial distribution and only if you\n received the program in object code or executable form with such\n an offer, in accord with Subsection b above.)\n\nThe source code for a work means the preferred form of the work for\nmaking modifications to it. For an executable work, complete source\ncode means all the source code for all modules it contains, plus any\nassociated interface definition files, plus the scripts used to\ncontrol compilation and installation of the executable. However, as a\nspecial exception, the source code distributed need not include\nanything that is normally distributed (in either source or binary\nform) with the major components (compiler, kernel, and so on) of the\noperating system on which the executable runs, unless that component\nitself accompanies the executable.\n\nIf distribution of executable or object code is made by offering\naccess to copy from a designated place, then offering equivalent\naccess to copy the source code from the same place counts as\ndistribution of the source code, even though third parties are not\ncompelled to copy the source along with the object code.\n\n 4. You may not copy, modify, sublicense, or distribute the Program\nexcept as expressly provided under this License. Any attempt\notherwise to copy, modify, sublicense or distribute the Program is\nvoid, and will automatically terminate your rights under this License.\nHowever, parties who have received copies, or rights, from you under\nthis License will not have their licenses terminated so long as such\nparties remain in full compliance.\n\n 5. You are not required to accept this License, since you have not\nsigned it. However, nothing else grants you permission to modify or\ndistribute the Program or its derivative works. These actions are\nprohibited by law if you do not accept this License. Therefore, by\nmodifying or distributing the Program (or any work based on the\nProgram), you indicate your acceptance of this License to do so, and\nall its terms and conditions for copying, distributing or modifying\nthe Program or works based on it.\n\n 6. Each time you redistribute the Program (or any work based on the\nProgram), the recipient automatically receives a license from the\noriginal licensor to copy, distribute or modify the Program subject to\nthese terms and conditions. You may not impose any further\nrestrictions on the recipients' exercise of the rights granted herein.\nYou are not responsible for enforcing compliance by third parties to\nthis License.\n\n 7. If, as a consequence of a court judgment or allegation of patent\ninfringement or for any other reason (not limited to patent issues),\nconditions are imposed on you (whether by court order, agreement or\notherwise) that contradict the conditions of this License, they do not\nexcuse you from the conditions of this License. If you cannot\ndistribute so as to satisfy simultaneously your obligations under this\nLicense and any other pertinent obligations, then as a consequence you\nmay not distribute the Program at all. For example, if a patent\nlicense would not permit royalty-free redistribution of the Program by\nall those who receive copies directly or indirectly through you, then\nthe only way you could satisfy both it and this License would be to\nrefrain entirely from distribution of the Program.\n\nIf any portion of this section is held invalid or unenforceable under\nany particular circumstance, the balance of the section is intended to\napply and the section as a whole is intended to apply in other\ncircumstances.\n\nIt is not the purpose of this section to induce you to infringe any\npatents or other property right claims or to contest validity of any\nsuch claims; this section has the sole purpose of protecting the\nintegrity of the free software distribution system, which is\nimplemented by public license practices. Many people have made\ngenerous contributions to the wide range of software distributed\nthrough that system in reliance on consistent application of that\nsystem; it is up to the author/donor to decide if he or she is willing\nto distribute software through any other system and a licensee cannot\nimpose that choice.\n\nThis section is intended to make thoroughly clear what is believed to\nbe a consequence of the rest of this License.\n\n 8. If the distribution and/or use of the Program is restricted in\ncertain countries either by patents or by copyrighted interfaces, the\noriginal copyright holder who places the Program under this License\nmay add an explicit geographical distribution limitation excluding\nthose countries, so that distribution is permitted only in or among\ncountries not thus excluded. In such case, this License incorporates\nthe limitation as if written in the body of this License.\n\n 9. The Free Software Foundation may publish revised and/or new versions\nof the General Public License from time to time. Such new versions will\nbe similar in spirit to the present version, but may differ in detail to\naddress new problems or concerns.\n\nEach version is given a distinguishing version number. If the Program\nspecifies a version number of this License which applies to it and \"any\nlater version\", you have the option of following the terms and conditions\neither of that version or of any later version published by the Free\nSoftware Foundation. If the Program does not specify a version number of\nthis License, you may choose any version ever published by the Free Software\nFoundation.\n\n 10. If you wish to incorporate parts of the Program into other free\nprograms whose distribution conditions are different, write to the author\nto ask for permission. For software which is copyrighted by the Free\nSoftware Foundation, write to the Free Software Foundation; we sometimes\nmake exceptions for this. Our decision will be guided by the two goals\nof preserving the free status of all derivatives of our free software and\nof promoting the sharing and reuse of software generally.\n\n\t\t\t NO WARRANTY\n\n 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY\nFOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN\nOTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES\nPROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED\nOR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF\nMERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS\nTO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE\nPROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,\nREPAIR OR CORRECTION.\n\n 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING\nWILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR\nREDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,\nINCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING\nOUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED\nTO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY\nYOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER\nPROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE\nPOSSIBILITY OF SUCH DAMAGES.\n\n\t\t END OF TERMS AND CONDITIONS\n\n\t How to Apply These Terms to Your New Programs\n\n If you develop a new program, and you want it to be of the greatest\npossible use to the public, the best way to achieve this is to make it\nfree software which everyone can redistribute and change under these terms.\n\n To do so, attach the following notices to the program. It is safest\nto attach them to the start of each source file to most effectively\nconvey the exclusion of warranty; and each file should have at least\nthe \"copyright\" line and a pointer to where the full notice is found.\n\n \n Copyright (C) \n\n This program is free software; you can redistribute it and/or modify\n it under the terms of the GNU General Public License as published by\n the Free Software Foundation; either version 2 of the License, or\n (at your option) any later version.\n\n This program is distributed in the hope that it will be useful,\n but WITHOUT ANY WARRANTY; without even the implied warranty of\n MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n GNU General Public License for more details.\n\n You should have received a copy of the GNU General Public License along\n with this program; if not, write to the Free Software Foundation, Inc.,\n 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n\nAlso add information on how to contact you by electronic and paper mail.\n\nIf the program is interactive, make it output a short notice like this\nwhen it starts in an interactive mode:\n\n Gnomovision version 69, Copyright (C) year name of author\n Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.\n This is free software, and you are welcome to redistribute it\n under certain conditions; type `show c' for details.\n\nThe hypothetical commands `show w' and `show c' should show the appropriate\nparts of the General Public License. Of course, the commands you use may\nbe called something other than `show w' and `show c'; they could even be\nmouse-clicks or menu items--whatever suits your program.\n\nYou should also get your employer (if you work as a programmer) or your\nschool, if any, to sign a \"copyright disclaimer\" for the program, if\nnecessary. Here is a sample; alter the names:\n\n Yoyodyne, Inc., hereby disclaims all copyright interest in the program\n `Gnomovision' (which makes passes at compilers) written by James Hacker.\n\n , 1 April 1989\n Ty Coon, President of Vice\n\nThis General Public License does not permit incorporating your program into\nproprietary programs. If your program is a subroutine library, you may\nconsider it more useful to permit linking proprietary applications with the\nlibrary. If this is what you want to do, use the GNU Lesser General\nPublic License instead of this License.\n" }, { "path": "LICENSE.md", "content": "Copyright (c) 2017, Jean-Noël Avila \nAll rights reserved.\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n\n * Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n * Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n * Neither the name of Jean-Noël Avila nor the names of his\n contributors may be used to endorse or promote products derived\n from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL THE AUTHOR AND CONTRIBUTORS BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" }, { "path": "Makefile", "content": ".PHONY: build clean test install uninstall distrib publish release\n\nbuild:\n\tdune build\n\nclean:\n\tdune clean\n\ntest:\n\tdune runtest\n\ninstall:\n\tdune install\n\nuninstall:\n\tdune uninstall\n\ndistrib:\n\tdune-release tag\n\tdune-release\n" }, { "path": "README.md", "content": "[![Build Status](https://travis-ci.org/jnavila/plotkicadsch.svg?branch=master)](https://travis-ci.org/jnavila/plotkicadsch)[![Build status](https://ci.appveyor.com/api/projects/status/558xcmkgx220sqjv?svg=true)](https://ci.appveyor.com/project/jnavila/plotkicadsch)\n\n# Kicad schematic plotter\n\nPlotKicadsch is a small tool to export Kicad Sch files to SVG pictures. In the future, export to other formats may be available (PDF, PNG).\n\nThis package also provides the [`plotgitsch`](https://jnavila.github.io/plotkicadsch/plotgitsch_usersguide.html) command which allows to visually compare git revisions of schematics:\n\n![Visual diff](docs/svg_diff.png)\n\nFor more information type `plotgitsch --help`.\n\n## Objectives\n\nThis project is mainly an attempt at using ocaml with functional programming on a pet real-world project.\n\nThe quality of the output is not a first requirement (meaning: not supposed to match Kicad one to one), but the accuracy of positioning matters.\n\n# Installation\n\n# Stable version from OPAM\n\nThe stable version of plotkicadsch can be installed with [opam](http://opam.ocaml.org/). Be careful to install opam v2.0 for your platform.\n\n```bash\nopam switch create 4.09.1\nopam switch 4.09.1\neval `opam config env`\nopam update\nopam install plotkicadsch\n```\n\nIf you don't use opam consult the .opam files for build instructions.\n\n## Windows\n\nFor Windows users, there is an [experimental opam repository](https://fdopen.github.io/opam-repository-mingw/) which works pretty well.\n\nAlternatively, you can simply grab precompiled binaries at\n\nhttps://github.com/jnavila/plotkicadsch/releases\n\nIf you have installed git for windows, chances are that you have installed the bash environment, so drop the binaries in `C:\\Program Files\\Git\\mingw64\\bin`(Administrator rights required). They should be accessible on your bash command line and work just like under Linux/OSX.\n\n# Master version\n\nThe latest running version can also be installed from this repo by pinning the project in opam:\n\n```bash\nopam switch create 4.09.1\nopam switch 4.09.1\neval `opam config env`\nopam pin add kicadsch .\nopam pin add plotkicadsch .\nopam update\nopam install plotkicadsch\n```\n\n# How to\n\n## Using\n\nAll the commands have a help option. For `plotgitsch`, a [small hands on guide](https://jnavila.github.io/plotkicadsch/plotgitsch_usersguide.html) is available.\n\n## Contributing\n\nThis project accepts GitHub pull requests, but as it is a self-teaching project, I would prefer to do all the core stuff. If you see some parts of the code whose style is not ocamlish or not FP ready, please let me know.\n\nIf this project happens to be of any use, let me know also!\n" }, { "path": "README.org", "content": "* Kicad schematic plotter\n\nPlotKicadsch is a small tool to export Kicad Sch files to SVG pictures. In the future, export to other formats may be available (PDF, PNG).\n\n** Objectives\nThis project is mainly an attempt at using ocaml with functional programming on a pet real-world project.\n\nThe quality of the output is not a first requirement, but the accuracy of positioning matters. The end objective is to be able to provide a visual diff on sch files for version control.\n\n** Contributing\n\nThis project accepts GitHub pull requests, but as it is a self-teaching project, I would prefer to do all core stuff. If you see some parts of the code whose style is not ocamlish or not FP ready, please let me know.\n\nIf this project happens to be of any use, let me know also!\n" }, { "path": "docs/_config.yml", "content": "theme: jekyll-theme-cayman" }, { "path": "docs/index.md", "content": "# Massaging your git for kicad\n\nKicad is the only electronics CAD that I know to use a nice text format for managing all the data. That feature usually fits nicely with source code version control systems such as Git. However, in spite of the text format nature of Kicad files, the fit with Git is not totally perfect and needs some adjustments for smoother interaction.\n\nThe following points are the setup that I reached for the edition of schematics. Caveat: most of the following tricks run on unix-like systems, but I made no attempt to port them to Windows.\n\n## Including and Ignoring files\n\nFirst off, you have to know which files you need to follow in version control and which other ones you just want the version control system to ignore.\n\n\nConcerning libraries of components, Kicad is well-behaved in that it maintains a cache library of all the components presently used in the schematics of a project. The presence of this file means that you don't need to check into version all the libraries from which you pulled the components, but that the project folder already contains all that is needed to open all the schematic sheets. The main files for a project named `myboard` that are followed under version control are:\n\n * the `.pro` file which is main project file, e.g, `myboard.pro`\n * the `.sch` files that represent the schematic sheets.\n * the `cache.lib` which is the local cache for all the components used in your schematic, e.g. `myboard-cache.lib`\n * the `cache.dcm` which is the additional cache for component information, e.g. `myboard-cache.dcm`\n * the `rescue.lib`, e.g. `myboard-rescue.lib`, if present, which is a cache file of components which have been changed in the global libraries since the components was used in the schematics. This file is here to record the components that you didn't want to “upgrade” to the new global version.\n\nOf course, you can choose to put other files of your project, such as datasheets, simulation files, notes, documents. Don't forget that, unlike you used to do, now the upcoming versions of your board will be tagged by your version control system, so it is no use making one directory per revision of the board.\n\nOn the other side, there are files that you surely don't want to follow in version, because they are some by-products of the schematic. This encompasses typically intermediate files between the schematic and the manufacturing files.\n\nI usually add these lines to my `.gitignore`\n\n```bash\n# export files for BOM\n*.csv\n*.tsv\n*.xml\n# backup files\n *.bak\n```\n\n## Cleaning and Smudging\n\nKicad generally has a nice behavior with respect to version controlling, such as taking care to not upset the structure of a schematic file when a small change is introduced. This lands very well in the version control world because when reviewing the changes between two versions, the changes are limited to some small chunks of the files. Nevertheless, some other behaviors are annoying for version control. One of these behaviors is the act of changing the content of the files for administrative purpose, without any causal or visual relationship with user's actions.\n\nFortunately, to solve this issue, there is a very handy feature of git that allows to filter the content of the files when they are about to be committed and changed back if needed when they are checked out. This feature is called cleaning (when checking in)/smudging (when checking out). Using this feature, we can force the content of certain parts of the files to remain the same in version control, even when these parts are changing in the working copy.\n\n### How it works\n\nThe set up in Git is simple: first, we define a `filter` attribute for certain files by specifying the matching filename patterns. Then, for this type of file, we define in the config two commands that will filter the files in and out of the repository. These filter commands will accept the file content on their standard inputs and spit the modified content on their standard outputs. I will give the setup for what's needed; for more information on clean/smudge, please refer to Git's documentation.\n\n### removing the date in the .pro file\n\nA particular annoying feature is the fact that the project file contains a field that represents the date of last modification of the project, for example, when a lib is added to the project. I don't know where this date is supposed to appear, but the changes in this field are quite disruptive for version control.\n\nFirst, let's define the filter `kicad_project` for the `*.pro` files. We do so by adding a `.gitattributes` file (to b committed) at the root of working copy, with the following content:\n\n\n```ini\n*.pro filter=kicad_project\n```\n\nAfter that, we define the filters and we want them to be available for all the projects where the attribute exists, so we set it at the user config level. The `clean` part of the filter (for checkin) will get rid of the date, while the `smudge` part of the filter (checkout) will do nothing.\n\nDoing nothing is just passing the content through the `cat` command.\nOn the other hand, the actual filtering in the `clean` part needs a little more work. Basically, we apply a stream edition, via the `sed` command:\n\n\n```console\n$ git config --global filter.kicad_project.clean \"sed -E 's/^update=.*$/update=Date/'\"\n$ git config --global filter.kicad_project.smudge cat\n```\n\nThe `--global` option makes the filter available in every project of the user. From now on, changes to date in the `*.pro` file won't be noticed by git.\n\n#### Power and Flags Numbering\n\nAnother annoying behavior in Kicad Schematics is the way the power and flag parts are numbered. These components are part of the schematic but they don't appear in the BOM. So, their numbering is all managed internally by Kicad. Kicad renumbers them all every time the user requests an annotation of the project, which modifies all those references in all the sheets each time or when a DRC test is run. As a user, I don't care which numbers are assigned to these components and I don't want them to appear in the diff between commits. So it's better keeping the references for all these phantom parts to \"unknown\" in the revision control system. Let's kick off another filter for that! First let's add a new attribute in the `.gitattributes` file:\n\n```ini\n*.sch filter=kicad_sch\n```\n\nThen let's clean up all the `sch` files before staging:\n\n```console\n$ git config --global filter.kicad_sch.clean \"sed -E 's/#(PWR|FLG)[0-9]+/#\\1?/'\"\n$ git config --global filter.kicad_sch.smudge cat\n```\n\nWith this one, you should be able to diff your project and get a more understandable view of your changes.\n\n## Visual Diffing\n\nThe textual diffs between revisions of a schematic sheet have cleared up a bit with the filters, but most of us poor humans don't read the schematic format in the text. To put it bluntly, except when only properties of parts are changed, the text diff is totally useless. The good news is that there is a better solution: diffing visually the schematic.\n\nI developed a utility specially for this purpose: [Plotgitsch](https://jnavila.github.io/plotkicadsch/plotgitsch_usersguide.html) that you can download [here](https://github.com/jnavila/plotkicadsch/releases). Plotgitsch can use two strategies to diff schematics:\n\n * Generate bitmap pictures of each sheet of the schematic and use an external tool to visually diff them.\n * Perform an internal diff on the schematics drawing primitive lists and provide the result as an svg to be visualized in your preferred browser.\n\n### External Image Diffing\n\nRight now, the image diff tool is by default imagemagick's `compare`, wrapped in a custom script. This way of diffing is a sure way to indicate the visual differences between the schematics because it can not lie about pixel to pixel changes but the result can be difficult to read because there is no zooming capability: the schematics are drawn as bitmap, which means that in order to get decent differences, you need to generate huge bitmaps. Nevertheless, this is still quite efficient. A script is already provided, but if you prefer to provide you own comparison program, we're going to show how it is done by default.\n\nFirst, let's create the script that allows to compare two images. If the images are identical, the script just finishes, otherwise a three-pane image is displayed, showing the visual diff at the center and the revisions on each side. Here it is:\n\n```bash\n#!/bin/bash\nPIPE=$(mktemp -u)\n(! compare -metric RMSE $2 $1 png:${PIPE} 2> /dev/null) && (montage -geometry +4+4 $2 $PIPE $1 png:- | display -title \"$1\" -)\nrm $PIPE\n```\n\nSave this file as `git-imgdiff` script, make it executable and available in your `$PATH`.\n\nNow, `plotgitsch` can be invoked in your project's root directory in three forms:\n\n 1. `plotgitsch `, with `rev1` and `rev2` being two references to commit (tag, branch or any commitish form). The differing schematic sheets between the two revisions will be compared.\n 2. `plotgitsch ` performs the comparison between the working copy and the given revision. You can quickly spot what changed since the last tagged prototype.\n 3. `plotgitsch` alone, which performs the comparison between the working copy and the HEAD. This is by far the most used one. Very helpful for checking what's changed before committing.\n\nPlotgitsch's plotting capabilities are not supposed to match those of Kicad, but to allow to quickly review the changes. The real job of comparing the two svg plots of schematic is done by the script which is quite rough, so feel free to share a better alternative for this function.\n\n### Internal Diffing\n\nThis new feature orders the drawing primitives in lists and performs the diff between the two lists, showing the additions in green and the erased parts in red. The resulting picture is opened with the application specified with the `-i` option, e.g.:\n\n```bash\n $ plotgitsch -ifirefox\n```\n\n![visual diff in the browser](svg_diff.png)\n\nThis feature uses the same forms of version references as the external diffing. Other command line options are available; for more information on advanced use of `plotgitsch`, type: \n\n```bash\n $ plotgitsch --help\n```\n\n## Archiving the Project\n\nNow that you are managing your project in Git, you can add other types of files to your project such as datasheets, BOMs and any additional files that you see fit. In this case, the Kicad archiving feature becomes less useful, it is more interesting to create your archives from Git. You benefit from the version system and you can create archive files of your project at a given revision.\n\nSay you want a zip archive of the version `1.0` of your project. Just type:\n\n```bash\n$ git archive --format=zip --output=../myproject_v1.0.zip v1.0\n```\n\nThat's all.\n" }, { "path": "docs/plotgitsch_usersguide.adoc", "content": "= Plotgitsch User's Guide\nJean-Noël Avila \n:toc:\n:icons: font\n\n== Introduction\n\nPlotgitsch is a utility command coming from the plotkicadsch package. Its core feature is the ability to generate visual diff between two versions of a Kicad schematic managed in a Git project.\n\nProvided your Kicad project is versioned with Git, this feature is useful in several cases, among which:\n\n* to check the changes you just introduced before committing\n* to visualize a changeset\n* to review the changes introduced between two revisions of a schematic\n* to send the difference of schematic to the person in charge of routing\n\nTo walk you through some of these use cases, we are going to use a fake repository of a board and show how to use the commands.\n\nNOTE: If you want to apply the same recipes to your own project, don't forget to follow the advices listed in link:index.html[Massaging your git or kicad].\n\n== Set Up\n\nIn order to play with plotgitsch, let's prepare a sandbox project and see what can be done.\n\n[source, shell]\n----\n$ git clone https://github.com/jnavila/kicad_playground.git\n$ cd kicad_playground\n$ patch -p1 -i changes.diff\n----\n\nNow, we have a project with a schematic with changes in the working copy. This project has a pretty strange history that will help us exercise the features of `plotgitsch`.\n\nAs you can already see, the schematic project isn't located at the root of the git working copy. `plotgitsch` can compute changes recursively in subdirectories, from the current directory. It's always safer to change the current directory to the root of kicad project you are interested in, in case several kicad projects share the same git project worktree.\n\n[source, shell]\n----\n$ cd schematic\n$ ls -1\nkicad_playground-cache.lib\nkicad_playground.kicad_pcb\nkicad_playground.pro\nkicad_playground.sch\nLEDs.sch\n----\n\nThis is a checkout of what is usually followed under git in kicad projects. For more information, refer to link:index.html[how to set up your git repository].\n\n== Internal Diff\n\nAlthough `plotgitsch` is invoked by default to run an external image diff tool, we will focus on using the internal diff feature by using the `-i` option. This feature tries to compute the visual differences between lists of drawing primitives (lines, texts, arcs…) of the schematics drawings and keeps the difference at the level of https://en.wikipedia.org/wiki/Vector_graphics[vector graphics], which allows any zooming level.\n\nThe primitives are reordered internally, so that the diffing algorithm can cope with great reworks of the schematics but still find the differences at the shape level.\n\nIn order to visualize the vector output of the difference, you'll need an application able to display SVG pictures. Your default web browser should be able to handle these files. Let's try for instance with firefox:\n\n[source, shell]\n----\n$ plotgitsch -ifirefox\n----\n\nThis should display:\n\nimage::working_copy_diff.png[]\n\nIt seems the last change to the working copy was the addition of a screw terminal block.\n\nThis is the display of changes that were introduced in your present working copy with respect to the latest revision checked in git, just like `git diff` would display the textual differences introduced in your working copy. Of course, instead of firefox, you can specify the tool of your choice to handle the svg output file.\n\n== Specifying Revisions to compare\n\nFor the simplicity of this guide, all the revisions of this playground repo have been tagged so that you can easily type them in.\n\n`plotgitsch` handles revision specifiers just like git (behind the scene, it uses git). Please have a look at https://git-scm.com/docs/gitrevisions[git revisions] for all the kinds of commit reference specifiers.\n\nRevisions to be compared can be specified in three forms: with two, one or no revisions.\n\n 1. `plotgitsch` alone, performs the comparison between the working copy and `HEAD` (the tip of the branch you have checked out). This is by far the most used one. Very helpful for verifying what's changed before committing.\n 2. `plotgitsch ` performs the comparison between the working copy and the given revision _rev_ . You can quickly spot what changed since the last tagged prototype.\n 3. `plotgitsch `, with _rev1_ and _rev2_ being two references to commits (tag, branch or any commitish form). The changes in schematic sheets from _rev1_ to _rev2_ are displayed.\n\nFor instance, let's check the changes between two tagged revisions:\n\n[source, shell]\n----\n$ plotgitsch -ifirefox v0.0.3 v0.0.4\n----\n\nimage::LED_swap.png[]\n\n\nTIP: You can also diff plain directories, without any reference to git, by using the scheme `dir:` for a side of diff: `plotgitsch dir: dir:` will perform the schematic diff between directories _dir1_ and _dir2_.\n\n== Changing Colors\n\nBy default, the background is white, the unmodified part of the drawing is black, the added parts are green and the removed ones are red. These colors can be changed with the `-c` option. Say we'd rather have the background in black (RGB hex code 000000), the unchanged parts in white (RGB hex: FFFFFF), the added lines in clear blue (RGB hex: 008FFF) and keep the removed in red (RGB hex: FF0000), we need to issue the following command:\n\n[source, shell]\n----\n$ plotgitsch -ifirefox -c FF0000:008FFF:FFFFFF:000000 v0.0.3 v0.0.4\n----\n\nimage::LED_swap_blackbg.png[]\n\n== Keeping Diff Pictures\n\nYou may have noticed while performing the previous commands that the corresponding files are opened in your web browser but do not clutter your working directory. This is because these files are generated in the `temp` directory.\n\nIf you need the files, as documentation for instance, you can specify the `-k` option (`--keep` in long format) to force the generation in the working directory and disable deletion after use.\n\n== Preloading libraries\n\nThe project was not correctly checked in during the first revisions, namely, the cache library was not checked in:\n\n[source, shell]\n----\n$ plotgitsch -ifirefox v0.0.2 v0.0.3\n\ninternal diff and show with firefox between Git rev v0.0.2 and Git rev v0.0.3\nException (\"Kicadsch__Kicadlib.MakePainter(P).Component_Not_Found(\\\"Timer:LM555\\\")\")\n----\n\nThis message indicates that in one of the revisions, the definition of a component is missing. The definitions are provided in libraries which must be checked in. To circumvent this forgotten step, `plotgitsch` lets you specify a path in your filesystem to one or several libraries to preload with the option `-l` or `--lib=`. If we are lucky, we can assume that the cache lib present in our working copy contains the required components in their correct version:\n\n[source, shell]\n----\n$ plotgitsch -ifirefox -lkicad_playground-cache.lib v0.0.2 v0.0.3\n----\nimage::diff_with_lib.png[]\n\nThis works quite well. However, you can still notice that some changes appear at the shape of the LED which may have changed in the cache, because the wires around it show changes. We are quite lucky that the shape of more complex components haven't changed (for instance a mapping on a microcontroller).\n\nTIP: Don't forget to commit your `*-cache.lib` file with your changes. They hold the shape of the components and are needed for accurate history recording.\n\n== Added sheets\n\nWhen a sheet is added or when several sheets are changed at once, the diffs are opened one tab per sheet in your browser.\n\n[source, shell]\n----\n$ plotgitsch -ifirefox v0.0.4 v0.0.5\n----\nimage::diff_two_tabs.png[]\n\n\n== Setting Default Options\n\nIt's tedious to repeat the same options on and on each time you wish to visualize a diff. One option around that is to define an alias in you preferred shell script environment. For instance, if you are using bash, you can add this line to your `.bashrc`:\n\n.Defining a shortcut alias in your `.bashrc`\n[source, shell]\n----\nalias pgs='plotgitsch --internal=firefox --color=FF0000:008FFF:FFFFFF:000000'\n----\n\nThis lets you use the `pgs` alias to quickly check your local diffs from the last commit.\n\nAnother option is to use environment variables to customize the behavior of `plotgitsch`. Two environment variables are usable:\n\n`PLOTGITSCH_VIEWER`::\n This variable makes `plotgitsch` use the internal differ and its value is the command of the viewer.\n`PLOTGITSCH_COLORS`::\n This variable is the value passed to the `--colors` option.\n`PLOTGITSCH_CHANGE_COLOR`::\n This variable activate change zone highlighting with the specified color in hex format #rrggbb\n\nSet and export these variables in your `$HOME/.bashrc` or in you `$HOME/.profilerc`, like this:\n\n[source, shell]\n----\nexport PLOTGITSCH_VIEWER=firefox\nexport PLOTGITSCH_COLORS=FF0000:008FFF:FFFFFF:000000\n----\n\nThis way, `plotgitsch` 's default behavior will be to use the internal diff with firefox as a viewer with customized colors.\n\n== Other Options\n\nThere are a few last options:\n\n`-t`, `--textdiff`::\n In case the sch files are different but do not yield graphical differences, instruct `plotgitsch` to dump a text diff of the files.\n\n`--version`::\n Show the version string.\n\n`-z#__`, `--zone=#__`::\n Highlight the change zones in the diff output with specified colors.\n\n`--help`::\n Show a very helpful manual page.\n" }, { "path": "docs/plotgitsch_usersguide.html", "content": "\n\n\n\n\n\n\n\nPlotgitsch User’s Guide\n\n\n\n\n\n
\n
\n

Introduction

\n
\n
\n

Plotgitsch is a utility command coming from the plotkicadsch package. Its core feature is the ability to generate visual diff between two versions of a Kicad schematic managed in a Git project.

\n
\n
\n

Provided your Kicad project is versioned with Git, this feature is useful in several cases, among which:

\n
\n
\n
    \n
  • \n

    to check the changes you just introduced before committing

    \n
    • \n
  • \n

    to visualize a changeset

    \n
    • \n
  • \n

    to review the changes introduced between two revisions of a schematic

    \n
    • \n
  • \n

    to send the difference of schematic to the person in charge of routing

    \n
    • \n
\n
\n
\n

To walk you through some of these use cases, we are going to use a fake repository of a board and show how to use the commands.

\n
\n
\n\n\n\n\n\n
\n\n\nIf you want to apply the same recipes to your own project, don’t forget to follow the advices listed in Massaging your git or kicad.\n
\n
\n
\n
\n
\n

Set Up

\n
\n
\n

In order to play with plotgitsch, let’s prepare a sandbox project and see what can be done.

\n
\n
\n
\n
$ git clone https://github.com/jnavila/kicad_playground.git\n$ cd kicad_playground\n$ patch -p1 -i changes.diff
\n
\n
\n
\n

Now, we have a project with a schematic with changes in the working copy. This project has a pretty strange history that will help us exercise the features of plotgitsch.

\n
\n
\n

As you can already see, the schematic project isn’t located at the root of the git working copy. plotgitsch can compute changes recursively in subdirectories, from the current directory. It’s always safer to change the current directory to the root of kicad project you are interested in, in case several kicad projects share the same git project worktree.

\n
\n
\n
\n
$ cd schematic\n$ ls -1\nkicad_playground-cache.lib\nkicad_playground.kicad_pcb\nkicad_playground.pro\nkicad_playground.sch\nLEDs.sch
\n
\n
\n
\n

This is a checkout of what is usually followed under git in kicad projects. For more information, refer to how to set up your git repository.

\n
\n
\n
\n
\n

Internal Diff

\n
\n
\n

Although plotgitsch is invoked by default to run an external image diff tool, we will focus on using the internal diff feature by using the -i option. This feature tries to compute the visual differences between lists of drawing primitives (lines, texts, arcs…) of the schematics drawings and keeps the difference at the level of vector graphics, which allows any zooming level.

\n
\n
\n

The primitives are reordered internally, so that the diffing algorithm can cope with great reworks of the schematics but still find the differences at the shape level.

\n
\n
\n

In order to visualize the vector output of the difference, you’ll need an application able to display SVG pictures. Your default web browser should be able to handle these files. Let’s try for instance with firefox:

\n
\n
\n
\n
$ plotgitsch -ifirefox
\n
\n
\n
\n

This should display:

\n
\n
\n
\n\"working\n
\n
\n
\n

It seems the last change to the working copy was the addition of a screw terminal block.

\n
\n
\n

This is the display of changes that were introduced in your present working copy with respect to the latest revision checked in git, just like git diff would display the textual differences introduced in your working copy. Of course, instead of firefox, you can specify the tool of your choice to handle the svg output file.

\n
\n
\n
\n
\n

Specifying Revisions to compare

\n
\n
\n

For the simplicity of this guide, all the revisions of this playground repo have been tagged so that you can easily type them in.

\n
\n
\n

plotgitsch handles revision specifiers just like git (behind the scene, it uses git). Please have a look at git revisions for all the kinds of commit reference specifiers.

\n
\n
\n

Revisions to be compared can be specified in three forms: with two, one or no revisions.

\n
\n
\n
    \n
  1. \n

    plotgitsch alone, performs the comparison between the working copy and HEAD (the tip of the branch you have checked out). This is by far the most used one. Very helpful for verifying what’s changed before committing.

    \n
    2. \n
  2. \n

    plotgitsch <rev> performs the comparison between the working copy and the given revision rev . You can quickly spot what changed since the last tagged prototype.

    \n
    3. \n
  3. \n

    plotgitsch <rev1> <rev2>, with rev1 and rev2 being two references to commits (tag, branch or any commitish form). The changes in schematic sheets from rev1 to rev2 are displayed.

    \n
    4. \n
\n
\n
\n

For instance, let’s check the changes between two tagged revisions:

\n
\n
\n
\n
$ plotgitsch -ifirefox v0.0.3 v0.0.4
\n
\n
\n
\n
\n\"LED\n
\n
\n
\n\n\n\n\n\n
\n\n\nYou can also diff plain directories, without any reference to git, by using the scheme dir:<directory> for a side of diff: plotgitsch dir:<dir1> dir:<dir2> will perform the schematic diff between directories dir1 and dir2.\n
\n
\n
\n
\n
\n

Changing Colors

\n
\n
\n

By default, the background is white, the unmodified part of the drawing is black, the added parts are green and the removed ones are red. These colors can be changed with the -c option. Say we’d rather have the background in black (RGB hex code 000000), the unchanged parts in white (RGB hex: FFFFFF), the added lines in clear blue (RGB hex: 008FFF) and keep the removed in red (RGB hex: FF0000), we need to issue the following command:

\n
\n
\n
\n
$ plotgitsch -ifirefox -c FF0000:008FFF:FFFFFF:000000 v0.0.3 v0.0.4
\n
\n
\n
\n
\n\"LED\n
\n
\n
\n
\n
\n

Keeping Diff Pictures

\n
\n
\n

You may have noticed while performing the previous commands that the corresponding files are opened in your web browser but do not clutter your working directory. This is because these files are generated in the temp directory.

\n
\n
\n

If you need the files, as documentation for instance, you can specify the -k option (--keep in long format) to force the generation in the working directory and disable deletion after use.

\n
\n
\n
\n
\n

Preloading libraries

\n
\n
\n

The project was not correctly checked in during the first revisions, namely, the cache library was not checked in:

\n
\n
\n
\n
$ plotgitsch -ifirefox v0.0.2 v0.0.3\n\ninternal diff and show with firefox between Git rev v0.0.2 and Git rev v0.0.3\nException (\"Kicadsch__Kicadlib.MakePainter(P).Component_Not_Found(\\\"Timer:LM555\\\")\")
\n
\n
\n
\n

This message indicates that in one of the revisions, the definition of a component is missing. The definitions are provided in libraries which must be checked in. To circumvent this forgotten step, plotgitsch lets you specify a path in your filesystem to one or several libraries to preload with the option -l or --lib=. If we are lucky, we can assume that the cache lib present in our working copy contains the required components in their correct version:

\n
\n
\n
\n
$ plotgitsch -ifirefox -lkicad_playground-cache.lib v0.0.2 v0.0.3
\n
\n
\n
\n
\n\"diff\n
\n
\n
\n

This works quite well. However, you can still notice that some changes appear at the shape of the LED which may have changed in the cache, because the wires around it show changes. We are quite lucky that the shape of more complex components haven’t changed (for instance a mapping on a microcontroller).

\n
\n
\n\n\n\n\n\n
\n\n\nDon’t forget to commit your *-cache.lib file with your changes. They hold the shape of the components and are needed for accurate history recording.\n
\n
\n
\n
\n
\n

Added sheets

\n
\n
\n

When a sheet is added or when several sheets are changed at once, the diffs are opened one tab per sheet in your browser.

\n
\n
\n
\n
$ plotgitsch -ifirefox v0.0.4 v0.0.5
\n
\n
\n
\n
\n\"diff\n
\n
\n
\n
\n
\n

Setting Default Options

\n
\n
\n

It’s tedious to repeat the same options on and on each time you wish to visualize a diff. One option around that is to define an alias in you preferred shell script environment. For instance, if you are using bash, you can add this line to your .bashrc:

\n
\n
\n
Defining a shortcut alias in your .bashrc
\n
\n
alias pgs='plotgitsch --internal=firefox --color=FF0000:008FFF:FFFFFF:000000'
\n
\n
\n
\n

This lets you use the pgs alias to quickly check your local diffs from the last commit.

\n
\n
\n

Another option is to use environment variables to customize the behavior of plotgitsch. Two environment variables are usable:

\n
\n
\n
\n
PLOTGITSCH_VIEWER
\n
\n

This variable makes plotgitsch use the internal differ and its value is the command of the viewer.

\n
\n
PLOTGITSCH_COLORS
\n
\n

This variable is the value passed to the --colors option.

\n
\n
PLOTGITSCH_CHANGE_COLOR
\n
\n

This variable activate change zone highlighting with the specified color in hex format #rrggbb

\n
\n
\n
\n
\n

Set and export these variables in your $HOME/.bashrc or in you $HOME/.profilerc, like this:

\n
\n
\n
\n
export PLOTGITSCH_VIEWER=firefox\nexport PLOTGITSCH_COLORS=FF0000:008FFF:FFFFFF:000000
\n
\n
\n
\n

This way, plotgitsch 's default behavior will be to use the internal diff with firefox as a viewer with customized colors.

\n
\n
\n
\n
\n

Other Options

\n
\n
\n

There are a few last options:

\n
\n
\n
\n
-t, --textdiff
\n
\n

In case the sch files are different but do not yield graphical differences, instruct plotgitsch to dump a text diff of the files.

\n
\n
--version
\n
\n

Show the version string.

\n
\n
-z#<RRGGBB>, --zone=#<RRGGBB>
\n
\n

Highlight the change zones in the diff output with specified colors.

\n
\n
--help
\n
\n

Show a very helpful manual page.

\n
\n
\n
\n
\n
\n
\n
\n
\nLast updated 2021-02-06 18:42:11 +0100\n
\n
\n\n" }, { "path": "dune-project", "content": "(lang dune 1.0)\n(name plotkicadsch)\n(version 0.4.0)" }, { "path": "kicadsch/src/dune", "content": "(library\n (name kicadsch)\n (public_name kicadsch)\n (modules_without_implementation kicadSch_sigs)\n (synopsis \"Library to plotting KiCAD schematics\")\n (flags (:standard -safe-string))\n )\n" }, { "path": "kicadsch/src/kicadLib_sigs.ml", "content": "open KicadSch_sigs\n\ntype relcoord = RelCoord of int * int\n\ntype circle = {center: relcoord; radius: int}\n\ntype pin_orientation = P_L | P_R | P_U | P_D\n\ntype pin_tag = string * size\n\ntype pin =\n { name: pin_tag\n ; number: pin_tag\n ; length: size\n ; contact: relcoord\n ; orient: pin_orientation\n }\n\ntype primitive =\n | Field\n | Polygon of int * relcoord list\n | Circle of int * circle\n | Pin of pin\n | Text of {c: relcoord; text: string; s: size}\n | Arc of\n { s: size\n ; radius: int\n ; sp: relcoord\n ; ep: relcoord\n ; center: relcoord\n }\n\ntype elt = {parts: int; prim: primitive}\n\ntype component =\n { names: string list\n ; draw_pnum: bool\n ; draw_pname: bool\n ; multi: bool\n ; graph: elt list\n }\n" }, { "path": "kicadsch/src/kicadSch_sigs.mli", "content": "(**\n Kicad modules Signatures *)\n\n(** orientation of a text *)\ntype orientation = Orient_H | Orient_V (** *)\n\n(** absolute coordinates in the drawing *)\ntype coord = Coord of int * int\n\n(** font size of a text *)\ntype size = Size of int (** *)\n\n(** Text justification of a text *)\ntype justify = J_left | J_right | J_center | J_bottom | J_top (** *)\n\n(** Style of a text *)\ntype style = Bold | Italic | BoldItalic | NoStyle (** *)\n\n(** Color of the text. These are the colors appearing in Kicad schematics *)\ntype kolor = [`NoColor | `Black | `Green | `Red | `Blue | `Brown]\n\n(** Transformation matrix of a relative coordinate around an absolute coordinate.\n The matrix is layed out as a pair of lines of pairs *)\ntype transfo = (int * int) * (int * int)\n\ntype revision =\n | First of string\n | Second of string\n | No_Rev\n\nmodule type Painter = sig\n (** A module able to paint a canvas with several graphic primitives\n and then to process the canvas into a picture file format. The\n functions are supposed to be pure *)\n\n (** the canvas of the painter *)\n type t\n\n val paint_text :\n ?kolor:kolor\n -> String.t\n -> orientation\n -> coord\n -> size\n -> justify\n -> style\n -> t\n -> t\n (** [paint ?kolor text orient coord size justification style canvas]\n adds a [text] with the given [orient], [size], [justification]\n and [style] at the given [coord] to [canvas].\n @return the modified canvas *)\n\n val paint_line : ?kolor:kolor -> ?width:size -> coord -> coord -> t -> t\n (** [paint_line ?kolor width start end canvas] paints a line with\n the given [kolor] and [width] between [start] and [stop] on\n [canvas].\n @return the modified canvas *)\n\n val paint_circle : ?kolor:kolor -> ?fill:kolor -> coord -> int -> t -> t\n (** [paint_circle ?kolor center radius canvas] paints a circle\n filled with the given [kolor] defined by [center] and [radius] on\n [canvas].\n @return the modified canvas *)\n\n val paint_rect : ?kolor:kolor -> ?fill:kolor -> coord -> coord -> t -> t\n (** [paint_rect ?kolor corner1 corner2 canvas] paints a rectangle\n filled with the given [kolor] defined by [corner1] and [corner2]\n on [canvas].\n @return the modified canvas *)\n\n val paint_image : coord -> float -> Buffer.t -> t -> t\n (** [paint_image corner scale png canvas] paints a [png] image\n filled at [corner], scaled at [scale] on [canvas].\n @return the\n modified canvas *)\n\n val paint_arc :\n ?kolor:kolor -> ?fill:kolor -> coord -> coord -> coord -> int -> t -> t\n (** [paint_arc ?kolor center start end radius canvas] paints an arc filled\n with [kolor] between [start] and [end] of [radius] around center on\n [canvas].\n @return the modified canvas *)\n\n val set_canevas_size : int -> int -> t -> t\n (** [set_canevas x y canvas] set the size of the canevas\n\n @return the modified canvas *)\n\n val get_context : unit -> t\n (** [get_context ()]\n @return a new painting canvas *)\nend\n\nmodule type SchPainter = sig\n (** A module able to paint a schematic file in a painter context *)\n\n (** the schematic context *)\n type schContext\n\n (** the underlying context *)\n type painterContext\n\n val initial_context : ?allow_missing_component:bool -> revision -> schContext\n (** [initial_context allow_missing_component revision]\n @return an new empty context *)\n\n val add_lib : string -> schContext -> schContext\n (** [add_lib line context] parse the content of [line] provided to\n libs to the [context].\n @return the updated context *)\n\n val parse_line : String.t -> schContext -> schContext\n (** [parse_line line context] parse a new [line] of schematic and\n update [context].\n @return the updated context *)\n\n val output_context : schContext -> painterContext\n (** [output_context context output] write the [context] as a image\n format to [output] *)\nend\n\nmodule type CompPainter = sig\n (** The library that is able to read component libraries and\n memorize the read components. Then when passed a drawing context\n and a component to paint it can paint the component on demand to\n the drawing context *)\n\n (** A component Library manager *)\n type t\n\n (** A drawing context *)\n type drawContext\n\n val lib : unit -> t\n (** [lib ()]\n @return an empty new component manager *)\n\n val append_lib : string -> t -> t\n (** [append_lib stream context] appends the lib contained in the\n [stream] to the context.\n @return the updated context *)\n\n val plot_comp :\n t -> string -> int -> coord -> transfo -> bool -> drawContext -> drawContext * bool\n (** [plot_comp lib name partnumber origin transformation\n allow_missing context] find in [lib] the component with given\n [name] and plot the part [partnumber] at [origin] after\n [transformation] into the graphical [context] and the fact that\n the component is multipart. If the component is not found, raise\n an exception, unless [allow_missing] is true.\n\n @return the updated graphical context *)\nend\n" }, { "path": "kicadsch/src/kicadlib.ml", "content": "open KicadSch_sigs\n\nmodule MakePainter (P : Painter) : CompPainter with type drawContext := P.t =\nstruct\n open KicadLib_sigs\n\n let pin_orientation_of_string = function\n | \"L\" ->\n P_L\n | \"R\" ->\n P_R\n | \"U\" ->\n P_U\n | \"D\" ->\n P_D\n | s ->\n failwith (\"pin orientation mismatch \" ^ s)\n\n module Lib : Hashtbl.S with type key := string = Hashtbl.Make (struct\n type t = string\n\n let equal = String.equal\n\n let get_i s n = int_of_char s.[n]\n\n let hash s =\n let rec build_hash h i =\n if i < 0 then h else build_hash ((h * 47) + get_i s i) (i - 1)\n in\n build_hash 0 (String.length s - 1)\n end)\n\n type t = component Lib.t * component option * elt list\n\n type drawContext = P.t\n\n let lib () : t = (Lib.create 256, None, [])\n\n open Schparse\n\n let parse_def =\n create_lib_parse_fun ~name:\"component header\"\n ~regexp_str:\"DEF %s %s 0 %d %[YN] %[YN] %d %[FL] %[NP]\"\n ~processing:(fun name _ _ dpnum dpname unit_count _ _ ->\n let draw_pnum = dpnum.[0] = 'Y' in\n let draw_pname = dpname.[0] = 'Y' in\n let nname =\n if name.[0] = '~' then String.sub name 1 (String.length name - 1)\n else name\n in\n let multi = if unit_count = 1 then false else true in\n Some (nname, draw_pnum, draw_pname, multi) )\n\n (** Parsing component drawing primitives **)\n\n (** Parse a poly line\n P Nb parts convert thickness x0 y0 x1 y1 xi yi cc\n **)\n let rec make_double ol il =\n match il with\n | [] ->\n ol\n | [_] ->\n failwith \"make double: odd number of coords!\"\n | x :: y :: tl ->\n make_double (RelCoord (x, y) :: ol) tl\n\n let parse_integers = parse_list \" %d \"\n\n let parse_Poly =\n create_lib_parse_fun ~name:\"polygon\" ~regexp_str:\"P %d %d %d %d %s@@\"\n ~processing:(fun _ parts _ thickness remainder ->\n let coords = List.rev (parse_integers remainder) in\n let finish = remainder.[String.length remainder - 1] = 'F' in\n let coord_list = make_double [] coords in\n let corner_list =\n if finish then\n match coord_list with\n | [_] | [] ->\n coord_list\n | c :: _ ->\n c :: List.rev coord_list\n else List.rev coord_list\n in\n Some {parts; prim= Polygon (thickness, corner_list)} )\n\n let parse_rect =\n create_lib_parse_fun ~name:\"rectangle\"\n ~regexp_str:\"S %d %d %d %d %d %d %d %s\"\n ~processing:(fun x1 y1 x2 y2 parts _ thickness _ ->\n try\n let c1 = RelCoord (x1, y1) in\n let c2 = RelCoord (x2, y2) in\n let rect_poly = [c1; RelCoord (x1, y2); c2; RelCoord (x2, y1); c1] in\n Some {parts; prim= Polygon (thickness, rect_poly)}\n with _ -> None )\n\n let parse_circle =\n create_lib_parse_fun ~name:\"circle\" ~regexp_str:\"C %d %d %d %d %d %d\"\n ~processing:(fun x y radius parts _ width ->\n try\n let center = RelCoord (x, y) in\n Some {parts; prim= Circle (width, {center; radius})}\n with _ -> None )\n\n let parse_pin =\n create_lib_parse_fun ~name:\"pin\"\n ~regexp_str:\"X %s %s %d %d %d %[RLUD] %d %d %d %d %s %s\"\n ~processing:(fun nm nb x y sz o nm_sz nb_sz parts _ _ c ->\n if String.length c = 0 || c.[0] != 'N' then\n try\n let contact = RelCoord (x, y) in\n let length = Size sz in\n let orient = pin_orientation_of_string o in\n let name = (nm, Size nm_sz) in\n let number = (nb, Size nb_sz) in\n Some {parts; prim= Pin {name; number; length; contact; orient}}\n with _ -> None\n else Some {parts= -1; prim= Field} )\n\n let parse_alias =\n create_lib_parse_fun ~name:\"ALIAS\" ~regexp_str:\"ALIAS %s@@\"\n ~processing:(fun sp ->\n Some (parse_list ~cond:(fun s -> String.length s > 0) \" %s \" sp) )\n\n let parse_text =\n create_lib_parse_fun ~name:\"Text\" ~regexp_str:\"T %d %d %d %d %d %d %d %s\"\n ~processing:(fun _ x y sz _ parts _ text ->\n let c = RelCoord (x, y) in\n let s = Size sz in\n Some {parts; prim= Text {c; text; s}} )\n\n let parse_arc =\n create_lib_parse_fun ~name:\"Arc\"\n ~regexp_str:\"A %d %d %d %d %d %d %d %d %s %d %d %d %d\"\n ~processing:(fun x y radius _ _ parts _ sz _ spx spy epx epy ->\n let center = RelCoord (x, y) in\n let sp = RelCoord (spx, spy) in\n let ep = RelCoord (epx, epy) in\n let s = Size sz in\n Some {parts; prim= Arc {sp; ep; s; radius; center}} )\n\n let parse_line line =\n if String.length line > 0 then (\n match line.[0] with\n | 'A' -> (\n match parse_arc line with\n | Some a ->\n a\n | None ->\n failwith (\"Error parsing arc \" ^ line) )\n | 'P' -> (\n match parse_Poly line with\n | Some p ->\n p\n | None ->\n failwith (\"Error parsing poly \" ^ line) )\n | 'S' -> (\n match parse_rect line with\n | Some p ->\n p\n | None ->\n failwith (\"Error parsing rectangle \" ^ line) )\n | 'C' -> (\n match parse_circle line with\n | Some c ->\n c\n | None ->\n failwith (\"Error parsing circle \" ^ line) )\n | 'F' ->\n {parts= -1; prim= Field}\n | 'X' -> (\n match parse_pin line with\n | Some p ->\n p\n | None ->\n failwith (\"Error parsing pin :\" ^ line) )\n | 'T' -> (\n match parse_text line with\n | Some t ->\n t\n | None ->\n failwith (\"Error parsing pin :\" ^ line) )\n | ' ' | '$' ->\n {parts= -1; prim= Field}\n | _ ->\n Printf.printf \"throwing away line '%s'\\n\" line ;\n {parts= -1; prim= Field} )\n else {parts= -1; prim= Field}\n\n let fix_illegal_chars name =\n String.map (function '/' | ':' -> '_' | c -> c) name\n\n let append_lib line (lib, comp_option, acc) =\n match comp_option with\n | None ->\n if\n String.length line > 3\n && String.compare (String.sub line 0 3) \"DEF\" = 0\n then\n match parse_def line with\n | Some (name, draw_pnum, draw_pname, multi) ->\n let new_comp =\n {names= [name]; draw_pnum; draw_pname; multi; graph= []}\n in\n (lib, Some new_comp, [])\n | None ->\n failwith (\"could not parse component definition \" ^ line)\n else (lib, None, [])\n | Some comp ->\n if String.compare line \"DRAW\" = 0 || String.compare line \"ENDDRAW\" = 0\n then (lib, comp_option, acc)\n else if String.compare line \"ENDDEF\" = 0 then (\n let comp = {comp with graph= List.rev acc} in\n List.iter\n (fun name -> Lib.replace lib (fix_illegal_chars name) comp)\n comp.names ;\n (lib, None, []) )\n else if\n String.length line > 6\n && String.compare (String.sub line 0 5) \"ALIAS\" = 0\n then\n match parse_alias line with\n | None ->\n failwith (Printf.sprintf \"ALIAS line %s parse error\\n\" line)\n | Some name_list ->\n ( lib\n , Some {comp with names= List.rev_append comp.names name_list}\n , acc )\n else\n let prim = parse_line line in\n (lib, comp_option, prim :: acc)\n\n let ( +$ ) (Coord (x1, y1)) (RelCoord (x2, y2)) = Coord (x1 + x2, y1 + y2)\n\n let ( *$ ) ((a, b), (c, d)) (RelCoord (x, y)) =\n RelCoord ((a * x) + (b * y), (c * x) + (d * y))\n\n let rotate (origin : coord) (rotation : transfo) (relpoint : relcoord) :\n coord =\n origin +$ (rotation *$ relpoint)\n\n let rec plot_poly rotfun thickness points ctx =\n match points with\n | [] | [_] ->\n ctx\n | c1 :: c2 :: tl ->\n let c1' = rotfun c1 in\n let c2' = rotfun c2 in\n plot_poly rotfun thickness (c2 :: tl) (P.paint_line c1' c2' ctx)\n\n let plot_pin rotfun {name; number; length; contact; orient} c ctx =\n let (RelCoord (x, y)) = contact in\n let (Size delta) = length in\n let sc =\n match orient with\n | P_R ->\n RelCoord (x + delta, y)\n | P_L ->\n RelCoord (x - delta, y)\n | P_U ->\n RelCoord (x, y + delta)\n | P_D ->\n RelCoord (x, y - delta)\n in\n let (Coord (nxsc, nysc) as new_sc) = rotfun sc in\n let (Coord (nx, ny) as new_contact) = rotfun contact in\n let new_J, new_orient =\n if nx > nxsc then (J_right, Orient_H)\n else if nx < nxsc then (J_left, Orient_H)\n else if ny > nysc then (J_top, Orient_V)\n else (J_bottom, Orient_V)\n in\n let name_text, name_size = name in\n let pin_text, pin_size = number in\n let pin_ctx = P.paint_line new_sc new_contact ctx in\n let pname_ctx =\n if c.draw_pname && String.compare \"~\" name_text <> 0 then\n P.paint_text name_text new_orient new_sc name_size new_J NoStyle\n pin_ctx\n else pin_ctx\n in\n if c.draw_pnum && String.compare \"~\" pin_text <> 0 then\n P.paint_text pin_text new_orient new_contact pin_size new_J NoStyle\n pname_ctx\n else pname_ctx\n\n let plot_elt rotfun comp part ctx {parts; prim} =\n if parts = 0 || parts = part then\n match prim with\n | Polygon (t, pts) ->\n plot_poly rotfun t pts ctx\n | Circle (_, {center; radius}) ->\n P.paint_circle (rotfun center) radius ctx\n | Field ->\n ctx\n | Pin p ->\n plot_pin rotfun p comp ctx\n | Text {c; text; s} ->\n P.paint_text text Orient_H (rotfun c) s J_left NoStyle ctx\n | Arc {radius; sp; ep; center; _} ->\n P.paint_arc (rotfun center) (rotfun sp) (rotfun ep) radius ctx\n else ctx\n\n exception Component_Not_Found of string\n\n let plot_comp (lib, _, _) comp_name part rotation origin allow_missing (ctx : drawContext)\n =\n let rot = rotate rotation origin in\n try let thecomp =\n Lib.find lib (fix_illegal_chars comp_name)\n in\n ( List.fold_left (plot_elt rot thecomp part) ctx thecomp.graph\n , thecomp.multi )\n with _ -> if allow_missing then (ctx, false) else raise (Component_Not_Found comp_name)\nend\n" }, { "path": "kicadsch/src/kicadsch.ml", "content": "module Sigs = KicadSch_sigs\nopen Sigs\n\nmodule MakeSchPainter (P : Painter) :\n SchPainter with type painterContext := P.t = struct\n module CPainter = Kicadlib.MakePainter (P)\n\n type rect = {c: coord; dim: coord}\n\n type portrange = Glabel | Hlabel\n\n type labeluse = WireLabel | TextNote\n\n type porttype =\n | UnSpcPort\n | ThreeStatePort\n | OutputPort\n | InputPort\n | NoPort\n | BiDiPort\n\n type linetype = Wire | Bus | Line | WireEntry | BusEntry\n\n type labeltype = PortLabel of portrange * porttype | TextLabel of labeluse\n\n type label = {c: coord; size: size; orient: justify; labeltype: labeltype}\n\n type field =\n { nb: int\n ; text: string\n ; o: orientation\n ; co: coord\n ; s: size\n ; j: justify\n ; stl: style }\n\n type single_reference = {piece: string option; unitnr: int option}\n\n type multi_reference = {m_piece: string; m_unitnr: int}\n\n type component =\n | NoComp\n | Unique of single_reference\n | Multiple of multi_reference list\n\n type componentContext =\n { component: component\n ; sym: string option\n ; origin: coord option\n ; fields: field list }\n\n type bitmapContext =\n {pos: coord option; scale: float option; data: Buffer.t option}\n\n type schParseContext =\n | BodyContext\n | DescrContext of coord\n | WireContext of linetype\n | ComponentContext of componentContext\n | SheetContext of rect option\n | TextContext of label option\n | BitmapContext of bitmapContext\n\n type wireDesc =\n { start: coord\n ; stop: coord }\n\n type connectionDesc = coord\n type wires =\n { wires: wireDesc list\n ; cons: connectionDesc list\n ; buses: wireDesc list\n }\n\n type schContext =\n { wires: wires\n ; lib: CPainter.t\n ; c: schParseContext\n ; canevas: P.t\n ; rev: revision\n ; allow_missing_component: bool\n }\n type ('a, 'b) either =\n Left of 'a | Right of 'b\n\n let initial_context ?allow_missing_component:(allow_missing_component=false) rev = {wires={wires=[]; cons=[]; buses=[]}; lib=CPainter.lib (); c=BodyContext; canevas=P.get_context (); rev; allow_missing_component}\n\n let swap_type = function\n | (UnSpcPort | ThreeStatePort | NoPort | BiDiPort) as p ->\n p\n | OutputPort ->\n InputPort\n | InputPort ->\n OutputPort\n\n let porttype_of_string = function\n | \"U\" | \"UnSpc\" ->\n UnSpcPort\n | \"T\" | \"3State\" ->\n ThreeStatePort\n | \"O\" | \"Output\" ->\n OutputPort\n | \"I\" | \"Input\" ->\n InputPort\n | \"B\" | \"BiDi\" ->\n BiDiPort\n | \"~\" ->\n NoPort\n | _ as s ->\n ignore (Printf.printf \"unknown port type %s\\n\" s) ;\n NoPort\n\n let justify_of_string s =\n match s.[0] with\n | 'L' | '0' ->\n J_left\n | 'R' | '2' ->\n J_right\n | 'C' ->\n J_center\n | 'B' | '1' ->\n J_bottom\n | 'T' | '3' ->\n J_top\n | c ->\n failwith (Printf.sprintf \"no match for justify! (%c)\" c)\n\n let style_of_string s =\n let i = (fst s).[0] and b = (snd s).[0] in\n match (i, b) with\n | 'N', 'B' ->\n Bold\n | 'I', 'N' ->\n Italic\n | 'I', 'B' ->\n BoldItalic\n | 'N', 'N' ->\n NoStyle\n | _ ->\n failwith (Printf.sprintf \"no match for style! (%c %c)\" i b)\n\n let orientation_of_string s =\n match s.[0] with\n | 'H' ->\n Orient_H\n | 'V' ->\n Orient_V\n | c ->\n failwith (Printf.sprintf \"no match for orientation! (%c)\" c)\n\n let orientation_of_justify = function\n | J_left | J_right | J_center ->\n Orient_H\n | J_top | J_bottom ->\n Orient_V\n\n (* Parsing a sch file *)\n open Schparse\n\n let parse_F =\n create_parse_fun ~name:\"Component F\"\n ~regexp_str:\"F %d %S %[HV] %d %d %d %[01] %[LRCBT] %[CLRBTNI]\"\n ~extract_fun:(fun nb name orient posX posY size flags hjust vjustbi ->\n let co = Coord (posX, posY)\n and o = orientation_of_string orient\n and s = Size size\n and j = justify_of_string hjust\n and stl =\n style_of_string (String.sub vjustbi 1 1, String.sub vjustbi 2 1)\n and visible = flags.[3] = '0' && not (String.equal \"~\" name) in\n Some (nb, visible, name, o, co, s, j, stl) )\n\n let parse_L =\n create_parse_fun ~name:\"Component L\" ~regexp_str:\"L %s %s\"\n ~extract_fun:(fun name reference -> Some (name, reference))\n\n let parse_P =\n create_parse_fun ~name:\"Component P\" ~regexp_str:\"P %d %d\"\n ~extract_fun:(fun x y -> Some (Coord (x, y)))\n\n let parse_U =\n create_parse_fun ~name:\"Component U\" ~regexp_str:\"U %d %s %s\"\n ~extract_fun:(fun n mm timestamp -> Some (n, mm, timestamp))\n\n let parse_AR =\n create_parse_fun ~name:\"Component AR\" ~regexp_str:\"AR %s %s %s\"\n ~extract_fun:(fun _ ref_s part_s ->\n let the_ref = String.sub ref_s 5 (String.length ref_s - 6) in\n let the_part =\n int_of_string @@ String.sub part_s 6 (String.length part_s - 7)\n in\n Some (the_ref, the_part) )\n\n let parse_transfo =\n let check x = x = 1 || x = 0 || x = -1 in\n create_parse_fun ~name:\"Component transformation\"\n ~regexp_str:\" %d %d %d %s\" ~extract_fun:(fun a b c ds ->\n if String.length ds > 0 then\n let d = int_of_string ds in\n if check a && check b && check c && check d then\n Some (a, b, c, Some d)\n else (\n Printf.printf \"Bad transfo matrix! %d %d %d %d\\n\" a b c d ;\n None )\n else Some (a, b, c, None) )\n\n let swap_justify = function\n | J_left ->\n J_right\n | J_center ->\n J_center\n | J_right ->\n J_left\n | J_bottom ->\n J_top\n | J_top ->\n J_bottom\n\n let draw_field (Coord (x0, y0)) ((a, b), (c, d)) is_multi refs context\n {nb; text; o; co; s; j; stl} =\n let (Coord (x, y)) = co in\n let xrel = x - x0 and yrel = y - y0 in\n let x' = (a * xrel) + (b * yrel) + x0 in\n let y' = (c * xrel) + (d * yrel) + y0 in\n let o' =\n if a = 0 then\n (* this is a ±90° rotation matrix *)\n match o with Orient_H -> Orient_V | Orient_V -> Orient_H\n else o\n in\n let text =\n if nb != 0 then text\n else\n String.concat \"/\"\n (List.map\n (fun {m_unitnr; m_piece} ->\n if is_multi then\n m_piece\n ^ Char.escaped (char_of_int (m_unitnr + int_of_char 'A' - 1))\n else m_piece )\n refs)\n in\n let j' =\n match o' with\n | Orient_H ->\n if a = -1 || b = -1 then swap_justify j else j\n | Orient_V ->\n if c = 1 || d = -1 then swap_justify j else j\n in\n P.paint_text text o' (Coord (x', y')) s j' stl context\n\n let right_arrow = \"\\xE2\\x96\\xB6\"\n\n let left_arrow = \"\\xE2\\x97\\x80\"\n\n let diamond = \"\\xE2\\x97\\x86\"\n\n let square = \"\\xE2\\x97\\xBC\"\n\n let decorate_port_name name ptype justif =\n let port_char =\n match (ptype, justif) with\n | UnSpcPort, _ | NoPort, _ ->\n \"\"\n | ThreeStatePort, _ | BiDiPort, _ ->\n diamond\n | OutputPort, (J_left | J_top) | InputPort, (J_right | J_bottom) ->\n left_arrow\n | OutputPort, (J_right | J_bottom) | InputPort, (J_left | J_top) ->\n right_arrow\n | _, J_center ->\n square\n in\n match justif with\n | J_left | J_top ->\n port_char ^ name\n | J_right | J_bottom ->\n name ^ port_char\n | J_center ->\n name\n\n let draw_port ?(kolor = `Black) name ptype justif (Coord (x, y))\n (Size l as s) canevas =\n let new_port_name = decorate_port_name name ptype justif in\n let orient = orientation_of_justify justif in\n let j = justif in\n let _ = kolor in\n let c =\n match orient with\n | Orient_H ->\n Coord (x, y + (l / 4))\n | Orient_V ->\n Coord (x + (l / 4), y)\n in\n P.paint_text new_port_name orient c s j NoStyle canevas\n\n let parse_component_line lib (line : string) (comp : componentContext) allow_missing\n canevas : componentContext * P.t =\n let update_comp comp = (comp, canevas) in\n if String.length line == 0 then\n comp, canevas\n else\n let first = line.[0] in\n match first with\n | 'A' ->\n update_comp\n @@ parse_AR line\n ~onerror:(fun () -> comp)\n ~process:(fun (the_ref, the_unit) ->\n if the_ref.[String.length the_ref - 1] = '?' then comp\n else\n let new_name = {m_piece= the_ref; m_unitnr= the_unit} in\n let component =\n Multiple\n ( match comp.component with\n | NoComp | Unique _ ->\n [new_name]\n | Multiple l ->\n new_name :: l )\n in\n {comp with component} )\n | 'F' ->\n update_comp\n @@ parse_F line\n ~onerror:(fun () -> comp)\n ~process:(fun (nb, visible, text, o, co, s, j, stl) ->\n if visible && String.length text > 0 then\n {comp with fields= {nb; text; o; co; s; j; stl} :: comp.fields}\n else comp )\n | 'U' ->\n update_comp\n @@ parse_U line\n ~onerror:(fun () -> comp)\n ~process:(fun (u, _, _) ->\n let component =\n match comp.component with\n | NoComp ->\n Unique {piece= None; unitnr= Some u}\n | Unique r ->\n Unique {r with unitnr= Some u}\n | Multiple _ ->\n comp.component\n in\n {comp with component} )\n | 'P' ->\n update_comp\n @@ parse_P line\n ~onerror:(fun () -> comp)\n ~process:(fun c -> {comp with origin= Some c})\n | 'L' ->\n update_comp\n @@ parse_L line\n ~onerror:(fun () -> comp)\n ~process:(fun (sym_s, n) ->\n let component =\n match comp.component with\n | NoComp ->\n Unique {piece= Some n; unitnr= None}\n | Unique r ->\n Unique {r with piece= Some n}\n | Multiple _ ->\n comp.component\n in\n let sym = Some sym_s in\n {comp with component; sym} )\n | '\t' ->\n parse_transfo line\n ~onerror:(fun () -> (comp, canevas))\n ~process:(fun (a, b, c, d_opt) ->\n match d_opt with\n | Some d -> (\n let {component; origin; fields; sym} = comp in\n match (origin, sym) with\n | Some origin, Some sym -> (\n let res =\n match component with\n | Unique {unitnr= Some m_unitnr; piece= Some m_piece} ->\n Some ([{m_unitnr; m_piece}], m_unitnr)\n | Multiple m -> (\n match m with\n | [] ->\n None\n | c :: _ ->\n Some (m, c.m_unitnr) )\n | Unique {unitnr= None; _}\n | Unique {piece= None; _}\n | NoComp ->\n None\n in\n match res with\n | None ->\n Printf.printf\n \"cannot plot component with missing definitions !\" ;\n (comp, canevas)\n | Some (refs, m_unitnr) ->\n let transfo = ((a, b), (c, d)) in\n let canevas', is_multi =\n CPainter.plot_comp lib sym m_unitnr origin transfo allow_missing\n canevas\n in\n let draw = draw_field origin transfo is_multi refs in\n (comp, List.fold_left draw canevas' fields) )\n | _ ->\n Printf.printf\n \"cannot plot component with missing definitions !\" ;\n (comp, canevas) )\n | None ->\n (comp, canevas) )\n | _ ->\n ignore (Printf.printf \"ignored %s\\n\" line) ;\n (comp, canevas)\n\n let parse_wire_wire =\n create_parse_fun ~name:\"Wire header\" ~regexp_str:\"%s %s %s\"\n ~extract_fun:(fun kind width line ->\n match (kind, width, line) with\n | \"Wire\", \"Wire\", \"Line\" ->\n Some Wire\n | \"Wire\", \"Bus\", \"Line\" ->\n Some Bus\n | \"Wire\", \"Notes\", \"Line\" ->\n Some Line\n | \"Wire\", \"Wire\", \"Note\" ->\n Some Line\n | \"Entry\", \"Wire\", \"Line\" ->\n Some WireEntry\n | \"Entry\", \"Bus\", \"Line\" ->\n Some BusEntry\n | _, _, _ ->\n None )\n\n let parse_wire_line =\n create_parse_fun ~name:\"Wire\" ~regexp_str:\" %d %d %d %d\"\n ~extract_fun:(fun x1 y1 x2 y2 ->\n let c1 = Coord (x1, y1) and c2 = Coord (x2, y2) in\n Some (c1, c2) )\n\n let parse_noconn_line =\n create_parse_fun ~name:\"NoConn\" ~regexp_str:\"NoConn ~ %d %d\"\n ~extract_fun:(fun x y -> Some (Coord (x, y)))\n\n let parse_conn_line =\n create_parse_fun ~name:\"Connection\" ~regexp_str:\"Connection ~ %d %d\"\n ~extract_fun:(fun x y -> Some (Coord (x, y)))\n\n let parse_sheet_field01 =\n create_parse_fun ~name:\"Sheet Field 0 or 1\" ~regexp_str:\"F%[01] %S %d\"\n ~extract_fun:(fun num name size ->\n let number = int_of_string num in\n Some (number, name, Size size) )\n\n let parse_sheet_other_fields =\n create_parse_fun ~name:\"Sheet generic field\"\n ~regexp_str:\"F%d %S %[IOBTU] %[RLTB] %d %d %d\"\n ~extract_fun:(fun _ name t j x y sz ->\n let ptype = porttype_of_string t in\n let justif = justify_of_string j in\n let c = Coord (x, y) in\n let s = Size sz in\n Some (name, ptype, justif, c, s) )\n\n let parse_sheet_field =\n create_parse_fun ~name:\"detect sheet field\" ~regexp_str:\"F%d\"\n ~extract_fun:(fun num -> Some num)\n\n let parse_sheet_rect =\n create_parse_fun ~name:\"Sheet Rect\" ~regexp_str:\"S %d %d %d %d\"\n ~extract_fun:(fun x1 y1 x2 y2 ->\n let c = Coord (x1, y1) and dim = Coord (x2, y2) in\n Some {c; dim} )\n\n let parse_text_line =\n create_parse_fun ~name:\"Text header\" ~regexp_str:\"Text %s %d %d %s %d %s\"\n ~extract_fun:(fun ltype x y j s lorient ->\n let c = Coord (x, y) and j = justify_of_string j and size = Size s in\n let labeltype, orient =\n match ltype with\n | \"GLabel\" ->\n (PortLabel (Glabel, porttype_of_string lorient), swap_justify j)\n | \"HLabel\" ->\n (PortLabel (Hlabel, porttype_of_string lorient), swap_justify j)\n | \"Label\" ->\n (TextLabel WireLabel, j)\n | \"Notes\" ->\n (TextLabel TextNote, j)\n | _ ->\n (TextLabel TextNote, j)\n in\n let result : label option = Some {size; orient; labeltype; c} in\n result )\n\n let parse_descr_header =\n create_parse_fun ~name:\"Descr header\" ~regexp_str:\"$Descr %s %d %d\"\n ~extract_fun:(fun format x y -> Some (format, Coord (x, y)))\n\n let parse_descr_body =\n create_parse_fun ~name:\"Description line\" ~regexp_str:\"%s %s@^\"\n ~extract_fun:(fun field value ->\n if value.[0] = '\"' then\n let new_val = String.sub value 1 (String.length value - 2) in\n Some (field, new_val)\n else Some (field, value) )\n\n let parse_bm_pos =\n create_parse_fun ~name:\"Bitmap Pos\" ~regexp_str:\"Pos %d %d\"\n ~extract_fun:(fun x y -> Some (Coord (x, y)))\n\n let parse_bm_scale =\n create_parse_fun ~name:\"Bitmap Scale\" ~regexp_str:\"Scale %f\"\n ~extract_fun:(fun sc -> Some sc)\n\n (* Printing things *)\n\n let split_lines line =\n let len = String.length line in\n let rec split lstart lend (acc : string list) =\n if lend < len - 1 then\n if line.[lend] = '\\\\' && line.[lend + 1] = 'n' then\n split (lend + 2) (lend + 2)\n (String.sub line lstart (lend - lstart) :: acc)\n else split lstart (lend + 1) acc\n else String.sub line lstart (len - lstart) :: acc\n in\n split 0 0 []\n\n let print_text_line line l c =\n match l.labeltype with\n | TextLabel t ->\n let pcolor = match t with TextNote -> `Green | WireLabel -> `Red in\n let (Size s) = l.size in\n let (Coord (x, y)) = l.c in\n let paint_line c' (line_index, l') =\n P.paint_text ~kolor:pcolor l'\n (orientation_of_justify l.orient)\n (Coord (x, y - (line_index * s)))\n l.size l.orient NoStyle c'\n in\n let lines = split_lines line in\n List.fold_left paint_line c (List.mapi (fun i l -> (i, l)) lines)\n | PortLabel (prange, ptype) ->\n let pcolor = match prange with Glabel -> `Green | Hlabel -> `Red in\n let new_type = swap_type ptype in\n draw_port ~kolor:pcolor line new_type l.orient l.c l.size c\n\n let plot_page_frame (Coord (x, y)) canevas =\n let b_width = 100 in\n let f_width = 4000 in\n let bot_x = x - b_width in\n let bot_y = y - b_width in\n let frame_x = bot_x - f_width in\n canevas\n |> P.paint_rect\n (Coord (b_width, b_width))\n (Coord (x - (2 * b_width), y - (2 * b_width)))\n |> P.paint_rect (Coord (frame_x, bot_y - 150)) (Coord (f_width, 150))\n |> P.paint_rect (Coord (frame_x, bot_y - 250)) (Coord (f_width, 100))\n |> P.paint_rect (Coord (frame_x, bot_y - 550)) (Coord (f_width, 400))\n\n let plot_bitmap b context =\n match (b.pos, b.scale, b.data) with\n | Some p, Some s, Some d ->\n P.paint_image p s d context\n | _ ->\n context\n\n (* high level parsing *)\n\n let parse_sheet_line line context canevas =\n match line.[0] with\n | 'F' ->\n ( context\n , parse_sheet_field line\n ~onerror:(fun () -> canevas)\n ~process:(fun number ->\n if number < 2 then\n parse_sheet_field01 line\n ~onerror:(fun () -> canevas)\n ~process:(fun (number, name, (Size size as s)) ->\n match context with\n | Some {c= Coord (x, y); dim= Coord (_, dim_y)} ->\n let y = if number = 0 then y else y + dim_y + size in\n P.paint_text name Orient_H\n (Coord (x, y))\n s J_left NoStyle canevas\n | None ->\n canevas )\n else\n parse_sheet_other_fields line\n ~onerror:(fun () -> canevas)\n ~process:(fun (name, ptype, justif, c, s) ->\n draw_port name ptype justif c s canevas ) ) )\n | 'S' ->\n parse_sheet_rect line\n ~onerror:(fun () -> (context, canevas))\n ~process:(fun ({c; dim} as range) ->\n (Some range, P.paint_rect c dim canevas) )\n | 'U' ->\n (context, canevas)\n | _ ->\n Printf.printf \"unknown sheet line (%s)\" line ;\n (context, canevas)\n\n let starts_with str p =\n let len = String.length p in\n if String.length str < len then false\n else\n let rec comp_rec str p i =\n if str.[i] <> p.[i] then false\n else if i = len - 1 then true\n else comp_rec str p (i + 1)\n in\n comp_rec str p 0\n\n let parse_body_line ctx line =\n if String.compare line \"$Comp\" = 0 then\n {ctx with c=ComponentContext\n {component= NoComp; sym= None; origin= None; fields= []}}\n\n else if String.compare line \"$Bitmap\" = 0 then\n {ctx with c=BitmapContext {pos= None; scale= None; data= None}}\n else if starts_with line \"$Descr\" then\n parse_descr_header line\n ~onerror:(fun () -> {ctx with c=BodyContext})\n ~process:(fun (_, (Coord (x, y) as f_left)) ->\n {ctx with c=DescrContext (Coord (x - 4000, y - 100))\n ;canevas=plot_page_frame f_left (P.set_canevas_size x y ctx.canevas) } )\n else if starts_with line \"Wire\" || starts_with line \"Entry\" then\n ( parse_wire_wire line\n ~onerror:(fun () -> {ctx with c=BodyContext})\n ~process:(fun lt -> {ctx with c=WireContext lt}))\n else if starts_with line \"NoConn\" then\n {ctx with c=BodyContext\n ; canevas=(parse_noconn_line line\n ~onerror:(fun () -> ctx.canevas)\n ~process:(fun (Coord (x, y)) ->\n let delta = 20 in\n ctx.canevas\n |> P.paint_line\n (Coord (x - delta, y - delta))\n (Coord (x + delta, y + delta))\n |> P.paint_line\n (Coord (x - delta, y + delta))\n (Coord (x + delta, y - delta)) ) ) }\n else if starts_with line \"Connection\" then\n parse_conn_line line\n ~onerror:(fun () -> ctx)\n ~process:(fun conn_c -> {ctx with c=BodyContext\n ; canevas=(\n let delta = 10 in\n P.paint_circle ~fill:`Black conn_c delta ctx.canevas)\n ;wires={ctx.wires with cons=conn_c::ctx.wires.cons}} )\n else if String.compare line \"$Sheet\" = 0 then {ctx with c=SheetContext None}\n else if starts_with line \"Text\" then\n let lab : label option =\n parse_text_line line\n ~onerror:(fun () -> None)\n ~process:(fun l -> Some l)\n in\n {ctx with c=TextContext lab}\n else {ctx with c=BodyContext}\n\n let parse_descr_line line (Coord (x, y)) canevas =\n parse_descr_body line\n ~onerror:(fun () -> canevas)\n ~process:(fun (field, content) ->\n if String.length content > 0 then\n let title_text content x y s =\n P.paint_text content Orient_H\n (Coord (x, y))\n (Size s) J_left NoStyle canevas\n in\n match field with\n | \"Sheet\" ->\n title_text (\"Page: \" ^ content) x (y - 200) 50\n | \"Title\" ->\n title_text (\"Title: \" ^ content) x (y - 50) 100\n | \"Rev\" ->\n title_text (\"Rev: \" ^ content) (x + 3200) (y - 50) 100\n | \"Date\" ->\n title_text (\"Date: \" ^ content) (x + 500) (y - 200) 50\n | \"Comp\" ->\n title_text content (x + 1000) (y - 200) 50\n | \"Comment1\" ->\n title_text content x (y - 400) 50\n | \"Comment2\" ->\n title_text content (x + 2000) (y - 400) 50\n | \"Comment3\" ->\n title_text content x (y - 300) 50\n | \"Comment4\" ->\n title_text content (x + 2000) (y - 300) 50\n | _ ->\n canevas\n else canevas )\n\n let append_bm_line data_opt line =\n match data_opt with\n | None ->\n failwith \"not adding data to None image\"\n | Some buf ->\n parse_list \" %x \" line |> List.rev_map char_of_int\n |> List.iter (Buffer.add_char buf)\n\n let parse_bitmap_line line b =\n if starts_with line \"Pos\" then\n { b with\n pos=\n parse_bm_pos line\n ~onerror:(fun () -> b.pos)\n ~process:(fun c -> Some c) }\n else if starts_with line \"Scale\" then\n { b with\n scale=\n parse_bm_scale line\n ~onerror:(fun () -> b.scale)\n ~process:(fun s -> Some s) }\n else if starts_with line \"Data\" then\n {b with data= Some (Buffer.create 1000)}\n else ( append_bm_line b.data line ; b )\n\n let write_revision (Coord(x, y)) ctx =\n match ctx.rev with\n | First s ->\n P.paint_text s Orient_H\n (Coord (x, y + 50))\n (Size 50) J_left NoStyle ctx.canevas\n | Second s ->\n P.paint_text s Orient_H\n (Coord (x + 2200, y + 50))\n (Size 50) J_left NoStyle ctx.canevas\n | No_Rev -> ctx.canevas\n\n\n let parse_line line (ctx:schContext) =\n match ctx.c with\n | DescrContext page_size as c ->\n if String.compare line \"$EndDescr\" = 0 then\n let canevas = write_revision page_size ctx in\n {ctx with c=BodyContext; canevas}\n else {ctx with c;canevas=(parse_descr_line line page_size ctx.canevas)}\n | ComponentContext comp ->\n if String.compare line \"$EndComp\" = 0 then {ctx with c=BodyContext}\n else\n let comp, canevas = parse_component_line ctx.lib line comp ctx.allow_missing_component ctx.canevas in\n {ctx with c=ComponentContext comp; canevas}\n | BodyContext ->\n parse_body_line ctx line\n | WireContext l ->\n parse_wire_line line\n ~onerror:(fun () -> {ctx with c=BodyContext})\n ~process:(fun (start, stop) ->\n let paint_param =\n match l with\n | Bus -> Right true\n | BusEntry ->\n Left ((`Blue, Size 5), true)\n | Wire -> Right false\n | WireEntry ->\n Left ((`Brown, Size 2), true)\n | Line ->\n Left ((`Black, Size 2), false)\n in\n begin\n match paint_param with\n | Left ((kolor, width), isEntry) ->\n if isEntry then\n {ctx with\n c=BodyContext;canevas=P.paint_line ~kolor ~width start stop ctx.canevas\n ; wires={ctx.wires with cons=start::stop::ctx.wires.cons}}\n else\n {ctx with c=BodyContext;canevas=P.paint_line ~kolor ~width start stop ctx.canevas}\n | Right isBus ->\n if isBus then\n {ctx with c=BodyContext; wires={ctx.wires with buses={start; stop}::ctx.wires.buses}}\n else\n {ctx with c=BodyContext; wires={ctx.wires with wires={start; stop}::ctx.wires.wires}}\n end)\n | SheetContext sc ->\n if String.compare line \"$EndSheet\" = 0 then {ctx with c=BodyContext}\n else\n let nsc, canevas = parse_sheet_line line sc ctx.canevas in\n {ctx with c=SheetContext nsc; canevas}\n | TextContext sc -> (\n match sc with\n | None ->\n failwith \"TextContext without definition!\"\n | Some v ->\n {ctx with c=BodyContext; canevas= print_text_line line v ctx.canevas} )\n | BitmapContext b ->\n if String.compare line \"$EndBitmap\" = 0 then\n {ctx with c=BodyContext; canevas=plot_bitmap b ctx.canevas}\n else\n let nb = parse_bitmap_line line b in\n {ctx with c=BitmapContext nb}\n module type OrderedCoord =\n sig\n val compare: coord -> coord -> int\n end\n\n module SegmentCutter(O:OrderedCoord):(sig val cut_wires: wireDesc list -> coord list -> kolor:kolor -> width:size -> P.t -> P.t end) =\n struct\n module SegmentSet = Set.Make(struct\n type t = wireDesc\n let compare {start=start1; _} {start=start2; _} = O.compare start1 start2\n end)\n\n let point_in_segment c {start; stop} =\n (O.compare start c <= 0) && (O.compare stop c >= 0)\n\n let con_in_a_segment c set =\n match SegmentSet.find_first_opt (fun {stop; _} -> (O.compare stop c > 0)) set with\n | None -> None\n | Some ({start; _} as seg) ->\n if O.compare start c < 0 then\n Some seg\n else\n None\n ;;\n\n let point_in_a_segment c set =\n match SegmentSet.find_first_opt (fun {stop; _} -> (O.compare stop c >= 0)) set with\n | None -> None\n | Some ({start; _} as seg) ->\n if O.compare start c <= 0 then\n Some seg\n else\n None\n ;;\n\n let cut_wire set con =\n match con_in_a_segment con set with\n | None -> set\n | Some ({start; stop} as seg) ->\n set |> SegmentSet.remove seg |> SegmentSet.add {start; stop=con} |> SegmentSet.add {start=con;stop}\n ;;\n\n let merge_segment ~set seg =\n SegmentSet.filter (fun {start=stt; _} -> not( point_in_segment stt seg)) set\n |>SegmentSet.add seg\n ;;\n\n let insert_segment set {start; stop} =\n let start, stop = if O.compare start stop <= 0 then\n start, stop\n else\n stop, start in\n match (point_in_a_segment start set), (point_in_a_segment stop set) with\n | None, None ->\n merge_segment ~set {start; stop}\n | Some ({start=stt; _}), None ->\n merge_segment ~set {start=stt; stop}\n | None, Some {stop=stp; _} ->\n merge_segment ~set {start; stop=stp}\n | Some {start=stt; _}, Some {stop=stp; _} ->\n merge_segment ~set {start=stt; stop=stp}\n ;;\n\n let cut_wires seg_list junctions ~kolor ~width canevas =\n let seg_set = List.fold_left insert_segment SegmentSet.empty seg_list in\n let split_set = List.fold_left cut_wire seg_set junctions in\n SegmentSet.fold (fun {start; stop} canevas -> P.paint_line ~kolor ~width start stop canevas) split_set canevas\n ;;\n end\n\n module VerticalSet = SegmentCutter(\n struct\n let compare (Coord (xs0, ys0)) (Coord (xs1, ys1)) =\n match Stdlib.compare xs0 xs1 with\n | 0 -> Stdlib.compare ys0 ys1\n | c -> c\n end)\n\n module HorizontalSet = SegmentCutter(\n struct\n let compare (Coord (xs0, ys0)) (Coord (xs1, ys1)) =\n match Stdlib.compare ys0 ys1 with\n | 0 -> Stdlib.compare xs0 xs1\n | c -> c\n end)\n\n let cut_all_wires junctions wires ~kolor ~width canevas =\n let vertical, horizontal = List.partition (fun {start=Coord (x1, _); stop=Coord (x2, _)} -> x1 == x2) wires in\n VerticalSet.cut_wires vertical junctions ~kolor ~width canevas |>\n HorizontalSet.cut_wires horizontal junctions ~kolor ~width\n\n let cut_wires_and_buses {wires;buses;cons} canevas =\n cut_all_wires cons wires ~kolor:`Brown ~width:(Size 2) canevas |>\n cut_all_wires cons buses ~kolor:`Blue ~width:(Size 5)\n\n let output_context ({canevas; wires;_ }:schContext) = cut_wires_and_buses wires canevas\n\n let add_lib line ctxt =\n CPainter.append_lib line ctxt.lib |> fun lib -> {ctxt with lib}\nend\n" }, { "path": "kicadsch/src/schparse.ml", "content": "(** This function generates a parsing function which outputs an 'a\n option Note that some lines may not yield any correct output, so\n the output is an option. **)\nlet create_lib_parse_fun ~name ~regexp_str ~processing =\n let parser line =\n try Scanf.sscanf line regexp_str processing with\n | End_of_file ->\n Printf.printf \"could not match %s (%s): line to short\\n\" name line ;\n None\n | Scanf.Scan_failure m ->\n Printf.printf \"could not match %s (%s): %s\\n\" name line m ;\n None\n in\n parser\n\nlet create_parse_fun ~name ~regexp_str ~extract_fun =\n let parser line ~onerror ~process =\n try\n match Scanf.sscanf line regexp_str extract_fun with\n | None ->\n Printf.printf \"Fields of %s could not be parsed (%s)\\n\" name line ;\n onerror ()\n | Some args ->\n process args\n with\n | End_of_file ->\n Printf.printf \"could not match %s (%s): line to short\\n\" name line ;\n onerror ()\n | Scanf.Scan_failure m ->\n Printf.printf \"could not match %s (%s): %s\\n\" name line m ;\n onerror ()\n in\n parser\n\nlet parse_list ?(cond = fun _ -> true) form s =\n let stream = Scanf.Scanning.from_string s in\n let rec do_parse acc =\n try\n let new_val = Scanf.bscanf stream form (fun x -> x) in\n if cond new_val then do_parse (new_val :: acc) else acc\n with\n | Scanf.Scan_failure _ ->\n acc\n | End_of_file ->\n acc\n in\n do_parse []\n" }, { "path": "kicadsch/test/dune", "content": "(tests\n (names test)\n (libraries\n oUnit\n kicadsch\n )\n (flags (:standard -w -27 ))\n )\n" }, { "path": "kicadsch/test/stubPainter.ml", "content": "open Kicadsch.Sigs\n\ntype t = string list\n\nlet string_of_justification = function\n | J_left -> \"J_left\"\n | J_right -> \"J_right\"\n | J_center -> \"J_center\"\n | J_bottom -> \"J_bottom\"\n | J_top -> \"J_top\"\n\nlet string_of_style = function\n | Bold -> \"Bold\"\n | Italic -> \"Italic\"\n | BoldItalic -> \"BoldItalic\"\n | NoStyle -> \"NoStyle\"\n\nlet string_of_orientation = function\n | Orient_H -> \"Orient_H\"\n | Orient_V -> \"Orient_V\"\n\nlet string_of_kolor = function\n | `NoColor -> \"NoColor\"\n | `Black -> \"Black\"\n | `Green -> \"Green\"\n | `Red -> \"Red\"\n | `Blue -> \"Blue\"\n | `Brown -> \"Brown\"\n\nlet paint_text ?(kolor=`Black) t (o:orientation) (Coord (x,y)) (Size size) justif styl c =\n (Printf.sprintf \"Text %s %s %s %d %d %d %s %s\" (string_of_kolor kolor) t (string_of_orientation o) x y size (string_of_justification justif) (string_of_style styl) ):: c\n\nlet paint_line ?(kolor=`NoColor) ?(width=Size 1) (Coord (x1, y1)) (Coord (x2, y2)) c =\n (Printf.sprintf \"Line %d %d - %d %d\" x1 y1 x2 y2) :: c\n\nlet paint_rect ?(kolor=`NoColor) ?(fill=`NoColor) (Coord(x, y)) (Coord (dim_x, dim_y)) c =\n c\n\nlet paint_circle ?(kolor=`NoColor) ?(fill=`NoColor) (Coord(x, y)) radius c =\n c\n\nlet paint_arc ?(kolor=`NoColor) ?(fill=`NoColor) c1 c2 c3 r c =\n c\n\nlet paint_image co s b c =\n c\nlet get_context () = []\n\nlet set_canevas_size _ _ c =\n c\n\nlet write c = c\n" }, { "path": "kicadsch/test/test.ml", "content": "open OUnit\nopen StdLabels\n\nmodule MUT = Kicadsch.MakeSchPainter(StubPainter)\nlet initial_sheet = {|EESchema Schematic File Version 4\nEELAYER 26 0\nEELAYER END\n|}\n\nlet initial_lib ={|DEF C C 0 10 N Y 1 F N\nF0 \"C\" 25 100 50 H V L CNN\nF1 \"C\" 25 -100 50 H V L CNN\nF2 \"\" 38 -150 50 H I C CNN\nF3 \"\" 0 0 50 H I C CNN\n$FPLIST\n C_*\n$ENDFPLIST\nDRAW\nENDDRAW\nENDDEF\n|}\n\nlet init () =\n let lib_lines =\n initial_lib\n |> String.split_on_char ~sep:'\\n'\n |> List.fold_left ~f:(fun a b -> MUT.add_lib b a) ~init:(MUT.initial_context No_Rev) in\n initial_sheet\n |> String.split_on_char ~sep:'\\n'\n |> List.fold_left ~f:(fun a b -> MUT.parse_line b a) ~init:lib_lines\n;;\n\n\nlet test_printable_F_line () =\n let u =\n {|\n$Comp\nL C C?\nU 1 1 5FE7760D\nP 3750 2500\nF 0 \"C?\" H 3865 2546 50 0001 L CNN\nF 1 \"C\" H 3865 2455 50 0000 L CNN\nF 2 \"\" H 3788 2350 50 0001 C CNN\nF 3 \"~\" H 3750 2500 50 0001 C CNN\n\t1 3750 2500\n\t1 0 0 -1\n$EndComp\n$EndSCHEMATC|}\n |> String.split_on_char ~sep:'\\n'\n |> List.fold_left ~f:(fun a b -> MUT.parse_line b a) ~init:(init ()) in\n let output = StubPainter.write (MUT.output_context u) in\n match output with\n | [] -> assert_failure \"Field should have been printed\"\n | [v] -> assert_equal v \"Text Black C Orient_H 3865 2545 50 J_left NoStyle\"\n | u::v::w ->List.iter ~f:(Printf.printf \"%s\\n\") output;assert_failure \"Only one line should be printed\\n\"\n;;\n\nlet test_escaped_F_line () =\n let u =\n {|\n$Comp\nL C C?\nU 1 1 5FE7760D\nP 3750 2500\nF 0 \"C?\" H 3865 2546 50 0001 L CNN\nF 1 \"C\\\" 3\" H 3865 2455 50 0000 L CNN\nF 2 \"\" H 3788 2350 50 0001 C CNN\nF 3 \"~\" H 3750 2500 50 0001 C CNN\n\t1 3750 2500\n\t1 0 0 -1\n$EndComp\n$EndSCHEMATC|}\n |> String.split_on_char ~sep:'\\n'\n |> List.fold_left ~f:(fun a b -> MUT.parse_line b a) ~init:(init ()) in\n let output = StubPainter.write (MUT.output_context u) in\n match output with\n | [] -> assert_failure \"Field should have been printed\"\n | [v] -> assert_equal v \"Text Black C\\\" 3 Orient_H 3865 2545 50 J_left NoStyle\"\n | u::v::w -> assert_failure \"Only one line should be printed\"\n;;\n\nlet test_zero_length_lines () =\n let u =\n {|\n$Comp\nL C C?\nU 1 1 5FE7760D\nP 3750 2500\nF 0 \"C?\" H 3865 2546 50 0001 L CNN\nF 1 \"~\" H 3865 2455 50 0000 L CNN\nF 2 \"\" H 3788 2350 50 0001 C CNN\nF 3 \"~\" H 3750 2500 50 0001 C CNN\n\t1 3750 2500\n\t1 0 0 -1\n$EndComp\n$EndSCHEMATC|}\n |> String.split_on_char ~sep:'\\n'\n |> List.fold_left ~f:(fun a b -> MUT.parse_line b a) ~init:(init ()) in\n let output = StubPainter.write (MUT.output_context u) in\n match output with\n | [] -> ()\n | _ -> assert_failure \"Field should not have been printed\"\n;;\n\nlet match_wire_line () =\n let line = \"\t5500 1700 5500 2200\" in\n let u = MUT.parse_line \"Wire Wire Line\" (init ()) in\n let v = MUT.parse_line line u in\n match StubPainter.write (MUT.output_context v) with\n | [v] -> ()\n | _ -> assert_failure \"Wire line should have matched\"\n;;\n\nlet segment_horizontal_wire wire_type () =\n let u =\n Printf.sprintf {|Wire %s Line\n\t5500 1700 5500 2200\nConnection ~ 5500 1800\nEntry Wire Line\n\t5500 2000 5550 2050\nEntry Bus Line\n\t5500 2100 5550 2150 5550\n|} wire_type\n\n |> String.split_on_char ~sep:'\\n'\n |> List.fold_left ~f:(fun a b -> MUT.parse_line b a) ~init:(init ()) in\n let output = StubPainter.write (MUT.output_context u) in\n assert_bool \"Connection segment present\" (List.mem \"Line 5500 1700 - 5500 1800\" ~set:output);\n assert_bool \"Entry wire segment present\" (List.mem \"Line 5500 1800 - 5500 2000\" ~set:output);\n assert_bool \"Entry bus segment present\" (List.mem \"Line 5500 2000 - 5500 2100\" ~set:output);\n assert_bool \"Fourth segment present\" (List.mem \"Line 5500 2100 - 5500 2200\" ~set:output)\n\nlet segment_inverse_horizontal_wire wire_type () =\n let u =\n Printf.sprintf {|Wire %s Line\n\t5500 2200 5500 1700\nConnection ~ 5500 1800\nEntry Wire Line\n\t5500 2000 5550 2050\nEntry Bus Line\n\t5500 2100 5550 2150\n|} wire_type\n |> String.split_on_char ~sep:'\\n'\n |> List.fold_left ~f:(fun a b -> MUT.parse_line b a) ~init:(init ()) in\n let output = StubPainter.write (MUT.output_context u) in\n assert_bool \"Connection segment present\" (List.mem \"Line 5500 1700 - 5500 1800\" ~set:output);\n assert_bool \"Entry wire segment present\" (List.mem \"Line 5500 1800 - 5500 2000\" ~set:output);\n assert_bool \"Entry bus segment present\" (List.mem \"Line 5500 2000 - 5500 2100\" ~set:output);\n assert_bool \"Fourth segment present\" (List.mem \"Line 5500 2100 - 5500 2200\" ~set:output)\n;;\n\nlet segment_vertical_wire wire_type () =\n let u =\n Printf.sprintf {|Wire %s Line\n\t 1700 5500 2200 5500\nConnection ~ 1800 5500\nEntry Wire Line\n\t2000 5500 2050 5550\nEntry Bus Line\n\t2100 5500 2150 5550\n|} wire_type\n |> String.split_on_char ~sep:'\\n'\n |> List.fold_left ~f:(fun a b -> MUT.parse_line b a) ~init:(init ()) in\n let output = StubPainter.write (MUT.output_context u) in\n assert_bool \"Connection segment present\" (List.mem \"Line 1700 5500 - 1800 5500\" ~set:output);\n assert_bool \"Entry wire segment present\" (List.mem \"Line 1800 5500 - 2000 5500\" ~set:output);\n assert_bool \"Entry bus segment present\" (List.mem \"Line 2000 5500 - 2100 5500\" ~set:output);\n assert_bool \"Fourth segment present\" (List.mem \"Line 2100 5500 - 2200 5500\" ~set:output)\n;;\n\nlet segment_inverse_vertical_wire wire_type () =\n let u =\n Printf.sprintf {|Wire %s Line\n\t 2200 5500 1700 5500\nConnection ~ 1800 5500\nEntry Wire Line\n\t2000 5500 2050 5550\nEntry Bus Line\n\t2100 5500 2150 5550\n|} wire_type\n |> String.split_on_char ~sep:'\\n'\n |> List.fold_left ~f:(fun a b -> MUT.parse_line b a) ~init:(init ()) in\n let output = StubPainter.write (MUT.output_context u) in\n assert_bool \"Connection segment present\" (List.mem \"Line 1700 5500 - 1800 5500\" ~set:output);\n assert_bool \"Entry wire segment present\" (List.mem \"Line 1800 5500 - 2000 5500\" ~set:output);\n assert_bool \"Entry bus segment present\" (List.mem \"Line 2000 5500 - 2100 5500\" ~set:output);\n assert_bool \"Fourth segment present\" (List.mem \"Line 2100 5500 - 2200 5500\" ~set:output)\n;;\n\nlet segment_vertical_wire_test () =\n let u =\n {|Wire Wire Line\n\t6000 1150 6000 2750\nWire Wire Line\n\t6000 1350 6000 1350\nConnection ~ 6000 1350\nConnection ~ 6000 2050\nConnection ~ 6000 1250\nConnection ~ 6000 1150\n|}\n |> String.split_on_char ~sep:'\\n'\n |> List.fold_left ~f:(fun a b -> MUT.parse_line b a) ~init:(init ()) in\n let output = StubPainter.write (MUT.output_context u) in\n assert_bool \"Wire 1150 - 1250\" (List.mem \"Line 6000 1150 - 6000 1250\" ~set:output)\n ; assert_bool \"Wire 1250 - 1350\" (List.mem \"Line 6000 1250 - 6000 1350\" ~set:output)\n ; assert_bool \"Wire 1350 - 2050\" (List.mem \"Line 6000 1350 - 6000 2050\" ~set:output)\n ; assert_bool \"Wire 2050 - 2750\" (List.mem \"Line 6000 2050 - 6000 2750\" ~set:output)\n ; assert_bool \"no Wire 1150 - 1150\" (not(List.mem \"Line 6000 1150 - 6000 1150\" ~set:output))\n;;\n\nlet suite = \"OUnit for \" >:::\n [ \"printable F line\" >:: test_printable_F_line\n ; \"match wire line\" >:: match_wire_line\n ; \"zero length lines\" >:: test_zero_length_lines\n ; \"escaped field lines\" >:: test_escaped_F_line\n ; \"Segment horizontal wire\" >:: segment_horizontal_wire \"Wire\"\n ; \"Segment inverse horizontal wire\" >:: segment_inverse_horizontal_wire \"Wire\"\n ; \"Segment vertical wire\" >:: segment_vertical_wire \"Wire\"\n ; \"Segment inverse vertical wire\" >:: segment_inverse_vertical_wire \"Wire\"\n ; \"Segment horizontal bus\" >:: segment_horizontal_wire \"Bus\"\n ; \"Segment inverse horizontal bus\" >:: segment_inverse_horizontal_wire \"Bus\"\n ; \"Segment vertical bus\" >:: segment_vertical_wire \"Bus\"\n ; \"Segment inverse vertical bus\" >:: segment_inverse_vertical_wire \"Bus\"\n ; \"Segment vertical test \">:: segment_vertical_wire_test\n ]\nlet _ =\n run_test_tt_main suite\n" }, { "path": "kicadsch.opam", "content": "opam-version: \"2.0\"\nmaintainer: \"Jean-Noël Avila \"\nauthors: \"Jean-Noël Avila \"\nhomepage: \"https://jnavila.github.io/plotkicadsch/\"\ndoc: \"https://jnavila.github.io/plotkicadsch/index\"\nsynopsis: \"Library to read and convert Kicad Sch files\"\ndescription: \"\"\"\nLibrary able to read Kicad libraries and sch file and\ndrive a painter to paint the schematics.\n\"\"\"\nbug-reports: \"https://github.com/jnavila/plotkicadsch/issues\"\nlicense: \"ISC\"\ndev-repo: \"git+https://github.com/jnavila/plotkicadsch.git\"\nbuild: [\n [ \"dune\" \"subst\" ] {dev}\n [ \"dune\" \"build\" \"-p\" name \"-j\" jobs ]\n [\"dune\" \"runtest\" \"-p\" name \"-j\" jobs] {with-test}\n]\ndepends: [\n \"dune\" {>= \"1.0\"}\n \"ounit\" {with-test}\n \"ocaml\" {>=\"4.07\"}\n]\navailable: arch != \"arm32\" & arch != \"x86_32\"\n" }, { "path": "pkg/pkg.ml", "content": "#!/usr/bin/env ocaml\n#use \"topfind\"\n#require \"topkg-jbuilder\"\n\nopen Topkg\n\nlet publish =\n Pkg.publish ~artefacts:[`Distrib] ()\n\nlet () =\n Topkg_jbuilder.describe ~name:\"kicadsch\" ~publish ()\n" }, { "path": "plotkicadsch/src/boundingBox.ml", "content": "open Kicadsch.Sigs\n\ntype t = { left_inf: coord; right_sup: coord}\n\nlet create () =\n { left_inf= Coord(10000000000, 1000000000); right_sup = Coord(-100000, -100000)}\n\nlet create_from_rect (Coord (x, y) as c1) (Coord (width, height)) =\n { left_inf= c1; right_sup= Coord(x+width, y+height)}\n\nlet create_from_limits (Coord (x1, y1)) (Coord (x2, y2)) =\n { left_inf= Coord ( (min x1 x2), (min y1 y2)); right_sup= Coord((max x1 x2),(max y1 y2))}\n\nlet add_rect {left_inf=Coord(xli_1, yli_1); right_sup=Coord(xrs_1, yrs_1)} {left_inf=Coord(xli_2, yli_2); right_sup=Coord(xrs_2, yrs_2)} =\n { left_inf= Coord ((min xli_1 xli_2), (min yli_1 yli_2)); right_sup = Coord((max xrs_1 xrs_2), (max yrs_1 yrs_2))}\n\nlet add_point {left_inf=Coord(xli, yli); right_sup=Coord(xrs, yrs) } (Coord(x, y)) =\n { left_inf= Coord ((min xli x), (min yli y)); right_sup = Coord((max xrs x), (max yrs y))}\n\nlet reformat ~min_size ~extend {left_inf=Coord(xli, yli); right_sup=Coord(xrs, yrs)} =\n let resize li rs = if (rs -li) < min_size then\n let middle = (rs + li ) / 2 in\n middle - min_size/2, middle + min_size/2\n else\n li - extend, rs + extend in\n let xmin, xmax = resize xli xrs and ymin, ymax = resize yli yrs in\n {left_inf=Coord(xmin, ymin); right_sup=Coord(xmax, ymax) }\n\nlet as_rect {left_inf=Coord(xli, yli) as c1; right_sup=Coord(xrs, yrs) } =\n c1, Coord (xrs - xli, yrs - yli)\n\nlet overlap_ratio {left_inf=Coord(xli_1, yli_1); right_sup=Coord(xrs_1, yrs_1)} {left_inf=Coord(xli_2, yli_2); right_sup=Coord(xrs_2, yrs_2)} =\n let xli = max xli_1 xli_2 and yli = max yli_1 yli_2 and xrs = min xrs_1 xrs_2 and yrs = min yrs_1 yrs_2 in\n let intersected = (xli < xrs) && (yli < yrs) in\n if intersected then\n let surface = (xrs - xli)* (yrs - yli) and\n surface_1 = (xrs_1 - xli_1)* (yrs_1 - yli_1) and\n surface_2 = (xrs_2 - xli_2)* (yrs_2 - yli_2) in\n (float (max surface_1 surface_2) ) /. (float surface)\n else\n 0.0\n\nlet compare {left_inf=Coord(xli_1, yli_1); right_sup=Coord(xrs_1, yrs_1)} {left_inf=Coord(xli_2, yli_2); right_sup=Coord(xrs_2, yrs_2)} : int =\n let xli_r = xli_1 - xli_2 in\n if xli_r == 0 then\n let yli_r = yli_1 - yli_2 in\n if (yli_r == 0) then\n let xrs_r = xrs_1 - xrs_2 in\n if xrs_r == 0 then\n yrs_1 - yrs_2\n else\n xrs_r\n else\n yli_r\n else\n xli_r\n" }, { "path": "plotkicadsch/src/boundingBox.mli", "content": "open Kicadsch.Sigs\n\ntype t\n\nval create: unit -> t\n\nval create_from_rect: coord -> coord -> t\n\nval create_from_limits: coord -> coord -> t\n\nval add_rect: t -> t -> t\n\nval add_point: t -> coord -> t\n\nval reformat: min_size:int -> extend:int -> t -> t\nval as_rect: t -> coord*coord\n\nval overlap_ratio: t -> t -> float\n\nval compare: t -> t -> int\n" }, { "path": "plotkicadsch/src/diffFs.ml", "content": "\ntype t = TrueFS of string | GitFS of string\n\nmodule type Simple_FS = sig\n\n val label : t\n\n val get_content : string list -> string Lwt.t\n\n val list_files : (string -> bool) -> (string list * string) list Lwt.t\nend\n" }, { "path": "plotkicadsch/src/diffTool.ml", "content": "open! StdLabels\nopen Kicadsch.Sigs\n\nmodule type Differ = sig\n val doc : string\n\n type pctx\n\n module S : SchPainter with type painterContext = pctx\n\n val display_diff :\n from_ctx:pctx -> to_ctx:pctx -> string list -> keep:bool -> bool Lwt.t\nend\n" }, { "path": "plotkicadsch/src/dune", "content": "(executables\n (names plotgitsch plotkicadsch)\n (public_names plotgitsch plotkicadsch)\n (package plotkicadsch)\n (preprocess (pps lwt_ppx))\n (libraries\n kicadsch\n tyxml\n digestif.c\n git-unix\n lwt\n lwt.unix\n sha\n base64\n cmdliner\n )\n (flags (:standard -w -3 -safe-string))\n)\n\n (install\n (package plotkicadsch)\n (section bin)\n (files git-imgdiff)\n )\n" }, { "path": "plotkicadsch/src/git-imgdiff", "content": "#!/bin/bash\nPIPE=$(mktemp -u)\n(! compare -metric RMSE $2 $1 png:${PIPE} 2> /dev/null) && (montage -geometry +4+4 $2 $PIPE $1 png:- | display -title \"$1\" -)\nrm $PIPE\n" }, { "path": "plotkicadsch/src/gitFs.ml", "content": "open StdLabels\nopen Lwt.Infix\nopen DiffFs\nexception InternalGitError of string\nexception PathNotFound of string list\n\nlet make commitish relative_path =\n ( module struct\n open Git_unix\n module Search = Git.Search.Make (Digestif.SHA1) (Store)\n let rev_parse r =\n SysAbst.pread \"git\" [|\"rev-parse\"; r ^ \"^{commit}\"|]\n >>= fun s ->\n try Lwt.return @@ Store.Hash.of_hex @@ String.sub ~pos:0 s ~len:(min 40 (String.length s))\n with _ -> Lwt.fail (InternalGitError (\"cannot parse rev \" ^ r))\n\n let label = GitFS commitish\n\n (* pair gitroot, relative_path where\n gitroot is the root dir of the git working copy\n relative_path is the actual path relative to gitroot*)\n let git_root =\n let open Filename in\n let rec recurse (d, b) =\n let new_gitdir = concat d \".git/description\" in\n try%lwt\n let%lwt _ = Lwt_unix.stat new_gitdir in\n (* that's a git repo and d is the root *)\n Lwt.return (match relative_path with\n | None -> (d, b)\n | Some p -> (d, String.split_on_char ~sep:'/' p))\n with\n | UnixLabels.Unix_error (UnixLabels.ENOENT, _, _) ->\n let new_d = dirname d in\n if String.equal new_d d then\n (* we've reached the root of the FS *)\n Lwt.fail (InternalGitError \"not in a git repository\")\n else\n let new_b = basename d :: b in\n recurse (new_d, new_b)\n | e ->\n raise e\n in\n recurse @@ (Sys.getcwd (), [])\n\n let fs =\n let%lwt root, _ = git_root in\n match%lwt Store.v (Fpath.v root) with\n | Ok s ->\n Lwt.return s\n | Error e ->\n Lwt.fail (InternalGitError (Fmt.strf \"%a\" Store.pp_error e))\n\n let theref = rev_parse commitish\n\n let with_path path action =\n let%lwt t = fs in\n let%lwt h = theref in\n let%lwt _, rel_path = git_root in\n match%lwt\n Search.find t h (`Commit (`Path (List.concat [rel_path; path])))\n with\n | None ->\n Lwt.fail\n (PathNotFound path)\n | Some sha -> (\n match%lwt Store.read t sha with\n | Ok a ->\n action a\n | Error e ->\n Lwt.fail (InternalGitError (Fmt.strf \"%a\" Store.pp_error e)) )\n\n let get_content filename =\n try%lwt\n begin\n with_path filename\n @@ fun res -> match res with\n | Git.Value.Blob b ->\n Lwt.return (Store.Value.Blob.to_string b)\n | _ ->\n Lwt.fail (InternalGitError \"not a valid path\")\n end\n with\n PathNotFound _ -> Lwt.return \"\"\n\n let find_file_local filter (t: Store.Value.Tree.t) =\n let open Git.Tree in\n to_list t\n |> List.filter_map ~f:(fun t -> let {node; name; _} = t in\n if filter name then Some ([name], Store.Hash.to_hex node) else None\n )\n ;;\n\n let find_dir_local t =\n let open Git.Tree in\n to_list t\n |> List.filter ~f:(fun {perm;_} -> perm == `Dir)\n ;;\n\n let rec recurse_dir ?dirname node pattern =\n let rename name = match dirname with\n | Some dirname -> dirname::name\n | None -> name in\n let local_file_list = find_file_local pattern node in\n let path_file_list = List.map local_file_list ~f:(fun (name, hash) -> ((rename name), hash)) in\n let dirs = find_dir_local node in\n let%lwt t = fs in\n let open Git.Tree in\n let recurse_tree = fun entry ->\n let%lwt res = Store.read t entry.node in\n match res with\n |Error e -> Lwt.fail (InternalGitError (Fmt.strf \"%a\" Store.pp_error e))\n |Ok Git.Value.Tree t ->(\n let%lwt subdir = recurse_dir ~dirname:entry.name t pattern in\n let subdir_files = List.map ~f:(fun (name, hash) -> ((rename name), hash)) subdir in\n Lwt.return subdir_files)\n |Ok _ -> Lwt.fail (InternalGitError (\"impossible case\")) in\n let%lwt subdir_list = Lwt_list.map_s recurse_tree dirs in\n let result = List.concat [List.concat subdir_list; path_file_list] in\n Lwt.return result\n\n let list_files_from path pattern =\n with_path path\n @@ function\n | Git.Value.Tree t -> recurse_dir t pattern\n | _ -> Lwt.fail (InternalGitError \"not a tree!\")\n\n let list_files pattern =list_files_from [] pattern\n end\n : Simple_FS )\n" }, { "path": "plotkicadsch/src/imageDiff.ml", "content": "open! StdLabels\nopen Lwt.Infix\n\nlet doc = \"use compare (ImageMagick) between bitmaps\"\n\ntype pctx = SvgPainter.t\n\nmodule SVG = Kicadsch.MakeSchPainter (SvgPainter)\nmodule SP = struct\n include SVG\n\n type painterContext = SvgPainter.t\nend\n\nmodule S = SP\n\nlet display_diff ~from_ctx ~to_ctx filename ~keep =\n let from_filename = SysAbst.build_tmp_svg_name ~keep \"from_\" filename in\n let to_filename = SysAbst.build_tmp_svg_name ~keep \"to_\" filename in\n let both_files =\n List.map\n ~f:(fun (svg_name, context) ->\n Lwt_io.with_file ~mode:Lwt_io.Output svg_name (fun o ->\n Lwt_io.write o (SvgPainter.write context) ) )\n [(from_filename, from_ctx); (to_filename, to_ctx)]\n in\n let both = Lwt.join both_files in\n let compare_them =\n both\n >>= fun _ ->\n SysAbst.exec \"git-imgdiff\" [|from_filename; to_filename|]\n >|= let open UnixLabels in\n function\n | WEXITED ret ->\n if Int.equal ret 0 then true else false\n | WSIGNALED _ ->\n false\n | WSTOPPED _ ->\n false\n in\n let%lwt ret =\n try%lwt compare_them with\n | GitFs.InternalGitError s ->\n Lwt_io.printf \"%s\\n\" s >|= fun () -> false\n | _ ->\n Lwt_io.printf \"unknown error\\n\" >|= fun () -> false\n in\n Lwt.join\n @@ List.map\n ~f:(SysAbst.finalize_tmp_file ~keep)\n [from_filename; to_filename]\n >|= fun _ -> ret\n" }, { "path": "plotkicadsch/src/internalDiff.ml", "content": "open! StdLabels\nopen Lwt.Infix\nopen Kicadsch.Sigs\n\ninclude DiffTool\n\nmodule L = Kicadsch.MakeSchPainter(ListPainter.L)\n\nmodule LP = struct\n include L\n\n type painterContext = ListPainter.listcanevas\nend\n\nlet internal_diff (d : string) (c : SvgPainter.diff_colors option) (z: string option) =\n ( module struct\n let doc = \"internal diff and show with \" ^ d\n\n type pctx = ListPainter.listcanevas\n\n module S = LP\n\n type diff_style = Theirs | Ours | Idem\n\n let plot_elt style out_ctx (arg : ListPainter.t) =\n let open ListPainter in\n let module O = SvgPainter in\n let kolor =\n match style with\n | Theirs ->\n `Old\n | Ours ->\n `New\n | Idem ->\n `ForeGround\n in\n match arg with\n | Text (_, text, o, c, s, j, style) ->\n O.paint_text ~kolor text o c s j style out_ctx\n | Line (_, s, from_, to_) ->\n O.paint_line ~kolor ~width:s from_ to_ out_ctx\n | Rect (_, _, c1, c2) ->\n O.paint_rect ~kolor c1 c2 out_ctx\n | Circle (_, _, center, radius) ->\n O.paint_circle ~kolor center radius out_ctx\n | Arc (_, _, center, start_, end_, radius) ->\n O.paint_arc ~kolor center start_ end_ radius out_ctx\n | Image (corner, scale, data) ->\n O.paint_image corner scale data out_ctx\n | Format (Coord (x, y)) ->\n O.set_canevas_size x y out_ctx\n | Zone (c1, c2) ->\n O.paint_zone c1 c2 out_ctx\n\n let text_bbox text o c s j =\n (* TODO: vertical text does not work *)\n let len = String.length text in\n let Size sz = s in\n let Coord (x,y) = c in\n let shift =\n match j with\n | J_right | J_bottom -> -sz*len/2\n | J_center -> - sz*len/4\n | J_left | J_top -> 0\n in\n match o with\n | Orient_H ->\n BoundingBox.create_from_rect (Coord (x+shift,y)) (Coord (sz*len/2,sz/2))\n | Orient_V ->\n BoundingBox.create_from_rect (Coord (x, y-sz*len/2+shift)) (Coord (sz/2, sz*len/2))\n\n let elt_rect elt =\n let open ListPainter in\n let module BB = BoundingBox in\n match elt with\n | Text (_, text, o, c, s, j, _) ->\n text_bbox text o c s j\n | Line (_, _, f, t) ->\n BB.create_from_limits f t\n | Rect (_, _, c1, c2)\n | Zone (c1, c2) ->\n BB.create_from_rect c1 c2\n | Circle (_, _, center, radius) ->\n let Coord(x,y) = center in\n BB.create_from_limits (Coord(x-radius, y-radius)) (Coord(x+radius,y+radius))\n | Arc (_ , _, center, _, _, radius) ->\n (* TODO: take into count partial angle *)\n let Coord(x,y) = center in\n BB.create_from_limits (Coord(x-radius, y-radius)) (Coord(x+radius,y+radius))\n | Image (corner, _, data) ->\n let w, h = SvgPainter.get_png_dims data in\n BB.create_from_rect corner (Coord(w, h))\n | Format _ -> BB.create ()\n\n let dispatch_rect (res, acc) elt =\n if (BoundingBox.overlap_ratio res elt) > 0.9 then\n BoundingBox.add_rect res elt , acc\n else\n res, elt::acc\n\n let rec aggregate rect rect_list =\n let result, remaining = List.fold_left ~f:dispatch_rect ~init:(rect, []) rect_list in\n if Int.equal (List.length remaining) (List.length rect_list) then\n result, remaining\n else\n aggregate result remaining\n\n let merge_rects rects:BoundingBox.t list =\n let rec aggregate_list out_list = function\n | rect::l ->\n let res, remaining = aggregate rect l in\n let res2, remaining2 = aggregate res out_list in\n aggregate_list (res2::remaining2) remaining\n | [] -> out_list , [] in\n fst (aggregate_list [] rects)\n\n let draw_bb ctx r =\n let c1, c2 = BoundingBox.as_rect r in\n SvgPainter.paint_zone c1 c2 ctx\n\n let refine_segments (Coord (x1, y1), _) (Coord (x1', y1'), Coord (x2', y2')) =\n if (Int.compare x1 x1' == 0)\n then\n ((Int.compare y1 y1') * (Int.compare x1 x2'))\n else\n Int.compare y1 y2'\n\n let compare s1 s2 : int =\n let s1_r = elt_rect s1\n and s2_r = elt_rect s2 in\n let bb_comp = BoundingBox.compare s1_r s2_r in\n if bb_comp == 0 then\n match s1, s2 with\n | Text (_, t1, _, _, _, _ , _), Text (_, t2, _, _, _, _, _) -> String.compare t1 t2\n | Rect _, Rect _ -> 0\n | Line (_, _ , c1, c2), Line(_, _, c1', c2') -> refine_segments (c1, c2) (c1', c2')\n | Circle _, Circle _ -> 0\n | Arc _, Arc _ -> 0\n | Image _, Image _ -> 0\n | Zone _, Zone _ -> 0\n | Format _, Format _ -> 0\n | _, _ -> 1\n else bb_comp\n\n let draw_difftotal ~prev ~next out_canevas =\n let rec rec_draw_difftotal ~prev ~next (idem, theirs, ours, outc) diff_list =\n let r s = BoundingBox.reformat ~min_size:20 ~extend:50 (elt_rect s) in\n match prev, next with\n | p::pl, n::nl ->\n let comp = compare p n in\n if comp == 0 then\n rec_draw_difftotal ~prev:pl ~next:nl ((plot_elt Idem idem p),theirs, ours, outc) diff_list\n else if comp < 0 then\n rec_draw_difftotal ~prev:pl ~next (idem, (plot_elt Theirs theirs p), ours, outc) ((r p)::diff_list)\n else\n rec_draw_difftotal ~prev ~next:nl (idem, theirs, (plot_elt Ours ours n), outc) (r n::diff_list)\n | p::pl, [] ->\n rec_draw_difftotal ~prev:pl ~next (idem, (plot_elt Theirs theirs p), ours, outc) (r p::diff_list)\n | [], n::nl ->\n rec_draw_difftotal ~prev ~next:nl (idem, theirs, (plot_elt Ours ours n), outc) (r n::diff_list)\n |[],[] -> SvgPainter.(add_to theirs (add_to ours (add_to idem outc))), diff_list\n in\n let new_ctx = SvgPainter.new_from out_canevas in\n rec_draw_difftotal ~prev ~next (new_ctx, new_ctx, new_ctx, out_canevas) []\n\n let display_diff ~from_ctx ~to_ctx (filename:string list) ~keep =\n let prev = List.sort ~cmp:compare from_ctx in\n let next = List.sort ~cmp:compare to_ctx in\n match\n draw_difftotal ~prev ~next (SvgPainter.get_color_context c z)\n with\n | _, [] ->\n Lwt.return false\n | outctx, diff_list ->\n let merged_rects = merge_rects diff_list in\n let outctx = List.fold_left ~f:draw_bb ~init:outctx merged_rects in\n let svg_name = SysAbst.build_tmp_svg_name ~keep \"diff_\" filename in\n let open UnixLabels in\n let wait_for_1_s result =\n match result with\n | WSIGNALED n ->\n Printf.printf \"signalled with signal %d\\n\" n ;\n Lwt.return svg_name\n | WSTOPPED n ->\n Printf.printf \"stopped with %d\\n\" n ;\n Lwt.return svg_name\n | WEXITED err -> (\n match err with\n | 127 ->\n Printf.printf \"Command not found: %s\\n\" d ;\n Lwt.return svg_name\n | 0 ->\n let t, u = Lwt.wait () in\n let erase_timeout =\n Lwt_timeout.create 1 (fun () -> Lwt.wakeup u svg_name)\n in\n Lwt_timeout.start erase_timeout ;\n t\n | _ ->\n Printf.printf \"Errored with code %d\\n\" err ;\n Lwt.return svg_name )\n in\n Lwt_io.with_file ~mode:Lwt_io.Output svg_name (fun o ->\n Lwt_io.write o @@ SvgPainter.write ~op:false outctx )\n >>= fun _ ->\n SysAbst.exec d [|svg_name|]\n >>= wait_for_1_s\n >>= SysAbst.finalize_tmp_file ~keep\n >|= fun _ -> true\n end\n : Differ )\n" }, { "path": "plotkicadsch/src/kicadDiff.ml", "content": "open! StdLabels\nopen Lwt.Infix\nopen Kicadsch.Sigs\ninclude DiffFs\nopen DiffTool\n\nlet doc = function\n | TrueFS s -> \"file system \" ^ s\n | GitFS s -> \"Git rev \" ^ s\n\nlet git_fs commitish = GitFS commitish\nlet true_fs rootname = TrueFS rootname\n\ntype differ = Internal of string | Image_Diff\n\nlet fs_mod s r =\n let rel_path = Option.bind r (fun rel_path ->\n if (String.length rel_path > 1) &&\n String.equal (String.sub rel_path ~pos:0 ~len:2) \"./\" then\n begin\n if String.length rel_path == 2 then\n None\n else\n Some (String.sub rel_path ~pos:2 ~len:(String.length rel_path - 2))\n end\n else\n Some rel_path) in\n match s with\n | GitFS s -> GitFs.make s rel_path\n | TrueFS s -> TrueFs.make s rel_path\n\nlet is_suffix ~suffix s =\n let suff_length = String.length suffix in\n let s_length = String.length s in\n (suff_length < s_length) &&\n (String.equal (String.sub s ~pos:(String.length s - suff_length) ~len:suff_length) suffix)\n;;\n\nlet trim_cr l = if is_suffix ~suffix:\"\\r\" l then String.sub ~pos:0 ~len:(String.length l - 1) l else l\n;;\n\nmodule FSPainter (S : SchPainter) (F : Simple_FS) : sig\n val find_schematics : unit -> (string list * string) list Lwt.t\n\n val process_file : S.schContext Lwt.t -> string list -> S.painterContext Lwt.t\n\n val context_from : S.schContext Lwt.t -> S.schContext Lwt.t\nend = struct\n\n let find_schematics () = F.list_files (is_suffix ~suffix:\".sch\")\n\n let process_file initctx filename =\n let parse c l =\n let trimmed_line = trim_cr l in\n S.parse_line trimmed_line c in\n let%lwt init = initctx in\n F.get_content filename\n >|= fun ctt ->\n let lines = String.split_on_char ~sep:'\\n' ctt in\n let endctx = List.fold_left ~f:parse ~init lines in\n S.output_context endctx\n\n let find_libs () =\n F.list_files (is_suffix ~suffix:\"-cache.lib\") >|= List.map ~f:fst\n\n let read_libs initial_ctx lib_list =\n let add_lib ctx l =\n let trimmed_line = trim_cr l in\n S.add_lib trimmed_line ctx in\n Lwt_list.fold_left_s\n (fun c l ->\n F.get_content l\n >|= String.split_on_char ~sep:'\\n'\n >|= List.fold_left ~f:add_lib ~init:c)\n initial_ctx lib_list\n\n let context_from from_ctx =\n let%lwt initial_context = from_ctx in\n find_libs () >>= read_libs initial_context\nend\n\nmodule PathCompare = struct\n type t = string list * string\n\n let rec sl_compare l1 l2 =\n match l1, l2 with\n | name1::tl1, name2::tl2 -> let res = String.compare name1 name2 in\n if res == 0 then\n sl_compare tl1 tl2\n else\n res\n | _h::_t, [] -> 1\n | [], _h::_t -> -1\n | [], [] -> 0\n let compare (l1, _) (l2, _) = sl_compare l1 l2\n\nend\nmodule PathSet = Set.Make(PathCompare)\n\nlet merge_lists l1l l2l =\n l1l\n >>= fun l1 ->\n l2l\n >|= fun l2 ->\n let r = PathSet.empty in\n let r1 = List.fold_left ~f:(fun s l -> PathSet.add l s) ~init:r l1 in\n let r2 = List.fold_left ~f:(fun s l -> PathSet.add l s) ~init:r1 l2 in\n PathSet.elements r2 |> List.rev_map ~f:fst\n\nlet diff_cmd f t filename =\n let diff_cmd = [|\"--no-pager\"; \"diff\"; \"--word-diff\"|] in\n match (f, t) with\n | GitFS fc, GitFS tc ->\n (\"git\", Array.append diff_cmd [|fc; tc; \"--\"; filename|])\n | TrueFS _, GitFS tc ->\n (\"git\", Array.append diff_cmd [|tc; \"--\"; filename|])\n | GitFS fc, TrueFS _ ->\n (\"git\", Array.append diff_cmd [|fc; \"--\"; filename|])\n | TrueFS fc, TrueFS tc ->\n ( \"diff\"\n , [| fc ^ Filename.dir_sep ^ filename\n ; tc ^ Filename.dir_sep ^ filename |] )\n\nlet doit from_fs to_fs file_to_diff differ textdiff libs keep colors zone_color allow_missing_component relative_path =\n let module_d =\n match differ with\n | Image_Diff ->\n (module ImageDiff : Differ)\n | Internal s ->\n InternalDiff.internal_diff s colors zone_color\n in\n let module D = (val module_d : Differ) in\n let module F = (val (fs_mod from_fs relative_path) : Simple_FS) in\n let module T = (val (fs_mod to_fs relative_path) : Simple_FS) in\n let module FromP = FSPainter (D.S) (F) in\n let module ToP = FSPainter (D.S) (T) in\n let file_list =\n match file_to_diff with\n | None ->\n let from_list = FromP.find_schematics () in\n let to_list = ToP.find_schematics () in\n merge_lists from_list to_list\n | Some filename ->\n let filename_l = String.split_on_char ~sep:'/' filename in\n Lwt.return [filename_l]\n in\n let preload_libs desc =\n Lwt_list.fold_left_s\n (fun c f -> Lwt_stream.fold D.S.add_lib (Lwt_io.lines_of_file f) c)\n (D.S.initial_context ~allow_missing_component desc) libs\n in\n let from_init_ctx = FromP.context_from @@ preload_libs (First (doc from_fs)) in\n let to_init_ctx = ToP.context_from @@ preload_libs (Second (doc to_fs)) in\n let compare_one filename =\n let%lwt from_ctx = FromP.process_file from_init_ctx filename in\n let%lwt to_ctx = ToP.process_file to_init_ctx filename in\n match%lwt D.display_diff ~from_ctx ~to_ctx filename ~keep with\n | true ->\n Lwt.return ()\n | false ->\n if textdiff then\n let cmd, args = diff_cmd F.label T.label @@ String.concat ~sep:\"/\" filename in\n SysAbst.exec cmd args >|= ignore\n else Lwt.return ()\n in\n let compare_all = file_list >>= Lwt_list.iter_p compare_one in\n let catch_errors =\n Lwt.catch\n (fun _ ->\n Lwt_io.printf \"%s between %s and %s\\n\" D.doc (doc F.label) (doc T.label)\n >>= fun _ -> compare_all )\n (function\n | GitFs.InternalGitError s ->\n Lwt_io.printf \"Git Exception: %s\\n\" s\n | a ->\n Lwt_io.printf \"Exception %s\\n\" (Printexc.to_string a) )\n in\n Lwt_main.run catch_errors\n" }, { "path": "plotkicadsch/src/kicadDiff.mli", "content": "(**\n schematic diffing module *)\n\n(** type of diffing. If internal, specify the application for showing SVGs **)\ntype differ = Internal of string | Image_Diff\n\n(** type of the file system for each leg of the diff *)\ntype t\n\n(** [git_fs rev] builds a file system tree based on a git revision [rev] *)\nval git_fs: string -> t\n\n(** [true_fs root] builds a fs from the file system [root] directory *)\nval true_fs: string -> t\n\n(** [doc fs] outputs the doc string of the file system [fs] *)\nval doc: t -> string\n\n(** [doit fs_from fs_to filename differ textdiff libs keep colors allow_missing relative_path]\n performs the diff of [filename] from [relative_path] if present between [fs_from] and [fs_to]\n using strategy [differ] and using common [libs] and [colors]\n scheme. If [textdiff], then a text diff is shown when no visual\n diff, if [keep] then the diff file isn't removed after *)\nval doit: t -> t -> string option ->\n differ -> bool -> string list -> bool ->\n SvgPainter.diff_colors option -> string option -> bool -> string option -> unit\n" }, { "path": "plotkicadsch/src/listPainter.ml", "content": "open Kicadsch.Sigs\n\ntype image_data = Buffer.t\n\ntype t =\n | Text of kolor * string * orientation * coord * size * justify * style\n | Line of kolor * size * coord * coord\n | Rect of kolor * kolor * coord * coord\n | Circle of kolor * kolor * coord * int\n | Arc of kolor * kolor * coord * coord * coord * int\n | Image of coord * float * image_data\n | Format of coord\n | Zone of coord * coord\n\ntype listcanevas = t list\n\nmodule L = struct\n type t = listcanevas\n\n type painterContext = listcanevas\n\n let paint_text ?(kolor = `Black) text (o : orientation) coords s j stl ctx =\n Text (kolor, text, o, coords, s, j, stl) :: ctx\n\n let paint_line ?(kolor = `Black) ?(width = Size 2) pt_start pt_end ctx =\n Line (kolor, width, pt_start, pt_end) :: ctx\n\n let paint_rect ?(kolor = `Black) ?(fill = `NoColor) pt dims ctx =\n Rect (kolor, fill, pt, dims) :: ctx\n\n let paint_circle ?(kolor = `Black) ?(fill = `NoColor) center radius ctx =\n Circle (kolor, fill, center, radius) :: ctx\n\n let paint_arc ?(kolor = `Black) ?(fill = `NoColor) pt_center pt_start pt_stop\n radius ctx =\n Arc (kolor, fill, pt_center, pt_start, pt_stop, radius) :: ctx\n\n let paint_image corner scale b c = Image (corner, scale, b) :: c\n\n\n let get_context () = []\n\n let set_canevas_size x y c = Format (Coord (x, y)) :: c\nend\n" }, { "path": "plotkicadsch/src/plotgitsch.ml", "content": "open StdLabels\nopen KicadDiff\nopen Cmdliner\n\n\nlet pp_fs out fs =\n Format.fprintf out \"%s\" (doc fs)\n\nlet get_fs s =\n if String.length s > 4 && String.equal (String.sub s ~pos:0 ~len:4) \"dir:\" then\n true_fs (String.sub s ~pos:4 ~len:(String.length s - 4))\n else git_fs s\n\nlet reference =\n let docv = \"a commitish reference\" in\n Arg.(conv ~docv ((fun s -> Result.Ok (get_fs s)), pp_fs))\n\nlet from_ref =\n let doc =\n \"reference from which the diff is performed. If it starts with 'dir:' \\\n it's a file system dir.\"\n in\n let docv = \"FROM_REF\" in\n Arg.(value & pos 0 reference (git_fs \"HEAD\") & info [] ~doc ~docv)\n\nlet to_ref =\n let doc =\n \"target reference to diff with. If it starts with 'dir:' it's a file \\\n system dir.\"\n in\n let docv = \"TO_REF\" in\n Arg.(value & pos 1 reference (true_fs \".\") & info [] ~doc ~docv)\n\nlet pp_differ out differ =\n let s =\n match differ with\n | Internal p ->\n \"internal with viewer \" ^ p\n | Image_Diff ->\n \"external\"\n in\n Format.fprintf out \"%s\" s\n\nlet differ =\n let docv = \"diff strategy used\" in\n Arg.(conv ~docv ((fun d -> Result.Ok (Internal d)), pp_differ))\n\nlet diff_of_file =\n let doc = \"diff only selected file $(docv).\" in\n let docv = \"FILENAME\" in\n Arg.(value & opt (some file) None & info [\"f\"; \"file\"] ~doc ~docv)\n\nlet internal_diff =\n let doc =\n \"use an internal diff algorithm and use the $(docv) to display the result.\"\n in\n let docv = \"BROWSER\" in\n let env = Arg.env_var ~doc:\"Default viewer for internal diff. Defining this env var forces internal diff.\" \"PLOTGITSCH_VIEWER\" in\n Arg.(\n value\n & opt ~vopt:(Internal (SysAbst.default_opener ())) differ Image_Diff\n & info [\"i\"; \"internal\"] ~env ~doc ~docv)\n\nlet preloaded_libs =\n let doc =\n \"preload symbol library $(docv) in order to prepare the diff. This option \\\n can be used several times on command line.\"\n in\n let docv = \"LIB\" in\n Arg.(value & opt_all file [] & info [\"l\"; \"lib\"] ~doc ~docv)\n\nlet textual_diff =\n let doc =\n \"fall back to show a text diff if files are different but generate no \\\n visual diffs\"\n in\n Arg.(value & flag & info [\"t\"; \"textdiff\"] ~doc)\n\nlet continue_on_missing_component =\n let doc =\n \"by default, a missing component aborts the comparison. With this option, a missing component is skipped and the process continues.\"\n in\n Arg.(value & flag & info [\"m\"; \"allow_missing\"] ~doc)\n\nlet keep_files =\n let doc =\n \"by default, the svg diff files are deleted after launching the viewer; \\\n this option lets the files in place after viewing them. \"\n in\n Arg.(value & flag & info [\"k\"; \"keep\"] ~doc)\n\nlet pp_colors out c =\n let open SvgPainter in\n match c with\n | None ->\n Format.fprintf out \"default colors\"\n | Some {old_ver; new_ver; fg; bg} ->\n Format.fprintf out \"%s:%s:%s:%s\" old_ver new_ver fg bg\n\nlet extract_colors s =\n let open SvgPainter in\n let col_exp = \"([0-9a-fA-F]{6})\" in\n let bg_exp = \"([0-9a-fA-F]{6}([0-9a-fA-F]{2})?)\" in\n let cols_exp =\n \"^\" ^ col_exp ^ \":\" ^ col_exp ^ \":\" ^ col_exp ^ \":\" ^ bg_exp ^ \"$\"\n in\n let col_re = Re.Posix.compile_pat cols_exp in\n match Re.all col_re s with\n | [m] -> (\n match Re.Group.all m with\n | [|_; o; n; f; b; _|]\n | [|_; o; n; f; b|] ->\n let e c = \"#\" ^ c in\n Result.Ok (Some {old_ver= e o; new_ver= e n; fg= e f; bg= e b})\n | _ ->\n Result.Error (`Msg \"wrong colors format\") )\n | _ ->\n Result.Error (`Msg \"wrong colors format\")\n\nlet get_colors =\n let docv = \"scheme of colors for diffing\" in\n Arg.(conv ~docv (extract_colors, pp_colors))\n\nlet colors =\n let doc =\n \"list of colon separated hex RRGGBB codes for colors used for diffing and RRGGBB[AA] code for background e.g. \\\n the default colors are FF0000:00FF00:000000:FFFFFFFF\"\n in\n let docv = \"old:new:foreground:background\" in\n let env = Arg.env_var ~doc:\"Colors for plotting the diff\" \"PLOTGITSCH_COLORS\" in\n\n Arg.(value & opt get_colors None & info [\"c\"; \"colors\"] ~env ~doc ~docv)\n\nlet pp_zone_color out c =\n match c with\n | None ->\n Format.fprintf out \"transparent\"\n | Some c ->\n Format.fprintf out \"#%s\" c\n\nlet extract_zone_color s =\n let col_exp = \"(#[0-9a-fA-F]{6})\" in\n let col_re = Re.Posix.compile_pat col_exp in\n match Re.all col_re s with\n | [_] -> Result.Ok (Some s)\n | _ ->\n Result.Error (`Msg \"wrong colors format\")\n\nlet get_zone_color =\n let docv = \"RGB color format\" in\n Arg.(conv ~docv (extract_zone_color, pp_zone_color))\n\nlet zone_color =\n let doc =\n \"color of the frame around changed zones in hex RGB format, if specified\"\n in\n let docv = \"RGB, eg: #rrggbb\" in\n let env = Arg.env_var ~doc:\"Color for plotting frames around changes\" \"PLOTGITSCH_CHANGE_COLOR\" in\n Arg.(value & opt get_zone_color None & info [\"z\"; \"zone\"] ~env ~doc ~docv)\n\nlet relative_path =\n let doc =\n \"force relative path to git working tree root. Detected automatically from current dir by default\" in\n let docv = \"path\" in\n Arg.(value & opt (some string) None & info [\"r\"; \"relative\"] ~doc ~docv)\n\nlet plotgitsch_t =\n Term.(\n const doit $ from_ref $ to_ref $ diff_of_file $ internal_diff\n $ textual_diff $ preloaded_libs $ keep_files $ colors $ zone_color $ continue_on_missing_component $ relative_path)\n\nlet info =\n let doc =\n \"Show graphically the differences between two git revisions of a kicad \\\n schematic\"\n in\n let man =\n [ `S Manpage.s_bugs\n ; `P \"Open issues to https://github.com/jnavila/plotkicadsch/issues\" ]\n in\n Term.info \"plotgitsch\" ~version:\"%%VERSION%%\" ~doc ~exits:Term.default_exits\n ~man\n\nlet () = Term.exit @@ Term.eval (plotgitsch_t, info)\n" }, { "path": "plotkicadsch/src/plotkicadsch.ml", "content": "open Kicadsch\nmodule SvgSchPainter = MakeSchPainter (SvgPainter)\nopen SvgSchPainter\n\nlet build_outputfilename outdir sch =\n let open Filename in\n let basefilename =\n if String.equal outdir \"\" then sch else concat outdir (basename sch)\n in\n remove_extension basefilename ^ \".svg\"\n\nlet process_file init outdir sch =\n let fileout = build_outputfilename outdir sch in\n let%lwt o = Lwt_io.open_file ~mode:Lwt_io.Output fileout in\n let%lwt i = Lwt_io.open_file ~mode:Lwt_io.Input sch in\n let%lwt endcontext = Lwt_stream.fold parse_line (Lwt_io.read_lines i) init in\n let canvas : SvgPainter.t = output_context endcontext in\n let%lwt () = Lwt_io.write o (SvgPainter.write canvas) in\n let%lwt () = Lwt_io.close i in\n Lwt_io.close o\n\nlet process_libs libs =\n Lwt_list.fold_left_s\n (fun c l -> Lwt_stream.fold add_lib (Lwt_io.lines_of_file l) c)\n (initial_context No_Rev) libs\n\nlet () =\n let files = ref [] in\n let libs = ref [] in\n let outpath = ref \"\" in\n let speclist =\n [ ( \"-l\"\n , Arg.String (fun lib -> libs := lib :: !libs)\n , \"specify component library\" )\n ; ( \"-f\"\n , Arg.String (fun sch -> files := sch :: !files)\n , \"sch file to process\" )\n ; ( \"-o\"\n , Arg.String (fun o -> outpath := o)\n , \"full path of output directory\" ) ]\n in\n let usage_msg = \"plotkicadsch prints Kicad sch files to svg\" in\n Arg.parse speclist print_endline usage_msg ;\n Lwt_main.run\n (let%lwt c = process_libs !libs in\n Lwt_list.iter_p (process_file c !outpath) !files)\n" }, { "path": "plotkicadsch/src/svgPainter.ml", "content": "open Tyxml.Svg\nopen Kicadsch.Sigs\n\ntype diff_colors = {old_ver: string; new_ver: string; fg: string; bg: string}\n\ntype content = [`Polyline | `Text | `Svg | `Rect | `Circle | `Path | `Image]\n\ntype dim = int * int\n\ntype t = {d: dim; c: content elt list; colors: diff_colors option; zone_color: string option} [@@inline]\n\nlet style_attr_of_style = function\n | Italic ->\n [a_font_style \"italic\"]\n | Bold ->\n [a_font_weight \"bold\"]\n | BoldItalic ->\n [a_font_style \"italic\"; a_font_weight \"bold\"]\n | NoStyle ->\n []\n\nlet anchor_attr_of_justify justif =\n a_text_anchor\n ( match justif with\n | J_left ->\n `Start\n | J_center ->\n `Middle\n | J_right ->\n `End\n | J_bottom ->\n `End\n | J_top ->\n `Start )\n\nlet color_of_kolor k {colors; zone_color; _} =\n let new_ver, old_ver, fg =\n match colors with\n | None ->\n (\"#00FF00\", \"#FF0000\", \"#000000\")\n | Some {old_ver; new_ver; fg; _} ->\n (new_ver, old_ver, fg)\n in\n let plain c = `Color (c, None) in\n match k with\n | `NoColor ->\n `None\n | `Black ->\n plain \"#000000\"\n | `Red ->\n plain \"#FF0000\"\n | `Green ->\n plain \"#00FF00\"\n | `Blue ->\n plain \"#0000CD\"\n | `Brown ->\n plain \"#800000\"\n | `Old ->\n plain old_ver\n | `New ->\n plain new_ver\n | `ForeGround ->\n plain fg\n | `Zone ->\n match zone_color with\n | None -> `None\n | Some c -> plain c\n\n(** SVG coord type conversion from int **)\nlet coord_of_int x = (float_of_int x, None)\n\nlet paint_text ?(kolor = `Black) t (o : orientation) (Coord (x, y)) (Size size)\n justif styl ({c; _} as ctxt) =\n let size_in = Printf.sprintf \"%f\" (float_of_int size)\n and j = anchor_attr_of_justify justif\n and s = style_attr_of_style styl\n and x_c = float_of_int x\n and y_c = float_of_int y\n and angle = match o with Orient_H -> 0. | Orient_V -> -90. in\n let orient = ((angle, None), Some (x_c, y_c)) in\n let color = color_of_kolor kolor ctxt in\n { ctxt with\n c=\n text\n ~a:\n ( [ a_x_list [coord_of_int x]\n ; a_y_list [coord_of_int y]\n ; a_font_size size_in\n ; j\n ; a_transform [`Rotate orient]\n ; a_fill color ]\n @ s )\n [pcdata t]\n :: c }\n\nlet paint_line ?(kolor = `Black) ?(width = Size 2) (Coord (x1, y1))\n (Coord (x2, y2)) ({c; _} as ctxt) =\n let x1_in = float_of_int x1 in\n let y1_in = float_of_int y1 in\n let x2_in = float_of_int x2 in\n let y2_in = float_of_int y2 in\n let (Size width) = width in\n let fwidth = float_of_int width *. 5. in\n { ctxt with\n c=\n polyline\n ~a:\n [ a_points [(x1_in, y1_in); (x2_in, y2_in)]\n ; a_stroke_width (fwidth, Some `Px)\n ; a_stroke (color_of_kolor kolor ctxt) ]\n []\n :: c }\n\nlet paint_rect ?(kolor = `Black) ?(fill = `NoColor) (Coord (x, y))\n (Coord (dim_x, dim_y)) ({c; _} as ctxt) =\n { ctxt with\n c=\n rect\n ~a:\n [ a_x (coord_of_int x)\n ; a_y (coord_of_int y)\n ; a_width (coord_of_int dim_x)\n ; a_height (coord_of_int dim_y)\n ; a_fill (color_of_kolor fill ctxt)\n ; a_stroke_width (5., Some `Px)\n ; a_stroke (color_of_kolor kolor ctxt) ]\n []\n :: c }\n\nlet paint_circle ?(kolor = `Black) ?(fill = `NoColor) (Coord (x, y)) radius\n ({c; _} as ctxt) =\n { ctxt with\n c=\n circle\n ~a:\n [ a_r (coord_of_int radius)\n ; a_cx (coord_of_int x)\n ; a_cy (coord_of_int y)\n ; a_fill (color_of_kolor fill ctxt)\n ; a_stroke_width (10., Some `Px)\n ; a_stroke (color_of_kolor kolor ctxt) ]\n []\n :: c }\n\nlet paint_arc ?(kolor = `Black) ?(fill = `NoColor) (Coord (x, y))\n (Coord (x1, y1)) (Coord (x2, y2)) radius ({c; _} as ctxt) =\n (* not sure how this thing behaves. This setup seems to work *)\n let sweepflag = if (x1 - x) * (y2 - y) > (x2 - x) * (y1 - y) then 1 else 0 in\n { ctxt with\n c=\n path\n ~a:\n [ a_d\n (Printf.sprintf \"M%d,%d A%d,%d 0 0,%d %d,%d\" x1 y1 radius radius\n sweepflag x2 y2)\n ; a_fill (color_of_kolor fill ctxt)\n ; a_stroke_width (10., Some `Px)\n ; a_stroke (color_of_kolor kolor ctxt) ]\n []\n :: c }\n\nlet get_png_dims b =\n if Buffer.sub b 1 3 = \"PNG\" then\n let belong str =\n (int_of_char str.[0] lsl 24)\n + (int_of_char str.[1] lsl 16)\n + (int_of_char str.[2] lsl 8)\n + int_of_char str.[3]\n in\n let w = belong (Buffer.sub b 16 4) in\n let h = belong (Buffer.sub b 20 4) in\n (w, h)\n else (0, 0)\n\nexception Base64Exception of string\n\nlet paint_image (Coord (x, y)) scale b ({c; _} as ctxt) =\n let s = scale /. 0.3 in\n let w, h = get_png_dims b in\n match Base64.encode (Buffer.contents b) with\n | Ok outstring ->\n { ctxt with\n c=\n image\n ~a:\n [ a_x (float x -. (float (w / 2) *. s), None)\n ; a_y (float y -. (float (h / 2) *. s), None)\n ; a_height (float h *. s, None)\n ; a_width (float w *. s, None)\n ; a_xlink_href @@ \"data:image/png;base64,\" ^ outstring ]\n []\n :: c }\n | Error (`Msg err) ->\n raise (Base64Exception err)\n\nlet paint_zone (Coord (x, y)) (Coord (dim_x, dim_y)) ({c; _} as ctxt) =\n let fill_color = color_of_kolor `Zone ctxt in\n let render = if fill_color == `None then\n [a_style \"fill-opacity: 0;\"]\n else\n [ a_fill (color_of_kolor `Zone ctxt)\n ; a_style \"fill-opacity: 0.1;\"\n ] in\n\n { ctxt with\n c=\n rect\n ~a:(\n [ a_x (coord_of_int x)\n ; a_y (coord_of_int y)\n ; a_width (coord_of_int dim_x)\n ; a_height (coord_of_int dim_y)\n ; a_stroke_width (5., Some `Px)\n ; a_class [\"zone\"]\n ] @ render)\n []\n :: c }\n\n\nlet get_context () = {d= (0, 0); c= []; colors= None; zone_color=None}\n\nlet get_color_context colors zone_color = {d= (0, 0); c= []; colors; zone_color}\n\nlet new_from {colors; zone_color; _} = {d= (0, 0); c= []; colors; zone_color}\n\nlet add_to {d=(x2, y2);c=c1; _} {d=(x1, y1); c=c2; colors; zone_color} =\n let c = List.rev_append c1 c2 in\n {d=((max x1 x2), (max y1 y2)); c; colors; zone_color}\n\nlet set_canevas_size x y ctxt = {ctxt with d= (x, y)}\n\nlet write ?(op = true) {d= x, y; c; colors; _} =\n let fx = float x in\n let fy = float y in\n let o = if op then 1.0 else 0.8 in\n let bg = match colors with None -> \"#FFFFFF\" | Some {bg; _} -> bg in\n let opacity =\n a_style @@ Printf.sprintf \"stroke-opacity:%f;fill-opacity:%f;\" o o\n in\n let svg_doc =\n svg\n ~a:\n [ a_width (fx *. 0.00254, Some `Cm)\n ; a_height (fy *. 0.00254, Some `Cm)\n ; a_viewBox (0., 0., float x, float y)\n ; a_font_family \"Verdana, sans-serif\"\n ; opacity ]\n @@ rect\n ~a:\n [ a_fill (`Color (bg, None))\n ; a_width (coord_of_int x)\n ; a_height (coord_of_int y)\n ; a_style \"stroke-opacity:1.0;fill-opacity:1.0;\" ]\n []\n :: c\n in\n Format.asprintf \"%a\" (Tyxml.Svg.pp ()) svg_doc\n" }, { "path": "plotkicadsch/src/sysAbst.ml", "content": "open StdLabels\n\ntype os = MacOS | Linux | Windows | Cygwin\n\nlet process_output_to_string command =\n let chan = UnixLabels.open_process_in command in\n let res = ref \"\" in\n let rec process_otl_aux () =\n let e = input_line chan in\n res := e ^ !res ;\n process_otl_aux ()\n in\n try process_otl_aux ()\n with End_of_file ->\n let stat = UnixLabels.close_process_in chan in\n (!res, stat)\n;;\n\nlet cmd_output command =\n let l, _ = process_output_to_string command in\n l\n;;\n\nlet launch_on_windows command =\n let _, s = process_output_to_string (\"start \" ^ command) in\n Lwt.return s\n;;\n\nlet detect_os () : os =\n if Sys.win32 then Windows\n else if Sys.cygwin then Cygwin\n else\n let ((in_ch, _, _) as uname) = UnixLabels.open_process_full \"uname\" ~env:[| |] in\n let os = input_line in_ch in\n ignore (UnixLabels.close_process_full uname) ;\n match os with\n | \"Darwin\" ->\n MacOS\n | \"Linux\" ->\n Linux\n | _ ->\n failwith \"unknown operating system\"\n;;\n\nlet windows_quote s =\n let open Re in\n replace\n (Posix.compile_pat {|\\^|&|\\||\\(|<|>|})\n ~f:(fun ss -> \"^\" ^ Group.get ss 0)\n s\n;;\n\nlet exec c a =\n match detect_os () with\n | MacOS | Linux ->\n Lwt_process.exec (\"\", Array.append [|c|] a)\n | Cygwin | Windows ->\n launch_on_windows\n @@ Array.fold_left ~f:(fun f g -> f ^ \" \" ^ windows_quote g) ~init:c a\n;;\n\nlet pread c a =\n match detect_os () with\n | MacOS | Linux ->\n Lwt_process.pread ~stderr:`Dev_null (\"\", Array.append [|c|] a)\n | Cygwin | Windows ->\n Lwt.return\n @@ cmd_output\n (Array.fold_left ~f:(fun f g -> f ^ \" \" ^ windows_quote g) ~init:c a)\n;;\n\nlet rec last_exn = function\n | [e] -> e\n | _::tl -> last_exn tl\n | [] -> raise Not_found\n;;\n\nlet build_tmp_svg_name ~keep aprefix aschpath =\n let aschname = last_exn aschpath in\n let root_prefix =\n aprefix ^ String.sub aschname ~pos:0 ~len:(String.length aschname - 4)\n in\n if keep then root_prefix ^ \".svg\"\n else Stdlib.Filename.temp_file root_prefix \".svg\"\n;;\n\nlet finalize_tmp_file fnl ~keep =\n match detect_os () with\n | MacOS | Linux -> (\n try%lwt\n if not keep then\n Lwt_unix.unlink fnl\n else\n Lwt.return_unit\n with _ -> Lwt.return_unit )\n | Cygwin | Windows ->\n Lwt.return_unit\n;;\n\nlet default_opener () =\n match detect_os () with\n | Linux ->\n \"xdg-open\"\n | MacOS ->\n \"open\"\n | Cygwin | Windows ->\n \"\"\n\n(* we already use \"start\" in exec *)\n" }, { "path": "plotkicadsch/src/sysAbst.mli", "content": "val pread : string -> string array -> string Lwt.t\n\nval exec : string -> string array -> Unix.process_status Lwt.t\n\n(* the two following function are meant to be used together *)\nval build_tmp_svg_name : keep:bool -> string -> string list -> string\n\nval finalize_tmp_file : string -> keep:bool -> unit Lwt.t\n\nval default_opener : unit -> string\n" }, { "path": "plotkicadsch/src/trueFs.ml", "content": "open StdLabels\nopen Lwt.Infix\nopen DiffFs\n\nlet make rootname relative =\n ( module struct\n\n let lstrip c s =\n let rec find_non_c c s n =\n if s.[n] != c then\n String.sub ~pos:n ~len:(String.length s - n) s\n else\n find_non_c c s (n+1)\n in\n find_non_c c s 0\n\n let rootname = (lstrip '/' rootname) ^ (match relative with\n | None -> \"\"\n | Some p -> \"/\" ^ (lstrip '/' p))\n\n let label = TrueFS rootname\n\n let rootlength = (String.length rootname) + 1\n\n let get_content filename =\n let filepath = (String.concat ~sep:Filename.dir_sep (rootname::filename)) in\n try%lwt\n Lwt_io.with_file ~mode:Lwt_io.input filepath Lwt_io.read\n with\n _ -> Lwt.return \"\"\n\n let hash_file filename =\n get_content filename\n >|= fun c ->\n let blob_content = Printf.sprintf \"blob %d\\000\" (String.length c) ^ c in\n (filename, Sha1.to_hex (Sha1.string blob_content))\n\n let dir_contents dir pattern =\n let rec loop result = function\n | f::fs when Sys.is_directory f ->\n Sys.readdir f\n |> Array.to_list\n |> List.map ~f:(Filename.concat f)\n |> List.append fs\n |> loop result\n | f::fs when pattern f -> loop (f::result) fs\n | _::fs -> loop result fs\n | [] -> result\n in\n loop [] [dir]\n\n let list_files pattern =\n let list = dir_contents rootname pattern in\n let file_list = Lwt_list.map_s (fun filename ->\n let filename = String.sub filename ~pos:rootlength ~len:(String.length filename - rootlength) in\n let file_path = String.split_on_char ~sep:'/' filename in\n hash_file file_path) list in\n file_list\n end\n : Simple_FS )\n" }, { "path": "plotkicadsch.opam", "content": "opam-version: \"2.0\"\nmaintainer: \"Jean-Noël Avila \"\nauthors: \"Jean-Noël Avila \"\nhomepage: \"https://jnavila.github.io/plotkicadsch/\"\nbug-reports: \"https://github.com/jnavila/plotkicadsch/issues\"\ndoc: \"https://jnavila.github.io/plotkicadsch/index\"\nsynopsis: \"Utilities to print and compare version of Kicad schematics\"\ndescription: \"\"\"\nTwo utilities:\n * plotkicadsch is able to plot schematic sheets to SVG files\n * plotgitsch is able to compare git revisions of schematics\n\"\"\"\nlicense: \"ISC\"\ndev-repo: \"git+https://github.com/jnavila/plotkicadsch.git\"\nbuild: [\n [ \"dune\" \"subst\" ] {dev}\n [ \"dune\" \"build\" \"-p\" name \"-j\" jobs]\n]\ndepends: [\n \"ocaml\" {>=\"4.09\"}\n \"dune\" {>= \"1.0\"}\n \"kicadsch\" {= version}\n \"tyxml\" {>= \"4.0.0\"}\n \"lwt\"\n \"lwt_ppx\" {build}\n \"sha\"\n \"git\" {>= \"3.4.0\"}\n \"git-unix\"\n \"base64\" {>= \"3.0.0\"}\n \"cmdliner\"\n]\n" } ]