Repository: jnavila/plotkicadsch Branch: master Commit: e5f94e479a62 Files: 44 Total size: 191.3 KB Directory structure: gitextract_my2q5416/ ├── .appveyor.yml ├── .gitignore ├── .travis.yml ├── CHANGES.md ├── COPYING ├── LICENSE.md ├── Makefile ├── README.md ├── README.org ├── docs/ │ ├── _config.yml │ ├── index.md │ ├── plotgitsch_usersguide.adoc │ └── plotgitsch_usersguide.html ├── dune-project ├── kicadsch/ │ ├── src/ │ │ ├── dune │ │ ├── kicadLib_sigs.ml │ │ ├── kicadSch_sigs.mli │ │ ├── kicadlib.ml │ │ ├── kicadsch.ml │ │ └── schparse.ml │ └── test/ │ ├── dune │ ├── stubPainter.ml │ └── test.ml ├── kicadsch.opam ├── pkg/ │ └── pkg.ml ├── plotkicadsch/ │ └── src/ │ ├── boundingBox.ml │ ├── boundingBox.mli │ ├── diffFs.ml │ ├── diffTool.ml │ ├── dune │ ├── git-imgdiff │ ├── gitFs.ml │ ├── imageDiff.ml │ ├── internalDiff.ml │ ├── kicadDiff.ml │ ├── kicadDiff.mli │ ├── listPainter.ml │ ├── plotgitsch.ml │ ├── plotkicadsch.ml │ ├── svgPainter.ml │ ├── sysAbst.ml │ ├── sysAbst.mli │ └── trueFs.ml └── plotkicadsch.opam ================================================ FILE CONTENTS ================================================ ================================================ FILE: .appveyor.yml ================================================ platform: - x86 environment: FORK_USER: ocaml FORK_BRANCH: master CYG_ROOT: C:\cygwin64 PACKAGE: plotkicadsch OPAM_SWITCH: 4.09.0+mingw64c PINS: kicadsch:. plotkicadsch:. install: - ps: iex ((new-object net.webclient).DownloadString("https://raw.githubusercontent.com/$env:FORK_USER/ocaml-ci-scripts/$env:FORK_BRANCH/appveyor-install.ps1")) build_script: - call %CYG_ROOT%\bin\bash.exe -l %APPVEYOR_BUILD_FOLDER%\appveyor-opam.sh - call %CYG_ROOT%\bin\bash.exe -l -c 'opam install plotkicadsch' - mv %CYG_ROOT%\home\appveyor\.opam %APPVEYOR_BUILD_FOLDER%\opam artifacts: - name: Binaries path: 'opam\*\bin\plot*' deploy: provider: GitHub auth_token: secure: c4q0Y7feAIuCOOJebzyrIGMQ/9CPTpzZKyyJHvqrZCiQOr9UBVYQXbuTmStkYsdn artifact: /plot.*\.exe/ draft: false prerelease: false on: appveyor_repo_tag: true ================================================ FILE: .gitignore ================================================ _build/ *.byte *.native configure setup.* .merlin *.pdf ================================================ FILE: .travis.yml ================================================ language: c sudo: false services: - docker install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh script: bash -ex ./.travis-docker.sh env: - OCAML_VERSION=4.09 DISTRO="ubuntu-16.04" PACKAGE=kicadsch - PINS="kicadsch:." OCAML_VERSION=4.09 DISTRO="ubuntu-16.04" PACKAGE=plotkicadsch ================================================ FILE: CHANGES.md ================================================ v0.9.0 ------ - plotgitsch: introduce alpha channel for background in internal diff - plotgitsch: add revisions in diff plots - plotgitsch: allow missing components in libs - plotgitsch: add --relative option v0.8.0 ------ - plotgitsch: split wires with respect to jonction points to refine diff - manage escaped strings in fields - Remove dependency to Core_kernel v0.7.0 ------ - plotgitsch: introduce -z option to highlight zones of changes - plotgitsch: implement home made internal diff - plotgitsch: fix bug in keep option (#39) - plotgitsch: z-order shapes in SVG according to new, old, idem status v0.6.1 ------ - Switch to ocaml 4.09.0 and JaneStreet libs 0.13.x v0.6.0 ------ - Search libs and schs recursively from working directory (fixes #33) v0.5.2 ------ - Manage Fields with delimited strings - Use environment variables for internal differ - add dependency to an implementation of digestif v0.5.1 ------ - fix compatibility with kicad 5.x v0.5.0 ------ - add compatibility with kicad 5.x - update 'massaging' with rescue lib - become independent on line endings types - add an option to select output directory in plotkicadsch - update lib versions v0.4.0 ------ - add the -l option - add the -c option - add the -t option - add the -k option - enhance svg drawing - add appveyor builds and Windows binaries - switch to dune - add a small user's guide v0.3.0 ------ - rework opam interaction - fix version watermark - allow to have project in subdir of git working dir - update Readme for installation procedure - fix arc drawing (works for arcs less than 180°) - set up documentation of lib v0.2.0 ------ - Add plotgitsch internal diffing - fix #2, #3 and #4 v0.0.1 ------ - Initial release ================================================ FILE: COPYING ================================================ Note that the only valid version of the GPL as far as this project is concerned is _this_ particular version of the license (ie v2, not v2.2 or v3.x or whatever), unless explicitly otherwise stated. HOWEVER, in order to allow a migration to GPLv3 if that seems like a good idea, I also ask that people involved with the project make their preferences known. In particular, if you trust me to make that decision, you might note so in your copyright message, ie something like This file is licensed under the GPL v2, or a later version at the discretion of Linus. might avoid issues. But we can also just decide to synchronize and contact all copyright holders on record if/when the occasion arises. Linus Torvalds ---------------------------------------- GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. ================================================ FILE: LICENSE.md ================================================ Copyright (c) 2017, Jean-Noël Avila All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Jean-Noël Avila nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ================================================ FILE: Makefile ================================================ .PHONY: build clean test install uninstall distrib publish release build: dune build clean: dune clean test: dune runtest install: dune install uninstall: dune uninstall distrib: dune-release tag dune-release ================================================ FILE: README.md ================================================ [![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) # Kicad schematic plotter PlotKicadsch is a small tool to export Kicad Sch files to SVG pictures. In the future, export to other formats may be available (PDF, PNG). This package also provides the [`plotgitsch`](https://jnavila.github.io/plotkicadsch/plotgitsch_usersguide.html) command which allows to visually compare git revisions of schematics: ![Visual diff](docs/svg_diff.png) For more information type `plotgitsch --help`. ## Objectives This project is mainly an attempt at using ocaml with functional programming on a pet real-world project. The quality of the output is not a first requirement (meaning: not supposed to match Kicad one to one), but the accuracy of positioning matters. # Installation # Stable version from OPAM The stable version of plotkicadsch can be installed with [opam](http://opam.ocaml.org/). Be careful to install opam v2.0 for your platform. ```bash opam switch create 4.09.1 opam switch 4.09.1 eval `opam config env` opam update opam install plotkicadsch ``` If you don't use opam consult the .opam files for build instructions. ## Windows For Windows users, there is an [experimental opam repository](https://fdopen.github.io/opam-repository-mingw/) which works pretty well. Alternatively, you can simply grab precompiled binaries at https://github.com/jnavila/plotkicadsch/releases If 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. # Master version The latest running version can also be installed from this repo by pinning the project in opam: ```bash opam switch create 4.09.1 opam switch 4.09.1 eval `opam config env` opam pin add kicadsch . opam pin add plotkicadsch . opam update opam install plotkicadsch ``` # How to ## Using All the commands have a help option. For `plotgitsch`, a [small hands on guide](https://jnavila.github.io/plotkicadsch/plotgitsch_usersguide.html) is available. ## Contributing This 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. If this project happens to be of any use, let me know also! ================================================ FILE: README.org ================================================ * Kicad schematic plotter PlotKicadsch is a small tool to export Kicad Sch files to SVG pictures. In the future, export to other formats may be available (PDF, PNG). ** Objectives This project is mainly an attempt at using ocaml with functional programming on a pet real-world project. The 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. ** Contributing This 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. If this project happens to be of any use, let me know also! ================================================ FILE: docs/_config.yml ================================================ theme: jekyll-theme-cayman ================================================ FILE: docs/index.md ================================================ # Massaging your git for kicad Kicad 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. The 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. ## Including and Ignoring files First 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. Concerning 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: * the `.pro` file which is main project file, e.g, `myboard.pro` * the `.sch` files that represent the schematic sheets. * the `cache.lib` which is the local cache for all the components used in your schematic, e.g. `myboard-cache.lib` * the `cache.dcm` which is the additional cache for component information, e.g. `myboard-cache.dcm` * 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. Of 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. On 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. I usually add these lines to my `.gitignore` ```bash # export files for BOM *.csv *.tsv *.xml # backup files *.bak ``` ## Cleaning and Smudging Kicad 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. Fortunately, 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. ### How it works The 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. ### removing the date in the .pro file A 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. First, 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: ```ini *.pro filter=kicad_project ``` After 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. Doing nothing is just passing the content through the `cat` command. On 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: ```console $ git config --global filter.kicad_project.clean "sed -E 's/^update=.*$/update=Date/'" $ git config --global filter.kicad_project.smudge cat ``` The `--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. #### Power and Flags Numbering Another 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: ```ini *.sch filter=kicad_sch ``` Then let's clean up all the `sch` files before staging: ```console $ git config --global filter.kicad_sch.clean "sed -E 's/#(PWR|FLG)[0-9]+/#\1?/'" $ git config --global filter.kicad_sch.smudge cat ``` With this one, you should be able to diff your project and get a more understandable view of your changes. ## Visual Diffing The 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. I 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: * Generate bitmap pictures of each sheet of the schematic and use an external tool to visually diff them. * Perform an internal diff on the schematics drawing primitive lists and provide the result as an svg to be visualized in your preferred browser. ### External Image Diffing Right 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. First, 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: ```bash #!/bin/bash PIPE=$(mktemp -u) (! compare -metric RMSE $2 $1 png:${PIPE} 2> /dev/null) && (montage -geometry +4+4 $2 $PIPE $1 png:- | display -title "$1" -) rm $PIPE ``` Save this file as `git-imgdiff` script, make it executable and available in your `$PATH`. Now, `plotgitsch` can be invoked in your project's root directory in three forms: 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. 2. `plotgitsch ` performs the comparison between the working copy and the given revision. You can quickly spot what changed since the last tagged prototype. 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. Plotgitsch'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. ### Internal Diffing This 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.: ```bash $ plotgitsch -ifirefox ``` ![visual diff in the browser](svg_diff.png) This 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: ```bash $ plotgitsch --help ``` ## Archiving the Project Now 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. Say you want a zip archive of the version `1.0` of your project. Just type: ```bash $ git archive --format=zip --output=../myproject_v1.0.zip v1.0 ``` That's all. ================================================ FILE: docs/plotgitsch_usersguide.adoc ================================================ = Plotgitsch User's Guide Jean-Noël Avila :toc: :icons: font == Introduction 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. Provided your Kicad project is versioned with Git, this feature is useful in several cases, among which: * to check the changes you just introduced before committing * to visualize a changeset * to review the changes introduced between two revisions of a schematic * to send the difference of schematic to the person in charge of routing 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. NOTE: 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]. == Set Up In order to play with plotgitsch, let's prepare a sandbox project and see what can be done. [source, shell] ---- $ git clone https://github.com/jnavila/kicad_playground.git $ cd kicad_playground $ patch -p1 -i changes.diff ---- 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`. 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. [source, shell] ---- $ cd schematic $ ls -1 kicad_playground-cache.lib kicad_playground.kicad_pcb kicad_playground.pro kicad_playground.sch LEDs.sch ---- This 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]. == Internal Diff 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 https://en.wikipedia.org/wiki/Vector_graphics[vector graphics], which allows any zooming level. 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. 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: [source, shell] ---- $ plotgitsch -ifirefox ---- This should display: image::working_copy_diff.png[] It seems the last change to the working copy was the addition of a screw terminal block. 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. == Specifying Revisions to compare For the simplicity of this guide, all the revisions of this playground repo have been tagged so that you can easily type them in. `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. Revisions to be compared can be specified in three forms: with two, one or no revisions. 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. 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. 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. For instance, let's check the changes between two tagged revisions: [source, shell] ---- $ plotgitsch -ifirefox v0.0.3 v0.0.4 ---- image::LED_swap.png[] TIP: 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_. == Changing Colors 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: [source, shell] ---- $ plotgitsch -ifirefox -c FF0000:008FFF:FFFFFF:000000 v0.0.3 v0.0.4 ---- image::LED_swap_blackbg.png[] == Keeping Diff Pictures 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. 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. == Preloading libraries The project was not correctly checked in during the first revisions, namely, the cache library was not checked in: [source, shell] ---- $ plotgitsch -ifirefox v0.0.2 v0.0.3 internal diff and show with firefox between Git rev v0.0.2 and Git rev v0.0.3 Exception ("Kicadsch__Kicadlib.MakePainter(P).Component_Not_Found(\"Timer:LM555\")") ---- 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: [source, shell] ---- $ plotgitsch -ifirefox -lkicad_playground-cache.lib v0.0.2 v0.0.3 ---- image::diff_with_lib.png[] 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). TIP: 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. == Added sheets When a sheet is added or when several sheets are changed at once, the diffs are opened one tab per sheet in your browser. [source, shell] ---- $ plotgitsch -ifirefox v0.0.4 v0.0.5 ---- image::diff_two_tabs.png[] == Setting Default Options 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`: .Defining a shortcut alias in your `.bashrc` [source, shell] ---- alias pgs='plotgitsch --internal=firefox --color=FF0000:008FFF:FFFFFF:000000' ---- This lets you use the `pgs` alias to quickly check your local diffs from the last commit. Another option is to use environment variables to customize the behavior of `plotgitsch`. Two environment variables are usable: `PLOTGITSCH_VIEWER`:: This variable makes `plotgitsch` use the internal differ and its value is the command of the viewer. `PLOTGITSCH_COLORS`:: This variable is the value passed to the `--colors` option. `PLOTGITSCH_CHANGE_COLOR`:: This variable activate change zone highlighting with the specified color in hex format #rrggbb Set and export these variables in your `$HOME/.bashrc` or in you `$HOME/.profilerc`, like this: [source, shell] ---- export PLOTGITSCH_VIEWER=firefox export PLOTGITSCH_COLORS=FF0000:008FFF:FFFFFF:000000 ---- This way, `plotgitsch` 's default behavior will be to use the internal diff with firefox as a viewer with customized colors. == Other Options There are a few last options: `-t`, `--textdiff`:: In case the sch files are different but do not yield graphical differences, instruct `plotgitsch` to dump a text diff of the files. `--version`:: Show the version string. `-z#__`, `--zone=#__`:: Highlight the change zones in the diff output with specified colors. `--help`:: Show a very helpful manual page. ================================================ FILE: docs/plotgitsch_usersguide.html ================================================ Plotgitsch User’s Guide

Introduction

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.

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

  • to check the changes you just introduced before committing

  • to visualize a changeset

  • to review the changes introduced between two revisions of a schematic

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

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.

If 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.

Set Up

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

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

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.

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.

$ cd schematic
$ ls -1
kicad_playground-cache.lib
kicad_playground.kicad_pcb
kicad_playground.pro
kicad_playground.sch
LEDs.sch

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.

Internal Diff

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.

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.

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:

$ plotgitsch -ifirefox

This should display:

working copy diff

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

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.

Specifying Revisions to compare

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

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.

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

  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.

  2. 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.

  3. 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.

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

$ plotgitsch -ifirefox v0.0.3 v0.0.4
LED swap
You 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.

Changing Colors

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:

$ plotgitsch -ifirefox -c FF0000:008FFF:FFFFFF:000000 v0.0.3 v0.0.4
LED swap blackbg

Keeping Diff Pictures

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.

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.

Preloading libraries

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

$ plotgitsch -ifirefox v0.0.2 v0.0.3

internal diff and show with firefox between Git rev v0.0.2 and Git rev v0.0.3
Exception ("Kicadsch__Kicadlib.MakePainter(P).Component_Not_Found(\"Timer:LM555\")")

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:

$ plotgitsch -ifirefox -lkicad_playground-cache.lib v0.0.2 v0.0.3
diff with lib

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).

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.

Added sheets

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

$ plotgitsch -ifirefox v0.0.4 v0.0.5
diff two tabs

Setting Default Options

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:

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

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

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

PLOTGITSCH_VIEWER

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

PLOTGITSCH_COLORS

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

PLOTGITSCH_CHANGE_COLOR

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

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

export PLOTGITSCH_VIEWER=firefox
export PLOTGITSCH_COLORS=FF0000:008FFF:FFFFFF:000000

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

Other Options

There are a few last options:

-t, --textdiff

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

--version

Show the version string.

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

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

--help

Show a very helpful manual page.

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