planets-0.1.13/BUGS0000644000076600007660000000000010636107402015156 0ustar yminskyyminsky00000000000000planets-0.1.13/CHANGES0000644000076600007660000000454610636107402015511 0ustar yminskyyminsky000000000000000.1.10 - A number of small changes: * cleaned up the makefile and .spec file. There is now a debian package as well. * Added a "-debug" command line option that turns on debugging messages (useful for figuring out what the right keysym is for a certain key) * Fixed the zoom in/out so it works with the keypad. * A manpage is now included 0.1.9 - Fixed some problems in the Danish translation 0.1.8 - Integrated Daniel Andor's fourth-order runge-kutta code. Now the physical simulation is finally decent. Added pixmap and desktop entries, donated by Gunner Poulson. Implemented some dialog cleanups proposed by Bulia Byak, as well as a new command "J", for adding clockwise-only random orbital planets. True bouncing has been removed, leaving only force-bouncing. At the moment, I'm not sure how to do a good, energy-preserving true-bounce in combination with the runge-kutta method. 0.1.7 - Improved behavior of random-orbital planet (introduced by key "j") to behave more sensibly. In particular, the "implied distance" is computed not based on the center of mass of the remaining planets, but on the induced acceleration on the point in question. 0.1.6 - Changed kid key-bindings so that keypad introduces random non-orbital planets. Fixed bug where pressing Dismiss button on dialog did not commit changes. 0.1.5 - Danish translation added 0.1.4 - Debugging messages no longer listed by default Basic (and ad-hoc) support for internationalization (see display.ml and lstrings.ml). Universes no longer saved by default in current working directory. Instead, they are saved in $HOME/.planets, if $HOME exists. If $HOME exists but $HOME/.planets does not, then the latter is created. Help dialog is now displayed initially. This displays the basic keybindings, and can be disabled so it doesn't pop up initially. 0.1.3 - added more information to README.txt on windows about getting Tcl/Tk. No other user-visible changes, but some changes made towards sensible behavior for traces during COM-following mode. 0.1.2 - minor bugfixes 0.1.1 - code updated to work with OCaml 3.04. Mostly of the work is to accommodate the new labeling regime. 0.1 - First public release planets-0.1.13/codeguide.txt0000644000076600007660000001031010636107402017171 0ustar yminskyyminsky00000000000000Some quick notes on the code. Planets is written entirely in OCaml, a functional language developed at INRIA, a variant on ML. OCaml has a lot of nice features---the compiled code runs at near-C speeds, it has type inference, which means you need very few type declarations, which makes it terser and easier to read. And it is statically typed, which means that it catches a lot of errors at compile time rather than run time. And the compilers themselves are lightning fast compared to gcc. OCaml, however, has one big misfeature: it's unusual, and it's hard for someone who has never used it before to get use to the programming style. But OCaml is great language, so it could well be worth learing. Here's a list of the different modules and what they do. state.ml contains basic type definitions and holds the variables containing the state. This includes things like the definitions of vector operations. physics.ml Contains the basic physics, including computing the action of bodies on each other and a simple algorithm for collision detection and handling. Some of the actual code is really implemented in fast_physics.ml, which is where the physics code is moved to when it's optimized and made grungy. display.ml This is the user interface. It has a bunch of kinky stuff for setting up things like the placement of a new planet. You probably don?t want to look at it for a while. But it also contains some important and easy to modify stuff, including the key bindings, and the constants determining how many iterations are done per display cycle, and how long the display cycle is. options.ml This is somewhat hairy, so newbies beware. This is the code for implementing the little box containing the listing of configuration variables. The core data type here is a live value, which is just an class wrapping a value such that callbacks are invoked whenever the value is updated. These callbacks are used to update the display when configuration options are changed from outside the display, and to update the simulation when the configuration options are changed. Also contained in here is GUI code for generating the various kinds of displays required for the differnent options. There is much object-and-inheritance stuff going on, which is always hard to understand. collision.ml This code has all the raw material for the "true collision" mode. Basically it knows how to play billiards. The only function called by other modules is one that takes as its argument a sequence of planets and a time interval, and computes the motion, collisions and bounces that would happen assuming all host's velocities stay constant. This is done by repeatedly computing the next collision, moving the time forward to when that happens, and the computing how that collision causes planets to bounce. This is repeated until there are no further collisions in the time period. common.ml Contains a few definitions that are used in lots of places, primarily the debugging information. constants.ml A couple of physics constants that need to be accessed in a few different places. fast_physics.ml Contains the faster array-based implementation of some of the physics primitives. Full of lots of not-very-functional code. fqueue.ml A simple functional queue implementation used to store planet traces saveState.ml: Code for loading and saving universe files. This is a tad more sophisticated than your average flat config file --- it uses the ocaml Genlex module to generating a lexer, which in turn allows for a pretty flexible and readable file format. help.ml: Code for initial help window. lstrings.ml: Localization. Basically, it contains a bunch of functions (english, danish, etc.) that provide translations from certain polymorphic variants (i.e., `save or `load) to the appropriate string in the appropriate language. One of those functions is chosen at run-time as the one to actually use. augMap.ml, augSet.ml: simple, augmented versions of the Set and Map modules. The main improvement is that these keep track of their size, so that getting the number of elements is not linear. planets-0.1.13/COPYING0000644000076600007660000003557410636107402015556 0ustar yminskyyminsky00000000000000This software is only available under the GNU General Public License (GNU GPL). GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 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 Library 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 planets-0.1.13/CREDITS0000644000076600007660000000063410636107402015530 0ustar yminskyyminsky00000000000000* Yaron Minsky is the main author * Sandor Lehoczky helped out in implementing planet bouncing * Gunner Poulsen provided a number of useful suggestions, as well as a Danish translation. * Daniel Andor contributed the 4th-order runge-kutta code * Martin Pitt contributed many packaging fixes while building a debian package, and also wrote the initial version of the manpage. planets-0.1.13/FILES0000644000076600007660000000042710636107402015275 0ustar yminskyyminsky00000000000000BUGS CHANGES codeguide.txt COPYING CREDITS FILES BINFILES INSTALL INSTALL.txt INSTALL_w32.txt KEYBINDINGS.txt LICENSE Makefile README README.txt TODO VERSION planets.1 planets.desktop planets.png planets.spec sqrt.c uni.9 .depend getting_started.html planets.src.spec *.ml *.mli planets-0.1.13/BINFILES0000644000076600007660000000025510636107402015625 0ustar yminskyyminsky00000000000000BUGS CHANGES COPYING CREDITS FILES INSTALL INSTALL.txt INSTALL_w32.txt KEYBINDINGS.txt LICENSE README README.txt TODO VERSION planets.1.gz uni.9 getting_started.html planetsplanets-0.1.13/INSTALL0000644000076600007660000000433710636107402015545 0ustar yminskyyminsky00000000000000Unix Compilation ---------------- To install, you need Tcl/Tk version 8.3 and ocaml version 3.04. Getting these is pretty straightforward on a unix box, so I'll just point you to the URLs: http://www.scriptics.com (for Tcl/Tk) http://www.ocaml.org In order to compile planets, you simply move to the planets directory and type: make planets That should compile the planets executable. Note that planets looks for and saves universe files in the directory from which planets was invoked. Win32 Compilation ----------------- To compile under windows, you need to find and install a number of unix-style tools. The following explanation assumes a basic understanding of how to get around in a unix shell. Planets on Win32 currently depends on cygwin, a free (as in speech) UNIX-compatibility layer. Cygwin is available at http://cygwin.com. Download the setup.exe file, run it, and follow the instructions. You should end up with a bash shell, gcc, and make, which are the main prerequisites. You also need to install Tcl/Tk 8.3. You can get the ActiveTcl distribution at http://scriptics.com or http://activestate.com. Make sure you install Tcl at a path that doesn't include any spaces. Thus, installing at C:\Tcl is OK, C:\Program Files\Tcl isn't. Once you have cygwin and Tcl/Tk installed, you should get ocaml 3.04. Download that from www.ocaml.org. Once you unpack the archive, read the INSTALL file, which will give you the basic instructions. You need to enable labltk support, so your invocation of configure should look something like this: ./configure -tklibs -L/cygdrive/C/Tcl/lib -tkdefs -I/cygdrive/C/Tcl/include Look at the output of configure, and make sure that labltk was properly configured. You'll need to do "make world; make opt; make install" to actually compile and install ocaml. Once ocaml is installed, go to the planets directory. Type "make clean; make dep; make planets", and that, ideally, should do it. At this point, planets should be invokeable from the cygwin shell. To make it work from the GUI, you need to ensure that cygwin1.dll is in the path. You can do this either by copying cygwin1.dll from /usr/bin/ to the directory planets is in, or else by editing the normal windows path to ensure planets-0.1.13/INSTALL.txt0000644000076600007660000000433710636107402016363 0ustar yminskyyminsky00000000000000Unix Compilation ---------------- To install, you need Tcl/Tk version 8.3 and ocaml version 3.04. Getting these is pretty straightforward on a unix box, so I'll just point you to the URLs: http://www.scriptics.com (for Tcl/Tk) http://www.ocaml.org In order to compile planets, you simply move to the planets directory and type: make planets That should compile the planets executable. Note that planets looks for and saves universe files in the directory from which planets was invoked. Win32 Compilation ----------------- To compile under windows, you need to find and install a number of unix-style tools. The following explanation assumes a basic understanding of how to get around in a unix shell. Planets on Win32 currently depends on cygwin, a free (as in speech) UNIX-compatibility layer. Cygwin is available at http://cygwin.com. Download the setup.exe file, run it, and follow the instructions. You should end up with a bash shell, gcc, and make, which are the main prerequisites. You also need to install Tcl/Tk 8.3. You can get the ActiveTcl distribution at http://scriptics.com or http://activestate.com. Make sure you install Tcl at a path that doesn't include any spaces. Thus, installing at C:\Tcl is OK, C:\Program Files\Tcl isn't. Once you have cygwin and Tcl/Tk installed, you should get ocaml 3.04. Download that from www.ocaml.org. Once you unpack the archive, read the INSTALL file, which will give you the basic instructions. You need to enable labltk support, so your invocation of configure should look something like this: ./configure -tklibs -L/cygdrive/C/Tcl/lib -tkdefs -I/cygdrive/C/Tcl/include Look at the output of configure, and make sure that labltk was properly configured. You'll need to do "make world; make opt; make install" to actually compile and install ocaml. Once ocaml is installed, go to the planets directory. Type "make clean; make dep; make planets", and that, ideally, should do it. At this point, planets should be invokeable from the cygwin shell. To make it work from the GUI, you need to ensure that cygwin1.dll is in the path. You can do this either by copying cygwin1.dll from /usr/bin/ to the directory planets is in, or else by editing the normal windows path to ensure planets-0.1.13/INSTALL_w32.txt0000644000076600007660000000102110636107402017041 0ustar yminskyyminsky00000000000000When installing the binary on windows, you need to make sure that you have Tcl/Tk 8.3 installed. You can get it at scriptics.com or activestate.com. Once it's installed, you may need to reboot, to ensure that the path to the Tcl libraries (typically C:\Tcl) is in your path. You can add it manually if you like. Note that you also need the cygwin dll, which is included in the zip file. If you already have cygwin installed, then you can run planets from the cygwin command line without this installation of the cygwin dll. planets-0.1.13/KEYBINDINGS.txt0000644000076600007660000000257610636107402017026 0ustar yminskyyminsky00000000000000Note that universe files are now stored in ~/.planets, so you might want to drop the uni.9 example universe there. Normal keybindings H Display help dialog a Add Planet = Zoom In - Zoom Out B Toggle true bounce b Toggle bounce c, space Center k Display option dialog o Change all colors q, Escape Quit e Reset to empty universe s Save Universe l Load Universe u Undo (undoes last planet insertion) g Go Back (goes back to last planet insertion) p Toggle Pause t Toggle Trace d Double Trace Length h Halve Trace Length j Place random orbital planet r Place random planet x Initiate C-O-M tracking Up Pan Up Down Pan Down Left Pan Left Right Pan Right Also: * Drag a box around a set of planets to follow the center of mass of those planets. * Click on a planet to delete it Kidmode bindings: numbers : toggle tracing q,w,e,a,s,d,z,x,c: change colors space: move to center of mass escape: erase all planets all other buttons: add random planetplanets-0.1.13/LICENSE0000644000076600007660000004307610636107402015524 0ustar yminskyyminsky00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, 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 Library 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 Appendix: 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) 19yy 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., 675 Mass Ave, Cambridge, MA 02139, 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) 19yy 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 Library General Public License instead of this License. planets-0.1.13/Makefile0000644000076600007660000000616110636107402016151 0ustar yminskyyminsky00000000000000ifndef OCAMLC OCAMLC=ocamlc endif ifndef OCAMLOPT OCAMLOPT=ocamlopt endif ifndef CAMLP4O CAMLP4O=camlp4o endif ifndef PREFIX PREFIX=/usr/local endif INCLUDES=-I +labltk CAMLP4=-pp $(CAMLP4O) OCAMLDEP=ocamldep CAMLLIBS=unix.cma str.cma labltk.cma # libjpf.cma mylibs.cma OCAMLFLAGS=$(INCLUDES) $(CAMLP4) -g -custom $(CAMLLIBS) -cclib -lunix OCAMLOPTFLAGS=$(INCLUDES) $(CAMLP4) $(CAMLLIBS:.cma=.cmxa) -inline 50 -cclib -lunix ifdef PROFILING OCAMLC=ocamlcp OCAMLOPTFLAGS = -p $(INCLUDES) $(CAMLLIBS:.cma=.cmxa) -inline 40 -cclib -lunix endif OBJS = augSet.cmx augMap.cmx mTimer.cmx common.cmx lstrings.cmx options.cmx \ constants.cmx fqueue.cmx state.cmx saveState.cmx \ rk4.cmx fast_physics.cmx \ collision.cmx physics.cmx help.cmx display.cmx VERSION := $(shell cat VERSION) PREFIX = planets-$(VERSION) FILES := $(shell sed -e s/.*/$(PREFIX)\\/\&/ FILES) BINFILES := $(shell sed -e s/.*/$(PREFIX)\\/\&/ BINFILES) all: planets planets.1.gz install: planets.1.gz if [ -x planets ]; then install planets $(PREFIX)/bin/planets; fi if [ -x planets.bc ]; then install planets.bc $(PREFIX)/bin/planets; fi if [ -x $(PREFIX)/share/applications ]; \ then install planets.desktop $(PREFIX)/share/applications; fi if [ -x $(PREFIX)/share/applnk/Games ]; \ then install planets.desktop $(PREFIX)/share/applnk/Games; fi if [ -x $(PREFIX)/share/pixmaps ]; \ then install planets.png $(PREFIX)/share/pixmaps; fi if [ -x $(PREFIX)/share/man/man1 ]; \ then install planets.1.gz $(PREFIX)/share/man/man1; fi planets.1.gz: planets.1 gzip -c planets.1 > planets.1.gz rpm: planets.spec src rpmbuild -ta ../planets-$(VERSION).tgz src: planets.spec if [ ! -x planets-$(VERSION) ]; then ln -s . planets-$(VERSION); fi tar cfz ../planets-$(VERSION).tgz $(FILES) rm planets-$(VERSION) w32: planets cp /usr/bin/cygwin1.dll . zip -r ../planets.zip planets.exe cygwin1.dll getting_started.html \ README.txt KEYBINDINGS.txt LICENSE CHANGES BUGS CREDITS \ COPYING VERSION uni.* rm cygwin1.dll bin: all if [ ! -x planets-$(VERSION) ]; then ln -s . planets-$(VERSION); fi tar cfz ../planets-x86_Linux-$(VERSION).tgz $(BINFILES) rm planets-$(VERSION) planets: $(OBJS) $(OCAMLOPT) -o planets $(OCAMLOPTFLAGS) $^ planets.bc: $(OBJS:.cmx=.cmo) $(OCAMLC) -o planets.bc $(OCAMLFLAGS) $^ test: test.ml $(OCAMLC) -o test $(OCAMLFLAGS) $^ sqrt: sqrt.ml $(OCAMLOPT) -o sqrt $(OCAMLOPTFLAGS) $^ collision: constants.cmx options.cmx fqueue.cmx state.cmx collision.cmx $(OCAMLOPT) -o collision $(OCAMLOPTFLAGS) $^ convert: convert.ml $(OCAMLC) -o convert $(OCAMLFLAGS) $^ common.ml: common.src.ml VERSION sed s/__VERSION__/$(VERSION)/ < common.src.ml > common.ml planets.spec: planets.src.spec VERSION sed s/__VERSION__/$(VERSION)/ < planets.src.spec > planets.spec # Common rules .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC) $(OCAMLFLAGS) -c $< .mli.cmi: $(OCAMLC) $(OCAMLFLAGS) -c $< .ml.cmx: $(OCAMLOPT) $(OCAMLOPTFLAGS) -c $< # Clean up clean: rm -f *.[0-9].gz rm -f *.exe rm -f *.obj rm -f *.o rm -f *.cm[iox] rm -f planets rm -f planets.bc # Dependencies dep: $(OCAMLDEP) $(CAMLP4) $(INCLUDES) *.ml *.mli > .depend include .depend planets-0.1.13/README0000644000076600007660000000006410636107402015365 0ustar yminskyyminsky00000000000000Planets is a simple interactive orbital simulator. planets-0.1.13/README.txt0000644000076600007660000000135110636107402016203 0ustar yminskyyminsky00000000000000Windows Install Directions -------------------------- Before running planets, you need to make sure that you have Tcl/Tk 8.3 installed. You can get it here: http://downloads.activestate.com/ActiveTcl/Windows/8.3.4/ActiveTcl8.3.4.1-9.win32-ix86.exe Once it's installed, you may need to reboot, to ensure that the path to the Tcl libraries (typically C:\Tcl) is in your path. You can add it manually if you like. Note that you also need the cygwin dll, which is included in the zip file. If you already have cygwin installed, then you can run planets from the cygwin command line without this dll. Take a look at getting_started.html to get a sense of how to use the program, and look at KEYBINDINGS.txt to see the full set of keybindings. planets-0.1.13/TODO0000644000076600007660000000420110636107402015172 0ustar yminskyyminsky00000000000000* Physics - implement better approximation --- 4th order runge kutta would be a nice start, but there's a lot of stuff to do under this rubric, such as varying the step size depending on the conditions. - add in solar system snapshot. - Better bouncing: + repulsion field that drops off more quickly (nearly to zero outside of radius bound?) so as not to affect normal physics. - Redo COM-follow mode so it computes an offset for the COM, and then uses those to reposition before display. By keeping a record of the COM offsets, tracing could be made to do something reasonable in COM-follow mode. - Make 3D? Could be done with a 2D-display and a simple projection.... Use 2d-mouse movement for changing angle, maybe a scrollbar for depth. Could be done... - Make 3D for real: using LablGL. This will hurt portability and performance, however * Display - Consider breaking up traces into lots of little line segments. Whether this is an improvement depends on the internals of Tcl/Tk, but it does avoid the need for a linear scan (both in OCaml and in Tcl/Tk) every time a planet moves. - Consider using built-in Tcl/Tk scaling when zooming in and out. It's not clear, though, if that would really help performance. - Port to LablGtk? Canvas performance should be higher, there is anti-aliasing, and gtk can be linked in to make a small windows executable. This would be a lot of work, unfortunately. Also, what about portability? Should wait until LablGtk is more clearly the standard for OCaml, or at least until it's better supported. - Allow for display of planet names next to planets * UI - improved GUI controls for optionbox + exponential control + Little up-and-down arrows on the entry controls would be nice. * Config Files - Allow files to refrain from setting some variables, like G and G-exp. This should be controllable from the UI. Perhaps add a keyword to indicate that the current values should not be overwritten. - Modify lexer to enable forward and backward compatibility. i.e., non-understood entries are simply dropped. planets-0.1.13/VERSION0000644000076600007660000000000710636110372015552 0ustar yminskyyminsky000000000000000.1.13 planets-0.1.13/planets.10000644000076600007660000000533310636107402016241 0ustar yminskyyminsky00000000000000.TH planets 1 "April 20, 2003" .SH NAME planets \- Gravitational simulation of planetary bodies .\" .SH DESCRIPTION .\" .B Planets is a simple interactive program for playing with simulations of planetary systems. It is great teaching tool for understanding how gravitation works on a planetary level. The user interface is aimed at being simple enough for a fairly young kid can get some joy of it. There's also a special kid-mode aimed at very young children which grabs the focus and converts key banging into lots of random planets. .\" .SH KEYBINDINGS .\" .SS Universe definition .\" .IP a Add Planet .IP j Place random orbital planet .IP r Place random planet .IP u Undo (undoes last planet insertion) .IP e Reset to empty universe .IP g Go Back (goes back to just after last planet insertion) .IP Mouse Click on a planet to delete it .\" .SS Physics .\" .IP b Toggle bounce (experimental) .\" .SS Display control .\" .TP Cursor keys Panning .\" .TP c, Space Move display to center of mass .IP x Initiate center of mass tracking .IP = Zoom in .IP - Zoom out .IP p Toggle Pause .IP o Change all colors randomly .IP t Toggle Trace .IP d Double Trace Length .IP h Halve Trace Length .IP Mouse Drag a box around a set of planets to follow the center of mass of those planets .\" .SS Program control .\" .IP H Display help dialog .IP k Display option dialog .IP Ctrl-Shift-k Toggle kid-mode. Kid mode locks the keyboard and mouse, so the only way to get out is to toggle kid-mode again to get out. .IP l Load Universe After pressing l, press any other character to load the universe with that name. Universes are stored in ~/.planets/ . .IP s Save Universe .\" After pressing s, press any other character to save the universe with that name. Universes are saved in ~/.planets/ . .TP q, Esc Quit .\" .SH TECHNICAL DETAILS .B Planets uses a fourth-order runge-kutta approximation for the simulation itself. Planet bouncing is achieved by adding a repulsive force to planets at close quarters. .B Planets is fairly flexible: you can change the gravitational constant, the time-slice of the simulation, and even the exponent used in the gravitational law. Universes are saved in the ~/.planets directory, and are simple human readable and editable files. .SH BUGS Currently bouncing doesn't work very well unless you make the time-slice quite small. Ideally, it would be nice to have a billiard-style bounce system, but it's not clear how to do this accurately in the presence of a strong gravitational field. .SH AUTHOR .B Planets was written by Yaron M. Minsky as a gift for his nephew, Eyal Minsky-Fenick. This manpage was contributed originally by Martin Pitt for the Debian GNU/Linux system (but may be used by others). planets-0.1.13/planets.desktop0000644000076600007660000000047710636107402017556 0ustar yminskyyminsky00000000000000[Desktop Entry] Name=Planets Comment=A simple interactive program for playing with simulations of planetary systems Comment[da]=Et simpelt interaktivt program til at lege med simulering af planetsystemer Exec=planets Icon=planets.png Terminal=0 Type=Application Categories=Application;Game;Education;Astronomy;Physics; planets-0.1.13/planets.png0000644000076600007660000000077710636107402016674 0ustar yminskyyminsky00000000000000‰PNG  IHDR@@ªiqÞbKGDÿÿÿ œ§“ pHYs  ÒÝ~ütIMEÓk†dŒIDATxœíš1®1 DÇ_”ƒSüš‚pFn@AÍ)8}(P‚lÄfm2~%Z€ñ['ìÆ€‚揀M ``³b° ”÷mMDš×†PJÁúpl~ޒj LëñÙaôŠ¯Ž$„0J ``“ØŽ\÷»î5×ýîí§0Œ /¡U<Ÿ Îy )`¡–Àæï­v¬Lµ¥'&ž‹þߜ>ºŽ%CušõŠžâ|ÙÞ9‹PPJ*ü•óeë*AeÔ*žwOoßÐf±Íâ+ž °(Ÿâ%aX€eñ ?ÿ 4$ÀãîW¬» ;€€Ílží_±\ÙìlR;›ÀÀf¶y^xayFÀÀfH€ç2°>"Ëý¢Gx.êK ^§Ã‹—€…Ï£q•=@S‚÷\ 'C0:|îš³Áß>Î?H°°IìlR;›ÀÀ&°°IìlR;›ÀÀæüö›ø7xn–IEND®B`‚planets-0.1.13/planets.spec0000644000076600007660000000233310636110416017027 0ustar yminskyyminsky00000000000000Summary: A simple and fun planetary simulator Name: planets Version: 0.1.13 Release: 1 URL: http://planets.homedns.org Source0: %{name}-%{version}.tgz License: GPL Group: Amusements/Games BuildRoot: %{_tmppath}/%{name}-root %description Planets is a simple interactive program for playing with simulations of planetary systems. The user interface is aimed at being simple enough that a fairly young kid can get some joy out of it. But it's probably as much if not more fun for adults. %prep %setup -q %build make all %install rm -rf $RPM_BUILD_ROOT mkdir -p $RPM_BUILD_ROOT/usr/bin mkdir -p $RPM_BUILD_ROOT/usr/share/applications mkdir -p $RPM_BUILD_ROOT/usr/share/applnk/Games mkdir -p $RPM_BUILD_ROOT/usr/share/pixmaps mkdir -p $RPM_BUILD_ROOT/usr/share/man/man1 make PREFIX=$RPM_BUILD_ROOT/usr install %clean rm -rf $RPM_BUILD_ROOT %files %defattr(-,root,root) %doc KEYBINDINGS.txt LICENSE CHANGES BUGS CREDITS getting_started.html /usr/bin/* /usr/share/applications/* /usr/share/applnk/Games/* /usr/share/pixmaps/* /usr/share/man/man1/* %changelog * Mon Apr 21 2003 Yaron M. Minsky - modified spec file to use "make install" * Mon Feb 25 2002 Yaron M. Minsky - Initial build. planets-0.1.13/sqrt.c0000644000076600007660000000206110636107402015641 0ustar yminskyyminsky00000000000000#include #include #include int main () { struct timeval tv1, tv2; struct timezone tz; int iterations = 10000; double i; double v = 1000.0; double y = 0.0; // First sqrt gettimeofday(&tv1,&tz); for(i = 0;i Getting started with planets

Getting started with planets

A quick tutorial to get you started

Adding planets:

Press "a" to add a planet. That will attach a circle to your pointer, indicating the size of the planet. That size can be changed by pressing a number 0-9, and can also be adjusted up and down by a small percentage using the up and down arrows.

You click once to place the planet in a given location. Then move the mouse again, and you'll see a vector pointing from the planets location to the pointer. This is the initial velocity. Click again to set this.

Note that you can simply double-click to make a zero-velocity planet.

Keeping planets on-screen

There are a few ways of preventing planets from disappearing from view. You can:
recenter
on the center of mass and zero out the central velocity, by pressing the space bar.
pan
to follow the planets, by using the arrow keys
zoom in/out
by using the +/- keys. If you think you've lost planets, you can zoom way out, and eventually you'll seem them again. Just press the - key and hold it.

Saving and loading universes

You can save a configuration by typing "s" and then any other single character. Type "l" and that character to load the universe. Try l9 to load an interesting universe that comes with the distribution.

Fun things

undo and goback
"u" undoes the last planet addition, which is good for fixing mistakes. "g" goes back to just after the last planet addition which is nice for replaying interesting situations. You can undo arbitrarily many steps.
control panel
Press "k" to call up the control panel. This lets you see and control a number of configuration options, and see some of the state of the system.
Traces
Press "t" to toggle tracing, "d" to double trace length, and "h" to half trace length
Bouncing
Press "b" to toggle force bouncing, and "B" to toggle true bouncing
C-O-M following
You can track the center of mass of a subset of planets by dragging a box around them. "x" cancels the COM tracking. This is useful, for instance, if you want to track the moon and earth only of a moon-earth-sun system.
More information can be found in the Keybindings.txt file in the distribution.
Yaron M. Minsky
Last modified: Mon Jan 7 11:21:44 EST 2002 planets-0.1.13/planets.src.spec0000644000076600007660000000234010636107402017614 0ustar yminskyyminsky00000000000000Summary: A simple and fun planetary simulator Name: planets Version: __VERSION__ Release: 1 URL: http://planets.homedns.org Source0: %{name}-%{version}.tgz License: GPL Group: Amusements/Games BuildRoot: %{_tmppath}/%{name}-root %description Planets is a simple interactive program for playing with simulations of planetary systems. The user interface is aimed at being simple enough that a fairly young kid can get some joy out of it. But it's probably as much if not more fun for adults. %prep %setup -q %build make all %install rm -rf $RPM_BUILD_ROOT mkdir -p $RPM_BUILD_ROOT/usr/bin mkdir -p $RPM_BUILD_ROOT/usr/share/applications mkdir -p $RPM_BUILD_ROOT/usr/share/applnk/Games mkdir -p $RPM_BUILD_ROOT/usr/share/pixmaps mkdir -p $RPM_BUILD_ROOT/usr/share/man/man1 make PREFIX=$RPM_BUILD_ROOT/usr install %clean rm -rf $RPM_BUILD_ROOT %files %defattr(-,root,root) %doc KEYBINDINGS.txt LICENSE CHANGES BUGS CREDITS getting_started.html /usr/bin/* /usr/share/applications/* /usr/share/applnk/Games/* /usr/share/pixmaps/* /usr/share/man/man1/* %changelog * Mon Apr 21 2003 Yaron M. Minsky - modified spec file to use "make install" * Mon Feb 25 2002 Yaron M. Minsky - Initial build. planets-0.1.13/augMap.ml0000644000076600007660000000405510636107402016255 0ustar yminskyyminsky00000000000000open StdLabels open MoreLabels module type OrderedType = sig type t val compare: t -> t -> int end module type S = sig type key type 'a t val empty: 'a t val add: key:key -> (data:'a -> ('a t -> 'a t)) val find: key -> 'a t -> 'a val remove: key -> 'a t -> 'a t val mem: key -> 'a t -> bool val has_key: key -> 'a t -> bool val iter: f:(key:key -> (data:'a -> unit)) -> ('a t -> unit) val map: f:('a -> 'b) -> ('a t -> 'b t) val mapi: f:(key -> 'a -> 'b) -> ('a t -> 'b t) val fold: f:(key:key -> (data:'a -> ('b -> 'b))) -> ('a t -> (init:'b -> 'b)) val of_list: (key * 'a) list -> 'a t val to_list: 'a t -> (key * 'a) list val build_index: key list -> int t val filter: f:(key:key -> (data:'a -> bool)) -> ('a t -> 'a t) val keys: 'a t -> key list end module Make(Ord: OrderedType) : (S with type key = Ord.t) = struct (* create the underlying map module *) module UMap = Map.Make(Ord) type key = UMap.key type 'a t = 'a UMap.t let empty = UMap.empty let add = UMap.add let find = UMap.find let remove = UMap.remove let mem = UMap.mem let iter = UMap.iter let map = UMap.map let mapi = UMap.mapi let fold = UMap.fold let has_key key map = try let _ = find key map in true with Not_found -> false let of_list pairlist = let rec loop pairlist map = match pairlist with [] -> map | (key,data)::tl -> loop tl (add key data map) in loop pairlist empty let to_list map = fold ~f:(fun ~key ~data list -> (key,data)::list) map ~init:[] (* takes a list with no duplicates, and produces a map from elements of that list to indices into the list *) let build_index list = let rec loop list map i = match list with [] -> map | hd::tl -> loop tl (add ~key:hd ~data:i map) (i+1) in loop list empty 0 let keys map = fold ~f:(fun ~key ~data list -> key::list) map ~init:[] let filter ~f map = fold ~f:(fun ~key ~data map -> if f ~key ~data then add ~key ~data map else map) map ~init:empty end planets-0.1.13/augSet.ml0000644000076600007660000001132510636107402016271 0ustar yminskyyminsky00000000000000(* A painful and boring extension to the Set module. *) (* This is basically a somewhat extended and more efficient implementation of Set. *) (* Extended in that it has of_list, exists and for_all *) (* More efficient in that cardinal is now (usually) O(1) instead of O(n) *) open StdLabels open MoreLabels module type S = sig type elt and t val empty : t val is_empty : t -> bool val mem : elt -> t -> bool val add : elt -> t -> t val singleton : elt -> t val remove : elt -> t -> t val union : t -> t -> t val inter : t -> t -> t val diff : t -> t -> t val compare : t -> t -> int val equal : t -> t -> bool val subset : t -> t -> bool val iter : f:(elt -> unit) -> (t -> unit) val fold : f:(elt -> 'a -> 'a) -> (t -> (init:'a -> 'a)) val cardinal : t -> int (* more efficient than original *) val elements : t -> elt list val min_elt : t -> elt val max_elt : t -> elt val choose : t -> elt (* these are my additions to Set.S *) val of_list : elt list -> t val exists : (elt -> bool) -> t -> bool val for_all : (elt -> bool) -> t -> bool end module MakeFromSet(SomeSet : Set.S ) : (S with type elt = SomeSet.elt) = struct type t = { set: SomeSet.t; mutable length: int; } (* a length of (-1) implies the length is currently unknown *) type elt = SomeSet.elt let unary unary_func s = unary_func s.set let merge merge_func s t = { set = merge_func s.set t.set; length = -1 } let join join_func s t = join_func s.set t.set let incr v inc = if v >= 0 then v + inc else v let empty = { set = SomeSet.empty; length = 0 } and is_empty = unary SomeSet.is_empty and mem elt s = SomeSet.mem elt s.set and add elt s = if SomeSet.mem elt s.set then s else { set = SomeSet.add elt s.set; length = incr s.length 1 } and singleton elt = { set = SomeSet.singleton elt; length = 1 } and remove elt s = if SomeSet.mem elt s.set then { set = SomeSet.remove elt s.set; length = incr s.length (-1) } else s let union = merge SomeSet.union and inter = merge SomeSet.inter and diff = merge SomeSet.diff and compare = join SomeSet.compare and equal = join SomeSet.equal and subset = join SomeSet.subset and iter ~f s = SomeSet.iter ~f s.set and fold ~f s = SomeSet.fold ~f s.set and cardinal s = (if s.length < 0 then s.length <- SomeSet.cardinal s.set); s.length and elements = unary SomeSet.elements and min_elt = unary SomeSet.min_elt and max_elt = unary SomeSet.max_elt and choose = unary SomeSet.choose let of_list list = let add_elem set elem = SomeSet.add elem set in let new_set = List.fold_left ~f:add_elem ~init:SomeSet.empty list in { set = new_set; length = -1 } let exists test s = SomeSet.fold ~f:(fun elt tval -> tval || (test elt)) s.set ~init:true let for_all test s = SomeSet.fold ~f:(fun elt tval -> tval && (test elt)) s.set ~init:true end module Make = functor (Elt : Set.OrderedType) -> MakeFromSet(Set.Make(Elt)) let test () = let module IntSet = Make(struct type t = int let compare = compare end) in let passed = ref true in let test_cond tval fail_str = if not tval then begin Printf.printf "%s\n" fail_str; passed := false end in test_cond ((IntSet.cardinal IntSet.empty) = 0) "Empty set length test failed"; let set1 = IntSet.union (IntSet.of_list [1;2;3]) (IntSet.of_list [3;4;5]) and set2 = IntSet.of_list [1;2;3;4;5] in test_cond (IntSet.equal set1 set2) "union equality test failed"; test_cond ((IntSet.cardinal set1) = (IntSet.cardinal set2)) "union size test failed"; let set1 = IntSet.inter (IntSet.of_list [1;2;3;4]) (IntSet.of_list [3;4;5;6]) and set2 = IntSet.of_list [3;4] in test_cond (IntSet.equal set1 set2) "inter equality test failed"; test_cond ((IntSet.cardinal set1) = (IntSet.cardinal set2)) "inter size test failed"; let set1 = IntSet.diff (IntSet.of_list [1;2;3;4]) (IntSet.of_list [3;4;5;6]) and set2 = IntSet.of_list [1;2] in test_cond (IntSet.equal set1 set2) "diff equality test failed"; test_cond ((IntSet.cardinal set1) = (IntSet.cardinal set2)) "diff size test failed"; test_cond ((IntSet.elements (IntSet.of_list [0;1;2;3;4;5])) = [0;1;2;3;4;5]) "of_list/elements test failed"; test_cond ((IntSet.max_elt (IntSet.of_list [1;3;0;5;4;2])) = 5) "max_elt test failed"; test_cond ((IntSet.min_elt (IntSet.of_list [1;3;0;5;4;2])) = 0) "min_elt test failed"; test_cond (IntSet.subset (IntSet.of_list [1;4;3;4;4]) (IntSet.of_list [1;2;4;65;3;4;6;4])) "Subset/of_list test failed"; test_cond (IntSet.mem 3 (IntSet.of_list [1;2;5;3;5;6;7])) "mem test failed"; test_cond ((IntSet.cardinal (IntSet.of_list [1;2;3;1;2;3;3;1])) = 3) "cardinal test failed"; !passed planets-0.1.13/collision.ml0000644000076600007660000001014710636107402017035 0ustar yminskyyminsky00000000000000open State (***************************************************************) (** Collision detection *************************************) (***************************************************************) (* Computes smallest positive solution to the quadratic equation |p + t*v|^2 - dist = 0. The solution is: - v.p +/- sqrt((v.p)^2 - v.v*(p.p - dist)) ------------------------------------------ v.v if the sqrt term is imaginary, then bail out early (before computing the sqrt). This is a big performance win. *) let next_collision_values p v dist dotpp = let dotvp = dot v p in let dotvpsq = dotvp *. dotvp and dotpp = dot p p and dotvv = dot v v in let pre_sqrt_term = dotvpsq -. dotvv *. (dotpp -. (dist *. dist)) in if pre_sqrt_term <= 0. then infinity else let sqrt_term = sqrt pre_sqrt_term in let soln1 = (-. dotvp -. sqrt_term) /. dotvv and soln2 = (-. dotvp +. sqrt_term) /. dotvv in (* It's important to ignore planets that are currently touching *) (* note that soln2 is always greater than soln1 *) if soln2 <= 0. then infinity else if soln1 > 0. then soln1 else soln2 (* computes time of next collision given two bodies *) let next_collision_bodies b1 b2 = let dist = b1.radius +. b2.radius in let p = b1.pos <-> b2.pos in let v = b1.velocity <-> b2.velocity in let dotpp = dot p p in if dotpp < dist *. dist then infinity else next_collision_values p v dist dotpp (* computes nearest collision *) let next_collision bodies = let len = Array.length bodies in let best = ref (infinity, None) in for i = 0 to len - 2 do for j = i + 1 to len - 1 do let time = next_collision_bodies bodies.(i) bodies.(j) in let ( best_time, _ ) = !best in if time < best_time then best := (time, Some (i,j)); done done; match !best with (time,None) -> raise Not_found | (time,Some (i,j)) -> (time, (i,j)) (***************************************************************) (*** Bouncing ***********************************************) (***************************************************************) (* Computes the bounce of two touching bodies. It is assumed that the two bodies are touching. *) (* compute new velocities from 1-dimensional bounce problem *) let bounce_1d ~s1 ~s2 ~m1 ~m2 = let new_s1 = (( m1 -. m2) *. s1 +. 2. *. m2 *. s2) /. (m1 +. m2) and new_s2 = (( m2 -. m1) *. s2 +. 2. *. m1 *. s1) /. (m1 +. m2) in (new_s1,new_s2) let magsq v = dot v v let mag v = sqrt (magsq v) let uvec v = mag v <|> v let bounce_pair b1 b2 = let v1 = b1.velocity and v2 = b2.velocity and m1 = b1.mass and m2 = b2.mass and p1 = b1.pos and p2 = b2.pos in let u = uvec (p2 <-> p1) in (* speed in collision direction *) let s1 = dot v1 u and s2 = dot v2 u in (* perpendicular components of velocity *) let v1p = v1 <-> (s1 <*> u) and v2p = v2 <-> (s2 <*> u) in let new_s1,new_s2 = bounce_1d ~s1 ~s2 ~m1 ~m2 in let new_v1 = (new_s1 <*> u) <+> v1p and new_v2 = (new_s2 <*> u) <+> v2p in ( { b1 with velocity = new_v1 }, { b2 with velocity = new_v2 } ) (***************************************************************) (**** Moving Forward ****************************************) (***************************************************************) let move_forward_simple bodies time = for i = 0 to Array.length bodies - 1 do let body = bodies.(i) in bodies.(i) <- { body with pos = body.pos <+> (time <*> body.velocity) } done let rec move_forward_array time bodies = try let (ctime,(i,j)) = next_collision bodies in if ctime > time then move_forward_simple bodies time else ( move_forward_simple bodies ctime; (* move to collision time *) let b_i,b_j = bodies.(i),bodies.(j) in let b_i,b_j = bounce_pair b_i b_j in bodies.(i) <- b_i; bodies.(j) <- b_j; move_forward_array (time -. ctime) bodies ) with Not_found -> move_forward_simple bodies time let move_forward time bodies = let bodies = Array.of_list bodies in move_forward_array time bodies; Array.to_list bodies planets-0.1.13/common.ml0000644000076600007660000000234210636107402016330 0ustar yminskyyminsky00000000000000(* Planets: A celestial simulator Copyright (C) 2001-2003 Yaron M. Minsky 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let version = "0.1.11" let debugging = ref false let debug_msg msg = if !debugging then (print_string msg; print_newline ()) type 'a reference = { mutable v: 'a } type fref = { mutable fv: float } let lpush el l = l := el::!l (** argument parsing code *) let anonymous = ref [] let spec = [ ("-debug", Arg.Set debugging, "Turn debugging mode on") ] let () = Arg.parse spec (fun s -> lpush s anonymous) "planets [-debug]" planets-0.1.13/common.src.ml0000644000076600007660000000234710636107402017123 0ustar yminskyyminsky00000000000000(* Planets: A celestial simulator Copyright (C) 2001-2003 Yaron M. Minsky 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let version = "__VERSION__" let debugging = ref false let debug_msg msg = if !debugging then (print_string msg; print_newline ()) type 'a reference = { mutable v: 'a } type fref = { mutable fv: float } let lpush el l = l := el::!l (** argument parsing code *) let anonymous = ref [] let spec = [ ("-debug", Arg.Set debugging, "Turn debugging mode on") ] let () = Arg.parse spec (fun s -> lpush s anonymous) "planets [-debug]" planets-0.1.13/constants.ml0000644000076600007660000000157210636107402017060 0ustar yminskyyminsky00000000000000(* Planets: A celestial simulator Copyright (C) 2001-2003 Yaron M. Minsky 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let gconst = new Options.live_value 1.0 let grav_exp = new Options.live_value 2.0 planets-0.1.13/convert.ml0000644000076600007660000000711710636107402016525 0ustar yminskyyminsky00000000000000(* Planets: A simple 2-d celestial simulator Copyright (C) 2001 Yaron M. Minsky 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (* When run in a given directory, converts all the uni.[0-9a-z] files from * the old to the new format. *) open Printf open Tk type body = { pos: float * float; velocity: float * float; radius: float; color: color; mass: float; id: int; } type state = { mutable zoom: float; mutable center: float * float; mutable delta: float; mutable bodies: body list; } let state = { zoom = 0.0; center = (0.0, 0.0); delta = 0.0; bodies = []; } let load_universe filename = try let in_c = open_in_bin filename in let nstate = ((Marshal.from_channel in_c):state) in state.zoom <- nstate.zoom; state.center <- nstate.center; state.delta <- nstate.delta; state.bodies <- nstate.bodies; with Sys_error str -> print_string ("error opening file: " ^ str); print_newline (); () (******************************************************************) (******************************************************************) let string_of_float x = sprintf "%.20e" x let string_of_int x = sprintf "%d" x let string_of_pair pair = sprintf "(%s, %s)" (string_of_float (fst pair)) (string_of_float (snd pair)) let string_of_color color = match color with `Color string -> string | `Black -> "black" | `Blue -> "blue" | `Red -> "red" | `White -> "white" | `Green -> "green" | `Yellow -> "yellow" let write_body out_c body = let indent = " " in fprintf out_c "\nbody\n"; fprintf out_c "%spos %s\n" indent (string_of_pair body.pos); fprintf out_c "%svelocity %s\n" indent (string_of_pair body.velocity); fprintf out_c "%sradius %s\n" indent (string_of_float body.radius); fprintf out_c "%smass %s\n" indent (string_of_float body.mass); fprintf out_c "%scolor \"%s\"\n" indent (string_of_color body.color); fprintf out_c "%sid %s\n" indent (string_of_int body.id) let write_state out_c = fprintf out_c "zoom %s\n" (string_of_float state.zoom); fprintf out_c "center %s\n" (string_of_pair state.center); fprintf out_c "delta %s\n" (string_of_float state.delta); List.iter ~f:(write_body out_c) state.bodies; close_out out_c let write_state_file filename = write_state (open_out filename) let get_files ~f dir = let rec loop files = try let file = Unix.readdir dir in if f file then loop (file::files) else loop files with End_of_file -> files in loop [] let is_uni str = let pat = Str.regexp "^uni\.[0-9a-z]$" in Str.string_match ~pat str ~pos:0 let main () = let dir = Unix.opendir(".") in let files = get_files ~f:is_uni dir in List.iter ~f:(fun filename -> load_universe filename; write_state_file filename) files let _ = if not !Sys.interactive then main () planets-0.1.13/display.ml0000644000076600007660000011440010636107402016504 0ustar yminskyyminsky00000000000000(* Planets: A simple 2-d celestial simulator Copyright (C) 2001-2003 Yaron M. Minsky 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open StdLabels open MoreLabels open Tk open Printf open State open Common open Constants let gap_ms = Options.named_live_value "gap_ms" 30 (* period, in ms, between callbacks. 30ms corresponds to roughly 33 frames/sec *) let iterations = Options.named_live_value "iterations" (gap_ms#v / 15) (* # iterations per callback *) let init_screen_width = 500 let init_screen_height = 500 let diameter_multiplier = Options.named_live_value "diameter_multiplier" 1.0 let random_vel_multiplier = Options.named_live_value "random_vel_multiplier" 1.0 let penergy = Options.named_live_value "penergy" 0.0 let kenergy = Options.named_live_value "kenergy" 0.0 let energy = Options.named_live_value "energy" 0.0 let num_bodies = Options.named_live_value "number of bodies" 0 let truebounce = new Options.live_toggle false let kidmode = new Options.live_toggle false let _ = truebounce#set_name "truebounce"; kidmode#set_name "kidmode" let app_class = "Planets" (********************************************************) module IntSet = AugSet.Make(struct type t = int let compare = compare end) (********************************************************) (*** Color Operations *********************************) (********************************************************) let intensity r g b = sqrt ((float_of_int r)**2.0 +. (float_of_int g)**2.0 +. (float_of_int b)**2.0) let max_intensity r g b = let maxval = max (max r g) b in let mult = 255.0 /. (float_of_int maxval) in let max_r = (float_of_int r) *. mult and max_g = (float_of_int g) *. mult and max_b = (float_of_int b) *. mult in sqrt (max_r ** 2.0 +. max_g ** 2.0 +. max_b ** 2.0) let test_color r g b = (r >= 0 && r < 256) && (g >= 0 && g < 256) && (b >= 0 && b < 256) let renormalize r g b = let m = max_intensity r g b in let i = intensity r g b in let new_i = (m +. i) /. 2.0 in let r = int_of_float ((float_of_int r) *. new_i /. i) and g = int_of_float ((float_of_int g) *. new_i /. i) and b = int_of_float ((float_of_int b) *. new_i /. i) in assert (test_color r g b); rgb r g b let rand_range () = Random.int 256 let rand_color () = renormalize (rand_range ()) (rand_range ()) (rand_range ()) let change_trace_color id color = try let trace = IntMap.find id transient.traces in transient.traces <- IntMap.add ~key:id ~data:{trace with t_color = color} transient.traces with Not_found -> () let change_body_color_by_id id = let color = rand_color () in let changebodies bodies = List.map ~f:(fun body -> if body.id = id then { body with color = color } else body) bodies in state.bodies <- changebodies state.bodies; change_trace_color id color let hlcolor = `Yellow let fgcolor = `White let bgcolor = `Black let uw opt = match opt with Some x -> x | None -> failwith "Display.uw: attempt to unwrap null option" (****************************************************) (****************************************************) (****************************************************) let compute_energy () = let p = Physics.penergy state.bodies and k = Physics.kenergy state.bodies in penergy#set (log (abs_float p)); kenergy#set (log k); energy#set (log (abs_float (p +. k))) (****************************************************) (****************************************************) (****************************************************) type ('a,'b,'c,'d) disp_state = { mutable toplevel: Widget.toplevel Widget.widget option; mutable frame: Widget.frame Widget.widget option; mutable canvas: Widget.canvas Widget.widget option; mutable optionbox: ('c,'d) Options.optionbox option; mutable dbodies: 'a IntMap.t; mutable dtraces: 'b IntMap.t; mutable tracked_ids: IntSet.t; paused: Options.live_toggle; tracing: Options.live_toggle; tracking: Options.live_toggle; } let disp_state = { toplevel = None; frame = None; canvas = None; optionbox = None; dbodies = IntMap.empty; dtraces = IntMap.empty; tracked_ids = IntSet.empty; paused = new Options.live_toggle false; tracing = new Options.live_toggle false; tracking = new Options.live_toggle false; } let get_dbody id = IntMap.find id disp_state.dbodies let canvas () = uw disp_state.canvas let init_optionbox () = let obox = new Options.optionbox (uw disp_state.toplevel) in obox#set_liveness true; Options.add_option_live obox disp_state.paused (new Options.toggle_option ~text:(Lstrings.get `paused) ~set:disp_state.paused#set ~get:disp_state.paused#get ()); Options.add_option_live obox disp_state.tracing (new Options.toggle_option ~text:(Lstrings.get `tracing) ~set:disp_state.tracing#set ~get:disp_state.tracing#get ()); Options.add_option_live obox truebounce (new Options.toggle_option ~text:(Lstrings.get `true_bounce) ~set:truebounce#set ~get:truebounce#get ()); Options.add_option_live obox transient.bound (new Options.int_scale_option ~text:(Lstrings.get `trace_length) ~set:transient.bound#set ~get:transient.bound#get ~min:3.0 ~max:300.0 ()); Options.add_option_live obox gap_ms (new Options.int_scale_option ~text:(Lstrings.get `disp_period) ~set:gap_ms#set ~get:gap_ms#get ~min:1.0 ~max:100.0 ()); Options.add_option_live obox iterations (new Options.int_scale_option ~text:(Lstrings.get `iter_display) ~set:iterations#set ~get:iterations#get ~min:1.0 ~max:100.0 ()); Options.add_option_live obox state.delta (new Options.float_entry_option ~text:(Lstrings.get `time_step) ~mult:1.05 ~set:state.delta#set ~get:state.delta#get ()); Options.add_option_live obox gconst (new Options.float_entry_option ~text:(Lstrings.get `g) ~mult:1.05 ~set:gconst#set ~get:gconst#get ()); Options.add_option_live obox grav_exp (new Options.float_entry_option ~text:(Lstrings.get `grav_exp) ~mult:1.01 ~set:grav_exp#set ~get:grav_exp#get ()); Options.add_option obox (new Options.void_entry_display ~text:"New random bodies:" ()); Options.add_option_live obox diameter_multiplier (new Options.float_entry_option ~text:(Lstrings.get `diam_mult) ~mult:1.01 ~set:diameter_multiplier#set ~get:diameter_multiplier#get ()); Options.add_option_live obox random_vel_multiplier (new Options.float_entry_option ~text:(Lstrings.get `rand_vel_mult) ~mult:1.01 ~set:random_vel_multiplier#set ~get:random_vel_multiplier#get ()); (* Energy Display *) Options.add_option_live obox kenergy (new Options.float_entry_display ~text:(Lstrings.get `log_k_energy) ~set:kenergy#set ~get:kenergy#get ()); Options.add_option_live obox penergy (new Options.float_entry_display ~text:(Lstrings.get `log_p_energy) ~set:penergy#set ~get:penergy#get ()); Options.add_option_live obox energy (new Options.float_entry_display ~text:(Lstrings.get `log_energy) ~set:energy#set ~get:energy#get ()); Options.add_option_live obox num_bodies (new Options.int_entry_display ~text:(Lstrings.get `num_planets) ~set:num_bodies#set ~get:num_bodies#get ()); disp_state.optionbox <- Some obox let toggle_opt_dialog () = match disp_state.optionbox with None -> failwith "Display.create_dialog: Attempt to display optionbox when none is available" | Some obox -> if obox#mapped then obox#destroy else obox#create_dialog ~geometry:"+0+0" ~transient:(uw disp_state.toplevel) ~clas:app_class () (********************************************************) (** Display Classes ***********************************) (********************************************************) (** Note: just screwing around here. Classes are not yet used. **) class virtual ['a] display_item tag = object (self) val tag = tag val mutable alive = true method destroy = if not alive then failwith "Attempt to destroy same display_item more than once" else (Canvas.delete (canvas ()) [tag]; alive <- false) method draw item = if not alive then failwith "Display.display_item#draw: attempt to draw deleted item." else self#draw_internal item (* Here's where you put the logic for drawing an item*) method virtual draw_internal : 'a -> unit end (************************************************) class dbody body tag = let tag = tag in object (self) inherit [body] display_item tag val id = body.id method draw_internal body = let r = body.radius *. state.zoom#v and (x,y) = real_to_screen body.pos in let (x1,y1,x2,y2) = (int_of_float (x -. r), int_of_float (y -. r), int_of_float (x +. r), int_of_float (y +. r)) in Canvas.configure_oval ~fill:body.color ~outline:fgcolor (canvas ()) tag; Canvas.coords_set (canvas ()) tag ~xys:[ (x1,y1) ; (x2,y2) ] initializer begin Canvas.bind ~events:[`ButtonPress] ~extend:false ~fields:[] ~action:(fun e -> delete_body_by_id id) (* change_body_color_by_id id) *) (canvas ()) tag; self#draw_internal body end end let new_dbody_with_tag body tag = new dbody body tag let new_dbody_from_body body = let tag = Canvas.create_oval ~x1:0 ~y1:0 ~x2:0 ~y2:0 (canvas ()) in new dbody body tag (************************************************) class dtrace () = let tag = try Canvas.create_line ~xys:[(0,0);(0,0)] (canvas ()) with e -> failwith (sprintf "line drawing failed: %s" (Printexc.to_string e)) in let _ = Canvas.configure_line ~smooth:false (canvas ()) tag in object (self) inherit [trace] display_item tag method draw_internal trace = let screen_trace = List.map ~f:pair_to_int (List.map ~f:real_to_screen (trace_to_list trace)) in if List.length screen_trace > 1 then ( Canvas.configure_line ~fill:trace.t_color (canvas ()) tag; Canvas.coords_set (canvas ()) tag ~xys:screen_trace ) end (**********************************************************) (** Classes used in the placement of new planets *******) (**********************************************************) class ['a] new_planet () = let tag = Canvas.create_oval ~x1:0 ~y1:0 ~x2:0 ~y2:0 (canvas ()) in object (self) inherit ['a] display_item tag val mutable radius = 0.0 val mutable pos = (0,0) val mutable color = fgcolor method draw_internal (x,y) = let radius = int_of_float radius in let coords = [(x-radius,y-radius);(x+radius,y+radius)] in Canvas.coords_set (canvas ()) tag ~xys:coords; pos <- (x,y) method set_radius _radius = radius <- _radius; self#draw_internal pos method set_color _color = Canvas.configure_oval ~fill:_color (canvas ()) tag; color <- _color method tag = tag method pos = pos method radius = radius method color = color initializer Canvas.configure_oval ~outline:fgcolor (canvas ()) tag end (******) class ['a] new_velocity planet = let pos = planet#pos in let tag = Canvas.create_line ~xys:[pos; pos] ~arrow:`Last (canvas ()) in let _ = Canvas.configure_line ~fill:fgcolor (canvas ()) tag in object (self) inherit ['a] display_item tag val mutable vpos = planet#pos method draw_internal _vpos = Canvas.coords_set (canvas ()) tag ~xys:[pos; _vpos]; vpos <- _vpos method vpos = vpos method tag = tag end (*********************************************************) (** Functions for selecting bodies *********************) (*********************************************************) let selected_bodies pos1 pos2 = let (x1,y1) = pair_to_float pos1 and (x2,y2) = pair_to_float pos2 in let x1,x2 = (min x1 x2), (max x1 x2) and y1,y2 = (min y1 y2), (max y1 y2) in List.filter ~f:(fun body -> let (x,y) = real_to_screen body.pos in x1 <= x && x <= x2 && y1 <= y && y <= y2) state.bodies let selected_ids pos1 pos2 = IntSet.of_list (List.map ~f:(fun body -> body.id) (selected_bodies pos1 pos2)) let recenter_on_selection pos1 pos2 = debug_msg "recentering on selection"; let bodies = selected_bodies pos1 pos2 in if bodies != [] then begin debug_msg (sprintf "recentering on %d bodies" (List.length bodies)); Physics.zero_speed_bodies bodies; Physics.center_bodies bodies end else debug_msg "no bodies selected to recenter on" let create_rectangle color pos1 pos2 = let (x1,y1) = pos1 and (x2,y2) = pos2 in Canvas.create_rectangle ~x1 ~y1 ~x2 ~y2 ~outline:color (canvas ()) (***********************************************************) (** Primitives for displaying and deleting display items *) (***********************************************************) let delete_dbody_id id = try let dbody = get_dbody id in disp_state.dbodies <- IntMap.remove id disp_state.dbodies; dbody#destroy with Not_found -> printf "No dbody with id %d" id; print_newline () let delete_trace_id id = try let dtrace = IntMap.find id disp_state.dtraces in disp_state.dtraces <- IntMap.remove id disp_state.dtraces; dtrace#destroy with Not_found -> printf "No dtrace with id: %d" id; print_newline () (***************************************************) (* Lookup functions for dbody/dtrace. * If one is not found, one is created. *) let get_dbody body = try IntMap.find body.id disp_state.dbodies with Not_found -> let dbody = new_dbody_from_body body in disp_state.dbodies <- IntMap.add ~key:body.id ~data:dbody disp_state.dbodies; dbody let get_dtrace id = try IntMap.find id disp_state.dtraces with Not_found -> let dtrace = new dtrace () in disp_state.dtraces <- IntMap.add ~key:id ~data:dtrace disp_state.dtraces; dtrace (****************) let draw_body body = (get_dbody body)#draw body let draw_trace ~key:id ~data:trace = (get_dtrace id)#draw trace let draw_bodies () = List.iter ~f:draw_body state.bodies let draw_traces () = IntMap.iter ~f:draw_trace transient.traces (****************) let change_all_body_colors () = let changebodies bodies = List.map ~f:(fun body -> let color = rand_color () in change_trace_color body.id color; { body with color = color} ) bodies in state.bodies <- changebodies state.bodies (********************************************************) let remove_dead_bodies () = let disp_ids = IntSet.of_list (IntMap.keys disp_state.dbodies) in let body_ids = IntSet.of_list (List.map ~f:(fun body -> body.id) state.bodies) in let dead_ids = IntSet.diff disp_ids body_ids in IntSet.iter ~f:delete_dbody_id dead_ids let remove_dead_traces () = let disp_ids = IntSet.of_list (IntMap.keys disp_state.dtraces) in let trace_ids = IntSet.of_list (IntMap.keys transient.traces) in let dead_ids = IntSet.diff disp_ids trace_ids in IntSet.iter ~f:delete_trace_id dead_ids let remove_all_traces () = let disp_ids = IntSet.of_list (IntMap.keys disp_state.dtraces) in IntSet.iter ~f:delete_trace_id disp_ids let _ = disp_state.tracing#register_callback (fun oldval newval -> if not newval then remove_all_traces ()) let remove_dead () = remove_dead_bodies (); remove_dead_traces () (********************************************************) let redraw_all_basic () = draw_bodies (); if disp_state.tracing#v then draw_traces () let redraw_all () = redraw_all_basic (); remove_dead () (*********************************************************) (*********************************************************) (*********************************************************) let pause () = disp_state.paused#set true let resume () = disp_state.paused#set false let init_body ~color ~pos ~velocity ~radius = let body = { pos = pos; velocity = velocity; radius = radius; color = color; mass = radius ** 3.0; id = Random.bits (); i = None; } in set_undo_point (); state.bodies <- body::state.bodies; set_goback_point (); body let add_new_body ~color ~pos ~vpos ~r = let r = r /. state.zoom#v in init_body ~color ~pos:(screen_to_real pos) ~velocity:((state.zoom#v *. 10.0) <|> (pair_to_float vpos <-> pair_to_float pos)) ~radius:r let add_dbody_from_tag body tag = let dbody = new_dbody_with_tag body tag in disp_state.dbodies <- IntMap.add ~key:body.id ~data:dbody disp_state.dbodies (* track center-of-mass *) let track_com () = if disp_state.tracking#v then let tbodies = List.filter ~f:(fun body -> IntSet.mem body.id disp_state.tracked_ids) state.bodies in if tbodies != [] then (Physics.zero_speed_bodies tbodies; Physics.center_bodies tbodies) (*****************************************************) (*****************************************************) let file_join filelist = let rec file_join filelist partial = match filelist with [] -> partial | hd::tl -> file_join tl (Filename.concat partial hd) in file_join filelist "" (* let toggle b = if b then false else true *) let planet_radius i = (float_of_int i) *. 5.0 *. diameter_multiplier#v let is_num c = (int_of_char '0') <= (int_of_char c) && (int_of_char c) <= (int_of_char '9') let to_num c = (int_of_char c) - (int_of_char '0') (* Center weighted random float *) let cw_rand_float level f = let x = Random.float 2.0 in let x = x -. 1.0 in let mult = if x >= 0.0 then (x**level +. 1.0) /. 2.0 else (-.abs_float(x**level) +. 1.0) /. 2.0 in mult *. f let cw_rand_int level i = let f_val = cw_rand_float level (float i) in round f_val let random_velocity size = let screen_vel = ( (Random.float (2.0 *. size)) -. size, (Random.float (2.0 *. size)) -. size ) in random_vel_multiplier#v <*> (state.zoom#v <|> screen_vel) let random_planet () = let screen_radius = planet_radius 3 and screen_pos = (Random.float (float !screen_width), Random.float (float !screen_height)) and velocity = random_velocity 0.9 and color = rand_color () in let pos = screen_to_real_float screen_pos and radius = screen_radius /. state.zoom#v in ignore (init_body ~color ~pos ~velocity ~radius) let mag v = sqrt (dot v v) let tweak_size = 0.1 let rand_tweak size = ((Random.float 2.0) -. 1.) *. size *. tweak_size let rdist ?(n=6) low high = let x = ref 0.0 in for i = 0 to n -1 do x := !x +. Random.float (1.0/. float n) done; low +. (high -. low) *. !x (** adds a planet at what would be a near-orbital velocity if the force induced on the new planet all came from a single planet. *) let orbital_planet dir = let screen_radius = planet_radius (Random.int 3 + 1) in let radius = screen_radius /. state.zoom#v in let color = rand_color () in let screen_pos = (rdist ~n:3 0. (float !screen_width), rdist ~n:3 0. (float !screen_height)) in let pos = screen_to_real_float screen_pos in let ovelocity = Physics.induced_orbital_velocity state.bodies ~pos dir in let speed = mag ovelocity in let velocity = ovelocity +| (rand_tweak speed,rand_tweak speed) in ignore (init_body ~color ~pos ~velocity ~radius) (*******************************************************) (** Callbacks *************************************) (*******************************************************) type key_matcher = | Key of string | KeySym of string | KeyList of string list | Other type key_handler = { key: key_matcher; description: string; handler: eventInfo -> unit; } let rec lookup handlers key = match handlers with | handler::tl -> if handler.key = key then Some handler else lookup tl key | [] -> None let handler_to_string h = let matcher = match h.key with Key s -> s | KeySym s -> s | KeyList slist -> String.concat ", " slist | Other -> "Any other key" in "\t" ^ matcher ^ (if String.length matcher > 8 then "" else "\t") ^ "\t " ^ h.description let hlist_to_string hlist = let slist = List.map ~f:handler_to_string hlist in String.concat "\n" slist (***********************************************************) let rec get_next_key ~f = let handle e = f e.ev_Char; set_normal_key_handler () in bind_class ~events:[`KeyPress] ~extend:false ~fields:[`Char] ~action:handle app_class (***********************************************************) (** UI State Machine ************************************) (***********************************************************) (* Events: Motion, ButtonRelease, ButtonPress, KeyPress A: default_state: def_key_map "a" -> B:create_planet ButtonPress -> D:draw_rectangle Motion -> nothing ButtonRelease -> nothing B: create_planet: Save Pause, pause [0-9] -> change_planet_size Motion -> move planet BottonPress -> place planet, C:set_planet_direction ButtonRelease -> nothing (can't be reached anyway) C: set_planet_direction: [0-9] -> change_planet_size Motion -> move arrow ButtonPress -> set arrow, restore pause state, A:default_state ButtonRelease -> nothing D: draw_rectangle: save pause, pause No keymap ButtonPress -> nothing ButtonRelease -> restore pause A:default_state Motion -> move rectangle *) (***********************************************************) (** Planet Select ****************************************) (***********************************************************) and select_planet_handler e = clear_select_planet_handler (); clear_key_handler (); let pos = (e.ev_MouseX,e.ev_MouseY) in let pos1 = ref pos and pos2 = ref pos in let tag = create_rectangle fgcolor !pos1 !pos2 in let move e = pos2 := (e.ev_MouseX,e.ev_MouseY); Canvas.coords_set (canvas ()) tag ~xys:[!pos1; !pos2] and finish pause_state e = Canvas.delete (canvas ()) [tag]; disp_state.tracked_ids <- selected_ids !pos1 !pos2; disp_state.paused#set pause_state; disp_state.tracking#set true; restore_normal_bindings (); redraw_all () in let old_pause_state = disp_state.paused#v in disp_state.paused#set true; bind ~events:[`Motion] ~extend:false ~fields:[`MouseX;`MouseY] ~action:move (uw disp_state.canvas); bind ~events:[`ButtonRelease] ~extend:false ~fields:[] ~action:(finish old_pause_state) (uw disp_state.canvas) and set_select_planet_handler () = bind ~events:[`ButtonPress] ~extend:false ~fields:[`MouseX; `MouseY] ~action:select_planet_handler (uw disp_state.canvas) and clear_select_planet_handler () = bind ~events:[`ButtonPress] (uw disp_state.canvas) (***********************************************************) (** Add Planet ******************************************) (***********************************************************) and add_planet pos rad_int = let rec move_planet planet e = planet#draw (e.ev_MouseX,e.ev_MouseY) and set_radius planet e = if String.length e.ev_Char > 0 && is_num e.ev_Char.[0] then let rad_int = to_num e.ev_Char.[0] in planet#set_radius (planet_radius rad_int) else if e.ev_KeySymString="Down" then planet#set_radius (planet#radius *. (1.0/.1.1)) else if e.ev_KeySymString="Up" then planet#set_radius (planet#radius *. 1.1) and move_velocity velocity e = velocity#draw (e.ev_MouseX,e.ev_MouseY) and set_place planet pause_state e = planet#draw (e.ev_MouseX,e.ev_MouseY); planet#set_color (rand_color ()); let velocity = new new_velocity planet in bind ~events:[`Motion] ~extend:false ~fields:[ `MouseX; `MouseY] ~action:(move_velocity velocity) (uw disp_state.canvas); bind ~events:[`ButtonPress] ~extend:false ~fields:[] ~action:(finish pause_state planet velocity) (uw disp_state.canvas) and finish pause_state planet velocity e = bind ~events:[`Motion] ~extend:false (uw disp_state.canvas); bind ~events:[`ButtonPress] ~extend:false (uw disp_state.canvas); restore_normal_bindings (); disp_state.paused#set pause_state; velocity#destroy; let body = add_new_body ~color:planet#color ~pos:planet#pos ~vpos:velocity#vpos ~r:planet#radius in add_dbody_from_tag body planet#tag in let old_pause_state = disp_state.paused#v in let planet = new new_planet () in planet#set_radius (planet_radius rad_int); planet#draw pos; disp_state.paused#set true; bind ~events:[`Motion] ~extend:false ~fields:[ `MouseX; `MouseY] ~action:(move_planet planet) (uw disp_state.canvas); bind_class ~events:[`KeyPress] ~extend:false ~fields:[ `Char; `KeySymString ] ~action:(set_radius planet) app_class; bind ~events:[`ButtonPress] ~extend:false ~fields:[`MouseX; `MouseY] ~action:(set_place planet old_pause_state) (uw disp_state.canvas); bind ~events:[`ButtonRelease] ~extend:false ~fields:[] (uw disp_state.canvas) (***********************************************************) (***********************************************************) and keyhandlers = [ { key = Key "H"; description = (Lstrings.get `display_help ); handler = (fun e -> Help.create_window (uw disp_state.toplevel) (hlist_to_string keyhandlers)); }; { key = Key "a"; description = (Lstrings.get `add_planet ); handler = (fun e -> add_planet (e.ev_MouseX,e.ev_MouseY) 3); }; { key = KeyList ["plus";"equal";"KP_Add"]; description = (Lstrings.get `zoom_in ); handler = (fun e -> state.zoom#set (state.zoom#v *. 1.1); redraw_all_basic ()); }; { key = KeyList ["minus";"underscore"; "KP_Subtract"]; description = (Lstrings.get `zoom_out ); handler = (fun e -> state.zoom#set (state.zoom#v /. 1.1); redraw_all_basic ()); }; { key = Key "b"; description = (Lstrings.get `toggle_true_bounce); handler = (fun e -> truebounce#flip;) }; { key = KeyList ["c"; "space"]; description = (Lstrings.get `center); handler = (fun e -> disp_state.tracking#set false; Physics.zero_speed (); Physics.center (); clear_all_traces (); redraw_all_basic ()) }; { key = Key "k"; description = (Lstrings.get `option_dialog); handler = (fun e -> toggle_opt_dialog ()) }; { key = Key "o"; description = (Lstrings.get `change_all_colors); handler = (fun e -> change_all_body_colors (); redraw_all_basic ()); }; { key = KeyList [ "q" ; "Escape"] ; description = (Lstrings.get `quit); handler = (fun e -> exit 0); }; { key = Key "e" ; description = (Lstrings.get `reset); handler = (fun e -> clear_all_traces (); state.bodies <- []; redraw_all ()); }; { key = Key "s"; description = (Lstrings.get `save ); handler = (fun e -> let old_pause_state = disp_state.paused#v in disp_state.paused#set true; get_next_key ~f:(fun key -> clear_all_traces (); SaveState.write_state key; disp_state.paused#set old_pause_state )); }; { key = Key "l"; description = (Lstrings.get `load); handler = (fun e -> let old_pause_state = disp_state.paused#v in disp_state.paused#set true; get_next_key ~f:(fun key -> debug_msg "Starting to load universe"; clear_all_traces (); SaveState.read_state key; debug_msg (sprintf "Done loading: %d planets" (List.length state.bodies)); redraw_all (); debug_msg "Done redrawing"; disp_state.paused#set old_pause_state )); }; { key = Key "u"; description = (Lstrings.get `undo); handler = (fun e -> undo (); clear_all_traces (); redraw_all ()) }; { key = Key "g"; description = (Lstrings.get `goback); handler = (fun e -> goback (); clear_all_traces (); redraw_all ()) }; { key = Key "p"; description = (Lstrings.get `toggle_pause); handler = (fun e -> disp_state.paused#flip) }; { key = Key "t"; description = (Lstrings.get `toggle_trace); handler = (fun e -> disp_state.tracing#flip) }; { key = Key "d"; description = (Lstrings.get `double_trace); handler = (fun e -> transient.bound#set (min 300 (transient.bound#v * 2))); }; { key = Key "h"; description = (Lstrings.get `halve_trace ); handler = (fun e -> transient.bound#set (max 3 (transient.bound#v / 2)) ) }; { key = Key "j"; description = (Lstrings.get `place_random_orbital ); handler = (fun e -> orbital_planet (Random.int 2 = 1) ) }; { key = Key "J"; description = (Lstrings.get `place_random_orbital_uni ); handler = (fun e -> orbital_planet true) }; { key = Key "r"; description = (Lstrings.get `place_random ); handler = (fun e -> random_planet () ) }; { key = Key "x"; description = (Lstrings.get `cancel_com ); handler = (fun e -> disp_state.tracking#flip; ) }; (* Panning Around *) { key = KeySym "Up"; description = (Lstrings.get `pan_up); handler = (fun e -> let (x_s,y_s) = real_to_screen(state.center#v) in let y_s = y_s -. (float !screen_height)/.30.0 in let (x,y) = screen_to_real( pair_to_int (x_s,y_s) ) in state.center#set (x,y); redraw_all_basic ()); }; { key = KeySym "Down"; description = (Lstrings.get `pan_down); handler = (fun e -> let (x_s,y_s) = real_to_screen(state.center#v) in let y_s = y_s +. (float !screen_height)/.30.0 in let (x,y) = screen_to_real( pair_to_int (x_s,y_s) ) in state.center#set (x,y); redraw_all_basic () ); }; { key = KeySym "Left"; description = (Lstrings.get `pan_left); handler = (fun e -> let (x_s,y_s) = real_to_screen(state.center#v) in let x_s = x_s -. (float !screen_width)/.30.0 in let (x,y) = screen_to_real( pair_to_int (x_s,y_s) ) in state.center#set (x,y); redraw_all_basic () ); }; { key = KeySym "Right"; description = (Lstrings.get `pan_right); handler = (fun e -> let (x_s,y_s) = real_to_screen(state.center#v) in let x_s = x_s +. (float !screen_width)/.30.0 in let (x,y) = screen_to_real( pair_to_int (x_s,y_s) ) in state.center#set (x,y); redraw_all_basic () ); }; ] and kid_keyhandlers = [ { key = KeyList ["KP_Home"; "KP_Up"; "KP_Prior"; "KP_Left"; "KP_Begin"; "KP_Right"; "KP_End"; "KP_Down"; "KP_Next"; "KP_Insert"; "KP_Delete"; "KP_En`ter"; "KP_Add"; "KP_Multiply"; "KP_Divide"; "Num_Lock"; ]; description = (Lstrings.get `place_random ); handler = (fun e -> random_planet () ) }; { key = Key "="; description = (Lstrings.get `zoom_in ); handler = (fun e -> state.zoom#set (state.zoom#v *. 1.1); redraw_all_basic ()); }; { key = Key "-"; description = (Lstrings.get `zoom_out ); handler = (fun e -> state.zoom#set (state.zoom#v *. 0.9); redraw_all_basic ()); }; { key = KeySym "Up"; description = (Lstrings.get `pan_up); handler = (fun e -> let (x_s,y_s) = real_to_screen(state.center#v) in let y_s = y_s -. (float !screen_height)/.30.0 in let (x,y) = screen_to_real( pair_to_int (x_s,y_s) ) in state.center#set (x,y); redraw_all_basic ()); }; { key = KeySym "Down"; description = (Lstrings.get `pan_down); handler = (fun e -> let (x_s,y_s) = real_to_screen(state.center#v) in let y_s = y_s +. (float !screen_height)/.30.0 in let (x,y) = screen_to_real( pair_to_int (x_s,y_s) ) in state.center#set (x,y); redraw_all_basic () ); }; { key = KeySym "Left"; description = (Lstrings.get `pan_left); handler = (fun e -> let (x_s,y_s) = real_to_screen(state.center#v) in let x_s = x_s -. (float !screen_width)/.30.0 in let (x,y) = screen_to_real( pair_to_int (x_s,y_s) ) in state.center#set (x,y); redraw_all_basic () ); }; { key = KeySym "Right"; description = (Lstrings.get `pan_right); handler = (fun e -> let (x_s,y_s) = real_to_screen(state.center#v) in let x_s = x_s +. (float !screen_width)/.30.0 in let (x,y) = screen_to_real( pair_to_int (x_s,y_s) ) in state.center#set (x,y); redraw_all_basic () ); }; { key = KeySym "space"; description = (Lstrings.get `center); handler = (fun e -> disp_state.tracking#set false; Physics.zero_speed (); Physics.center (); clear_all_traces (); redraw_all_basic ()) }; { key = KeyList ["q";"w";"e";"a";"s";"d";"z";"x";"c"]; description = (Lstrings.get `change_all_colors); handler = (fun e -> change_all_body_colors (); redraw_all_basic ()); }; { key = KeyList ["1";"2";"3";"4";"5";"6";"7";"8";"9"]; description = (Lstrings.get `toggle_trace); handler = (fun e -> disp_state.tracing#flip) }; { key = KeySym "Escape"; description = (Lstrings.get `reset); handler = (fun e -> clear_all_traces (); state.bodies <- []; redraw_all ()); }; { key = Other; description = (Lstrings.get `place_random ); handler = (fun e -> orbital_planet (Random.int 2 = 0) ) }; ] and main_key_handler e = debug_msg "Key handler"; Focus.force (uw disp_state.toplevel); let key = e.ev_Char and keysym = e.ev_KeySymString in let rec loop handlers = match handlers with handler::tl -> if (match handler.key with Key hkey -> hkey = key | KeySym hkeysym -> hkeysym = keysym | KeyList hkeys -> List.mem keysym hkeys | Other -> true ) then ( debug_msg handler.description; handler.handler e; ) else loop tl | [] -> debug_msg ("Other Key: " ^ keysym) in if kidmode#v then loop kid_keyhandlers else loop keyhandlers and clear_key_handler () = bind_class ~events:[`KeyPress] app_class and set_normal_key_handler () = bind_class ~events:[`KeyPress] ~extend:false ~fields:[`Char;`MouseX;`MouseY;`KeySymString] ~action:main_key_handler app_class (* sets up all handlers that might be fiddled with *) and restore_normal_bindings () = set_select_planet_handler (); set_normal_key_handler (); bind ~events:[`ButtonRelease] (canvas ()); bind ~events:[`Motion] (canvas ()) (***************) let rec timer_cb () = let compute_timer = MTimer.create () in let full_timer = MTimer.create () in let _ = if not disp_state.paused#v then ( MTimer.start full_timer; update (); MTimer.start compute_timer; Physics.simulate ~bounce:truebounce#v iterations#v; compute_energy (); num_bodies#set (List.length state.bodies); MTimer.stop compute_timer; track_com (); update_traces (); (let old_debugging = !debugging in debugging := false; redraw_all (); debugging := old_debugging); MTimer.stop full_timer; (* let compute_time_ms = MTimer.read_ms compute_timer and full_time_ms = MTimer.read_ms full_timer in debug_msg (sprintf "compute: %f ms, other: %f ms" compute_time_ms (full_time_ms -. compute_time_ms)) *) ) in let time_left_ms = max 0 (int_of_float (float_of_int gap_ms#v -. MTimer.read_ms full_timer )) in let full_time_ms = MTimer.read_ms full_timer in Timer.set ~ms:time_left_ms ~callback:timer_cb let set_size e = debug_msg "Resizing"; let width, height = e.ev_Width, e.ev_Height in screen_center := float_of_int (width/2), float_of_int (height/2); screen_width := width; screen_height := height (******************************************************************) let grab () = Grab.set ~global:true (uw disp_state.toplevel) let ungrab () = Grab.release (uw disp_state.toplevel) (* Toggle the focus mode. This is the first step towards building a kid-friendly version *) let toggle_kidmode () = (* transient.bounce#set true; *) match Grab.status (uw disp_state.toplevel) with `None -> grab () | `Global | `Local -> ungrab () let _ = kidmode#register_callback (fun oldv newv -> toggle_kidmode ()) let init () = disp_state.toplevel <- Some (openTk ~clas:app_class ()); disp_state.frame <- Some (Frame.create ~width:!screen_width ~height:!screen_height (uw disp_state.toplevel)); disp_state.canvas <- Some (Canvas.create ~width:init_screen_width ~height:init_screen_height (uw disp_state.frame)); screen_center := pair_to_float (init_screen_height / 2, init_screen_width / 2); if SaveState.help_start then Help.create_window (uw disp_state.toplevel) (hlist_to_string keyhandlers); Canvas.configure ~background:bgcolor (canvas ()); Pack.configure ~expand:true ~fill:`Both [uw disp_state.frame]; Pack.configure ~expand:true ~fill:`Both [uw disp_state.canvas]; timer_cb (); restore_normal_bindings (); bind ~events:[`Configure] ~extend:false ~fields:[`Width; `Height] ~action:set_size (canvas ()); bind_class ~events:[`Modified ([`Control; `Shift], `KeyPressDetail "K")] ~extend:true ~action:(fun _ -> kidmode#flip) app_class; appname_set "Planets"; init_optionbox (); mainLoop () let license_notice = sprintf " Planets %s, Copyright (C) 2001-2003 Yaron M. Minsky Planets comes with ABSOLUTELY NO WARRANTY; This is free software, and you are welcome to redistribute it under the terms of the GNU GPL; see the COPYING file for details. " version let main () = print_string license_notice; print_newline (); Random.self_init (); state.delta#set 0.45; state.bodies <- []; init () let _ = if not !Sys.interactive then main () planets-0.1.13/fast_physics.ml0000644000076600007660000001260010636107402017535 0ustar yminskyyminsky00000000000000(* Planets: A celestial simulator Copyright (C) 2001-2003 Yaron M. Minsky 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open StdLabels open MoreLabels open Printf open State open Constants open Common (* Faster physics implementation that is array-based *) (* Only implements the act_all_on_all function. *) (* Another useful thing to implement faster would be collision detection *) (* all-float record, to let the compiler unbox in a loop *) type fbody = { mutable x_pos: float; mutable y_pos: float; mutable x_vel: float; mutable y_vel: float; fb_radius: float; fb_mass: float; } let cube x = x *. x *. x let square x = x *. x (* let sqrtcube x = sqrt (x *. x *. x) (* Faster but less flexible implementaqtion of sqrtcube *) *) let body_to_fbody body = let (x_pos,y_pos) = body.pos and (x_vel,y_vel) = body.velocity (*and (x_accel,y_accel) = match body.i with None -> (0.,0.) | Some accel -> accel *) in { x_pos = x_pos; y_pos = y_pos; fb_radius = body.radius; fb_mass = body.mass; x_vel = x_vel; y_vel = y_vel; } let build_fbody_array bodies = Array.of_list (List.map ~f:body_to_fbody bodies) (* convert a body and a b to an updated body *) let fbody_and_body_to_body body b = { body with velocity = (b.x_vel,b.y_vel); pos = (b.x_pos,b.y_pos); } (******** List iterator w/index ********) let rec list_iteri_rec ~f list i = match list with [] -> () | hd::tl -> f ~i hd; list_iteri_rec ~f tl (i+1) let list_iteri ~f list = list_iteri_rec ~f list 0 (**************************************************) let array_to_bodies bodies array = let b_list = Array.to_list array in List.map2 ~f:fbody_and_body_to_body bodies b_list (**********************************************************************) let timer = MTimer.create () let sqrtcube x = sqrt (x *. x *. x) let act_all_on_all_rk ~bounce bodies = let gexp = grav_exp#v in let exp = ((1.0 +. gexp)/.2.0) in let sqrtcube = if gexp = 2.0 then sqrtcube else (fun x -> x ** exp) in let const = gconst#v in (* t is the time. This function has no time dependence. s is the position is state space dsdt is the array of derivatives *) let deriv t s dsdt = (* initialize derivatives to 0 *) for i = 0 to Array.length dsdt - 1 do dsdt.(i) <- 0. done; for i = 0 to Array.length bodies - 1 do (* x and y pos derivative *) dsdt.(i*4) <- s.(i*4 + 2); dsdt.(i*4 + 1) <- s.(i*4 + 3); done; for i = 0 to Array.length bodies - 1 do for j = i+1 to Array.length bodies - 1 do (* compute i's action on j and vice-versa. That way you only need to * compute the force once. It's nearly twice as fast that way. *) let x_pos_i = s.(i*4) and y_pos_i = s.(i*4 + 1) in let x_pos_j = s.(j*4) and y_pos_j = s.(j*4 + 1) in let xdiff = x_pos_i -. x_pos_j and ydiff = y_pos_i -. y_pos_j in let dist_sq = xdiff *. xdiff +. ydiff *. ydiff in let mult = const /. sqrtcube dist_sq in let mult_i = -. mult *. bodies.(j).fb_mass and mult_j = mult *. bodies.(i).fb_mass in (* x vel derivative *) dsdt.(i*4 + 2) <- dsdt.(i*4 + 2) +. xdiff *. mult_i; dsdt.(j*4 + 2) <- dsdt.(j*4 + 2) +. xdiff *. mult_j; (* y vel derivative *) dsdt.(i*4 + 3) <- dsdt.(i*4 + 3) +. ydiff *. mult_i; dsdt.(j*4 + 3) <- dsdt.(j*4 + 3) +. ydiff *. mult_j; if bounce && (let total_radius = bodies.(j).fb_radius +. bodies.(i).fb_radius in dist_sq < total_radius *. total_radius ) then ( let total_radius = bodies.(j).fb_radius +. bodies.(i).fb_radius in let mult = -. mult *. bodies.(i).fb_mass *. bodies.(j).fb_mass *. (total_radius *. total_radius /. dist_sq) in let mult_i = -. mult /. bodies.(i).fb_mass and mult_j = mult /. bodies.(j).fb_mass in (* x vel derivative *) dsdt.(i*4 + 2) <- dsdt.(i*4 + 2) +. xdiff *. mult_i; dsdt.(j*4 + 2) <- dsdt.(j*4 + 2) +. xdiff *. mult_j; (* y vel derivative *) dsdt.(i*4 + 3) <- dsdt.(i*4 + 3) +. ydiff *. mult_i; dsdt.(j*4 + 3) <- dsdt.(j*4 + 3) +. ydiff *. mult_j; ) done done in let s = Array.init (4 * Array.length bodies) ~f:(fun i -> match i mod 4 with | 0 -> bodies.(i / 4).x_pos | 1 -> bodies.(i / 4).y_pos | 2 -> bodies.(i / 4).x_vel | _ -> bodies.(i / 4).y_vel ) in (* dumb_solver s state.delta#v deriv; *) Rk4.step s 0.0 state.delta#v s deriv; for i = 0 to Array.length bodies - 1 do bodies.(i).x_pos <- s.(4 * i); bodies.(i).y_pos <- s.(4 * i + 1); bodies.(i).x_vel <- s.(4 * i + 2); bodies.(i).y_vel <- s.(4 * i + 3); done let act_all_on_all ~bounce bodies = let array = build_fbody_array bodies in act_all_on_all_rk ~bounce array; array_to_bodies bodies array planets-0.1.13/fqueue.ml0000644000076600007660000000425310636107402016335 0ustar yminskyyminsky00000000000000(* Simple implementation of a polymorphic functional queue *) (* push and top are O(1). pop and take are O(1) amortized. to_list and length are O(n). *) (* Invariant: if queue is not empty, outlist is not empty queue.length = List.length(queue.outlist) + List.length(queue.inlist)*) exception Empty type 'a t = { inlist: 'a list; outlist: 'a list; length: int; } (*****************************************) (* let test_invariants queue = assert begin queue.length = (List.length queue.outlist) + (List.length queue.inlist) end; assert begin (queue.length = 0) || List.length queue.outlist > 0 end *) let empty = { inlist = []; outlist = []; length = 0; } (*****************************************) let push el queue = if queue.outlist = [] then let outlist = List.rev (el::queue.inlist) in { inlist = []; outlist = outlist; length = queue.length + 1; } else { inlist = el::queue.inlist; outlist = queue.outlist; length = queue.length + 1; } (*****************************************) let top queue = match queue.outlist with [] -> (if queue.inlist != [] then failwith "FQueue.top: BUG. inlist should be empty but isn't" else raise Empty) | hd::tl -> hd (*****************************************) let pop queue = match queue.outlist with hd::[] -> (hd, { inlist = []; outlist = (List.rev queue.inlist); length = queue.length - 1}) | hd::tl -> (hd, { inlist = queue.inlist; outlist = tl; length = queue.length - 1;}) | [] -> if queue.inlist = [] then raise Empty else (match List.rev queue.inlist with [] -> failwith "FQueue.top: BUG. inlist should not be empty here" | hd::tl -> (hd, { inlist=[]; outlist=tl; length = queue.length - 1; })) (*****************************************) let remove queue = let (el,new_q) = pop queue in new_q (*****************************************) let to_list queue = queue.inlist @ (List.rev (queue.outlist)) (*****************************************) let length queue = queue.length planets-0.1.13/help.ml0000644000076600007660000000430410636107402015770 0ustar yminskyyminsky00000000000000open Tk open Printf open Common let prologue = Lstrings.get `prologue class window toplevel text = object (self) val mutable widget = None val on_startup = Textvariable.create () method display ?(title=Lstrings.get `help) ?geometry () = match widget with None -> debug_msg "Creating help window from scratch"; let topwin = Toplevel.create toplevel in let frame1 = Frame.create topwin in let frame2 = Frame.create topwin in let frame3 = Frame.create topwin in let textw = Text.create frame1 in let vscrollbar = Scrollbar.create ~command:(Text.yview textw) ~orient:`Vertical frame1 in let hscrollbar = Scrollbar.create ~command:(Text.xview textw) ~orient:`Horizontal frame2 in let cbutton = Checkbutton.create ~text:(Lstrings.get `at_startup) ~variable:on_startup frame3 ~command:(fun () -> SaveState.set_help_start (Textvariable.get on_startup = "1")) in Text.insert ~index:(`Atxy (0,0),[]) ~text:(prologue ^ text) textw; Text.configure ~state:`Disabled ~wrap:`None ~width:65 ~yscrollcommand:(Scrollbar.set vscrollbar) ~xscrollcommand:(Scrollbar.set hscrollbar) textw; widget <- Some topwin; bind ~events:[`Destroy] ~action:(fun ev -> widget <- None) topwin; Pack.configure [frame1] ~side:`Top ~fill:`Both ~expand:true; Pack.configure [frame2] ~fill:`X ~side:`Top; Pack.configure [frame3] ~fill:`X ~side:`Top; Pack.configure [textw] ~side:`Left ~fill:`Both ~expand:true; Pack.configure [vscrollbar] ~side:`Right ~fill:`Y; Pack.configure [hscrollbar] ~fill:`X; Pack.configure [cbutton]; Wm.title_set topwin title; (match geometry with None -> () | Some geometry -> Wm.geometry_set topwin geometry) | Some widget -> debug_msg "Raising help window"; Tk.raise_window widget initializer if SaveState.help_start then Textvariable.set on_startup "1" else Textvariable.set on_startup "0" end let help_window = ref None let create_window toplevel text = let window = (match !help_window with None -> let win = new window toplevel text in help_window := Some win; win | Some win -> win) in window#display ~geometry:"+0+0" () planets-0.1.13/lstrings.ml0000644000076600007660000001311110636107402016701 0ustar yminskyyminsky00000000000000(* Planets: A simple 2-d celestial simulator Copyright (C) 2001-2003 Yaron M. Minsky 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open StdLabels open MoreLabels (* Some ad-hoc localization *) let english word = match word with | `paused -> "Paused" | `tracing -> "Tracing" | `true_bounce -> "Bouncing (experimental)" | `trace_length -> "Trace Length" | `disp_period -> "Disp. Period (ms)" | `g -> "G" | `grav_exp -> "G exp." | `diam_mult -> "Average diameter" | `rand_vel_mult -> "Average velocity" | `log_k_energy -> "Log k energy" | `log_p_energy -> "Log p energy" | `log_energy -> "Log energy" | `num_planets -> "Number of planets" | `add_planet -> "Add Planet" | `zoom_in -> "Zoom In" | `zoom_out -> "Zoom Out" | `iter_display -> "iter/display" | `time_step -> "Time step" | `toggle_true_bounce -> "Toggle true bounce" | `toggle_bounce -> "Toggle bounce" | `center -> "Center" | `option_dialog -> "Display option dialog" | `change_all_colors -> "Change all colors" | `quit -> "Quit" | `reset -> "Reset to empty universe" | `save -> "Save Universe" | `load -> "Load Universe" | `undo -> "Undo (undoes last planet insertion)" | `goback -> "Go Back (goes back to last planet insertion)" | `toggle_pause -> "Toggle Pause" | `toggle_trace -> "Toggle Trace" | `double_trace -> "Double Trace Length" | `halve_trace -> "Halve Trace Length" | `place_random_orbital -> "Place random orbital planet" | `place_random_orbital_uni -> "Place random orbital planet (unidirectional)" | `place_random -> "Place random planet" | `cancel_com -> "Cancel C-O-M tracking" | `pan_up -> "Pan Up" | `pan_down -> "Pan Down" | `pan_left -> "Pan Left" | `pan_right -> "Pan Right" | `display_help -> "Display this help dialog" | `help -> "Help" | `dismiss -> "Dismiss" | `options -> "Options" | `at_startup -> "Display this screen at startup?" | `prologue -> "Welcome to Planets! Planets is a simple orbital planetary simulator. A short introduction to planets can be found at: http://planets.homedns.org/getting_started.html The following is a list of keybindings. Note that a summary of keybindings can be found in the KEYBINDINGS.txt file distributed with this program. " let danish word = match word with | `paused -> "Pause" | `tracing -> "Vis hale" | `true_bounce -> "Ægte stød" | `trace_length -> "Halelængde" | `disp_period -> "Opdateringstid (ms)" | `g -> "G (Tyngdeacceleration)" | `grav_exp -> "G exp." | `diam_mult -> "Diam. faktor" | `rand_vel_mult -> "Hastigheds-faktor" | `log_k_energy -> "Log k energi" | `log_p_energy -> "Log p energi" | `log_energy -> "Log energi" | `add_planet -> "Tilføj planet" | `zoom_in -> "Zoom ind" | `zoom_out -> "Zoom ud" | `iter_display -> "Trin/opdatering" | `time_step -> "Tidsintervaller" | `toggle_true_bounce -> "Ægte stød til/fra" | `toggle_bounce -> "Stød til/fra" | `center -> "Centrér" | `option_dialog -> "Vis dialogboksen indstillinger" | `change_all_colors -> "Ændr alle farver" | `quit -> "Afslut" | `reset -> "Genstart med tomt univers" | `save -> "Gem univers" | `load -> "Indlæs univers" | `undo -> "Fortryd (oprettelsen af sidste planet)" | `goback -> "Gå tilbage (til oprettelsen af sidste planet)" | `toggle_pause -> "Pause/kør" | `toggle_trace -> "Vis/skjul hale" | `double_trace -> "Fordobl halens længde" | `halve_trace -> "Halvér halens længde" | `place_random_orbital -> "Opret planet i tilfældig bane" | `place_random -> "Opret tilfældig planet" | `cancel_com -> "Afbryd sporing af massemidtpunkt" | `pan_up -> "Op" | `pan_down -> "Ned" | `pan_left -> "Venstre" | `pan_right -> "Højre" | `display_help -> "Vis denne hjælpeskærm" | `help -> "Hjælp" (* "Help" *) | `dismiss -> "Anvend" (* "Dismiss" *) | `options -> "Indstillinger" (* "Options" *) | `at_startup -> "Vis denne hjælpeskærm hver gang Planets starter?" (* "Display this screen at startup?" *) | `prologue -> "Velkommen til Planets! Planets er en simpel planetbanesimulator. Du kan finde en kort (engelsksproget) introduktion til Planets på: http://planets.homedns.org/getting_started.html Det følgende er en liste over tastaturgenveje (de er vigtige i dette program!). Bemærk at du kan finde en oversigt over genvejstasterne (en.) i filen KEYBINDINGS.txt som fulgte med dette program. " | _ -> raise Not_found let maxsub string ~pos ~len = let len = min len (String.length string - pos) in String.sub string ~pos ~len let rec list_find ~f list = match list with | [] -> raise Not_found | hd::tl -> match (try Some (f hd) with Not_found -> None) with Some x -> x | None -> list_find ~f tl let get_locale () = list_find ~f:Sys.getenv ["LC_ALL";"LC_MESSAGES";"LANG"] let get word = try ( match maxsub ~pos:0 ~len:2 (Sys.getenv "LANG") with | "en" -> english word | "da" -> danish word | _ -> english word ) with Not_found -> english word planets-0.1.13/mTimer.ml0000644000076600007660000000134610636107402016300 0ustar yminskyyminsky00000000000000type t = { mutable start_time : float; mutable stop_time : float; mutable running : bool; } let create () = { start_time = 0.0; stop_time = 0.0; running = false; } let start timer = if timer.running then failwith "Timer started twice in a row." else ( timer.start_time <- Unix.gettimeofday (); timer.running <- true ) let stop timer = if not timer.running then failwith "Timer stopped when not running." else ( timer.stop_time <- Unix.gettimeofday (); timer.running <- false ) let read timer = if timer.running then failwith "Timer read at wrong time" else timer.stop_time -. timer.start_time let read_ms timer = 1000.0 *. (read timer) let read_us timer = (1000.0 *. 1000.0) *. (read timer) planets-0.1.13/options.ml0000644000076600007660000003404710636107402016542 0ustar yminskyyminsky00000000000000open StdLabels open MoreLabels open Tk open Printf open Common exception Unimplemented (****************************************************************) (** Utility Functions ****************************************) (****************************************************************) let random_chr () = let rand = Random.int ((Char.code 'z') - (Char.code 'a')) in Char.chr ((Char.code 'a') + rand) let random_name length = let str = String.create length in for i = 0 to length -1 do str.[i] <- random_chr () done; str module StringMap = AugMap.Make( struct type t = string let compare = compare end) (*****************************************************************) (** Live Values ************************************************) (*****************************************************************) (* Values that have a list of callbacks that are called whenever the value * is updated. This is useful both for keeping the optionbox up to date, * and for doing whatever needs to be done to accomodate changing options. *) class ['a] live_value (init:'a) = object (self) val mutable name = None val mutable value = init val mutable callback_list = [] method set newval = value <- newval; List.iter ~f:(fun cb -> try cb value newval with exn -> debug_msg (match name with None -> (sprintf "live_value#set: Callback failed with exn <%s>" (Printexc.to_string exn)) | Some name -> (sprintf "live_value#set %s: Callback failed with exn <%s>" name (Printexc.to_string exn)))) callback_list method set_name newname = name <- Some newname method v = value method get () = value method register_callback cb = callback_list <- cb::callback_list end let named_live_value name init = let v = new live_value init in v#set_name name; v (****************************************************) class live_toggle init = object (self) inherit [bool] live_value init method flip = self#set (not value) end exception Option_exists of string (*********************************************************************) (*********************************************************************) (*********************************************************************) class type ['a] display_type = object method display : live:bool -> ('a Widget.widget -> unit) method tk_to_real : unit method name : string end (*********************************************************************) (* 'a is the data type, 'b is the widget type *) class virtual ['a,'b] option ?name ~text ~set:(set:'a->unit) ~get () = let name = (match name with None -> random_name 10 | Some name -> name ) in object (self) val mutable widget = None val tk_var = Textvariable.coerce name val name = name val text = (text : string) method virtual build_widget : live:bool -> 'b method display ~live parent = ignore (self#build_widget ~live parent); match widget with None -> failwith "option#display: widget unexpectedly missing" | Some widget -> Pack.configure ~anchor:`W [widget] method virtual get_tk : 'a method virtual set_tk : 'a -> unit method set_real v = set v method tk_to_real = set self#get_tk method real_to_tk = self#set_tk (get ()) method name = name method text = text method upcast = (self :> 'c display_type) end (*********************) class ['b] toggle_option ?name ~text ~set ~get () = object (self) inherit [bool,'b] option ?name ~text ~set ~get () method set_tk bool = Textvariable.set tk_var (if bool then "true" else "false") method get_tk = let string = Textvariable.get tk_var in if string = "true" then true else if string = "false" then false else failwith "toggle_option#get_tk: bad string value" method build_widget ~live parent = let new_widget = Checkbutton.create ~name ~text ~onvalue:"true" ~offvalue:"false" parent in (if live then Checkbutton.configure ~command:(fun () -> self#tk_to_real) new_widget); widget <- Some new_widget; self#real_to_tk; new_widget end (*********************) class ['b] int_scale_option ?name ~min ~max ~text ~set ~get () = object (self) inherit [int,'b] option ?name ~text ~set ~get () val min = min val max = max method min = min method max = max method get_tk = match widget with None -> failwith ("int_scale_option#get_tk called when " ^ "no widget exists") | Some widget -> if Winfo.exists widget then int_of_float (Scale.get widget) else failwith ("int_scale_option#get_tk called when " ^ "widget does not exist") method set_tk v = match widget with None -> () | Some widget -> if Winfo.exists widget then Scale.set widget (float_of_int v) method build_widget ~live parent = let new_widget = Scale.create ~name ~label:text ~orient:`Horizontal ~min ~max parent in widget <- Some new_widget; self#real_to_tk; (if live then Scale.configure ~command:(fun value -> self#set_real (int_of_float value)) new_widget); new_widget end (*******************************************************) class ['b] float_scale_option ?name ~min ~max ?(resolution=1.0) ~text ~set ~get () = object (self) inherit [float, 'b] option ?name ~text ~set ~get () val min = min val max = max method min = min method max = max method get_tk = match widget with None -> failwith ("float_scale_option#get_tk called when " ^ "no widget exists") | Some widget -> if Winfo.exists widget then Scale.get widget else failwith ("float_scale_option#get_tk called when " ^ "widget does not exist") method set_tk v = match widget with None -> () | Some widget -> if Winfo.exists widget then Scale.set widget v method build_widget ~live parent = let new_widget = Scale.create ~name ~resolution ~label:text ~orient:`Horizontal ~min ~max parent in widget <- Some new_widget; self#real_to_tk; (if live then Scale.configure ~command:(fun value -> self#set_real value) new_widget); new_widget end (*******************************************************) let string_of_float x = let string = string_of_float x in if string.[String.length string - 1] = '.' then string ^ "0" else string class ['b] float_entry_option ?name ?(mult=1.1) ~text ~set ~get () = object (self) inherit [float, 'b] option ?name ~text ~set ~get () val mutable entry = None method get_tk = match entry with None -> failwith ( "float_entry_option#get_tk called " ^ "when no widget exists" ) | Some entry -> let float = float_of_string (Entry.get entry) in let float = if float <= 0.0 then get () else float in let string_rep = string_of_float float in Entry.delete_range ~start:(`Num 0) ~stop:`End entry; Entry.insert entry ~index:(`Num 0) ~text:string_rep; float method set_tk v = match widget with None -> () | Some widget -> match entry with None -> failwith ("float_entry_option#set_tk" ^ " called when no widget exists") | Some entry -> if Winfo.exists entry then ( Entry.delete_range ~start:(`Num 0) ~stop:`End entry; Entry.insert entry ~index:(`Num 0) ~text:(string_of_float v) ) method build_widget ~live parent = let frame = Frame.create parent in let nentry = Entry.create ~width:6 frame in let label = Label.create ~text frame in let action ev = if ev.ev_KeySymString = "Return" then self#tk_to_real else if ev.ev_KeySymString = "Up" then let newval = (mult *. self#get_tk) in self#set_real newval; self#set_tk newval else if ev.ev_KeySymString = "Down" then let newval = (self#get_tk /. mult) in self#set_real newval; self#set_tk newval in if live then begin bind ~events:[`KeyPress] ~fields:[`KeySymString] ~action nentry; bind ~events:[`FocusOut] ~fields:[`KeySymString] ~action:(fun ev -> self#tk_to_real) nentry; end; Pack.configure ~side:`Left [nentry]; Pack.configure ~side:`Left [label]; widget <- Some frame; entry <- Some nentry; self#real_to_tk; frame end (*******************************************************) class ['b] float_entry_display ?name ~text ~set ~get () = object (self) inherit [float, 'b] option ?name ~text ~set ~get () val mutable display = None method get_tk = raise Unimplemented method set_tk v = match widget with None -> () | Some widget -> match display with None -> failwith ("float_entry_display#set_tk" ^ " called when no widget exists") | Some display -> if Winfo.exists display then Label.configure ~text:(sprintf "%8.4f" v) display method build_widget ~live parent = let frame = Frame.create parent in let label = Label.create ~text frame in let ndisplay = Label.create frame in Pack.configure ~side:`Left [label]; Pack.configure ~side:`Left [ndisplay]; widget <- Some frame; display <- Some ndisplay; self#real_to_tk; frame end (*******************************************************) class ['b] int_entry_display ?name ~text ~set ~get () = object (self) inherit [int, 'b] option ?name ~text ~set ~get () val mutable display = None method get_tk = raise Unimplemented method set_tk v = match widget with None -> () | Some widget -> match display with None -> failwith ("int_entry_option#set_tk" ^ " called when no widget exists") | Some display -> if Winfo.exists display then Label.configure ~text:(sprintf "%d" v) display method build_widget ~live parent = let frame = Frame.create parent in let label = Label.create ~text frame in let ndisplay = Label.create frame in Pack.configure ~side:`Left [label]; Pack.configure ~side:`Left [ndisplay]; widget <- Some frame; display <- Some ndisplay; self#real_to_tk; frame end (*******************************************************) class ['b] void_entry_display ?name ~text () = object (self) inherit [unit, 'b] option ?name ~text ~set:(fun x -> ()) ~get:(fun () -> ()) () method get_tk = raise Unimplemented method set_tk v = () method build_widget ~live parent = let frame = Frame.create parent in let label = Label.create ~text frame in Pack.configure ~side:`Left [label]; widget <- Some frame; frame end (*****************************************************************) (** Option Box ************************************************) (*****************************************************************) (***********************************************************) (* Some helper functions to simplify the optionbox class. * The reason they are here instead of being inside of optionbox * is that putting them outside allows for a greater degree * of polymorphism. *) (************************************************************) let add_option optionbox ?register_cb option = (match register_cb with None -> () | Some register -> register (fun oldval newval -> ignore (oldval = newval); option#set_tk newval)); optionbox#add_option option#upcast let add_option_live optionbox lvalue option = add_option optionbox ~register_cb:lvalue#register_callback option (****************************************************************) (****************************************************************) (****************************************************************) class ['a,'b] optionbox toplevel = object (self) val mutable widget = None val mutable display_map = StringMap.empty val mutable display_names = [] val mutable mapped = false val mutable live = true method set_liveness bool = live <- bool method add_option (option : 'a display_type) = if StringMap.has_key option#name display_map then raise (Option_exists option#name) else ( display_map <- StringMap.add ~key:option#name ~data:option display_map; display_names <- option#name::display_names; ) (*************************************************************) (* private toggle methods *) (* Called when OK button is pressed to commit all toggles. Not useful in live option dialog. *) method private read_options = StringMap.iter ~f:(fun ~key ~data:display -> try display#tk_to_real with Unimplemented -> () ) display_map method destroy = match widget with None -> failwith "Attempt to destroy non-existant widget" | Some widget -> destroy widget method private display frame live = List.iter ~f:(fun name -> try let display = StringMap.find name display_map in display#display ~live frame; with Not_found -> failwith ("Options.display_from_map: BUG." ^ " name not found in map.")) (List.rev display_names) method mapped = mapped method create_dialog ?(title=Lstrings.get `options) ?geometry ?(clas="Option") ?(transient:'b) () = if not mapped then begin mapped <- true; let topwin = Toplevel.create ~takefocus:true ~clas ~name:"options" toplevel in let frame = Frame.create ~name:"options" topwin in let buttons = if not live then let cancel_button = Button.create ~text:"Cancel" ~command:(fun () -> destroy topwin) frame and ok_button = Button.create ~text:"Ok" ~command:(fun () -> self#read_options; destroy topwin) frame in [cancel_button; ok_button] else let dismiss_button = Button.create ~text:(Lstrings.get `dismiss) ~command:(fun () -> self#read_options; destroy topwin) frame in [dismiss_button] in widget <- Some topwin; bind ~events:[`Destroy] ~action:(fun ev -> mapped <- false) frame; Pack.configure [frame]; self#display frame live; Pack.configure ~side:`Left buttons; (match transient with None -> () | Some master -> Wm.transient_set topwin ~master); (match geometry with None -> () | Some geometry -> Wm.geometry_set topwin geometry); Wm.title_set topwin title end else debug_msg "Attempt to map already-mapped option dialog" end planets-0.1.13/physics.ml0000644000076600007660000001647510636107402016536 0ustar yminskyyminsky00000000000000(* Planets: A celestial simulator Copyright (C) 2001-2003 Yaron M. Minsky 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open StdLabels open MoreLabels open Printf open State open Constants open Common (*******************************************************) (*** Physics *****************************************) (*******************************************************) let cube x = x *. x *. x let square x = x *. x let magsq (x,y) = x*.x +. y*.y let mag (x,y) = sqrt (x*.x +. y*.y) let distsq v1 v2 = magsq (v1 <-> v2) let dist v1 v2 = mag (v1 <-> v2) (* return unit vector pointing from (x1,y1) to (x2,y2) *) let unit_vect v1 v2 = dist v1 v2 <|> (v2 <-> v1) let update_pos body = { body with pos = body.pos <+> (state.delta#v <*> body.velocity) } let update_pos_bodies bodies = List.map ~f:update_pos bodies let print_body body = let (x,y) = body.pos and (x_v,y_v) = body.velocity in printf "pos: (%3f,%3f), vel: (%3f,%3f) " x y x_v y_v let print_bodies bodies = List.iter ~f:print_body bodies (***********************************************) (** Energy Calculations **********************) (***********************************************) let rec pairfold ~f list ~init = match list with [] -> init | hd::tl -> let init = List.fold_left ~f:(fun partial el -> f partial hd el) ~init tl in pairfold ~f tl ~init (* How to compute potential: sum of pair energy for all pairs (don't do pairs twice), where pair energy is G m_1 * m_2 / d Only works with grav_exp = 2.0 *) let pair_energy b1 b2 = let dist = mag (b1.pos <-> b2.pos) in -. gconst#v *. b1.mass *. b2.mass /. dist (* returns potential energy *) let penergy bodies = pairfold ~f:(fun e b1 b2 -> e +. pair_energy b1 b2) ~init:0. bodies (* returns kinetic energy *) let kenergy bodies = List.fold_left ~f:(fun e b -> e +. 0.5 *. b.mass *. magsq b.velocity) ~init:0. bodies let energy bodies = (* penergy bodies +. *) kenergy bodies (***********************************************) (***********************************************) (***********************************************) let center_of_mass bodies = match bodies with [] -> (0.0,0.0) | _ -> let mpositions = List.map ~f:(fun body -> body.mass <*> body.pos) bodies and masses = List.map ~f:(fun body -> body.mass) bodies in (sum masses <|> vsum mpositions) let central_velocity bodies = match bodies with [] -> (0.0,0.0) | _ -> let momenta = List.map ~f:(fun body -> body.mass <*> body.velocity) bodies and masses = List.map ~f:(fun body -> body.mass) bodies in (sum masses <|> vsum momenta) (***********************************************) let orbital_velocity bodies ~pos dir = (* first compute some global facts about the system *) let com = center_of_mass bodies and masses = List.map ~f:(fun body -> body.mass) bodies and cv = central_velocity bodies in let mass = sum masses in (* now we compute the orbital speed *) let radius_vect = com -| pos in let r = sqrt (dot radius_vect radius_vect) in let speed = sqrt(gconst#v *. mass /. r) in let uvect = r /| radius_vect in let uvect = if dir then rotleft uvect else rotright uvect in (speed *| uvect) +| cv let induced_orbital_velocity bodies ~pos dir = if List.length bodies = 0 then (0.0,0.0) else let cv = central_velocity bodies in let induced_accel_list = List.map ~f:(fun body -> let dvect = body.pos -| pos in let d = mag dvect in let uvect = d /| dvect in (body.mass /. (d *. d)) *| uvect ) bodies in let induced_accel = List.fold_left ~f:( +| ) induced_accel_list ~init:vzero in let total_mass = sum (List.map ~f:(fun body -> body.mass) bodies) in let implied_dist = sqrt (total_mass /. mag induced_accel) in let implied_uvect = mag induced_accel /| induced_accel in let speed = sqrt (gconst#v *. total_mass /. implied_dist) in let uvect = (if dir then rotleft implied_uvect else rotright implied_uvect) in (speed *| uvect) +| cv (***********************************************) let sub_velocity vel body = { body with velocity = body.velocity <-> vel; } let zero_speed_bodies selected_bodies = let velocity = central_velocity selected_bodies in state.bodies <- List.map ~f:(sub_velocity velocity) state.bodies let center_bodies selected_bodies = let center = center_of_mass selected_bodies in state.center#set center (***********************************************) let zero_speed () = zero_speed_bodies state.bodies let center () = center_bodies state.bodies let bodies_from_ids ids = List.filter ~f:(fun body -> List.mem body.id ids) state.bodies let zero_speeds_ids ids = zero_speed_bodies (bodies_from_ids ids) let center_ids ids = center_bodies (bodies_from_ids ids) (************************************************************************) (** Collision Detection ********************************************) (************************************************************************) let touch ~mult b1 b2 = let mdist = max b1.radius b2.radius in distsq b1.pos b2.pos < mdist *. mdist *. mult *. mult let join_bodies b1 b2 = { pos = center_of_mass [b1; b2]; velocity = (b1.mass +. b2.mass) <|> ((b1.mass <*> b1.velocity) <+> (b2.mass <*> b2.velocity)); radius = ((b1.radius ** 3.0) +. (b2.radius ** 3.0))**(1.0/.3.0); color = join_colors b1.color b1.mass b2.color b2.mass; mass = b1.mass +. b2.mass; id = Random.bits (); i = None; } let find_single_collision ~mult b1 bodies = let rec loop b1 bodies examined = match bodies with [] -> b1::examined | b2::tl -> if touch ~mult b1 b2 then loop (join_bodies b1 b2) tl examined else loop b1 tl (b2::examined) in loop b1 bodies [] (* look for a collision. If you find it, return a body list with those two bodies joined. Otherwise, return the original unchanged *) let rec find_collisions ~mult bodies = match bodies with [] -> [] | b1::tl -> (find_single_collision ~mult b1 (find_collisions ~mult tl)) (************************************************************************) (** Simulation ******************************************************) (************************************************************************) let compose f g x = f (g x) let compose3 f g h x = f (g (h x)) let ident x = x let rec apply n f x = match n with 0 -> x | _ -> apply (n-1) f (f x) let simulate ?(bounce=false) i = let action = compose (Fast_physics.act_all_on_all ~bounce) (find_collisions ~mult:(if bounce then 0.5 else 1.0)) in state.bodies <- apply i action state.bodies planets-0.1.13/rk4.ml0000644000076600007660000000322010636107402015534 0ustar yminskyyminsky00000000000000let dydx = ref (Array.make 0 0.) let dym = ref (Array.make 0 0.) let dyt = ref (Array.make 0 0.) let yt = ref (Array.make 0 0.) let make_static_arrays dims = begin dydx := Array.make dims 0. ; dym := Array.make dims 0. ; dyt := Array.make dims 0. ; yt := Array.make dims 0. ; end let dims = ref 0 (** Given values for the variables y[1..n] and their derivatives dydx[1..n] known at x, use the fourth-order Runge-Kutta method to advance the solution over an interval h and return the incremented variables as yout[1..n], which need not be a distinct array from y. The user supplies the routine derivs(x,y,dydx), which returns derivatives dydx at x. *) let step ~y ~x ~h ~yout ~derivs = (* We store the static arrays used by the routine globally, so they don't get reallocated each call. The dimensions of the problem are not likely to change between calls... We save 3 Array.make-s at the expense of a dereference and a compare. *) let n = Array.length y in let hh = h *. 0.5 and h6 = h /. 6.0 in let xh = x +. hh in let _ = (if n <> !dims then (dims:=n;make_static_arrays n)) in let dydx = !dydx and dym = !dym and dyt = !dyt and yt = !yt in derivs x y dydx ; for i = 0 to n-1 do yt.(i) <- y.(i) +. hh *. dydx.(i) done ; derivs xh yt dyt ; for i = 0 to n-1 do yt.(i) <- y.(i) +. hh *. dyt.(i) done ; derivs xh yt dym ; for i = 0 to n-1 do yt.(i) <- y.(i) +. h *. dym.(i) ; dym.(i) <- dym.(i) +. dyt.(i) done ; derivs (x +. h) yt dyt ; for i = 0 to n-1 do yout.(i) <- y.(i) +. h6 *. (dydx.(i) +. dyt.(i) +. 2.0 *. dym.(i)) done planets-0.1.13/saveState.ml0000644000076600007660000001753410636107402017010 0ustar yminskyyminsky00000000000000(* Planets: A simple 2-d celestial simulator Copyright (C) 2001-2003 Yaron M. Minsky 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open StdLabels open MoreLabels module Unix = UnixLabels open Printf open State open Genlex let major_version = 1 let minor_version = 0 let lexer = make_lexer ["("; ","; ")"; "["; "]"; "pos"; "velocity"; "radius"; "color"; "mass"; "id"; "zoom"; "center"; "delta"; "body"; "iterations" ; ] let rec parse_next list = parser | [< 'Kwd "zoom"; 'Float x; e = parse_next ((`Zoom x)::list) >] -> e | [< 'Kwd "center"; pair = parse_pair; e = parse_next ((`Center pair)::list) >] -> e | [< 'Kwd "delta"; 'Float x; e = parse_next ((`Delta x)::list) >] -> e | [< 'Kwd "iterations"; 'Int x; e = parse_next ((`Iter x)::list) >] -> e | [< 'Kwd "body"; e1 = parse_body ; e = parse_next (e1::list) >] -> e | [< >] -> list and parse_body = parser | [< 'Kwd "["; body = parse_bnext []; 'Kwd "]" >] -> body | [< body = parse_bnext [] >] -> body and parse_pair = parser [< 'Kwd "("; 'Float x; 'Kwd ","; 'Float y; 'Kwd ")" >] -> (x,y) and parse_bnext list = parser | [< 'Kwd "pos"; pair = parse_pair; e = parse_bnext ((`Pos pair)::list)>] -> e | [< 'Kwd "velocity"; pair = parse_pair; e = parse_bnext ((`Velocity pair)::list)>] -> e | [< 'Kwd "radius"; 'Float x; e = parse_bnext ((`Radius x)::list)>] -> e | [< 'Kwd "color"; 'String x; e = parse_bnext ((`Color x)::list)>] -> e | [< 'Kwd "mass"; 'Float x; e = parse_bnext ((`Mass x)::list)>] -> e | [< 'Kwd "id"; 'Int x; e = parse_bnext ((`Id x)::list)>] -> e | [< >] -> `Body list (* Converting a state description to a state *) exception Wrong_type exception Missing of string let all_matches ~f list = let rec all_matches ~partial list = match list with [] -> partial | hd::tl -> try all_matches ~partial:((f hd)::partial) tl with Wrong_type -> all_matches ~partial tl in all_matches ~partial:[] list (* get first match. If none available, then raise (Missing name) error *) let rec first_match ~f ~name list = match list with [] -> raise (Missing name) | hd::tl -> try f hd with Wrong_type -> first_match ~f ~name tl (* get first match. If no match available, then return default. *) let rec first_match_default ~f ~name ~default list = match list with [] -> default | hd::tl -> try f hd with Wrong_type -> first_match_default ~f ~name ~default tl let build_body bdesc = try { pos = first_match ~f:(function `Pos pos -> pos | _ -> raise Wrong_type) ~name:"pos" bdesc; velocity = first_match ~f:(function `Velocity velocity -> velocity | _ -> raise Wrong_type) ~name:"velocity" bdesc; radius = first_match ~f:(function `Radius radius -> radius | _ -> raise Wrong_type) ~name:"radius" bdesc; color = first_match ~f:(function `Color (color:string) -> `Color color | _ -> raise Wrong_type) ~name:"color" bdesc; mass = first_match ~f:(function `Mass mass -> mass | _ -> raise Wrong_type) ~name:"mass" bdesc; id = first_match ~f:(function `Id id -> id | _ -> raise Wrong_type) ~name:"id" bdesc; i = None } with Missing name -> raise (Missing (sprintf "body: %s" name)) let build_state sdesc = try { d_zoom = first_match ~f:(function `Zoom zoom -> zoom | _ -> raise Wrong_type) ~name:"zoom" sdesc; d_center = first_match_default ~f:(function `Center center -> center | _ -> raise Wrong_type) ~name:"center" ~default:(0.,0.) sdesc; d_delta = first_match ~f:(function `Delta delta -> delta | _ -> raise Wrong_type) ~name:"delta" sdesc; d_bodies = List.map ~f:build_body (all_matches ~f:(function `Body bodies -> bodies | _ -> raise Wrong_type) sdesc); } with Missing name -> failwith (sprintf "Field missing from state description: %s" name) (********************************************************************) (********************************************************************) (********************************************************************) let parse_state in_c = let token_stream = lexer (Stream.of_channel in_c) in build_state (parse_next [] token_stream) let string_of_float x = sprintf "%.20e" x let string_of_int x = sprintf "%d" x let string_of_pair pair = sprintf "(%s, %s)" (string_of_float (fst pair)) (string_of_float (snd pair)) let string_of_color color = match color with `Color string -> string | `Black -> "black" | `Blue -> "blue" | `Red -> "red" | `White -> "white" | `Green -> "green" | `Yellow -> "yellow" let write_body out_c body = let indent = " " in fprintf out_c "\nbody\n"; fprintf out_c "%spos %s\n" indent (string_of_pair body.pos); fprintf out_c "%svelocity %s\n" indent (string_of_pair body.velocity); fprintf out_c "%sradius %s\n" indent (string_of_float body.radius); fprintf out_c "%smass %s\n" indent (string_of_float body.mass); fprintf out_c "%scolor \"%s\"\n" indent (string_of_color body.color); fprintf out_c "%sid %s\n" indent (string_of_int body.id) let write_state out_c = fprintf out_c "zoom %s\n" (string_of_float state.zoom#v); fprintf out_c "center %s\n" (string_of_pair state.center#v); fprintf out_c "delta %s\n" (string_of_float state.delta#v); List.iter ~f:(write_body out_c) state.bodies; close_out out_c (* Some final details: choosing the save directory and the external interface *) let is_dir fname = let stats = Unix.stat fname in stats.Unix.st_kind = Unix.S_DIR let save_directory = try let home = Sys.getenv "HOME" in let pdir = Filename.concat home ".planets" in if Sys.file_exists pdir & is_dir pdir then pdir else (* PROBLEM: is 0x1FF really the right mode? *) try Unix.mkdir pdir 0x1FF; pdir with Unix.Unix_error (err,func,arg) -> "" with Not_found -> "" (******************************************************************) let write_state_file filename = write_state (open_out filename) let read_state_file filename = let dead_state = parse_state (open_in filename) in reanimate_dead_state dead_state let saved_fname key = "uni." ^ key let write_state key = let fname = Filename.concat save_directory (saved_fname key) in try write_state_file fname with Sys_error x -> Common.debug_msg (sprintf "%s: failed to load file %s" x fname) let read_state key = let fname = Filename.concat save_directory (saved_fname key) in try read_state_file fname with Sys_error x -> Common.debug_msg (sprintf "%s: failed to load file %s" x fname) (****************************************************************) let help_fname = Filename.concat save_directory ".nohelp" let help_start = not (Sys.file_exists help_fname) let set_help_start x = match x with true -> if Sys.file_exists help_fname then Sys.remove help_fname | false -> let file = open_out help_fname in close_out file planets-0.1.13/sqrt.ml0000755000076600007660000000613310636107402016036 0ustar yminskyyminsky00000000000000open Printf type fref = { mutable v: float } let iterations = try int_of_string(Sys.argv.(1)) with _ -> 10000 let x = { v = 1.0 } let y = { v = 1.0 } (* first sqrt *) let timer = MTimer.create () let _ = MTimer.start timer; for i = 0 to iterations - 1 do y.v <- y.v +. 1.0; x.v <- sqrt(y.v) done; MTimer.stop timer let _ = printf "Sqrt: %f us per iteration\n" (MTimer.read_us timer /. float iterations) (* Then exponent *) let _ = MTimer.start timer; for i = 0 to iterations - 1 do y.v <- y.v +. 1.0; x.v <- y.v**(0.51) done; MTimer.stop timer let _ = printf "Pow: %f us per iteration\n" (MTimer.read_us timer /. float iterations) (* Then exponent *) let _ = MTimer.start timer; for i = 0 to iterations - 1 do y.v <- y.v +. 1.0; x.v <- y.v*.y.v done; MTimer.stop timer let _ = printf "Sqr: %f us per iteration\n" (MTimer.read_us timer /. float iterations) let _ = MTimer.start timer; for i = 0 to iterations - 1 do y.v <- y.v +. 100.0; x.v <- min x.v y.v done; MTimer.stop timer let _ = printf "Min: %f us per iteration\n" (MTimer.read_us timer /. float iterations) let _ = MTimer.start timer; for i = 0 to iterations - 1 do y.v <- y.v +. 100.0; x.v <- if x.v < y.v then x.v else y.v done; MTimer.stop timer let _ = printf "FMin: %f us per iteration\n" (MTimer.read_us timer /. float iterations) let _ = let rec loop i partial = match i with 0 -> () | _ -> if i < partial then loop (i-1) i else loop (i-1) partial in MTimer.start timer; loop iterations (iterations/2); MTimer.stop timer let _ = printf "FMin: %f us per iteration\n" (MTimer.read_us timer /. float iterations) let _ = MTimer.start timer; for i = 0 to iterations - 1 do y.v <- y.v *. 1.000000001; done; MTimer.stop timer let _ = printf "Prod: %f us per iteration\n" (MTimer.read_us timer /. float iterations) let _ = MTimer.start timer; for i = 0 to iterations - 1 do y.v <- y.v +. 1.0; done; MTimer.stop timer let _ = printf "Plus: %f us per iteration\n" (MTimer.read_us timer /. float iterations) let x = ref 0 let _ = MTimer.start timer; for i = 0 to iterations - 1 do x := !x + i done; MTimer.stop timer let _ = printf "IPls: %f us per iteration\n" (MTimer.read_us timer /. float iterations) type interval = { low: float; high: float; } let intersect a b = { low = if a.low > b.low then a.low else b.low; high = if a.high < b.high then a.high else b.high; } let isempty i = i.low >= i.high let empty = { low = 1.; high = 0. } let int1 = { low = 0.0; high = 4.2;} let int2 = { low = 0.9; high = 3.4;} (* let intersect (alow,ahigh) (blow,bhigh) = (max alow blow),(min ahigh bhigh) let int1 = (0.0,4.2) let int2 = (0.9, 3.4) *) (* Then exponent *) let rec loop n partial = match n with 0 -> () | _ -> loop (n - 1) (intersect int1 partial) let _ = MTimer.start timer; loop iterations int2; MTimer.stop timer let _ = printf "Intr: %f us per iteration\n" (MTimer.read_us timer /. float iterations) planets-0.1.13/state.ml0000644000076600007660000002352510636107402016166 0ustar yminskyyminsky00000000000000(* Planets: A celestial simulator Copyright (C) 2001-2003 Yaron M. Minsky 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open StdLabels open Printf open Tk module IntMap = AugMap.Make(struct type t = int let compare = compare end) module IntSet = AugSet.Make(struct type t = int let compare = compare end) let trunc = int_of_float (* Basic types *) type body = { pos: float * float; velocity: float * float; radius: float; color: color; mass: float; id: int; i: (float * float) option; (* extra integration info. Will be used for Runge-Kutta info *) } type state = { zoom: float Options.live_value; center: (float * float) Options.live_value; delta: float Options.live_value; mutable bodies: body list; } type dead_state = { d_zoom: float; d_center: float * float; d_delta: float; d_bodies: body list; } let state = { zoom = new Options.live_value 1.0; center = new Options.live_value (0.0, 0.0); delta = new Options.live_value 5.0; bodies = []; } (***************************************************************************) (***************************************************************************) (***************************************************************************) (* Transient state. *) type trace_point = { t_pos: float * float; t_round: int; } type trace = { t_queue: trace_point Fqueue.t; t_color: color; } let empty_trace color = { t_queue = Fqueue.empty; t_color = color; } type transient = { mutable traces: trace IntMap.t; mutable trace_round: int; mutable com_trace: trace; bound: int Options.live_value; } let transient = { traces = IntMap.empty; com_trace = empty_trace `Black; trace_round = 0; bound = new Options.live_value 20; } (************************************************) (** Traces ************************************) (************************************************) let set_trace_bound = transient.bound#set let trace_inc () = transient.trace_round <- transient.trace_round + 1 let trace_push pos trace = { trace with t_queue = Fqueue.push { t_pos = pos; t_round = transient.trace_round; } trace.t_queue } let trace_to_list trace = let trace_queue = Fqueue.to_list trace.t_queue in List.map ~f:(fun trace_point -> trace_point.t_pos) trace_queue let rec trace_filt trace = try let oldest = Fqueue.top trace.t_queue in if transient.trace_round - oldest.t_round > transient.bound#v then trace_filt { trace with t_queue = Fqueue.remove trace.t_queue } else trace with Fqueue.Empty -> trace (*************************************************) (*************************************************) let add_to_trace body = let trace = try IntMap.find body.id transient.traces with Not_found -> empty_trace body.color in transient.traces <- IntMap.add ~key:body.id ~data:(trace_push body.pos trace) transient.traces let add_to_com_trace com = transient.com_trace <- trace_push com transient.com_trace let remove_empty_traces () = IntMap.fold ~f:(fun ~key:id ~data:trace map -> if Fqueue.length trace.t_queue = 0 then map else IntMap.add ~key:id ~data:trace map) transient.traces ~init:IntMap.empty let update_traces () = List.iter ~f:add_to_trace state.bodies; trace_inc (); transient.traces <- IntMap.map ~f:trace_filt transient.traces; transient.traces <- remove_empty_traces () (*************************************************) let clear_trace body = transient.traces <- IntMap.remove body.id transient.traces (*************************************************) let remove_traces ids = transient.traces <- List.fold_left ~f:(fun map id -> IntMap.remove id map) ~init:transient.traces ids let clear_all_traces () = transient.traces <- (IntMap.map ~f:(fun trace -> { trace with t_queue = Fqueue.empty}) transient.traces); transient.traces <- remove_empty_traces () (***************************************************************************) (***************************************************************************) (***************************************************************************) let screen_center = ref (0.0, 0.0) let screen_width = ref 500 let screen_height = ref 500 (***************************************************************************) (** Undo and Goback support **********************************************) (***************************************************************************) let reanimate_dead_state dstate = state.zoom#set dstate.d_zoom; state.center#set dstate.d_center; state.delta#set dstate.d_delta; state.bodies <- dstate.d_bodies let copy_state state = { d_zoom = state.zoom#v; d_center = state.center#v; d_delta = state.delta#v; d_bodies = state.bodies; } (* Two separate quees are kept, one for goback, one for undo *) let goback_states = ref [] let undo_states = ref [] (* calls to set_undo_point and set_goback_point should always be paired *) let set_undo_point () = undo_states := (copy_state state)::!undo_states let set_goback_point () = goback_states := (copy_state state)::!goback_states let undo () = match !undo_states with [] -> () | hd::tl -> reanimate_dead_state hd; undo_states := tl; match !goback_states with [] -> failwith "State.undo: BUG. laststates should not be empty" | hd::tl -> goback_states := tl let goback () = match !goback_states with [] -> () | s::tl -> reanimate_dead_state s (********************************************************) (********************************************************) (********************************************************) let vzero = (0.,0.) let add_vect (x1,y1) (x2,y2) = (x1 +. x2, y1 +. y2) let sub_vect (x1,y1) (x2,y2) = (x1 -. x2, y1 -. y2) let sc_mult scalar (x,y) = (scalar *. x, scalar *. y) let sc_div scalar (x,y) = (x /. scalar, y /. scalar) (* Define the following as infix operators, to make it easier to read *) let ( <*> ) scalar vect = sc_mult scalar vect (* scalar mult *) let ( <|> ) scalar vect = sc_div scalar vect (* scalar division *) let ( <+> ) v1 v2 = add_vect v1 v2 (* vector addition *) let ( <-> ) v1 v2 = sub_vect v1 v2 (* vector addition *) let ( <.> ) (x1,y1) (x2,y2) = x1 *. x2 +. y1 *. y2 (* dot product *) let ( *| ) scalar vect = sc_mult scalar vect (* scalar mult *) let ( /| ) scalar vect = sc_div scalar vect (* scalar division *) let ( +| ) v1 v2 = add_vect v1 v2 (* vector addition *) let ( -| ) v1 v2 = sub_vect v1 v2 (* vector addition *) let dot (x1,y1) (x2,y2) = x1 *. x2 +. y1 *. y2 (* dot product *) let rotright (x1,y1) = (-.y1,x1) let rotleft (x1,y1) = (y1,-.x1) let print_vect (x,y) = printf "(%3f, %3f)" x y let vsum vectors = let rec loop vectors sum = match vectors with [] -> sum | v::tl -> loop tl (sum <+> v) in loop vectors (0.0,0.0) let sum nums = let rec loop nums sum = match nums with [] -> sum | n::tl -> loop tl (sum +. n) in loop nums 0.0 (***********************************************) (***********************************************) (***********************************************) let pair_to_float (x,y) = (float_of_int x, float_of_int y) let pair_to_int (x,y) = (int_of_float x, int_of_float y) (* Simple graphics primitves *) let screen_to_real_float pos = state.center#v <+> (state.zoom#v <|> (pos <-> !screen_center)) let screen_to_real pos = screen_to_real_float (pair_to_float pos) let real_to_screen pos = (state.zoom#v <*> (pos <-> state.center#v)) <+> !screen_center (****************) let wavg x1 w1 x2 w2 = ((x1 *. w1) +. (x2 *. w2)) /. (w1 +. w2) let round f = truncate (floor (f +. 0.5)) let wavgi x1 w1 x2 w2 = round (wavg (float_of_int x1) w1 (float_of_int x2) w2) let rgb r g b = `Color (sprintf "#%02X%02X%02X" r g b) let decompose_cint cint = let r = (0xFF0000 land cint) lsr 16 and g = (0x00FF00 land cint) lsr 8 and b = (0x0000FF land cint) lsr 0 in (r,g,b) let decompose_color color = let cint = match color with `Color cstr -> int_of_string ("0x" ^ (String.sub cstr ~pos:1 ~len:6)) | `Black -> 0x00000 | `White -> 0xFFFFFF | `Red -> 0xFF0000 | `Green -> 0x00FF00 | `Blue -> 0x0000FF | `Yellow -> 0xFFFF00 in decompose_cint cint let join_colors c1 w1 c2 w2 = let (r1,g1,b1) = decompose_color c1 and (r2,g2,b2) = decompose_color c2 in let (r,g,b) = (wavgi r1 w1 r2 w2, wavgi g1 w1 g2 w2, wavgi b1 w1 b2 w2) in rgb r g b (*********************************************************************) let delete_body_by_id id = set_undo_point (); state.bodies <- List.filter ~f:(fun body -> body.id <> id) state.bodies; set_goback_point () (*********************************************************************) let print_body body = print_string "pos: "; print_vect body.pos; print_string " "; print_string "vel: "; print_vect body.velocity; print_string "rad: "; printf "%5f" body.radius; print_newline () let rmult () = Random.float 2.0 -. 1.0 planets-0.1.13/test.ml0000644000076600007660000000054010636107402016015 0ustar yminskyyminsky00000000000000open Tk open Printf let toplevel = openTk ~clas:"Options" () let entry = Entry.create toplevel let action ev = if ev.ev_KeySymString = "Return" then begin printf "%s" (Entry.get entry); print_newline () end let _ = bind ~events:[`KeyPress] ~fields:[`KeySymString] ~action entry; Pack.configure [entry]; mainLoop () planets-0.1.13/fqueue.mli0000644000076600007660000000046010636107402016502 0ustar yminskyyminsky00000000000000(* push and top are O(1). pop and take are O(1) amortized. to_list and length are O(n). *) exception Empty type 'a t val empty : 'a t val push : 'a -> 'a t -> 'a t val top : 'a t -> 'a val pop : 'a t -> 'a * 'a t val remove : 'a t -> 'a t val to_list : 'a t -> 'a list val length : 'a t -> int planets-0.1.13/rk4.mli0000644000076600007660000000022510636107402015707 0ustar yminskyyminsky00000000000000val step : y: float array -> x: float -> h: float -> yout: float array -> derivs: (float -> float array -> float array -> unit) -> unit planets-0.1.13/saveState.mli0000644000076600007660000000033610636107402017151 0ustar yminskyyminsky00000000000000val write_state : string -> unit (** Writes state to file specified by string *) val read_state : string -> unit (** Reads state from file specified by string *) val help_start : bool val set_help_start : bool -> unit