--- /dev/null
+<?xml version="1.0" encoding="UTF-8"?>
+<classpath>
+ <classpathentry kind="con" path="org.eclipse.jdt.launching.JRE_CONTAINER"/>
+ <classpathentry kind="output" path="bin"/>
+</classpath>
--- /dev/null
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+ <name>fifth</name>
+ <comment></comment>
+ <projects>
+ </projects>
+ <buildSpec>
+ <buildCommand>
+ <name>org.eclipse.jdt.core.javabuilder</name>
+ <arguments>
+ </arguments>
+ </buildCommand>
+ </buildSpec>
+ <natures>
+ <nature>org.eclipse.jdt.core.javanature</nature>
+ </natures>
+</projectDescription>
--- /dev/null
+
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU 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.
+\f
+ 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.)
+\f
+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.
+\f
+ 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.
+\f
+ 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
+\f
+ 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 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.
--- /dev/null
+.( loading editor ) update\r
+.( done )\r
+.( ETh - for text editor help )\r
+\r
+var handletxt\r
+var handlebuf\r
+Dstralloc const editfile\r
+var shiftx var shifty\r
+var curlocx var curlocy\r
+Dstr \listF\TXT_ET" tmphelpfile\r
+\r
+: disppage ( -- )\r
+handletxt @\r
+dynp shifty @ 50 * +\r
+0 1 at!\r
+1270 type ;\r
+\r
+: fclose ( close opened file )\r
+handletxt @ dup if dynde handletxt off else drop then ;\r
+\r
+: ETnewpage fclose 27100 dynal dup handletxt ! dynp\r
+FF swap 27100 cfill ;\r
+\r
+var tmp1\r
+: fopen ( strhand -- )\r
+fclose\r
+dup editfile Dstr2Dstr fsDloadnew dup push dynp ( addrinp R: handinp )\r
+27100 dynal dup handletxt ! dynp ( addrinp addrout R: handinp )\r
+FF over 27100 cfill\r
+tmp1 off\r
+i dyns do ( addrinp addrout )\r
+over c@ ( addrinp addrout c )\r
+dup FE = if\r
+ drop\r
+ 50 tmp1 @ - + tmp1 off\r
+else\r
+ dup FD = if\r
+ drop tmp1 @ tab ( addrinp addrout numspaces )\r
+ tmp1 @ over + tmp1 ! + 0\r
+ else\r
+ over c! 1+ 0\r
+ tmp1 @ 1+ tmp1 !\r
+ then\r
+ drop\r
+then\r
+swap 1+ swap\r
+loop 2drop\r
+pop dynde ; rh tmp1\r
+\r
+: dispchar ( x y -- )\r
+2dup\r
+swap shiftx @ -\r
+swap shifty @ - 1+\r
+at!\r
+50 * + handletxt @ dynp + c@ emit ;\r
+\r
+: dispcur curlocx @ curlocy @ dispchar ;\r
+\r
+: displine ( line )\r
+0 over shifty @ - 1+ at!\r
+50 * handletxt @ dynp + shiftx @ + 50 type ;\r
+\r
+: dispstatbar\r
+colneg\r
+0 0 at! 50 do space loop\r
+0 0 at! ." col:" curlocx @ .\r
+7 0 at! ." line:" curlocy @ .\r
+11 0 at! ." ascii:" curlocy @ 50 * curlocx @ + handletxt @ dynp + c@ .\r
+1B 0 at! ." file:" editfile Dstr.\r
+49 0 at! ." F1-help"\r
+colnorm ;\r
+\r
+: charins ( char x y )\r
+50 * handletxt @ dynp + ( char x addr )\r
+over push\r
++ dup dup 1+ 4F pop - cmove ( char addr )\r
+c! ;\r
+\r
+: charcut ( x y -- char )\r
+over push\r
+50 * handletxt @ dynp + +\r
+dup c@ swap ( char addr )\r
+dup dup 1+ swap ( char addr addr+1 addr )\r
+4F pop - dup push cmove ( char addr )\r
+pop + FF swap c! ;\r
+\r
+: lineins ( line )\r
+50 * dup push handletxt @ dynp + ( addr )\r
+dup dup 50 + handletxt @ dyns 50 - pop - cmove ( addr )\r
+FF swap 50 cfill ;\r
+\r
+: linecut ( line )\r
+50 * dup push handletxt @ dynp + ( addr )\r
+dup 50 + swap handletxt @ dyns 50 - pop - cmove ;\r
+\r
+: screenaim\r
+0 curlocy @ 1E - 794 bound shifty !\r
+disppage ;\r
+\r
+var tmp1\r
+: length ( line -- length )\r
+50 * 4F + handletxt @ dynp + ( addr )\r
+51 do\r
+ i tmp1 !\r
+ dup c@ FF - if pop drop 0 push then\r
+ 1-\r
+loop\r
+drop\r
+tmp1 @ ; rh tmp1\r
+\r
+var tmp2 var tmp3\r
+: fsavechar ( char ) tmp2 @ swap over c! 1+ tmp2 ! ;\r
+: fsave ( -- )\r
+27200 dynal dup dynp tmp2 !\r
+0\r
+7CF do\r
+ i length if drop pop 1+ 0 push then\r
+loop\r
+0 swap for ( desthand )\r
+ tmp3 off\r
+ i 50 * handletxt @ dynp +\r
+ 0 i length for ( desthand srcaddr )\r
+ dup c@\r
+ i tab 8 = if tmp3 @ if FD fsavechar tmp3 off then then\r
+ dup FF = if\r
+ drop tmp3 @ 1+ tmp3 !\r
+ else\r
+ tmp3 @ do FF fsavechar loop tmp3 off\r
+ fsavechar\r
+ then\r
+ 1+\r
+ loop drop\r
+ FE fsavechar\r
+loop\r
+tmp2 @ over dynp - over dynresize\r
+dup editfile fsDsave\r
+dynde ; rh tmp2 rh tmp3\r
+\r
+str TXT_default" tmpdefault\r
+\r
+: ET\r
+handletxt @ if\r
+disppage\r
+until\r
+ colneg dispcur dispstatbar KBD_FW@ colnorm dispcur\r
+\r
+ dup 415 = if ( DEL )\r
+ curlocx @ curlocy @ charcut drop\r
+ curlocy @ displine\r
+ then\r
+\r
+ dup FC = if ( BACKSPACE )\r
+ curlocx @ if\r
+ curlocx @ 1- curlocy @ charcut drop\r
+ curlocy @ displine\r
+ drop 413\r
+ else\r
+ curlocy @ if\r
+ curlocy @ 1- dup length dup curlocx ! ( y-1 strlen )\r
+ swap 50 * handletxt @ dynp + ( strlen y1addr )\r
+ 2dup + swap 50 + ( strlen dest src )\r
+ swap rot 50 swap - cmove\r
+ curlocy @ linecut\r
+ drop 410\r
+ disppage\r
+ then\r
+ then\r
+ then\r
+\r
+ dup FD = if ( TAB )\r
+ curlocx @ tab\r
+ dup do FF curlocx @ curlocy @ charins loop\r
+ curlocx @ + curlocx !\r
+ curlocy @ displine\r
+ then\r
+\r
+ dup FE = if ( ENTER )\r
+ curlocy @ 7CF < if\r
+ curlocy @ 1+ lineins\r
+ curlocx @ 0\r
+ 50 curlocx @ - do\r
+ over curlocy @ charcut\r
+ over curlocy @ 1+ charins\r
+ 1+\r
+ loop 2drop\r
+ curlocx off\r
+ drop 412\r
+ disppage\r
+ then\r
+ then\r
+\r
+ dup 418 = if curlocy @ 3A - curlocy ! then ( PG-UP )\r
+ dup 419 = if curlocy @ 3A + curlocy ! then ( PG-DOWN )\r
+ dup 416 = if curlocx off then ( HOME )\r
+ dup 417 = if curlocy @ length curlocx ! then ( END )\r
+ dup 401 = if tmphelpfile fsdisp disppage then ( F1 )\r
+ dup 402 = if fsave then ( F2 )\r
+ dup 403 = if fclose drop 1B then ( F3 )\r
+ dup 400 = if done 0 0 at! screen cls drop -1 then ( ESC )\r
+\r
+ 0 over F0 bound? if -1 else 0 then ( NORMAL KEY )\r
+ over FF = if drop -1 then\r
+ if\r
+ curlocx @ curlocy @ charins\r
+ curlocy @ displine\r
+ 411\r
+ then\r
+\r
+ dup 411 = if curlocx @ 1+ curlocx ! then ( RIGHT )\r
+ dup 413 = if curlocx @ 1- curlocx ! then ( LEFT )\r
+ dup 412 = if curlocy @ 1+ curlocy ! then ( DOWN )\r
+ dup 410 = if curlocy @ 1- curlocy ! then ( UP )\r
+ drop\r
+\r
+ 0 curlocx @ 4F bound curlocx !\r
+ 0 curlocy @ 7CF bound curlocy !\r
+\r
+ curlocy @ shifty @ - 3B > if screenaim then\r
+\r
+ curlocy @ shifty @ - 3B - 0 = if\r
+ 0 0 8 screen scrollf\r
+ shifty @ 1+ shifty !\r
+ curlocy @ displine\r
+ then\r
+\r
+ curlocy @ shifty @ - -1 < if screenaim then\r
+\r
+ curlocy @ shifty @ - 1+ 0 = if\r
+ 0 0 -8 screen scrollf\r
+ shifty @ 1- shifty !\r
+ curlocy @ displine\r
+ then\r
+\r
+loop\r
+else\r
+ tmpdefault editfile str2Dstr\r
+ ETnewpage\r
+ ET\r
+then ;\r
+\r
+: ETl\r
+fopen\r
+curlocx off\r
+curlocy off\r
+shiftx off\r
+shifty off\r
+ET ;\r
+\r
+: ETs\r
+editfile Dstr2Dstr\r
+fsave ." saved " ;\r
+\r
+: ETh tmphelpfile fs. ;\r
+\r
+rh handletxt\r
+rh handlebuf\r
+rh editfile\r
+rh shiftx rh shifty\r
+rh curlocx rh curlocy\r
+rh tmphelpfile\r
+rh disppage\r
+rh fclose rh fopen\r
+rh dispchar rh dispcur\r
+rh displine rh dispstatbar\r
+rh charins rh charcut\r
+rh lineins rh linecut\r
+rh screenaim rh length\r
+rh fsavechar rh fsave\r
+rh ETnewpage rh tmpdefault\r
--- /dev/null
+ Compilation & misc\r
+ ------------------\r
+\r
+\r
+init module ( -- )\r
+ First module, control is passed to on startup. Contains\r
+ initialization routines. Also it is the last core module.\r
+ All new modules on top of it comes as result of executing\r
+ external source files.\r
+\r
+head <name> ( -- ) compiles new dictionary entry without specifying\r
+ new module type.\r
+ ex: head myentry\r
+\r
+: <name> ( -- ) creates new code module\r
+; ( -- ) ends module (immideate)\r
+ ex: : hello ." hi there" ;\r
+\r
+const <name> ( n -- ) defines new constant.\r
+ ex: 2147483647 const max\r
+\r
+:i <name> ( -- ) same as ":" but this module will be executed\r
+ immideately even in compile mode.\r
+ ex: :i ( 41 scan ;\r
+\r
+create <name> ( -- ) same as "head" , but specify module type as data.\r
+ ex: create LotoResults 5 , 13 , 52 , 12 , 11 , 3 ,\r
+\r
+allot ( n -- ) allocate n bytes in dictionary.\r
+ ex: create MyArray 100 allot\r
+\r
+" <string>" ( -- ) compile string and its size into core.\r
+ ex: create Mystring " This is it's contects"\r
+\r
+str <name> <string>" ( -- ) just shorter way for defining strings.\r
+ ex: str Mystring This is it's contenc"\r
+\r
+var <name> ( -- ) define new 32 bit variable.\r
+ ex: var result\r
+\r
+' <module> ( -- n ) return memory address of given entry.\r
+ ex: ' init\r
+\r
+forget <name> ( -- ) erases from RAM given entry and all entries what was\r
+ defined after it.\r
+ ex: forget myprog\r
+\r
+[ ( -- ) set interpret mode (immideate)\r
+] ( n -- ) set compile mode and compile top stack element\r
+ in as literal. Together [ .... ] cobination provides good\r
+ way to compute some values only once, at compile time,\r
+ rather than every time while program is running.\r
+ ex: : calculate - [ 4 MyConst1 + MyConst2 * ] ;\r
+\r
+defer <name> ( -- ) creates new module, with jump instruction.\r
+ Later address where to jump can be modified by "is" command.\r
+ This provides method of foward referencing. So you can use\r
+ modules what not jet exist.\r
+is ( address1 address2 -- ) address1 - where to jump, address2 -\r
+ address of module created by defer command.\r
+ ex: defer dispver\r
+ : run dispver ." running ..." ;\r
+ ... whatever ...\r
+ : (dispver ." Version 9.99 " ;\r
+ ' (dispver ' dispver is\r
+\r
+ Now if I type "run" on the screen appears:\r
+ Version 9.99 running ...\r
+\r
+asc <char> ( -- ) reads char ascii code and treats it as literal.\r
+ (immideate)\r
+ ex: : BreakLine 30 do asc - emit loop ;\r
+ same as:\r
+ : BreakLine 30 do 45 emit loop ;\r
+\r
+dyninc ( handle -- ) execute code in dynamic memory handle.\r
+ automatically deallocates it when done.\r
+\r
+include ( filenumber -- ) execute code in specified file.\r
+\r
+words ( -- ) display existing blocks in core.\r
+\r
+bye ( -- ) exit from Fifth\r
+\r
+fkey ( -- c )\r
+ Read one byte from input stream.\r
+\r
+sadd ( c addr -- )\r
+ Add one byte "c" to string located at "addr" and updates\r
+ string length.\r
+\r
+scan ( c -- )\r
+ Read input stream and store it to pad until it finds c .\r
+ It ignores all "c" bytes until it finds any non "c" byte.\r
+ in other words:\r
+ c is: "\r
+ input stream: """"This is test !"aoeu idh\r
+ result: This is test !\r
+\r
+ Is useful for breaking text lines into words.\r
+\r
+skey ( -- c )\r
+ So called safe "fkey". Reads data from input stream\r
+ but converts characters with ASCII codes: 9 13 10\r
+ to spaces.\r
+\r
+str=str? ( adr1 adr2 -- result )\r
+ Compares string at "adr1" with string at "adr2", returns\r
+ true flag if they are equal or false if they are not.\r
+ true = -1\r
+ false = 0\r
+\r
+find ( -- addr )\r
+ Searches whole dictionary for word in "pad". If found,\r
+ returns it address, if not, returns 0.\r
+\r
+execute ( -- )\r
+ Execute word located in "pad". Depending on "mode".\r
+\r
+dta ( addr -- DataAddr )\r
+ Calculates address of dictionary entry data area, from\r
+ entry point.\r
+\r
+2num ( -- num result )\r
+ Attempt to convert string located in "pad" into numeric\r
+ value. If succeed returns number and true as result.\r
+ If not, returns whatever and false as result.\r
+\r
+dadd ( addr length -- )\r
+ Add to dictionary data located at "addr", with specified\r
+ length.\r
+\r
+lit ( n -- )\r
+ Act with number depending on "mode". When interpreting,\r
+ leaves it in stack.\r
+\r
+\r
+incmod ( addr -- )\r
+ Add to dictionary data located at "addr"+1 , length is taken\r
+ from "addr".\r
+\r
+here ( -- n )\r
+ return "h" contents.\r
+\r
+mode var 8 bit\r
+ Holds input stream parser operation mode.\r
+ 0 = interpreting\r
+ 1 = compiling\r
+\r
+pad var 128 bytes\r
+ Holds temprorary strings.\r
+\r
+h var 32 bit\r
+ Pointer to free byte in memory, always at the end of the\r
+ dictionary. Each time when something is stored\r
+ by "c," command, pointer is incareased.\r
+\r
+lp var 32 bit\r
+ Pointer to last dictionary word. Each time when new word is\r
+ compiled or erased by "forget", this pointer is updated.\r
+\r
+modulechk ( Dstr<filename> -- ) check if module is loaded, if not\r
+ immideately load it.\r
+\r
+ne ( entrydata entrytype -- ) Compile new dictionary entry.\r
+ It's name must be in "pad".\r
--- /dev/null
+ Conditionals & loops\r
+ ------------------\r
+\r
+if ( flag -- ) (immideate)\r
+ "if 1.. else 2.. then" or\r
+ "if 1.. then" construction. Conditional execution.\r
+ Performs "1.." if "flag" was true,\r
+ elseway performs "2.." if exist. Execution continues after\r
+ word "then".\r
+ ex: 1 if ." nonzero" else ." zero" then\r
+\r
+>= ( n1 n2 -- result ) true if (n1 = n2) or (n1 > n2)\r
+ ex: 5 3 >= if ." first number is greater or equal" then\r
+\r
+<= ( n1 n2 -- result ) true if (n1 = n2) or (n1 < n2)\r
+= ( n1 n2 -- result ) true if n1 = n2\r
+\r
+do ( count -- ) (immideate)\r
+ "do .. loop" construction. Performs ".." "count" times.\r
+ In every step "count" is decareased until it is 0.\r
+ ex: : test 5 do i .d loop ;\r
+ result: 4 3 2 1 0\r
+\r
+doexit ( -- ) exit from "do .. loop"\r
+\r
+for ( count top -- ) (immideate)\r
+ "for .. loop" construction. Performs ".." (top - count) times.\r
+ In every step "count" is incareased until it reaches "top" .\r
+ ex: : test 4 10 for i .d loop ;\r
+ result: 4 5 6 7 8 9\r
+\r
+forexit ( -- ) exit from "for .. loop"\r
+\r
+until ( -- ) (immideate)\r
+ "until .. loop" construction. Performs ".." until flag become\r
+ true. False by default. Top of return stack holds flag.\r
+\r
+done ( -- ) exit from "until .. loop"\r
+\r
--- /dev/null
+ Disk & file access\r
+ ------------------\r
+\r
+diskload ( FromDisk ToMem amount -- )\r
+ Load specified abount of bytes from disk into memory.\r
+\r
+disksave ( FromMem ToDisk amount -- )\r
+ save specified abount of bytes from memory into disk.\r
+\r
+format ( -- ) Erase all files.\r
+\r
+fsDfilesize@ ( handle -- size )\r
+ Return size of opened file.\r
+\r
+fsDcurloc@ ( handle -- location )\r
+ Return current location in file.\r
+\r
+fsDupdated@ ( handle -- updated? )\r
+ Return true if file was updated,\r
+ ie. write operations occured.\r
+\r
+fssave ( FromMem DestFileHandle amount -- )\r
+ Save data to file.\r
+\r
+fsload ( SrcFileHandle ToMem amount -- )\r
+ Load data from file.\r
+\r
+fseof ( handle -- bytesLeft )\r
+ Return amount of bytes left till end of file.\r
+ Useful before read operation.\r
+\r
+fsls ( -- ) List all files and lists (directories,folders)\r
+ in current path.\r
+\r
+fslsr ( -- ) Same as "fsls" but recursively scans also sub lists.\r
+\r
+fscl ( DynStrHand -- )\r
+ Change list (path)\r
+\r
+fscreate ( DynStrHand -- DescPnt )\r
+ Create new file or list. Can create multiple lists at once.\r
+ ex: when creating:\r
+ "\listGAMES\listSTRATEGY\listSIMWORLD\5th-runme"\r
+ and only "\listGAMES\" already exist, then\r
+ "listSTRATEGY" and "listSIMWORLD" lists will be created,\r
+ and empty file "5th-runme" placed in there.\r
+\r
+fsDsave ( DynHand<data> DynStrHand<filename> -- )\r
+ Create new file and save all data from dynamic memory\r
+ block to it.\r
+\r
+fsDload ( DynStr<SrcFileName> DynHand<DataDest> -- )\r
+ Load whole file into dynamic memory block.\r
+\r
+fsDloadnew ( DynStr<SrcFileName> -- DynHand<DataDest> )\r
+ Load whole file into new dynamic memory block.\r
+\r
--- /dev/null
+ Dynamic memory\r
+ --------------\r
+\r
+\r
+dynal ( size -- handle )\r
+ Allocate dynamic memory block and return it's handle.\r
+\r
+dynde ( handle -- )\r
+ Deallocate dynamic memory block.\r
+\r
+dynp ( handle -- addr )\r
+ Returns pointer to memory where dynamic block\r
+ data begins.\r
+\r
+dyns ( handle -- size )\r
+ Returns size of dynamic block.\r
+\r
+dynresize ( NewSize handle -- )\r
+ Nondestructively resize dynamic block.\r
+\r
+dync@ ( addr handle )\r
+ Read one byte from dynamic block.\r
+\r
+dync! ( byte addr dynhandle )\r
+ Write one byte to dynamic block.\r
+\r
+dyn@ ( addr handle )\r
+ Read 32 bit number from dynamic block.\r
+ Address will spacify, whitch number, not byte.\r
+\r
+dyn! ( 32BitNum addr dynhandle )\r
+ Write 32 bit number to dynamic block.\r
+ Address will spacify, whitch number, not byte.\r
+\r
+dyncon ( size "name" -- )\r
+ Allocate dynamic block with specified size, and\r
+ create constant honding its handle.\r
+ ex: 100 dyncon MyNewBlock\r
+\r
+dyn. ( handle -- )\r
+ Write contenc of dynamic memory block to screen.\r
+\r
+\r
--- /dev/null
+ Graphic & text\r
+ --------------\r
+\r
+. ( n -- ) print number on screen\r
+\r
+d. ( n -- ) print number on screen in decimal\r
+\r
+? ( addr -- ) print 32 bit value located at addr.\r
+\r
+." <string>" ( -- ) print string into screen. Immideately\r
+ compiles.\r
+ ex: : greeting ." Hello, World" ;\r
+\r
+tab. ( -- ) print tabulator\r
+\r
+calccol ( b g r -- c ) calculate color what best matches given\r
+ Blue Green & Red values. Values must be in range 0 - 255.\r
+\r
+imgalloc ( xsize ysize -- imgbuf ) allocate image buffer for\r
+ specified size.\r
+\r
+imgsize ( imgbuf -- ) print on the screen X & Y size of image\r
+ buffer.\r
+\r
+point ( x y imgbuf -- addr ) returns memory address for specified\r
+ pixel.\r
+\r
+pset ( color x y imgbuf -- ) set graphic point\r
+\r
+boxf ( x1 x2 y1 y2 imgbuf color -- ) draw filled box\r
+\r
+cls ( imgbuf -- ) clear image buffer\r
+\r
+setpal ( b g r color -- ) set palette value for specified color.\r
+ values bust be in size 0 - 63.\r
+\r
+putchar ( char color x y imgbuf -- ) put graphic character in\r
+ imagebuffer to specified (x & y) location.\r
+\r
+scroll ( x y imgbuf -- ) scroll in imgbuf.\r
+\r
+scrollf ( color x y screen -- ) scroll and fill empty space with\r
+ given color.\r
+\r
+at! ( x y -- ) set cursor location\r
+curc! ( color -- ) set text color\r
+curb! ( solor -- ) set backround color\r
+\r
+colnorm ( -- ) set text color to normal\r
+colneg ( -- ) set text color to negative (selected)\r
+\r
+dyntype ( dynhandle -- ) display contenc of dynamic memory on screen\r
+fsdisp ( file -- ) clear screen, display file, and wait for key\r
+\r
+type ( addr length -- )\r
+ Types on the screen string, from memory at addr and\r
+ specified length.\r
+\r
+write ( addr -- )\r
+ Types on the screen string, from memory at "addr"+1\r
+ length is taken from "addr" .\r
+\r
+screen const 32 bit\r
+ Holds handle of screen buffer.\r
+\r
+copyscreen ( SrcImgHandle DestImgHandle -- ) copy contenc of source\r
+ image to destination image. Source and destination images\r
+ must have same size.\r
--- /dev/null
+<html><head><title>FIFTH</title></head>\r
+<body>\r
+<pre>\r
+\r
+ <h2>Fifth internal standard commands:</h2>\r
+\r
+\r
+<br><a href="math&mem.txt">Math & memory manipulation</a>\r
+<br><a href="dsk&file.txt">Disk & file access</a>\r
+<br><a href="conditio.txt">Conditionals and loops</a>\r
+<br><a href="graphic.txt">Graphic & text</a>\r
+<br><a href="dynmem.txt">Dynamic memory</a>\r
+<br><a href="string.txt">Dynamic & static strings</a>\r
+<br><a href="cmp&misc.txt">Compilation & miscellaneous</a>\r
+\r
+\r
+</pre>\r
+</body>\r
+</html>
\ No newline at end of file
--- /dev/null
+ Math, memory & stack manipulation\r
+ ---------------------------------\r
+\r
+\r
+off ( n -- ) writes 0 to given address, good for zeroing variable.\r
+ ex: MyVariable off\r
+on ( n -- ) writes -1 (true flag) to given address.\r
+ ex: MyVariable on\r
+\r
+2dup ( n1 n2 -- n1 n2 n1 n2 )\r
+2drop ( n1 n2 -- )\r
+nip ( n1 n2 -- n2 )\r
+neg ( n1 -- -n1 ) negotiate\r
+bit@ ( n bit -- result ) return specified bit from n.\r
+ ex: 38 2 bit@ (result will be 1)\r
+to32bit ( n1 n2 n3 n4 -- n32 ) treat 4 last stack elements as bytes\r
+ and unite them into 32 bit dword. Most significant byte\r
+ on top.\r
+ ex: 12 76 23 11 to32bit result: 186076172\r
+\r
+to8bit ( n32 -- n1 n2 n3 n4 ) break 32 bit number into 4 bytes.\r
+ Useful if you need to send 32 bit numbers thru 8 bit COM\r
+ port.\r
+ ex: 186076172 to8bit result: 12 76 23 11\r
+\r
+mod ( n1 n2 -- reminder ) divide n1 by n2 and returns reminder.\r
+ ex: 12 5 mod result: 2\r
+\r
+bound ( low n high -- n ) check if n is in given bounds,\r
+ if not then incarease/decarease it to match bounds.\r
+ ex: 5 80 15 bound result: 15\r
+ 5 10 15 bound result: 10\r
+ 5 -10 15 bound result: 5\r
+\r
+bound? ( low n high -- result ) returns true if n is in the\r
+ given bounds.\r
+\r
+tab ( col -- spaces) calculate amount of spaces to add\r
+ ta reach next tabulation from given column.\r
+\r
+count ( addr -- addr+1 n )\r
+ Useful for returning bytes from constantly incareasing\r
+ address. Module "type" is nice example.\r
+\r
+c, ( n -- )\r
+ store one byte at memory specified by "h". And incarease\r
+ "h" by 1.\r
+\r
+, ( n -- )\r
+ store 32 bit number at memory specified by "h". And\r
+ incarease "h" by 4.\r
+\r
+cmove ( addr1 addr2 n -- )\r
+ copy "n" amount of bytes from memory at "addr1" to memory\r
+ at "addr2".\r
+\r
+rnd ( limit -- result )\r
+ generates random number in range 0 to "limit"-1.\r
+\r
+abs ( n -- |n| )\r
+ returns absolute value of "n"\r
--- /dev/null
+ Dynamic & static strings \r
+ ------------------------\r
+\r
+Fifth supports both static and dynamic strings.\r
+Static strings must have predefined space reserved,\r
+and string mustn't exceed this length. They manipulation is\r
+faster. But they use more memory. Static string memory address is used\r
+to refer to the string.\r
+\r
+Dynamic strings can have at any time length form 0 to 0FFh,\r
+They take up only memory they currently need. They are held\r
+in dynamic memory blocks, so dynamic block handle is used to refer\r
+to this string.\r
+\r
+Both types of strings are stored in the way, where first (0th)\r
+byte holds current string length, following bytes are string itself.\r
+\r
+Dynamic:\r
+\r
+Dstral ( -- handle )\r
+ Allocate new string.\r
+\r
+Dstrlen ( handle -- length )\r
+ Return string length.\r
+\r
+c+Dstr ( chr handle -- )\r
+ Add one byte to end of the string.\r
+\r
+c+lDstr ( chr handle -- )\r
+ Add one byte to left side (beginning) of the string.\r
+\r
+Dstr. ( handle -- )\r
+ Write contec of string into screen.\r
+\r
+Dstrsure ( size Dstr -- )\r
+ Makes sure that at least rquested\r
+ "size" (amount of characters) is allocated for given\r
+ dynamic string.\r
+\r
+Dstr2str ( handle address -- )\r
+ Copy dyamic string into static memory space.\r
+\r
+str2Dstr ( address handle -- )\r
+ Copy static string into dyamic string.\r
+\r
+Dstr+str ( Dstr addr -- )\r
+ Add contenc of dynamic string to static string.\r
+\r
+D" any string" ( -- Dstr )\r
+ Moves specified string into dynamic string called "defDstr".\r
+\r
+D> any_string ( -- Dstr )\r
+ Moves specified string into dynamic string called "defDstr".\r
+ Space marks end of string!\r
+\r
+D>2 any_string ( -- Dstr )\r
+ Moves specified string into dynamic string called "defDstr2".\r
+ Space marks end of string!\r
+\r
+Dstr+Dstr ( Dstr1 Dstr2 -- )\r
+ Adds "Dstr1" to "Dstr2" and places result into "Dstr2". \r
+\r
+Dstrclear ( Dstr -- )\r
+ Clears contenc of dynamic string.\r
+\r
+Dstr2Dstr ( Dstr1 Dstr2 -- )\r
+ Moves "Dstr1" to "Dstr2".\r
+Dstr ( data" name -- )\r
+ Creates new dynamic string and moves specified data into it.\r
+ Then creates new constant with given "name" holding created\r
+ dynamic string handle.\r
+\r
+ ex: Dstr Hello, my name is Sven!" message \ creates it\r
+ message Dstr. \ tests it\r
+\r
+Dstrlscan ( char Dstr -- loc )\r
+ Searches dynamic string for "char", from left to right,\r
+ returns first found "char" location in string, or 0,\r
+ if not found.\r
+\r
+Dstrrscan ( char Dstr -- loc )\r
+ Searches dynamic string for "char", from right to left,\r
+ returns first found "char" location in string, or 0,\r
+ if not found.\r
+\r
+Dstrlscane ( char Dstr -- loc )\r
+ Same as "Dstrlscan" buf returns string length+1 as location.\r
+ÿ\r
+Dstrleft ( amo Dstr -- )\r
+ Only specified amount of characters from left remains\r
+ in dynamic string. ie. cut right part out.\r
+\r
+Dstrright ( amo Dstr -- )\r
+ Only specified amount of characters from right remains\r
+ in dynamic string. ie. cut left part out.\r
+\r
+Dstrcutl ( amo Dstr -- )\r
+ Cut specified amount of characters from left of dynamic\r
+ string out.\r
+\r
+Dstrsp ( char Dstr1 Dstr2 -- )\r
+ Separate dynamic string in Dstr1 into two parts,\r
+ using "char" as separator. First part will be stored in\r
+ "Dstr2", second part in "Dstr1".\r
+ ex: asc \ \ ..separator\r
+ D> listF\listLIB\5TH_DRVMOUSE \ ..separate from\r
+ defDstr2 \ ..place result in\r
+ Dstrsp \ separation command\r
+ defDstr Dstr. \ will be: listLIB\5TH_DRVMOUSE\r
+ defDstr2 Dstr. \ will be: listF\r
+\r
+Dv ( addr -- )\r
+ Allocates empty dynamic string, and places it's handle\r
+ into given address.\r
+\r
+Df ( addr -- )\r
+ Reads dynamic string handle from given address and\r
+ deallocates (frees) it.\r
+\r
+ex: var mystring1\r
+ : testmodule\r
+ mystring1 Dv \ allocates string\r
+\r
+ <whatever>\r
+\r
+ mystring1 Df ; \ deallocates it again when no longer needed.\r
--- /dev/null
+<html><head><title>FIFTH</title></head>\r
+<body>\r
+\r
+<pre>\r
+\r
+ <h2>Emulator & virtual CPU</h2>\r
+\r
+\r
+\r
+Using CPU emulator slows it down but I shouldn't now\r
+think too mutch about, and waste my time on batteling with problems whitch\r
+results on complex design of PC hardware. Also it allows me to use existing DOS and\r
+resident drivers services in real mode. So I don't need to deal with\r
+hardware too mutch. It also allows me to use all free XMS for flat\r
+code & data storage.\r
+\r
+Current emulator emulates 1 CPU. It has 2 stacks,\r
+~50 instructions, and 4GB flat address space (theoretically).\r
+I'm not sure that DOS 6.22 that I currently prefer can handle more than\r
+64 MB of RAM. While I tried to keep instructionset simple,\r
+I was forced to put in lot of complex instructions to make it's performance\r
+acceptable on emulator. On actual silicon ~20 instructions is enaugh\r
+(I think).\r
+\r
+Maybe one day similar system will run directly on custom silicon chip :)\r
+\r
+\r
+CPU has following registers:\r
+\r
+IP - instruction pointer\r
+DSP - data stack pointer\r
+RSP - return stack pointer\r
+\r
+Virtual CPU, commands (most of them are avaiable as ordinary commands in\r
+programming lanquage):\r
+\r
+code mnemonic description\r
+\r
+0 nop does notheing\r
+1 halt halt CPU ( return to DOS on emulator )\r
+\r
+2 kbd@ ( -- c ) read scancode of pressed or released key.\r
+ Returns 0, if no data avaiable. \r
+3 num <dword> ( -- n ) put immidiate number into datastack\r
+\r
+4 jmp <dword> jump to specified code\r
+5 call <dword>jump to specified code, save return address to\r
+ return stack.\r
+\r
+6 1+ ( n -- n+1 )\r
+7 1- ( n -- n-1 )\r
+\r
+8 dup ( n -- n n ) duplicate top of data stack\r
+9 drop ( n -- ) drop last element in data stack\r
+\r
+10 if <dword> ( n -- ) jump to addr if top element was 0\r
+11 ret jump to code, specified in return stack.\r
+\r
+12 c@ ( addr -- n ) read byte from memory at specified address\r
+13 c! ( n addr -- ) store byte to specified memory\r
+\r
+14 push ( DSTK -> RSTK ) move top of datastack to returnstack\r
+15 pop ( RSTK -> DSTK ) move top of returnstack to datastack\r
+\r
+16 <unused>\r
+17 rot ( n1 n2 n3 -- n2 n3 n1) rotate stack elements\r
+\r
+18 disk@ ( FromDiskSect ToMem -- ) read 1KB from disk into RAM\r
+19 disk! ( FromMem ToDiskSect -- ) write 1KB to disk\r
+\r
+20 @ ( addr -- n ) read 32 bit number from memory\r
+21 ! ( n addr -- ) store 32 bit number to memory\r
+\r
+22 over ( n1 n2 -- n1 n2 n1 ) self explaining ...\r
+23 swap ( n1 n2 -- n2 n1 ) -,,-\r
+\r
+24 + ( n1 n2 -- n1+n2 ) -,,-\r
+25 - ( n1 n2 -- n1-n2 ) -,,-\r
+\r
+26 * ( n1 n2 -- n1*n2 ) -,,-\r
+27 / ( n1 n2 -- n1/n2 ) -,,-\r
+\r
+28 > ( n1 n2 -- result ) is true when n1 > n2\r
+29 < ( n1 n2 -- result ) is true when n1 < n2\r
+\r
+30 not ( n1 -- not_n1 ) logical not\r
+31 i ( -- n ) copies top of return stack into datastack\r
+\r
+32 cprt@ ( addr -- n ) read one byte from hardware port\r
+33 cprt! ( n addr -- ) store one byte to hardware port\r
+\r
+34 i2 ( -- n ) like "i" but takes socond top stack element.\r
+35 i3 ( -- n ) like "i" but takes third top stack element.\r
+\r
+36 shl ( n amount -- n ) left bit shift\r
+37 shr ( n amount -- n ) right bit shift\r
+\r
+38 or ( n1 n2 -- n ) logical or\r
+39 xor ( n1 n2 -- n ) exclusive logical or\r
+ \r
+40 vidmap ( addr -- ) copy memory from "addr" to video memory.\r
+\r
+41 mouse@ ( -- x y button ) read mouse coordinates & buttons\r
+\r
+42 vidput ( addr1 addr2 x y -- ) put image1 into image2, at\r
+ location x, y. Does clipping, so part of a big image\r
+ can be mapped into smaller one.\r
+\r
+43 cmove ( addr1 addr2 amount ) move memory from addr1 to addr2\r
+ if addr1 is greater than addr2 then count address\r
+ foward while moving, elseway starts from end and\r
+ counts backwards, so no data loss will occure on\r
+ overlapping.\r
+\r
+44 cfill ( c addr amount -- ) fill memory starting at "addr"\r
+ with "c" bytes.\r
+\r
+45 tvidput ( addr1 addr2 x y -- ) same as "vidput" but treats\r
+ color 255 in source image as transparent.\r
+\r
+46 depth ( -- depth ) returns current depth of data stack.\r
+\r
+47 charput ( colorfg colorbg addrsrc addrdest x y )\r
+ draw character to image buffer located at "addrdest"\r
+ to specified x & y location. Decodes 8 bytes from\r
+ source to bits, used to draw character.\r
+\r
+</pre>\r
+</body>\r
+</html>
\ No newline at end of file
--- /dev/null
+ Fifth distribution directory tree description\r
+ =============================================\r
+\r
+After downloading and unpacking the ZIP file you shoud get\r
+directory tree similar to this:\r
+\r
+\r
+[DOC] - Fifth documentation \r
+ [commands] - documentation on Fifth built-in commands\r
+ [modules] - documentation on additional commands, realized as loadable modules\r
+ [shots] - Fifth screenshots\r
+\r
+[imageFile] - files contained within 'disk.raw', just an extracted form.\r
+\r
+[source] - source files\r
+ [emulator] - emulator source\r
+ [util] - utilites\r
+\r
+disk.raw - Virtual disk file, has filesystem inside.\r
+emulator.com - main executable.\r
+\r
+\r
+\r
+\r
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+<meta
+ http-equiv="Content-Type"
+ content="text/html; charset=UTF-8">
+<title>FIFTH</title>
+</head>
+<body>
+ <h1>FIFTH - virtual machine, operating system, programming language</h1>
+ <a href="http://php.svjatoslav.eu/gitweb/?p=fifth.git;a=snapshot;h=HEAD;sf=tgz">Download</a>
+
+ <a href="http://svjatoslav.eu/static/gitbrowse/fifth/doc/index.html">Online homepage</a>
+
+ <a href="http://svjatoslav.eu/programs.jsp">Other applications hosted on svjatoslav.eu</a>
+ <pre>
+<b>Program author:</b>
+ Svjatoslav Agejenko
+ Homepage: <a href="http://svjatoslav.eu">http://svjatoslav.eu</a>
+ Email: <a href="mailto:svjatoslav@svjatoslav.eu">svjatoslav@svjatoslav.eu</a>
+
+This software is distributed under <a href="http://www.gnu.org/licenses/gpl-2.0.html">GNU GENERAL PUBLIC LICENSE Version 2</a>.
+
+<h2>Introdution</h2>
+
+Fifth is programming lanquage & operating system, running on
+<a href="emulator.html">virtual CPU</a>, with custom instructionset. It is mutch like
+Charles Chunk Moore's Forth, it also uses stack architecture,
+and many commands are similar. Basically I got famailiar with
+concepts of Forth, and being inspired created my own system.
+<p />
+Note:
+<i>
+Current implementation does not support object oriented programming.
+While working on Fifth I got lots of cool new ideas that require reimplementation
+of everything.
+
+Currently I try to implement those new ideas in the project called <a
+ href="http://svjatoslav.eu/static/gitbrowse/sixth/doc/index.html">Sixth</a>.
+</i>
+<br />
+<a href="shots/index.html">Screenshots</a>
+
+Read more about:
+<br> <a href="emulator.html">Virtual CPU</a>
+<br> <a href="commands/index.html">Built-in commands</a>
+<br> <a href="modules/index.html">Additional commands, realized as loadable modules</a>
+<br> <a href="5TH_ET.txt">Example Fifth source file - text editor </a>
+
+
+ <h2>Installation</h2>
+
+Just unpack all files, witout altering original directory structure,
+somewhere in your hard disk. For example: C:\MISC\FIFTH\....
+To run fifth you need minimally just 2 files.
+emulator itself ( EMULATOR.EXE or EMULATOR.COM ), and
+virtual disk file ( DISK.RAW ).
+Read more about <a href="files.txt">distribution directory layout</a>.
+
+
+
+ <h2>Software/Hardware/Human requirements</h2>
+
+
+Software: MS-DOS 6.22, with HIMEM.SYS loaded.
+ Mouse driver if you have a mouse.
+ Does work only when CPU is in real mode.
+ To recompile ASM sources I used FASM (Flat Assembler).
+ I ran QBasic utilites on QB 4.5 .
+ VESA support by BIOS, or external driver (UNIVBE).
+
+Hardware: Minimum CPU 386.
+ Recommended CPU Pentium 133.
+ 64 KB free RAM below 640KB,
+ 2 MB of free XMS.
+ VESA compatible video card.
+
+Human: Beginner level Forth knowledge is recommended.
+ Enthusiasm.
+
+
+
+ <h2>Numbers representation</h2>
+
+<img src="numbers.png">
+
+Fifth uses hexdecimal number representation as primary.
+Numbers shape is formed by dividing a square into four parts.
+And manipulating their color (black or white).
+
+
+
+ <h2>Disk file map, and it's data structures</h2>
+
+
+Core & highlevel boot code is stored outside of the filesystem to allow
+easy access to it, at early booting time, when filesystem is not yet
+initialized.
+
+ disk allocation:
+
+offset length description
+
+0 ~4 Kb Fifth core
+4 Kb ~32Kb highlevel boot code
+37 Kb ~65Kb FAT
+101Kb ~16MB filesystem data area
+
+ FAT entry format:
+
+-2 last sector
+-1 empty sector
+0 -- .. pointer to next block
+
+ file entry format
+
+offset length description
+
+0 4 extension
+4 16 name
+20 4 entry point
+24 4 size
+28 4 last modification time
+
+
+
+ <h2>Core architecture</h2>
+
+
+Fifth core is simply some amount of already compiled into machine code
+and linked together modules (entries in other words). In compilation
+process modules is compiled one by one and simply stored on top of
+already existing and growing core. Separately from core is kept
+dictionary, this is special list that contain names of compiled modules,
+variables etc. and they locations in core. Constants use dictionary space
+only. Random word can be removed from dictionary at any time. Currently
+dictionary can contain at most 1000 entries.
+
+
+ dictionary entry format
+
+offset length description
+
+0 4 0 < previous entry
+ 0 = last
+ -1 = empty
+4 15 module name string
+19 1 entry type
+20 4 entry data
+
+Core headers as linked list of module names make up something like dictionary.
+When some entry address is needed compiler can quickly run through headers
+backwards and find needed entry.
+
+ Possible module types
+
+type description "execute" action
+
+0 data compile "num" instruction
+ with address to module
+1 submodule compile "call" instruction
+ with address to module
+2 imm. submodule immideately call to module
+
+
+ Memory map: (average)
+
+<loc> <size> <desc>
+0 ~4096 core
+1500000 ~32000 highlevel Fifth boot code
+200000h core startup messages area
+5200000 end of dynamic memory space
+
+
+
+ <h2>Fifth source format</h2>
+
+
+Fifth uses a different character table and codes than ASCII.
+I call it FSCII (Fifth Standard Code for Information Interchange)
+for example space character is not 32 but 255 instead.
+I plan to use mainly HEX numbers, and create new characters
+to represent numeric values. So typical nemric characters "0123..."
+is treated like ordinary letters.
+
+ FSCII:
+
+DEC HEX function
+
+0 - 15 0 - F HEX numbers
+252 FC backspace
+253 FD tabulator (TAB)
+254 FE carriage return (CR)
+255 FF space
+
+else ordinary characters, like in ASCII.
+
+
+
+
+
+ </pre>
+</body>
+</html>
\ No newline at end of file
--- /dev/null
+ Keyboard driver\r
+ ---------------\r
+\r
+KBD_@ ( -- code ) get scancodes for pressed keys from keyboard.\r
+KBD_down? ( key -- result ) check is key with specified scancode\r
+ currently pressed down. \r
+KBD_SC2FSCII ( code -- FSCII ) convert key scancode into FSCII code,\r
+ or in FSK (Fifth standard keycode). \r
+KBD_F@ ( -- FSCII ) read pressed key FSCII or FSK, returns -1 if no\r
+ keys are pressed.\r
+KBD_FW@ ( -- FSCII ) read pressed key FSCII or FSK, if no keys is\r
+ are pressed then waits until there is.\r
+\r
+ FSK\r
+ ---\r
+In HEX.\r
+\r
+FC backspace\r
+FD TAB\r
+FE enter\r
+FF space\r
+\r
+400 ESC\r
+401 ... F1 ...\r
+410 up\r
+411 right\r
+412 down\r
+413 left\r
+414 INS\r
+415 DEL\r
+416 home\r
+417 end\r
+418 PG/UP\r
+419 PG/DN\r
--- /dev/null
+ Mouse driver\r
+ ------------\r
+\r
+mousex var Mouse x coordinate.\r
+mousey var Mouse y coordinate.\r
+mousekeyl var Mouse left key.\r
+mousekeym var Mouse middle key.\r
+mousekeyr var Mouse right key.\r
+mousec var Display current mouse coordinates in top left part of screen,\r
+ if true. (good for debugging)\r
+mousepointer var Image buffer, holding current mouse pointer.\r
+mouseadd ( ModuleAddr x1 x2 y1 y2 -- ) Add specified area on screen,\r
+ into mause click buffer. If any mouse button is clicked on\r
+ that area, module at "ModuleAddr" will be executed.\r
+mousebe var Amount of buffer elements.\r
+mousedo ( -- ) Updates mouse coordinates and keys. Parse mouse\r
+ click buffer, and draw mouse cursor to "screen".\r
--- /dev/null
+ 2D graphic library\r
+ ------------------\r
+\r
+\r
+lineh ( color len x y imgbuf -- ) draws horisontal line\r
+ from X,Y coordinates to right, with specified length.\r
+linev ( color len x y imgbuf -- ) draws vertical line\r
+ down, from coordinates X,Y, with specified length.\r
+box ( color x2 x1 y2 y1 imgbuf -- ) draws rectangular\r
+ box. x2 bust be >= x1, y2 must be >= y1.\r
+ x1,y1-----------+\r
+ | |\r
+ | |\r
+ +-----------x2,y2\r
+\r
+flipv ( imgbuf -- ) flip image vertically.\r
+imgcoltrans ( ImgBuf Color ToColor -- ) Translate all pixels in\r
+ specified image with "Color" into "ToColor".\r
+imgfill ( color x y imgbuf -- ) Fill image region starting at location\r
+ X & Y with specified color.\r
--- /dev/null
+<html><head><title>FIFTH</title></head>\r
+<body>\r
+\r
+<pre>\r
+\r
+ <h2>Loadable external modules</h2>\r
+\r
+\r
+<a href="drvkbd.txt">keyboard driver</a>\r
+<a href="drvmouse.txt">mouse driver</a>\r
+<a href="gfx2.txt">advanced graphic library</a>\r
+<a href="trig.txt">trigonometry module</a>\r
+\r
+</pre>\r
+</body>\r
+</html>
\ No newline at end of file
--- /dev/null
+ Trigonometry functions\r
+ ----------------------\r
+\r
+sin ( a -- result ) return sinus from given angle "a",\r
+ 360ø is 2000. So 1000 represents 180ø angle.\r
+ Result will be in range -10'000 to 10'000, instead of ñ1.\r
+\r
+cos ( a -- result ) return cosinus from given angle.\r
+ Parameters are like in "sin" function.\r
--- /dev/null
+<html><head><title>FIFTH</title></head>\r
+<body>\r
+\r
+<pre>\r
+\r
+ <h2>Screen shots</h2>\r
+\r
+\r
+<img src="start.png">\r
+Startup screen diplaying Fifth logo and full file list.\r
+\r
+\r
+\r
+<img src="words.png">\r
+Sample words defined. Most of the words are commands that can be executed\r
+interactively from command line or from file. When executed they can be\r
+selectively compiled or interpreted.\r
+\r
+\r
+\r
+<img src="textEditor.png">\r
+Built in text editor.\r
+\r
+\r
+\r
+</pre>\r
+</html>
\ No newline at end of file
--- /dev/null
+; part of virtual processor, emulator for FIFTH\r
+\r
+xcharput:\r
+ mov eax, [es:edi] ; chary\r
+ mov [chary], eax\r
+ mov ecx, [es:edi+4] ; charx\r
+ mov eax, [es:edi+8] ; addrdest\r
+ add eax, [xms_addr]\r
+ mov ebx, [es:eax]\r
+ mov [sizex], ebx\r
+ add eax, 8\r
+ add eax, ecx\r
+ push eax\r
+ sub edx, edx\r
+ mov eax, [chary]\r
+ mul dword [sizex]\r
+ pop ebx\r
+ add eax, ebx\r
+ mov [addrdst], eax\r
+ mov eax, [es:edi+12]\r
+ add eax, [xms_addr]\r
+ mov [addrsrc], eax\r
+ mov al, [es:edi+16]\r
+ mov [colorbg], al\r
+ mov al, [es:edi+20]\r
+ mov [colorfg], al\r
+ add edi, 24\r
+\r
+ mov [linenum], 8\r
+charl1:\r
+ mov eax, [addrsrc]\r
+ mov bx, [es:eax]\r
+ mov edx, [addrdst]\r
+ mov cx, 8\r
+charl2:\r
+ dec cx\r
+ bt bx, cx\r
+ jnc charl3\r
+ mov al, [colorfg]\r
+ jmp charl4\r
+charl3:\r
+ mov al, [colorbg]\r
+charl4:\r
+ mov [es:edx], al\r
+ inc edx\r
+ cmp cx, 0\r
+ jne charl2\r
+\r
+ mov eax, [sizex]\r
+ add [addrdst], eax\r
+ inc [addrsrc]\r
+ dec [linenum]\r
+ mov al, [linenum]\r
+ cmp al, 0\r
+ jne charl1\r
+\r
+ jmp emu\r
+\r
+colorfg db 0\r
+colorbg db 0\r
+charx dd 0\r
+chary dd 0\r
+addrsrc dd 0\r
+addrdst dd 0\r
+sizex dd 0\r
+linenum db 0\r
--- /dev/null
+#!/bin/bash
+
+fasm emulator.asm
+
--- /dev/null
+; virtual processor, emulator for FIFTH\r
+\r
+; registers usage:\r
+\r
+; edi - data stack pointer\r
+; esi - instruction pointer\r
+; es = 0\r
+; cs - emulator program code segment\r
+; ds = cs\r
+\r
+\r
+org 100h\r
+\r
+ call system_init ; init system, allocate XMS\r
+ call KB_init ; init keyoard\r
+\r
+ push 0 ; initialize segments\r
+ pop es\r
+ push cs\r
+ pop ds\r
+ sub ebx, ebx ; initialize pointers\r
+ mov bx, cs\r
+ shl ebx, 4\r
+ add ebx, buf\r
+ add ebx, 20000\r
+ mov edi, ebx ; data stack\r
+ add ebx, 10000\r
+ mov [resp], ebx ; return stack\r
+ mov esi, [xms_addr] ; instruction pointer\r
+\r
+ mov ah, 3dh ; open diskfile\r
+ mov al, 2\r
+ mov dx, infile\r
+ int 21h\r
+ mov word [fileh], ax\r
+\r
+ mov ax, 4F02h ; set VESA 640*480 8 bit\r
+ mov bx, 101h\r
+ int 10h\r
+\r
+ mov ecx, 0 ; load boot block (first 1024 bytes)\r
+ mov ebx, [xms_addr]\r
+ call diskload\r
+ jmp emu\r
+\r
+xmemtot dw 0 ; amount of accessible XMS\r
+\r
+infile db 'disk.raw', 0 ; virtual disk file name\r
+fileh dw 0 ; it's handle\r
+\r
+coresiz dw 4096 ; core size\r
+gran dw 0 ; VESA granule size\r
+\r
+quit: mov ax, 3 ; restore text mode\r
+ int 10h\r
+\r
+ mov ah, 3eh ; close diskfile\r
+ mov bx, word [fileh]\r
+ int 21h\r
+\r
+ call KB_restore\r
+ jmp system_exit ; terminate program\r
+\r
+resp dd 0 ; return stack pointer\r
+\r
+emu: ; pick instruction\r
+movzx bx, byte [es:esi]\r
+inc esi\r
+shl bx, 1\r
+add bx, table\r
+jmp word [cs:bx]\r
+\r
+table dw emu ; 0\r
+ dw quit\r
+ dw xkbd@\r
+ dw xnum\r
+ dw xjmp\r
+ dw xcall ; 5\r
+ dw xinc\r
+ dw xdec\r
+ dw xdup\r
+ dw xdrop\r
+ dw xif ; 10\r
+ dw xret\r
+ dw xc@\r
+ dw xc!\r
+ dw xpush\r
+ dw xpop ; 15\r
+ dw 0\r
+ dw xrot\r
+ dw xdisk@\r
+ dw xdisk!\r
+ dw x@ ; 20\r
+ dw x!\r
+ dw xover\r
+ dw xswap\r
+ dw xplus\r
+ dw xminus ; 25\r
+ dw xmul\r
+ dw xdiv\r
+ dw xgreat\r
+ dw xless\r
+ dw xnot ; 30\r
+ dw xi\r
+ dw xcprt@\r
+ dw xcprt!\r
+ dw xi2\r
+ dw xi3 ; 35\r
+ dw xshl\r
+ dw xshr\r
+ dw lor\r
+ dw lxor\r
+ dw xvidmap ; 40\r
+ dw xmouse@\r
+ dw xvidput\r
+ dw xcmove\r
+ dw xcfill\r
+ dw xtvidput ; 45\r
+ dw xdep\r
+ dw xcharput\r
+\r
+xkbd@: call KB_read\r
+ sub edi, 4\r
+ mov [es:edi], dl\r
+\r
+ mov ah, 0bh ; check for key in keyboard buffer\r
+ int 21h\r
+ cmp al, 0h\r
+ je emu\r
+ mov ah, 0 ; read key\r
+ int 16h\r
+ jmp emu\r
+\r
+xnum: mov edx, dword [es:esi]\r
+ sub edi, 4\r
+ mov [es:edi], edx\r
+ add esi, 4\r
+ jmp emu\r
+\r
+xjmp: mov esi, dword [es:esi]\r
+ add esi, [xms_addr]\r
+ jmp emu\r
+\r
+xcall: mov edx, dword [es:esi]\r
+ mov eax, [resp]\r
+ sub eax, 4\r
+ mov ebx, esi\r
+ add ebx, 4\r
+ sub ebx, [xms_addr]\r
+ mov [es:eax], ebx\r
+ mov [resp], eax\r
+ mov esi, edx\r
+ add esi, [xms_addr]\r
+ jmp emu\r
+\r
+xinc: inc dword [es:edi]\r
+ jmp emu\r
+\r
+xdec: dec dword [es:edi]\r
+ jmp emu\r
+\r
+xdup: mov eax, [es:edi]\r
+ sub edi, 4\r
+ mov [es:edi], eax\r
+ jmp emu\r
+\r
+xdrop: add edi, 4\r
+ jmp emu\r
+\r
+xif: mov eax, [es:edi]\r
+ add edi, 4\r
+ cmp eax, 0\r
+ jne l2\r
+ mov esi, [es:esi]\r
+ add esi, [xms_addr]\r
+ jmp emu\r
+l2:\r
+ add esi, 4\r
+ jmp emu\r
+\r
+xret: mov eax, [resp]\r
+ mov esi, [es:eax]\r
+ add esi, [xms_addr]\r
+ add eax, 4\r
+ mov [resp], eax\r
+ jmp emu\r
+\r
+xc@: mov eax, [es:edi]\r
+ add eax, [xms_addr]\r
+ sub ecx, ecx\r
+ mov cl, [es:eax]\r
+ mov [es:edi], ecx\r
+ jmp emu\r
+\r
+xc!: ;( n addr -- )\r
+ mov ebx, [es:edi]\r
+ add edi, 4\r
+ mov ecx, [es:edi]\r
+ add edi, 4\r
+ add ebx, [xms_addr]\r
+ mov [es:ebx], cl\r
+ jmp emu\r
+\r
+xpush: mov ebx, [es:edi]\r
+ add edi, 4\r
+ mov eax, [resp]\r
+ sub eax, 4\r
+ mov [es:eax], ebx\r
+ mov [resp], eax\r
+ jmp emu\r
+\r
+xpop: mov eax, [resp]\r
+ mov ebx, [es:eax]\r
+ add eax, 4\r
+ mov [resp], eax\r
+ sub edi, 4\r
+ mov [es:edi], ebx\r
+ jmp emu\r
+\r
+xrot: mov ebx, [es:edi]\r
+ mov ecx, [es:edi+4]\r
+ mov edx, [es:edi+8]\r
+ mov [es:edi+8], ecx\r
+ mov [es:edi+4], ebx\r
+ mov [es:edi], edx\r
+ jmp emu\r
+\r
+xdisk@: mov ebx, [es:edi]\r
+ add ebx, [xms_addr]\r
+ mov ecx, [es:edi+4]\r
+ add edi, 8\r
+ call diskload ; ecx-fromdisk ebx-tomem\r
+ jmp emu\r
+\r
+xdisk!: mov ecx, [es:edi]\r
+ call file_seek\r
+ mov ecx, 1024\r
+ mov ebx, [es:edi+4]\r
+ add edi, 8\r
+ add ebx, [xms_addr]\r
+ sub edx, edx\r
+ mov dx, cs\r
+ shl edx, 4\r
+ add edx, buf\r
+ call memmove ; ebx - from, edx - to, ecx - amount\r
+ mov ah, 40h\r
+ mov bx, [fileh]\r
+ mov cx, 1024\r
+ mov dx, buf\r
+ int 21h\r
+ jmp emu\r
+\r
+x@: mov eax, [es:edi]\r
+ add eax, [xms_addr]\r
+ mov eax, [es:eax]\r
+ mov [es:edi], eax\r
+ jmp emu\r
+\r
+x!: ;( n addr -- )\r
+ mov eax, [es:edi]\r
+ add eax, [xms_addr]\r
+ mov ecx, [es:edi+4]\r
+ add edi, 8\r
+ mov [es:eax], ecx\r
+ jmp emu\r
+\r
+xover: mov ebx, [es:edi+4]\r
+ sub edi, 4\r
+ mov [es:edi], ebx\r
+ jmp emu\r
+\r
+xswap: mov ebx, [es:edi]\r
+ xchg ebx, [es:edi+4]\r
+ mov [es:edi], ebx\r
+ jmp emu\r
+\r
+xplus: mov ebx, [es:edi]\r
+ add edi, 4\r
+ add [es:edi], ebx\r
+ jmp emu\r
+\r
+xminus: mov ebx, [es:edi]\r
+ add edi, 4\r
+ sub [es:edi], ebx\r
+ jmp emu\r
+\r
+xmul: mov eax, [es:edi]\r
+ add edi, 4\r
+ sub edx, edx\r
+ imul dword [es:edi]\r
+ mov [es:edi], eax\r
+ jmp emu\r
+\r
+xdiv: add edi, 4\r
+ mov eax, [es:edi]\r
+ cdq\r
+ idiv dword [es:edi-4]\r
+ mov [es:edi], eax\r
+ jmp emu\r
+\r
+xgreat: mov eax, [es:edi]\r
+ add edi, 4\r
+ mov edx, 0\r
+ cmp [es:edi], eax\r
+ jng l3\r
+ dec edx\r
+l3: mov [es:edi], edx\r
+ jmp emu\r
+\r
+xless: mov eax, [es:edi]\r
+ add edi, 4\r
+ mov edx, 0\r
+ cmp [es:edi], eax\r
+ jnl l4\r
+ dec edx\r
+l4: mov [es:edi], edx\r
+ jmp emu\r
+\r
+file_seek: ; ( ecx - pointer to seek )\r
+ mov eax, 1024\r
+ mul ecx\r
+ mov ecx, eax\r
+ mov dx, cx\r
+ shr ecx, 16\r
+ mov ah, 42h\r
+ mov al, 0\r
+ mov bx, [ds:fileh]\r
+ int 21h\r
+ ret\r
+\r
+xnot: not dword [es:edi]\r
+ jmp emu\r
+\r
+xi: mov ebx, [resp]\r
+ mov eax, [es:ebx]\r
+ sub edi, 4\r
+ mov [es:edi], eax\r
+ jmp emu\r
+\r
+xcprt@: mov dx, [es:edi]\r
+ in al, dx\r
+ sub ecx, ecx\r
+ mov cl, al\r
+ mov [es:edi], ecx\r
+ jmp emu\r
+\r
+xcprt!: mov dx, [es:edi]\r
+ mov al, [es:edi+4]\r
+ add edi, 8\r
+ out dx, al\r
+ jmp emu\r
+\r
+xi2: mov ebx, [resp]\r
+ mov eax, [es:ebx+4]\r
+ sub edi, 4\r
+ mov [es:edi], eax\r
+ jmp emu\r
+\r
+xi3: mov ebx, [resp]\r
+ mov eax, [es:ebx+8]\r
+ sub edi, 4\r
+ mov [es:edi], eax\r
+ jmp emu\r
+\r
+xshl: mov cl, [es:edi]\r
+ add edi, 4\r
+ shl dword [es:edi], cl\r
+ jmp emu\r
+\r
+xshr: mov cl, [es:edi]\r
+ add edi, 4\r
+ shr dword [es:edi], cl\r
+ jmp emu\r
+\r
+lor: mov eax, [es:edi]\r
+ add edi, 4\r
+ or [es:edi], eax\r
+ jmp emu\r
+\r
+lxor: mov eax, [es:edi]\r
+ add edi, 4\r
+ xor [es:edi], eax\r
+ jmp emu\r
+\r
+xvidmap:\r
+ mov edx, [es:edi]\r
+ add edx, [xms_addr]\r
+ add edi, 4\r
+ push edi\r
+ push esi\r
+ push 0a000h\r
+ pop es\r
+ mov word [ds:gra], 0\r
+ push 0\r
+ pop ds\r
+ mov esi, edx\r
+mapl1: mov dx, [cs:gra]\r
+ xor bx, bx\r
+ mov ax, 4f05h\r
+ int 10h\r
+ mov edi, 0\r
+ mov cx, 4096\r
+; mov cx, 16384\r
+mapl2: mov eax, [ds:esi]\r
+ add esi, 4\r
+ stosd\r
+ loop mapl2\r
+ inc word [cs:gra]\r
+; cmp word [cs:gra], 5\r
+ cmp word [cs:gra], 19\r
+ jne mapl1\r
+ push 0\r
+ pop es\r
+ push cs\r
+ pop ds\r
+ pop esi\r
+ pop edi\r
+ jmp emu\r
+gra dw 0\r
+\r
+\r
+xmouse@:\r
+ mov ax, 0bh ; read motion counter\r
+ int 33h\r
+ push dx\r
+ sub eax, eax\r
+ mov ax, cx\r
+ cwd\r
+ shl edx, 16\r
+ add edx, eax\r
+ mov [es:edi-4], edx\r
+ pop ax\r
+ cwd\r
+ shl edx, 16\r
+ add edx, eax\r
+ mov [es:edi-8], edx\r
+ mov ax, 3 ; read buttons\r
+ int 33h\r
+ sub eax, eax\r
+ mov ax, bx\r
+ sub edi, 12\r
+ mov [es:edi], eax\r
+ jmp emu\r
+\r
+memmove: ; ebx - from, edx - to, ecx - amount\r
+ cmp ecx, 0\r
+ je l11\r
+ mov al, [es:ebx]\r
+ mov [es:edx], al\r
+ inc ebx\r
+ inc edx\r
+ dec ecx\r
+ jmp memmove\r
+l11: ret\r
+\r
+memmove2: ; ebx - from, edx - to, ecx - amount\r
+ add ebx, ecx\r
+ add edx, ecx\r
+l7: cmp ecx, 0\r
+ je l12\r
+ dec ebx\r
+ dec edx\r
+ mov al, [es:ebx]\r
+ mov [es:edx], al\r
+ dec ecx\r
+ jmp l7\r
+l12: ret\r
+\r
+xcmove: mov ecx, [es:edi]\r
+ add edi, 12\r
+ mov edx, [es:edi-8]\r
+ add edx, [xms_addr]\r
+ mov ebx, [es:edi-4]\r
+ add ebx, [xms_addr]\r
+ cmp ecx, 0\r
+ je emu\r
+ cmp ebx, edx\r
+ ja l8\r
+ call memmove2\r
+ jmp emu\r
+l8: call memmove\r
+ jmp emu\r
+\r
+xcfill: mov ecx, [es:edi]\r
+ mov edx, [es:edi+4]\r
+ add edx, [xms_addr]\r
+ mov eax, [es:edi+8]\r
+ add edi, 12\r
+l9: cmp ecx, 0\r
+ je emu\r
+ mov [es:edx], al\r
+ inc edx\r
+ dec ecx\r
+ jmp l9\r
+\r
+diskload: ; ecx-fromdisk ebx-tomem\r
+ push ebx\r
+ call file_seek\r
+ mov cx, 1024\r
+ mov ah, 3fh\r
+ mov bx, [fileh]\r
+ mov dx, buf\r
+ int 21h\r
+\r
+ sub ebx, ebx ; move it to XMS\r
+ mov bx, cs\r
+ shl ebx, 4\r
+ add ebx, buf\r
+ pop edx\r
+ mov ecx, 1024\r
+ call memmove ; ebx - from, edx - to, ecx - amount\r
+ ret\r
+\r
+xdep: sub eax, eax\r
+ mov ax, cs\r
+ shl eax, 4\r
+ add eax, buf\r
+ add eax, 20000\r
+ sub eax, edi\r
+ shr eax, 2\r
+ sub edi, 4\r
+ mov [es:edi], eax\r
+ jmp emu\r
+\r
+include 'vidput.inc'\r
+include 'tvidput.inc'\r
+include 'charput.inc'\r
+include 'system.inc'\r
+include 'kbdrive.inc'\r
+\r
+buf: ; pointer to end of the code\r
--- /dev/null
+; Keyboard driver.\r
+\r
+KB_init:\r
+ push es \r
+ push 0\r
+ pop es\r
+ mov eax, [es:9*4] ; save old int vectar\r
+ mov [KB_OldVect], eax \r
+ mov ax, cs ; set new int vector\r
+ shl eax, 16\r
+ mov ax, KB_IntHandler\r
+ mov [es:9*4], eax\r
+ pop es\r
+ ret\r
+\r
+KB_restore:\r
+ mov eax, [KB_OldVect]\r
+ push es\r
+ push 0\r
+ pop es\r
+ mov [es:9*4], eax \r
+ pop es\r
+ ret\r
+\r
+KB_IntHandler:\r
+ pusha\r
+ in al, 60h\r
+ mov bx, [cs:KB_pntin]\r
+ mov byte [cs:bx+KB_buf], al\r
+ inc bx\r
+ cmp bx, 128\r
+ jng KB_l1\r
+ mov bx, 0\r
+KB_l1: mov [cs:KB_pntin], bx\r
+ popa\r
+ pushf ; Execute default code in old int vector\r
+ call dword [cs:KB_OldVect]\r
+ iret\r
+\r
+KB_read: ; returns scan code in: dl\r
+ mov dl, 0\r
+ mov bx, [KB_pntout]\r
+ cmp bx, [KB_pntin]\r
+ je KB_l2\r
+ mov dl, [bx+KB_buf]\r
+ inc bx\r
+ cmp bx, 128\r
+ jng KB_l3\r
+ mov bx, 0\r
+KB_l3: mov [KB_pntout], bx\r
+KB_l2: ret\r
+\r
+KB_OldVect dd 0\r
+KB_pntin dw 0\r
+KB_pntout dw 0\r
+KB_buf db 0\r
+times 127 db 0\r
--- /dev/null
+; part of virtual processor, emulator for FIFTH.\r
+\r
+system_init:\r
+ mov ax,7202h\r
+ push ax\r
+ popf\r
+ pushf\r
+ pop bx\r
+ cmp ax,bx\r
+ je processor_ok\r
+ mov dx, badcpu\r
+ mov ah,9\r
+ int 21h\r
+ mov ah,4Ch\r
+ int 21h\r
+ badcpu db 'required 80386 or better',24h\r
+processor_ok:\r
+ smsw ax\r
+ test al,1\r
+ jz mode_ok\r
+ mov dx, badmode\r
+ mov ah,9\r
+ int 21h\r
+ mov ah,4Ch\r
+ int 21h\r
+ badmode db 'error: CPU in protected mode',24h\r
+mode_ok:\r
+ mov ax,4300h ; check for XMS\r
+ int 2Fh\r
+ cmp al,80h ; XMS present?\r
+ je xms_ok\r
+ mov dx, badxms\r
+ mov ah,9\r
+ int 21h\r
+ jmp system_exit\r
+ badxms db 'error: HIMEM.SYS not loaded',24h\r
+xms_ok:\r
+ mov ax,350Dh\r
+ int 21h\r
+ mov word [irq_5],bx\r
+ mov word [irq_5+2],es\r
+ push cs\r
+ pop es\r
+ mov ax,250Dh\r
+ mov dx,int_13\r
+ int 21h\r
+\r
+ push es\r
+ mov ax,4310h ; get XMS driver address\r
+ int 2Fh\r
+ mov word [xms_call],bx ; store XMS driver address\r
+ mov word [xms_call+2],es\r
+ pop es\r
+ mov ah,3 ; enable A20\r
+ call far dword [xms_call]\r
+ mov ah,8 ; get free extended memory size\r
+ xor bl,bl\r
+ call far dword [xms_call]\r
+ or bl,bl\r
+ mov dx,ax\r
+ movzx eax,ax\r
+ shl eax,10\r
+ mov ah,9 ; allocate largest memory block\r
+ call far dword [xms_call]\r
+ mov [xms_handle],dx\r
+ mov ah,0Ch ; lock extended memory block\r
+ call far dword [xms_call]\r
+ shl edx,16\r
+ mov dx,bx\r
+ mov [xms_addr],edx ; store memory block address\r
+ ret\r
+\r
+\r
+system_exit:\r
+ cmp [xms_handle],0\r
+ je sys_exit\r
+ mov ah, 0dh ; unlock extended memory block\r
+ mov dx, [xms_handle]\r
+ call far dword [xms_call]\r
+ mov ah, 0ah ; free extended memory block\r
+ call far dword [xms_call]\r
+sys_exit:\r
+ mov ax, 250dh\r
+ mov dx, word [irq_5]\r
+ mov ds, word [irq_5+2]\r
+ int 21h\r
+ pop ax\r
+ mov ah, 4ch\r
+ int 21h\r
+\r
+int_13: push eax\r
+ mov al, 00001011b ; OCW3 - read IRQ in-service register\r
+ out 20h, al\r
+ in al, 20h\r
+ test al, 00100000b ; is IRQ 5 in service?\r
+ jz exception\r
+ pop eax\r
+ jmp dword 0:0\r
+ label irq_5 dword at $-4\r
+exception:\r
+ push ds es fs gs\r
+ cli ; disable interrupts\r
+ xor eax, eax ; calculate linear address of GDT\r
+ mov ax, cs\r
+ shl eax, 4\r
+ add eax, GDT\r
+ mov dword [cs:GDTR+2],eax\r
+ lgdt pword [cs:GDTR] ; load GDT register\r
+ mov eax, cr0 ; switch to protected mode\r
+ or al, 1\r
+ mov cr0, eax\r
+ jmp pm_start\r
+ pm_start:\r
+ mov ax, 1 shl 3 ; load 32-bit data descriptor\r
+ mov ds, ax ; to all data segment registers\r
+ mov es, ax\r
+ mov fs, ax\r
+ mov gs, ax\r
+ mov eax, cr0 ; switch back to real mode\r
+ and al, not 1\r
+ mov cr0, eax\r
+ jmp pm_end\r
+ pm_end:\r
+ sti ; enable interrupts\r
+ pop gs fs es ds\r
+ pop eax\r
+ iret\r
+\r
+GDTR dw 2*8-1 ; limit of GDT\r
+ dd ? ; linear address of GDT\r
+\r
+GDT rw 4 ; null descriptor\r
+ dw 0FFFFh, 0, 9200h, 8Fh ; 32-bit data descriptor\r
+\r
+xms_call dd 0 ; XMS driver pointer\r
+xms_handle dw 0 ; handle of XMS memory block\r
+xms_addr dd 0 ; address to XMS block\r
--- /dev/null
+; part of virtual processor, emulator for FIFTH\r
+\r
+\r
+xtvidput:\r
+mov ebx, edi ; read data from stack, and save it to variables\r
+mov eax, [es:ebx]\r
+mov [cory], eax\r
+add ebx, 4\r
+mov eax, [es:ebx]\r
+mov [corx], eax\r
+\r
+add ebx, 4\r
+mov eax, [es:ebx]\r
+add eax, [xms_addr]\r
+mov ecx, [es:eax]\r
+mov [img2x], ecx\r
+add eax, 4\r
+mov ecx, [es:eax]\r
+mov [img2y], ecx\r
+add eax, 4\r
+mov [img2a], eax\r
+\r
+add ebx, 4\r
+mov eax, [es:ebx]\r
+add eax, [xms_addr]\r
+mov ecx, [es:eax]\r
+mov [img1x], ecx\r
+add eax, 4\r
+mov ecx, [es:eax]\r
+mov [img1y], ecx\r
+add eax, 4\r
+mov [img1a], eax\r
+\r
+add ebx, 4\r
+mov edi, ebx\r
+\r
+cmp dword [cory] , 0 ; calculate Y start\r
+jl tvidl1\r
+mov dword [starty], 0\r
+jmp tvidl2\r
+tvidl1:\r
+mov eax, [cory]\r
+neg eax\r
+mov [starty], eax\r
+tvidl2:\r
+\r
+cmp dword [corx] , 0 ; calculate X start\r
+jl tvidl3\r
+mov dword [startx], 0\r
+jmp tvidl4\r
+tvidl3:\r
+mov eax, [corx]\r
+neg eax\r
+mov [startx], eax\r
+tvidl4:\r
+\r
+mov eax, [cory] ; calculate Y end\r
+add eax, [img1y]\r
+cmp eax, [img2y]\r
+jg tvidl5\r
+mov eax, [img1y]\r
+mov [endy], eax\r
+jmp tvidl6\r
+tvidl5:\r
+mov eax, [img2y]\r
+sub eax, [cory]\r
+mov [endy], eax\r
+tvidl6:\r
+\r
+mov eax, [corx] ; calculate X end\r
+add eax, [img1x]\r
+cmp eax, [img2x]\r
+jg tvidl7\r
+mov eax, [img1x]\r
+mov [endx], eax\r
+jmp tvidl8\r
+tvidl7:\r
+mov eax, [img2x]\r
+sub eax, [corx]\r
+mov [endx], eax\r
+tvidl8:\r
+\r
+mov eax, [endy] ; calculate Y length\r
+sub eax, [starty]\r
+cmp eax, 0\r
+jle emu\r
+mov [lengthy], eax\r
+\r
+mov eax, [endx] ; calculate X length\r
+sub eax, [startx]\r
+cmp eax, 0\r
+jle emu\r
+mov [lengthx], eax\r
+\r
+mov eax, [starty] ; calculate img1 start address\r
+mov ebx, [img1x]\r
+sub edx, edx\r
+mul ebx\r
+add eax, [img1a]\r
+add eax, [startx]\r
+mov [img1start], eax\r
+\r
+mov eax, [cory] ; calculate img2 start address\r
+add eax, [starty]\r
+mov ebx, [img2x]\r
+sub edx, edx\r
+mul ebx\r
+add eax, [img2a]\r
+add eax, [corx]\r
+add eax, [startx]\r
+mov [img2start], eax\r
+\r
+tvidl9:\r
+mov ebx, [img1start]\r
+mov ecx, [lengthx]\r
+mov edx, [img2start]\r
+\r
+tmemmove: ; ebx - from, edx - to, ecx - amount\r
+cmp ecx, 0\r
+je tl11\r
+mov al, [es:ebx]\r
+cmp al, 255\r
+je tl12\r
+mov [es:edx], al\r
+tl12:\r
+inc ebx\r
+inc edx\r
+dec ecx\r
+jmp tmemmove\r
+tl11:\r
+\r
+mov eax, [img1x]\r
+add [img1start], eax\r
+mov eax, [img2x]\r
+add [img2start], eax\r
+dec dword [lengthy]\r
+cmp [lengthy], 0\r
+jg tvidl9\r
+\r
+jmp emu\r
--- /dev/null
+; part of virtual processor, emulator for FIFTH\r
+\r
+\r
+xvidput:\r
+mov ebx, edi ; read data from stack, and save it to variables\r
+mov eax, [es:ebx]\r
+mov [cory], eax\r
+add ebx, 4\r
+mov eax, [es:ebx]\r
+mov [corx], eax\r
+\r
+add ebx, 4\r
+mov eax, [es:ebx]\r
+add eax, [xms_addr]\r
+mov ecx, [es:eax]\r
+mov [img2x], ecx\r
+add eax, 4\r
+mov ecx, [es:eax]\r
+mov [img2y], ecx\r
+add eax, 4\r
+mov [img2a], eax\r
+\r
+add ebx, 4\r
+mov eax, [es:ebx]\r
+add eax, [xms_addr]\r
+mov ecx, [es:eax]\r
+mov [img1x], ecx\r
+add eax, 4\r
+mov ecx, [es:eax]\r
+mov [img1y], ecx\r
+add eax, 4\r
+mov [img1a], eax\r
+\r
+add ebx, 4\r
+mov edi, ebx\r
+\r
+cmp dword [cory] , 0 ; calculate Y start\r
+jl vidl1\r
+mov dword [starty], 0\r
+jmp vidl2\r
+vidl1:\r
+mov eax, [cory]\r
+neg eax\r
+mov [starty], eax\r
+vidl2:\r
+\r
+cmp dword [corx] , 0 ; calculate X start\r
+jl vidl3\r
+mov dword [startx], 0\r
+jmp vidl4\r
+vidl3:\r
+mov eax, [corx]\r
+neg eax\r
+mov [startx], eax\r
+vidl4:\r
+\r
+mov eax, [cory] ; calculate Y end\r
+add eax, [img1y]\r
+cmp eax, [img2y]\r
+jg vidl5\r
+mov eax, [img1y]\r
+mov [endy], eax\r
+jmp vidl6\r
+vidl5:\r
+mov eax, [img2y]\r
+sub eax, [cory]\r
+mov [endy], eax\r
+vidl6:\r
+\r
+mov eax, [corx] ; calculate X end\r
+add eax, [img1x]\r
+cmp eax, [img2x]\r
+jg vidl7\r
+mov eax, [img1x]\r
+mov [endx], eax\r
+jmp vidl8\r
+vidl7:\r
+mov eax, [img2x]\r
+sub eax, [corx]\r
+mov [endx], eax\r
+vidl8:\r
+\r
+mov eax, [endy] ; calculate Y length\r
+sub eax, [starty]\r
+cmp eax, 0\r
+jle emu\r
+mov [lengthy], eax\r
+\r
+mov eax, [endx] ; calculate X length\r
+sub eax, [startx]\r
+cmp eax, 0\r
+jle emu\r
+mov [lengthx], eax\r
+\r
+mov eax, [starty] ; calculate img1 start address\r
+mov ebx, [img1x]\r
+sub edx, edx\r
+mul ebx\r
+add eax, [img1a]\r
+add eax, [startx]\r
+mov [img1start], eax\r
+\r
+mov eax, [cory] ; calculate img2 start address\r
+add eax, [starty]\r
+mov ebx, [img2x]\r
+sub edx, edx\r
+mul ebx\r
+add eax, [img2a]\r
+add eax, [corx]\r
+add eax, [startx]\r
+mov [img2start], eax\r
+\r
+vidl9:\r
+mov ebx, [img1start]\r
+mov ecx, [lengthx]\r
+mov edx, [img2start]\r
+call memmove\r
+\r
+mov eax, [img1x]\r
+add [img1start], eax\r
+mov eax, [img2x]\r
+add [img2start], eax\r
+dec dword [lengthy]\r
+cmp [lengthy], 0\r
+jg vidl9\r
+\r
+jmp emu\r
+\r
+cory dd 0\r
+corx dd 0\r
+img2x dd 0\r
+img2y dd 0\r
+img2a dd 0\r
+img1x dd 0\r
+img1y dd 0\r
+img1a dd 0\r
+\r
+starty dd 0\r
+startx dd 0\r
+endy dd 0\r
+endx dd 0\r
+lengthx dd 0\r
+lengthy dd 0\r
+\r
+img1start dd 0\r
+img2start dd 0\r
--- /dev/null
+#!/bin/bash
+
+
+sudo mount -o loop image.img files/
--- /dev/null
+#!/bin/bash
+
+sudo umount files
--- /dev/null
+#!/bin/bash
+
+
+qemu -fda image.img -boot a
+
--- /dev/null
+D> \listF\listLIB\5TH_GFX include\r
+D> \listF\5TH_LOGO include\r
+\r
+: tmpmsg 200000 100 do\r
+ dup c@ dup FC = if drop doexit else emit 1+ then\r
+loop drop ;\r
+.( Messages from core: )\r
+colhigh\r
+tmpmsg\r
+colnorm\r
+forget tmpmsg\r
+\r
+\r
+D> \listF\listLIB\5TH_DRVKBD include\r
+D> \listF\listLIB\5TH_UICMD include\r
+D> \listF\5TH_QUICKPATH include\r
+\r
+Dstr \listF\5TH_ET" tmpstr\r
+: lde tmpstr include ; rh tmpstr\r
+\r
+Dstr \listF\TXT_HELP" tmpstr\r
+: help tmpstr fs. ; rh tmpstr\r
+\r
+Dstr \listF\5TH_BOOT" tmpstr\r
+: putboot\r
+tmpstr fsDloadnew\r
+dup dynp [ 400 4 * ] [ 400 20 * ] disksave\r
+dynde ; rh tmpstr\r
+\r
+fslsr\r
+\r
+.( type 'help' to get help )\r
--- /dev/null
+str \listF\" ~f\r
+str \listGAMES\listSauron_Return\" ~game\r
+str \listF\listLIB\" ~lib\r
+str \" ~r\r
+\r
+: go fspath str2Dstr fsls ;\r
--- /dev/null
+FE 3\r
+\r
+: im 2 lp @ 13 + c! ret I\r
+: ; B c, 1 mode c! ret I im\r
+: gw FF scan ;\r
+: lit mode c@ if ret else 3 c, , ret then ;\r
+: ' gw find 14 + @ lit ; im\r
+: abc FF scan here 2 ne 3 c, , 4 c, ' bcode , ;\r
+\r
+ 2 abc kbd@\r
+10 abc kb@ 11 abc rot 1B abc / 1E abc not\r
+1F abc i 20 abc cprt@ 21 abc cprt! 22 abc i2\r
+23 abc i3 24 abc shl 25 abc shr 26 abc or\r
+27 abc xor 28 abc vidmap 29 abc mouse@ 2A abc vidput\r
+2C abc cfill 2D abc tvidput 2E abc depth 13 abc disk!\r
+2F abc charput\r
+\r
+: create gw here 0 ne ;\r
+: vari create , ;\r
+: var 0 vari ;\r
+: const gw 0 ne ;\r
+: asc skey lit ; im\r
+: ( asc ) scan ; im\r
+: cr FE emit ;\r
+: .( asc ) scan pad write cr ; .( it is a test )\r
+: forget gw find dup 14 + @ h ! @ lp ! ;\r
+: on -1 swap ! ;\r
+: off 0 swap ! ;\r
+: 2dup over over ;\r
+: 2drop drop drop ;\r
+: space FF emit ;\r
+: nip swap drop ;\r
+: >= 1- > ;\r
+: <= 1+ < ;\r
+: = - if 0 else -1 then ;\r
+: neg 0 swap - ;\r
+: forexit pop pop pop drop dup 1+ push push push ;\r
+: done pop pop 1- push push ;\r
+: doexit pop pop drop 0 push push ;\r
+: bit@ shr -2 or -2 xor ;\r
+: to32bit 100 * + 100 * + 100 * + ;\r
+: mod 2dup / * - ;\r
+: rh gw -1 find dup @ prev @ ! ! ;\r
+: alloc do 0 c, loop ;\r
+var tmp\r
+: [ depth tmp ! 1 mode ! ; im\r
+: ] 0 mode ! depth tmp @ - do lit loop ; rh tmp\r
+: " asc " scan pad dup c@ c, incmod ;\r
+: i" asc " scan pad incmod ;\r
+: str here " const ;\r
+: writestr i write i c@ pop + 1+ push ;\r
+: ." 5 c, ' writestr , " ; im rh writestr\r
+: vector ." no vector ! " ;\r
+: defer gw here 1 ne 4 c, ' vector , ;\r
+: is 1+ ! ; rh vector\r
+: bound 2dup > if nip nip\r
+ else drop 2dup > if drop else\r
+ nip then then ;\r
+: bound? over < if 2drop 0 else\r
+ > if 0 else -1 then then ;\r
+: \ until fkey FE = if done then loop ; im\r
+: tab. FD emit ;\r
+: abs dup 0 < if neg then ;\r
+\r
+7FFFFFFF const max\r
+80000000 const min\r
+1 const version\r
+\r
+var to8bitt\r
+: to8bit to8bitt ! to8bitt dup c@ swap 1+ dup c@\r
+ swap 1+ dup c@ swap 1+ c@ ; rh to8bitt\r
+\r
+var tmp1\r
+: d. dup 0 < if 0 swap - 2D\r
+ emit then tmp1 off 3B9ACA00\r
+ A do 2dup / dup dup tmp1 @ +\r
+ if 30 + emit 1 tmp1 !\r
+ else drop then\r
+ over * swap push - pop A /\r
+ loop 2drop tmp1 @ if\r
+ else 30 emit then ; rh tmp1\r
+\r
+var tmp1\r
+: . dup 0 < if 0 swap - 2D emit then\r
+tmp1 off 10000000\r
+8 do\r
+ 2dup / dup dup tmp1 @ +\r
+ if\r
+ emit 1 tmp1 !\r
+ else\r
+ drop\r
+ then\r
+ over * swap push - pop 10 /\r
+loop 2drop\r
+tmp1 @ if else 0 emit then ;\r
+rh tmp1\r
+\r
+: ? @ . ;\r
+: depth. depth . ;\r
+\r
+: score 800 do i 400 * i 14 + disk! loop ;\r
+: dump 10 do 4 do dup c@ . space 1+ loop cr loop drop ;\r
+\r
+var tmp1 var tmp2\r
+: rnd ( range -- result )\r
+tmp1 @ 17 * B + dup tmp1 !\r
+tmp2 @ over + 11 * 4 + dup tmp2 !\r
++ swap mod ; rh tmp1 rh tmp2\r
+\r
+100 const dynent \ dynamic memory support\r
+create dyntab dynent 8 * alloc\r
+create dynmem h @ 500000 + h !\r
+dynmem vari dynpn\r
+\r
+: dyntaba 8 * dyntab + ;\r
+: dynde dyntaba off ;\r
+: dynp dyntaba @ ;\r
+: dynp! dyntaba ! ;\r
+: dyns dyntaba 4 + @ ;\r
+: dyns! dyntaba 4 + ! ;\r
+\r
+var dync\r
+: dynal ( size -- handle )\r
+until\r
+ dync @ dup dynp 0 = if dup done then \ size dync\r
+ 1+ dup dynent = if drop 0 then\r
+ dync !\r
+loop \ size handle\r
+dynpn @ over dynp!\r
+2dup dyns!\r
+swap dynpn @ + dynpn ! ; rh dync\r
+\r
+: dynresize ( nsize handle -- )\r
+dup push dyns \ Nsize Osiz R: handle\r
+over < if \ Nsize R: handle\r
+ i dynp dup push over + push \ Nsize R: handle Oloc Nendloc\r
+ dyntab dynent\r
+ do\r
+ dup @ dup i3 >\r
+ if\r
+ i2 < if\r
+ pop drop i3 dynp dynpn @ dup i3\r
+ dynp! i3 dyns cmove 0 push\r
+ then\r
+ else\r
+ drop\r
+ then\r
+ 8 +\r
+ loop\r
+ drop pop pop 2drop\r
+then \ Nsize R: handle\r
+i dynp over + \ Nsize Nend R: handle\r
+dup dynpn @ > if\r
+ dynpn !\r
+else\r
+ drop\r
+then \ Nsize R: handle\r
+pop dyns! ;\r
+\r
+: dync@ ( addr dynhandle ) dynp + c@ ;\r
+: dync! ( num addr dynhandle ) dynp + c! ;\r
+: dyn@ dynp swap 4 * + @ ;\r
+: dyn! dynp swap 4 * + ! ;\r
+: dyncon dynal const ;\r
+\r
+: statdyn\r
+cr ." <hand>" tab. ." <addr>" tab. ." <size>"\r
+0 dyntab dynent\r
+do dup @ if cr swap dup . swap tab. dup @ . tab. dup 4 + @ . then 8 +\r
+swap 1+ swap loop\r
+2drop ;\r
+\r
+: dyn. ( dynhandle -- )\r
+ dup dynp swap dyns do\r
+ dup c@ emit 1+\r
+ loop drop ;\r
+\r
+rh dynent rh dyntab rh dynmem\r
+rh dyntaba rh dynpn\r
+\r
+: Dstralloc ( -- strh ) \ string support\r
+1 dynal dup dynp 0 swap c! ;\r
+\r
+: Dstral Dstralloc ; \ compatibility patch!\r
+\r
+: Dstrsure ( size strh -- )\r
+swap push\r
+dup dyns 1- \ strh len\r
+i < if\r
+ pop 20 + swap dynresize\r
+else\r
+ pop 2drop\r
+then ;\r
+\r
+: Dstrlen ( strh -- length )\r
+dynp c@ ;\r
+\r
+: c+Dstr ( chr strh -- )\r
+dup Dstrlen 1+ over Dstrsure\r
+dynp dup c@ 1+ \ chr addr len\r
+2dup swap c!\r
++ c! ;\r
+\r
+: c+lDstr ( chr strh -- )\r
+dup Dstrlen 1+ over Dstrsure\r
+dynp dup c@ \ addr len\r
+over 1+ dup 1+ rot cmove\r
+dup dup c@ 1+ swap c!\r
+1+ c! ;\r
+\r
+: Dstr. ( strh -- ) dynp write ;\r
+\r
+: Dstr2str ( strh mem -- )\r
+push dynp dup c@ 1+ \ Saddr len\r
+pop swap cmove ;\r
+\r
+: str2Dstr ( mem strh -- )\r
+over c@ 1+ dup push over Dstrsure \ mem strh\r
+pop do\r
+ over i + c@\r
+ over dynp i + c!\r
+loop 2drop ;\r
+\r
+: Dstr+str ( hand addr -- )\r
+dup c@ over + 1+ rot \ addr destaddr hand\r
+dynp count push \ addr destaddr src R: len\r
+swap i cmove \ addr R: len\r
+dup c@ pop + swap c! ;\r
+\r
+Dstralloc const defDstr\r
+Dstralloc const defDstr2\r
+: D" asc " scan pad defDstr str2Dstr defDstr ;\r
+: D> FF scan pad defDstr str2Dstr defDstr ;\r
+: D>2 FF scan pad defDstr2 str2Dstr defDstr2 ;\r
+\r
+: Dstr+Dstr ( hand1 hand2 -- )\r
+push push \ R: hand2 hand1\r
+i2 Dstrlen i Dstrlen \ len2 len1 R: hand2 hand1\r
+2dup + dup i2 dynp c! i2 Dstrsure\r
+pop dynp 1+ rot pop dynp 1+ + rot cmove ;\r
+\r
+: Dstrclear ( handle -- )\r
+0 over Dstrsure\r
+dynp 0 swap c! ;\r
+\r
+: Dstr2Dstr ( srchand desthand -- )\r
+dup Dstrclear Dstr+Dstr ;\r
+\r
+: Dstr asc " scan Dstralloc pad over str2Dstr const ;\r
+\r
+var tmploc\r
+: Dstrlscan ( char strh -- loc )\r
+tmploc off\r
+dynp 0 over c@ for \ char addr\r
+ 1+\r
+ 2dup c@ = if i 1+ tmploc ! forexit then\r
+loop\r
+2drop\r
+tmploc @ ;\r
+\r
+: Dstrrscan ( char strh -- loc )\r
+tmploc off dynp \ char addr len\r
+dup c@ do\r
+ 2dup 1+ i + c@ = if\r
+ i 1+ tmploc !\r
+ doexit\r
+ then\r
+loop 2drop\r
+tmploc @ ; rh tmploc\r
+\r
+: Dstrlscane ( char strh -- loc )\r
+dup Dstrlen push Dstrlscan\r
+dup if pop drop else drop pop 1+ then ;\r
+\r
+: Dstrleft ( amo strh -- )\r
+dup Dstrlen rot \ strh strlen amo\r
+0 swap rot bound \ strh ramo\r
+swap 2dup Dstrsure\r
+dynp c! ;\r
+\r
+: Dstrright ( amo strh -- ) \ unoptimized!\r
+dup Dstrlen rot \ strh strlen amo\r
+0 swap rot bound \ strh ramo\r
+swap 2dup Dstrsure\r
+push push \ R: strh ramo\r
+i2 dynp dup c@ \ loc len R: -,,-\r
+2dup i 1- - + \ loc len srcA R: -,,-\r
+rot 1+ rot drop i \ srcA dstA amo R: -,,-\r
+cmove pop pop \ ramo strh\r
+dynp c! ;\r
+\r
+: Dstrcutl ( amo strh -- )\r
+dup Dstrlen rot -\r
+dup 1 < if\r
+ drop Dstrclear\r
+else\r
+ swap Dstrright\r
+then ;\r
+\r
+var tmpdest var tmpsrc var tmpamo\r
+: Dstrsp ( char strhsrc strhdest -- )\r
+tmpdest ! dup tmpsrc ! \ char srchand\r
+Dstrlscane tmpamo !\r
+tmpsrc @ tmpdest @ Dstr2Dstr\r
+tmpamo @ dup tmpsrc @ Dstrcutl\r
+1- tmpdest @ Dstrleft ;\r
+rh tmpdest rh tmpsrc rh tmpamo\r
+\r
+: Dv ( addr -- ) Dstral swap ! ;\r
+: Df ( addr -- ) @ dynde ;\r
+\r
+24 400 * const fsroot \ filesystem support\r
+25 const fsfatbeg\r
+4000 const fsfatsiz\r
+fsfatsiz 4 * 400 / 1+ fsfatbeg + const fsdata\r
+asc f asc r asc e asc e to32bit const fsextfree\r
+asc l asc i asc s asc t to32bit const fsextlist\r
+\r
+Dstr \" fspath\r
+\r
+create dib 400 alloc\r
+-1 vari dibblock\r
+: dibload dup dibblock @ = if drop\r
+ else dup dibblock ! dib disk@ then ;\r
+: dibsave dup dibblock ! dib swap disk! ;\r
+\r
+var tmpfrom var tmpto var tmpamo var tmpramo\r
+: diskload ( fromdisk tomem amount -- )\r
+ tmpamo ! tmpto ! tmpfrom !\r
+ until\r
+ tmpamo @ if\r
+ tmpfrom @ 400 / dibload\r
+ 0 400 tmpfrom @ 400 mod dup push - tmpamo @ bound tmpramo !\r
+ dib pop + tmpto @ tmpramo @ 2dup + tmpto ! cmove\r
+ tmpamo @ tmpramo @ - tmpamo !\r
+ tmpfrom @ tmpramo @ + tmpfrom !\r
+ else\r
+ done\r
+ then\r
+ loop ;\r
+\r
+: disksave \ frommem todisk amount --\r
+ tmpamo ! tmpto ! tmpfrom !\r
+ until\r
+ tmpamo @ if\r
+ tmpto @ 400 / dibload\r
+ 0 400 tmpto @ 400 mod dup push - tmpamo @ bound tmpramo !\r
+ tmpfrom @ dib pop + tmpramo @ cmove dibblock @ dibsave\r
+ tmpamo @ tmpramo @ - tmpamo !\r
+ tmpfrom @ tmpramo @ + tmpfrom !\r
+ tmpto @ tmpramo @ + tmpto !\r
+ else\r
+ done\r
+ then\r
+ loop ; rh tmpamo rh tmpto rh tmpfrom rh tmpramo\r
+\r
+: fat@ 4 * dup push 400 / fsfatbeg + dibload pop 400 mod dib + @ ;\r
+: fat! 4 * dup push 400 / fsfatbeg + dibload pop 400 mod dib + !\r
+ dibblock @ dibsave ;\r
+\r
+var tmp1\r
+: fatfindf\r
+ until\r
+ tmp1 @ fat@ -1 = if tmp1 @ done then\r
+ tmp1 @ 1+ dup tmp1 !\r
+ fsfatsiz = if tmp1 off then\r
+ loop ; rh tmp1\r
+\r
+create formattmp i" listRootDireCtorYent" 0 , 0 , 0 ,\r
+: format ." formatting ... " fsfatsiz do\r
+ -1 i fat!\r
+ loop\r
+ -2 0 fat!\r
+ formattmp fsroot 20 disksave\r
+ ." done" cr ; rh formattmp\r
+\r
+20 const maxfiles\r
+create fshandles 11 maxfiles * alloc\r
+\r
+\ 0 4 - FileDescription\r
+\ 4 4 - FileSize\r
+\ 8 4 - CurrentLocation\r
+\ 12 4 - CurrentSector\r
+\ 16 1 - updated\r
+\r
+: fsDfiledesc@ 11 * fshandles + @ ;\r
+: fsDfiledesc! 11 * fshandles + ! ;\r
+: fsDfilesize@ 11 * fshandles + 4 + @ ;\r
+: fsDfilesize! 11 * fshandles + 4 + ! ;\r
+: fsDcurloc@ 11 * fshandles + 8 + @ ;\r
+: fsDcurloc! 11 * fshandles + 8 + ! ;\r
+: fsDcursect@ 11 * fshandles + C + @ ;\r
+: fsDcursect! 11 * fshandles + C + ! ;\r
+: fsDupdated@ 11 * fshandles + 10 + c@ ;\r
+: fsDupdated! 11 * fshandles + 10 + c! ;\r
+\r
+: inithandles maxfiles do\r
+ -1 i fsDfiledesc!\r
+loop ; inithandles\r
+forget inithandles\r
+\r
+: statfile\r
+cr ." handle" tab. ." pnt" tab. ." size" tab. ." CurLoc"\r
+tab. ." CurSect" tab. ." updated?" cr\r
+0 maxfiles for\r
+ -1 i fsDfiledesc@ - if\r
+ i . tab.\r
+ i fsDfiledesc@ . tab.\r
+ i fsDfilesize@ . tab.\r
+ i fsDcurloc@ . tab.\r
+ i fsDcursect@ . tab.\r
+ i fsDupdated@ . cr\r
+ then\r
+loop ;\r
+\r
+: fsfreenext ( firstSector -- )\r
+ until\r
+ dup -2 = if\r
+ done\r
+ else\r
+ dup fat@ swap -1 swap fat!\r
+ then\r
+ loop drop ;\r
+\r
+create fsfiledesc 20 alloc\r
+: fsopen ( FileDescPnt -- handle )\r
+ maxfiles do\r
+ i fsDfiledesc@ -1 = if i doexit then\r
+ loop\r
+ swap dup fsfiledesc 20 diskload \ handle desc\r
+ over fsDfiledesc! \ handle\r
+ [ fsfiledesc 14 + ] @ over fsDcursect!\r
+ 0 over fsDcurloc!\r
+ 0 over fsDupdated!\r
+ [ fsfiledesc 18 + ] @ over fsDfilesize! ;\r
+\r
+: fspntdel ( FileDescPnt -- )\r
+dup fsfiledesc 20 diskload \ pnt\r
+[ fsfiledesc 14 + ] @ fsfreenext\r
+fsextfree fsfiledesc !\r
+fsfiledesc swap 20 disksave ;\r
+\r
+: fsclose ( handle -- )\r
+ dup fsDupdated@ if\r
+ push\r
+ i fsDfiledesc@ fsfiledesc 20 diskload\r
+ i fsDfilesize@ [ 18 fsfiledesc + ] !\r
+ fsfiledesc i fsDfiledesc@ 20 disksave\r
+ pop\r
+ then\r
+ -1 swap fsDfiledesc! ; rh fsfiledesc\r
+\r
+var tmpamo var tmpfrom var tmphand var tmploc var tmpramo var tmpsect\r
+var tmpmax\r
+: fssave \ fromMem toFhandle amount --\r
+ tmpamo !\r
+ dup fsDcurloc@ tmploc !\r
+ dup fsDcursect@ tmpsect !\r
+ tmphand ! tmpfrom !\r
+ until\r
+ tmpamo @ if\r
+ 0 400 tmploc @ 400 mod dup push - dup tmpmax ! tmpamo @\r
+ bound tmpramo !\r
+ tmpfrom @ tmpsect @ fsdata + 400 * pop + tmpramo @ disksave\r
+ tmpramo @ tmpmax @ = if\r
+ tmpsect @ fat@\r
+ dup -2 = if\r
+ drop\r
+ fatfindf\r
+ dup tmpsect @ fat!\r
+ -2 over fat!\r
+ then\r
+ tmpsect !\r
+ then\r
+ tmpramo @\r
+ tmpamo @ over - tmpamo !\r
+ tmploc @ over + tmploc !\r
+ tmpfrom @ + tmpfrom !\r
+ else\r
+ done\r
+ then\r
+ loop\r
+ tmphand @ push\r
+ tmploc @ i fsDcurloc!\r
+ tmpsect @ i fsDcursect!\r
+ -1 i fsDupdated!\r
+ tmploc @ i fsDfilesize@ max bound pop fsDfilesize! ;\r
+\r
+var tmpto\r
+: fsload \ fromFhandle toMem amount --\r
+ tmpamo ! tmpto !\r
+ dup fsDcurloc@ tmploc !\r
+ dup fsDcursect@ tmpsect !\r
+ tmphand !\r
+ until\r
+ tmpamo @ if\r
+ 0 400 tmploc @ 400 mod dup push - dup tmpmax ! tmpamo @\r
+ bound tmpramo !\r
+ tmpsect @ fsdata + 400 * pop + tmpto @ tmpramo @ diskload\r
+ tmpsect @ fat@\r
+ dup -2 = if\r
+ drop\r
+ else\r
+ tmpramo @ tmpmax @ = if tmpsect ! else drop then\r
+ then\r
+ tmpramo @\r
+ tmpamo @ over - tmpamo !\r
+ tmploc @ over + tmploc !\r
+ tmpto @ + tmpto !\r
+ 0 tmploc @ tmphand @ fsDfilesize@ bound tmploc !\r
+ else\r
+ done\r
+ then\r
+ loop\r
+ tmphand @\r
+ tmploc @ over fsDcurloc!\r
+ tmpsect @ swap fsDcursect! ;\r
+\r
+rh tmpamo rh tmpfrom rh tmphand rh tmploc rh tmpramo rh tmpsect rh tmpto\r
+rh tmpmax\r
+\r
+: fsabsloc ( handle -- loc )\r
+dup fsDcursect@ fsdata + 400 *\r
+swap fsDcurloc@ 400 mod + ;\r
+\r
+var tmppnt var tmphand var curhand var tmpsect\r
+create tmpFdesc 21 alloc\r
+: fspntcreate ( dynHand descPnt -- newFileDescPnt )\r
+tmppnt ! tmphand !\r
+tmppnt @ fsopen curhand !\r
+until\r
+ curhand @ fsDfilesize@ curhand @ fsDcurloc@ 20 + >= if\r
+ curhand @ fsDcursect@ tmpsect !\r
+ curhand @ tmpFdesc 20 fsload\r
+ tmpFdesc @ fsextfree = if\r
+ curhand @ fsDcurloc@ 20 - curhand @ fsDcurloc!\r
+ tmpsect @ curhand @ fsDcursect!\r
+ done\r
+ then\r
+ else\r
+ done\r
+ then\r
+loop\r
+FF tmpFdesc 20 cfill\r
+0 [ tmpFdesc 18 + ] !\r
+fatfindf -2 over fat! [ tmpFdesc 14 + ] !\r
+0 tmphand @ dync@ do\r
+ i 1+ tmphand @ dync@\r
+ dup asc \ = if drop FF then\r
+ tmpFdesc i + c!\r
+loop\r
+curhand @ fsabsloc\r
+ tmpFdesc curhand @ 20 fssave\r
+ curhand @ fsclose ;\r
+rh tmppnt rh tmphand rh curhand rh tmpsect\r
+\r
+: fseof ( handle -- bytesLeft )\r
+dup fsDfilesize@ swap fsDcurloc@ - ;\r
+\r
+create tmppath FF alloc\r
+var tmppnt var tmphand var tmploc\r
+: fsgetdesc ( dynhand -- DescPnt)\r
+tmppath off\r
+0 over dync@ if\r
+ 1 over dync@ asc \ = if dup tmppath Dstr2str then\r
+then\r
+tmppath c@ 0 = if\r
+ fspath tmppath Dstr2str\r
+ dup tmppath Dstr+str\r
+then\r
+drop\r
+fsroot tmppnt !\r
+until\r
+ tmppath c@ if\r
+ tmppath c@ push\r
+ 1 i 2 + for\r
+ i 1- tmppath c!\r
+ tmppath i + c@ asc \ = if forexit then\r
+ loop\r
+ \ tmppath write cr\r
+ tmppath c@ if\r
+ tmppnt @ fsopen tmphand !\r
+ until\r
+ tmphand @ fseof 20 >= if\r
+ tmphand @ fsabsloc tmploc !\r
+ tmphand @ [ tmpFdesc 1+ ] 20 fsload\r
+ 15 do\r
+ i tmpFdesc c!\r
+ tmpFdesc i + c@ FF -\r
+ if doexit then\r
+ loop\r
+ tmpFdesc tmppath str=str? if\r
+ tmploc @ tmppnt !\r
+ done\r
+ then\r
+ else\r
+ -1 tmppnt !\r
+ done\r
+ then\r
+ loop\r
+ tmphand @ fsclose\r
+ else\r
+ fsroot tmppnt !\r
+ then\r
+ tmppath c@ dup push [ tmppath 1+ ] + tmppath i2 cmove\r
+ pop pop swap - 1-\r
+ dup -1 = if drop 0 then tmppath c!\r
+ else\r
+ done\r
+ then\r
+ tmppnt @ -1 = if done then\r
+loop\r
+tmppnt @ ; rh tmppath rh tmppnt rh tmphand rh tmploc\r
+\r
+1 vari tmpdepth var tmploc\r
+: fspntls ( recursive? descpnt -- )\r
+fsopen\r
+until \ handle\r
+ dup fseof 20 >= if\r
+ dup fsabsloc tmploc !\r
+ dup tmpFdesc 20 fsload\r
+ tmpFdesc @ fsextfree - if\r
+ [ tmpFdesc 18 + ] @ .\r
+ tmpdepth @ do tab. loop\r
+ tmpFdesc 14 type cr\r
+ then\r
+ over if\r
+ tmpFdesc @ fsextlist = if\r
+ tmpdepth @ 1+ tmpdepth !\r
+ -1 tmploc @ fspntls\r
+ tmpdepth @ 1- tmpdepth !\r
+ then\r
+ then\r
+ else\r
+ done\r
+ then\r
+loop\r
+fsclose drop ; rh tmpFdesc rh tmpdepth rh tmploc\r
+\r
+: tmpls ." PATH: " fspath dup Dstr. cr fsgetdesc fspntls ;\r
+: fslsr -1 tmpls ;\r
+: fsls 0 tmpls ;\r
+rh tmpls\r
+\r
+: fscl ( dynhand -- )\r
+push\r
+i Dstrlen if\r
+ 1 i dync@ asc \ = if\r
+ i fspath Dstr2Dstr\r
+ else\r
+ i fspath Dstr+Dstr\r
+ then\r
+then pop drop ;\r
+\r
+var tmpstr1 var tmpstr2 var tmpstrpath var tmppnt\r
+: fscreate ( dynhand -- descpnt )\r
+tmpstr1 Dv tmpstr2 Dv tmpstrpath Dv\r
+fspath tmpstrpath @ Dstr2Dstr\r
+tmpstr1 @ Dstr2Dstr\r
+until\r
+ tmpstr1 @ Dstrlen if\r
+ asc \ tmpstr1 @ tmpstr2 @ Dstrsp\r
+ asc \ tmpstr2 @ c+Dstr\r
+\ tmpstr2 @ Dstr. cr\r
+ tmpstr2 @ fsgetdesc\r
+ dup -1 = if\r
+ drop\r
+ tmpstr2 @ fspath fsgetdesc fspntcreate\r
+ then\r
+ tmppnt !\r
+ tmpstr2 @ fscl\r
+ else\r
+ done\r
+ then\r
+loop\r
+tmppnt @\r
+tmpstrpath @ fspath Dstr2Dstr\r
+tmpstr1 Df tmpstr2 Df tmpstrpath Df ;\r
+rh tmpstr1 rh tmpstr2 rh tmpstrpath rh tmppnt\r
+\r
+: fstrunc ( Fhandle -- )\r
+-1 over fsDupdated!\r
+dup fsDcurloc@ over fsDfilesize!\r
+fsDcursect@ \ sect\r
+dup fat@ dup 0 >= if\r
+ fsfreenext\r
+else\r
+ drop\r
+then\r
+-2 swap fat! ;\r
+\r
+: fsDsave ( Dynhand Dstr -- )\r
+fscreate fsopen \ datahand filehand\r
+dup fstrunc\r
+dup rot \ filehand filehand datahand\r
+dup dynp rot \ filehand datahand from filehand\r
+rot dyns fssave \ fh\r
+fsclose ;\r
+\r
+: fsDload ( Dstr Dynhand -- )\r
+push fsgetdesc fsopen \ Fhand R: Dhand\r
+dup fsDfilesize@ dup i dynresize \ Fhand Fsize R: Dhand\r
+over pop dynp rot fsload \ Fhand\r
+fsclose ;\r
+\r
+: fsDloadnew ( Dstr -- Dynhand )\r
+1 dynal swap over fsDload ;\r
+\r
+1E8480 const tmpfrom\r
+var tmplen var tmpdyn var tmpstr\r
+: fsimport\r
+tmpfrom tmplen 4 diskload\r
+tmplen @ if\r
+ ." file length: " tmplen @ dup .\r
+ dynal tmpdyn !\r
+ tmpstr Dv\r
+ F0 tmpstr @ Dstrsure\r
+ [ tmpfrom 4 + ] tmpstr @ dynp F0 over c! 1+ F0 diskload\r
+ FE tmpstr @ Dstrlscan 1- tmpstr @ Dstrleft\r
+ ." file: " tmpstr @ Dstr.\r
+ ." importing ..."\r
+ [ tmpfrom 64 + ] tmpdyn @ dynp tmplen @ diskload\r
+ tmpdyn @ tmpstr @ fsDsave\r
+ ." done" cr\r
+ tmpdyn Df tmpstr Df\r
+ tmplen off\r
+ tmplen tmpfrom 4 disksave\r
+then ;\r
+rh tmplen rh tmpfrom rh tmpdyn rh tmpstr\r
+\r
+: fsdel ( Dstr -- ) fsgetdesc dup -1 - if fspntdel else drop then ;\r
+\r
+: fscopy ( Dstr1 Dstr2 -- ) swap fsDloadnew dup rot fsDsave dynde ;\r
+\r
+: fsmove ( Dstr1 Dstr2 -- ) over swap fscopy fsdel ;\r
+\r
+: fsgettop ( Dstr1 Dstr2 -- )\r
+2dup Dstr2Dstr nip \ Dstr2\r
+asc \ over Dstrrscan \ Dstr2 CharLoc\r
+swap Dstrcutl ;\r
+\r
+create incfiles 80 alloc \ File inclusion support\r
+-1 vari inccur\r
+\r
+: dyninc ( dynhandle -- )\r
+inccur @ 1+ dup inccur ! \ hand cur\r
+8 * incfiles + dup 4 + 0 swap ! ! ;\r
+\r
+: include ( StrHand<filename> -- )\r
+fsDloadnew dyninc ;\r
+\r
+defer cmdline\r
+\r
+: (fkey\r
+inccur @ 8 * incfiles + dup @ ( adr handle )\r
+dup dyns rot ( handle size adr )\r
+4 + @ > if ( handle )\r
+ inccur @ 8 * incfiles + 4 + dup @ ( handle adr+4 pointer )\r
+ dup 1+ rot ! ( handle pointer )\r
+ swap dynp + c@\r
+else\r
+ dynde\r
+ inccur @ 1 - dup inccur !\r
+ 0 < if cmdline then FF\r
+then ;\r
+\r
+var tmpstr\r
+: modulechk ( Dstr -- )\r
+tmpstr Dv\r
+dup tmpstr @ fsgettop\r
+asc # tmpstr @ c+lDstr\r
+tmpstr @ pad Dstr2str \ Dstr\r
+find if\r
+ drop\r
+else\r
+ tmpstr @ pad Dstr2str\r
+ here 0 ne\r
+ include\r
+then\r
+tmpstr Df ; rh tmpstr\r
+\r
+.( test test test ... )\r
+\r
+\ format\r
+\ fsimport cr\r
+\r
+D" listF\5TH_AUTORUN" include\r
+' (fkey ' fkey is\r
--- /dev/null
+.( testgraph - simple graphic test)\r
+: testgraph\r
+10 40 10 40 screen FF 0 0 calccol boxf\r
+50 80 50 80 screen 0 FF 0 calccol boxf\r
+90 C0 10 40 screen 0 0 FF calccol boxf ;\r
+\r
+.( testmouse - simple mouse test)\r
+var tmp1 var tmp2 var tmpc\r
+: testmouse\r
+50 tmp1 !\r
+50 tmp2 !\r
+until\r
+ kb@ if done then\r
+ mouse@\r
+ dup 0 = if [ FF FF FF calccol ] tmpc ! then\r
+ dup 1 = if [ 00 FF FF calccol ] tmpc ! then\r
+ dup 2 = if [ FF 00 FF calccol ] tmpc ! then\r
+ 3 = if [ FF FF 00 calccol ] tmpc ! then\r
+ tmp2 @ + tmp2 ! tmp1 @ + tmp1 !\r
+ 10 tmp1 @ 26F bound tmp1 !\r
+ 10 tmp2 @ 1CF bound tmp2 !\r
+ tmp1 @ dup 5 + tmp2 @ dup 5 + screen tmpc @ boxf update\r
+loop ; rh tmp1 rh tmp2 rh tmpc\r
--- /dev/null
+.( loading graphic editor ) update\r
+\r
+D> \listF\listLIB\5TH_GFX2 modulechk\r
+D> \listF\listLIB\5TH_DRVMOUSE modulechk\r
+\r
+.( <file> gedit - load existing image )\r
+.( <Xsize> <Ysize> geditnew - start new image )\r
+.( EGh - graphic editor help )\r
+\r
+var ghandle\r
+var sizex var sizey\r
+var zoomx var zoomy\r
+var zoomup\r
+var zoom\r
+var selcol\r
+var gbrush\r
+1 vari geditcycdir\r
+5 vari geditcyccur\r
+\r
+Dstral const EGfile\r
+str F1 - help" msghelp\r
+str pick the color" msgpick\r
+str draw pixels" msgpix\r
+str fill with color" msgfill\r
+Dstr \listF\TXT_EG" tmphlpfile\r
+\r
+\r
+: EGh tmphlpfile fs. ;\r
+\r
+: gclose ghandle @ dup if dynde\r
+ghandle off else drop then ;\r
+\r
+: geditmsg ( addr -- )\r
+ghandle @ emitscreen !\r
+1A 3B at! 14 do space loop\r
+1A 3B at! write\r
+screen emitscreen ! ;\r
+\r
+: zoomupdate\r
+zoom @ if\r
+ 14 do\r
+ 14 do\r
+ i 4 * 226 + dup 4 + i2 4 * 1+ dup 4 + ghandle @\r
+ i zoomx @ + i2 zoomy @ + screen point c@ boxf\r
+ loop\r
+ loop\r
+then ;\r
+\r
+: selcoldisp 226 27F 55 64 ghandle @ selcol @ boxf ;\r
+\r
+var tmp1\r
+: grinit\r
+ghandle @ 0 = if 280 1E0 imgalloc ghandle ! then\r
+ghandle @ cls\r
+tmp1 off ( display palette )\r
+24 do\r
+ 6 do\r
+ i2 5 * dup 5 + i 5 * 1C2 + dup 5 + ghandle @\r
+ tmp1 @ boxf\r
+ tmp1 @ 1+ tmp1 !\r
+ loop\r
+loop\r
+[ FF FF FF calccol ] sizex @ 1+ 0 sizey @ 1+ 0 ghandle @ box\r
+[ FF FF FF calccol ] 276 225 51 0 ghandle @ box\r
+[ FF FF FF calccol ] selcol ! selcoldisp\r
+B4 C8 1C2 1DF ghandle @ FF boxf\r
+msghelp geditmsg ; rh tmp1\r
+\r
+: geditpict ( x y -- )\r
+push push\r
+1 i sizex @ bound? if\r
+1 i2 sizey @ bound? if\r
+ gbrush @\r
+ dup 2 = if selcol @ i i2 ghandle @ pset zoomup on then\r
+ 3 = if sizex @ sizey @ imgalloc\r
+ ghandle @ dynp over dynp -1 -1 vidput\r
+ dup push\r
+ selcol @ i2 1- i3 1- pop imgfill\r
+ dup dynp ghandle @ dynp 1 1 vidput\r
+ dynde\r
+ zoomup on then\r
+then then\r
+pop pop 2drop ;\r
+\r
+: gsavepict\r
+sizex @ sizey @ imgalloc ( imgbuf )\r
+ghandle @ dynp over dynp -1 -1 vidput\r
+dup EGfile fsDsave\r
+dynde ;\r
+\r
+: ged\r
+ghandle @ if\r
+until\r
+ ghandle @ dynp screen dynp 4B008 cmove\r
+ zoomup @ if zoomupdate zoomup off then\r
+\r
+ KBD_F@ dup 1+ if\r
+ dup 400 = if done then ( ESC )\r
+ dup 401 = if tmphlpfile fsdisp then ( F1 )\r
+ dup 402 = if gsavepict then ( F2 )\r
+ dup 405 = if msgpick geditmsg 1 gbrush ! then ( F5 )\r
+ dup 406 = if msgpix geditmsg 2 gbrush ! then ( F6 )\r
+ 407 = if msgfill geditmsg 3 gbrush ! then ( F7 )\r
+ else drop then\r
+\r
+ mousekeyr @ if\r
+ 0 mousex @ A - sizex @ 12 - bound zoomx !\r
+ 0 mousey @ A - sizey @ 12 - bound zoomy !\r
+ zoom on\r
+ ghandle @ emitscreen !\r
+ 45 1D at!\r
+ zoomx @ . space\r
+ zoomy @ . space space space space\r
+ screen emitscreen !\r
+ zoomupdate\r
+ then\r
+\r
+ mousekeyl @ if\r
+ gbrush @ 1 = if\r
+ mousex @ mousey @ ghandle @ point\r
+ c@ selcol ! selcoldisp\r
+ else\r
+ 225 mousex @ 276 bound? if\r
+ 0 mousey @ 51 bound? if\r
+ mousex @ 225 - 4 / zoomx @ +\r
+ mousey @ 1- 4 / zoomy @ + geditpict\r
+ then then\r
+ mousex @ mousey @ geditpict\r
+ then\r
+ then\r
+\r
+ mousedo\r
+ update\r
+\r
+ geditcyccur @ geditcycdir @ + dup geditcyccur !\r
+ dup dup dup FF setpal\r
+ 1 swap 3E bound? 0 = if geditcycdir @ neg geditcycdir ! then\r
+loop\r
+screen cls\r
+else\r
+." no picture loaded" then ;\r
+\r
+: gedit ( file -- )\r
+dup EGfile str2Dstr ! fsDloadnew ( imgbuf )\r
+dup imgsize sizey ! sizex ! grinit\r
+dup dynp ghandle @ dynp 1 1 vidput\r
+dynde ged ;\r
+\r
+: geditnew ( xsize ysize -- )\r
+sizey ! sizex !\r
+grinit ged ;\r
+\r
+\r
+rh tmphlpfile\r
+rh ghandle\r
+rh sizex rh sizey\r
+rh zoomx rh zoomy\r
+rh zoomup rh zoom\r
+rh gclose rh geditmsg\r
+rh zoomupdate rh selcoldisp\r
+rh grinit rh geditpict\r
+rh gsavepict rh ged\r
+rh selcol\r
+rh msghelp rh msgpix rh msgpick rh msgfill\r
+rh gbrush\r
+rh geditcycdir rh geditcyccur\r
+rh EGfile\r
--- /dev/null
+.( loading editor ) update\r
+.( done )\r
+.( ETh - for text editor help )\r
+\r
+var handletxt\r
+var handlebuf\r
+Dstralloc const editfile\r
+var shiftx var shifty\r
+var curlocx var curlocy\r
+Dstr \listF\TXT_ET" tmphelpfile\r
+\r
+: disppage ( -- )\r
+handletxt @\r
+dynp shifty @ 50 * +\r
+0 1 at!\r
+1270 type ;\r
+\r
+: fclose ( close opened file )\r
+handletxt @ dup if dynde handletxt off else drop then ;\r
+\r
+: ETnewpage fclose 27100 dynal dup handletxt ! dynp\r
+FF swap 27100 cfill ;\r
+\r
+var tmp1\r
+: fopen ( strhand -- )\r
+fclose\r
+dup editfile Dstr2Dstr fsDloadnew dup push dynp ( addrinp R: handinp )\r
+27100 dynal dup handletxt ! dynp ( addrinp addrout R: handinp )\r
+FF over 27100 cfill\r
+tmp1 off\r
+i dyns do ( addrinp addrout )\r
+over c@ ( addrinp addrout c )\r
+dup FE = if\r
+ drop\r
+ 50 tmp1 @ - + tmp1 off\r
+else\r
+ dup FD = if\r
+ drop tmp1 @ tab ( addrinp addrout numspaces )\r
+ tmp1 @ over + tmp1 ! + 0\r
+ else\r
+ over c! 1+ 0\r
+ tmp1 @ 1+ tmp1 !\r
+ then\r
+ drop\r
+then\r
+swap 1+ swap\r
+loop 2drop\r
+pop dynde ; rh tmp1\r
+\r
+: dispchar ( x y -- )\r
+2dup\r
+swap shiftx @ -\r
+swap shifty @ - 1+\r
+at!\r
+50 * + handletxt @ dynp + c@ emit ;\r
+\r
+: dispcur curlocx @ curlocy @ dispchar ;\r
+\r
+: displine ( line )\r
+0 over shifty @ - 1+ at!\r
+50 * handletxt @ dynp + shiftx @ + 50 type ;\r
+\r
+: dispstatbar\r
+colneg\r
+0 0 at! 50 do space loop\r
+0 0 at! ." col:" curlocx @ .\r
+7 0 at! ." line:" curlocy @ .\r
+11 0 at! ." ascii:" curlocy @ 50 * curlocx @ + handletxt @ dynp + c@ .\r
+1B 0 at! ." file:" editfile Dstr.\r
+49 0 at! ." F1-help"\r
+colnorm ;\r
+\r
+: charins ( char x y )\r
+50 * handletxt @ dynp + ( char x addr )\r
+over push\r
++ dup dup 1+ 4F pop - cmove ( char addr )\r
+c! ;\r
+\r
+: charcut ( x y -- char )\r
+over push\r
+50 * handletxt @ dynp + +\r
+dup c@ swap ( char addr )\r
+dup dup 1+ swap ( char addr addr+1 addr )\r
+4F pop - dup push cmove ( char addr )\r
+pop + FF swap c! ;\r
+\r
+: lineins ( line )\r
+50 * dup push handletxt @ dynp + ( addr )\r
+dup dup 50 + handletxt @ dyns 50 - pop - cmove ( addr )\r
+FF swap 50 cfill ;\r
+\r
+: linecut ( line )\r
+50 * dup push handletxt @ dynp + ( addr )\r
+dup 50 + swap handletxt @ dyns 50 - pop - cmove ;\r
+\r
+: screenaim\r
+0 curlocy @ 1E - 794 bound shifty !\r
+disppage ;\r
+\r
+var tmp1\r
+: length ( line -- length )\r
+50 * 4F + handletxt @ dynp + ( addr )\r
+51 do\r
+ i tmp1 !\r
+ dup c@ FF - if pop drop 0 push then\r
+ 1-\r
+loop\r
+drop\r
+tmp1 @ ; rh tmp1\r
+\r
+var tmp2 var tmp3\r
+: fsavechar ( char ) tmp2 @ swap over c! 1+ tmp2 ! ;\r
+: fsave ( -- )\r
+27200 dynal dup dynp tmp2 !\r
+0\r
+7CF do\r
+ i length if drop pop 1+ 0 push then\r
+loop\r
+0 swap for ( desthand )\r
+ tmp3 off\r
+ i 50 * handletxt @ dynp +\r
+ 0 i length for ( desthand srcaddr )\r
+ dup c@\r
+ i tab 8 = if tmp3 @ if FD fsavechar tmp3 off then then\r
+ dup FF = if\r
+ drop tmp3 @ 1+ tmp3 !\r
+ else\r
+ tmp3 @ do FF fsavechar loop tmp3 off\r
+ fsavechar\r
+ then\r
+ 1+\r
+ loop drop\r
+ FE fsavechar\r
+loop\r
+tmp2 @ over dynp - over dynresize\r
+dup editfile fsDsave\r
+dynde ; rh tmp2 rh tmp3\r
+\r
+str TXT_default" tmpdefault\r
+\r
+: ET\r
+handletxt @ if\r
+disppage\r
+until\r
+ colneg dispcur dispstatbar KBD_FW@ colnorm dispcur\r
+\r
+ dup 415 = if ( DEL )\r
+ curlocx @ curlocy @ charcut drop\r
+ curlocy @ displine\r
+ then\r
+\r
+ dup FC = if ( BACKSPACE )\r
+ curlocx @ if\r
+ curlocx @ 1- curlocy @ charcut drop\r
+ curlocy @ displine\r
+ drop 413\r
+ else\r
+ curlocy @ if\r
+ curlocy @ 1- dup length dup curlocx ! ( y-1 strlen )\r
+ swap 50 * handletxt @ dynp + ( strlen y1addr )\r
+ 2dup + swap 50 + ( strlen dest src )\r
+ swap rot 50 swap - cmove\r
+ curlocy @ linecut\r
+ drop 410\r
+ disppage\r
+ then\r
+ then\r
+ then\r
+\r
+ dup FD = if ( TAB )\r
+ curlocx @ tab\r
+ dup do FF curlocx @ curlocy @ charins loop\r
+ curlocx @ + curlocx !\r
+ curlocy @ displine\r
+ then\r
+\r
+ dup FE = if ( ENTER )\r
+ curlocy @ 7CF < if\r
+ curlocy @ 1+ lineins\r
+ curlocx @ 0\r
+ 50 curlocx @ - do\r
+ over curlocy @ charcut\r
+ over curlocy @ 1+ charins\r
+ 1+\r
+ loop 2drop\r
+ curlocx off\r
+ drop 412\r
+ disppage\r
+ then\r
+ then\r
+\r
+ dup 418 = if curlocy @ 3A - curlocy ! then ( PG-UP )\r
+ dup 419 = if curlocy @ 3A + curlocy ! then ( PG-DOWN )\r
+ dup 416 = if curlocx off then ( HOME )\r
+ dup 417 = if curlocy @ length curlocx ! then ( END )\r
+ dup 401 = if tmphelpfile fsdisp disppage then ( F1 )\r
+ dup 402 = if fsave then ( F2 )\r
+ dup 403 = if fclose drop 1B then ( F3 )\r
+ dup 400 = if done 0 0 at! screen cls drop -1 then ( ESC )\r
+\r
+ 0 over F0 bound? if -1 else 0 then ( NORMAL KEY )\r
+ over FF = if drop -1 then\r
+ if\r
+ curlocx @ curlocy @ charins\r
+ curlocy @ displine\r
+ 411\r
+ then\r
+\r
+ dup 411 = if curlocx @ 1+ curlocx ! then ( RIGHT )\r
+ dup 413 = if curlocx @ 1- curlocx ! then ( LEFT )\r
+ dup 412 = if curlocy @ 1+ curlocy ! then ( DOWN )\r
+ dup 410 = if curlocy @ 1- curlocy ! then ( UP )\r
+ drop\r
+\r
+ 0 curlocx @ 4F bound curlocx !\r
+ 0 curlocy @ 7CF bound curlocy !\r
+\r
+ curlocy @ shifty @ - 3B > if screenaim then\r
+\r
+ curlocy @ shifty @ - 3B - 0 = if\r
+ 0 0 8 screen scrollf\r
+ shifty @ 1+ shifty !\r
+ curlocy @ displine\r
+ then\r
+\r
+ curlocy @ shifty @ - -1 < if screenaim then\r
+\r
+ curlocy @ shifty @ - 1+ 0 = if\r
+ 0 0 -8 screen scrollf\r
+ shifty @ 1- shifty !\r
+ curlocy @ displine\r
+ then\r
+\r
+loop\r
+else\r
+ tmpdefault editfile str2Dstr\r
+ ETnewpage\r
+ ET\r
+then ;\r
+\r
+: ETl\r
+fopen\r
+curlocx off\r
+curlocy off\r
+shiftx off\r
+shifty off\r
+ET ;\r
+\r
+: ETs\r
+editfile Dstr2Dstr\r
+fsave ." saved " ;\r
+\r
+: ETh tmphelpfile fs. ;\r
+\r
+rh handletxt\r
+rh handlebuf\r
+rh editfile\r
+rh shiftx rh shifty\r
+rh curlocx rh curlocy\r
+rh tmphelpfile\r
+rh disppage\r
+rh fclose rh fopen\r
+rh dispchar rh dispcur\r
+rh displine rh dispstatbar\r
+rh charins rh charcut\r
+rh lineins rh linecut\r
+rh screenaim rh length\r
+rh fsavechar rh fsave\r
+rh ETnewpage rh tmpdefault\r
--- /dev/null
+: tmpbox ( x y -- )\r
+10 * swap 10 * \ y x\r
+dup 9 + rot dup 9 + \ x1 x2 y1 y2\r
+screen FF FF FF calccol boxf ;\r
+\r
+: tmplineh ( x y -- )\r
+swap 1+ swap 2dup tmpbox\r
+swap 1+ swap tmpbox ;\r
+\r
+: tmplinev ( x y -- )\r
+1+ 2dup tmpbox\r
+1+ tmpbox ;\r
+\r
+: tmpI ( x y -- )\r
+2dup tmplinev\r
+3 + 2dup tmplinev\r
+tmpbox ;\r
+\r
+: tmpT ( x y -- )\r
+2dup tmpI\r
+tmplineh ;\r
+\r
+: tmpF ( x y -- )\r
+2dup tmpT\r
+3 + tmplineh ;\r
+\r
+: tmpH ( x y -- )\r
+2dup tmpI\r
+2dup 3 + tmplineh\r
+swap 3 + swap tmpI ;\r
+\r
+: tmpxp\r
+swap 5 + swap ;\r
+\r
+: tmplogo ( x y -- )\r
+2dup tmpF tmpxp\r
+2dup tmpI tmpxp\r
+2dup tmpF tmpxp\r
+2dup tmpT tmpxp\r
+tmpH ;\r
+\r
+7 3 tmplogo\r
+0 18 at!\r
+.( Fifth, Copyright 2003 Svjatoslav Agejenko. All rights reserved.)\r
+forget tmpbox\r
+update\r
--- /dev/null
+: KBD_test\r
+until\r
+ kbd@\r
+ dup 1 = if done then\r
+ dup if\r
+ . tab. update\r
+ else\r
+ drop\r
+ then\r
+loop ;\r
+\r
+\r
+create KBD_downbuf 80 alloc\r
+\r
+: KBD_@\r
+until\r
+ kbd@\r
+ dup if\r
+ dup 80 >= if\r
+ [ KBD_downbuf 80 - ] + 0 swap c!\r
+ else\r
+ dup KBD_downbuf + 1 swap c! done\r
+ then\r
+ else\r
+ done\r
+ then\r
+loop ;\r
+\r
+: KBD_down? ( KeyScanCode -- result )\r
+KBD_downbuf + c@ ;\r
+\r
+rh KBD_downbuf\r
+\r
+str \listF\listLIB\5TH_KBD_USDVORAK" tmp1\r
+str \listF\listLIB\5TH_KBD_US" tmp2\r
+\r
+.( Select keyboard layout, by pressing appropriate number. )\r
+.( 1 - US dvorak )\r
+.( 2 - US )\r
+\r
+: tmpselect\r
+until\r
+ KBD_@\r
+ dup 2 = if tmp1 swap done then\r
+ dup 3 = if tmp2 swap done then\r
+ drop\r
+loop ;\r
+\r
+update\r
+tmpselect\r
+.( selected )\r
+update\r
+\r
+defDstr str2Dstr\r
+forget tmp1\r
+defDstr include\r
+\r
+: KBD_test2\r
+until\r
+ KBD_@\r
+ dup 1 = if done then\r
+ dup if\r
+ . tab. update\r
+ else\r
+ drop\r
+ then\r
+loop ;\r
+\r
+: KBD_SC2FSCII ( ScanCode -- FSCII )\r
+KBD_table swap until \ addr code\r
+ over @ dup if\r
+ over = if\r
+ drop 4 + @ done\r
+ else\r
+ swap 8 + swap\r
+ then\r
+ else\r
+ 2drop drop -1 done\r
+ then\r
+loop ;\r
+\r
+: KBD_F@\r
+KBD_@\r
+2A KBD_down? if 100 + then\r
+38 KBD_down? if 200 + then\r
+KBD_SC2FSCII ;\r
+\r
+: KBD_FW@ update\r
+until\r
+ KBD_F@\r
+ dup -1 = if drop else done then\r
+loop ;\r
--- /dev/null
+var mousex\r
+var mousey\r
+var mousekeyl\r
+var mousekeyr\r
+var mousekeym\r
+var mousec ( display coordinates flag )\r
+create mousebuf 100 alloc\r
+var mousebe ( amount of buffer elements )\r
+var mousepointer\r
+D> \listF\I01_MCARROW fsDloadnew mousepointer !\r
+\r
+: mouseadd ( addr x1 x2 y1 y2 -- )\r
+mousebe @ dup 1+ mousebe !\r
+14 * mousebuf + ( ... addr )\r
+swap over !\r
+4 + swap over !\r
+4 + swap over !\r
+4 + swap over !\r
+4 + ! ;\r
+\r
+: mousedo ( -- )\r
+mouse@\r
+dup 0 bit@ if mousekeyl on else mousekeyl off then\r
+dup 1 bit@ if mousekeyr on else mousekeyr off then\r
+ 2 bit@ if mousekeym on else mousekeym off then\r
+\r
+mousey @ + 0 swap 1DF bound mousey !\r
+mousex @ + 0 swap 27F bound mousex !\r
+\r
+mousepointer @ dynp\r
+screen dynp mousex @ mousey @ tvidput\r
+\r
+mousekeyl @ mousekeyr @ + mousekeym @ + if\r
+mousebe @ do\r
+ i 14 * mousebuf +\r
+ dup @ swap 4 + @ mousey @ rot bound? if\r
+ i 14 * mousebuf + 8 +\r
+ dup @ swap 4 + @ mousex @ rot bound? if\r
+ i 14 * mousebuf + 10 + @ goto pop drop 0 push\r
+ then\r
+ then\r
+loop\r
+then\r
+\r
+mousec @ if\r
+ emitscreen @\r
+ screen emitscreen !\r
+ at@\r
+ 0 0 at!\r
+ mousex @ . tab. mousey @ .\r
+ at!\r
+ emitscreen !\r
+then ;\r
--- /dev/null
+create KBD_table\r
+\r
+2 , asc 1 , 102 , asc ! ,\r
+3 , asc 2 , 103 , asc @ ,\r
+4 , asc 3 , 104 , asc # ,\r
+5 , asc 4 , 105 , asc $ ,\r
+6 , asc 5 , 106 , asc % ,\r
+7 , asc 6 , 107 , asc ^ ,\r
+8 , asc 7 , 108 , asc & ,\r
+9 , asc 8 , 109 , asc * ,\r
+A , asc 9 , 10A , asc ( ,\r
+B , asc 0 , 10B , asc ) ,\r
+C , asc - , 10C , asc _ ,\r
+D , asc = , 10D , asc + ,\r
+E , FC , \ backspace\r
+F , FD , \ tab\r
+10 , asc q , 110 , asc Q ,\r
+11 , asc w , 111 , asc W ,\r
+12 , asc e , 112 , asc E ,\r
+13 , asc r , 113 , asc R ,\r
+14 , asc t , 114 , asc T ,\r
+15 , asc y , 115 , asc Y ,\r
+16 , asc u , 116 , asc U ,\r
+17 , asc i , 117 , asc I ,\r
+18 , asc o , 118 , asc O ,\r
+19 , asc p , 119 , asc P ,\r
+1A , asc [ , 11A , asc { ,\r
+1B , asc ] , 11B , asc } ,\r
+1C , FE , \ enter\r
+1E , asc a , 11E , asc A ,\r
+1F , asc s , 11F , asc S ,\r
+20 , asc d , 120 , asc D ,\r
+21 , asc f , 121 , asc F ,\r
+22 , asc g , 122 , asc G ,\r
+23 , asc h , 123 , asc H ,\r
+24 , asc j , 124 , asc J ,\r
+25 , asc k , 125 , asc K ,\r
+26 , asc l , 126 , asc L ,\r
+27 , asc ; , 127 , asc : ,\r
+28 , asc , , 128 , asc " ,\r
+29 , asc ' , 129 , asc ~ ,\r
+\r
+2B , asc \ , 12B , asc | ,\r
+2C , asc z , 12C , asc Z ,\r
+2D , asc x , 12D , asc X ,\r
+2E , asc c , 12E , asc C ,\r
+2F , asc v , 12F , asc V ,\r
+30 , asc b , 130 , asc B ,\r
+31 , asc n , 131 , asc N ,\r
+32 , asc m , 132 , asc M ,\r
+33 , asc , , 133 , asc < ,\r
+34 , asc . , 134 , asc > ,\r
+35 , asc / , 135 , asc ? ,\r
+\r
+39 , FF , \ space\r
+48 , 410 , 148 , 410 , \ up\r
+4D , 411 , 14D , 411 , \ right\r
+50 , 412 , 150 , 412 , \ down\r
+4B , 413 , 14B , 413 , \ left\r
+\r
+1 , 400 , \ ESC\r
+3B , 401 , \ F1 ...\r
+3C , 402 ,\r
+3D , 403 ,\r
+3E , 404 ,\r
+3F , 405 ,\r
+40 , 406 ,\r
+41 , 407 ,\r
+42 , 408 ,\r
+43 , 409 ,\r
+44 , 40A , \ F10\r
+\r
+152 , 414 , \ INS\r
+153 , 415 , \ DEL\r
+147 , 416 , \ HOME\r
+14F , 417 , \ END\r
+149 , 418 , \ PG/UP\r
+151 , 419 , \ PG/DN\r
+\r
+202 , 1 ,\r
+203 , 2 ,\r
+204 , 3 ,\r
+205 , 4 ,\r
+206 , 5 ,\r
+207 , 6 ,\r
+208 , 7 ,\r
+209 , 8 ,\r
+20A , 9 ,\r
+20B , 0 ,\r
+21E , A ,\r
+231 , B ,\r
+217 , C ,\r
+223 , D ,\r
+220 , E ,\r
+215 , F ,\r
+\r
+0 ,\r
--- /dev/null
+create KBD_table\r
+\r
+2 , asc 1 , 102 , asc ! ,\r
+3 , asc 2 , 103 , asc @ ,\r
+4 , asc 3 , 104 , asc # ,\r
+5 , asc 4 , 105 , asc $ ,\r
+6 , asc 5 , 106 , asc % ,\r
+7 , asc 6 , 107 , asc ^ ,\r
+8 , asc 7 , 108 , asc & ,\r
+9 , asc 8 , 109 , asc * ,\r
+A , asc 9 , 10A , asc ( ,\r
+B , asc 0 , 10B , asc ) ,\r
+C , asc [ , 10C , asc { ,\r
+D , asc ] , 10D , asc } ,\r
+E , FC , \ backspace\r
+F , FD , \ tab\r
+10 , asc ' , 110 , asc " ,\r
+11 , asc , , 111 , asc < ,\r
+12 , asc . , 112 , asc > ,\r
+13 , asc p , 113 , asc P ,\r
+14 , asc y , 114 , asc Y ,\r
+15 , asc f , 115 , asc F ,\r
+16 , asc g , 116 , asc G ,\r
+17 , asc c , 117 , asc C ,\r
+18 , asc r , 118 , asc R ,\r
+19 , asc l , 119 , asc L ,\r
+1A , asc / , 11A , asc ? ,\r
+1B , asc = , 11B , asc + ,\r
+1C , FE , \ enter\r
+1E , asc a , 11E , asc A ,\r
+1F , asc o , 11F , asc O ,\r
+20 , asc e , 120 , asc E ,\r
+21 , asc u , 121 , asc U ,\r
+22 , asc i , 122 , asc I ,\r
+23 , asc d , 123 , asc D ,\r
+24 , asc h , 124 , asc H ,\r
+25 , asc t , 125 , asc T ,\r
+26 , asc n , 126 , asc N ,\r
+27 , asc s , 127 , asc S ,\r
+28 , asc - , 128 , asc _ ,\r
+29 , asc ' , 129 , asc ~ ,\r
+\r
+2B , asc \ , 12B , asc | ,\r
+2C , asc ; , 12C , asc : ,\r
+2D , asc q , 12D , asc Q ,\r
+2E , asc j , 12E , asc J ,\r
+2F , asc k , 12F , asc K ,\r
+30 , asc x , 130 , asc X ,\r
+31 , asc b , 131 , asc B ,\r
+32 , asc m , 132 , asc M ,\r
+33 , asc w , 133 , asc W ,\r
+34 , asc v , 134 , asc V ,\r
+35 , asc z , 135 , asc Z ,\r
+\r
+39 , FF , \ space\r
+48 , 410 , 148 , 410 , \ up\r
+4D , 411 , 14D , 411 , \ right\r
+50 , 412 , 150 , 412 , \ down\r
+4B , 413 , 14B , 413 , \ left\r
+\r
+1 , 400 , \ ESC\r
+3B , 401 , \ F1 ...\r
+3C , 402 ,\r
+3D , 403 ,\r
+3E , 404 ,\r
+3F , 405 ,\r
+40 , 406 ,\r
+41 , 407 ,\r
+42 , 408 ,\r
+43 , 409 ,\r
+44 , 40A , \ F10\r
+\r
+152 , 414 , \ INS\r
+153 , 415 , \ DEL\r
+147 , 416 , \ HOME\r
+14F , 417 , \ END\r
+149 , 418 , \ PG/UP\r
+151 , 419 , \ PG/DN\r
+\r
+202 , 1 ,\r
+203 , 2 ,\r
+204 , 3 ,\r
+205 , 4 ,\r
+206 , 5 ,\r
+207 , 6 ,\r
+208 , 7 ,\r
+209 , 8 ,\r
+20A , 9 ,\r
+20B , 0 ,\r
+21E , A ,\r
+231 , B ,\r
+217 , C ,\r
+223 , D ,\r
+220 , E ,\r
+215 , F ,\r
+\r
+0 ,\r
--- /dev/null
+: words\r
+cr lp @\r
+max do\r
+118 do\r
+ dup 0 = if pop pop 2drop drop ret then\r
+ colnorm\r
+ dup 13 + c@\r
+ dup 2 = if colhigh then\r
+ 0 = if colneg then\r
+ dup 4 + write colnorm\r
+ curx @ 10 mod 10 swap - do space loop\r
+ @\r
+loop\r
+cr 50 do asc = emit loop KBD_FW@ drop\r
+loop ;\r
+\r
+: statinc\r
+inccur @ dup ." depth: " d. cr\r
+." <handle> <size> <current offset>" cr\r
+incfiles swap 1+ do\r
+ dup @ dup d. space dyns d. space 4 + dup @ d. 4 + cr\r
+loop drop ;\r
+\r
+: (cmdline\r
+\ colhigh\r
+200 dynal\r
+0\r
+cr\r
+until\r
+ KBD_FW@ ( handle addr key )\r
+ push\r
+ 0 swap 200 bound\r
+ over dynp over + i swap c! ( handle addr )\r
+ 1+\r
+ i FC = if 2 - FC emit space then\r
+ pop dup FE - if ( handle addr )\r
+ emit\r
+ else\r
+ drop space\r
+ over dynresize ( handle )\r
+ dyninc\r
+ done\r
+ then\r
+loop \ colnorm\r
+;\r
+\r
+' (cmdline ' cmdline is\r
+\r
+: ascii\r
+until KBD_FW@ dup 1B = if done then\r
+dup emit space d. space loop ;\r
+\r
+: fs. ( fname -- ) fsDloadnew dup dyn. dynde ;\r
+\r
+: fsdisp ( fname -- )\r
+screen cls 0 0 at! fs. cr\r
+." press any key to continue ..."\r
+KBD_FW@ drop ;\r
+\r
+create tmpbuf 100 alloc\r
+: s.\r
+depth 2 - push\r
+." depth: " i . cr\r
+1 i 400 bound? if\r
+ i do\r
+ i 4 * tmpbuf + !\r
+ loop\r
+ 0 i for\r
+ i 4 * tmpbuf + @ dup . tab.\r
+ loop\r
+then pop drop ; rh tmpbuf\r
+\r
+: bye 2dup push push \ R: n1 n2\r
+i2 3 = if\r
+ i FE = if halt then\r
+then\r
+." unbalanced stack: " swap . space . KBD_FW@ halt ;\r
--- /dev/null
+: tab ( col -- spaces) 8 mod 8 swap - dup 0 = if drop 8 then ;\r
+\r
+: calccol ( b g r -- c )\r
+2B / 24 * swap 2B / 6 * + swap 2B / + ;\r
+\r
+: imgalloc ( x y -- handle )\r
+2dup * 8 + dynal ( x y handle )\r
+dup push dynp ( x y addr )\r
+rot over ! 4 + ! pop ;\r
+\r
+280 1E0 imgalloc const screen\r
+\r
+: imgsize ( screen -- x y )\r
+dynp dup @ swap 4 + @ ;\r
+\r
+: copyscreen ( srcDhand destDhand -- )\r
+swap dynp swap dup dynp swap dyns cmove ;\r
+\r
+: update ( -- ) screen dynp 8 + vidmap ;\r
+\r
+: point ( x y screen -- addr )\r
+dynp dup @ ( x y addr xs )\r
+rot * ( x addr y*xs)\r
++ + 8 + ;\r
+\r
+: pset ( c x y screen -- ) point c! ;\r
+\r
+var tmp1 var tmp2\r
+: boxf ( x1 x2 y1 y2 screen c -- )\r
+tmp1 !\r
+tmp2 !\r
+for ( x1 x2 )\r
+ 2dup swap - push\r
+ over i2 tmp2 @ point\r
+ tmp1 @ swap pop cfill\r
+loop 2drop ;\r
+rh tmp1 rh tmp2\r
+\r
+: cls ( screen -- )\r
+dynp dup @ swap 4 + dup @ ( x addr y )\r
+rot * swap 4 + ( len addr )\r
+0 rot rot swap ( c addr len)\r
+cfill ;\r
+\r
+: setpal ( b g r color -- ) 3C8 cprt! 3C9 cprt! 3C9 cprt! 3C9 cprt! ;\r
+\r
+: setupal\r
+D7\r
+6 do\r
+ 6 do\r
+ 6 do\r
+ dup i C * swap i2 C * swap i3 C * swap setpal\r
+ 1 -\r
+ loop\r
+ loop\r
+loop\r
+drop ;\r
+\r
+setupal\r
+\r
+D" \listF\FNT_SYSTEM" fsDloadnew const font\r
+\r
+: scroll ( x y screen -- )\r
+dynp dup @ swap 4 + dup @ swap 4 + push ( x y xsize ysize R: addr )\r
+over * push ( x y xsize R: addr size )\r
+* + i2 + pop pop swap cmove ;\r
+\r
+var tmp1 var tmp2 var tmp3 var tmp4 var tmp5 var tmp6 var tmp7\r
+: scrollf ( color x y screen -- )\r
+dup push tmp1 ! ( screen )\r
+dup push tmp2 ! ( y )\r
+dup tmp3 ! ( x )\r
+pop pop scroll\r
+push\r
+tmp1 @ dynp dup @ tmp4 ! ( xsize )\r
+4 + @ tmp5 ! ( ysize )\r
+tmp2 @ dup 0 - if\r
+ 0 > if\r
+ 0 dup tmp6 ! tmp4 @ tmp5 @ tmp2 @ - dup tmp7 !\r
+ tmp5 @ tmp1 @ i boxf\r
+\r
+ else\r
+ 0 tmp4 @ 0 tmp2 @ neg dup tmp6 ! tmp1 @ i boxf\r
+ tmp5 @ tmp7 !\r
+ then\r
+else\r
+ drop\r
+ 0 tmp6 ! tmp5 @ tmp7 !\r
+then\r
+\r
+tmp3 @ dup 0 - if\r
+ 0 > if\r
+ tmp4 @ dup tmp3 @ - swap tmp6 @ tmp7 @ tmp1 @ i boxf\r
+ else\r
+ 0 tmp3 @ neg tmp6 @ tmp7 @ tmp1 @ i boxf\r
+ then\r
+else\r
+ drop\r
+then\r
+pop drop ;\r
+rh tmp1 rh tmp2 rh tmp3 rh tmp4 rh tmp5 rh tmp6 rh tmp7\r
+\r
+var curx\r
+var cury\r
+var curc\r
+var curb\r
+var emitscreen\r
+\r
+screen emitscreen !\r
+\r
+: at! ( x y -- ) cury ! curx ! ;\r
+: at@ ( -- x y ) curx @ cury @ ;\r
+: curc! calccol curc ! ;\r
+: curb! calccol curb ! ;\r
+\r
+: colnorm FF FF FF curc! 0 0 0 curb! ;\r
+: colneg 0 0 0 curc! FF FF FF curb! ;\r
+: colhigh 0 FF FF curc! 0 0 0 curb! ;\r
+\r
+colnorm\r
+\r
+: (emit2\r
+dup FE = if drop\r
+ 0 curx ! cury @ 1+\r
+ dup 3B > if\r
+ 0 0 8 emitscreen @ scrollf\r
+ drop 3B\r
+ then\r
+ cury !\r
+else\r
+ dup FC - if\r
+ dup FD - if\r
+ curx @ 4F > if FE emit then\r
+ 8 * font dynp +\r
+ curc @ swap curb @ swap emitscreen @ dynp\r
+ curx @ 8 * cury @ 8 * charput\r
+ curx @ 1+ curx !\r
+ else\r
+ drop curx @ tab do space loop\r
+ then\r
+ else\r
+ drop curx @ 1-\r
+ dup 0 < if drop 0 then curx !\r
+ then\r
+then ;\r
+\r
+screen cls\r
+FC emit\r
+' (emit2 ' emit is\r
--- /dev/null
+: lineh ( color len x y imgbuf -- )\r
+point swap cfill ;\r
+\r
+: linev ( color len x y imgbuf -- )\r
+dup imgsize drop push\r
+point swap\r
+do 2dup c! i2 + loop\r
+2drop pop drop ;\r
+\r
+var tmp1 var tmp2 var tmp3 var tmp4\r
+: box ( color x2 x1 y2 y1 imgbuf -- )\r
+ push ( buf i3 )\r
+dup push ( y1 i2 )\r
+over tmp1 ! ( y2 1 )\r
+- tmp2 ! ( ylen 2 )\r
+dup push ( x1 i )\r
+over tmp3 ! ( x2 3 )\r
+- tmp4 ! ( xlen 4 )\r
+\r
+dup tmp4 @ i i2 i3 lineh\r
+dup tmp4 @ 1+ i tmp1 @ i3 lineh\r
+dup tmp2 @ i i2 i3 linev\r
+ tmp2 @ tmp3 @ i2 i3 linev\r
+pop pop 2drop pop drop ;\r
+rh tmp1 rh tmp2 rh tmp3 rh tmp4\r
+\r
+var flipxs var flipys var fliplb var flipib var flipsa var flipda\r
+: flipv ( imgbuf -- )\r
+dup push imgsize over dynal push ( sizex sizey R: imgbuf linebuf )\r
+flipys ! flipxs ! pop fliplb ! pop flipib !\r
+flipys @ 2 / do\r
+ 0 i flipib @ point flipsa !\r
+ 0 flipys @ i - 1- flipib @ point flipda !\r
+ flipda @ fliplb @ dynp flipxs @ cmove\r
+ flipsa @ flipda @ flipxs @ cmove\r
+ fliplb @ dynp flipsa @ flipxs @ cmove\r
+loop ;\r
+rh flipxs rh flipys rh fliplb rh flipib rh flipsa rh flipda\r
+\r
+: imgcoltrans ( ImgBuf Color ToColor -- )\r
+push push\r
+dup dynp 8 + swap dyns 8 - do\r
+ dup c@ i2 = if i3 over c! then\r
+ 1+\r
+loop drop pop pop 2drop ;\r
+\r
+var imgfillbuf var imgfilld var imgfillc\r
+: imgfill ( color x y imgbuf -- )\r
+dup imgfillbuf ! point dup c@ imgfillc ! FE swap c! ( color )\r
+until\r
+ imgfilld off\r
+\r
+ imgfillbuf @ imgsize\r
+ swap 1- swap\r
+ do\r
+ imgfillbuf @ imgsize drop 1- i imgfillbuf @ point\r
+ over do\r
+ dup c@ FE = if\r
+ dup 1- c@ imgfillc @ = if\r
+ dup 1- FE swap c!\r
+ imgfilld on\r
+ then\r
+ then\r
+ 1-\r
+ loop drop\r
+\r
+ 0 i imgfillbuf @ point\r
+ over do\r
+ dup c@ FE = if\r
+ dup 1+ c@ imgfillc @ = if\r
+ dup 1+ FE swap c!\r
+ imgfilld on\r
+ then\r
+ then\r
+ 1+\r
+ loop drop\r
+ loop drop\r
+\r
+ imgfillbuf @ imgsize 1- swap\r
+ do\r
+ i imgfillbuf @ dup imgsize swap push 1- swap point\r
+ over do\r
+ dup c@ FE = if\r
+ dup i2 - c@ imgfillc @ = if\r
+ dup i2 - FE swap c!\r
+ imgfilld on\r
+ then\r
+ then\r
+ i2 -\r
+ loop drop\r
+\r
+\r
+ i2 0 imgfillbuf @ point\r
+ over do\r
+ dup c@ FE = if\r
+ dup i2 + c@ imgfillc @ = if\r
+ dup i2 + FE swap c!\r
+ imgfilld on\r
+ then\r
+ then\r
+ i2 +\r
+ loop pop 2drop\r
+ loop drop\r
+imgfilld @ if imgfilld off else done then\r
+loop\r
+imgfillbuf @ FE rot imgcoltrans ;\r
+rh imgfillbuf rh imgfilld rh imgfillc\r
--- /dev/null
+create sintable 8000 alloc\r
+\r
+: mktable\r
+here push\r
+sintable h !\r
+100000000 0\r
+2000 do\r
+\r
+ over 100000 / -\r
+ swap over + swap\r
+ over 10000 / ,\r
+loop\r
+2drop\r
+pop h ! ;\r
+\r
+mktable\r
+forget mktable\r
+\r
+: cos ( num -- result)\r
+abs 2000 mod 4 * sintable + @ ;\r
+\r
+: sin 500 - cos ;\r
+\r
+rh sintable\r
--- /dev/null
+\r
+Graphic editor is very unfinished, some functions do not work properly yet!\r
+\r
+ Paint quick help:\r
+\r
+q - exit, don't close image\r
+F1 - this help\r
+F2 - save to file\r
+F3 - close & exit\r
+F5 - pick color\r
+F6 - draw pixels\r
+F7 - fill with color\r
+\r
+Right mouse button - select zoom region.\r
+\r
+flashing color is transparent\r
--- /dev/null
+ Text editor help:\r
+\r
+from editor:\r
+\r
+F1 - help\r
+F2 - save to current file\r
+F3 - close text, switch to commandline\r
+ESC - switch to commandline\r
+\r
+PG/UP & PG/DOWN, cursor keys, DEL, backspace, TAB, HOME & END, works as usual.\r
+\r
+\r
+commandline:\r
+\r
+ ET - switch to text editor\r
+<file> ETl - load file, and switch to editor\r
+<file> ETs - save to file\r
+ ETh - help\r
--- /dev/null
+ basic Fifth commands:\r
+\r
+help - get this help\r
+lde - load editor\r
+fsls - show list of files\r
+fslsr - recursive file list\r
+<file> fsdel - delete file\r
+<path> fscl - goto specified path\r
+<File1> <File2> fscopy - copy file\r
+<file> fs. - type file contenc to screen\r
+bye - exit from fifth\r
+words - list all dictionary entries.\r
+statdyn - list info about allocated dynamic memory blocks\r
--- /dev/null
+; core of Fifth\r
+\r
+include 'define.inc'\r
+\r
+link = 0\r
+org 0\r
+\r
+lpad: xnum 1 ; load rest of core into RAM\r
+ xnum 1024\r
+ xnum 3\r
+ xcall lload\r
+ xnum 4 ; load highlevel Fifth boot code into RAM \r
+ xnum 1500000\r
+ xnum 32\r
+ xcall lload\r
+ xnum -1 ; initialize dictionary space\r
+ xnum lend\r
+ xnum 30000\r
+ xcfill\r
+ xjmp lmain\r
+ times 15 db '*PAD*'\r
+\r
+lload: ;( fromdisk tomem amount -- )\r
+l46: xdup\r
+ xif l45\r
+ xdec\r
+ xpush\r
+ xover\r
+ xover\r
+ xdisk@\r
+ xnum 1024\r
+ xplus\r
+ xswap\r
+ xinc\r
+ xswap\r
+ xpop\r
+ xjmp l46\r
+l45: xdrop\r
+ xdrop\r
+ xdrop\r
+ xret\r
+\r
+ibuf: dd 0, 0, 0, 0, 0, 0, 0, 0\r
+lh: dd last+24000\r
+llp: dd lastp\r
+\r
+lcount: xinc\r
+ xdup\r
+ xdec\r
+ xc@\r
+ xret\r
+\r
+vloc dd 200000h\r
+llemit: ; xemit\r
+ xnum vloc\r
+ x@\r
+ xdup\r
+ xinc\r
+ xnum vloc\r
+ x!\r
+ xc!\r
+ xret\r
+\r
+lhere: xnum lh\r
+ x@\r
+ xret\r
+\r
+lemit: xjmp llemit\r
+\r
+ltype: xdup\r
+ xif l2\r
+ xdec\r
+ xpush\r
+ xcall lcount\r
+ xcall lemit\r
+ xpop\r
+ xjmp ltype\r
+l2: xdrop\r
+ xdrop\r
+ xret\r
+\r
+lwrite: xcall lcount\r
+ xcall ltype\r
+ xret\r
+\r
+lsadd: xdup\r
+ xc@\r
+ xinc\r
+ xover\r
+ xover\r
+ xswap\r
+ xc!\r
+ xplus\r
+ xc!\r
+ xret\r
+\r
+llfkey: xnum d1\r
+ x@\r
+ xcall lcount\r
+ xswap\r
+ xnum d1\r
+ x!\r
+ xret\r
+d1 dd 1500000\r
+\r
+lfkey: xjmp llfkey\r
+\r
+lskey: xcall lfkey\r
+ xdup\r
+ xnum 254\r
+ xminus\r
+ xif l47\r
+ xdup\r
+ xnum 253\r
+ xminus\r
+ xif l47\r
+ xret\r
+l47: xdrop\r
+ xnum 255\r
+ xret\r
+\r
+lscan: xnum 0\r
+ xnum lpad\r
+ xc!\r
+l4: xcall lskey\r
+ xover\r
+ xover\r
+ xminus\r
+ xif l3\r
+ xnum lpad\r
+ xcall lsadd\r
+ xjmp l4\r
+l3: xdrop\r
+ xnum lpad\r
+ xc@\r
+ xif lscan\r
+ xdrop\r
+ xret\r
+\r
+lstrEQstr: xdup\r
+ xc@\r
+ xinc\r
+l8: xdup\r
+ xif l6\r
+ xdec\r
+ xpush\r
+ xover\r
+ xc@\r
+ xover\r
+ xc@\r
+ xminus\r
+ xif l7\r
+ xpop\r
+ xdrop\r
+ xdrop\r
+ xdrop\r
+ xnum 0\r
+ xret\r
+l7: xinc\r
+ xswap\r
+ xinc\r
+ xpop\r
+ xjmp l8\r
+l6: xdrop\r
+ xdrop\r
+ xdrop\r
+ xnum -1\r
+ xret\r
+\r
+lstrEQpad:\r
+ xnum lpad\r
+ xjmp lstrEQstr\r
+\r
+lfind: xnum llp\r
+l9: xdup\r
+ xnum lprev\r
+ x!\r
+ x@\r
+ xdup\r
+ xif l11\r
+ xdup\r
+ xinc\r
+ xinc\r
+ xinc\r
+ xinc\r
+ xcall lstrEQpad\r
+ xif l9\r
+l11: xret\r
+\r
+lprev: dd 0\r
+lmode: db 1 ; 0 compile\r
+ ; 1 interpret\r
+\r
+lgoto: xnum l44+1\r
+ x!\r
+l44: xjmp 0\r
+\r
+lexecute:\r
+ xnum lmode\r
+ xc@\r
+ xif l19\r
+ xcall setint\r
+l19: xcall lfind\r
+ xdup\r
+ xif l12 ; not found ?\r
+ xnum 19\r
+ xplus\r
+ xdup\r
+ xc@ ; ( addr+19 c )\r
+ xdup\r
+ xif cmpnum\r
+ xdec\r
+ xdup\r
+ xif cmpmod\r
+ xdec\r
+ xif cmpimm\r
+ xdrop\r
+ xjmp clrint\r
+setint: xnum l14\r
+ x@\r
+ xif l15\r
+ xret\r
+l14 dd 0\r
+l15: xnum lh\r
+ x@\r
+ xnum l14\r
+ x!\r
+ xnum ibuf\r
+ xnum lh\r
+ x!\r
+ xret\r
+clrint: xnum l14\r
+ x@\r
+ xif l20\r
+ xnum 11\r
+ xcall lcsto\r
+ xnum l14\r
+ x@\r
+ xnum lh\r
+ x!\r
+ xnum 0\r
+ xnum l14\r
+ x!\r
+ xjmp ibuf\r
+l20: xret\r
+cmpnum: xdrop\r
+ xnum 3\r
+ xjmp cmpn\r
+cmpmod: xdrop\r
+ xnum 5\r
+ xjmp cmpn\r
+cmpimm: xcall setint\r
+ xnum 5\r
+ xjmp cmpn\r
+cmpn: xcall lcsto\r
+ xinc\r
+ x@\r
+ xcall lsto\r
+ xjmp clrint\r
+l12: xdrop\r
+ xcall l2num\r
+ xif l23\r
+ xnum 3\r
+ xcall lcsto\r
+ xcall lsto\r
+ xjmp clrint\r
+l23: xdrop\r
+ xnum lpad\r
+ xcall lwrite\r
+ xnum msg1\r
+ xcall lwrite\r
+ xjmp clrint\r
+msg1 db 3, ' ? '\r
+\r
+l2num: xnum lpad\r
+ xcall lcount ; ( addr len )\r
+ xnum numlen\r
+ xc!\r
+ xnum 0\r
+l13: xnum numlen ; ( addr num )\r
+ xc@\r
+ xdup\r
+ xif numend\r
+ xdec\r
+ xnum numlen\r
+ xc!\r
+ xnum 16\r
+ xmul\r
+ xswap\r
+ xcall lcount ; ( num addr c )\r
+\r
+ xdup\r
+ xnum 45\r
+ xminus\r
+ xif l22\r
+l28: xdup\r
+ xnum 16\r
+ xcmpg\r
+ xif l21\r
+ xdrop\r
+ xdrop\r
+ xnum 0\r
+ xret\r
+l21: xrot\r
+ xplus ; ( addr num )\r
+ xjmp l13\r
+numend: xdrop\r
+ xswap\r
+ xdrop\r
+ xnum numneg\r
+ xc@\r
+ xif l16\r
+ xnum -1\r
+ xmul\r
+ xnum 0\r
+ xnum numneg\r
+ xc!\r
+l16: xnum -1\r
+ xret\r
+numlen db 0\r
+numneg db 0\r
+\r
+l22: xnum numneg\r
+ xc!\r
+ xnum 0\r
+ xjmp l28\r
+\r
+lcsto: xnum lh\r
+ x@\r
+ xover\r
+ xover ; ( n addr n addr )\r
+ xc!\r
+ xinc\r
+ xnum lh\r
+ x!\r
+ xdrop\r
+ xret\r
+\r
+lsto: xnum lh\r
+ x@\r
+ xover\r
+ xover\r
+ x!\r
+ xnum 4\r
+ xplus\r
+ xnum lh\r
+ x!\r
+ xdrop\r
+ xret\r
+\r
+lhalt: xhalt\r
+\r
+l@: xnum 20\r
+ xjmp bcode\r
+\r
+l!: xnum 21\r
+ xjmp bcode\r
+\r
+lc@: xnum 12\r
+ xjmp bcode\r
+\r
+lc!: xnum 13\r
+ xjmp bcode\r
+\r
+linc: xnum 6\r
+ xjmp bcode\r
+\r
+ldec: xnum 7\r
+ xjmp bcode\r
+\r
+lcmpg: xnum 28\r
+ xjmp bcode\r
+\r
+lcmpl: xnum 29\r
+ xjmp bcode\r
+\r
+lret: xnum 11\r
+ xjmp bcode\r
+\r
+lplus: xnum 24\r
+ xjmp bcode\r
+\r
+lminus: xnum 25\r
+ xjmp bcode\r
+\r
+lmul: xnum 26\r
+ xjmp bcode\r
+\r
+ldrop: xnum 9\r
+ xjmp bcode\r
+\r
+ldup: xnum 8\r
+ xjmp bcode\r
+\r
+lswap: xnum 23\r
+ xjmp bcode\r
+\r
+ldisk@: xnum 18\r
+ xjmp bcode\r
+\r
+lpush: xnum 14\r
+ xjmp bcode\r
+\r
+lpop: xnum 15\r
+ xjmp bcode\r
+\r
+lover: xnum 22\r
+ xjmp bcode\r
+\r
+lcmove: xnum 43\r
+ xjmp bcode\r
+\r
+bcode: xnum lmode\r
+ xc@\r
+ xif lcsto\r
+ xnum l25\r
+ xc!\r
+l25: db 0\r
+ xret\r
+\r
+lne: xcall lfind\r
+ xif lne3\r
+ xnum lpad\r
+ xcall lwrite\r
+ xnum msg2\r
+ xcall lwrite\r
+lne3: xnum sf ; pick next address\r
+ x@\r
+ xdup\r
+ xnum 24\r
+ xplus\r
+ xdup\r
+ xnum last+23999\r
+ xcmpg\r
+ xif lne1\r
+ xdrop\r
+ xnum last\r
+lne1: xnum sf\r
+ x!\r
+ xdup ; is cell empty\r
+ x@\r
+ xinc\r
+ xif lne2\r
+ xdrop\r
+ xjmp lne3\r
+lne2: xnum llp ; create entry\r
+ x@\r
+ xover\r
+ x!\r
+ xdup\r
+ xnum llp\r
+ x!\r
+ xnum lpad\r
+ xover\r
+ xinc\r
+ xinc\r
+ xinc\r
+ xinc\r
+ xnum 15\r
+ xcmove\r
+ xnum 19\r
+ xplus\r
+ xdup\r
+ xinc\r
+ xpush\r
+ xc!\r
+ xpop\r
+ x!\r
+ xret\r
+sf dd lend\r
+msg2 db 3, ' ! '\r
+\r
+lcolon: xnum 255\r
+ xcall lscan\r
+ xnum lh\r
+ x@\r
+ xnum 1\r
+ xcall lne\r
+ xnum 0\r
+ xnum lmode\r
+ xc!\r
+ xret\r
+\r
+lI: xnum 1\r
+ xnum lmode\r
+ xc!\r
+ xret\r
+\r
+ldadd:\r
+l27: xdup\r
+ xif l26\r
+ xdec\r
+ xpush\r
+ xcall lcount\r
+ xcall lcsto\r
+ xpop\r
+ xjmp l27\r
+l26: xdrop\r
+ xdrop\r
+ xret\r
+\r
+lincmod: xcall lcount\r
+ xjmp ldadd\r
+\r
+lif: xcall lhere\r
+ xinc\r
+ xnum d6\r
+ xcall lincmod\r
+l35: xnum 255\r
+ xcall lscan\r
+ xnum d7\r
+ xcall lstrEQpad\r
+ xif l36\r
+ xcall lhere\r
+ xinc\r
+ xnum d9\r
+ xcall lincmod\r
+ xswap\r
+ xcall lhere\r
+ xswap\r
+ x!\r
+ xjmp l35\r
+l36: xnum d8\r
+ xcall lstrEQpad\r
+ xif l37\r
+ xcall lhere\r
+ xswap\r
+ x!\r
+ xret\r
+l37: xcall lexecute\r
+ xjmp l35\r
+\r
+d6 db 5, 10, 0, 0, 0, 0\r
+d7 db 4, 'else'\r
+d8 db 4, 'then'\r
+d9 db 5, 4, 0, 0, 0, 0\r
+\r
+ldo: xcall lhere\r
+ xinc\r
+ xinc\r
+ xnum d4\r
+ xcall lincmod\r
+l33: xnum 255\r
+ xcall lscan\r
+ xnum d5\r
+ xcall lstrEQpad\r
+ xif l34\r
+ xnum 15\r
+ xcall lsto\r
+ xnum 4\r
+ xcall lcsto\r
+ xdup\r
+ xdec\r
+ xdec\r
+ xcall lsto\r
+ xcall lhere\r
+ xswap\r
+ x!\r
+ xnum 9\r
+ xcall lcsto\r
+ xret\r
+l34: xcall lexecute\r
+ xjmp l33\r
+d4 db 8, 8, 10, 0, 0, 0, 0, 7, 14\r
+d5 db 4, 'loop'\r
+\r
+lfor: xcall lhere\r
+ xnum d10\r
+ xcall lincmod\r
+l38: xnum 255\r
+ xcall lscan\r
+ xnum d5\r
+ xcall lstrEQpad\r
+ xif l39\r
+ xnum d11\r
+ xcall lincmod\r
+ xcall lhere\r
+ xover\r
+ xnum 5\r
+ xplus\r
+ x!\r
+ xinc\r
+ xcall lhere\r
+ xdec\r
+ xdec\r
+ xdec\r
+ xdec\r
+ x!\r
+ xnum d12\r
+ xcall lincmod\r
+ xret\r
+l39: xcall lexecute\r
+ xjmp l38\r
+\r
+d10 db 10, 14, 8, 31, 25, 10, 0,0,0,0, 14\r
+d11 db 7, 15, 6, 4, 0,0,0,0\r
+d12 db 3, 9, 15, 9\r
+\r
+luntil: xnum d14\r
+ xcall lincmod\r
+ xcall lhere\r
+l40: xnum 255\r
+ xcall lscan\r
+ xnum d5\r
+ xcall lstrEQpad\r
+ xif l41\r
+ xnum d15\r
+ xcall lincmod\r
+ xcall lhere\r
+ xnum 6\r
+ xminus\r
+ x!\r
+ xret\r
+l41: xcall lexecute\r
+ xjmp l40\r
+\r
+d14 db 6, 3, 0, 0, 0, 0, 14\r
+d15 db 8, 31, 10, 0, 0, 0, 0, 15, 9\r
+\r
+lmain:\r
+l32: xnum 255\r
+ xcall lscan\r
+ xcall lexecute\r
+ xjmp l32\r
+\r
+last:\r
+head 2, 'lp', 0, llp\r
+head 5, 'count', 1, lcount\r
+head 4, 'emit', 1, lemit\r
+head 4, 'type', 1, ltype\r
+head 5, 'write', 1, lwrite\r
+head 3, 'pad', 0, lpad\r
+head 5, 'c+str', 1, lsadd\r
+head 4, 'fkey', 1, lfkey\r
+head 4, 'scan', 1, lscan\r
+head 8, 'str=str?', 1, lstrEQstr\r
+head 4, 'find', 1, lfind\r
+head 4, 'mode', 0, lmode\r
+head 4, 'goto', 1, lgoto\r
+head 7, 'execute', 1, lexecute\r
+head 4, '2num', 1, l2num\r
+head 2, 'c,', 1, lcsto\r
+head 1, ',', 1, lsto\r
+head 4, 'halt', 1, lhalt\r
+head 1, '@', 2, l@\r
+head 1, '!', 2, l!\r
+head 2, 'c@', 2, lc@\r
+head 2, 'c!', 2, lc!\r
+head 2, '1+', 2, linc\r
+head 2, '1-', 2, ldec\r
+head 1, '>', 2, lcmpg\r
+head 1, '<', 2, lcmpl\r
+head 3, 'ret', 2, lret\r
+head 1, '+', 2, lplus\r
+head 1, '-', 2, lminus\r
+head 1, '*', 2, lmul\r
+head 4, 'drop', 2, ldrop\r
+head 3, 'dup', 2, ldup\r
+head 4, 'swap', 2, lswap\r
+head 5, 'disk@', 2, ldisk@\r
+head 4, 'push', 2, lpush\r
+head 3, 'pop', 2, lpop\r
+head 4, 'over', 2, lover\r
+head 5, 'cmove', 2, lcmove\r
+head 2, 'ne', 1, lne\r
+head 1, ':', 1, lcolon\r
+head 1, 'I', 2, lI\r
+head 5, 'bcode', 1, bcode\r
+head 4, 'dadd', 1, ldadd\r
+head 6, 'incmod', 1, lincmod\r
+head 2, 'if', 2, lif\r
+head 4, 'here', 1, lhere\r
+head 2, 'do', 2, ldo\r
+head 3, 'for', 2, lfor\r
+head 5, 'until', 2, luntil\r
+head 4, 'prev', 0, lprev\r
+head 4, 'skey', 1, lskey\r
+lastp:\r
+head 1, 'h', 0, lh\r
+lend:\r
--- /dev/null
+; Virtual CPU machine code definitions\r
+; For assembling with FASM (Flat Assembler).\r
+; Rest is defined in highlevel code.\r
+\r
+macro xnop\r
+{ db 0 }\r
+macro xhalt\r
+{ db 1 }\r
+macro kbd@\r
+{ db 2 }\r
+macro xnum arg1\r
+{ db 3\r
+ dd arg1 }\r
+macro head arg1, arg2, arg3, arg4\r
+{ dd link\r
+ link = $-4\r
+ db arg1\r
+ db arg2\r
+ len = (24-5)-($-link)\r
+ times len db 177\r
+ db arg3\r
+ dd arg4 }\r
+macro xjmp arg1\r
+{ db 4\r
+ dd arg1 }\r
+macro xcall arg1\r
+{ db 5\r
+ dd arg1 }\r
+macro xinc\r
+{ db 6 }\r
+macro xdec\r
+{ db 7 }\r
+macro xdup\r
+{ db 8 }\r
+macro xdrop\r
+{ db 9 }\r
+macro xif arg1\r
+{ db 10\r
+ dd arg1 }\r
+macro xret\r
+{ db 11 }\r
+macro xc@\r
+{ db 12 }\r
+macro xc!\r
+{ db 13 }\r
+macro xpush\r
+{ db 14 }\r
+macro xpop\r
+{ db 15 }\r
+macro xrot\r
+{ db 17 }\r
+macro xdisk@\r
+{ db 18 }\r
+macro xdisk!\r
+{ db 19 }\r
+macro x@\r
+{ db 20 }\r
+macro x!\r
+{ db 21 }\r
+macro xover\r
+{ db 22 }\r
+macro xswap\r
+{ db 23 }\r
+macro xplus\r
+{ db 24 }\r
+macro xminus\r
+{ db 25 }\r
+macro xmul\r
+{ db 26 }\r
+macro xcmpg\r
+{ db 28 }\r
+macro xcmpl\r
+{ db 29 }\r
+macro xcprt!\r
+{ db 33 }\r
+macro xcmove\r
+{ db 43 }\r
+macro xcfill\r
+{ db 44 }\r
--- /dev/null
+; Font for Fifth\r
+\r
+\r
+; 0\r
+db 00000000b\r
+db 00000000b\r
+db 00111000b\r
+db 00101000b\r
+db 00111000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; 1\r
+db 11111110b\r
+db 01111100b\r
+db 00111000b\r
+db 00101000b\r
+db 00111000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; 2\r
+db 00000010b\r
+db 00000110b\r
+db 00111110b\r
+db 00101110b\r
+db 00111110b\r
+db 00000110b\r
+db 00000010b\r
+db 00000000b\r
+; 3\r
+db 11111110b\r
+db 01111110b\r
+db 00111110b\r
+db 00101110b\r
+db 00111110b\r
+db 00000110b\r
+db 00000010b\r
+db 00000000b\r
+; 4\r
+db 00000000b\r
+db 00000000b\r
+db 00111000b\r
+db 00101000b\r
+db 00111000b\r
+db 01111100b\r
+db 11111110b\r
+db 00000000b\r
+; 5\r
+db 11111110b\r
+db 01111100b\r
+db 00111000b\r
+db 00101000b\r
+db 00111000b\r
+db 01111100b\r
+db 11111110b\r
+db 00000000b\r
+; 6\r
+db 00000010b\r
+db 00000110b\r
+db 00111110b\r
+db 00101110b\r
+db 00111110b\r
+db 01111110b\r
+db 11111110b\r
+db 00000000b\r
+; 7\r
+db 11111110b\r
+db 01111110b\r
+db 00111110b\r
+db 00101110b\r
+db 00111110b\r
+db 01111110b\r
+db 11111110b\r
+db 00000000b\r
+; 8\r
+db 10000000b\r
+db 11000000b\r
+db 11111000b\r
+db 11101000b\r
+db 11111000b\r
+db 11000000b\r
+db 10000000b\r
+db 00000000b\r
+; 9\r
+db 11111110b\r
+db 11111100b\r
+db 11111000b\r
+db 11101000b\r
+db 11111000b\r
+db 11000000b\r
+db 10000000b\r
+db 00000000b\r
+; 10\r
+db 10000010b\r
+db 11000110b\r
+db 11111110b\r
+db 11101110b\r
+db 11111110b\r
+db 11000110b\r
+db 10000010b\r
+db 00000000b\r
+; 11\r
+db 11111110b\r
+db 11111110b\r
+db 11111110b\r
+db 11101110b\r
+db 11111110b\r
+db 11000110b\r
+db 10000010b\r
+db 00000000b\r
+; 12\r
+db 10000000b\r
+db 11000000b\r
+db 11111000b\r
+db 11101000b\r
+db 11111000b\r
+db 11111100b\r
+db 11111110b\r
+db 00000000b\r
+; 13\r
+db 11111110b\r
+db 11111100b\r
+db 11111000b\r
+db 11101000b\r
+db 11111000b\r
+db 11111100b\r
+db 11111110b\r
+db 00000000b\r
+; 14\r
+db 10000010b\r
+db 11000110b\r
+db 11111110b\r
+db 11101110b\r
+db 11111110b\r
+db 11111110b\r
+db 11111110b\r
+db 00000000b\r
+; 15\r
+db 11111110b\r
+db 11111110b\r
+db 11111110b\r
+db 11101110b\r
+db 11111110b\r
+db 11111110b\r
+db 11111110b\r
+db 00000000b\r
+; 16\r
+db 10000000b\r
+db 11100000b\r
+db 11111000b\r
+db 11111110b\r
+db 11111000b\r
+db 11100000b\r
+db 10000000b\r
+db 00000000b\r
+; 17\r
+db 00000010b\r
+db 00001110b\r
+db 00111110b\r
+db 11111110b\r
+db 00111110b\r
+db 00001110b\r
+db 00000010b\r
+db 00000000b\r
+; 18\r
+db 00011000b\r
+db 00111100b\r
+db 01111110b\r
+db 00011000b\r
+db 00011000b\r
+db 01111110b\r
+db 00111100b\r
+db 00011000b\r
+; 19\r
+db 01100110b\r
+db 01100110b\r
+db 01100110b\r
+db 01100110b\r
+db 01100110b\r
+db 00000000b\r
+db 01100110b\r
+db 00000000b\r
+; 20\r
+db 01111111b\r
+db 11011011b\r
+db 11011011b\r
+db 01111011b\r
+db 00011011b\r
+db 00011011b\r
+db 00011011b\r
+db 00000000b\r
+; 21\r
+db 00111110b\r
+db 01100011b\r
+db 00111000b\r
+db 01101100b\r
+db 01101100b\r
+db 00111000b\r
+db 10000110b\r
+db 11111100b\r
+; 22\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 01111110b\r
+db 01111110b\r
+db 01111110b\r
+db 00000000b\r
+; 23\r
+db 00011000b\r
+db 00111100b\r
+db 01111110b\r
+db 00011000b\r
+db 01111110b\r
+db 00111100b\r
+db 00011000b\r
+db 11111111b\r
+; 24\r
+db 00011000b\r
+db 00111100b\r
+db 01111110b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+; 25\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 01111110b\r
+db 00111100b\r
+db 00011000b\r
+db 00000000b\r
+; 26\r
+db 00000000b\r
+db 00011000b\r
+db 00001100b\r
+db 11111110b\r
+db 00001100b\r
+db 00011000b\r
+db 00000000b\r
+db 00000000b\r
+; 27\r
+db 00000000b\r
+db 00110000b\r
+db 01100000b\r
+db 11111110b\r
+db 01100000b\r
+db 00110000b\r
+db 00000000b\r
+db 00000000b\r
+; 28\r
+db 00000000b\r
+db 00110000b\r
+db 01100000b\r
+db 11111110b\r
+db 01100000b\r
+db 00110000b\r
+db 00000000b\r
+db 00000000b\r
+; 29\r
+db 00000000b\r
+db 00110000b\r
+db 01100000b\r
+db 11111110b\r
+db 01100000b\r
+db 00110000b\r
+db 00000000b\r
+db 00000000b\r
+; 30\r
+db 00000000b\r
+db 00110000b\r
+db 01100000b\r
+db 11111110b\r
+db 01100000b\r
+db 00110000b\r
+db 00000000b\r
+db 00000000b\r
+; 31\r
+db 00000000b\r
+db 00110000b\r
+db 01100000b\r
+db 11111110b\r
+db 01100000b\r
+db 00110000b\r
+db 00000000b\r
+db 00000000b\r
+; 32\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; ! 33\r
+db 00011000b\r
+db 00111100b\r
+db 00111100b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+db 00011000b\r
+db 00000000b\r
+; " 34\r
+db 01101100b\r
+db 01101100b\r
+db 01101100b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; # 35\r
+db 01101100b\r
+db 01101100b\r
+db 11111110b\r
+db 01101100b\r
+db 11111110b\r
+db 01101100b\r
+db 01101100b\r
+db 00000000b\r
+; $ 36\r
+db 00011000b\r
+db 01111110b\r
+db 11000000b\r
+db 01111100b\r
+db 00000110b\r
+db 11111100b\r
+db 00011000b\r
+db 00000000b\r
+; % 37\r
+db 00000000b\r
+db 11000110b\r
+db 11001100b\r
+db 00011000b\r
+db 00110000b\r
+db 01100110b\r
+db 11000110b\r
+db 00000000b\r
+; & 38\r
+db 00111000b\r
+db 01101100b\r
+db 00111000b\r
+db 01110110b\r
+db 11011100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; ' 39\r
+db 00110000b\r
+db 00110000b\r
+db 01100000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; ( 40\r
+db 00011000b\r
+db 00110000b\r
+db 01100000b\r
+db 01100000b\r
+db 01100000b\r
+db 00110000b\r
+db 00011000b\r
+db 00000000b\r
+; ) 41\r
+db 01100000b\r
+db 00110000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00110000b\r
+db 01100000b\r
+db 00000000b\r
+; * 42\r
+db 00000000b\r
+db 01100110b\r
+db 00111100b\r
+db 11111111b\r
+db 00111100b\r
+db 01100110b\r
+db 00000000b\r
+db 00000000b\r
+; + 43\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 01111110b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+db 00000000b\r
+; , 44\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00110000b\r
+; - 45\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 01111110b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; . 46\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+; / 47\r
+db 00000110b\r
+db 00001100b\r
+db 00011000b\r
+db 00110000b\r
+db 01100000b\r
+db 11000000b\r
+db 10000000b\r
+db 00000000b\r
+; 0 48\r
+db 01111100b\r
+db 11001110b\r
+db 11011110b\r
+db 11110110b\r
+db 11100110b\r
+db 11000110b\r
+db 01111100b\r
+db 00000000b\r
+; 1 49\r
+db 00110000b\r
+db 01110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 11111100b\r
+db 00000000b\r
+; 2 50\r
+db 01111000b\r
+db 11001100b\r
+db 00001100b\r
+db 00111000b\r
+db 01100000b\r
+db 11001100b\r
+db 11111100b\r
+db 00000000b\r
+; 3 51\r
+db 01111000b\r
+db 11001100b\r
+db 00001100b\r
+db 00111000b\r
+db 00001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; 4 52\r
+db 00011100b\r
+db 00111100b\r
+db 01101100b\r
+db 11001100b\r
+db 11111110b\r
+db 00001100b\r
+db 00011110b\r
+db 00000000b\r
+; 5 53\r
+db 11111100b\r
+db 11000000b\r
+db 11111000b\r
+db 00001100b\r
+db 00001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; 6 54\r
+db 00111000b\r
+db 01100000b\r
+db 11000000b\r
+db 11111000b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; 7 55\r
+db 11111100b\r
+db 11001100b\r
+db 00001100b\r
+db 00011000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00000000b\r
+; 8 56\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; 9 57\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 01111100b\r
+db 00001100b\r
+db 00011000b\r
+db 01110000b\r
+db 00000000b\r
+; : 58\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+; ; 59\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00110000b\r
+; < 60\r
+db 00011000b\r
+db 00110000b\r
+db 01100000b\r
+db 11000000b\r
+db 01100000b\r
+db 00110000b\r
+db 00011000b\r
+db 00000000b\r
+; = 61\r
+db 00000000b\r
+db 00000000b\r
+db 01111110b\r
+db 00000000b\r
+db 01111110b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; > 62\r
+db 01100000b\r
+db 00110000b\r
+db 00011000b\r
+db 00001100b\r
+db 00011000b\r
+db 00110000b\r
+db 01100000b\r
+db 00000000b\r
+; ? 63\r
+db 00111100b\r
+db 01100110b\r
+db 00001100b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+db 00011000b\r
+db 00000000b\r
+; @ 64\r
+db 01111100b\r
+db 11000110b\r
+db 11011110b\r
+db 11011110b\r
+db 11011100b\r
+db 11000000b\r
+db 01111100b\r
+db 00000000b\r
+; A 65\r
+db 00110000b\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 11111100b\r
+db 11001100b\r
+db 11001100b\r
+db 00000000b\r
+; B 66\r
+db 11111100b\r
+db 01100110b\r
+db 01100110b\r
+db 01111100b\r
+db 01100110b\r
+db 01100110b\r
+db 11111100b\r
+db 00000000b\r
+; C 67\r
+db 00111100b\r
+db 01100110b\r
+db 11000000b\r
+db 11000000b\r
+db 11000000b\r
+db 01100110b\r
+db 00111100b\r
+db 00000000b\r
+; D 68\r
+db 11111000b\r
+db 01101100b\r
+db 01100110b\r
+db 01100110b\r
+db 01100110b\r
+db 01101100b\r
+db 11111000b\r
+db 00000000b\r
+; E 69\r
+db 11111110b\r
+db 01100010b\r
+db 01101000b\r
+db 01111000b\r
+db 01101000b\r
+db 01100010b\r
+db 11111110b\r
+db 00000000b\r
+; F 70\r
+db 11111110b\r
+db 01100010b\r
+db 01101000b\r
+db 01111000b\r
+db 01101000b\r
+db 01100000b\r
+db 11110000b\r
+db 00000000b\r
+; G 71\r
+db 00111100b\r
+db 01100110b\r
+db 11000000b\r
+db 11000000b\r
+db 11001110b\r
+db 01100110b\r
+db 00111010b\r
+db 00000000b\r
+; H 72\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11111100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 00000000b\r
+; I 73\r
+db 01111000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 01111000b\r
+db 00000000b\r
+; J 74\r
+db 00011110b\r
+db 00001100b\r
+db 00001100b\r
+db 00001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; K 75\r
+db 11100110b\r
+db 01100110b\r
+db 01101100b\r
+db 01111000b\r
+db 01101100b\r
+db 01100110b\r
+db 11100110b\r
+db 00000000b\r
+; L 76\r
+db 11110000b\r
+db 01100000b\r
+db 01100000b\r
+db 01100000b\r
+db 01100010b\r
+db 01100110b\r
+db 11111110b\r
+db 00000000b\r
+; M 77\r
+db 11000110b\r
+db 11101110b\r
+db 11111110b\r
+db 11111110b\r
+db 11010110b\r
+db 11000110b\r
+db 11000110b\r
+db 00000000b\r
+; N 78\r
+db 11000110b\r
+db 11100110b\r
+db 11110110b\r
+db 11011110b\r
+db 11001110b\r
+db 11000110b\r
+db 11000110b\r
+db 00000000b\r
+; O 79\r
+db 00111000b\r
+db 01101100b\r
+db 11000110b\r
+db 11000110b\r
+db 11000110b\r
+db 01101100b\r
+db 00111000b\r
+db 00000000b\r
+; P 80\r
+db 11111100b\r
+db 01100110b\r
+db 01100110b\r
+db 01111100b\r
+db 01100000b\r
+db 01100000b\r
+db 11110000b\r
+db 00000000b\r
+; Q 81\r
+db 01111100b\r
+db 11000110b\r
+db 11000110b\r
+db 11000110b\r
+db 11010110b\r
+db 01111100b\r
+db 00001110b\r
+db 00000000b\r
+; R 82\r
+db 11111100b\r
+db 01100110b\r
+db 01100110b\r
+db 01111100b\r
+db 01101100b\r
+db 01100110b\r
+db 11100110b\r
+db 00000000b\r
+; S 83\r
+db 01111100b\r
+db 11000110b\r
+db 11100000b\r
+db 01111000b\r
+db 00001110b\r
+db 11000110b\r
+db 01111100b\r
+db 00000000b\r
+; T 84\r
+db 11111100b\r
+db 10110100b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 01111000b\r
+db 00000000b\r
+; U 85\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11111100b\r
+db 00000000b\r
+; V 86\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00110000b\r
+db 00000000b\r
+; W 87\r
+db 11000110b\r
+db 11000110b\r
+db 11000110b\r
+db 11000110b\r
+db 11010110b\r
+db 11111110b\r
+db 01101100b\r
+db 00000000b\r
+; X 88\r
+db 11000110b\r
+db 11000110b\r
+db 01101100b\r
+db 00111000b\r
+db 01101100b\r
+db 11000110b\r
+db 11000110b\r
+db 00000000b\r
+; Y 89\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00110000b\r
+db 00110000b\r
+db 01111000b\r
+db 00000000b\r
+; Z 90\r
+db 11111110b\r
+db 11000110b\r
+db 10001100b\r
+db 00011000b\r
+db 00110010b\r
+db 01100110b\r
+db 11111110b\r
+db 00000000b\r
+; [ 91\r
+db 01111000b\r
+db 01100000b\r
+db 01100000b\r
+db 01100000b\r
+db 01100000b\r
+db 01100000b\r
+db 01111000b\r
+db 00000000b\r
+; \ 92\r
+db 11000000b\r
+db 01100000b\r
+db 00110000b\r
+db 00011000b\r
+db 00001100b\r
+db 00000110b\r
+db 00000010b\r
+db 00000000b\r
+; ] 93\r
+db 01111000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 01111000b\r
+db 00000000b\r
+; ^ 94\r
+db 00010000b\r
+db 00111000b\r
+db 01101100b\r
+db 11000110b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; _ 95\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 11111111b\r
+; ` 96\r
+db 00110000b\r
+db 00110000b\r
+db 00011000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; a 97\r
+db 00000000b\r
+db 00000000b\r
+db 01111000b\r
+db 00001100b\r
+db 01111100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; b 98\r
+db 11100000b\r
+db 01100000b\r
+db 01100000b\r
+db 01111100b\r
+db 01100110b\r
+db 01100110b\r
+db 11011100b\r
+db 00000000b\r
+; c 99\r
+db 00000000b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11000000b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; d 100\r
+db 00011100b\r
+db 00001100b\r
+db 00001100b\r
+db 01111100b\r
+db 11001100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; e 101\r
+db 00000000b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11111100b\r
+db 11000000b\r
+db 01111000b\r
+db 00000000b\r
+; f 102\r
+db 00111000b\r
+db 01101100b\r
+db 01100100b\r
+db 11110000b\r
+db 01100000b\r
+db 01100000b\r
+db 11110000b\r
+db 00000000b\r
+; g 103\r
+db 00000000b\r
+db 00000000b\r
+db 01110110b\r
+db 11001100b\r
+db 11001100b\r
+db 01111100b\r
+db 00001100b\r
+db 11111000b\r
+; h 104\r
+db 11100000b\r
+db 01100000b\r
+db 01101100b\r
+db 01110110b\r
+db 01100110b\r
+db 01100110b\r
+db 11100110b\r
+db 00000000b\r
+; i 105\r
+db 00110000b\r
+db 00000000b\r
+db 01110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 01111000b\r
+db 00000000b\r
+; j 106\r
+db 00001100b\r
+db 00000000b\r
+db 00011100b\r
+db 00001100b\r
+db 00001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+; k 107\r
+db 11100000b\r
+db 01100000b\r
+db 01100110b\r
+db 01101100b\r
+db 01111000b\r
+db 01101100b\r
+db 11100110b\r
+db 00000000b\r
+; l 108\r
+db 01110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 01111000b\r
+db 00000000b\r
+; m 109\r
+db 00000000b\r
+db 00000000b\r
+db 11001100b\r
+db 11111110b\r
+db 11111110b\r
+db 11010110b\r
+db 11010110b\r
+db 00000000b\r
+; n 110\r
+db 00000000b\r
+db 00000000b\r
+db 10111000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 00000000b\r
+; o 111\r
+db 00000000b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; p 112\r
+db 00000000b\r
+db 00000000b\r
+db 11011100b\r
+db 01100110b\r
+db 01100110b\r
+db 01111100b\r
+db 01100000b\r
+db 11110000b\r
+; q 113\r
+db 00000000b\r
+db 00000000b\r
+db 01110110b\r
+db 11001100b\r
+db 11001100b\r
+db 01111100b\r
+db 00001100b\r
+db 00011110b\r
+; r 114\r
+db 00000000b\r
+db 00000000b\r
+db 11011100b\r
+db 01110110b\r
+db 01100010b\r
+db 01100000b\r
+db 11110000b\r
+db 00000000b\r
+; s 115\r
+db 00000000b\r
+db 00000000b\r
+db 01111100b\r
+db 11000000b\r
+db 01110000b\r
+db 00011100b\r
+db 11111000b\r
+db 00000000b\r
+; t 116\r
+db 00010000b\r
+db 00110000b\r
+db 11111100b\r
+db 00110000b\r
+db 00110000b\r
+db 00110100b\r
+db 00011000b\r
+db 00000000b\r
+; u 117\r
+db 00000000b\r
+db 00000000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; v 118\r
+db 00000000b\r
+db 00000000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00110000b\r
+db 00000000b\r
+; w 119\r
+db 00000000b\r
+db 00000000b\r
+db 11000110b\r
+db 11000110b\r
+db 11010110b\r
+db 11111110b\r
+db 01101100b\r
+db 00000000b\r
+; x 120\r
+db 00000000b\r
+db 00000000b\r
+db 11000110b\r
+db 01101100b\r
+db 00111000b\r
+db 01101100b\r
+db 11000110b\r
+db 00000000b\r
+; y 121\r
+db 00000000b\r
+db 00000000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01111100b\r
+db 00001100b\r
+db 11111000b\r
+; z 122\r
+db 00000000b\r
+db 00000000b\r
+db 11111100b\r
+db 10011000b\r
+db 00110000b\r
+db 01100100b\r
+db 11111100b\r
+db 00000000b\r
+; { 123\r
+db 00011100b\r
+db 00110000b\r
+db 00110000b\r
+db 11100000b\r
+db 00110000b\r
+db 00110000b\r
+db 00011100b\r
+db 00000000b\r
+; | 124\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+; } 125\r
+db 11100000b\r
+db 00110000b\r
+db 00110000b\r
+db 00011100b\r
+db 00110000b\r
+db 00110000b\r
+db 11100000b\r
+db 00000000b\r
+; ~ 126\r
+db 01110110b\r
+db 11011100b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; \7f 127\r
+db 00000000b\r
+db 00010000b\r
+db 00111000b\r
+db 01101100b\r
+db 11000110b\r
+db 11000110b\r
+db 11111110b\r
+db 00000000b\r
+; � 128\r
+db 01111100b\r
+db 11000110b\r
+db 11000000b\r
+db 11000110b\r
+db 01111100b\r
+db 00001100b\r
+db 00000110b\r
+db 01111100b\r
+; � 129\r
+db 00000000b\r
+db 11001100b\r
+db 00000000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; � 130\r
+db 00011100b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11111100b\r
+db 11000000b\r
+db 01111000b\r
+db 00000000b\r
+; � 131\r
+db 01111110b\r
+db 10000001b\r
+db 00111100b\r
+db 00000110b\r
+db 00111110b\r
+db 01100110b\r
+db 00111011b\r
+db 00000000b\r
+; � 132\r
+db 11001100b\r
+db 00000000b\r
+db 01111000b\r
+db 00001100b\r
+db 01111100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; � 133\r
+db 11100000b\r
+db 00000000b\r
+db 01111000b\r
+db 00001100b\r
+db 01111100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; � 134\r
+db 00110000b\r
+db 00110000b\r
+db 01111000b\r
+db 00001100b\r
+db 01111100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; � 135\r
+db 00000000b\r
+db 00000000b\r
+db 01111100b\r
+db 11000110b\r
+db 11000000b\r
+db 01111000b\r
+db 00001100b\r
+db 00111000b\r
+; � 136\r
+db 01111110b\r
+db 10000001b\r
+db 00111100b\r
+db 01100110b\r
+db 01111110b\r
+db 01100000b\r
+db 00111100b\r
+db 00000000b\r
+; � 137\r
+db 11001100b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11111100b\r
+db 11000000b\r
+db 01111000b\r
+db 00000000b\r
+; � 138\r
+db 11100000b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11111100b\r
+db 11000000b\r
+db 01111000b\r
+db 00000000b\r
+; � 139\r
+db 11001100b\r
+db 00000000b\r
+db 01110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 01111000b\r
+db 00000000b\r
+; � 140\r
+db 01111100b\r
+db 10000010b\r
+db 00111000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00111100b\r
+db 00000000b\r
+; � 141\r
+db 11100000b\r
+db 00000000b\r
+db 01110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 01111000b\r
+db 00000000b\r
+; � 142\r
+db 11000110b\r
+db 00010000b\r
+db 01111100b\r
+db 11000110b\r
+db 11111110b\r
+db 11000110b\r
+db 11000110b\r
+db 00000000b\r
+; � 143\r
+db 00110000b\r
+db 00110000b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11111100b\r
+db 11001100b\r
+db 00000000b\r
+; � 144\r
+db 00011100b\r
+db 00000000b\r
+db 11111100b\r
+db 01100000b\r
+db 01111000b\r
+db 01100000b\r
+db 11111100b\r
+db 00000000b\r
+; � 145\r
+db 00000000b\r
+db 00000000b\r
+db 01111111b\r
+db 00001100b\r
+db 01111111b\r
+db 11001100b\r
+db 01111111b\r
+db 00000000b\r
+; � 146\r
+db 00111110b\r
+db 01101100b\r
+db 11001100b\r
+db 11111110b\r
+db 11001100b\r
+db 11001100b\r
+db 11001110b\r
+db 00000000b\r
+; � 147\r
+db 01111000b\r
+db 10000100b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; � 148\r
+db 00000000b\r
+db 11001100b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; � 149\r
+db 00000000b\r
+db 11100000b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; � 150\r
+db 01111000b\r
+db 10000100b\r
+db 00000000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; � 151\r
+db 00000000b\r
+db 11100000b\r
+db 00000000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; � 152\r
+db 00000000b\r
+db 11001100b\r
+db 00000000b\r
+db 11001100b\r
+db 11001100b\r
+db 01111100b\r
+db 00001100b\r
+db 11111000b\r
+; � 153\r
+db 11000011b\r
+db 00011000b\r
+db 00111100b\r
+db 01100110b\r
+db 01100110b\r
+db 00111100b\r
+db 00011000b\r
+db 00000000b\r
+; � 154\r
+db 11001100b\r
+db 00000000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; � 155\r
+db 00011000b\r
+db 00011000b\r
+db 01111110b\r
+db 11000000b\r
+db 11000000b\r
+db 01111110b\r
+db 00011000b\r
+db 00011000b\r
+; � 156\r
+db 00111000b\r
+db 01101100b\r
+db 01100100b\r
+db 11110000b\r
+db 01100000b\r
+db 11100110b\r
+db 11111100b\r
+db 00000000b\r
+; � 157\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00110000b\r
+db 11111100b\r
+db 00110000b\r
+db 11111100b\r
+db 00110000b\r
+; � 158\r
+db 11111000b\r
+db 11001100b\r
+db 11001100b\r
+db 11111010b\r
+db 11000110b\r
+db 11001111b\r
+db 11000110b\r
+db 11000011b\r
+; � 159\r
+db 00001110b\r
+db 00011011b\r
+db 00011000b\r
+db 00111100b\r
+db 00011000b\r
+db 00011000b\r
+db 11011000b\r
+db 01110000b\r
+; � 160\r
+db 00011100b\r
+db 00000000b\r
+db 01111000b\r
+db 00001100b\r
+db 01111100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; � 161\r
+db 00111000b\r
+db 00000000b\r
+db 01110000b\r
+db 00110000b\r
+db 00110000b\r
+db 00110000b\r
+db 01111000b\r
+db 00000000b\r
+; � 162\r
+db 00000000b\r
+db 00011100b\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; � 163\r
+db 00000000b\r
+db 00011100b\r
+db 00000000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 01110110b\r
+db 00000000b\r
+; � 164\r
+db 00000000b\r
+db 11111000b\r
+db 00000000b\r
+db 10111000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 00000000b\r
+; � 165\r
+db 11111100b\r
+db 00000000b\r
+db 11001100b\r
+db 11101100b\r
+db 11111100b\r
+db 11011100b\r
+db 11001100b\r
+db 00000000b\r
+; � 166\r
+db 00111100b\r
+db 01101100b\r
+db 01101100b\r
+db 00111110b\r
+db 00000000b\r
+db 01111110b\r
+db 00000000b\r
+db 00000000b\r
+; � 167\r
+db 00111000b\r
+db 01101100b\r
+db 01101100b\r
+db 00111000b\r
+db 00000000b\r
+db 01111100b\r
+db 00000000b\r
+db 00000000b\r
+; � 168\r
+db 00011000b\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00110000b\r
+db 01100110b\r
+db 00111100b\r
+db 00000000b\r
+; � 169\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 11111100b\r
+db 11000000b\r
+db 11000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 170\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 11111100b\r
+db 00001100b\r
+db 00001100b\r
+db 00000000b\r
+db 00000000b\r
+; � 171\r
+db 11000110b\r
+db 11001100b\r
+db 11011000b\r
+db 00110110b\r
+db 01101011b\r
+db 11000010b\r
+db 10000100b\r
+db 00001111b\r
+; � 172\r
+db 11000011b\r
+db 11000110b\r
+db 11001100b\r
+db 11011011b\r
+db 00110111b\r
+db 01101101b\r
+db 11001111b\r
+db 00000011b\r
+; � 173\r
+db 00011000b\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00111100b\r
+db 00111100b\r
+db 00011000b\r
+db 00000000b\r
+; � 174\r
+db 00000000b\r
+db 00110011b\r
+db 01100110b\r
+db 11001100b\r
+db 01100110b\r
+db 00110011b\r
+db 00000000b\r
+db 00000000b\r
+; � 175\r
+db 00000000b\r
+db 11001100b\r
+db 01100110b\r
+db 00110011b\r
+db 01100110b\r
+db 11001100b\r
+db 00000000b\r
+db 00000000b\r
+; � 176\r
+db 00100010b\r
+db 10001000b\r
+db 00100010b\r
+db 10001000b\r
+db 00100010b\r
+db 10001000b\r
+db 00100010b\r
+db 10001000b\r
+; � 177\r
+db 01010101b\r
+db 10101010b\r
+db 01010101b\r
+db 10101010b\r
+db 01010101b\r
+db 10101010b\r
+db 01010101b\r
+db 10101010b\r
+; � 178\r
+db 11011011b\r
+db 11110110b\r
+db 11011011b\r
+db 01101111b\r
+db 11011011b\r
+db 01111110b\r
+db 11010111b\r
+db 11101101b\r
+; � 179\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 180\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 11111000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 181\r
+db 00011000b\r
+db 00011000b\r
+db 11111000b\r
+db 00011000b\r
+db 11111000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 182\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 11110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 183\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 11111110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 184\r
+db 00000000b\r
+db 00000000b\r
+db 11111000b\r
+db 00011000b\r
+db 11111000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 185\r
+db 00110110b\r
+db 00110110b\r
+db 11110110b\r
+db 00000110b\r
+db 11110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 186\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 187\r
+db 00000000b\r
+db 00000000b\r
+db 11111110b\r
+db 00000110b\r
+db 11110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 188\r
+db 00110110b\r
+db 00110110b\r
+db 11110110b\r
+db 00000110b\r
+db 11111110b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 189\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 11111110b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 190\r
+db 00011000b\r
+db 00011000b\r
+db 11111000b\r
+db 00011000b\r
+db 11111000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 191\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 11111000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 192\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 193\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 11111111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 194\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 11111111b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 195\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011111b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 196\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 11111111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 197\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 11111111b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 198\r
+db 00011000b\r
+db 00011000b\r
+db 00011111b\r
+db 00011000b\r
+db 00011111b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 199\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110111b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 200\r
+db 00110110b\r
+db 00110110b\r
+db 00110111b\r
+db 00110000b\r
+db 00111111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 201\r
+db 00000000b\r
+db 00000000b\r
+db 00111111b\r
+db 00110000b\r
+db 00110111b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 202\r
+db 00110110b\r
+db 00110110b\r
+db 11110111b\r
+db 00000000b\r
+db 11111111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 203\r
+db 00000000b\r
+db 00000000b\r
+db 11111111b\r
+db 00000000b\r
+db 11110111b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 204\r
+db 00110110b\r
+db 00110110b\r
+db 00110111b\r
+db 00110000b\r
+db 00110111b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 205\r
+db 00000000b\r
+db 00000000b\r
+db 11111111b\r
+db 00000000b\r
+db 11111111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 206\r
+db 00110110b\r
+db 00110110b\r
+db 11110111b\r
+db 00000000b\r
+db 11110111b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 207\r
+db 00011000b\r
+db 00011000b\r
+db 11111111b\r
+db 00000000b\r
+db 11111111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 208\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 11111111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 209\r
+db 00000000b\r
+db 00000000b\r
+db 11111111b\r
+db 00000000b\r
+db 11111111b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 210\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 11111111b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 211\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00111111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 212\r
+db 00011000b\r
+db 00011000b\r
+db 00011111b\r
+db 00011000b\r
+db 00011111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 213\r
+db 00000000b\r
+db 00000000b\r
+db 00011111b\r
+db 00011000b\r
+db 00011111b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 214\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00111111b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 215\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+db 11111111b\r
+db 00110110b\r
+db 00110110b\r
+db 00110110b\r
+; � 216\r
+db 00011000b\r
+db 00011000b\r
+db 11111111b\r
+db 00011000b\r
+db 11111111b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 217\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 11111000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 218\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00011111b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 219\r
+db 11111111b\r
+db 11111111b\r
+db 11111111b\r
+db 11111111b\r
+db 11111111b\r
+db 11111111b\r
+db 11111111b\r
+db 11111111b\r
+; � 220\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 11111111b\r
+db 11111111b\r
+db 11111111b\r
+db 11111111b\r
+; � 221\r
+db 11110000b\r
+db 11110000b\r
+db 11110000b\r
+db 11110000b\r
+db 11110000b\r
+db 11110000b\r
+db 11110000b\r
+db 11110000b\r
+; � 222\r
+db 00001111b\r
+db 00001111b\r
+db 00001111b\r
+db 00001111b\r
+db 00001111b\r
+db 00001111b\r
+db 00001111b\r
+db 00001111b\r
+; � 223\r
+db 11111111b\r
+db 11111111b\r
+db 11111111b\r
+db 11111111b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 224\r
+db 00000000b\r
+db 00000000b\r
+db 01110110b\r
+db 11011100b\r
+db 11001000b\r
+db 11011100b\r
+db 01110110b\r
+db 00000000b\r
+; � 225\r
+db 00000000b\r
+db 01111000b\r
+db 11001100b\r
+db 11111000b\r
+db 11001100b\r
+db 11111000b\r
+db 11000000b\r
+db 11000000b\r
+; � 226\r
+db 00000000b\r
+db 11111100b\r
+db 11001100b\r
+db 11000000b\r
+db 11000000b\r
+db 11000000b\r
+db 11000000b\r
+db 00000000b\r
+; � 227\r
+db 00000000b\r
+db 00000000b\r
+db 11111110b\r
+db 01101100b\r
+db 01101100b\r
+db 01101100b\r
+db 01101100b\r
+db 00000000b\r
+; � 228\r
+db 11111100b\r
+db 11001100b\r
+db 01100000b\r
+db 00110000b\r
+db 01100000b\r
+db 11001100b\r
+db 11111100b\r
+db 00000000b\r
+; � 229\r
+db 00000000b\r
+db 00000000b\r
+db 01111110b\r
+db 11011000b\r
+db 11011000b\r
+db 11011000b\r
+db 01110000b\r
+db 00000000b\r
+; � 230\r
+db 00000000b\r
+db 01100110b\r
+db 01100110b\r
+db 01100110b\r
+db 01100110b\r
+db 01111100b\r
+db 01100000b\r
+db 11000000b\r
+; � 231\r
+db 00000000b\r
+db 01110110b\r
+db 11011100b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+; � 232\r
+db 11111100b\r
+db 00110000b\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00110000b\r
+db 11111100b\r
+; � 233\r
+db 00111000b\r
+db 01101100b\r
+db 11000110b\r
+db 11111110b\r
+db 11000110b\r
+db 01101100b\r
+db 00111000b\r
+db 00000000b\r
+; � 234\r
+db 00111000b\r
+db 01101100b\r
+db 11000110b\r
+db 11000110b\r
+db 01101100b\r
+db 01101100b\r
+db 11101110b\r
+db 00000000b\r
+; � 235\r
+db 00011100b\r
+db 00110000b\r
+db 00011000b\r
+db 01111100b\r
+db 11001100b\r
+db 11001100b\r
+db 01111000b\r
+db 00000000b\r
+; � 236\r
+db 00000000b\r
+db 00000000b\r
+db 01111110b\r
+db 11011011b\r
+db 11011011b\r
+db 01111110b\r
+db 00000000b\r
+db 00000000b\r
+; � 237\r
+db 00000110b\r
+db 00001100b\r
+db 01111110b\r
+db 11011011b\r
+db 11011011b\r
+db 01111110b\r
+db 01100000b\r
+db 11000000b\r
+; � 238\r
+db 00111000b\r
+db 01100000b\r
+db 11000000b\r
+db 11111000b\r
+db 11000000b\r
+db 01100000b\r
+db 00111000b\r
+db 00000000b\r
+; � 239\r
+db 01111000b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 11001100b\r
+db 00000000b\r
+; � 240\r
+db 00000000b\r
+db 01111110b\r
+db 00000000b\r
+db 01111110b\r
+db 00000000b\r
+db 01111110b\r
+db 00000000b\r
+db 00000000b\r
+; � 241\r
+db 00011000b\r
+db 00011000b\r
+db 01111110b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+db 01111110b\r
+db 00000000b\r
+; � 242\r
+db 01100000b\r
+db 00110000b\r
+db 00011000b\r
+db 00110000b\r
+db 01100000b\r
+db 00000000b\r
+db 11111100b\r
+db 00000000b\r
+; � 243\r
+db 00011000b\r
+db 00110000b\r
+db 01100000b\r
+db 00110000b\r
+db 00011000b\r
+db 00000000b\r
+db 11111100b\r
+db 00000000b\r
+; � 244\r
+db 00001110b\r
+db 00011011b\r
+db 00011011b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+; � 245\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 00011000b\r
+db 11011000b\r
+db 11011000b\r
+db 01110000b\r
+; � 246\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+db 01111110b\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+; � 247\r
+db 00000000b\r
+db 01110110b\r
+db 11011100b\r
+db 00000000b\r
+db 01110110b\r
+db 11011100b\r
+db 00000000b\r
+db 00000000b\r
+; � 248\r
+db 00111000b\r
+db 01101100b\r
+db 01101100b\r
+db 00111000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 249\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00011000b\r
+db 00011000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 250\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00011000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 251\r
+db 00001111b\r
+db 00001100b\r
+db 00001100b\r
+db 00001100b\r
+db 11101100b\r
+db 01101100b\r
+db 00111100b\r
+db 00011100b\r
+; � 252\r
+db 01011000b\r
+db 01101100b\r
+db 01101100b\r
+db 01101100b\r
+db 01101100b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 253\r
+db 01110000b\r
+db 10011000b\r
+db 00110000b\r
+db 01100000b\r
+db 11111000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+; � 254\r
+db 00000000b\r
+db 00000000b\r
+db 00111100b\r
+db 00111100b\r
+db 00111100b\r
+db 00111100b\r
+db 00000000b\r
+db 00000000b\r
+; � 255\r
+db 10001000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
+db 10000000b\r
+db 00000000b\r
+db 00000000b\r
+db 00000000b\r
--- /dev/null
+DECLARE SUB getline (a$)\r
+DECLARE SUB start ()\r
+DIM SHARED byte AS STRING * 1\r
+DIM SHARED endf\r
+\r
+start\r
+\r
+OPEN COMMAND$ + ".5th" FOR BINARY AS #1\r
+OPEN COMMAND$ + ".src" FOR OUTPUT AS #2\r
+\r
+1\r
+getline a$\r
+IF endf = 1 THEN GOTO 2\r
+PRINT #2, a$\r
+GOTO 1\r
+2\r
+\r
+CLOSE #2\r
+CLOSE #1\r
+\r
+SYSTEM\r
+\r
+SUB getline (a$)\r
+\r
+a$ = ""\r
+3\r
+IF EOF(1) <> 0 THEN endf = 1: GOTO 4\r
+GET #1, , byte\r
+IF ASC(byte) <= 9 THEN\r
+ byte = CHR$(48 + ASC(byte))\r
+END IF\r
+IF ASC(byte) <= 15 THEN\r
+ byte = CHR$(65 + ASC(byte) - 10)\r
+END IF\r
+IF ASC(byte) = 255 THEN\r
+ byte = " "\r
+END IF\r
+IF ASC(byte) = 253 THEN\r
+ byte = CHR$(9)\r
+END IF\r
+\r
+IF byte = CHR$(254) THEN GOTO 4\r
+a$ = a$ + byte\r
+GOTO 3\r
+4\r
+\r
+END SUB\r
+\r
+SUB start\r
+endf = 0\r
+IF COMMAND$ = "" THEN END\r
+END SUB\r
+\r
--- /dev/null
+' Disk file editor for FIFTH\r
+' Svjatoslav Agejenko: n0@hot.ee\r
+\r
+DECLARE SUB fdisp ()\r
+DECLARE SUB fopen (a$)\r
+DECLARE SUB ask (a$, b$)\r
+DECLARE SUB addk (a$)\r
+DECLARE SUB llen (a%, l%)\r
+DECLARE SUB save (a%)\r
+DECLARE SUB disp ()\r
+DEFINT A-Z\r
+\r
+DECLARE SUB load (a)\r
+DECLARE SUB start ()\r
+DECLARE SUB edit ()\r
+DIM SHARED buf(0 TO 31, 0 TO 31)\r
+DIM SHARED obuf(0 TO 31, 0 TO 31)\r
+DIM SHARED byte AS STRING * 1\r
+DIM SHARED font(0 TO 20, 0 TO 255)\r
+DIM SHARED eb\r
+DIM SHARED keys(0 TO 10000)\r
+DIM SHARED keyl, keyc\r
+DIM SHARED curx, cury\r
+DIM SHARED fil$(0 TO 1000)\r
+DIM SHARED fline, froll\r
+DIM SHARED filename$\r
+\r
+start\r
+\r
+OPEN "..\..\disk.raw" FOR BINARY AS #1\r
+\r
+edit\r
+\r
+CLOSE #1\r
+SYSTEM\r
+\r
+SUB addk (a$)\r
+keys(keyl) = ASC(a$)\r
+keyl = keyl + 1\r
+IF keyl > 10000 THEN keyl = 0\r
+END SUB\r
+\r
+SUB ask (a$, b$)\r
+LOCATE 16, 34\r
+PRINT SPACE$(46)\r
+LOCATE 16, 34\r
+COLOR 15\r
+PRINT a$\r
+COLOR 10\r
+LOCATE 16, 34 + LEN(a$)\r
+INPUT "", b$\r
+LOCATE 16, 34\r
+PRINT SPACE$(46)\r
+COLOR 15\r
+END SUB\r
+\r
+SUB disp\r
+\r
+FOR y = 0 TO 31\r
+FOR x = 0 TO 31\r
+c = buf(x, y)\r
+IF c <> obuf(x, y) THEN\r
+ PUT (x * 8, y * 8), font(0, c), PSET\r
+ obuf(x, y) = c\r
+END IF\r
+NEXT x\r
+NEXT y\r
+\r
+x1 = curx * 8\r
+y1 = cury * 8\r
+FOR y = y1 TO y1 + 7\r
+FOR x = x1 TO x1 + 7\r
+c = POINT(x, y)\r
+IF c = 15 THEN c = 0 ELSE c = 10\r
+PSET (x, y), c\r
+NEXT x\r
+NEXT y\r
+obuf(curx, cury) = -1\r
+\r
+LOCATE 1, 77\r
+PRINT " "\r
+LOCATE 1, 76\r
+PRINT buf(curx, cury)\r
+END SUB\r
+\r
+SUB edit\r
+fdisp\r
+leb = -1\r
+m = 0\r
+1\r
+IF eb <> leb THEN\r
+ IF m = 1 THEN\r
+ save leb\r
+ m = 0\r
+ END IF\r
+ load eb\r
+ leb = eb\r
+ LOCATE 1, 60\r
+ PRINT "page:"; eb; " "\r
+END IF\r
+disp\r
+2\r
+a$ = INKEY$\r
+bk = 0\r
+IF a$ = "" THEN\r
+ IF keyl = keyc THEN GOTO 2\r
+ a$ = CHR$(keys(keyc))\r
+ keyc = keyc + 1\r
+ IF keyc > 10000 THEN keyc = 0\r
+ bk = 1\r
+END IF\r
+\r
+IF a$ = CHR$(0) + CHR$(73) THEN eb = eb - 1\r
+IF a$ = CHR$(0) + CHR$(81) THEN eb = eb + 1\r
+IF a$ = CHR$(27) THEN GOTO 4\r
+IF a$ = CHR$(0) + "M" THEN curx = curx + 1\r
+IF a$ = CHR$(0) + "K" THEN curx = curx - 1\r
+IF a$ = CHR$(0) + "P" THEN cury = cury + 1\r
+IF a$ = CHR$(0) + "H" THEN cury = cury - 1\r
+IF a$ = CHR$(0) + "=" THEN ask "page: ", b$: eb = VAL(b$)\r
+IF a$ = CHR$(0) + "?" THEN ask "file: ", b$: fopen b$\r
+IF a$ = CHR$(0) + CHR$(132) THEN fline = fline - 1: fdisp\r
+IF a$ = CHR$(0) + CHR$(118) THEN fline = fline + 1: fdisp\r
+IF a$ = CHR$(0) + CHR$(64) THEN ' F6\r
+ d = 0\r
+ FOR b = 1 TO LEN(fil$(fline))\r
+ c$ = RIGHT$(LEFT$(fil$(fline), b), 1)\r
+ IF c$ = CHR$(9) THEN c$ = " "\r
+ IF c$ = " " OR c$ = CHR$(255) THEN d = d + 1 ELSE d = 0\r
+ IF d < 2 THEN addk c$\r
+ NEXT b\r
+END IF\r
+\r
+IF a$ = CHR$(0) + ";" THEN\r
+ FOR y = 0 TO 31\r
+ FOR x = 0 TO 31\r
+ buf(x, y) = 255\r
+ NEXT x\r
+ NEXT y\r
+ m = 1\r
+END IF\r
+\r
+IF a$ = CHR$(0) + CHR$(83) THEN\r
+ FOR b = curx TO 30\r
+ buf(b, cury) = buf(b + 1, cury)\r
+ NEXT b\r
+ buf(31, cury) = 255\r
+ m = 1\r
+END IF\r
+\r
+IF (a$ = CHR$(13)) AND (bk = 0) THEN\r
+a$ = ""\r
+IF cury < 31 THEN\r
+ FOR a = 31 TO cury + 2 STEP -1\r
+ FOR b = 0 TO 31\r
+ buf(b, a) = buf(b, a - 1)\r
+ NEXT b\r
+ NEXT a\r
+ FOR a = 0 TO 31\r
+ buf(a, cury + 1) = 255\r
+ NEXT a\r
+ FOR a = curx TO 31\r
+ SWAP buf(a, cury), buf(a - curx, cury + 1)\r
+ NEXT a\r
+ m = 1\r
+ cury = cury + 1\r
+ curx = 0\r
+END IF\r
+END IF\r
+\r
+IF LEN(a$) = 1 THEN\r
+ IF ASC(a$) = 32 THEN a$ = CHR$(255)\r
+ IF (a$ = CHR$(8)) AND (bk = 0) THEN\r
+ a$ = ""\r
+ IF curx > 0 THEN\r
+ FOR b = curx - 1 TO 30\r
+ buf(b, cury) = buf(b + 1, cury)\r
+ NEXT b\r
+ buf(31, cury) = 255\r
+ curx = curx - 1\r
+ m = 1\r
+ ELSE\r
+ IF cury > 0 THEN\r
+ llen cury - 1, a\r
+ curx = a\r
+ FOR b = a TO 31\r
+ buf(b, cury - 1) = buf(b - a, cury)\r
+ NEXT b\r
+ FOR a = cury TO 30\r
+ FOR b = 0 TO 31\r
+ buf(b, a) = buf(b, a + 1)\r
+ NEXT b\r
+ NEXT a\r
+ FOR b = 0 TO 31\r
+ buf(b, 31) = 255\r
+ NEXT b\r
+ m = 1\r
+ cury = cury - 1\r
+ END IF\r
+ END IF\r
+ END IF\r
+END IF\r
+\r
+IF a$ = CHR$(0) + "<" THEN\r
+ask "decimal number:", b$\r
+b$ = HEX$(VAL(b$))\r
+FOR a = 1 TO LEN(b$)\r
+ c = ASC(RIGHT$(LEFT$(b$, a), 1))\r
+ IF (c <= 57) AND (c >= 48) THEN d$ = CHR$(c - 48): addk d$\r
+ IF (c <= 70) AND (c >= 65) THEN d$ = CHR$(c - 55): addk d$\r
+NEXT a\r
+END IF\r
+\r
+IF a$ = CHR$(0) + CHR$(65) THEN\r
+FOR a = 999 TO fline STEP -1\r
+ fil$(a + 1) = fil$(a)\r
+NEXT a\r
+fil$(fline) = ""\r
+FOR a = curx TO 31\r
+ fil$(fline) = fil$(fline) + CHR$(buf(a, cury))\r
+NEXT a\r
+fdisp\r
+END IF\r
+\r
+IF a$ = CHR$(0) + ">" THEN\r
+ask "ascii code:", b$\r
+a$ = CHR$(VAL(b$))\r
+END IF\r
+\r
+IF LEN(a$) = 1 THEN\r
+ FOR b = 31 TO curx + 1 STEP -1\r
+ buf(b, cury) = buf(b - 1, cury)\r
+ NEXT b\r
+ buf(curx, cury) = ASC(a$)\r
+ curx = curx + 1\r
+ m = 1\r
+END IF\r
+\r
+IF eb < 0 THEN eb = 0\r
+IF curx < 0 THEN curx = 0\r
+IF cury < 0 THEN cury = 0\r
+IF curx > 31 THEN curx = 31\r
+IF cury > 31 THEN cury = 31\r
+GOTO 1\r
+4\r
+\r
+END SUB\r
+\r
+SUB fdisp\r
+IF fline < 0 THEN fline = 0\r
+IF fline > 1000 THEN fline = 1000\r
+IF fline - froll > 10 THEN froll = fline - 10\r
+IF fline - froll < 0 THEN froll = fline\r
+IF froll < 0 THEN froll = 0\r
+\r
+LOCATE 17, 1\r
+PRINT SPACE$(80)\r
+LOCATE 17, 1\r
+PRINT "file: " + filename$\r
+\r
+LOCATE 17, 20\r
+PRINT "line:"; fline\r
+\r
+FOR a = 0 TO 10\r
+ LOCATE a + 18, 1\r
+ IF a + froll = fline THEN\r
+ COLOR 10\r
+ IF fil$(a + froll) = SPACE$(LEN(fil$(a + froll))) THEN\r
+ FOR b = 1 TO 80\r
+ PRINT CHR$(219);\r
+ NEXT b\r
+ GOTO 7\r
+ END IF\r
+ ELSE\r
+ COLOR 12\r
+ END IF\r
+ PRINT fil$(a + froll) + SPACE$(80 - LEN(fil$(a + froll)));\r
+7\r
+NEXT a\r
+\r
+COLOR 15\r
+END SUB\r
+\r
+SUB fopen (a$)\r
+filename$ = a$\r
+FOR b = 0 TO 1000\r
+ fil$(b) = ""\r
+NEXT b\r
+\r
+b = 0\r
+OPEN filename$ FOR INPUT AS #2\r
+5\r
+IF EOF(2) <> 0 THEN GOTO 6\r
+LINE INPUT #2, c$\r
+fil$(b) = c$\r
+b = b + 1\r
+IF b > 1000 THEN GOTO 6\r
+GOTO 5\r
+6\r
+CLOSE #2\r
+\r
+fline = 0\r
+froll = 0\r
+fdisp\r
+END SUB\r
+\r
+SUB llen (a, l)\r
+FOR b = 31 TO 0 STEP -1\r
+IF buf(b, a) <> 255 THEN l = b + 1: GOTO 3\r
+NEXT b\r
+l = 0\r
+3\r
+END SUB\r
+\r
+SUB load (a)\r
+DIM c AS LONG\r
+DIM a1 AS LONG\r
+a1 = a\r
+c = a1 * 1024\r
+SEEK #1, c + 1\r
+FOR y = 0 TO 31\r
+ FOR x = 0 TO 31\r
+ GET #1, , byte\r
+ buf(x, y) = ASC(byte)\r
+ NEXT x\r
+NEXT y\r
+END SUB\r
+\r
+SUB save (a)\r
+DIM c AS LONG\r
+DIM a1 AS LONG\r
+a1 = a\r
+c = a1 * 1024\r
+SEEK #1, c + 1\r
+FOR y = 0 TO 31\r
+ FOR x = 0 TO 31\r
+ byte = CHR$(buf(x, y))\r
+ PUT #1, , byte\r
+ NEXT x\r
+NEXT y\r
+SOUND 5000, .1\r
+END SUB\r
+\r
+SUB start\r
+SCREEN 12\r
+COLOR 15\r
+eb = 7\r
+\r
+filename$ = "<noname>"\r
+fline = 0\r
+froll = 0\r
+keyl = 0\r
+keyc = 0\r
+\r
+OPEN "font.dat" FOR BINARY AS #1\r
+FOR f = 0 TO 255\r
+FOR y = 0 TO 7\r
+GET #1, , byte\r
+n = ASC(byte)\r
+b = 128\r
+FOR a = 0 TO 7\r
+IF n >= b THEN n = n - b: c = 15 ELSE c = 0\r
+b = b / 2\r
+PSET (a, y), c\r
+NEXT a\r
+NEXT y\r
+GET (0, 0)-(7, 7), font(0, f)\r
+NEXT f\r
+CLOSE #1\r
+\r
+FOR y = 0 TO 31\r
+FOR x = 0 TO 31\r
+obuf(x, y) = -1\r
+NEXT x\r
+NEXT y\r
+\r
+LOCATE 1, 34\r
+PRINT "F1 - clear page"\r
+LOCATE 2, 34\r
+PRINT "F2 - enter decimal number"\r
+LOCATE 3, 34\r
+PRINT "F3 - goto page"\r
+LOCATE 4, 34\r
+PRINT "F4 - enter character code"\r
+LOCATE 5, 34\r
+PRINT "F5 - load source file"\r
+LOCATE 6, 34\r
+PRINT "F6 - insert line from source file"\r
+LOCATE 7, 34\r
+PRINT "F7 - copy line to source file"\r
+\r
+LOCATE 1, 71\r
+PRINT "code:"\r
+END SUB\r
+\r
--- /dev/null
+DECLARE SUB bytew (fi&, d&, addr&)\r
+DECLARE SUB byter (fi&, addr&, d&)\r
+DECLARE SUB dwordw (fi&, b&, a&)\r
+DEFLNG A-Z\r
+\r
+DECLARE SUB savepath ()\r
+DECLARE SUB getson (a$)\r
+DECLARE SUB start ()\r
+\r
+DIM SHARED mitus, sona$(1 TO 50)\r
+DIM SHARED byte AS STRING * 1\r
+DIM SHARED length\r
+DIM SHARED srcfile$\r
+\r
+start\r
+\r
+OPEN "..\disk.raw" FOR BINARY AS #1\r
+savepath\r
+SEEK #1, 2000101\r
+OPEN srcfile$ FOR BINARY AS #2\r
+2\r
+IF EOF(2) <> 0 THEN GOTO 1\r
+GET #2, , byte\r
+length = length + 1\r
+PUT #1, , byte\r
+GOTO 2\r
+1\r
+CLOSE #2\r
+dwordw 1, length - 1, 2000000\r
+CLOSE #1\r
+\r
+SYSTEM\r
+\r
+SUB byter (fi, addr, d)\r
+SEEK #1, addr + 1\r
+GET fi, , byte\r
+d = ASC(byte)\r
+END SUB\r
+\r
+SUB bytew (fi, d, addr)\r
+SEEK #1, addr + 1\r
+byte = CHR$(d)\r
+PUT #1, , byte\r
+END SUB\r
+\r
+SUB dwordr (fi, a, f)\r
+byter fi, a, b\r
+byter fi, a + 1, c\r
+byter fi, a + 2, d\r
+byter fi, a + 3, e\r
+f = e * 16777216\r
+f = f + d * 65536 + c * 256 + b\r
+END SUB\r
+\r
+SUB dwordw (fi, b, a)\r
+c = b\r
+d = c \ 16777216\r
+c = c - (d * 16777216)\r
+\r
+e = c \ 65536\r
+c = c - (e * 65536)\r
+\r
+f = c \ 256\r
+c = c - (f * 256)\r
+\r
+bytew fi, c, a\r
+bytew fi, f, a + 1\r
+bytew fi, e, a + 2\r
+bytew fi, d, a + 3\r
+END SUB\r
+\r
+DEFSNG A-Z\r
+SUB getson (a$)\r
+mitus = 0\r
+\r
+d = 1\r
+FOR b = 1 TO LEN(a$)\r
+c$ = RIGHT$(LEFT$(a$, b), 1)\r
+IF c$ = " " THEN\r
+d = 1\r
+ELSE\r
+IF d = 1 THEN\r
+mitus = mitus + 1\r
+sona$(mitus) = ""\r
+d = 0\r
+END IF\r
+sona$(mitus) = sona$(mitus) + c$\r
+END IF\r
+NEXT b\r
+END SUB\r
+\r
+SUB savepath\r
+a$ = COMMAND$ + "\"\r
+f$ = ""\r
+ext$ = ""\r
+t$ = ""\r
+m = 0\r
+FOR b = 1 TO LEN(a$)\r
+ c$ = RIGHT$(LEFT$(a$, b), 1)\r
+ IF c$ = "." THEN m = 1: GOTO 3\r
+ IF c$ = "\" THEN\r
+ IF ext$ = "" THEN ext$ = "list"\r
+4 IF LEN(ext$) < 4 THEN ext$ = ext$ + "_": GOTO 4\r
+ t$ = t$ + ext$ + f$ + "\"\r
+ f$ = ""\r
+ ext$ = ""\r
+ GOTO 3\r
+ END IF\r
+ IF m = 0 THEN f$ = f$ + c$ ELSE ext$ = ext$ + c$\r
+3\r
+NEXT b\r
+t$ = LEFT$(t$, LEN(t$) - 1)\r
+\r
+' PRINT a$\r
+' PRINT t$\r
+\r
+t$ = t$ + CHR$(254)\r
+SEEK #1, 2000005\r
+PUT #1, , t$\r
+\r
+\r
+\r
+\r
+END SUB\r
+\r
+SUB start\r
+\r
+IF COMMAND$ = "" THEN END\r
+\r
+srcfile$ = COMMAND$\r
+\r
+\r
+END SUB\r
+\r
--- /dev/null
+DECLARE SUB getson (a$)\r
+DECLARE SUB start ()\r
+DIM SHARED mitus, sona$(1 TO 50)\r
+DIM SHARED byte AS STRING * 1\r
+\r
+start\r
+\r
+OPEN sona$(1) FOR BINARY AS #1\r
+PRINT "Seeking to:" + sona$(3)\r
+SEEK #1, VAL(sona$(3)) + 1\r
+OPEN sona$(2) FOR BINARY AS #2\r
+2\r
+IF EOF(2) <> 0 THEN GOTO 1\r
+GET #2, , byte\r
+PUT #1, , byte\r
+GOTO 2\r
+1\r
+CLOSE #2\r
+CLOSE #1\r
+\r
+SYSTEM\r
+\r
+SUB getson (a$)\r
+mitus = 0\r
+\r
+d = 1\r
+FOR b = 1 TO LEN(a$)\r
+c$ = RIGHT$(LEFT$(a$, b), 1)\r
+IF c$ = " " THEN\r
+d = 1\r
+ELSE\r
+IF d = 1 THEN\r
+mitus = mitus + 1\r
+sona$(mitus) = ""\r
+d = 0\r
+END IF\r
+sona$(mitus) = sona$(mitus) + c$\r
+END IF\r
+NEXT b\r
+END SUB\r
+\r
+SUB start\r
+\r
+IF COMMAND$ = "" THEN END\r
+\r
+getson COMMAND$\r
+\r
+\r
+END SUB\r
+\r
--- /dev/null
+DECLARE SUB chl (a$, b$)\r
+DECLARE SUB getline (a$)\r
+DECLARE SUB start ()\r
+DIM SHARED byte AS STRING * 1\r
+DIM SHARED er\r
+\r
+\r
+start\r
+\r
+OPEN COMMAND$ + ".src" FOR INPUT AS #1\r
+IF er = 0 THEN KILL COMMAND$ + ".5th"\r
+OPEN COMMAND$ + ".5th" FOR BINARY AS #2\r
+\r
+1\r
+IF EOF(1) <> 0 THEN GOTO 2\r
+LINE INPUT #1, a$\r
+\r
+c$ = ""\r
+e$ = ""\r
+FOR b = 1 TO LEN(a$)\r
+d$ = RIGHT$(LEFT$(a$, b), 1)\r
+IF d$ = " " THEN chl e$, c$: c$ = c$ + CHR$(255): GOTO 3\r
+IF d$ = CHR$(9) THEN chl e$, c$: c$ = c$ + CHR$(253): GOTO 3\r
+e$ = e$ + d$\r
+3\r
+NEXT b\r
+chl e$, c$\r
+c$ = c$ + CHR$(254)\r
+FOR b = 1 TO LEN(c$)\r
+ byte = RIGHT$(LEFT$(c$, b), 1)\r
+ PUT #2, , byte\r
+NEXT b\r
+GOTO 1\r
+2\r
+\r
+CLOSE #2\r
+CLOSE #1\r
+\r
+SYSTEM\r
+\r
+\r
+SUB chl (a$, b$)\r
+\r
+e$ = ""\r
+FOR c = 1 TO LEN(a$)\r
+d = ASC(RIGHT$(LEFT$(a$, c), 1))\r
+IF (d >= 48) AND (d <= 57) THEN d = d - 48: GOTO 4\r
+IF (d >= 65) AND (d <= 70) THEN d = d - 55: GOTO 4\r
+IF (d = 45) AND (c = 1) THEN GOTO 4\r
+GOTO 5\r
+4\r
+e$ = e$ + CHR$(d)\r
+NEXT c\r
+a$ = e$\r
+5\r
+\r
+b$ = b$ + a$\r
+a$ = ""\r
+END SUB\r
+\r
+SUB start\r
+IF COMMAND$ = "" THEN END\r
+er = 0\r
+END SUB\r
+\r
projects / fifth.git / commitdiff
