├── travistests ├── .travis.yml ├── demos ├── counting.fs ├── helloworld.fs ├── fizz.fs ├── snow.fs ├── blobs.fs ├── pinwheels.fs ├── screenshot.fs ├── widgets.fs ├── tools.fs ├── metaball.fs ├── handheld.fs ├── globe.fs └── frogger.fs ├── go ├── minimal.fs ├── mini-oof.fs ├── smoketest.fs ├── LICENSE.txt ├── README.md ├── standard.fs ├── label.fs └── gd2.fs /travistests: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | gforth standard.fs smoketest.fs 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | before_install: 2 | - sudo apt-get update -qq 3 | - sudo apt-get install -qq gforth 4 | script: ./travistests 5 | -------------------------------------------------------------------------------- /demos/counting.fs: -------------------------------------------------------------------------------- 1 | : counting 2 | GD.init 3 | 4 | 999999 0 do 5 | $103000 GD.ClearColorRGB# 6 | GD.Clear 7 | 240 136 31 GD.OPT_CENTER i GD.cmd_number 8 | GD.swap 9 | loop 10 | ; 11 | -------------------------------------------------------------------------------- /demos/helloworld.fs: -------------------------------------------------------------------------------- 1 | : helloworld 2 | GD.init 3 | 4 | begin 5 | $103000 GD.ClearColorRGB# 6 | GD.Clear 7 | GD.wh 2/ swap 2/ swap \ middle of the screen 8 | 31 GD.OPT_CENTER s" Hello world" GD.cmd_text 9 | GD.swap 10 | again 11 | ; 12 | -------------------------------------------------------------------------------- /go: -------------------------------------------------------------------------------- 1 | # python hue.py ; exit 2 | # Compile everything using gforth, using standard.fs to make sure 3 | # that only ANS standard Forth words are used. 4 | 5 | gforth standard.fs smoketest.fs 6 | exit 7 | 8 | # Load everything using the interactive shell 9 | # swapforth-shell.py gd2.fs demos/chess.fs 10 | # gforth standard.fs demos/pentom.fs 11 | swapforth-shell.py -h /dev/ttyUSB0 gd2.fs ../swapForth-private/src/detector.fs demos/tools.fs fakecal.fs \ 12 | demos/helloworld.fs \ 13 | demos/counting.fs \ 14 | demos/fizz.fs \ 15 | demos/widgets.fs \ 16 | demos/blobs.fs \ 17 | demos/pinwheels.fs \ 18 | demos/metaball.fs \ 19 | demos/globe.fs \ 20 | demos/menu.fs \ 21 | -------------------------------------------------------------------------------- /minimal.fs: -------------------------------------------------------------------------------- 1 | \ This file defines the minimal extra words needed by gd2.fs. 2 | 3 | : LOCALWORDS 4 | ; 5 | 6 | : PUBLICWORDS 7 | ; 8 | 9 | : DONEWORDS 10 | ; 11 | 12 | \ These are the 16-bit access words 13 | 14 | : uw@ ( a -- u ) \ unsigned 16-bit fetch 15 | dup c@ swap 1+ c@ 8 lshift + 16 | ; 17 | 18 | : w@ ( a -- n ) \ signed 16-bit fetch 19 | uw@ 20 | dup 32768 and if 21 | 65536 - 22 | then 23 | ; 24 | 25 | 26 | \ These SPI IO words are only stubs 27 | 28 | : gd2-spi-init 29 | ; 30 | 31 | : gd2-sel 32 | ; 33 | 34 | : gd2-unsel 35 | ; 36 | 37 | : >spi 38 | drop 39 | ; 40 | 41 | : spi> 42 | 0 43 | ; 44 | 45 | : blk>spi 46 | 2drop 47 | ; 48 | 49 | : random 0 ; 50 | : randrange ; 51 | -------------------------------------------------------------------------------- /mini-oof.fs: -------------------------------------------------------------------------------- 1 | \ Mini-OOF 12apr98py 2 | : noop ; 3 | : method ( m v "name" -- m' v ) Create over , swap cell+ swap 4 | DOES> ( ... o -- ... ) @ over @ + @ execute ; 5 | : var ( m v size "name" -- m v' ) Create over , + 6 | DOES> ( o -- addr ) @ + ; 7 | : class ( class -- class methods vars ) dup 2@ ; 8 | : end-class ( class methods vars "name" -- ) 9 | Create here >r , dup , 2 cells ?DO ['] noop , 1 cells +LOOP 10 | cell+ dup cell+ r> rot @ 2 cells /string move ; 11 | : >vt ( class "name" -- addr ) ' >body @ + ; 12 | : bind ( class "name" -- xt ) >vt @ ; 13 | : defines ( xt class "name" -- ) >vt ! ; 14 | : new ( class -- o ) align here over @ allot tuck ! ; 15 | : :: ( class "name" -- ) bind compile, ; 16 | Create object 1 cells , 2 cells , 17 | -------------------------------------------------------------------------------- /demos/fizz.fs: -------------------------------------------------------------------------------- 1 | \ Conversion of the 'fizz' sample from the 2 | \ "Gameduino 2: Tutorial, Reference and Cookbook" 3 | \ 4 | \ 5 | \ This is an ANS Forth program: 6 | \ Requiring the Core Extensions word set 7 | \ Requiring the Facility Extensions word set 8 | \ 9 | \ 10 | \ 11 | \ Requires gd2.fs and: 12 | \ 13 | \ randrange ( u0 -- u1 ) \ u1 is a random number less than u0 14 | \ 15 | 16 | : rr randrange ; 17 | 18 | 16 50 * constant pointsize 19 | : fizz 20 | GD.init 21 | GD.REG_HSIZE GD.@ 16 * GD.REG_VSIZE GD.@ 16 * ( width height ) 22 | begin 23 | GD.Clear 24 | GD.POINTS GD.Begin 25 | 200 0 do 26 | pointsize rr GD.PointSize 27 | random GD.ColorRGB# 28 | random GD.ColorA 29 | over rr over rr GD.Vertex2f 30 | loop 31 | GD.swap 32 | again 33 | ; 34 | -------------------------------------------------------------------------------- /demos/snow.fs: -------------------------------------------------------------------------------- 1 | \ Fill the screen with random 'snow' 2 | \ 3 | \ requires gd2.fs and: 4 | \ 5 | \ random ( -- u ) \ u is a random number 6 | \ 7 | \ This is an ANS Forth program: 8 | \ Requiring the Core Extensions word set 9 | \ Requiring the Facility Extensions word set 10 | \ 11 | 12 | 512 512 * constant ALLRAM 13 | 14 | : snow 15 | GD.init 16 | 17 | GD.L8 512 512 GD.BitmapLayout 18 | GD.NEAREST GD.REPEAT GD.REPEAT 480 272 GD.BitmapSize 19 | 20 | 0 ALLRAM GD.cmd_memwrite 21 | ALLRAM 0 do 22 | random GD.c 23 | 4 +loop 24 | 25 | begin 26 | random GD.BitmapTransformC 27 | random GD.BitmapTransformF 28 | GD.Clear 29 | GD.BITMAPS GD.Begin 30 | 0 0 0 0 GD.Vertex2ii 31 | GD.RestoreContext 32 | 240 136 31 GD.OPT_CENTER s" snow" GD.cmd_text 33 | GD.swap 34 | again 35 | ; 36 | -------------------------------------------------------------------------------- /smoketest.fs: -------------------------------------------------------------------------------- 1 | \ Smoke test for gd2.fs 2 | \ This file defines the extra words needed by gd2.fs, 3 | \ and compiles it. 4 | 5 | \ These definitions for LOCALWORDS, PUBLICWORDS, DONEWORDS 6 | \ are suitable for a Forth that has vocabularies. 7 | \ 8 | \ For a Forth that does not have vocabularies then 9 | \ define 10 | \ 11 | \ : LOCALWORDS ; : PUBLICWORDS ; : DONEWORDS ; 12 | \ 13 | 14 | s" minimal.fs" included 15 | 16 | : LOCALWORDS 17 | get-current 18 | get-order wordlist swap 1+ set-order definitions 19 | ; 20 | 21 | : PUBLICWORDS 22 | set-current 23 | ; 24 | 25 | : DONEWORDS 26 | previous 27 | ; 28 | 29 | s" gd2.fs" included 30 | 31 | : noop ; 32 | s" mini-oof.fs" included 33 | 34 | marker xxx s" demos/blobs.fs" included xxx 35 | marker xxx s" demos/fizz.fs" included xxx 36 | marker xxx s" demos/metaball.fs" included xxx 37 | marker xxx s" demos/snow.fs" included xxx 38 | : s\" postpone s" ; immediate 39 | marker xxx s" demos/widgets.fs" included xxx 40 | 41 | cr .( Compilation completed) 42 | bye 43 | -------------------------------------------------------------------------------- /demos/blobs.fs: -------------------------------------------------------------------------------- 1 | \ Conversion of the 'blobs' sample from the 2 | \ "Gameduino 2: Tutorial, Reference and Cookbook" 3 | \ 4 | \ This is an ANS Forth program: 5 | \ Requiring the Core Extensions word set 6 | \ Requiring the Double-Number word set 7 | \ Requiring the Facility Extensions word set 8 | \ 9 | 10 | -16384 -16384 2constant OFFSCREEN 11 | 12 | 128 constant NBLOBS 13 | create xys NBLOBS 2* cells allot 14 | 0 value blob_i 15 | : xy[] 2* cells xys + ; 16 | 17 | : blobs 18 | GD.init 19 | GD.calibrate 20 | 21 | NBLOBS 0 do 22 | OFFSCREEN i xy[] 2! 23 | loop 24 | 25 | begin 26 | GD.getinputs 27 | GD.inputs.x -32768 <> if 28 | GD.inputs.x 16 * GD.inputs.y 16 * 29 | else 30 | OFFSCREEN 31 | then 32 | blob_i xy[] 2! 33 | blob_i 1+ NBLOBS mod to blob_i 34 | 35 | 255 255 255 GD.ClearColorRGB 36 | GD.Clear 37 | GD.POINTS GD.Begin 38 | NBLOBS 0 do 39 | i 2* GD.ColorA 40 | 1040 i 8 * - GD.PointSize 41 | 42 | blob_i i + NBLOBS mod >r 43 | 44 | \ Random color for each blob, keyed from (blob_i + i) 45 | r@ 17 * r@ 23 * r@ 147 * GD.ColorRGB 46 | 47 | r> xy[] 2@ GD.Vertex2f 48 | loop 49 | GD.swap 50 | again 51 | ; 52 | -------------------------------------------------------------------------------- /demos/pinwheels.fs: -------------------------------------------------------------------------------- 1 | \ Draws animated rotating pinwheels 2 | \ 3 | \ Uses floating-point to compute coordinates 4 | \ 5 | \ This is an ANS Forth program: 6 | \ Requiring the Core Extensions word set 7 | \ Requiring the Double-Number word set 8 | \ Requiring the Facility Extensions word set 9 | \ Requiring the Floating-Point word set 10 | \ Requiring the Floating-Point Extensions word set 11 | \ 12 | 13 | 3.1415926e fconstant PI 14 | PI 2.0e f* fconstant 2PI 15 | 16 | : v ( F: x y -- ) \ draw a vertex 17 | fswap 16.0e f* f>d d>s 16.0e f* f>d d>s 18 | GD.Vertex2f 19 | ; 20 | 21 | variable radius 22 | variable time 0 time ! 23 | 24 | : wheel ( npoints -- ) 25 | GD.LINE_STRIP GD.Begin 26 | 2PI 17e f* dup s>d d>f f/ ( step ) 27 | time @ s>d d>f radius f@ f/ ( step theta ) 28 | 1+ 0 do 29 | fdup fcos radius f@ f* 240e f+ 30 | fover fsin radius f@ f* 136e f+ 31 | v fover f+ 32 | loop 33 | fdrop fdrop 34 | ; 35 | 36 | : pinwheels 37 | GD.init 38 | 0 time ! 39 | begin 40 | GD.Clear 41 | $c0ffc0 GD.ColorRGB# 30.0e radius f! 30 wheel 42 | $ffffc0 GD.ColorRGB# 48.0e radius f! 20 wheel 43 | $ffc0c0 GD.ColorRGB# 110.0e radius f! 13 wheel 44 | $c0c0ff GD.ColorRGB# 230.0e radius f! 52 wheel 45 | GD.swap 1 time +! 46 | again 47 | ; 48 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, James Bowman 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | * Neither the name of forth-ft800 nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # forth-ft800 2 | 3 | [![Build Status](https://travis-ci.org/jamesbowman/forth-ft800.svg?branch=master)](https://travis-ci.org/jamesbowman/forth-ft800) 4 | 5 | This is a Forth driver for the 6 | [FTDI FT80x/FT81x](http://www.ftdichip.com/Products/ICs/FT800.html) GPUs, as 7 | used in many devices, including the 8 | [Gameduino 2](http://gameduino.com). 9 | 10 | It assumes a 32-bit ANS Forth plus a handful of other words for interfacing. 11 | The API is identical to the one documented in the 12 | [Gameduino 2 book](http://excamera.com/files/gd2book_v0.pdf). 13 | There are also a handful of sample applications. 14 | 15 | `gd2.fs` contains the bindings themselves. 16 | There are notes at the beginning of the file on the required support words. 17 | `smoketest.fs` includes some reference implementations of the support words. 18 | 19 | There is also a simple compile test. 20 | You can run it like this: 21 | 22 | gforth standard.fs smoketest.fs 23 | 24 | There are a handful of demos, all of which require only a 32-bit ANS Forth and the driver. 25 | 26 | ### helloworld 27 | 28 | [Single line of text](demos/helloworld.fs) 29 | 30 | ![fizz](https://github.com/jamesbowman/gd2-book/blob/master/assets/helloworld.png) 31 | 32 | ### fizz 33 | 34 | [High-speed circle drawing](demos/fizz.fs) 35 | 36 | ![fizz](https://github.com/jamesbowman/gd2-book/blob/master/assets/fizz-6.png) 37 | 38 | ### widgets 39 | 40 | [Full widget set demo](demos/widgets.fs) 41 | 42 | ![widgets](https://github.com/jamesbowman/gd2-book/blob/master/assets/widgets3d.png) 43 | 44 | ### blobs 45 | 46 | [Interactive drawing using the touch-screen](demos/blobs.fs) 47 | 48 | ![blobs](https://github.com/jamesbowman/gd2-book/blob/master/assets/blobs.png) 49 | 50 | ### frogger 51 | 52 | [Simple animated game, a direct conversion of the Arduino version](demos/frogger.fs) 53 | 54 | ![frogger](https://github.com/jamesbowman/gd2-book/blob/master/assets/frogger.png) 55 | -------------------------------------------------------------------------------- /demos/screenshot.fs: -------------------------------------------------------------------------------- 1 | \ Send a buffer as a sequence of run/literal pairs 2 | \ a pair looks like: 3 | \ #-to-repeat #-to-insert 4 | \ 5 | \ The initial value at the start of the run is 0 6 | \ 7 | variable tx 8 | 9 | : send-length ( u -- ) 10 | 2/ 2/ 11 | begin 12 | dup 254 > 13 | while 14 | 255 - 15 | $ff emit 16 | repeat 17 | emit 18 | ; 19 | 20 | : flush ( mode a -- mode ) 21 | over if 22 | tx @ 2dup - ( a tx u -- ) 23 | dup send-length type 24 | else 25 | dup tx @ - 26 | send-length 27 | then 28 | tx ! 29 | invert 30 | ; 31 | 32 | : rlc 33 | 2dup + >r \ end-of-buffer 34 | over tx ! 35 | 0 -1 ( mode prev ) 36 | 2swap 37 | bounds do 38 | i @ <> ( mode cmp ) 39 | over xor ( mode ok ) 40 | if 41 | i flush 42 | then 43 | i @ ( mode prev ) 44 | 4 +loop 45 | drop 46 | r> flush 47 | if 48 | 0 send-length 49 | then 50 | ; 51 | 52 | : send32 53 | pad ! 54 | pad 4 type 55 | ; 56 | 57 | hex 58 | 302010 102410 gdconst REG_SCREENSHOT_EN \ Set to enable screenshot mode 59 | 302014 102414 gdconst REG_SCREENSHOT_Y \ Y line register 60 | 302018 102418 gdconst REG_SCREENSHOT_START \ Screenshot start trigger 61 | 3020e8 1024d8 gdconst REG_SCREENSHOT_BUSY \ Screenshot ready flags 62 | 302174 102554 gdconst REG_SCREENSHOT_READ \ Set to enable readout 63 | 3c2000 1c2000 gdconst RAM_SCREENSHOT \ Screenshot readout buffer 64 | decimal 65 | 66 | \ Send a compressed screenshot 67 | \ Uses 512 bytes at PAD 68 | 69 | : GD.screenshot 70 | GD.finish 71 | 1 REG_SCREENSHOT_EN GD.c! 72 | GD.REG_PCLK GD.@ 73 | 0 GD.REG_PCLK GD.c! 74 | cr ." !screenshot" 75 | GD.REG_HSIZE GD.@ send32 GD.REG_VSIZE GD.@ send32 76 | GD.REG_VSIZE GD.@ 0 do 77 | i REG_SCREENSHOT_Y GD.! 78 | 1 REG_SCREENSHOT_START GD.c! 79 | begin 80 | REG_SCREENSHOT_BUSY dup GD.@ 81 | swap cell+ GD.@ or 0= 82 | until 83 | 1 REG_SCREENSHOT_READ GD.c! 84 | 85 | GD.REG_HSIZE GD.@ 4 * 0 do 86 | GD.REG_HSIZE GD.@ 4 * i - 512 min 87 | pad over RAM_SCREENSHOT i + GD.move 88 | pad over rlc \ type 89 | +loop 90 | 91 | 0 REG_SCREENSHOT_READ GD.c! 92 | loop 93 | 0 REG_SCREENSHOT_EN GD.! 94 | GD.REG_PCLK GD.c! 95 | \ key [char] k <> 100 and throw 96 | ; 97 | -------------------------------------------------------------------------------- /demos/widgets.fs: -------------------------------------------------------------------------------- 1 | \ Conversion of the 'widgets' sample from the 2 | \ "Gameduino 2: Tutorial, Reference and Cookbook" 3 | \ 4 | \ This is an ANS Forth program: 5 | \ Requiring the Core Extensions word set 6 | \ Requiring the Facility Extensions word set 7 | \ 8 | 9 | : v2 ( x y -- ) 10 | 0 0 GD.Vertex2ii 11 | ; 12 | 13 | 200 dup constant TAG_DIAL 14 | 1+ dup constant TAG_SLIDER 15 | 1+ dup constant TAG_TOGGLE 16 | 1+ dup constant TAG_BUTTON1 17 | 1+ dup constant TAG_BUTTON2 18 | drop 19 | 20 | GD.OPT_FLAT value options 21 | 15000 value val 22 | 23 | create message 40 allot 24 | message 40 char . fill 25 | 26 | : msgadd ( c -- ) \ append c to the message buffer 27 | message 1+ message 39 move 28 | message 39 + c! 29 | ; 30 | 31 | variable tt 0 tt ! 32 | : widgets 33 | GD.init 34 | 35 | GD.calibrate 36 | 37 | 0 \ keep previous key on stack 38 | begin 39 | \ tt @ s>f 0.02e0 f* fsin 1.0e f+ 32767.0e0 f* f>s to val 40 | 1 tt +! 41 | GD.getinputs 42 | GD.inputs.track_tag TAG_DIAL TAG_TOGGLE 1+ within if 43 | GD.inputs.track_val to val 44 | then 45 | dup 0= GD.inputs.tag bl 127 within and if 46 | GD.inputs.tag msgadd 47 | then 48 | drop GD.inputs.tag 49 | dup case 50 | TAG_BUTTON1 of GD.OPT_FLAT to options endof 51 | TAG_BUTTON2 of 0 to options endof 52 | endcase 53 | 54 | 0 0 $404044 480 480 $606068 GD.cmd_gradient 55 | 56 | $707070 GD.ColorRGB# 57 | 58 | 4 16 * GD.LineWidth 59 | GD.RECTS GD.Begin 60 | 61 | 8 8 v2 62 | 128 128 v2 63 | 64 | 8 136 8 + v2 65 | 128 136 128 + v2 66 | 67 | 144 136 8 + v2 68 | 472 136 128 + v2 69 | 70 | $ffffff GD.ColorRGB# 71 | 72 | TAG_DIAL GD.Tag 73 | 68 68 50 options val GD.cmd_dial 74 | 68 68 1 1 TAG_DIAL GD.cmd_track 75 | 76 | TAG_SLIDER GD.Tag 77 | 16 199 104 10 TAG_SLIDER GD.cmd_track 78 | 16 199 104 10 options val 65535 GD.cmd_slider 79 | 80 | TAG_TOGGLE GD.Tag 81 | 360 62 80 29 options val s\" that\xFFthis" GD.cmd_toggle 82 | 360 62 60 20 TAG_TOGGLE GD.cmd_track 83 | 84 | 255 GD.Tag 85 | 68 136 30 GD.OPT_CENTER 5 or val GD.cmd_number 86 | 87 | 184 48 40 options GD.OPT_NOSECS or 0 0 val 0 GD.cmd_clock 88 | 280 48 40 options 4 3 val 65535 GD.cmd_gauge 89 | 90 | TAG_BUTTON1 GD.Tag 91 | 352 12 40 30 28 options s" 2D" GD.cmd_button 92 | TAG_BUTTON2 GD.Tag 93 | 400 12 40 30 28 options s" 3D" GD.cmd_button 94 | 95 | 255 GD.Tag 96 | 144 100 320 10 options val 65535 GD.cmd_progress 97 | 144 120 320 10 options val 2/ 32768 65535 GD.cmd_scrollbar 98 | 99 | dup options or GD.OPT_CENTER or >r 100 | 101 | 144 168 320 24 28 r@ s" qwertyuiop" GD.cmd_keys 102 | 144 168 26 + 320 24 28 r@ s" asdfghjkl" GD.cmd_keys 103 | 144 168 52 + 320 24 28 r@ s" zxcvbnm,." GD.cmd_keys 104 | bl GD.Tag 105 | 308 60 - 172 74 + 120 20 28 options s" " GD.cmd_button 106 | 107 | r> drop 108 | 109 | GD.SRC_ALPHA 0 GD.BlendFunc 110 | 149 146 18 0 message 40 GD.cmd_text 111 | 112 | GD.swap 113 | again 114 | ; 115 | -------------------------------------------------------------------------------- /demos/tools.fs: -------------------------------------------------------------------------------- 1 | \ Various additional tools for working with the FT800. 2 | \ 3 | \ ram>GD bulk-copy from RAM to the FT800 4 | \ file>GD copy a file to the FT800 5 | \ GD.dump inspect FT800 main memory 6 | \ GD.screenshot dump the current display to the console 7 | \ 8 | \ This is an ANS Forth program: 9 | \ Requiring the Core Extensions word set 10 | \ Requiring the Exception word set 11 | \ Requiring the Facility Extensions word set 12 | \ Requiring the File Access word set 13 | \ 14 | 15 | : bounds 16 | over + swap 17 | ; 18 | 19 | : file>GD ( caddr u -- ) \ feed a file to the FT800 command buffer 20 | r/o open-file throw >r 21 | begin 22 | pad 512 r@ read-file throw 23 | ?dup 24 | while 25 | pad swap GD.supply 26 | repeat 27 | r> close-file throw 28 | ; 29 | 30 | : (GD.dump) ( caddr -- caddr' ) \ dump one line of FT800 RAM 31 | cr dup dup 32 | 0 <# # # # # # # #> type 33 | space space 34 | 16 0 do 35 | dup GD.c@ 0 <# # # #> 36 | type space char+ 37 | loop 38 | space swap 39 | 16 0 do 40 | dup GD.c@ 127 and dup 0 bl within 41 | over 127 = or 42 | if drop [char] . then 43 | emit char+ 44 | loop 45 | drop 46 | ; 47 | 48 | : GD.dump ( a u -- ) \ dump FT800 memory, useful for debugging 49 | ?dup if 50 | base @ >r hex 51 | 1- 16 / 1+ 52 | 0 do 53 | (GD.dump) 54 | loop 55 | r> base ! 56 | then 57 | drop 58 | ; 59 | 60 | LOCALWORDS \ { 61 | 62 | \ Send a buffer as a sequence of run/literal pairs 63 | \ a pair looks like: 64 | \ #-to-repeat #-to-insert 65 | \ 66 | \ The initial value at the start of the run is 0 67 | \ 68 | variable tx 69 | 70 | : send-length ( u -- ) 71 | 2/ 2/ 72 | begin 73 | dup 254 > 74 | while 75 | 255 - 76 | $ff emit 77 | repeat 78 | emit 79 | ; 80 | 81 | : flush ( mode a -- mode ) 82 | over if 83 | tx @ 2dup - ( a tx u -- ) 84 | dup send-length type 85 | else 86 | dup tx @ - 87 | send-length 88 | then 89 | tx ! 90 | invert 91 | ; 92 | 93 | : rlc 94 | 2dup + >r \ end-of-buffer 95 | over tx ! 96 | 0 0 ( mode prev ) 97 | 2swap 98 | bounds do 99 | i @ <> ( mode cmp ) 100 | over xor ( mode ok ) 101 | if 102 | i flush 103 | then 104 | i @ ( mode prev ) 105 | 4 +loop 106 | drop 107 | r> flush 108 | if 109 | 0 send-length 110 | then 111 | ; 112 | 113 | : send32 114 | pad ! 115 | pad 4 type 116 | ; 117 | 118 | hex 119 | 00102410 constant REG_SCREENSHOT_EN \ Set to enable screenshot mode 120 | 00102414 constant REG_SCREENSHOT_Y \ Y line register 121 | 00102418 constant REG_SCREENSHOT_START \ Screenshot start trigger 122 | 001024d8 constant REG_SCREENSHOT_BUSY \ Screenshot ready flags 123 | 00102554 constant REG_SCREENSHOT_READ \ Set to enable readout 124 | 001c2000 constant RAM_SCREENSHOT \ Screenshot readout buffer 125 | decimal 126 | 127 | PUBLICWORDS \ }{ 128 | 129 | : GD.screenshot 130 | GD.finish 131 | 1 REG_SCREENSHOT_EN GD.c! 132 | GD.REG_PCLK GD.@ 133 | 0 GD.REG_PCLK GD.c! 134 | cr ." !screenshot" 135 | GD.REG_HSIZE GD.@ send32 GD.REG_VSIZE GD.@ send32 136 | GD.REG_VSIZE GD.@ 0 do 137 | i REG_SCREENSHOT_Y GD.! 138 | 1 REG_SCREENSHOT_START GD.c! 139 | begin 140 | REG_SCREENSHOT_BUSY dup GD.@ 141 | swap cell+ GD.@ or 0= 142 | until 143 | 1 REG_SCREENSHOT_READ GD.c! 144 | pad GD.REG_HSIZE GD.@ cells RAM_SCREENSHOT GD.move 145 | pad GD.REG_HSIZE GD.@ 4 * rlc \ type 146 | 0 REG_SCREENSHOT_READ GD.c! 147 | loop 148 | 0 REG_SCREENSHOT_EN GD.! 149 | GD.REG_PCLK GD.c! 150 | key [char] k <> 100 and throw 151 | ; 152 | 153 | DONEWORDS \ } 154 | -------------------------------------------------------------------------------- /demos/metaball.fs: -------------------------------------------------------------------------------- 1 | \ Converted from FTDI's 'metaball' sample 2 | \ 3 | \ requires gd2.fs and: 4 | \ 5 | \ mini-oof.fs tiny object-oriented library 6 | \ 7 | \ randrange ( u0 -- u1 ) \ u1 is a random number less than u0 8 | \ 9 | \ 10 | \ This is an ANS Forth program: 11 | \ Requiring the Core Extensions word set 12 | \ Requiring the Facility Extensions word set 13 | \ Requiring the String word set 14 | \ 15 | 16 | 51 constant w 17 | 31 constant h 18 | 80 constant NBLOBS 19 | 20 | 0 value centerx 21 | 0 value centery 22 | 0 value scale 23 | 24 | w h * constant wh 25 | 26 | object class 27 | 1 cells var x 28 | 1 cells var y 29 | 1 cells var dx 30 | 1 cells var dy 31 | method kick \ randomize velocity 32 | method born \ randomize position, velocity 33 | method animate \ compute new position 34 | method draw \ draw self 35 | method brightness \ return brightness from center point 36 | end-class blob 37 | 38 | : rr randrange ; 39 | 40 | : rvel ( -- n ) \ n is a random velocity 41 | 512 randrange 256 - 42 | ; 43 | 44 | :noname 45 | >r 46 | rvel r@ dx ! 47 | rvel r> dy ! 48 | ; blob defines kick 49 | 50 | :noname 51 | >r 52 | centerx 2* rr r@ x ! 53 | centery 2* rr r@ y ! 54 | r> kick 55 | ; blob defines born 56 | 57 | :noname 58 | dup x @ 59 | swap y @ 60 | GD.Vertex2f 61 | ; blob defines draw 62 | 63 | : attract ( c pos -- v ) 64 | < if 65 | -6 66 | else 67 | 6 68 | then 69 | ; 70 | 71 | :noname 72 | >r 73 | centerx r@ x @ attract r@ dx +! 74 | centery r@ y @ attract r@ dy +! 75 | 76 | r@ dx @ r@ x +! 77 | r@ dy @ r> y +! 78 | ; blob defines animate 79 | 80 | \ array of blob addresses 81 | create bb NBLOBS cells allot 82 | : b[] ( u -- a ) cells bb + @ ; 83 | 84 | \ reciprocal table 85 | w dup * h dup * + 1+ constant recipsz 86 | create recip recipsz allot 87 | 88 | :noname ( i j blob -- u ) 89 | >r 90 | 8 lshift r@ y @ - dup * swap 91 | 8 lshift r> x @ - dup * 92 | + 19 rshift 93 | recipsz 1- min 94 | recip + c@ 95 | ; blob defines brightness 96 | 97 | 98 | : new ( class -- o ) align here over @ allot tuck ! ; 99 | 100 | : metaball 101 | GD.init 102 | GD.REG_HSIZE GD.@ 2/ 16 * to centerx 103 | GD.REG_VSIZE GD.@ 2/ 16 * to centery 104 | 105 | GD.REG_HSIZE GD.@ 6 800 */ to scale 106 | 107 | \ Build the reciprocal table 108 | 200 recip c! 109 | recipsz 1 do 110 | 4800 i 4 * / 200 min 111 | recip i + c! 112 | loop 113 | 114 | cr ." HERE " 115 | 116 | \ Create blobs at random locations 117 | NBLOBS 0 do 118 | blob new 119 | i cells bb + ! 120 | loop 121 | NBLOBS 0 do 122 | i b[] born 123 | loop 124 | 125 | \ Background bitmap 126 | GD.L8 w h GD.BitmapLayout 127 | GD.BILINEAR GD.BORDER GD.BORDER 0 0 GD.BitmapSize 128 | 129 | begin 130 | GD.SaveContext 131 | 132 | \ Draw the background 133 | 16 GD.BitmapTransformA 134 | 16 GD.BitmapTransformE 135 | GD.BITMAPS GD.Begin 136 | GD.SRC_ALPHA 0 GD.BlendFunc 137 | 255 0 0 GD.ColorRGB 138 | 0 0 GD.Vertex2f 139 | GD.SRC_ALPHA 1 GD.BlendFunc 140 | 255 255 0 GD.ColorRGB 141 | 0 0 GD.Vertex2f 142 | 143 | \ Draw the black blobs on top 144 | GD.RestoreContext 145 | 0 GD.ColorRGB# 146 | GD.POINTS GD.Begin 147 | NBLOBS 3 do 148 | i scale * GD.PointSize 149 | i b[] draw 150 | loop 151 | 152 | \ Move all blobs 153 | NBLOBS 0 do 154 | i b[] animate 155 | loop 156 | 157 | \ Randomize one blob's velocity 158 | 10 randrange 0= if 159 | NBLOBS randrange b[] kick 160 | then 161 | 162 | \ Build up a new w*h background image at pad 163 | pad 164 | h 0 do 165 | w 0 do 166 | i j 0 b[] brightness 167 | i j 1 b[] brightness + 168 | i j 2 b[] brightness + 169 | 255 min 170 | over c! 1+ 171 | loop 172 | loop 173 | drop 174 | 175 | \ Transfer it to graphics memory 176 | 0 wh GD.cmd_memwrite 177 | pad wh GD.supply 178 | \ pad wh bounds do 179 | \ i @ GD.c 180 | \ 4 +loop 181 | GD.swap 182 | again 183 | ; 184 | -------------------------------------------------------------------------------- /demos/handheld.fs: -------------------------------------------------------------------------------- 1 | \ Handheld: swapForth-specific handheld console driver. 2 | \ This module replaces the regular 'emit' and 'key' hooks 3 | \ that drive the FT800 as a portrait-orientation tty 4 | \ emulator. 5 | \ The soft-keyboard implementation uses the touchscreen. 6 | \ 7 | 8 | : xyii ( x y i i -- ) 9 | 2swap 10 | 479 swap - swap 11 | 2swap 12 | GD.vertex2ii 13 | ; 14 | 15 | : xy ( x y -- ) 16 | 0 0 xyii 17 | ; 18 | 19 | create widths 128 allot 20 | : width ( c -- w ) 21 | widths + c@ 22 | ; 23 | 24 | : loadfont ( u -- ) 25 | 16 - 148 * 26 | GD.ROM_FONTROOT GD.@ + >r 27 | 28 | \ GD.L8 480 272 GD.BitmapLayout 29 | \ GD.NEAREST GD.BORDER GD.BORDER 0 0 GD.BitmapSize 30 | 31 | r@ 144 + GD.@ GD.BitmapSource 32 | 33 | r@ 128 + GD.@ 34 | r@ 132 + GD.@ 35 | r@ 140 + GD.@ GD.BitmapLayout 36 | 37 | GD.BILINEAR GD.BORDER GD.BORDER 38 | r@ 140 + GD.@ 39 | r@ 136 + GD.@ GD.BitmapSize 40 | 41 | r> 42 | 128 0 do 43 | dup i + GD.c@ 44 | widths i + c! 45 | loop 46 | drop 47 | ; 48 | 49 | : button ( x y ch -- ) 50 | \ GD.SRC_ALPHA GD.ONE_MINUS_SRC_ALPHA GD.BlendFunc 51 | >r 52 | r@ GD.Tag 53 | $202040 GD.ColorRGB# 54 | GD.RECTS GD.Begin 55 | 2dup xy 56 | 2dup 14 dup d+ xy 57 | \ GD.SRC_ALPHA 0 GD.BlendFunc 58 | $ffffff GD.ColorRGB# 59 | GD.BITMAPS GD.Begin 60 | 14 + 61 | swap 16 r@ widths + c@ - 2/ + swap 62 | 0 r> xyii 63 | ; 64 | 65 | variable shift 0 shift ! 66 | 67 | : 1ch ( u k. k. -- c ) \ from two shifted row strings, pick char u 68 | shift @ if 69 | 2swap 70 | then 71 | 2drop 72 | drop + c@ 73 | ; 74 | 75 | \ Alternative to s" for strings that contain a " 76 | : s| [char] | parse postpone sliteral ; immediate 77 | 78 | : row0 s" 1234567890" s" !@#$%^&*()" 1ch ; 79 | : row1 s" QWERTYUIOP" s" `~[]\{}| " 1ch ; 80 | : row2 s" ASDFGHJKL" s| _+-= :;"'| 1ch ; 81 | : row3 s" ZXCVBNM" s" <>,./?" 1ch ; 82 | 83 | : label 84 | bounds do 85 | 2dup 0 i c@ xyii 86 | i c@ width 1+ 0 d+ 87 | loop 88 | 2drop 89 | ; 90 | 91 | : keyboard 92 | GD.cmd_loadidentity 93 | $80000 $10000 GD.cmd_translate 94 | $4000 GD.cmd_rotate 95 | $-10000 $-80000 GD.cmd_translate 96 | GD.cmd_setmatrix 97 | 98 | 64 GD.LineWidth 99 | 10 0 do 100 | i 27 * 6 + 101 | 330 102 | i row0 103 | button 104 | loop 105 | 10 0 do 106 | i 27 * 6 + 107 | 360 108 | i row1 109 | button 110 | loop 111 | 9 0 do 112 | i 27 * 19 + 113 | 390 114 | i row2 115 | button 116 | loop 117 | 7 0 do 118 | i 27 * 46 + 119 | 420 120 | i row3 121 | button 122 | loop 123 | 124 | $202040 GD.ColorRGB# 125 | 126 | GD.RECTS GD.Begin 127 | 128 | \ backspace 129 | 8 GD.Tag 130 | 236 420 xy 131 | 266 434 xy 132 | 133 | \ numberwang 134 | 128 GD.Tag 135 | 6 450 xy 136 | 45 464 xy 137 | 138 | \ space bar 139 | 32 GD.Tag 140 | 60 450 xy 141 | 210 464 xy 142 | 143 | \ enter 144 | 13 GD.Tag 145 | 225 450 xy 146 | 266 464 xy 147 | 148 | 0 GD.TagMask 149 | $c0c060 GD.ColorRGB# 150 | GD.BITMAPS GD.Begin 151 | shift @ if 152 | 13 464 s" abc" 153 | else 154 | 11 464 s" sym" 155 | then label 156 | 243 434 s" <<" label 157 | 228 464 s" enter" label 158 | ; 159 | 160 | : redraw 161 | GD.Clear 162 | 163 | GD.cmd_loadidentity 164 | 330 $10000 * $-08000 GD.cmd_translate 165 | $4000 GD.cmd_rotate 166 | GD.cmd_setmatrix 167 | \ 1 0 GD.BlendFunc 168 | GD.BITMAPS GD.Begin 169 | 170 | 0 GD.Tag 171 | 0 330 1 0 xyii 172 | GD.RestoreContext 173 | 174 | $ff8080 GD.ColorRGB# 175 | 0 GD.Macro 176 | 177 | keyboard 178 | 179 | GD.swap 180 | ; 181 | 182 | variable cursor 183 | 184 | 2 34 * 20 * constant SZ 185 | 68 constant 2W \ Width doubled, line stride 186 | 187 | : scroll 188 | SZ 1- cursor @ < if 189 | 2W negate cursor +! 190 | 0 2W SZ 2W - GD.cmd_memcpy 191 | SZ 2W - 2W GD.cmd_memzero 192 | then 193 | ; 194 | 195 | action-of emit constant oldemit 196 | 197 | : tty-emit ( u -- ) 198 | \ dup [ oldemit compile, ] 199 | case 200 | $08 of -2 cursor +! endof 201 | $0a of 2W cursor +! endof 202 | $0d of cursor @ 2W / 2W * cursor ! endof 203 | 204 | dup 31 > if 205 | dup 206 | cursor @ 2 GD.cmd_memwrite 207 | $ff00 or GD.c 208 | 2 cursor +! 209 | then 210 | endcase 211 | scroll 212 | GD.REG_MACRO_0 4 GD.cmd_memwrite 213 | cursor @ 2W mod 2/ 8 * 214 | cursor @ 2W / 16 * 15 + 215 | 17 221 xyii 216 | GD.flush 217 | ; 218 | 219 | : at-xy 220 | 60 * + 2* 221 | cursor ! 222 | ; 223 | 224 | : page 225 | 0 cursor ! 226 | 0 SZ GD.cmd_memzero 227 | ; 228 | 229 | : tty-init 230 | page 231 | 232 | 1 GD.BitmapHandle 233 | 0 GD.BitmapSource 234 | GD.TEXTVGA 2W 20 GD.BitmapLayout 235 | GD.NEAREST GD.BORDER GD.BORDER 330 272 GD.BitmapSize 236 | 0 GD.BitmapHandle 237 | ; 238 | 239 | : sense 240 | GD.getinputs 241 | GD.inputs.tag 242 | ; 243 | 244 | : sound ( u -- ) 245 | GD.REG_SOUND 4 GD.cmd_memwrite GD.c 246 | GD.REG_PLAY 4 GD.cmd_memwrite 1 GD.c 247 | GD.flush 248 | ; 249 | 250 | variable dirty dirty off 251 | 252 | : tty-key 253 | dirty @ if 254 | tty-init 26 loadfont 255 | redraw 256 | 0 tty-emit \ update cursor pos 257 | dirty off 258 | then 259 | begin 260 | sense 0= 261 | until 262 | begin 263 | sense 264 | ?dup 265 | until 266 | dup 128 = if 267 | drop 268 | shift dup @ if 269 | off GD.NOTCH 270 | else 271 | on GD.SWITCH 272 | then 273 | sound 274 | redraw 275 | recurse exit 276 | then 277 | dup bl = over 13 = or if 278 | shift off redraw 279 | then 280 | GD.CHACK sound 281 | ; 282 | 283 | : calibrate 284 | 0 if 285 | GD.calibrate 286 | GD.REG_TOUCH_TRANSFORM_A 24 bounds do 287 | i GD.@ . ." GD.c " 288 | 4 +loop 289 | else 290 | GD.REG_TOUCH_TRANSFORM_A 24 GD.cmd_memwrite 291 | \ 41078 GD.c -378 GD.c -392457 GD.c 327 GD.c -39228 GD.c 18215789 GD.c 292 | 442 GD.c 67773 GD.c 128238 GD.c -69606 GD.c -257 GD.c 17998943 GD.c 293 | then 294 | ; 295 | 296 | : handheld 297 | GD.init 298 | calibrate 299 | 300 | tty-init 301 | 26 loadfont 302 | 303 | redraw 304 | 305 | ['] tty-key is key 306 | ['] tty-emit is emit 307 | page 308 | .version cr 309 | cr 310 | ; 311 | 312 | \ To make the system PERMANENTLY use the 313 | : cold 314 | cold 315 | handheld 316 | ; 317 | -------------------------------------------------------------------------------- /standard.fs: -------------------------------------------------------------------------------- 1 | \ --STANDARD-- \ Wil Baden 2003-02-22 2 | 3 | \ ******************************************************************* 4 | \ * * 5 | \ * ONLY STANDARD DEFINITIONS * 6 | \ * * 7 | \ ******************************************************************* 8 | 9 | WORDLIST CONSTANT STANDARD 10 | STANDARD SET-CURRENT 11 | 12 | \ Standard-Clone 13 | 14 | : ! ! ; 15 | : # # ; 16 | : #> #> ; 17 | : #S #S ; 18 | : ' ' ; 19 | : ( POSTPONE ( ; IMMEDIATE 20 | : (LOCAL) POSTPONE (LOCAL) ; IMMEDIATE 21 | : * * ; 22 | : */ */ ; 23 | : */MOD */MOD ; 24 | : + + ; 25 | : +! +! ; 26 | : +LOOP POSTPONE +LOOP ; IMMEDIATE 27 | : , , ; 28 | : - - ; 29 | : -TRAILING -TRAILING ; 30 | : . . ; 31 | : ." POSTPONE ." ; IMMEDIATE 32 | : .( POSTPONE .( ; IMMEDIATE 33 | : .R .R ; 34 | : .S .S ; 35 | : / / ; 36 | : /MOD /MOD ; 37 | : /STRING /STRING ; 38 | : 0< 0< ; 39 | : 0<> 0<> ; 40 | : 0= 0= ; 41 | : 0> 0> ; 42 | : 1+ 1+ ; 43 | : 1- 1- ; 44 | : 2! 2! ; 45 | : 2* 2* ; 46 | : 2/ 2/ ; 47 | : 2>R POSTPONE 2>R ; IMMEDIATE 48 | : 2@ 2@ ; 49 | : 2CONSTANT 2CONSTANT ; 50 | : 2DROP 2DROP ; 51 | : 2DUP 2DUP ; 52 | : 2LITERAL POSTPONE 2LITERAL ; IMMEDIATE 53 | : 2OVER 2OVER ; 54 | : 2R> POSTPONE 2R> ; IMMEDIATE 55 | : 2R@ POSTPONE 2R@ ; IMMEDIATE 56 | : 2ROT 2ROT ; 57 | : 2SWAP 2SWAP ; 58 | : 2VARIABLE 2VARIABLE ; 59 | : : : ; 60 | : :NONAME :NONAME ; 61 | : ; POSTPONE ; ; IMMEDIATE 62 | : ;CODE POSTPONE ;CODE ; IMMEDIATE 63 | : < < ; 64 | : <# <# ; 65 | : <> <> ; 66 | : = = ; 67 | : > > ; 68 | : >BODY >BODY ; 69 | : >FLOAT >FLOAT ; 70 | : >IN >IN ; 71 | : >NUMBER >NUMBER ; 72 | : >R POSTPONE >R ; IMMEDIATE 73 | : ? POSTPONE ? ; IMMEDIATE 74 | : ?DO POSTPONE ?DO ; IMMEDIATE 75 | : ?DUP ?DUP ; 76 | : @ @ ; 77 | : ABORT ABORT ; 78 | : ABORT" POSTPONE ABORT" ; IMMEDIATE 79 | : ABS ABS ; 80 | : ACCEPT ACCEPT ; 81 | : AGAIN POSTPONE AGAIN ; IMMEDIATE 82 | : AHEAD POSTPONE AHEAD ; IMMEDIATE 83 | : ALIGN ALIGN ; 84 | : ALIGNED ALIGNED ; 85 | : ALLOCATE ALLOCATE ; 86 | : ALLOT ALLOT ; 87 | : ALSO ALSO ; 88 | : AND AND ; 89 | : ASSEMBLER ASSEMBLER ; 90 | : AT-XY AT-XY ; 91 | : BASE BASE ; 92 | : BEGIN POSTPONE BEGIN ; IMMEDIATE 93 | : BIN BIN ; 94 | : BL BL ; 95 | : BLANK BLANK ; 96 | : BLK BLK ; 97 | : BLOCK BLOCK ; 98 | \ BUFFER 99 | : BYE BYE ; 100 | : C! C! ; 101 | : C" POSTPONE C" ; IMMEDIATE 102 | : C, C, ; 103 | : C@ C@ ; 104 | : CASE POSTPONE CASE ; IMMEDIATE 105 | : CATCH CATCH ; 106 | : CELL+ CELL+ ; 107 | : CELLS CELLS ; 108 | : CHAR CHAR ; 109 | : CHAR+ CHAR+ ; 110 | : CHARS CHARS ; 111 | : CLOSE-FILE CLOSE-FILE ; 112 | : CMOVE CMOVE ; 113 | : CMOVE> CMOVE> ; 114 | : CODE CODE ; 115 | : COMPARE COMPARE ; 116 | : COMPILE, COMPILE, ; 117 | : CONSTANT CONSTANT ; 118 | : COUNT COUNT ; 119 | : CR CR ; 120 | : CREATE CREATE ; 121 | : CREATE-FILE CREATE-FILE ; 122 | : CS-PICK CS-PICK ; 123 | : CS-ROLL CS-ROLL ; 124 | : D+ D+ ; 125 | : D- D- ; 126 | : D. D. ; 127 | : D.R D.R ; 128 | : D0< D0< ; 129 | : D0= D0= ; 130 | : D2* D2* ; 131 | : D2/ D2/ ; 132 | : D< D< ; 133 | : D= D= ; 134 | : D>F D>F ; 135 | : D>S D>S ; 136 | : DABS DABS ; 137 | : DECIMAL DECIMAL ; 138 | : DEFINITIONS DEFINITIONS ; 139 | : DELETE-FILE DELETE-FILE ; 140 | : DEPTH DEPTH ; 141 | : DF! DF! ; 142 | : DF@ DF@ ; 143 | : DFALIGN DFALIGN ; 144 | : DFALIGNED DFALIGNED ; 145 | : DFLOAT+ DFLOAT+ ; 146 | : DFLOATS DFLOATS ; 147 | : DMAX DMAX ; 148 | : DMIN DMIN ; 149 | : DNEGATE DNEGATE ; 150 | : DO POSTPONE DO ; IMMEDIATE 151 | : DOES> POSTPONE DOES> ; IMMEDIATE 152 | : DROP DROP ; 153 | : DU< DU< ; 154 | : DUMP DUMP ; 155 | : DUP DUP ; 156 | \ : EDITOR EDITOR ; 157 | : EKEY EKEY ; 158 | : EKEY>CHAR EKEY>CHAR ; 159 | : EKEY? EKEY? ; 160 | : ELSE POSTPONE ELSE ; IMMEDIATE 161 | : EMIT EMIT ; 162 | \ : EMIT? EMIT? ; 163 | \ EMPTY-BUFFERS 164 | : ENDCASE POSTPONE ENDCASE ; IMMEDIATE 165 | : ENDOF POSTPONE ENDOF ; IMMEDIATE 166 | : ENVIRONMENT? ENVIRONMENT? ; 167 | : ERASE ERASE ; 168 | : EVALUATE EVALUATE ; 169 | : EXECUTE EXECUTE ; 170 | : EXIT POSTPONE EXIT ; IMMEDIATE 171 | : F! F! ; 172 | : F* F* ; 173 | : F** F** ; 174 | : F+ F+ ; 175 | : F- F- ; 176 | : F. F. ; 177 | : F/ F/ ; 178 | : F0< F0< ; 179 | : F0= F0= ; 180 | : F< F< ; 181 | : F>D F>D ; 182 | : F@ F@ ; 183 | : FABS FABS ; 184 | : FACOS FACOS ; 185 | : FACOSH FACOSH ; 186 | : FALIGN FALIGN ; 187 | : FALIGNED FALIGNED ; 188 | : FALOG FALOG ; 189 | : FALSE FALSE ; 190 | : FASIN FASIN ; 191 | : FASINH FASINH ; 192 | : FATAN FATAN ; 193 | : FATAN2 FATAN2 ; 194 | : FATANH FATANH ; 195 | : FCONSTANT FCONSTANT ; 196 | : FCOS FCOS ; 197 | : FCOSH FCOSH ; 198 | : FDEPTH FDEPTH ; 199 | : FDROP FDROP ; 200 | : FDUP FDUP ; 201 | : FE. FE. ; 202 | : FEXP FEXP ; 203 | : FEXPM1 FEXPM1 ; 204 | : FILE-POSITION FILE-POSITION ; 205 | : FILE-SIZE FILE-SIZE ; 206 | : FILE-STATUS FILE-STATUS ; 207 | : FILL FILL ; 208 | : FIND FIND ; 209 | : FLITERAL POSTPONE FLITERAL ; IMMEDIATE 210 | : FLN FLN ; 211 | : FLNP1 FLNP1 ; 212 | : FLOAT+ FLOAT+ ; 213 | : FLOATS FLOATS ; 214 | : FLOG FLOG ; 215 | : FLOOR FLOOR ; 216 | \ FLUSH 217 | : FLUSH-FILE FLUSH-FILE ; 218 | : FM/MOD FM/MOD ; 219 | : FMAX FMAX ; 220 | : FMIN FMIN ; 221 | : FNEGATE FNEGATE ; 222 | : FORTH GET-ORDER NIP STANDARD SWAP SET-ORDER ; 223 | : FORTH-WORDLIST STANDARD ; 224 | : FOVER FOVER ; 225 | : FREE FREE ; 226 | : FROT FROT ; 227 | : FROUND FROUND ; 228 | : FS. FS. ; 229 | : FSIN FSIN ; 230 | : FSINCOS FSINCOS ; 231 | : FSINH FSINH ; 232 | : FSQRT FSQRT ; 233 | : FSWAP FSWAP ; 234 | : FTAN FTAN ; 235 | : FTANH FTANH ; 236 | : FVARIABLE FVARIABLE ; 237 | : F~ F~ ; 238 | : GET-CURRENT GET-CURRENT ; 239 | : GET-ORDER GET-ORDER ; 240 | : HERE HERE ; 241 | : HEX HEX ; 242 | : HOLD HOLD ; 243 | : I POSTPONE I ; IMMEDIATE 244 | : IF POSTPONE IF ; IMMEDIATE 245 | : IMMEDIATE IMMEDIATE ; 246 | : INCLUDE-FILE INCLUDE-FILE ; 247 | : INCLUDED INCLUDED ; 248 | : INVERT INVERT ; 249 | : J POSTPONE J ; IMMEDIATE 250 | : KEY KEY ; 251 | : KEY? KEY? ; 252 | : LEAVE POSTPONE LEAVE ; IMMEDIATE 253 | \ LIST 254 | : LITERAL POSTPONE LITERAL ; IMMEDIATE 255 | \ LOAD 256 | : LOCALS| POSTPONE LOCALS| ; IMMEDIATE 257 | : LOOP POSTPONE LOOP ; IMMEDIATE 258 | : LSHIFT LSHIFT ; 259 | : M* M* ; 260 | : M*/ M*/ ; 261 | : M+ M+ ; 262 | : MARKER MARKER ; 263 | : MAX MAX ; 264 | : MIN MIN ; 265 | : MOD MOD ; 266 | : MOVE MOVE ; 267 | : MS MS ; 268 | : NEGATE NEGATE ; 269 | : NIP NIP ; 270 | : OF POSTPONE OF ; IMMEDIATE 271 | : ONLY STANDARD 1 SET-ORDER ; 272 | : OPEN-FILE OPEN-FILE ; 273 | : OR OR ; 274 | : ORDER ORDER ; 275 | : OVER OVER ; 276 | : PAD PAD ; 277 | : PAGE PAGE ; 278 | : PARSE PARSE ; 279 | : PICK PICK ; 280 | : POSTPONE POSTPONE POSTPONE ; IMMEDIATE 281 | : PRECISION PRECISION ; 282 | : PREVIOUS PREVIOUS ; 283 | : QUIT QUIT ; 284 | : R/O R/O ; 285 | : R/W R/W ; 286 | : R> POSTPONE R> ; IMMEDIATE 287 | : R@ POSTPONE R@ ; IMMEDIATE 288 | : READ-FILE READ-FILE ; 289 | : READ-LINE READ-LINE ; 290 | : RECURSE POSTPONE RECURSE ; IMMEDIATE 291 | : REFILL REFILL ; 292 | : RENAME-FILE RENAME-FILE ; 293 | : REPEAT POSTPONE REPEAT ; IMMEDIATE 294 | : REPOSITION-FILE REPOSITION-FILE ; 295 | : REPRESENT REPRESENT ; 296 | : RESIZE RESIZE ; 297 | : RESIZE-FILE RESIZE-FILE ; 298 | : RESTORE-INPUT RESTORE-INPUT ; 299 | : ROLL ROLL ; 300 | : ROT ROT ; 301 | : RSHIFT RSHIFT ; 302 | : S" STATE @ IF POSTPONE S" ELSE ['] S" EXECUTE THEN ; IMMEDIATE 303 | : S>D S>D ; 304 | \ SAVE-BUFFERS 305 | : SAVE-INPUT SAVE-INPUT ; 306 | \ SCR 307 | : SEARCH SEARCH ; 308 | : SEARCH-WORDLIST SEARCH-WORDLIST ; 309 | : SEE SEE ; 310 | : SET-CURRENT SET-CURRENT ; 311 | : SET-ORDER SET-ORDER ; 312 | : SET-PRECISION SET-PRECISION ; 313 | : SF! SF! ; 314 | : SF@ SF@ ; 315 | : SFALIGN SFALIGN ; 316 | : SFALIGNED SFALIGNED ; 317 | : SFLOAT+ SFLOAT+ ; 318 | : SFLOATS SFLOATS ; 319 | : SIGN SIGN ; 320 | : SLITERAL POSTPONE SLITERAL ; IMMEDIATE 321 | : SM/REM SM/REM ; 322 | : SOURCE SOURCE ; 323 | : SOURCE-ID SOURCE-ID ; 324 | : SPACE SPACE ; 325 | : SPACES SPACES ; 326 | : STATE STATE ; 327 | : SWAP SWAP ; 328 | : THEN POSTPONE THEN ; IMMEDIATE 329 | : THROW THROW ; 330 | \ THRU 331 | : TIME&DATE TIME&DATE ; 332 | : TO STATE @ IF POSTPONE TO ELSE ['] TO EXECUTE THEN ; IMMEDIATE 333 | : TRUE TRUE ; 334 | : TUCK TUCK ; 335 | : TYPE TYPE ; 336 | : U. U. ; 337 | : U.R U.R ; 338 | : U< U< ; 339 | : U> U> ; 340 | : UM* UM* ; 341 | : UM/MOD UM/MOD ; 342 | : UNLOOP POSTPONE UNLOOP ; IMMEDIATE 343 | : UNTIL POSTPONE UNTIL ; IMMEDIATE 344 | : UNUSED UNUSED ; 345 | \ UPDATE 346 | : VALUE VALUE ; 347 | : VARIABLE VARIABLE ; 348 | : W/O W/O ; 349 | : WHILE POSTPONE WHILE ; IMMEDIATE 350 | : WITHIN WITHIN ; 351 | : WORD WORD ; 352 | : WORDLIST WORDLIST ; 353 | : WORDS WORDS ; 354 | : WRITE-FILE WRITE-FILE ; 355 | : WRITE-LINE WRITE-LINE ; 356 | : XOR XOR ; 357 | : [ POSTPONE [ ; IMMEDIATE 358 | : ['] POSTPONE ['] ; IMMEDIATE 359 | : [CHAR] POSTPONE [CHAR] ; IMMEDIATE 360 | : [COMPILE] POSTPONE [COMPILE] ; IMMEDIATE 361 | : [ELSE] POSTPONE [ELSE] ; IMMEDIATE 362 | : [IF] POSTPONE [IF] ; IMMEDIATE 363 | : [THEN] POSTPONE [THEN] ; IMMEDIATE 364 | : \ POSTPONE \ ; IMMEDIATE 365 | : ] ] ; 366 | 367 | STANDARD 1 SET-ORDER 368 | -------------------------------------------------------------------------------- /demos/globe.fs: -------------------------------------------------------------------------------- 1 | \ http://www.jgiesen.de/elevaz/basics/ 2 | \ http://nssdc.gsfc.nasa.gov/planetary/planets/earthpage.html 3 | \ http://www.stargazing.net/kepler/sun.html 4 | 5 | \ include mcp7940m.fs 6 | s" calencal.fs" included 7 | 8 | 480 constant width 9 | 240 constant height 10 | 11 | 65536 s>f fdup f* fconstant FLT_2**32 12 | 13 | ( calibration <-> NVSRAM JCB 17:55 02/15/15) 14 | 15 | $44474653 constant SIGNATURE \ "SFGD" for SwapForth Gameduino 16 | 17 | \ : calibrate 18 | \ \ first word of SRAM is the signature 19 | \ \ the rest is the 24-byte calibration block 20 | \ 21 | \ $20 pad 28 mcp7940m@m 22 | \ pad @ SIGNATURE <> if 23 | \ SIGNATURE pad ! 24 | \ GD.calibrate 25 | \ \ calibration -> pad 26 | \ GD.finish GD.suspend 27 | \ pad cell+ 24 GD.REG_TOUCH_TRANSFORM_A GD.move 28 | \ GD.resume 29 | \ \ pad -> NVRAM 30 | \ pad $20 28 mcp7940m!m 31 | \ else 32 | \ GD.REG_TOUCH_TRANSFORM_A 24 GD.cmd_memwrite 33 | \ pad cell+ 24 GD.supply 34 | \ then 35 | \ ; 36 | 37 | create seetz 24 allot seetz 24 erase 38 | true seetz 4 + c! 39 | true seetz 12 + c! 40 | true seetz 20 + c! 41 | 42 | JAN 1 2000 Fixed-from-Gregorian constant J2000 43 | 44 | \ Represent JD using a 32.32 double 45 | : mhmdy-jd ( mm hh m d y -- jd. ) 46 | Fixed-from-Gregorian 47 | J2000 - >r 48 | 60 * + $40000000 1440 */ 2* 2* 49 | \ 1491308 + \ move to half-past minute to avoid rounding 50 | r> 51 | $80000000. d- 52 | ; 53 | 54 | : jd-mhmdy 55 | $80000000. d+ 56 | >r 2 rshift 1440 $40000000 */ 57 | 60 /mod 58 | r> J2000 + Gregorian-from-Fixed 59 | ; 60 | 61 | T{ 0 11 AUG 7 1997 mhmdy-jd d>f flt_2**32 f/ 100e f* f>s -> -87704 }T 62 | 63 | \ compute the system time scaled for JD. 64 | \ system time from us@ is total microseconds 65 | \ JD is in days, so multiply by number of 66 | \ seconds in a day 67 | 68 | 24 60 * constant MINUTES-IN-DAY 69 | 24 60 * 60 * constant SECONDS-IN-DAY 70 | 71 | : jd@ ( -- jd. ) 72 | us@ 73 | $1000000 74 | 1000000 SECONDS-IN-DAY um* 75 | d2/ d2/ d2/ d2/ d2/ d2/ d2/ d2/ drop 76 | m*/ 77 | ; 78 | 79 | \ ============================================================ 80 | 81 | variable L \ Mean Longitude 82 | variable g \ Mean anomaly 83 | variable lambda \ ecliptic longitude 84 | variable epsilon \ obliquity of the ecliptic plane 85 | 86 | : smod360 87 | 360 mod 88 | dup 0< 360 and + 89 | ; 90 | 91 | : dmod360 92 | smod360 93 | ; 94 | 95 | : dscale 96 | 10000000 m*/ 97 | ; 98 | 99 | : dadd 100 | flt_2**32 f* f>d 101 | postpone 2literal 102 | postpone d+ 103 | ; immediate 104 | 105 | : d360! ( d. fa -- ) 106 | >r 107 | dmod360 108 | d>f flt_2**32 f/ r> f! 109 | ; 110 | 111 | : sunpos2 ( F: d -- RA declination ) 112 | \ 113 | \ L = 280.461 + 0.9856474 * d 114 | \ = -583.99284 + 720 115 | \ (add multiples of 360 to bring in range 0 to 360) 116 | \ = 136.00716 117 | 118 | 2dup 9856474 dscale [ 280.461e ] dadd L d360! 119 | 120 | \ 3. Find the Mean anomaly (g) of the Sun 121 | \ 122 | \ g = 357.528 + 0.9856003 * d 123 | \ = -506.88453 + 720 124 | \ = 213.11547 125 | 126 | 2dup 9856003 dscale [ 357.528e ] dadd g d360! 127 | 128 | \ 4. Find the ecliptic longitude (lambda) of the sun 129 | \ 130 | \ lambda = L + 1.915 * sin(g) + 0.020 * sin(2*g) 131 | \ = 134.97925 132 | \ 133 | \ (note that the sin(g) and sin(2*g) terms constitute an 134 | \ approximation to the 'equation of centre' for the orbit 135 | \ of the Sun) 136 | 137 | L f@ 138 | g f@ degrees fsin 1.915e f* f+ 139 | g f@ 2e f* degrees fsin 0.020e f* f+ 140 | lambda f! 141 | 142 | \ 143 | \ beta = 0 (by definition as the Sun's orbit defines the 144 | \ ecliptic plane. This results in a simplification 145 | \ of the formulas below) 146 | \ 147 | 148 | -0000004 dscale [ 23.439e ] dadd epsilon d360! 149 | 150 | \ 6. Find the Right Ascension (alpha) and Declination (delta) of 151 | \ the Sun 152 | \ 153 | \ Y = cos(epsilon) * sin(lambda) 154 | \ X = cos(lambda) 155 | 156 | lambda f@ degrees fsin epsilon f@ degrees fcos f* 157 | lambda f@ degrees fcos ( Y X ) 158 | 159 | \ 160 | \ a = arctan(Y/X) 161 | 162 | fover fover f/ fatan radians 163 | 164 | \ If X < 0 then alpha = a + 180 165 | \ If Y < 0 and X > 0 then alpha = a + 360 166 | \ else alpha = a 167 | 168 | fswap f0< if 169 | 180e f+ fswap fdrop 170 | else 171 | fswap f0< if 172 | 360e f+ 173 | then 174 | then 175 | 176 | \ 177 | \ Y = 0.6489924 178 | \ X = -0.7068507 179 | \ 180 | \ a = -42.556485 181 | \ alpha = -42.556485 + 180 = 137.44352 (degrees) 182 | 183 | \ delta = arcsin(sin(epsilon)*sin(lambda)) 184 | \ = 16.342193 degrees 185 | 186 | epsilon f@ degrees fsin 187 | lambda f@ degrees fsin f* 188 | fasin radians 189 | ; 190 | 191 | variable gst 192 | 193 | : jdwhere2 194 | 2dup $80000000. d+ drop \ keep the day part 195 | >r 196 | 197 | 2dup sunpos2 ( F: RA dec ) 198 | \ [char] | emit .f [char] | emit 199 | fswap ( F: dec RA ) 200 | 201 | -9856474 dscale [ -100.74145133333332e ] dadd 202 | 203 | ( F: dec RA ) 204 | \ gst d360! gst f@ f+ 205 | flt_2**32 f* f>d d+ 206 | r> 360 um* d- 207 | dmod360 208 | d>f flt_2**32 f/ 209 | 210 | fswap 211 | ; 212 | 213 | \ ============================================================ 214 | 215 | 216 | : dms. 217 | \ [char] ( emit fdup f. [char] ) emit space 218 | fdup f>s 3 .r ." °" 219 | fabs 220 | frac 3600e f* f>s 221 | 60 /mod 2 u.r ." '" 222 | 2 u.r space 223 | ; 224 | 225 | : ew. 226 | fdup 180.0e f< if 227 | dms. [char] E emit 228 | else 229 | 360.0e fswap f- dms. [char] W emit 230 | then 231 | space 232 | ; 233 | 234 | 0 365 2constant YEAR 235 | 0 1 2constant DAY 236 | DAY 1 24 m*/ 2constant HOUR 237 | DAY 1 24 60 * m*/ 2constant MINUTE 238 | DAY 1 24 60 * 60 * m*/ 2constant SECOND 239 | 240 | 241 | : onmap ( F: ra dec -- ) ( -- x y ) 242 | fswap 243 | [ width s>f 360e f/ ] fliteral f* width 2/ s>f f+ width s>f fmod 244 | 16.e f* f>s 245 | [ height 2/ negate s>f 90e f/ ] fliteral f* height 2/ s>f f+ 246 | 16.e f* f>s 247 | ; 248 | 249 | T{ -180e 90e onmap -> 0 0 }T 250 | \ T{ 0e 0e onmap -> 400 16 * 240 16 * }T 251 | 252 | 256 constant YLINE 253 | 254 | : monthname ( x - caddr u ) 255 | dup 1 13 within not throw 256 | 1- 3 * 257 | S" JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC" DROP + 3 258 | ; 259 | 260 | : statusline ( x -- x y font opt ) 261 | width 800 */ 262 | YLINE 30 GD.OPT_CENTER 263 | ; 264 | 265 | : drawnow ( JD. -- ) 266 | 500 GD.LineWidth 267 | 268 | jd-mhmdy 269 | >r 160 statusline r> GD.cmd_number 270 | >r 400 statusline 2 or r> GD.cmd_number 271 | monthname 2>r 300 statusline 2r> GD.cmd_text 272 | >r 540 statusline 2 or r> GD.cmd_number 273 | >r 620 statusline 2 or r> GD.cmd_number 274 | ; 275 | 276 | ( Cities JCB 11:56 02/15/15) 277 | 278 | \ 40.70 -74.00 "New York" 279 | 280 | : latlong 281 | fswap onmap 282 | ; 283 | 284 | variable citylist 0 citylist ! 285 | 286 | : city ( F: lat long -- ) ( name tz -- ) 287 | align here >r 288 | citylist @ , 289 | fswap f> , f> , 290 | , 291 | dup c, 292 | bounds do 293 | i c@ c, 294 | loop 295 | r> citylist ! 296 | ; 297 | 298 | 0200 constant Africa/Cairo 299 | 0000 constant Africa/Dakar 300 | 0300 constant Africa/Dar_es_Salaam 301 | 0200 constant Africa/Gaborone 302 | 0200 constant Africa/Harare 303 | 0200 constant Africa/Johannesburg 304 | 0300 constant Africa/Khartoum 305 | 0100 constant Africa/Lagos 306 | 0300 constant Africa/Mogadishu 307 | -0900 constant America/Anchorage 308 | -0500 constant America/Bogota 309 | -0300 constant America/Buenos_Aires 310 | -0430 constant America/Caracas 311 | -0600 constant America/Chicago 312 | -0700 constant America/Denver 313 | -0500 constant America/Havana 314 | -0400 constant America/La_Paz 315 | -0500 constant America/Lima 316 | -0800 constant America/Los_Angeles 317 | -0600 constant America/Mexico_City 318 | -0500 constant America/Montreal 319 | -0500 constant America/New_York 320 | -0300 constant America/Recife 321 | -0200 constant America/Sao_Paulo 322 | -0800 constant America/Vancouver 323 | 0700 constant Asia/Bangkok 324 | 0530 constant Asia/Calcutta 325 | 0530 constant Asia/Colombo 326 | 0600 constant Asia/Dhaka 327 | 0200 constant Asia/Istanbul 328 | 0700 constant Asia/Jakarta 329 | 0430 constant Asia/Kabul 330 | 0800 constant Asia/Manila 331 | 0300 constant Asia/Riyadh 332 | 0900 constant Asia/Seoul 333 | 0800 constant Asia/Shanghai 334 | 0800 constant Asia/Singapore 335 | 0330 constant Asia/Tehran 336 | 0900 constant Asia/Tokyo 337 | 0000 constant Atlantic/Reykjavik 338 | 0930 constant Australia/Darwin 339 | 0800 constant Australia/Perth 340 | 1100 constant Australia/Sydney 341 | 0100 constant Europe/Berlin 342 | 0000 constant Europe/London 343 | 0100 constant Europe/Madrid 344 | 0400 constant Europe/Moscow 345 | 1300 constant Pacific/Auckland 346 | -0500 constant Pacific/Easter 347 | -1000 constant Pacific/Honolulu 348 | 349 | 61.22e -149.90e s" Anchorage" America/Anchorage city 350 | -36.92e 174.78e s" Auckland" Pacific/Auckland city 351 | 13.73e 100.50e s" Bangkok" Asia/Bangkok city 352 | 52.53e 13.42e s" Berlin" Europe/Berlin city 353 | 4.63e -74.08e s" Bogota" America/Bogota city 354 | -34.67e -58.50e s" Buenos Aires" America/Buenos_Aires city 355 | 30.05e 31.25e s" Cairo" Africa/Cairo city 356 | -33.93e 18.47e s" Cape Town" Africa/Johannesburg city 357 | 10.50e -66.92e s" Caracas" America/Caracas city 358 | 6.92e 79.87e s" Colombo" Asia/Colombo city 359 | 14.63e -17.45e s" Dakar" Africa/Dakar city 360 | -6.85e 39.30e s" Dar es Salaam" Africa/Dar_es_Salaam city 361 | -12.38e 130.73e s" Darwin" Australia/Darwin city 362 | 28.67e 77.22e s" Delhi" Asia/Calcutta city 363 | 39.73e -104.98e s" Denver" America/Denver city 364 | 23.72e 90.37e s" Dhaka" Asia/Dhaka city 365 | -27.12e -109.37e s" Easter Island" Pacific/Easter city 366 | -24.75e 25.92e s" Gaborone" Africa/Gaborone city 367 | -17.83e 31.05e s" Harare" Africa/Harare city 368 | 23.17e -82.35e s" Havana" America/Havana city 369 | 21.30e -157.85e s" Honolulu" Pacific/Honolulu city 370 | 29.75e -95.35e s" Houston" America/Chicago city 371 | 41.03e 28.95e s" Istanbul" Asia/Istanbul city 372 | -6.13e 106.75e s" Jakarta" Asia/Jakarta city 373 | 34.52e 69.18e s" Kabul" Asia/Kabul city 374 | 15.55e 32.53e s" Khartoum" Africa/Khartoum city 375 | -16.50e -68.17e s" La Paz" America/La_Paz city 376 | 6.45e 3.47e s" Lagos" Africa/Lagos city 377 | -12.05e -77.05e s" Lima" America/Lima city 378 | 51.50e -0.17e s" London" Europe/London city 379 | 34.05e -118.23e s" Los Angeles" America/Los_Angeles city 380 | 40.42e -3.72e s" Madrid" Europe/Madrid city 381 | 14.62e 120.97e s" Manila" Asia/Manila city 382 | 19.40e -99.15e s" Mexico City" America/Mexico_City city 383 | 45.50e -73.60e s" Montreal" America/Montreal city 384 | 55.75e 37.70e s" Moscow" Europe/Moscow city 385 | 2.03e 45.35e s" Muqdisho" Africa/Mogadishu city 386 | 40.70e -74.00e s" New York" America/New_York city 387 | -31.97e 115.82e s" Perth" Australia/Perth city 388 | -8.10e -34.88e s" Recife" America/Recife city 389 | 64.15e -21.97e s" Reykjavik" Atlantic/Reykjavik city 390 | 24.65e 46.77e s" Riyadh" Asia/Riyadh city 391 | 37.53e 127.00e s" Seoul" Asia/Seoul city 392 | 31.10e 121.37e s" Shanghai" Asia/Shanghai city 393 | 1.28e 103.85e s" Singapore" Asia/Singapore city 394 | -33.92e 151.17e s" Sydney" Australia/Sydney city 395 | -23.55e -46.65e s" Sao Paulo" America/Sao_Paulo city 396 | 35.67e 51.43e s" Tehran" Asia/Tehran city 397 | 35.75e 139.50e s" Tokyo" Asia/Tokyo city 398 | 49.22e -123.10e s" Vancouver" America/Vancouver city 399 | 400 | : city-tz ( a -- tz ) \ return tz -12..12 for a city 401 | 3 cells + @ 402 | 100 / 403 | ; 404 | 405 | : city-pos ( a -- lat lon ) 406 | cell+ dup f@ 407 | cell+ f@ 408 | ; 409 | 410 | : cities 411 | $c0b0a0 GD.ColorRGB# 412 | GD.SRC_ALPHA 1 GD.BlendFunc 413 | 414 | GD.POINTS GD.Begin 415 | citylist @ 416 | begin 417 | dup 418 | while 419 | dup city-tz 12 + seetz + c@ 13 and 9 + 420 | GD.PointSize 421 | 422 | dup city-pos latlong 423 | GD.Vertex2f 424 | @ 425 | repeat 426 | drop 427 | 428 | $a09080 GD.ColorRGB# 429 | citylist @ 430 | begin 431 | dup 432 | while 433 | dup city-tz 12 + seetz + c@ 434 | if 435 | >r 436 | r@ city-pos latlong 437 | swap 16 / swap 16 / 3 + 438 | 26 GD.OPT_CENTERX 439 | r@ 4 cells + count 440 | GD.cmd_text 441 | \ 2drop 442 | r> 443 | then 444 | @ 445 | repeat 446 | drop 447 | ; 448 | 449 | ( Clocks JCB 14:22 02/15/15) 450 | 451 | : drawclocks ( JD -- ) 452 | \ Track the localtime as minutes-in-week, 453 | \ considering each hour to be 100 minutes. 454 | \ So Sunday 11:30am is 1130 455 | \ Monday 11:30am is 2530 etc. 456 | 457 | 1 - 7 mod 2400 * swap 458 | MINUTES-IN-DAY um* nip 459 | 60 /mod 100 * + 460 | + 461 | 462 | 25 0 do 463 | >r 464 | i 24 mod 465 | dup 100 + GD.Tag 466 | seetz + c@ if 467 | i 800 24 */ dup ( x x ) 468 | 47 26 GD.OPT_CENTER 469 | r@ 2400 mod s>d <# # # [char] : hold # # #> 470 | GD.cmd_text 471 | 63 26 GD.OPT_CENTER 472 | r@ 2400 / 7 mod case 473 | 0 of s" Sun" endof 474 | 1 of s" Mon" endof 475 | 2 of s" Tue" endof 476 | 3 of s" Wed" endof 477 | 4 of s" Thu" endof 478 | 5 of s" Fri" endof 479 | 6 of s" Sat" endof 480 | endcase 481 | GD.cmd_text 482 | $303060 483 | else 484 | $000000 485 | then 486 | GD.cmd_bgcolor 487 | 488 | i 800 24 */ 489 | 17 16 GD.OPT_FLAT GD.OPT_NOSECS or GD.OPT_NOTICKS or 490 | r@ 100 /mod swap 0 0 GD.cmd_clock 491 | 492 | r> 100 + \ advance 1 hour to next zone 493 | loop 494 | drop 495 | ; 496 | 497 | ( Illumination bitmap JCB 19:06 02/14/15) 498 | 499 | 480 240 * 2* constant ILL-BASE 500 | 501 | : ill-setup 502 | 1 GD.BitmapHandle 503 | ILL-BASE GD.BitmapSource 504 | GD.BILINEAR GD.BORDER GD.BORDER 480 240 GD.BitmapSize 505 | GD.L8 200 120 GD.BitmapLayout 506 | 200 120 * 0 do 507 | i 200 mod 0= 508 | i 200 < or 509 | i 200 mod 100 = i 200 / 1 and 0= and or 510 | i ILL-BASE + GD.c! 511 | loop 512 | ; 513 | 514 | \ ============================================================ 515 | : array 516 | create cells allot 517 | does> swap cells + 518 | ; 519 | 520 | \ 'g' is 0.15 fixed-point math format 521 | \ all numbers are -1 to +1. 522 | 523 | : f>g 524 | 32767e f* f>s 525 | ; 526 | 527 | : g* 528 | * 529 | 15 0 do 2/ loop 530 | ; 531 | 532 | : g>s 533 | 7 0 do 2/ loop 534 | ; 535 | 536 | 120 array latsin 537 | 120 array latcos 538 | 200 array loncos 539 | 540 | marker scratchinit 541 | :noname 542 | \ lat 543 | 120 0 do 544 | i 60 - s>f 120e f/ pi f* 545 | fdup fsin f>g i latsin ! 546 | fcos f>g i latcos ! 547 | loop 548 | \ long 549 | 200 0 do 550 | i 100 - s>f 100e f/ pi f* 551 | fcos f>g i loncos ! 552 | loop 553 | ; execute 554 | scratchinit 555 | 556 | : asvector ( lon lat -- x z ) 557 | fdup fsin frot frot 558 | fcos fswap fcos f* 559 | fswap 560 | ; 561 | 562 | variable sx 563 | variable sz 564 | 565 | create linebuf 200 allot 566 | 567 | \ lights8 is a lighting table, indexed -128 to 127 568 | 569 | here 256 allot 128 + constant lights8 570 | 571 | marker tmp 572 | :noname 573 | 128 -128 do 574 | i 575 | 5 * 576 | 0 max 255 min 577 | invert 578 | lights8 i + c! 579 | loop 580 | ; execute 581 | tmp 582 | 583 | code renderline ( multerm addterm -- ) 584 | r0 r3 move, \ r3: addterm 585 | ' drop call, 586 | 0 loncos r1 ldk, \ r1: loncos pointer 587 | 200 loncos r2 ldk, \ r2: loncos limit 588 | linebuf r4 ldk, \ r4: linebuf pointer 589 | lights8 r5 ldk, \ r5: lights8 pointer 590 | begin 591 | 0 r1 cc ldi, \ fetch from loncos 592 | r0 cc cc mul, \ * multerm 593 | 15 # cc cc ashr, \ 594 | r3 cc cc add, \ + addterm 595 | 8 # cc cc ashr, \ g>s 2/ 596 | 597 | r5 cc cc add, 598 | 0 cc cc ldi.b, 599 | r4 0 cc sti.b, \ store 600 | 601 | 1 # r4 r4 add, \ bump 602 | 4 # r1 r1 add, 603 | r1 r2 cmp, 604 | z until 605 | 606 | ' drop jmp, 607 | end-code 608 | 609 | \ variable addterm 610 | \ 611 | \ : renderline ( multerm addterm -- ) 612 | \ addterm ! 613 | \ 200 0 do 614 | \ dup i loncos @ g* 615 | \ addterm @ + 616 | \ g>s 2/ 617 | \ lights8 + c@ 618 | \ linebuf i + c! 619 | \ loop 620 | \ drop 621 | \ ; 622 | 623 | : lightmap ( F: dec -- ) \ compute lightmap, load to bitmap 624 | 0.0e fswap degrees fnegate 625 | asvector f>g sz ! f>g sx ! 626 | 627 | 120 0 do 628 | i latcos @ sx @ g* 629 | i latsin @ sz @ g* 630 | renderline 631 | linebuf 200 GD.supply 632 | loop 633 | ; 634 | 635 | : across ( x y dx -- x' y ) \ move dx pixels across 636 | 16 * 637 | rot + $fffffff0 and 638 | swap 639 | ; 640 | 641 | : draw-wrap ( x y xt -- ) 642 | >r 643 | 2dup r@ execute 644 | 2dup width negate across r@ execute 645 | width across r> execute 646 | ; 647 | 648 | : light ( F: RA dec -- ) 649 | GD.BITMAPS GD.Begin 650 | \ 63 GD.BitmapTransformA 651 | \ 64 GD.BitmapTransformE 652 | 200 255 width */ GD.BitmapTransformA 653 | 120 255 height */ GD.BitmapTransformE 654 | \ 0 0 1 0 GD.Vertex2ii 655 | 656 | ILL-BASE 200 120 * GD.cmd_memwrite 657 | lightmap 658 | 659 | 1 GD.BitmapHandle 660 | 0 GD.Cell 661 | GD.BITMAPS GD.Begin 662 | 90e onmap 663 | 664 | $000000 GD.ColorRGB# 665 | 220 GD.ColorA 666 | width 2/ negate across 667 | ['] GD.Vertex2f draw-wrap 668 | ; 669 | \ ============================================================ 670 | 671 | 672 | : asun ( x y -- ) \ draw a sun 673 | 8 0 do 674 | 500 i 50 * - 675 | width 800 */ 676 | GD.PointSize 677 | 2dup GD.Vertex2f 678 | loop 679 | 2drop 680 | ; 681 | 682 | variable prevtag 683 | 684 | : announce ( message -- ) 685 | 2>r 686 | GD.Clear 687 | width 2/ height 2/ 31 GD.OPT_CENTER 2r> GD.cmd_text 688 | GD.swap 689 | ; 690 | 691 | 2variable time0 692 | 693 | : globe 694 | GD.init 695 | 696 | s" initializing RTC..." announce 697 | 698 | \ mcp7940m-init 699 | 700 | s" loading from microSD" announce 701 | 702 | 0 0 GD.cmd_loadimage 703 | s" EARTH480.JPG" file>gd 704 | 705 | ill-setup 706 | 707 | \ 30 07 FEB 15 2015 708 | \ time&date 709 | 00 01 06 01 01 2015 710 | 711 | >r swap r> 712 | Fixed-from-Gregorian 713 | \ 60 + 183 + 714 | J2000 - 0 swap 715 | $80000000. d- 2>r \ save the day number as a JD 716 | 717 | ( ss mm hh ) 718 | 60 * + 60 * + \ seconds since midnight 719 | 0 swap SECONDS-IN-DAY um/mod nip 720 | 0 \ time of day as a JD 721 | 2r> d+ \ merge them: now as a JD 722 | 723 | jd@ d- time0 2! 724 | 725 | begin 726 | jd@ time0 2@ d+ 727 | time0 2@ 728 | MINUTE d+ MINUTE d+ 729 | MINUTE d+ MINUTE d+ 730 | DAY d+ 731 | time0 2! 732 | 733 | \ cr .s 2dup .x .x space 734 | \ 2dup jd-mhmdy . . . . . 735 | 736 | GD.getinputs 737 | GD.inputs.tag 100 125 within 738 | prevtag @ 0= and if 739 | GD.inputs.tag 100 - seetz + 740 | dup c@ invert swap c! 741 | then 742 | GD.inputs.tag prevtag ! 743 | 744 | GD.Clear 745 | GD.BITMAPS GD.Begin 746 | 0 0 0 0 GD.Vertex2ii 747 | GD.RestoreContext 748 | 749 | 2dup jdwhere2 750 | \ ms@ 751 | fover fover light 752 | \ ms@ swap - cr .ms 753 | 754 | \ Draw the Sun itself as 8 layered circles 755 | onmap 756 | GD.SRC_ALPHA 1 GD.BlendFunc 757 | GD.POINTS GD.Begin 758 | $c08040 GD.ColorRGB# 759 | 80 GD.ColorA 760 | ['] asun draw-wrap 761 | 762 | GD.RestoreContext 763 | \ cities 764 | 765 | GD.RestoreContext 766 | 2dup drawnow 767 | 768 | GD.RestoreContext 769 | \ 2dup drawclocks 770 | 771 | \ 0 240 31 0 GD.inputs.tag GD.cmd_number 772 | 773 | GD.swap 774 | 775 | \ $100000000. d+ 776 | \ DAY d+ 777 | \ MINUTE d+ 778 | \ MINUTE d+ 779 | \ SECOND 60 1 m*/ d+ 780 | \ DAY d+ 781 | \ GD.REG_FRAMES GD.@ . 782 | 783 | 2drop 784 | again 785 | ; 786 | -------------------------------------------------------------------------------- /label.fs: -------------------------------------------------------------------------------- 1 | \ label 2 | \ 3 | \ Create a new wordlist that only contains the ANS words that the 4 | \ host Forth supports. 5 | \ 6 | \ This becomes the Forth wordlist, so the system then behaves 7 | \ just like a pure-ANS Forth. 8 | \ 9 | \ BYE prints the ANS program label, with program requirements. 10 | \ 11 | 12 | : wrap \ if the following word exists in the host Forth, define it 13 | \ otherwise, ignore the rest of the line. 14 | >IN @ 15 | BL WORD FIND NIP 16 | IF 17 | >IN ! 18 | : 19 | ELSE 20 | cr SOURCE type 21 | DROP 22 | POSTPONE \ 23 | THEN 24 | ; 25 | 26 | : (exec) ( xt -- ) \ compile xt if compiling, otherwise execute it 27 | STATE @ IF 28 | COMPILE, 29 | ELSE 30 | EXECUTE 31 | THEN 32 | ; 33 | 34 | : exec 35 | ' POSTPONE LITERAL POSTPONE (EXEC) 36 | ; immediate 37 | 38 | : conly \ a compile-only word 39 | STATE @ 0= IF 40 | abort" Interpretation semantics for this word are undefined" 41 | THEN 42 | ; 43 | 44 | : flag 45 | CREATE FALSE , 46 | DOES> TRUE SWAP ! 47 | ; 48 | 49 | flag BLOCK 50 | flag BLOCK-EXT 51 | flag CORE 52 | flag CORE-EXT 53 | flag DOUBLE 54 | flag DOUBLE-EXT 55 | flag EXCEPTION 56 | flag FACILITY 57 | flag FACILITY-EXT 58 | flag FILE 59 | flag FILE-EXT 60 | flag FLOATING 61 | flag FLOATING-EXT 62 | flag LOCAL 63 | flag LOCAL-EXT 64 | flag MEMORY 65 | flag SEARCH 66 | flag SEARCH-EXT 67 | flag STRING 68 | flag TOOLS 69 | flag TOOLS-EXT 70 | 71 | : requiring 72 | CR 73 | ." \ Requiring the " 74 | TYPE 75 | ." word set" 76 | ; 77 | 78 | : report 79 | CR ." \" 80 | CR ." \ This is an ANS Forth program:" 81 | ['] BLOCK >BODY @ IF S" Block" requiring THEN 82 | ['] BLOCK-EXT >BODY @ IF S" Block Extensions" requiring THEN 83 | ['] CORE-EXT >BODY @ IF S" Core Extensions" requiring THEN 84 | ['] DOUBLE >BODY @ IF S" Double-Number" requiring THEN 85 | ['] DOUBLE-EXT >BODY @ IF S" Double-Number Extensions" requiring THEN 86 | ['] EXCEPTION >BODY @ IF S" Exception" requiring THEN 87 | ['] FACILITY >BODY @ IF S" Facility" requiring THEN 88 | ['] FACILITY-EXT >BODY @ IF S" Facility Extensions" requiring THEN 89 | ['] FILE >BODY @ IF S" File Access" requiring THEN 90 | ['] FILE-EXT >BODY @ IF S" File Access Extensions" requiring THEN 91 | ['] FLOATING >BODY @ IF S" Floating-Point" requiring THEN 92 | ['] FLOATING-EXT >BODY @ IF S" Floating-Point Extensions" requiring THEN 93 | ['] LOCAL >BODY @ IF S" Locals" requiring THEN 94 | ['] LOCAL-EXT >BODY @ IF S" Locals Extensions" requiring THEN 95 | ['] MEMORY >BODY @ IF S" Memory-Allocation Extensions" requiring THEN 96 | ['] SEARCH >BODY @ IF S" Search-Order" requiring THEN 97 | ['] SEARCH-EXT >BODY @ IF S" Search-Order Extensions" requiring THEN 98 | ['] STRING >BODY @ IF S" String" requiring THEN 99 | ['] TOOLS >BODY @ IF S" Programming-Tools" requiring THEN 100 | ['] TOOLS-EXT >BODY @ IF S" Programming-Tools Extensions" requiring THEN 101 | CR ." \" 102 | ; 103 | 104 | WORDLIST CONSTANT STANDARD 105 | STANDARD SET-CURRENT 106 | 107 | wrap ! CORE exec ! ; IMMEDIATE 108 | wrap # CORE exec # ; IMMEDIATE 109 | wrap #> CORE exec #> ; IMMEDIATE 110 | wrap #S CORE exec #S ; IMMEDIATE 111 | wrap #TIB CORE-EXT exec #TIB ; IMMEDIATE 112 | wrap ' CORE exec ' ; IMMEDIATE 113 | wrap ( CORE conly POSTPONE ( ; IMMEDIATE 114 | wrap (LOCAL) LOCAL conly POSTPONE (LOCAL) ; IMMEDIATE 115 | wrap * CORE exec * ; IMMEDIATE 116 | wrap */ CORE exec */ ; IMMEDIATE 117 | wrap */MOD CORE exec */MOD ; IMMEDIATE 118 | wrap + CORE exec + ; IMMEDIATE 119 | wrap +! CORE exec +! ; IMMEDIATE 120 | wrap +LOOP CORE conly POSTPONE +LOOP ; IMMEDIATE 121 | wrap , CORE exec , ; IMMEDIATE 122 | wrap - CORE exec - ; IMMEDIATE 123 | wrap -TRAILING STRING -TRAILING ; 124 | wrap . CORE exec . ; IMMEDIATE 125 | wrap ." CORE conly POSTPONE ." ; IMMEDIATE 126 | wrap .( CORE-EXT POSTPONE .( ; IMMEDIATE 127 | wrap .R CORE-EXT exec .R ; IMMEDIATE 128 | wrap .S TOOLS exec .S ; IMMEDIATE 129 | wrap / CORE exec / ; IMMEDIATE 130 | wrap /MOD CORE exec /MOD ; IMMEDIATE 131 | wrap /STRING STRING exec /STRING ; IMMEDIATE 132 | wrap 0< CORE exec 0< ; IMMEDIATE 133 | wrap 0<> CORE-EXT exec 0<> ; IMMEDIATE 134 | wrap 0= CORE exec 0= ; IMMEDIATE 135 | wrap 0> CORE-EXT exec 0> ; IMMEDIATE 136 | wrap 1+ CORE exec 1+ ; IMMEDIATE 137 | wrap 1- CORE exec 1- ; IMMEDIATE 138 | wrap 2! CORE exec 2! ; IMMEDIATE 139 | wrap 2* CORE exec 2* ; IMMEDIATE 140 | wrap 2/ CORE exec 2/ ; IMMEDIATE 141 | wrap 2>R CORE-EXT conly POSTPONE 2>R ; IMMEDIATE 142 | wrap 2@ CORE exec 2@ ; IMMEDIATE 143 | wrap 2CONSTANT DOUBLE exec 2CONSTANT ; IMMEDIATE 144 | wrap 2DROP CORE exec 2DROP ; IMMEDIATE 145 | wrap 2DUP CORE exec 2DUP ; IMMEDIATE 146 | wrap 2LITERAL DOUBLE conly POSTPONE 2LITERAL ; IMMEDIATE 147 | wrap 2OVER CORE exec 2OVER ; IMMEDIATE 148 | wrap 2R> CORE-EXT conly POSTPONE 2R> ; IMMEDIATE 149 | wrap 2R@ CORE-EXT conly POSTPONE 2R@ ; IMMEDIATE 150 | wrap 2ROT DOUBLE-EXT exec 2ROT ; IMMEDIATE 151 | wrap 2SWAP CORE exec 2SWAP ; IMMEDIATE 152 | wrap 2VARIABLE DOUBLE 2VARIABLE ; 153 | wrap : CORE exec : ; IMMEDIATE 154 | wrap :NONAME CORE-EXT exec :NONAME ; IMMEDIATE 155 | wrap ; CORE conly POSTPONE ; ; IMMEDIATE 156 | wrap ;CODE TOOLS-EXT conly POSTPONE ;CODE ; IMMEDIATE 157 | wrap < CORE exec < ; IMMEDIATE 158 | wrap <# CORE exec <# ; IMMEDIATE 159 | wrap <> CORE-EXT exec <> ; IMMEDIATE 160 | wrap = CORE exec = ; IMMEDIATE 161 | wrap > CORE exec > ; IMMEDIATE 162 | wrap >BODY CORE exec >BODY ; IMMEDIATE 163 | wrap >FLOAT FLOATING exec >FLOAT ; IMMEDIATE 164 | wrap >IN CORE exec >IN ; IMMEDIATE 165 | wrap >NUMBER CORE exec >NUMBER ; IMMEDIATE 166 | wrap >R CORE conly POSTPONE >R ; IMMEDIATE 167 | wrap ? TOOLS conly POSTPONE ? ; IMMEDIATE 168 | wrap ?DO CORE-EXT conly POSTPONE ?DO ; IMMEDIATE 169 | wrap ?DUP CORE exec ?DUP ; IMMEDIATE 170 | wrap @ CORE exec @ ; IMMEDIATE 171 | wrap ABORT CORE exec ABORT ; IMMEDIATE 172 | wrap ABORT" CORE conly POSTPONE ABORT" ; IMMEDIATE 173 | wrap ABS CORE exec ABS ; IMMEDIATE 174 | wrap ACCEPT CORE exec ACCEPT ; IMMEDIATE 175 | wrap AGAIN CORE-EXT conly POSTPONE AGAIN ; IMMEDIATE 176 | wrap AHEAD TOOLS-EXT conly POSTPONE AHEAD ; IMMEDIATE 177 | wrap ALIGN CORE exec ALIGN ; IMMEDIATE 178 | wrap ALIGNED CORE exec ALIGNED ; IMMEDIATE 179 | wrap ALLOCATE MEMORY exec ALLOCATE ; IMMEDIATE 180 | wrap ALLOT CORE exec ALLOT ; IMMEDIATE 181 | wrap ALSO SEARCH-EXT exec ALSO ; IMMEDIATE 182 | wrap AND CORE exec AND ; IMMEDIATE 183 | wrap ASSEMBLER TOOLS-EXT exec ASSEMBLER ; IMMEDIATE 184 | wrap AT-XY FACILITY exec AT-XY ; IMMEDIATE 185 | wrap BASE CORE exec BASE ; IMMEDIATE 186 | wrap BEGIN CORE conly POSTPONE BEGIN ; IMMEDIATE 187 | wrap BIN FILE exec BIN ; IMMEDIATE 188 | wrap BL CORE exec BL ; IMMEDIATE 189 | wrap BLANK STRING exec BLANK ; IMMEDIATE 190 | wrap BLK BLOCK exec BLK ; IMMEDIATE 191 | wrap BLOCK BLOCK exec BLOCK ; IMMEDIATE 192 | wrap BUFFER BLOCK exec BUFFER ; IMMEDIATE 193 | wrap BYE ( TOOLS-EXT ) report BYE ; 194 | wrap C! CORE exec C! ; IMMEDIATE 195 | wrap C" CORE-EXT conly POSTPONE C" ; IMMEDIATE 196 | wrap C, CORE exec C, ; IMMEDIATE 197 | wrap C@ CORE exec C@ ; IMMEDIATE 198 | wrap CASE CORE-EXT conly POSTPONE CASE ; IMMEDIATE 199 | wrap CATCH EXCEPTION exec CATCH ; IMMEDIATE 200 | wrap CELL+ CORE exec CELL+ ; IMMEDIATE 201 | wrap CELLS CORE exec CELLS ; IMMEDIATE 202 | wrap CHAR CORE exec CHAR ; IMMEDIATE 203 | wrap CHAR+ CORE exec CHAR+ ; IMMEDIATE 204 | wrap CHARS CORE exec CHARS ; IMMEDIATE 205 | wrap CLOSE-FILE FILE exec CLOSE-FILE ; IMMEDIATE 206 | wrap CMOVE STRING exec CMOVE ; IMMEDIATE 207 | wrap CMOVE> STRING exec CMOVE> ; IMMEDIATE 208 | wrap CODE TOOLS-EXT exec CODE ; IMMEDIATE 209 | wrap COMPARE STRING exec COMPARE ; IMMEDIATE 210 | wrap COMPILE, CORE-EXT exec COMPILE, ; IMMEDIATE 211 | wrap CONSTANT CORE exec CONSTANT ; IMMEDIATE 212 | wrap CONVERT CORE-EXT exec CONVERT ; IMMEDIATE 213 | wrap COUNT CORE exec COUNT ; IMMEDIATE 214 | wrap CR CORE exec CR ; IMMEDIATE 215 | wrap CREATE CORE exec CREATE ; IMMEDIATE 216 | wrap CREATE-FILE FILE exec CREATE-FILE ; IMMEDIATE 217 | wrap CS-PICK TOOLS-EXT exec CS-PICK ; IMMEDIATE 218 | wrap CS-ROLL TOOLS-EXT exec CS-ROLL ; IMMEDIATE 219 | wrap D+ DOUBLE exec D+ ; IMMEDIATE 220 | wrap D- DOUBLE exec D- ; IMMEDIATE 221 | wrap D. DOUBLE exec D. ; IMMEDIATE 222 | wrap D.R DOUBLE exec D.R ; IMMEDIATE 223 | wrap D0< DOUBLE exec D0< ; IMMEDIATE 224 | wrap D0= DOUBLE exec D0= ; IMMEDIATE 225 | wrap D2* DOUBLE exec D2* ; IMMEDIATE 226 | wrap D2/ DOUBLE exec D2/ ; IMMEDIATE 227 | wrap D< DOUBLE exec D< ; IMMEDIATE 228 | wrap D= DOUBLE exec D= ; IMMEDIATE 229 | wrap D>F FLOATING exec D>F ; IMMEDIATE 230 | wrap D>S DOUBLE exec D>S ; IMMEDIATE 231 | wrap DABS DOUBLE exec DABS ; IMMEDIATE 232 | wrap DECIMAL CORE exec DECIMAL ; IMMEDIATE 233 | wrap DEFINITIONS SEARCH exec DEFINITIONS ; IMMEDIATE 234 | wrap DELETE-FILE FILE exec DELETE-FILE ; IMMEDIATE 235 | wrap DEPTH CORE exec DEPTH ; IMMEDIATE 236 | wrap DF! FLOATING-EXT exec DF! ; IMMEDIATE 237 | wrap DF@ FLOATING-EXT exec DF@ ; IMMEDIATE 238 | wrap DFALIGN FLOATING-EXT exec DFALIGN ; IMMEDIATE 239 | wrap DFALIGNED FLOATING-EXT exec DFALIGNED ; IMMEDIATE 240 | wrap DFLOAT+ FLOATING-EXT exec DFLOAT+ ; IMMEDIATE 241 | wrap DFLOATS FLOATING-EXT exec DFLOATS ; IMMEDIATE 242 | wrap DMAX DOUBLE exec DMAX ; IMMEDIATE 243 | wrap DMIN DOUBLE exec DMIN ; IMMEDIATE 244 | wrap DNEGATE DOUBLE exec DNEGATE ; IMMEDIATE 245 | wrap DO CORE conly POSTPONE DO ; IMMEDIATE 246 | wrap DOES> CORE conly POSTPONE DOES> ; IMMEDIATE 247 | wrap DROP CORE exec DROP ; IMMEDIATE 248 | wrap DU< DOUBLE-EXT exec DU< ; IMMEDIATE 249 | wrap DUMP TOOLS exec DUMP ; IMMEDIATE 250 | wrap DUP CORE exec DUP ; IMMEDIATE 251 | wrap EDITOR TOOLS-EXT exec EDITOR ; IMMEDIATE 252 | wrap EKEY FACILITY-EXT exec EKEY ; IMMEDIATE 253 | wrap EKEY>CHAR FACILITY-EXT exec EKEY>CHAR ; IMMEDIATE 254 | wrap EKEY? FACILITY-EXT exec EKEY? ; IMMEDIATE 255 | wrap ELSE CORE conly POSTPONE ELSE ; IMMEDIATE 256 | wrap EMIT CORE exec EMIT ; IMMEDIATE 257 | wrap EMIT? FACILITY-EXT exec EMIT? ; IMMEDIATE 258 | wrap EMPTY-BUFFERS BLOCK-EXT exec EMPTY-BUFFERS ; IMMEDIATE 259 | wrap ENDCASE CORE-EXT conly POSTPONE ENDCASE ; IMMEDIATE 260 | wrap ENDOF CORE-EXT conly POSTPONE ENDOF ; IMMEDIATE 261 | wrap ENVIRONMENT? CORE exec ENVIRONMENT? ; IMMEDIATE 262 | wrap ERASE CORE-EXT exec ERASE ; IMMEDIATE 263 | wrap EVALUATE CORE exec EVALUATE ; IMMEDIATE 264 | wrap EXECUTE CORE exec EXECUTE ; IMMEDIATE 265 | wrap EXIT CORE conly POSTPONE EXIT ; IMMEDIATE 266 | wrap EXPECT CORE-EXT exec EXPECT ; IMMEDIATE 267 | wrap F! FLOATING exec F! ; IMMEDIATE 268 | wrap F* FLOATING exec F* ; IMMEDIATE 269 | wrap F** FLOATING-EXT exec F** ; IMMEDIATE 270 | wrap F+ FLOATING exec F+ ; IMMEDIATE 271 | wrap F- FLOATING exec F- ; IMMEDIATE 272 | wrap F. FLOATING-EXT exec F. ; IMMEDIATE 273 | wrap F/ FLOATING exec F/ ; IMMEDIATE 274 | wrap F0< FLOATING exec F0< ; IMMEDIATE 275 | wrap F0= FLOATING exec F0= ; IMMEDIATE 276 | wrap F< FLOATING exec F< ; IMMEDIATE 277 | wrap F>D FLOATING exec F>D ; IMMEDIATE 278 | wrap F@ FLOATING exec F@ ; IMMEDIATE 279 | wrap FABS FLOATING-EXT exec FABS ; IMMEDIATE 280 | wrap FACOS FLOATING-EXT exec FACOS ; IMMEDIATE 281 | wrap FACOSH FLOATING-EXT exec FACOSH ; IMMEDIATE 282 | wrap FALIGN FLOATING exec FALIGN ; IMMEDIATE 283 | wrap FALIGNED FLOATING exec FALIGNED ; IMMEDIATE 284 | wrap FALOG FLOATING-EXT exec FALOG ; IMMEDIATE 285 | wrap FALSE CORE-EXT exec FALSE ; IMMEDIATE 286 | wrap FASIN FLOATING-EXT exec FASIN ; IMMEDIATE 287 | wrap FASINH FLOATING-EXT exec FASINH ; IMMEDIATE 288 | wrap FATAN FLOATING-EXT exec FATAN ; IMMEDIATE 289 | wrap FATAN2 FLOATING-EXT exec FATAN2 ; IMMEDIATE 290 | wrap FATANH FLOATING-EXT exec FATANH ; IMMEDIATE 291 | wrap FCONSTANT FLOATING exec FCONSTANT ; IMMEDIATE 292 | wrap FCOS FLOATING-EXT exec FCOS ; IMMEDIATE 293 | wrap FCOSH FLOATING-EXT exec FCOSH ; IMMEDIATE 294 | wrap FDEPTH FLOATING exec FDEPTH ; IMMEDIATE 295 | wrap FDROP FLOATING exec FDROP ; IMMEDIATE 296 | wrap FDUP FLOATING exec FDUP ; IMMEDIATE 297 | wrap FE. FLOATING-EXT exec FE. ; IMMEDIATE 298 | wrap FEXP FLOATING-EXT exec FEXP ; IMMEDIATE 299 | wrap FEXPM1 FLOATING-EXT exec FEXPM1 ; IMMEDIATE 300 | wrap FILE-POSITION FILE exec FILE-POSITION ; IMMEDIATE 301 | wrap FILE-SIZE FILE exec FILE-SIZE ; IMMEDIATE 302 | wrap FILE-STATUS FILE-EXT exec FILE-STATUS ; IMMEDIATE 303 | wrap FILL CORE exec FILL ; IMMEDIATE 304 | wrap FIND CORE exec FIND ; IMMEDIATE 305 | wrap FLITERAL FLOATING conly POSTPONE FLITERAL ; IMMEDIATE 306 | wrap FLN FLOATING-EXT exec FLN ; IMMEDIATE 307 | wrap FLNP1 FLOATING-EXT exec FLNP1 ; IMMEDIATE 308 | wrap FLOAT+ FLOATING exec FLOAT+ ; IMMEDIATE 309 | wrap FLOATS FLOATING exec FLOATS ; IMMEDIATE 310 | wrap FLOG FLOATING-EXT exec FLOG ; IMMEDIATE 311 | wrap FLOOR FLOATING exec FLOOR ; IMMEDIATE 312 | wrap FLUSH BLOCK exec FLUSH ; IMMEDIATE 313 | wrap FLUSH-FILE FILE-EXT exec FLUSH-FILE ; IMMEDIATE 314 | wrap FM/MOD CORE exec FM/MOD ; IMMEDIATE 315 | wrap FMAX FLOATING exec FMAX ; IMMEDIATE 316 | wrap FMIN FLOATING exec FMIN ; IMMEDIATE 317 | wrap FNEGATE FLOATING exec FNEGATE ; IMMEDIATE 318 | wrap FORGET TOOLS-EXT exec FORGET ; IMMEDIATE 319 | wrap FORTH SEARCH-EXT GET-ORDER NIP STANDARD SWAP SET-ORDER ; 320 | wrap FORTH-WORDLIST SEARCH exec STANDARD ; IMMEDIATE 321 | wrap FOVER FLOATING exec FOVER ; IMMEDIATE 322 | wrap FREE MEMORY exec FREE ; IMMEDIATE 323 | wrap FROT FLOATING exec FROT ; IMMEDIATE 324 | wrap FROUND FLOATING exec FROUND ; IMMEDIATE 325 | wrap FS. FLOATING-EXT exec FS. ; IMMEDIATE 326 | wrap FSIN FLOATING-EXT exec FSIN ; IMMEDIATE 327 | wrap FSINCOS FLOATING-EXT exec FSINCOS ; IMMEDIATE 328 | wrap FSINH FLOATING-EXT exec FSINH ; IMMEDIATE 329 | wrap FSQRT FLOATING-EXT exec FSQRT ; IMMEDIATE 330 | wrap FSWAP FLOATING exec FSWAP ; IMMEDIATE 331 | wrap FTAN FLOATING-EXT exec FTAN ; IMMEDIATE 332 | wrap FTANH FLOATING-EXT exec FTANH ; IMMEDIATE 333 | wrap FVARIABLE FLOATING exec FVARIABLE ; IMMEDIATE 334 | wrap F~ FLOATING-EXT exec F~ ; IMMEDIATE 335 | wrap GET-CURRENT SEARCH exec GET-CURRENT ; IMMEDIATE 336 | wrap GET-ORDER SEARCH exec GET-ORDER ; IMMEDIATE 337 | wrap HERE CORE exec HERE ; IMMEDIATE 338 | wrap HEX CORE-EXT exec HEX ; IMMEDIATE 339 | wrap HOLD CORE exec HOLD ; IMMEDIATE 340 | wrap I CORE conly POSTPONE I ; IMMEDIATE 341 | wrap IF CORE conly POSTPONE IF ; IMMEDIATE 342 | wrap IMMEDIATE CORE exec IMMEDIATE ; IMMEDIATE 343 | wrap INCLUDE-FILE FILE exec INCLUDE-FILE ; IMMEDIATE 344 | wrap INCLUDED FILE exec INCLUDED ; IMMEDIATE 345 | wrap INVERT CORE exec INVERT ; IMMEDIATE 346 | wrap J CORE conly POSTPONE J ; IMMEDIATE 347 | wrap KEY CORE exec KEY ; IMMEDIATE 348 | wrap KEY? FACILITY exec KEY? ; IMMEDIATE 349 | wrap LEAVE CORE conly POSTPONE LEAVE ; IMMEDIATE 350 | wrap LIST BLOCK-EXT exec LIST ; IMMEDIATE 351 | wrap LITERAL CORE conly POSTPONE LITERAL ; IMMEDIATE 352 | wrap LOAD BLOCK exec LOAD ; IMMEDIATE 353 | wrap LOCALS| LOCAL-EXT conly POSTPONE LOCALS| ; IMMEDIATE 354 | wrap LOOP CORE conly POSTPONE LOOP ; IMMEDIATE 355 | wrap LSHIFT CORE exec LSHIFT ; IMMEDIATE 356 | wrap M* CORE exec M* ; IMMEDIATE 357 | wrap M*/ DOUBLE exec M*/ ; IMMEDIATE 358 | wrap M+ DOUBLE exec M+ ; IMMEDIATE 359 | wrap MARKER CORE-EXT exec MARKER ; IMMEDIATE 360 | wrap MAX CORE exec MAX ; IMMEDIATE 361 | wrap MIN CORE exec MIN ; IMMEDIATE 362 | wrap MOD CORE exec MOD ; IMMEDIATE 363 | wrap MOVE CORE exec MOVE ; IMMEDIATE 364 | wrap MS FACILITY-EXT exec MS ; IMMEDIATE 365 | wrap NEGATE CORE exec NEGATE ; IMMEDIATE 366 | wrap NIP CORE-EXT exec NIP ; IMMEDIATE 367 | wrap OF CORE-EXT conly POSTPONE OF ; IMMEDIATE 368 | wrap ONLY SEARCH-EXT STANDARD 1 SET-ORDER ; 369 | wrap OPEN-FILE FILE exec OPEN-FILE ; IMMEDIATE 370 | wrap OR CORE exec OR ; IMMEDIATE 371 | wrap ORDER SEARCH-EXT exec ORDER ; IMMEDIATE 372 | wrap OVER CORE exec OVER ; IMMEDIATE 373 | wrap PAD CORE-EXT exec PAD ; IMMEDIATE 374 | wrap PAGE FACILITY exec PAGE ; IMMEDIATE 375 | wrap PARSE CORE-EXT exec PARSE ; IMMEDIATE 376 | wrap PICK CORE-EXT exec PICK ; IMMEDIATE 377 | wrap POSTPONE CORE conly POSTPONE POSTPONE ; IMMEDIATE 378 | wrap PRECISION FLOATING-EXT exec PRECISION ; IMMEDIATE 379 | wrap PREVIOUS SEARCH-EXT exec PREVIOUS ; IMMEDIATE 380 | wrap QUERY CORE-EXT exec QUERY ; IMMEDIATE 381 | wrap QUIT CORE exec QUIT ; IMMEDIATE 382 | wrap R/O FILE exec R/O ; IMMEDIATE 383 | wrap R/W FILE exec R/W ; IMMEDIATE 384 | wrap R> CORE conly POSTPONE R> ; IMMEDIATE 385 | wrap R@ CORE conly POSTPONE R@ ; IMMEDIATE 386 | wrap READ-FILE FILE exec READ-FILE ; IMMEDIATE 387 | wrap READ-LINE FILE exec READ-LINE ; IMMEDIATE 388 | wrap RECURSE CORE conly POSTPONE RECURSE ; IMMEDIATE 389 | wrap REFILL CORE-EXT exec REFILL ; IMMEDIATE 390 | wrap RENAME-FILE FILE-EXT exec RENAME-FILE ; IMMEDIATE 391 | wrap REPEAT CORE conly POSTPONE REPEAT ; IMMEDIATE 392 | wrap REPOSITION-FILE FILE exec REPOSITION-FILE ; IMMEDIATE 393 | wrap REPRESENT FLOATING exec REPRESENT ; IMMEDIATE 394 | wrap RESIZE MEMORY exec RESIZE ; IMMEDIATE 395 | wrap RESIZE-FILE FILE exec RESIZE-FILE ; IMMEDIATE 396 | wrap RESTORE-INPUT CORE-EXT exec RESTORE-INPUT ; IMMEDIATE 397 | wrap ROLL CORE-EXT exec ROLL ; IMMEDIATE 398 | wrap ROT CORE exec ROT ; IMMEDIATE 399 | wrap RSHIFT CORE exec RSHIFT ; IMMEDIATE 400 | wrap S" CORE STATE @ IF POSTPONE S" ELSE FILE ['] S" EXECUTE THEN ; IMMEDIATE 401 | wrap S>D CORE exec S>D ; IMMEDIATE 402 | wrap SAVE-BUFFERS BLOCK exec SAVE-BUFFERS ; IMMEDIATE 403 | wrap SAVE-INPUT CORE-EXT exec SAVE-INPUT ; IMMEDIATE 404 | wrap SCR BLOCK-EXT exec SCR ; IMMEDIATE 405 | wrap SEARCH STRING exec SEARCH ; IMMEDIATE 406 | wrap SEARCH-WORDLIST SEARCH exec SEARCH-WORDLIST ; IMMEDIATE 407 | wrap SEE TOOLS exec SEE ; IMMEDIATE 408 | wrap SET-CURRENT SEARCH exec SET-CURRENT ; IMMEDIATE 409 | wrap SET-ORDER SEARCH exec SET-ORDER ; IMMEDIATE 410 | wrap SET-PRECISION FLOATING-EXT exec SET-PRECISION ; IMMEDIATE 411 | wrap SF! FLOATING-EXT exec SF! ; IMMEDIATE 412 | wrap SF@ FLOATING-EXT exec SF@ ; IMMEDIATE 413 | wrap SFALIGN FLOATING-EXT exec SFALIGN ; IMMEDIATE 414 | wrap SFALIGNED FLOATING-EXT exec SFALIGNED ; IMMEDIATE 415 | wrap SFLOAT+ FLOATING-EXT exec SFLOAT+ ; IMMEDIATE 416 | wrap SFLOATS FLOATING-EXT exec SFLOATS ; IMMEDIATE 417 | wrap SIGN CORE exec SIGN ; IMMEDIATE 418 | wrap SLITERAL STRING conly POSTPONE SLITERAL ; IMMEDIATE 419 | wrap SM/REM CORE exec SM/REM ; IMMEDIATE 420 | wrap SOURCE CORE exec SOURCE ; IMMEDIATE 421 | wrap SOURCE-ID CORE-EXT exec SOURCE-ID ; IMMEDIATE 422 | wrap SPACE CORE exec SPACE ; IMMEDIATE 423 | wrap SPACES CORE exec SPACES ; IMMEDIATE 424 | wrap SPAN CORE-EXT exec SPAN ; IMMEDIATE 425 | wrap STATE CORE exec STATE ; IMMEDIATE 426 | wrap SWAP CORE exec SWAP ; IMMEDIATE 427 | wrap THEN CORE conly POSTPONE THEN ; IMMEDIATE 428 | wrap THROW EXCEPTION exec THROW ; IMMEDIATE 429 | wrap THRU BLOCK-EXT exec THRU ; IMMEDIATE 430 | wrap TIB CORE-EXT exec TIB ; IMMEDIATE 431 | wrap TIME&DATE FACILITY-EXT exec TIME&DATE ; IMMEDIATE 432 | wrap TO CORE-EXT STATE @ IF POSTPONE TO ELSE ['] TO EXECUTE THEN ; IMMEDIATE 433 | wrap TRUE CORE-EXT exec TRUE ; IMMEDIATE 434 | wrap TUCK CORE-EXT exec TUCK ; IMMEDIATE 435 | wrap TYPE CORE exec TYPE ; IMMEDIATE 436 | wrap U. CORE exec U. ; IMMEDIATE 437 | wrap U.R CORE-EXT exec U.R ; IMMEDIATE 438 | wrap U< CORE exec U< ; IMMEDIATE 439 | wrap U> CORE-EXT exec U> ; IMMEDIATE 440 | wrap UM* CORE exec UM* ; IMMEDIATE 441 | wrap UM/MOD CORE exec UM/MOD ; IMMEDIATE 442 | wrap UNLOOP CORE conly POSTPONE UNLOOP ; IMMEDIATE 443 | wrap UNTIL CORE conly POSTPONE UNTIL ; IMMEDIATE 444 | wrap UNUSED CORE-EXT exec UNUSED ; IMMEDIATE 445 | wrap UPDATE BLOCK exec UPDATE ; IMMEDIATE 446 | wrap VALUE CORE-EXT exec VALUE ; IMMEDIATE 447 | wrap VARIABLE CORE exec VARIABLE ; IMMEDIATE 448 | wrap W/O FILE exec W/O ; IMMEDIATE 449 | wrap WHILE CORE conly POSTPONE WHILE ; IMMEDIATE 450 | wrap WITHIN CORE-EXT exec WITHIN ; IMMEDIATE 451 | wrap WORD CORE exec WORD ; IMMEDIATE 452 | wrap WORDLIST SEARCH exec WORDLIST ; IMMEDIATE 453 | wrap WORDS TOOLS exec WORDS ; IMMEDIATE 454 | wrap WRITE-FILE FILE exec WRITE-FILE ; IMMEDIATE 455 | wrap WRITE-LINE FILE exec WRITE-LINE ; IMMEDIATE 456 | wrap XOR CORE exec XOR ; IMMEDIATE 457 | wrap [ CORE conly POSTPONE [ ; IMMEDIATE 458 | wrap ['] CORE conly POSTPONE ['] ; IMMEDIATE 459 | wrap [CHAR] CORE conly POSTPONE [CHAR] ; IMMEDIATE 460 | wrap [COMPILE] CORE-EXT conly POSTPONE [COMPILE] ; IMMEDIATE 461 | wrap [ELSE] TOOLS-EXT POSTPONE [ELSE] ; IMMEDIATE 462 | wrap [IF] TOOLS-EXT POSTPONE [IF] ; IMMEDIATE 463 | wrap [THEN] TOOLS-EXT POSTPONE [THEN] ; IMMEDIATE 464 | wrap \ CORE-EXT POSTPONE \ ; IMMEDIATE 465 | wrap ] CORE exec ] ; IMMEDIATE 466 | 467 | STANDARD 1 SET-ORDER 468 | -------------------------------------------------------------------------------- /demos/frogger.fs: -------------------------------------------------------------------------------- 1 | \ 2 | \ FROGGER - conversion from C to the FT800 3 | \ 4 | \ This is an ANS Forth program: 5 | \ Requiring the Core Extensions word set 6 | \ Requiring the Exception word set 7 | \ Requiring the Facility Extensions word set 8 | \ Requiring the File Access word set 9 | \ 10 | 11 | GD.init 12 | 13 | hex 14 | 05000000 GD.c 01000000 GD.c 0801c100 GD.c 0721c100 GD.c 05000001 GD.c 15 | 0100e000 GD.c 08002010 GD.c 07004010 GD.c 05000002 GD.c 0101a800 GD.c 16 | 08001008 GD.c 07201008 GD.c 05000003 GD.c 0101a840 GD.c 08006030 GD.c 17 | 07186030 GD.c 05000004 GD.c 0101b140 GD.c 08001008 GD.c 07080208 GD.c 18 | 0101b140 GD.c ffffff2b GD.c 00000004 GD.c 0001b540 GD.c ffffff22 GD.c 19 | 00000000 GD.c 9ded9c78 GD.c 47238fcf GD.c 6bdbc715 GD.c 096484d8 GD.c 20 | 642bf110 GD.c 09090de2 GD.c b21afc84 GD.c 9961f2b0 GD.c 400fe241 GD.c 21 | 2c5607fc GD.c 24021eed GD.c 1120870a GD.c 13fe42d9 GD.c 71007f96 GD.c 22 | 3f8905ca GD.c 73466c82 GD.c e61c0d83 GD.c b997b162 GD.c 1eee2b44 GD.c 23 | 7eaeae99 GD.c bd55ef5d GD.c ed7b6eaa GD.c fbf7bbb1 GD.c 577719e9 GD.c 24 | f5d557bd GD.c db5555ea GD.c af7772e5 GD.c 99d9cf57 GD.c ce5fc81f GD.c 25 | e6ca220a GD.c 42a857c5 GD.c ae2941e5 GD.c 6e1962d4 GD.c 7d88b39d GD.c 26 | 2972cf3d GD.c 16d6a5f7 GD.c b3e41077 GD.c a2aadb13 GD.c f69ac0c9 GD.c 27 | b23dfb05 GD.c 3f6cacef GD.c ed55f6f5 GD.c ed73a44c GD.c 4d4a6451 GD.c 28 | 80ef92b9 GD.c 669ffaf5 GD.c 9f8bd53d GD.c 597dae8f GD.c 4c67dbc4 GD.c 29 | c93ed639 GD.c 9c1db281 GD.c c2da459d GD.c 838da0a5 GD.c 1c92ee89 GD.c 30 | 40e8cf3f GD.c e9a673e6 GD.c 00000003 GD.c 00000000 GD.c 5862a000 GD.c 31 | 87ff2bd0 GD.c fb92bede GD.c 9be8b6fb GD.c c521f3ff GD.c bdcb9f9c GD.c 32 | fa6da292 GD.c 88a152bd GD.c 9f7b85eb GD.c 95ebead6 GD.c cb49d413 GD.c 33 | a2a17bf4 GD.c 7a48514b GD.c b7ddb2a5 GD.c 9e28df4f GD.c fb3d47e7 GD.c 34 | ab2afb42 GD.c f49b5930 GD.c e7e7248b GD.c 97a37cbd GD.c eed95f62 GD.c 35 | e9d6e935 GD.c c2ed7217 GD.c 486a2e71 GD.c afa75bec GD.c 9921c828 GD.c 36 | a5da675f GD.c c2aa1b6f GD.c 58585dd0 GD.c df4eb57d GD.c f66b9ee8 GD.c 37 | 6d190cf3 GD.c 5fb54fd4 GD.c 36d37aed GD.c 94ff64fd GD.c ea569bd7 GD.c 38 | b9e7fac7 GD.c a36ce976 GD.c abbf66be GD.c ae96f126 GD.c 7d74fa65 GD.c 39 | 6f67ed0c GD.c d578f816 GD.c f5f4fd46 GD.c b69abfd1 GD.c 3fd63f4b GD.c 40 | 437137ab GD.c 4eb56639 GD.c 7b3fd23f GD.c e0a7c7e5 GD.c f4bb54f3 GD.c 41 | 0a3837cb GD.c 736406d4 GD.c b0fe9f68 GD.c b4fa7fbe GD.c 587edf48 GD.c 42 | 1f77ecd2 GD.c aae7e4a9 GD.c 9d9be996 GD.c 1514f98e GD.c 9b6aae7c GD.c 43 | 0000003e GD.c 00000000 GD.c 00000000 GD.c 00000000 GD.c 00000000 GD.c 44 | 00000000 GD.c 00000000 GD.c 00000000 GD.c 00000000 GD.c 00000000 GD.c 45 | 00000000 GD.c 59b20db0 GD.c bfcccd96 GD.c 0b5d65dd GD.c d47708cf GD.c 46 | 7abf70b1 GD.c 09dd8761 GD.c f2fde7f7 GD.c 28761d85 GD.c ddfaebbc GD.c 47 | e732d87a GD.c 8b856e81 GD.c 6675b983 GD.c 8365c307 GD.c 5aedecad GD.c 48 | 9ea7d678 GD.c 1970d1d8 GD.c 7763ba27 GD.c 9ce465c2 GD.c 9858ee8c GD.c 49 | a295993c GD.c d68b85ae GD.c d76c1bca GD.c 59c7e4c2 GD.c b8e2c367 GD.c 50 | 7d3ee17b GD.c 8f8ac89c GD.c 030b1d17 GD.c 00000000 GD.c 00000000 GD.c 51 | 00000000 GD.c 00000000 GD.c 00000000 GD.c 00000000 GD.c 00000000 GD.c 52 | 00000000 GD.c 00000000 GD.c 00000000 GD.c 11d80000 GD.c 4ebf767b GD.c 53 | d573ffdc GD.c 097abf70 GD.c 85d68aee GD.c b7efa6f0 GD.c 5de16fb9 GD.c 54 | c3d6efd7 GD.c 5fba3d96 GD.c c5c3a6e7 GD.c afdcfec1 GD.c 7ee1d373 GD.c 55 | db33fdcd GD.c a9f59e1e GD.c 5c347627 GD.c d8ee89c6 GD.c b919709d GD.c 56 | dcebf72f GD.c b93c9874 GD.c dcebf72f GD.c ad68b874 GD.c 2d76c1bc GD.c 57 | 759c7e4c GD.c bb8e2c36 GD.c d5efee17 GD.c 1d373afd GD.c c1e1ad06 GD.c 58 | 2ebb0783 GD.c 3e1956c2 GD.c 08baee18 GD.c d86864db GD.c c8b62175 GD.c 59 | 5afb0170 GD.c aee06e4d GD.c 865ed08b GD.c 16cb223b GD.c 1cded505 GD.c 60 | 7adc2c66 GD.c d535acfb GD.c 70b8dade GD.c 6fb3ddb1 GD.c b7d898f1 GD.c 61 | 4fb9e6c1 GD.c ac8b65f6 GD.c b2cbfed3 GD.c ddd7da4e GD.c 8cfb73f1 GD.c 62 | 4662a6ee GD.c be686d77 GD.c 2f9ddd1c GD.c e71e4be7 GD.c 2b0b07b4 GD.c 63 | 2c1ddd1d GD.c c84d1cfc GD.c 1b72b0a4 GD.c 6467cff2 GD.c 71e585b4 GD.c 64 | ac12a767 GD.c 2a52372a GD.c e5e52681 GD.c dbe74b0b GD.c a7e7da13 GD.c 65 | 71876b88 GD.c 4197f4e9 GD.c 5a5b1eda GD.c 86ad7fe7 GD.c 7b75ffb8 GD.c 66 | 76dbf5e3 GD.c cd18cbff GD.c 31a75e3e GD.c b8f8dadf GD.c dbe4ebe7 GD.c 67 | 5cffeb43 GD.c bf7ff5aa GD.c 3ffaa77d GD.c 43ff9cc9 GD.c b5fe532b GD.c 68 | eb5c9de9 GD.c 5affd29f GD.c 63ade4ff GD.c 86e7fadf GD.c 66db5459 GD.c 69 | cf8339c2 GD.c 987829e4 GD.c 566f96fb GD.c cf83428b GD.c cc8ee6cc GD.c 70 | 05b349a6 GD.c d791affb GD.c 5f2e9fe7 GD.c 5136fb33 GD.c 6cff497f GD.c 71 | a1e4c593 GD.c c9c8a7fb GD.c e4a5b343 GD.c 82fa98ee GD.c bba339eb GD.c 72 | 97997d2c GD.c 177a64db GD.c 5cd9d36f GD.c 5895a6b8 GD.c 4ebe9e99 GD.c 73 | aebfca9e GD.c f1f6757c GD.c e51ca1da GD.c 3bb975f9 GD.c 57705b7f GD.c 74 | c6247b46 GD.c 3dab85c0 GD.c b4b92ebf GD.c 63b17c81 GD.c 3abe56b9 GD.c 75 | d9fad4fb GD.c 1fefad4c GD.c efbf3adc GD.c dba8fd84 GD.c e9fabaf2 GD.c 76 | f9d3f30a GD.c f0b90ca9 GD.c a0b83664 GD.c c86584cd GD.c 73332749 GD.c 77 | 3327b5cc GD.c 3a9f9f23 GD.c 2134d3a9 GD.c 797d7e9e GD.c e563fcb3 GD.c 78 | beafb3ab GD.c aacc767e GD.c 78d635ef GD.c 1a7e12ef GD.c fee9c772 GD.c 79 | ba125743 GD.c 2babf2a6 GD.c b38b9d1f GD.c 790d342d GD.c f5e5f57d GD.c 80 | dfe937f9 GD.c f1b6fb29 GD.c cb801a5e GD.c 262c1264 GD.c 5c6631e1 GD.c 81 | 1b1a7b34 GD.c 9ed39c79 GD.c 19a95a9f GD.c ed1cfd6f GD.c 1b724f38 GD.c 82 | 46e7cff2 GD.c 25771a55 GD.c 6cd6647c GD.c b1bb93a8 GD.c ae9dcb5d GD.c 83 | 086d7408 GD.c 9870e9a5 GD.c 8c3b5c5f GD.c 0cbfa74b GD.c d2d8f6d2 GD.c 84 | 356bff3a GD.c dbaffdc4 GD.c b6dfaf1b GD.c 68c65ffb GD.c 8d3af1f6 GD.c 85 | 6dde96f9 GD.c f97ad2e8 GD.c 3ffad0f6 GD.c dffd6a97 GD.c fea9df6f GD.c 86 | 399bdfcf GD.c bfca491d GD.c ad373bfe GD.c 6bff4a7f GD.c 8eb793fd GD.c 87 | 009feb7d GD.c 00000000 GD.c c0000000 GD.c a8ae13a3 GD.c 12b431e1 GD.c 88 | a09dacc2 GD.c 75721335 GD.c b0bc7144 GD.c c2eeb352 GD.c 69d691cf GD.c 89 | 82342b54 GD.c 1935f233 GD.c 74011e45 GD.c 636ab776 GD.c 5691b935 GD.c 90 | bca45425 GD.c 7ce9617c GD.c fcfb427b GD.c 30ed7114 GD.c 32fe9d2e GD.c 91 | 6b43db48 GD.c 5affc875 GD.c ebff710d GD.c b7ebc6f6 GD.c 3197feed GD.c 92 | 2e440afa GD.c f147cad7 GD.c c9d7cf71 GD.c ffd687b7 GD.c ffeb54b9 GD.c 93 | f54efb7e GD.c 8b26b97f GD.c ff292474 GD.c ae4ef4da GD.c 7fe94ff5 GD.c 94 | d6f27fad GD.c 13fd6fb1 GD.c 00000000 GD.c 00000000 GD.c 2ddff420 GD.c 95 | 7cf8d285 GD.c f9d4c914 GD.c 3fbf911d GD.c 76fda1db GD.c 3fcbcfca GD.c 96 | 09339cbb GD.c 648617cf GD.c 588a78ea GD.c cea4a40d GD.c 9d3498ca GD.c 97 | ea7d3eb6 GD.c 437cfefc GD.c e62a067a GD.c 352347e3 GD.c 3f3754bf GD.c 98 | 17fcf768 GD.c 7c0e7e75 GD.c ed4b477e GD.c df5ffdcb GD.c bb952dc9 GD.c 99 | 7f926f2f GD.c ec4d7caa GD.c 760f9bab GD.c 399abbb1 GD.c 93523de2 GD.c 100 | b49a63c5 GD.c cf8b8a08 GD.c 6419da7c GD.c a7ac7b3b GD.c 6d0eb54f GD.c 101 | c6be587e GD.c 37f975e4 GD.c ccfd5f2f GD.c 69b62c6e GD.c d3fcc78d GD.c 102 | 57db758c GD.c fe6eff73 GD.c 1898fafc GD.c 7363291b GD.c 6af971fb GD.c 103 | 6b2937f9 GD.c 0017eabb GD.c 00000000 GD.c 51f8f000 GD.c afe37f37 GD.c 104 | 9b67f25f GD.c 5239f5c2 GD.c b5dcff23 GD.c e7c516c8 GD.c 7e1f62af GD.c 105 | 5f729372 GD.c 92bfafea GD.c 4daef21a GD.c 9ce6dca1 GD.c f05a2198 GD.c 106 | 2cea41d5 GD.c fdca42c0 GD.c 8de7b3fa GD.c abab50ad GD.c 52e67f1f GD.c 107 | 8fd5819f GD.c 7eb71d1f GD.c c97ecf93 GD.c 53d5c8d2 GD.c fa9202dc GD.c 108 | 5836e1fe GD.c 5ff5b2af GD.c 26b4c3c2 GD.c 5affad90 GD.c dcf20f70 GD.c 109 | dfe016b5 GD.c 016fcbb3 GD.c 0fa5efa1 GD.c 3e85df7d GD.c f6bce4d6 GD.c 110 | 0f48fd64 GD.c 28769cd3 GD.c 43c8e7f5 GD.c 66866c8f GD.c c6da4dad GD.c 111 | bab5e8e7 GD.c 9f7036e1 GD.c b33723f0 GD.c 1dc0ebca GD.c deb5dabb GD.c 112 | ab2beb17 GD.c 82634216 GD.c 58e51f6c GD.c eface421 GD.c 0b54f279 GD.c 113 | deeb93a8 GD.c 2527ed97 GD.c 35eb52a7 GD.c 7a0d8e18 GD.c d3fcd20b GD.c 114 | 0000bfcc GD.c 00000000 GD.c e5c00000 GD.c fcb77751 GD.c cfbaae3c GD.c 115 | dc777aa5 GD.c c504d885 GD.c 2dfd3fdd GD.c 4b3f3792 GD.c b7bf3d2c GD.c 116 | 693f3bb7 GD.c 8e7b5269 GD.c 6aa0aef2 GD.c b7f6d3f9 GD.c 4ffde49d GD.c 117 | eb1dfb83 GD.c 3cd0d04f GD.c bffa88c3 GD.c eabb63b8 GD.c 44aa7a7f GD.c 118 | fa61ffda GD.c cb6ffdd5 GD.c cbeffcef GD.c d74fecea GD.c f7e03b5f GD.c 119 | 7def0dc3 GD.c 4baaef6d GD.c b1dde1c7 GD.c 3a7fe1b7 GD.c f7febaef GD.c 120 | aebf5fef GD.c 5fd89bff GD.c 4efb7f57 GD.c 54bec4ba GD.c 0d4fe6d7 GD.c 121 | f2905bd0 GD.c 1a45015c GD.c bb929e7b GD.c 43dc73cf GD.c bad01ef6 GD.c 122 | a7b3f115 GD.c db8619bd GD.c ea4b5fe7 GD.c 9e8ff6ae GD.c d2ebdcb7 GD.c 123 | 7c85c350 GD.c dfcf54ef GD.c 11ae5260 GD.c 8fae418e GD.c b37f3f36 GD.c 124 | 6d866ff2 GD.c 00003fd6 GD.c 00000000 GD.c d75b419b GD.c 916eafe6 GD.c 125 | bf92b9bf GD.c dcaddabf GD.c da15c95f GD.c bfe8d202 GD.c 5dfb8ee9 GD.c 126 | 525cb91e GD.c 6193df72 GD.c 96b971de GD.c abe23f0b GD.c a75ff4f5 GD.c 127 | a7d8a683 GD.c 709fc4a7 GD.c 645e9512 GD.c c7b72417 GD.c f4f8bcbe GD.c 128 | a34f524e GD.c c17fdcfc GD.c c92cef37 GD.c dfce0df4 GD.c 1a66bac0 GD.c 129 | 7cfd20db GD.c d1b9ff6a GD.c d6c2f84a GD.c 5283354f GD.c ab7e6584 GD.c 130 | 4a45c0cc GD.c 835ec178 GD.c baf3b9d2 GD.c 39ba68a7 GD.c cc4cc99f GD.c 131 | 32fccdf0 GD.c b4bf72f9 GD.c b1da27c6 GD.c 5b8da0d4 GD.c b659cec2 GD.c 132 | 76e7272b GD.c 474ee4c7 GD.c 9cd61ee6 GD.c e0e5761e GD.c 58a61635 GD.c 133 | bfc2ffc9 GD.c bb7fe797 GD.c cbeffcc5 GD.c 1493ff43 GD.c d11a67fe GD.c 134 | a694aad1 GD.c d0d1f435 GD.c afbe2793 GD.c a69ff0ba GD.c efebb3ee GD.c 135 | 5fce6aba GD.c 41b09ed8 GD.c 70b6535c GD.c bd0d1afe GD.c b4916d37 GD.c 136 | f6c917a5 GD.c d194c950 GD.c b237caa8 GD.c af96203a GD.c 5e4d7da8 GD.c 137 | d8968ea5 GD.c b1b2c3c9 GD.c 934c03f7 GD.c b7245de9 GD.c 9787fd86 GD.c 138 | a581b3dd GD.c a8e435d6 GD.c 01ede97a GD.c d8000000 GD.c b17c9f0a GD.c 139 | ec629caa GD.c aa2f93fe GD.c dd8509f0 GD.c 87933146 GD.c 3e3cae2e GD.c 140 | 55292971 GD.c 237fe5a8 GD.c fe78e94f GD.c d3c2f3e1 GD.c 33dafa84 GD.c 141 | a3cd57c7 GD.c d71af01d GD.c 4ccf9c8e GD.c 66b8bbfd GD.c f39ff71b GD.c 142 | a27b1e53 GD.c c5c937c5 GD.c 2f3c2b4b GD.c 4d89cfda GD.c 5e4bdbe5 GD.c 143 | 55bb73a2 GD.c db96362b GD.c 2af2214d GD.c 2e7b4fcf GD.c ad7feebd GD.c 144 | 53feb214 GD.c 3124b21a GD.c 9ceedea9 GD.c e3c15fcc GD.c 4b5f546a GD.c 145 | 2650f245 GD.c 53935c6b GD.c 9d8978ea GD.c f49b2c3c GD.c bd3a692e GD.c 146 | aba94b74 GD.c d7d72e2f GD.c 0f7e690f GD.c bdf9cf6b GD.c 8ebe7d8d GD.c 147 | 57ad0794 GD.c 92e1fb78 GD.c b6aa7f94 GD.c 3101c6ce GD.c af1d583e GD.c 148 | c67ef377 GD.c bffc2dfa GD.c cc6bea41 GD.c 369e2a7a GD.c 1e850e3e GD.c 149 | 06d95292 GD.c ecf294f4 GD.c fe6bcf31 GD.c 1cb42390 GD.c 91ad9ba9 GD.c 150 | bf57b50d GD.c fd4a3fce GD.c 4a6e23fa GD.c e387971a GD.c 2eba9fac GD.c 151 | f427d767 GD.c 294a985e GD.c db8ca1e5 GD.c 1304472e GD.c af71ffb2 GD.c 152 | 77569c52 GD.c e30d5f7e GD.c 297072ea GD.c 52c77962 GD.c 00000001 GD.c 153 | e0caac00 GD.c 3f3a7e62 GD.c cc8d498d GD.c 9369696e GD.c 9fe7523c GD.c 154 | 9a664e9f GD.c 1cf54906 GD.c 459e548c GD.c cc29654a GD.c 9d46ac19 GD.c 155 | 3c75b135 GD.c 56da4794 GD.c 49b012dd GD.c 791d5aea GD.c d70be62a GD.c 156 | fc3cfc12 GD.c d0f32216 GD.c bf6b865a GD.c 2fdf9f8f GD.c 7ad0f46f GD.c 157 | dd5cd9bf GD.c eb141a87 GD.c a4d3479f GD.c c66d523c GD.c 3695d4e9 GD.c 158 | 249b0726 GD.c ab78efde GD.c 3f4274d0 GD.c f75f71c9 GD.c c2cf1361 GD.c 159 | 9d639bf7 GD.c a8fc85d1 GD.c 0a612e8d GD.c 36c24ed9 GD.c 56f12520 GD.c 160 | fe8e78f1 GD.c 423523bb GD.c 435f23db GD.c 4c7a487a GD.c cb65b31b GD.c 161 | f5229588 GD.c 682bb16e GD.c 32687ddf GD.c cddd866d GD.c b4f36b3a GD.c 162 | 9d7b1cfa GD.c fa86cddc GD.c 17dffbb9 GD.c 61c03369 GD.c 276d84f9 GD.c 163 | 27bf37c5 GD.c e293fec2 GD.c 05b122fb GD.c 86c653b5 GD.c 3ce276f2 GD.c 164 | fbdf79ad GD.c a6d1bdc6 GD.c a73d02b5 GD.c 5aaf79a6 GD.c ce8f3b06 GD.c 165 | ae3625fd GD.c 6996c55b GD.c dfcf6d42 GD.c ffbff75d GD.c 41f4841d GD.c 166 | ee875df8 GD.c ef397aa9 GD.c e39f9ad9 GD.c 72757a72 GD.c baf26deb GD.c 167 | fa477efc GD.c 229f294d GD.c 1ef9f617 GD.c 010c560f GD.c 5fb45db0 GD.c 168 | e335b8e7 GD.c b9534583 GD.c ff2425fb GD.c eb93a445 GD.c 3c9cdf67 GD.c 169 | 726adb2c GD.c b677725e GD.c 7aff2bcb GD.c 1159ff72 GD.c fd6eb3ab GD.c 170 | cbcffdc5 GD.c bb7f95ac GD.c 34f958f2 GD.c 69f6627b GD.c 9bac37ed GD.c 171 | 2aacfd74 GD.c 59aeebf7 GD.c 8567b5f9 GD.c d626deac GD.c bb4fd1b1 GD.c 172 | 976ffe2f GD.c abb9f43c GD.c 2ff566cf GD.c 78febe7d GD.c c036d9b0 GD.c 173 | c31e90cb GD.c ab397b42 GD.c 7cb28f8f GD.c 95bffbcd GD.c 7d7edaaf GD.c 174 | 754cad7d GD.c 681b78e1 GD.c da8fff5a GD.c 63bcb406 GD.c af929675 GD.c 175 | bd6dffe3 GD.c ae475807 GD.c bfbeddd7 GD.c 8f7cd187 GD.c 00004ffb GD.c 176 | 80000000 GD.c c1ecc304 GD.c 3afe41e2 GD.c 5986185c GD.c 6ab3ec56 GD.c 177 | 6182343f GD.c 69b52f2e GD.c 23bcd97f GD.c 49fed1a9 GD.c 50fb4248 GD.c 178 | 76fda227 GD.c adfd4d1c GD.c 1bfaa114 GD.c d7f57c69 GD.c 3fea90eb GD.c 179 | bfab87ae GD.c fea704d6 GD.c fdbf8d23 GD.c 4c5e67e5 GD.c 8d43ffa5 GD.c 180 | 3f3ff2e5 GD.c fea43195 GD.c 4f32caaa GD.c 95464370 GD.c e4a8affa GD.c 181 | bf7fcbfa GD.c faaca223 GD.c 22cb3acb GD.c 2b88a1c1 GD.c 59d25ff4 GD.c 182 | f36f04da GD.c fdfea338 GD.c c132cb08 GD.c d7323c5b GD.c 92c2317f GD.c 183 | 22c9bc12 GD.c 11ebfd73 GD.c f9f97f48 GD.c d7322e9b GD.c de1f101f GD.c 184 | d2affce3 GD.c a37bde5f GD.c 5ff5c9d2 GD.c 632dee20 GD.c e93afe7c GD.c 185 | 13cffae4 GD.c 97f5469f GD.c ea56bf9f GD.c 23dffae4 GD.c 4fcbfa12 GD.c 186 | fd5c9d4b GD.c bfa52239 GD.c c9d5b5fc GD.c f12efff3 GD.c fdfa848f GD.c 187 | ffd72752 GD.c bfd0910e GD.c 93a94aff GD.c 889b7feb GD.c 01ffdfeb GD.c 188 | dffae4e9 GD.c dffb7e22 GD.c 5ebffa88 GD.c fd7274ae GD.c ea70466f GD.c 189 | 5cc8b92f GD.c 9508d9ff GD.c d22c8bfa GD.c 87437fe8 GD.c 38b3afd4 GD.c 190 | 5d7d9fa3 GD.c 73ffaac7 GD.c fe8ae3c0 GD.c 529d35f2 GD.c 0ed9c45d GD.c 191 | a14a8cf9 GD.c 2a8882fe GD.c 5557fbfb GD.c 8c81fa8c GD.c 9ae501a2 GD.c 192 | bcfeae46 GD.c abc6a98c GD.c f8529fa7 GD.c 939f9feb GD.c 01bb4f11 GD.c 193 | d4afa9f1 GD.c 701f14f3 GD.c 0e47ac9f GD.c 91d44fe8 GD.c e34d5c79 GD.c 194 | 97d967ab GD.c 79ea8453 GD.c 50c52f82 GD.c 3afa73d5 GD.c 95c36d11 GD.c 195 | 95c93d2b GD.c 836d092b GD.c c10f0a51 GD.c 2f3533fe GD.c 54153fcb GD.c 196 | af079b33 GD.c 77e3c78e GD.c 076bb20e GD.c 671e87a6 GD.c 0627e347 GD.c 197 | 66983eb7 GD.c 0daf57c7 GD.c eca3e3fa GD.c dbcdc199 GD.c 4f39bcd3 GD.c 198 | 09be9346 GD.c 93470e0f GD.c 8e9fbe71 GD.c e3335eaf GD.c 3f77adfb GD.c 199 | 5fabf5bc GD.c c6e9e51e GD.c b7abfdc7 GD.c c1dc2ed6 GD.c 3a78f1cd GD.c 200 | e679671e GD.c dc1b2fe6 GD.c 37468d18 GD.c b7c7d906 GD.c feddf2f3 GD.c 201 | 3c3e3b38 GD.c 3c3c3a3c GD.c d1a3a6ce GD.c d7649724 GD.c c677470f GD.c 202 | e367ae37 GD.c 3b38d922 GD.c 5fcb66be GD.c 7cbcf834 GD.c f9bfdbe3 GD.c 203 | bbbfc7c3 GD.c 3d25be53 GD.c 4d1fc6ce GD.c 7ae5efa7 GD.c 71ffdfe3 GD.c 204 | b19dfefa GD.c d8d8ef29 GD.c 9c6c9f91 GD.c df845867 GD.c 1373fdbf GD.c 205 | ddd263be GD.c 323a3dba GD.c 43971cf9 GD.c cfd4b8d7 GD.c 3a3a3e5f GD.c 206 | bfdf3278 GD.c 7cde9d37 GD.c a3a13329 GD.c 8dd9c68f GD.c 8c0ecf1b GD.c 207 | 6789f4de GD.c 4c1f860e GD.c c7aee037 GD.c f5030683 GD.c 98033156 GD.c 208 | fcb27ff9 GD.c 7bdfc5ff GD.c 5f01ffd9 GD.c 008877b9 GD.c 209 | decimal 210 | 0 constant BACKGROUND_HANDLE 211 | 224 constant BACKGROUND_WIDTH 212 | 256 constant BACKGROUND_HEIGHT 213 | 1 constant BACKGROUND_CELLS 214 | 1 constant SPRITES_HANDLE 215 | 16 constant SPRITES_WIDTH 216 | 16 constant SPRITES_HEIGHT 217 | 100 constant SPRITES_CELLS 218 | 2 constant LIFE_HANDLE 219 | 8 constant LIFE_WIDTH 220 | 8 constant LIFE_HEIGHT 221 | 1 constant LIFE_CELLS 222 | 3 constant ARROW_HANDLE 223 | 48 constant ARROW_WIDTH 224 | 48 constant ARROW_HEIGHT 225 | 1 constant ARROW_CELLS 226 | 4 constant FONT_HANDLE 227 | 8 constant FONT_WIDTH 228 | 8 constant FONT_HEIGHT 229 | 128 constant FONT_CELLS 230 | 112084 constant ASSETS_END 231 | 232 | 1 constant CONTROL_LEFT 233 | 2 constant CONTROL_RIGHT 234 | 4 constant CONTROL_UP 235 | 8 constant CONTROL_DOWN 236 | 237 | : lookup \ a byte lookup table 238 | create 239 | does> + c@ 240 | ; 241 | 242 | \ Game variables 243 | 0 value t 244 | 0 value prevt 245 | variable frogx \ screen position 246 | variable frogy \ screen position 247 | variable leaping \ 0 means not leaping, 1-8 animates the leap 248 | variable frogdir \ while leaping, which direction is the leap? 249 | variable frogface \ which way is the frog facing, in furmans for CMD_ROTATE 250 | variable dying \ 0 means not dying, 1-64 animation counter 251 | variable score 252 | variable hiscore 0 hiscore ! 253 | variable lives 254 | create done 5 allot 255 | 256 | lookup homes 24 c, 72 c, 120 c, 168 c, 216 c, 257 | variable time 258 | 259 | : frog_start 260 | 120 frogx ! 261 | 232 frogy ! 262 | 0 leaping ! 263 | 0 frogdir ! 264 | 0 frogface ! 265 | 0 dying ! 266 | 120 7 lshift time ! 267 | ; 268 | 269 | : level_start 270 | done 5 erase 271 | ; 272 | 273 | : game_start 274 | 4 lives ! 275 | 0 score ! 276 | 0 to t 277 | ; 278 | 279 | : game_setup 280 | game_start 281 | level_start 282 | frog_start 283 | ; 284 | 285 | : draw_score ( x y n -- ) 286 | >r 287 | swap 8 * swap 8 * 288 | FONT_HANDLE 5 r> 289 | GD.cmd_number 290 | ; 291 | 292 | : sprite ( x y anim -- ) 293 | >r 294 | swap 16 - 255 and swap 8 - 255 and 295 | over 224 > if 296 | r> GD.Cell 297 | swap 256 - 16 * swap 16 * 298 | GD.Vertex2f 299 | else 300 | SPRITES_HANDLE r> GD.Vertex2ii 301 | then 302 | ; 303 | 304 | : r1 ( x y -- x' y ) \ move 16 pixels right, a sprite's width 305 | swap 16 + swap 306 | ; 307 | 308 | : turtleanim ( -- u ) \ the current turtle animation frame 309 | t 5 rshift 3 mod 50 + 310 | ; 311 | 312 | : turtle3 ( x y -- ) \ draw three turtles 313 | turtleanim >r 314 | 2dup r@ sprite 315 | r1 2dup r@ sprite 316 | r1 r> sprite 317 | ; 318 | 319 | : turtle2 ( x y -- ) \ draw two turtles 320 | turtleanim >r 321 | 2dup r@ sprite 322 | r1 r> sprite 323 | ; 324 | 325 | : log ( length x y -- ) 326 | 2dup 86 sprite r1 327 | rot 0 do 328 | 2dup 87 sprite r1 329 | loop 330 | 88 sprite 331 | ; 332 | 333 | : riverat ( y tt -- ) 334 | swap case 335 | 120 of negate endof 336 | 104 of endof 337 | 88 of 5 4 */ endof 338 | 72 of negate 2/ endof 339 | 56 of 2/ endof 340 | endcase 341 | ; 342 | 343 | : squarewave ( note amp -- ) \ continuous MIDI note, amp 0-255 344 | GD.REG_VOL_SOUND GD.c! 345 | 8 lshift 1 or GD.REG_SOUND GD.! 346 | 1 GD.REG_PLAY GD.c! 347 | ; 348 | 349 | : sound 350 | dying @ if 351 | 84 dying @ 2/ - 352 | 100 353 | else 354 | leaping @ if 355 | leaping @ 2 and 0<> 12 and 60 + 356 | 100 357 | else 358 | 0 0 359 | then 360 | then 361 | squarewave 362 | ; 363 | 364 | : silence 365 | 0 GD.REG_VOL_SOUND GD.c! 366 | ; 367 | 368 | : rotate_around ( x y a -- ) \ rotate sprite a degrees around (x,y) 369 | 14 lshift >r 370 | swap 65536 * swap 65536 * 371 | GD.cmd_loadidentity 372 | 2dup GD.cmd_translate 373 | r> GD.cmd_rotate 374 | swap negate swap negate GD.cmd_translate 375 | GD.cmd_setmatrix 376 | ; 377 | 378 | : GD.touching 379 | GD.inputs.x -32768 <> 380 | ; 381 | 382 | : letter ( x spr -- x' ) \ one letter of "F R O G G E R" 383 | >r 384 | dup 50 SPRITES_HANDLE r> GD.Vertex2ii 385 | 24 + 386 | ; 387 | 388 | : game_over 389 | silence 390 | 60 0 do 391 | GD.Clear 392 | \ Draw "F R O G G E R" using the sprites 90-94 393 | GD.BITMAPS GD.Begin 394 | 160 395 | 90 letter \ F 396 | 91 letter \ R 397 | 92 letter \ O 398 | 93 letter \ G 399 | 93 letter \ G 400 | 94 letter \ E 401 | 91 letter \ R 402 | drop 403 | 240 136 FONT_HANDLE GD.OPT_CENTER s" GAME OVER" GD.cmd_text 404 | i 59 = if 405 | 240 200 FONT_HANDLE GD.OPT_CENTER s" PRESS TO PLAY" GD.cmd_text 406 | then 407 | 408 | GD.swap 409 | loop 410 | begin GD.getinputs GD.touching until 411 | begin GD.getinputs GD.touching 0= until 412 | ; 413 | 414 | : padx ( i - x ) 415 | 3 - 48 * 480 + 416 | ; 417 | 418 | : pady ( i -- y ) 419 | 3 - 48 * 272 + 420 | ; 421 | 422 | : pads 423 | CONTROL_RIGHT GD.Tag 424 | 2 padx 1 pady ARROW_HANDLE 0 GD.Vertex2ii 425 | 426 | 24 24 3 rotate_around 427 | CONTROL_UP GD.Tag 428 | 1 padx 0 pady ARROW_HANDLE 0 GD.Vertex2ii 429 | 430 | 24 24 2 rotate_around 431 | CONTROL_LEFT GD.Tag 432 | 0 padx 1 pady ARROW_HANDLE 0 GD.Vertex2ii 433 | 434 | 24 24 1 rotate_around 435 | CONTROL_DOWN GD.Tag 436 | 1 padx 2 pady ARROW_HANDLE 0 GD.Vertex2ii 437 | ; 438 | 439 | lookup frog_anim 440 | 2 c, 1 c, 0 c, 0 c, 2 c, 441 | lookup die_anim 442 | 31 c, 32 c, 33 c, 30 c, 443 | 444 | : drawfrog \ draw the frog himself, or his death animation 445 | frogx @ frogy @ 446 | dying @ 0= if 447 | leaping @ 2/ frog_anim 448 | else 449 | dying @ 16 / die_anim 450 | then 451 | sprite 452 | ; 453 | 454 | : touching 455 | GD.inputs.ptag 2 = 456 | ; 457 | 458 | : die 459 | 1 dying ! 460 | ; 461 | 462 | : gameloop 463 | GD.getinputs 464 | GD.Clear 465 | 1 GD.Tag 466 | SPRITES_HANDLE GD.BitmapHandle 467 | GD.SaveContext 468 | 224 256 GD.ScissorSize 469 | GD.BITMAPS GD.Begin 470 | 0 0 BACKGROUND_HANDLE 0 GD.Vertex2ii 471 | 472 | frogx @ 8 - GD.REG_TAG_X GD.! 473 | frogy @ GD.REG_TAG_Y GD.! 474 | 475 | 2 GD.Tag 476 | GD.GREATER 0 GD.AlphaFunc \ on road, don't tag transparent pixels 477 | 478 | \ Completed homes 479 | 5 0 do 480 | done i + c@ if 481 | i homes 40 63 sprite 482 | then 483 | loop 484 | 485 | \ Yellow cars 486 | t negate 216 3 sprite 487 | t negate 128 + 216 3 sprite 488 | 489 | \ Dozers 490 | t 200 4 sprite 491 | t 50 + 200 4 sprite 492 | t 150 + 200 4 sprite 493 | 494 | \ Purple cars 495 | t negate 184 7 sprite 496 | t negate 75 + 184 7 sprite 497 | t negate 150 + 184 7 sprite 498 | 499 | \ Green and white racecars 500 | t 2* 168 8 sprite 501 | 502 | \ Trucks 503 | t negate 2/ 504 | dup 152 5 sprite 505 | dup 16 + 152 6 sprite 506 | dup 100 + 152 5 sprite 507 | 116 + 152 6 sprite 508 | 509 | GD.ALWAYS 0 GD.AlphaFunc \ on river, tag transparent pixels 510 | 511 | \ Turtles 512 | 256 0 do 513 | 120 t riverat i + 120 turtle3 514 | 64 +loop 515 | 516 | \ Short logs 517 | 240 0 do 518 | 1 104 t riverat i + 104 log 519 | 80 +loop 520 | 521 | \ Long logs 522 | 256 0 do 523 | 5 88 t riverat i + 88 log 524 | 128 +loop 525 | 526 | \ Turtles again, but slower 527 | 250 0 do 528 | 72 t riverat i + 72 turtle2 529 | 50 +loop 530 | 531 | \ Top logs 532 | 210 0 do 533 | 2 56 t riverat i + 56 log 534 | 70 +loop 535 | 536 | 0 GD.TagMask 537 | frogface @ 8 8 rotate_around 538 | drawfrog 539 | 540 | t to prevt 541 | t 1+ to t 542 | 543 | time @ 1- 0 max dup time ! \ lose time, die if zero 544 | 0= if 545 | die 546 | then 547 | 548 | \ Draw 'time remaining' by clearing a black rectangle 549 | GD.SaveContext 550 | 72 248 GD.ScissorXY 551 | 120 time @ 7 rshift - 8 GD.ScissorSize 552 | GD.Clear 553 | GD.RestoreContext 554 | 555 | 1 GD.TagMask 556 | 557 | GD.RestoreContext 558 | GD.SaveContext 559 | GD.BITMAPS GD.Begin 560 | 561 | pads 562 | 563 | GD.RestoreContext 564 | 565 | 255 85 0 GD.ColorRGB 566 | 3 1 score @ draw_score 567 | 11 1 hiscore @ draw_score 568 | 569 | 255 255 255 GD.ColorRGB 570 | lives @ 0 ?do 571 | i 8 * 240 LIFE_HANDLE 0 GD.Vertex2ii 572 | loop 573 | depth throw 574 | 575 | GD.swap 576 | 577 | GD.touching GD.inputs.tag and >r 578 | r@ 0<> 579 | dying @ 0= and 580 | leaping @ 0= and if 581 | r@ frogdir ! 582 | 1 leaping ! 583 | 10 score +! 584 | else 585 | leaping @ 0<> if 586 | leaping @ 9 < if 587 | frogdir @ case 588 | CONTROL_LEFT of 3 -2 frogx endof 589 | CONTROL_RIGHT of 1 2 frogx endof 590 | CONTROL_UP of 0 -2 frogy endof 591 | CONTROL_DOWN of 2 2 frogy endof 592 | endcase 593 | +! frogface ! 594 | 1 leaping +! 595 | else 596 | 0 leaping ! 597 | then 598 | then 599 | then 600 | r> drop 601 | 602 | dying @ if 603 | 1 dying +! 604 | dying @ 64 = if 605 | -1 lives +! 606 | lives @ 0= time @ 0= or if 607 | game_over 608 | game_start 609 | level_start 610 | then 611 | frog_start 612 | then 613 | else 614 | frogx @ 8 224 within 0= if 615 | die 616 | else 617 | \ GD.inputs.ptag cr . 618 | frogy @ 128 > if \ road section 619 | touching if 620 | die 621 | then 622 | else 623 | frogy @ 40 > if \ river section 624 | leaping @ 0= if 625 | touching if 626 | \ move frog according to lane speed 627 | frogy @ t riverat 628 | frogy @ prevt riverat 629 | - frogx +! 630 | else 631 | die 632 | then 633 | then 634 | else \ riverbank 635 | false 636 | 5 0 do 637 | done i + c@ 0= 638 | i homes frogx @ - abs 4 < and if 639 | 1 done i + c! 640 | 10 score +! 641 | 1+ 642 | then 643 | loop 644 | if 645 | true 5 0 do 646 | done i + c@ and 647 | loop 648 | if 649 | level_start 650 | else 651 | frog_start 652 | then 653 | else 654 | die 655 | then 656 | then 657 | then 658 | then 659 | then 660 | 661 | sound 662 | score @ hiscore @ max hiscore ! 663 | ; 664 | 665 | : frogger 666 | GD.calibrate 667 | 668 | game_setup 669 | begin 670 | gameloop 671 | again 672 | ; 673 | -------------------------------------------------------------------------------- /gd2.fs: -------------------------------------------------------------------------------- 1 | \ GD library: FT800 Forth interface 2 | \ 3 | \ Assumes a 32-bit ANS Forth plus the following: 4 | \ 5 | \ LOCALWORDS PUBLICWORDS DONEWORDS 6 | \ words in LOCAL section are only 7 | \ visible between PUBLICWORDS and 8 | \ DONEWORDS. 9 | \ If your Forth lacks vocabularies, 10 | \ ignore them. 11 | \ 12 | \ gd2-spi-init ( -- ) initialize SPI and GD select signal 13 | \ gd2-sel assert the GD2 SPI select signal 14 | \ gd2-unsel deassert the GD2 SPI select signal 15 | \ spi> ( x -- ) send a byte to SPI 16 | \ >spi ( -- x ) receive a byte from SPI 17 | \ uw@ ( a -- x ) unsigned 16-bit fetch 18 | \ w@ ( a -- n ) signed 16-bit fetch 19 | \ 20 | \ 21 | \ This is an ANS Forth program: 22 | \ Requiring the Core Extensions word set 23 | \ Requiring the Facility Extensions word set 24 | \ 25 | \ Environmental dependency on 32 bit arithmetic. 26 | 27 | \ Board configuration 28 | \ ------------------- 29 | \ 30 | \ Depending on how the FT800 is hooked up, there may be 31 | \ some custom initialization required. This initialization 32 | \ includes: 33 | \ * crystal/no-crystal operation 34 | \ * screen rotation 35 | \ * RGB pin swizzle 36 | \ * LCD custom resolution/timing selection 37 | \ 38 | \ These options are selected by a custom initialization 39 | \ word, which is called by GD.init 40 | \ 41 | \ This word calls GD.crystal or GD.nocrystal, then 42 | \ writes any registers needed for by the configuration, 43 | \ finally it should set up the LCD panel, using one of 44 | \ the predefined panel setup words. 45 | \ 46 | \ The default word is for Gameduino 2, and looks like: 47 | \ 48 | \ : gameduino2 49 | \ GD.nocrystal 50 | \ 3 GD.REG_SWIZZLE GD.c! 51 | \ 1 GD.REG_ROTATE GD.c! 52 | \ GD.480x272 53 | \ ; 54 | \ 55 | \ For other FT800/801 boards (e.g. FTDI's modules) then the hardware 56 | \ defaults are fine, so a simpler word can be used: 57 | \ 58 | \ : ftdi-eval 59 | \ GD.crystal 60 | \ GD.480x272 61 | \ ; 62 | \ 63 | \ To set the custom word, give its xt to GD.setcustom *before* 64 | \ calling GD.init 65 | \ 66 | \ ' ftdi-eval GD.setcustom 67 | \ 68 | 69 | variable model \ set to 0 for FT800, 4 for FT81x 70 | 71 | \ FT800 is an SPI peripheral controlled by reads and writes 72 | \ into its internal 24-bit address space. 73 | 74 | \ Hardware registers 75 | \ The main difference between the FT800 and FT810 architecture 76 | \ is the register addresses. Word gdconst hides this. 77 | 78 | : gdconst ( ft810-addr ft800-addr -- ) 79 | create , , 80 | does> model @ + @ 81 | ; 82 | 83 | hex 84 | 85 | 302008 102408 gdconst GD.REG_CLOCK 86 | 302100 1024ec gdconst GD.REG_CMD_DL 87 | 3020f8 1024e4 gdconst GD.REG_CMD_READ 88 | 3020fc 1024e8 gdconst GD.REG_CMD_WRITE 89 | 302020 10241c gdconst GD.REG_CPURESET 90 | 302068 102464 gdconst GD.REG_CSPREAD 91 | 302060 10245c gdconst GD.REG_DITHER 92 | 302054 102450 gdconst GD.REG_DLSWAP 93 | 302004 102404 gdconst GD.REG_FRAMES 94 | 30200c 10240c gdconst GD.REG_FREQUENCY 95 | 302094 102490 gdconst GD.REG_GPIO 96 | 302090 10248c gdconst GD.REG_GPIO_DIR 97 | 30202c 102428 gdconst GD.REG_HCYCLE 98 | 302030 10242c gdconst GD.REG_HOFFSET 99 | 302034 102430 gdconst GD.REG_HSIZE 100 | 302038 102434 gdconst GD.REG_HSYNC0 101 | 30203c 102438 gdconst GD.REG_HSYNC1 102 | 302000 102400 gdconst GD.REG_ID 103 | 3020ac 10249c gdconst GD.REG_INT_EN 104 | 3020a8 102498 gdconst GD.REG_INT_FLAGS 105 | 3020b0 1024a0 gdconst GD.REG_INT_MASK 106 | 3020d8 1024c8 gdconst GD.REG_MACRO_0 107 | 3020dc 1024cc gdconst GD.REG_MACRO_1 108 | 30205c 102458 gdconst GD.REG_OUTBITS 109 | 302070 10246c gdconst GD.REG_PCLK 110 | 30206c 102468 gdconst GD.REG_PCLK_POL 111 | 30208c 102488 gdconst GD.REG_PLAY 112 | 3020c4 1024b4 gdconst GD.REG_PLAYBACK_FORMAT 113 | 3020c0 1024b0 gdconst GD.REG_PLAYBACK_FREQ 114 | 3020b8 1024a8 gdconst GD.REG_PLAYBACK_LENGTH 115 | 3020c8 1024b8 gdconst GD.REG_PLAYBACK_LOOP 116 | 3020cc 1024bc gdconst GD.REG_PLAYBACK_PLAY 117 | 3020bc 1024ac gdconst GD.REG_PLAYBACK_READPTR 118 | 3020b4 1024a4 gdconst GD.REG_PLAYBACK_START 119 | 3020d4 1024c4 gdconst GD.REG_PWM_DUTY 120 | 3020d0 1024c0 gdconst GD.REG_PWM_HZ 121 | 302058 102454 gdconst GD.REG_ROTATE 122 | 302088 102484 gdconst GD.REG_SOUND 123 | 302064 102460 gdconst GD.REG_SWIZZLE 124 | 30207c 102478 gdconst GD.REG_TAG 125 | 302074 102470 gdconst GD.REG_TAG_X 126 | 302078 102474 gdconst GD.REG_TAG_Y 127 | 30218c 102574 gdconst GD.REG_TOUCH_DIRECT_XY 128 | 302190 102578 gdconst GD.REG_TOUCH_DIRECT_Z1Z2 129 | 30211c 102508 gdconst GD.REG_TOUCH_RAW_XY 130 | 302120 10250c gdconst GD.REG_TOUCH_RZ 131 | 302118 102504 gdconst GD.REG_TOUCH_RZTHRESH 132 | 302124 102510 gdconst GD.REG_TOUCH_SCREEN_XY 133 | 30212c 102518 gdconst GD.REG_TOUCH_TAG 134 | 302128 102514 gdconst GD.REG_TOUCH_TAG_XY 135 | 302150 10251c gdconst GD.REG_TOUCH_TRANSFORM_A 136 | 309000 109000 gdconst GD.REG_TRACKER 137 | 302180 10256c gdconst GD.REG_TRIM 138 | 302040 10243c gdconst GD.REG_VCYCLE 139 | 302044 102440 gdconst GD.REG_VOFFSET 140 | 302080 10247c gdconst GD.REG_VOL_PB 141 | 302084 102480 gdconst GD.REG_VOL_SOUND 142 | 302048 102444 gdconst GD.REG_VSIZE 143 | 30204c 102448 gdconst GD.REG_VSYNC0 144 | 302050 10244c gdconst GD.REG_VSYNC1 145 | 146 | 308000 108000 gdconst GD.RAM_CMD 147 | 300000 100000 gdconst GD.RAM_DL 148 | 149 | 102000 constant GD.RAM_PAL \ Only applies to FT800 150 | 151 | \ These registers are not used often 152 | \ 302104 1024f0 gdconst GD.REG_TOUCH_MODE 153 | \ 302114 102500 gdconst GD.REG_TOUCH_OVERSAMPLE 154 | \ 302108 1024f4 gdconst GD.REG_TOUCH_ADC_MODE 155 | \ 30210c 1024f8 gdconst GD.REG_TOUCH_CHARGE 156 | \ 302110 1024fc gdconst GD.REG_TOUCH_SETTLE 157 | \ 00000001 constant GD.CTOUCH_MODE_COMPATIBILITY 158 | \ 00000000 constant GD.CTOUCH_MODE_EXTENDED 159 | 160 | 001024f4 constant GD.REG_CTOUCH_EXTENDED 161 | 00102510 constant GD.REG_CTOUCH_TOUCH0_XY 162 | 00102508 constant GD.REG_CTOUCH_TOUCH1_XY 163 | 00102574 constant GD.REG_CTOUCH_TOUCH2_XY 164 | 00102578 constant GD.REG_CTOUCH_TOUCH3_XY 165 | 00102538 constant GD.REG_CTOUCH_TOUCH4_X 166 | 0010250c constant GD.REG_CTOUCH_TOUCH4_Y 167 | 168 | \ Graphics definitions 169 | 170 | 00000001 constant GD.BITMAPS 171 | 00000002 constant GD.POINTS 172 | 00000003 constant GD.LINES 173 | 00000004 constant GD.LINE_STRIP 174 | 00000005 constant GD.EDGE_STRIP_R 175 | 00000006 constant GD.EDGE_STRIP_L 176 | 00000007 constant GD.EDGE_STRIP_A 177 | 00000008 constant GD.EDGE_STRIP_B 178 | 00000009 constant GD.RECTS 179 | 180 | 00000000 constant GD.NEVER 181 | 00000001 constant GD.LESS 182 | 00000002 constant GD.LEQUAL 183 | 00000003 constant GD.GREATER 184 | 00000004 constant GD.GEQUAL 185 | 00000005 constant GD.EQUAL 186 | 00000006 constant GD.NOTEQUAL 187 | 00000007 constant GD.ALWAYS 188 | 189 | 00000000 constant GD.NEAREST 190 | 00000001 constant GD.BILINEAR 191 | 192 | 00000000 constant GD.BORDER 193 | 00000001 constant GD.REPEAT 194 | 195 | 00000000 constant GD.ARGB1555 196 | 00000001 constant GD.L1 197 | 00000002 constant GD.L4 198 | 00000003 constant GD.L8 199 | 00000004 constant GD.RGB332 200 | 00000005 constant GD.ARGB2 201 | 00000006 constant GD.ARGB4 202 | 00000007 constant GD.RGB565 203 | 00000008 constant GD.PALETTED 204 | 00000009 constant GD.TEXT8X8 205 | 0000000a constant GD.TEXTVGA 206 | 0000000b constant GD.BARGRAPH 207 | 00000011 constant GD.L2 208 | 209 | 00000002 constant GD.SRC_ALPHA 210 | 00000003 constant GD.DST_ALPHA 211 | 00000004 constant GD.ONE_MINUS_SRC_ALPHA 212 | 00000005 constant GD.ONE_MINUS_DST_ALPHA 213 | 214 | \ 00000000 constant GD.ADC_SINGLE_ENDED 215 | \ 00000001 constant GD.ADC_DIFFERENTIAL 216 | 217 | \ 00000000 constant GD.DLSWAP_DONE 218 | \ 00000001 constant GD.DLSWAP_LINE 219 | \ 00000002 constant GD.DLSWAP_FRAME 220 | 221 | \ 00000020 constant GD.INT_CMDEMPTY 222 | \ 00000040 constant GD.INT_CMDFLAG 223 | \ 00000080 constant GD.INT_CONVCOMPLETE 224 | \ 00000010 constant GD.INT_PLAYBACK 225 | \ 00000008 constant GD.INT_SOUND 226 | \ 00000001 constant GD.INT_SWAP 227 | \ 00000004 constant GD.INT_TAG 228 | \ 00000002 constant GD.INT_TOUCH 229 | 230 | 00000001 constant GD.KEEP 231 | 00000002 constant GD.REPLACE 232 | 00000003 constant GD.INCR 233 | 00000004 constant GD.DECR 234 | 00000005 constant GD.INVERT 235 | 236 | \ System register values 237 | 00000000 constant GD.LINEAR_SAMPLES 238 | 00000001 constant GD.ULAW_SAMPLES 239 | 00000002 constant GD.ADPCM_SAMPLES 240 | 241 | \ Options for commands 242 | 0600 constant GD.OPT_CENTER 243 | 0200 constant GD.OPT_CENTERX 244 | 0400 constant GD.OPT_CENTERY 245 | 0100 constant GD.OPT_FLAT 246 | 0001 constant GD.OPT_MONO 247 | 1000 constant GD.OPT_NOBACK 248 | 0002 constant GD.OPT_NODL 249 | c000 constant GD.OPT_NOHANDS 250 | 4000 constant GD.OPT_NOHM 251 | 4000 constant GD.OPT_NOPOINTER 252 | 8000 constant GD.OPT_NOSECS 253 | 2000 constant GD.OPT_NOTICKS 254 | 0800 constant GD.OPT_RIGHTX 255 | 0100 constant GD.OPT_SIGNED 256 | 257 | \ 'instrument' argument to GD.play 258 | 259 | 00 constant GD.SILENCE 260 | 01 constant GD.SQUAREWAVE 261 | 02 constant GD.SINEWAVE 262 | 03 constant GD.SAWTOOTH 263 | 04 constant GD.TRIANGLE 264 | 05 constant GD.BEEPING 265 | 06 constant GD.ALARM 266 | 07 constant GD.WARBLE 267 | 08 constant GD.CAROUSEL 268 | 40 constant GD.HARP 269 | 41 constant GD.XYLOPHONE 270 | 42 constant GD.TUBA 271 | 43 constant GD.GLOCKENSPIEL 272 | 44 constant GD.ORGAN 273 | 45 constant GD.TRUMPET 274 | 46 constant GD.PIANO 275 | 47 constant GD.CHIMES 276 | 48 constant GD.MUSICBOX 277 | 49 constant GD.BELL 278 | 50 constant GD.CLICK 279 | 51 constant GD.SWITCH 280 | 52 constant GD.COWBELL 281 | 53 constant GD.NOTCH 282 | 54 constant GD.HIHAT 283 | 55 constant GD.KICKDRUM 284 | 56 constant GD.POP 285 | 57 constant GD.CLACK 286 | 58 constant GD.CHACK 287 | 60 constant GD.MUTE 288 | 61 constant GD.UNMUTE 289 | : GD.PIPS 0f + ; 290 | 291 | 000ffffc constant GD.ROM_FONTROOT 292 | 293 | 00000000 constant GD.TOUCHMODE_OFF 294 | 00000001 constant GD.TOUCHMODE_ONESHOT 295 | 00000002 constant GD.TOUCHMODE_FRAME 296 | 00000003 constant GD.TOUCHMODE_CONTINUOUS 297 | 298 | decimal 299 | 300 | \ ####### INTERFACE ####################################### 301 | 302 | LOCALWORDS 303 | 304 | : GD.a ( a -- ) \ start SPI read transaction, 24-bit address a 305 | gd2-sel 306 | dup 16 rshift >spi 307 | dup 8 rshift >spi 308 | dup >spi 309 | >spi \ dummy 310 | ; 311 | 312 | : GD.wa ( a -- ) \ SPI write transaction, 24-bit address a 313 | gd2-sel 314 | dup 16 rshift 128 or >spi 315 | dup 8 rshift >spi 316 | >spi 317 | ; 318 | 319 | \ Low-level FT800 memory access words 320 | : GD.c@ ( addr -- x ) 321 | GD.a 322 | spi> 323 | gd2-unsel 324 | ; 325 | 326 | : GD.@ ( addr -- x ) 327 | GD.a 328 | spi> 329 | spi> 8 lshift or 330 | spi> 16 lshift or 331 | spi> 24 lshift or 332 | gd2-unsel 333 | ; 334 | 335 | : GD.move ( caddr u a -- ) \ copy u bytes to caddr from GD memory a 336 | GD.a 337 | over + swap do 338 | spi> i c! 339 | loop 340 | gd2-unsel 341 | ; 342 | 343 | : GD.c! ( addr -- x ) 344 | GD.wa 345 | >spi 346 | gd2-unsel 347 | ; 348 | 349 | : GD.! ( addr -- x ) 350 | GD.wa 351 | 4 0 do 352 | dup >spi 353 | 8 rshift 354 | loop 355 | drop 356 | gd2-unsel 357 | ; 358 | 359 | : hostcmd2 ( u0 u1 -- ) 360 | gd2-sel 361 | swap >spi 362 | >spi 363 | 00 >spi 364 | gd2-unsel 365 | 60 ms 366 | ; 367 | 368 | : hostcmd 369 | 0 hostcmd2 370 | ; 371 | 372 | : measureF ( -- u ) \ measure FT800's actual clock frequency 373 | 1 ms 374 | GD.REG_CLOCK GD.@ 375 | 10 ms 376 | GD.REG_CLOCK GD.@ 377 | swap - 100 * 378 | ; 379 | 380 | 47040000 constant LOW_FREQ_BOUND 381 | 382 | : tune ( -- ) \ adjust the clock trim to get close to 48 MHz 383 | 0 \ keep last-measured frequency on the stack 384 | 32 0 do 385 | i GD.REG_TRIM GD.c! 386 | drop measureF dup LOW_FREQ_BOUND > if 387 | leave 388 | then 389 | loop 390 | GD.REG_FREQUENCY GD.! 391 | ; 392 | 393 | 394 | variable wp \ write pointer 0-4095 395 | variable room \ how much space is in the command FIFO 396 | create inputs 18 allot \ sampled touch inputs 397 | 398 | : mod4K 399 | 4095 and 400 | ; 401 | 402 | : getspace ( -- u ) \ u is the space in the command FIFO 403 | 4092 404 | wp @ GD.REG_CMD_READ GD.@ 405 | dup 3 and 0<> 257 and throw 406 | - 407 | mod4K - 408 | ; 409 | 410 | : gostream 411 | GD.RAM_CMD wp @ mod4K + 412 | GD.wa 413 | ; 414 | 415 | : unstream 416 | gd2-unsel 417 | wp @ GD.REG_CMD_WRITE GD.! 418 | ; 419 | 420 | : >gd ( x -- ) \ write x to the command stream 421 | room @ 422 | begin 423 | dup 0= 424 | while 425 | drop 426 | unstream 427 | getspace 428 | gostream 429 | repeat 430 | 4 - room ! 431 | dup >spi 432 | dup 8 rshift >spi 433 | dup 16 rshift >spi 434 | 24 rshift >spi 435 | 4 wp +! 436 | ; 437 | 438 | : stream 439 | getspace room ! 440 | gostream 441 | ; 442 | 443 | \ Serialization helper words, mostly named 444 | \ after the type that they serialize: 445 | \ h 16-bit 446 | \ i 32-bit 447 | 448 | : cmd ( x -- ) 449 | -256 or >gd 450 | ; 451 | 452 | : hh ( h0 h1 -- ) 453 | 16 lshift swap $ffff and or >gd 454 | ; 455 | 456 | : hhhh ( h0 h1 h2 h3 -- ) 457 | 2swap hh hh 458 | ; 459 | 460 | : hhhhhh ( h0 h1 h2 h3 h4 h5 -- ) 461 | 2>r hhhh 462 | 2r> hh 463 | ; 464 | 465 | : hhhhhhhh ( h0 h1 h2 h3 h4 h5 h6 h7 -- ) 466 | 2>r 2>r hhhh 467 | 2r> 2r> hhhh 468 | ; 469 | 470 | : ii ( x0 x1 -- ) 471 | swap >gd >gd 472 | ; 473 | 474 | : iii ( x0 x1 x2 -- ) 475 | >r ii r> >gd 476 | ; 477 | 478 | \ s>gd appends a string to the command buffer, appends a 479 | \ zero byte, and pads to the next 32-bit boundary. It 480 | \ iterates through the string, ORing the characters into the 481 | \ 32-bit accumulator on top-of-stack. Every fourth character, 482 | \ it sends the word to the hardware, and clears the 483 | \ accumulator. After the loop, it flushes the partially-filled 484 | \ accumulator to the hardware. 485 | 486 | : s>gd ( caddr u -- ) \ send string to the command buffer 487 | 0 swap 0 ( caddr 0 u 0 ) 488 | ?do 489 | ( caddr u32 ) 490 | over i + c@ ( caddr u32 byte ) 491 | i 3 and dup >r 492 | 3 lshift lshift or 493 | r> 3 = if 494 | >gd 495 | 0 496 | then 497 | loop 498 | >gd ( caddr ) 499 | drop 500 | ; 501 | 502 | variable custom 503 | 504 | PUBLICWORDS 505 | 506 | \ ####### DRAWING COMMANDS ################################ 507 | 508 | : GD.VERTEX2F 509 | 1 30 lshift 510 | \ y 511 | swap 32767 and 512 | or 513 | \ x 514 | swap 32767 and 515 | 15 lshift 516 | or 517 | >gd 518 | ; 519 | : GD.VERTEX2II 520 | 2 30 lshift 521 | \ cell 522 | swap 127 and 523 | or 524 | \ handle 525 | swap 31 and 526 | 7 lshift 527 | or 528 | \ y 529 | swap 511 and 530 | 12 lshift 531 | or 532 | \ x 533 | swap 511 and 534 | 21 lshift 535 | or 536 | >gd 537 | ; 538 | : GD.BITMAPSOURCE 539 | 1 24 lshift 540 | \ addr 541 | swap 1048575 and 542 | or 543 | >gd 544 | ; 545 | : GD.CLEARCOLORRGB 546 | 2 24 lshift 547 | \ blue 548 | swap 255 and 549 | or 550 | \ green 551 | swap 255 and 552 | 8 lshift 553 | or 554 | \ red 555 | swap 255 and 556 | 16 lshift 557 | or 558 | >gd 559 | ; 560 | : GD.TAG 561 | 3 24 lshift 562 | \ s 563 | swap 255 and 564 | or 565 | >gd 566 | ; 567 | : GD.COLORRGB 568 | 4 24 lshift 569 | \ blue 570 | swap 255 and 571 | or 572 | \ green 573 | swap 255 and 574 | 8 lshift 575 | or 576 | \ red 577 | swap 255 and 578 | 16 lshift 579 | or 580 | >gd 581 | ; 582 | : GD.BITMAPHANDLE 583 | 5 24 lshift 584 | \ handle 585 | swap 31 and 586 | or 587 | >gd 588 | ; 589 | : GD.CELL 590 | 6 24 lshift 591 | \ cell 592 | swap 127 and 593 | or 594 | >gd 595 | ; 596 | : GD.BITMAPLAYOUT 597 | 7 24 lshift 598 | \ height 599 | swap 511 and 600 | or 601 | \ linestride 602 | swap 1023 and 603 | 9 lshift 604 | or 605 | \ format 606 | swap 31 and 607 | 19 lshift 608 | or 609 | >gd 610 | ; 611 | : GD.BITMAPSIZE 612 | 8 24 lshift 613 | \ height 614 | swap 511 and 615 | or 616 | \ width 617 | swap 511 and 618 | 9 lshift 619 | or 620 | \ wrapy 621 | swap 1 and 622 | 18 lshift 623 | or 624 | \ wrapx 625 | swap 1 and 626 | 19 lshift 627 | or 628 | \ filter 629 | swap 1 and 630 | 20 lshift 631 | or 632 | >gd 633 | ; 634 | : GD.ALPHAFUNC 635 | 9 24 lshift 636 | \ ref 637 | swap 255 and 638 | or 639 | \ func 640 | swap 7 and 641 | 8 lshift 642 | or 643 | >gd 644 | ; 645 | : GD.STENCILFUNC 646 | 10 24 lshift 647 | \ mask 648 | swap 255 and 649 | or 650 | \ ref 651 | swap 255 and 652 | 8 lshift 653 | or 654 | \ func 655 | swap 7 and 656 | 16 lshift 657 | or 658 | >gd 659 | ; 660 | : GD.BLENDFUNC 661 | 11 24 lshift 662 | \ dst 663 | swap 7 and 664 | or 665 | \ src 666 | swap 7 and 667 | 3 lshift 668 | or 669 | >gd 670 | ; 671 | : GD.STENCILOP 672 | 12 24 lshift 673 | \ spass 674 | swap 7 and 675 | or 676 | \ sfail 677 | swap 7 and 678 | 3 lshift 679 | or 680 | >gd 681 | ; 682 | : GD.POINTSIZE 683 | 13 24 lshift 684 | \ size 685 | swap 8191 and 686 | or 687 | >gd 688 | ; 689 | : GD.LINEWIDTH 690 | 14 24 lshift 691 | \ width 692 | swap 4095 and 693 | or 694 | >gd 695 | ; 696 | : GD.CLEARCOLORA 697 | 15 24 lshift 698 | \ alpha 699 | swap 255 and 700 | or 701 | >gd 702 | ; 703 | : GD.COLORA 704 | 16 24 lshift 705 | \ alpha 706 | swap 255 and 707 | or 708 | >gd 709 | ; 710 | : GD.CLEARSTENCIL 711 | 17 24 lshift 712 | \ s 713 | swap 255 and 714 | or 715 | >gd 716 | ; 717 | : GD.CLEARTAG 718 | 18 24 lshift 719 | \ s 720 | swap 255 and 721 | or 722 | >gd 723 | ; 724 | : GD.STENCILMASK 725 | 19 24 lshift 726 | \ mask 727 | swap 255 and 728 | or 729 | >gd 730 | ; 731 | : GD.TAGMASK 732 | 20 24 lshift 733 | \ mask 734 | swap 1 and 735 | or 736 | >gd 737 | ; 738 | : GD.BITMAPTRANSFORMA 739 | 21 24 lshift 740 | \ a 741 | swap 131071 and 742 | or 743 | >gd 744 | ; 745 | : GD.BITMAPTRANSFORMB 746 | 22 24 lshift 747 | \ b 748 | swap 131071 and 749 | or 750 | >gd 751 | ; 752 | : GD.BITMAPTRANSFORMC 753 | 23 24 lshift 754 | \ c 755 | swap 16777215 and 756 | or 757 | >gd 758 | ; 759 | : GD.BITMAPTRANSFORMD 760 | 24 24 lshift 761 | \ d 762 | swap 131071 and 763 | or 764 | >gd 765 | ; 766 | : GD.BITMAPTRANSFORME 767 | 25 24 lshift 768 | \ e 769 | swap 131071 and 770 | or 771 | >gd 772 | ; 773 | : GD.BITMAPTRANSFORMF 774 | 26 24 lshift 775 | \ f 776 | swap 16777215 and 777 | or 778 | >gd 779 | ; 780 | : GD.SCISSORXY 781 | 27 24 lshift 782 | model @ 0= if 783 | \ y 784 | swap 511 and 785 | or 786 | \ x 787 | swap 511 and 788 | 9 lshift 789 | or 790 | else 791 | \ y 792 | swap 2047 and 793 | or 794 | \ x 795 | swap 2047 and 796 | 11 lshift 797 | or 798 | then 799 | >gd 800 | ; 801 | : GD.SCISSORSIZE 802 | 28 24 lshift 803 | model @ 0= if 804 | \ height 805 | swap 1023 and 806 | or 807 | \ width 808 | swap 1023 and 809 | 10 lshift 810 | or 811 | else 812 | \ height 813 | swap 4095 and 814 | or 815 | \ width 816 | swap 4095 and 817 | 12 lshift 818 | or 819 | then 820 | >gd 821 | ; 822 | : GD.CALL 823 | 29 24 lshift 824 | \ dest 825 | swap 65535 and 826 | or 827 | >gd 828 | ; 829 | : GD.JUMP 830 | 30 24 lshift 831 | \ dest 832 | swap 65535 and 833 | or 834 | >gd 835 | ; 836 | : GD.BEGIN 837 | 31 24 lshift 838 | \ prim 839 | swap 15 and 840 | or 841 | >gd 842 | ; 843 | : GD.COLORMASK 844 | 32 24 lshift 845 | \ a 846 | swap 1 and 847 | or 848 | \ b 849 | swap 1 and 850 | 1 lshift 851 | or 852 | \ g 853 | swap 1 and 854 | 2 lshift 855 | or 856 | \ r 857 | swap 1 and 858 | 3 lshift 859 | or 860 | >gd 861 | ; 862 | : GD.CLEARtsc 863 | 38 24 lshift 864 | \ t 865 | swap 1 and 866 | or 867 | \ s 868 | swap 1 and 869 | 1 lshift 870 | or 871 | \ c 872 | swap 1 and 873 | 2 lshift 874 | or 875 | >gd 876 | ; 877 | : GD.CLEAR 878 | 38 24 lshift 879 | 7 or 880 | >gd 881 | ; 882 | : GD.END 883 | 33 24 lshift 884 | >gd 885 | ; 886 | : GD.SAVECONTEXT 887 | 34 24 lshift 888 | >gd 889 | ; 890 | : GD.RESTORECONTEXT 891 | 35 24 lshift 892 | >gd 893 | ; 894 | : GD.RETURN 895 | 36 24 lshift 896 | >gd 897 | ; 898 | : GD.MACRO 899 | 37 24 lshift 900 | \ m 901 | swap 1 and 902 | or 903 | >gd 904 | ; 905 | : GD.DISPLAY 906 | 0 907 | >gd 908 | ; 909 | 910 | : GD.COLORRGB# ( x -- ) 911 | 16777215 and 912 | 4 24 lshift 913 | or 914 | >gd 915 | ; 916 | 917 | : GD.CLEARCOLORRGB# ( x -- ) 918 | 16777215 and 919 | 2 24 lshift 920 | or 921 | >gd 922 | ; 923 | 924 | : GD.VERTEX_FORMAT 925 | 39 24 lshift 926 | \ frac 927 | swap 7 and 928 | or >gd 929 | ; 930 | 931 | : GD.BITMAP_LAYOUT_H 932 | 40 24 lshift 933 | \ height 934 | swap 3 and 935 | or 936 | \ linestride 937 | swap 3 and 938 | 2 lshift 939 | or >gd 940 | ; 941 | 942 | : GD.BITMAP_SIZE_H 943 | 41 24 lshift 944 | \ height 945 | swap 3 and 946 | or 947 | \ width 948 | swap 3 and 949 | 2 lshift 950 | or >gd 951 | ; 952 | 953 | : GD.PALETTE_SOURCE 954 | 42 24 lshift 955 | \ addr 956 | swap 4194303 and 957 | or >gd 958 | ; 959 | 960 | : GD.VERTEX_TRANSLATE_X 961 | 43 24 lshift 962 | \ x 963 | swap 131071 and 964 | or >gd 965 | ; 966 | 967 | 968 | : GD.VERTEX_TRANSLATE_Y 969 | 44 24 lshift 970 | \ y 971 | swap 131071 and 972 | or >gd 973 | ; 974 | 975 | \ ####### COPROCESSOR COMMANDS ############################ 976 | \ 977 | \ These are higher-level FT800 commands, for drawing widgets etc. 978 | 979 | hex 980 | 981 | : GD.cmd_append ( ptr num -- ) 982 | 01e cmd 983 | ii 984 | ; 985 | 986 | : GD.cmd_bgcolor ( c -- ) 987 | 009 cmd 988 | >gd 989 | ; 990 | 991 | : GD.cmd_button ( x y w h font options s -- ) 992 | 00d cmd 993 | 2>r hhhhhh 994 | 2r> s>gd 995 | ; 996 | 997 | : GD.cmd_calibrate ( -- ) 998 | 015 cmd 999 | 0 >gd 1000 | ; 1001 | 1002 | : GD.cmd_clock ( x y r options h m s ms -- ) 1003 | 014 cmd 1004 | hhhhhhhh 1005 | ; 1006 | 1007 | : GD.cmd_coldstart ( -- ) 1008 | 032 cmd 1009 | ; 1010 | 1011 | : GD.cmd_dial ( x y r options val -- ) 1012 | 02d cmd 1013 | >r hhhh r> >gd 1014 | ; 1015 | 1016 | : GD.cmd_dlstart 1017 | 000 cmd 1018 | ; 1019 | 1020 | : GD.cmd_fgcolor ( c -- ) 1021 | 00a cmd 1022 | >gd 1023 | ; 1024 | 1025 | : GD.cmd_gauge ( x y r options major minor val range -- ) 1026 | 013 cmd 1027 | hhhhhhhh 1028 | ; 1029 | 1030 | : GD.cmd_getmatrix ( -- ) 1031 | 033 cmd 1032 | ; 1033 | 1034 | \ : GD.cmd_getprops ( ptr w h -- ) 1035 | \ 025 cmd 1036 | \ ; 1037 | 1038 | \ : GD.cmd_getptr ( -- ) 1039 | \ 023 cmd 1040 | \ ; 1041 | 1042 | : GD.cmd_gradcolor ( c -- ) 1043 | 034 cmd 1044 | >gd 1045 | ; 1046 | 1047 | : GD.cmd_gradient ( x0 y0 rgb0 x1 y1 rgb1 -- ) 1048 | 00b cmd 1049 | >r 2>r 1050 | >r 1051 | hh 1052 | r> >gd 1053 | 2r> hh 1054 | r> >gd 1055 | ; 1056 | 1057 | : GD.cmd_inflate ( ptr -- ) 1058 | 022 cmd 1059 | >gd 1060 | ; 1061 | 1062 | : GD.cmd_interrupt ( ms -- ) 1063 | 002 cmd 1064 | >gd 1065 | ; 1066 | 1067 | : GD.cmd_keys ( x y w h font options s -- ) 1068 | 00e cmd 1069 | 2>r 1070 | hhhhhh 1071 | 2r> s>gd 1072 | ; 1073 | 1074 | : GD.cmd_loadidentity ( -- ) 1075 | 026 cmd 1076 | ; 1077 | 1078 | : GD.cmd_loadimage ( ptr options -- ) 1079 | 024 cmd 1080 | ii 1081 | ; 1082 | 1083 | : GD.cmd_memcpy ( dest src num -- ) 1084 | 01d cmd 1085 | iii 1086 | ; 1087 | 1088 | : GD.cmd_memset ( ptr value num -- ) 1089 | 01b cmd 1090 | iii 1091 | ; 1092 | 1093 | : GD.cmd_memzero ( ptr num -- ) 1094 | 01c cmd 1095 | ii 1096 | ; 1097 | 1098 | : GD.cmd_memwrite ( ptr num -- ) 1099 | 01a cmd 1100 | ii 1101 | ; 1102 | 1103 | : GD.cmd_regwrite ( ptr val -- ) 1104 | 01a cmd 1105 | swap >gd 1106 | 4 >gd 1107 | >gd 1108 | ; 1109 | 1110 | : GD.cmd_number ( x y font options n -- ) 1111 | 02e cmd 1112 | >r hhhh 1113 | r> >gd 1114 | ; 1115 | 1116 | : GD.cmd_progress ( x y w h options val range -- ) 1117 | 00f cmd 1118 | 0 hhhhhhhh 1119 | ; 1120 | 1121 | \ : GD.cmd_regread ( ptr -- ) 1122 | \ $19 cmd 1123 | \ ; 1124 | 1125 | : GD.cmd_rotate ( a -- ) 1126 | 029 cmd 1127 | >gd 1128 | ; 1129 | 1130 | : GD.cmd_scale ( sx sy -- ) 1131 | 028 cmd 1132 | ii 1133 | ; 1134 | 1135 | : GD.cmd_screensaver ( -- ) 1136 | 02f cmd 1137 | ; 1138 | 1139 | : GD.cmd_scrollbar ( x y w h options val size range -- ) 1140 | 011 cmd 1141 | hhhhhhhh 1142 | ; 1143 | 1144 | : GD.cmd_setfont ( font ptr -- ) 1145 | 02b cmd 1146 | ii 1147 | ; 1148 | 1149 | : GD.cmd_setmatrix ( -- ) 1150 | 02a cmd 1151 | ; 1152 | 1153 | : GD.cmd_sketch ( x y w h ptr format -- ) 1154 | 030 cmd 1155 | 2>r 1156 | hhhh 1157 | 2r> ii 1158 | ; 1159 | 1160 | : GD.cmd_slider ( x y w h options val range -- ) 1161 | 010 cmd 1162 | 0 hhhhhhhh 1163 | ; 1164 | 1165 | : GD.cmd_snapshot ( ptr -- ) 1166 | 01f cmd 1167 | >gd 1168 | ; 1169 | 1170 | : GD.cmd_spinner ( x y style scale -- ) 1171 | 016 cmd 1172 | hhhh 1173 | ; 1174 | 1175 | : GD.cmd_stop ( -- ) 1176 | 017 cmd 1177 | ; 1178 | 1179 | : GD.cmd_text ( x y font options s -- ) 1180 | 00c cmd 1181 | 2>r hhhh 1182 | 2r> 1183 | s>gd 1184 | ; 1185 | 1186 | : GD.cmd_toggle ( x y w font options state s -- ) 1187 | 012 cmd 1188 | 2>r 1189 | hhhhhh 1190 | 2r> s>gd 1191 | ; 1192 | 1193 | : GD.cmd_track ( x y w h tag -- ) 1194 | 02c cmd 1195 | 0 hhhhhh 1196 | ; 1197 | 1198 | : GD.cmd_translate ( tx ty -- ) 1199 | 027 cmd 1200 | ii 1201 | ; 1202 | 1203 | : GD.cmd_romfont 1204 | 03f cmd 1205 | ii 1206 | ; 1207 | 1208 | : GD.cmd_setbitmap 1209 | 043 cmd 1210 | >r 2>r >gd 2r> r> 0 hhhh 1211 | ; 1212 | 1213 | decimal 1214 | 1215 | \ ####### TOP-LEVEL COMMANDS ############################## 1216 | 1217 | : GD.flush \ Sends all pending commands to the FT800 1218 | unstream 1219 | stream 1220 | ; 1221 | 1222 | : GD.finish \ Wait for all pending commands to complete 1223 | unstream 1224 | begin 1225 | getspace 4092 = 1226 | until 1227 | stream 1228 | ; 1229 | 1230 | : GD.calibrate \ run the FT800's interactive calibration procedure 1231 | GD.Clear 1232 | unstream 1233 | GD.REG_HSIZE GD.@ 2/ 1234 | GD.REG_VSIZE GD.@ 3 10 */ 1235 | 30 1236 | stream 1237 | GD.OPT_CENTERX s" please tap on the dot" GD.cmd_text 1238 | GD.cmd_calibrate 1239 | GD.finish 1240 | GD.cmd_dlstart 1241 | ; 1242 | 1243 | : GD.swap \ swaps the working and displayed images 1244 | GD.display 1245 | 01 cmd \ cmd_swap 1246 | GD.flush 1247 | GD.cmd_dlstart 1248 | ; 1249 | 1250 | : GD.getinputs \ collects touch input 1251 | GD.finish 1252 | unstream 1253 | inputs 4 GD.REG_TRACKER GD.move 1254 | inputs 4 + 13 GD.REG_TOUCH_RZ GD.move 1255 | inputs 17 + 1 GD.REG_TAG GD.move 1256 | stream 1257 | ; 1258 | 1259 | \ accessors for the values collected by GD.getinputs 1260 | : GD.inputs.track_tag inputs 0 + uw@ ; 1261 | : GD.inputs.track_val inputs 2 + uw@ ; 1262 | : GD.inputs.rz inputs 4 + uw@ ; 1263 | : GD.inputs.y inputs 8 + w@ ; 1264 | : GD.inputs.x inputs 10 + w@ ; 1265 | : GD.inputs.tag_y inputs 12 + w@ ; 1266 | : GD.inputs.tag_x inputs 14 + w@ ; 1267 | : GD.inputs.tag inputs 16 + c@ ; 1268 | : GD.inputs.ptag inputs 17 + c@ ; 1269 | 1270 | hex 1271 | : GD.init \ initialize the device 1272 | gd2-spi-init 1273 | gd2-unsel 1274 | 1275 | custom @ execute 1276 | ; 1277 | 1278 | : common-init 1279 | \ cr 1280 | \ gd2-sel 1281 | \ 10 spix hex2. 1282 | \ 24 spix hex2. 1283 | \ 00 spix hex2. 1284 | \ 0 spix hex2. 1285 | \ 0 spix hex2. 1286 | \ 0 spix hex2. 1287 | \ gd2-unsel 1288 | 1289 | 0c0001 GD.c@ 4 rshift cells model ! 1290 | 1291 | 080 GD.REG_GPIO_DIR GD.c! 1292 | 080 GD.REG_GPIO GD.c! 1293 | 1294 | 0 wp ! 1295 | stream 1296 | 1297 | GD.cmd_dlstart 1298 | GD.Clear 1299 | 1300 | GD.swap 1301 | ; 1302 | 1303 | : GD.nocrystal ( -- ) \ initialize the FT800 for no-crystal 1304 | 000 hostcmd \ ACTIVE 1305 | 062 hostcmd \ CLK48M: for no-crystal parts like GD2 1306 | 068 hostcmd \ CORERST 1307 | tune 1308 | common-init 1309 | ; 1310 | 1311 | : GD.crystal ( -- ) \ initialize the FT800 for external crystal 1312 | 000 hostcmd \ ACTIVE 1313 | 044 hostcmd \ CLKEXT: use external crystal 1314 | 068 hostcmd \ CORERST 1315 | common-init 1316 | ; 1317 | 1318 | create plltab 1319 | \ 0 1X 2X 3X 4X 5X 6X 1320 | 0 c, 001 c, 002 c, 003 c, 044 c, 045 c, 046 c, 1321 | 1322 | : GD.pll ( u -- ) 1323 | 042 hostcmd 1324 | 061 swap plltab + c@ hostcmd2 1325 | ; 1326 | 1327 | : GD.setcustom ( xt -- ) \ Set the custom initialization word 1328 | custom ! 1329 | ; 1330 | 1331 | decimal 1332 | 1333 | : GD.c ( x -- ) \ send x to the command buffer 1334 | >gd 1335 | ; 1336 | 1337 | : GD.s ( caddr u -- ) \ send buffer to the command buffer 1338 | s>gd 1339 | ; 1340 | 1341 | : GD.suspend \ suspend the current SPI stream transaction 1342 | unstream 1343 | ; 1344 | 1345 | : GD.resume \ resume the SPI stream transaction 1346 | stream 1347 | ; 1348 | 1349 | : GD.supply ( caddr u -- ) \ write blk to the command stream 1350 | aligned 1351 | begin 1352 | dup 1353 | while 1354 | room @ 1355 | over min 1356 | ?dup 1357 | if 1358 | >r 1359 | r@ negate room +! 1360 | over r@ blk>spi 1361 | r@ wp +! 1362 | r> /string 1363 | else 1364 | unstream 1365 | stream 1366 | then 1367 | repeat 1368 | 2drop 1369 | ; 1370 | 1371 | : GD.play ( instrument note -- ) \ play a sound 1372 | unstream 1373 | 8 lshift or 1374 | GD.REG_SOUND GD.! 1375 | 1 GD.REG_PLAY GD.! 1376 | stream 1377 | ; 1378 | 1379 | : GD.wh ( -- w h ) \ size of the current screen 1380 | GD.finish unstream 1381 | GD.REG_HSIZE GD.@ GD.REG_VSIZE GD.@ 1382 | GD.REG_ROTATE GD.@ 2 and if \ deal with landscape/portrait 1383 | swap 1384 | then 1385 | stream 1386 | ; 1387 | 1388 | \ FT800 memory access 1389 | : GD.c! unstream GD.c! stream ; 1390 | : GD.c@ unstream GD.c@ stream ; 1391 | : GD.@ unstream GD.@ stream ; 1392 | : GD.! unstream GD.! stream ; 1393 | : GD.move unstream GD.move stream ; 1394 | 1395 | DONEWORDS 1396 | 1397 | : GD.480x272 1398 | 1 GD.REG_PCLK_POL GD.c! 1399 | 5 GD.REG_PCLK GD.c! 1400 | ; 1401 | 1402 | : gameduino2 1403 | GD.nocrystal 1404 | 3 GD.REG_SWIZZLE GD.c! 1405 | 1 GD.REG_ROTATE GD.c! 1406 | GD.480x272 1407 | ; 1408 | 1409 | : ftdi-eval 1410 | GD.crystal 1411 | GD.480x272 1412 | ; 1413 | 1414 | ' gameduino2 GD.setcustom 1415 | --------------------------------------------------------------------------------