( Main for WGE firmware                      JCB 13:24 08/24/10)

\ warnings off
\ require tags.fs

include crossj1.fs
meta
    : TARGET? 1 ;
    : build-debug? 1 ;

include basewords.fs
target
include hwdefs.fs

[IF]
    h# 1f80 org
    \ the RAM Bootloader copies 2000-3f80 to 0-1f80, then branches to zero
    : bootloader
        h# 1f80 h# 0
        begin
            2dupxor
        while
            dup h# 2000 + @
            over !
            d# 2 +
        repeat

        begin dsp h# ff and while drop repeat
        d# 0 >r
    ;
[ELSE]
    h# 3f80 org
    \ the Flash Bootloader copies 0x190000 to 0-3f80, then branches to zero
    : bootloader
        h# c flash_a_hi !
        h# 0 begin
            dup h# 8000 + flash_a !
            d# 0 flash_oe_n !
            flash_d @
            d# 1 flash_oe_n !
            over dup + !
            d# 1 +
            dup h# 1fc0 =
        until

        begin dsp h# ff and while drop repeat
        d# 0 >r
    ;
[THEN]

org
module[ everything"
include nuc.fs

include version.fs

\ 33333333 / 115200 = 289, half cycle is 144

: pause144
    d# 0 d# 45
    begin
        1-
        2dup=
    until
    2drop
;

: serout ( u -- )
    h# 300 or   \ 1 stop bits
    2*          \ 0 start bit
    \ Start bit
    begin
        dup RS232_TXD ! 2/
        pause144
        pause144
        dup 0=
    until
    drop
    pause144 pause144
    pause144 pause144
;

: frac ( ud u -- d1 u1 ) \ d1+u1 is ud
    >r 2dup d# 1 r@ m*/ 2swap 2over r> d# 1 m*/ d- drop ;
: .2  s>d <# # # #> type ;
: build.
    decimal
    builddate drop
    [ -8 3600 * ] literal s>d d+
    d# 1 d# 60 m*/mod >r
    d# 1 d# 60 m*/mod >r
    d# 1 d# 24 m*/mod >r
    2drop
    r> .2 [char] : emit
    r> .2 [char] : emit
    r> .2 ;

: net-my-mac h# 1234 h# 5677 h# 7777 ;

include doc.fs
include time.fs
include eth-ax88796.fs
include packet.fs
include ip0.fs
include defines_tcpip.fs
include defines_tcpip2.fs
include arp.fs
include ip.fs
include udp.fs
include dhcp.fs

code in end-code
: on ( a -- ) d# 1 swap ! ;
code out end-code
: off ( a -- ) d# 0 swap ! ;

: flash-reset
    flash_rst_n   off
    flash_rst_n   on
;

: flash-cold
    flash_ddir    on
    flash_ce_n    off
    flash_oe_n    on
    flash_we_n    on
    flash_byte_n  on
    flash_rdy     on
    flash-reset
;

: flash-w ( u a -- )
    flash_a !
    flash_d !
    flash_ddir off
    flash_we_n off
    flash_we_n on
    flash_ddir on
;

: flash-r ( a -- u )
    flash_a !
    flash_oe_n off
    flash_d @
    flash_oe_n on
;

: flash-unlock ( -- )
    h# aa h# 555 flash-w
    h# 55 h# 2aa flash-w
;

: flash! ( u da. -- )
    flash-unlock
    h# a0 h# 555 flash-w
    flash_a 2+ !    ( u a )
    2dup            ( u a u a)
    flash-w         ( u a )
    begin
        2dup flash-r xor
        h# 80 and 0=
    until
    2drop
    flash-reset
;

: flash@ ( da. -- u )
    flash_a 2+ !    ( u a )
    flash-r
;

: flash-chiperase
    flash-unlock
    h# 80 h# 555 flash-w
    h# aa h# 555 flash-w
    h# 55 h# 2aa flash-w
    h# 10 h# 555 flash-w
;

: flash-sectorerase ( da -- ) \ erase one sector
    flash-unlock
    h# 80 h# 555 flash-w
    h# aa h# 555 flash-w
    h# 55 h# 2aa flash-w
    flash_a 2+ ! h# 30 swap flash-w
;

: flash-erased ( a -- f )
    flash@ h# 80 and 0<> ;

: flash-dump ( da u -- )
    0do
        2dup flash@ hex4 space
        d1+
    loop cr
    2drop
;

: flashc@
    over d# 15 lshift flash_d !
    d2/ flash@
;

: flash-bytes
    s" BYTES: " type
    flash_byte_n  off
    h# 0.
    d# 1024 0do
        i d# 15 and 0= if
            cr
            2dup hex8 space space
        then
        2dup flashc@ hex2 space
        d1+
    loop cr
    2drop
    flash_byte_n  on
;

[IF]
: flash-demo
    flash-unlock
    h# 90 h# 555 flash-w
    h# 00 flash-r hex4 cr
    flash-reset

    false if
        flash-unlock
        h# a0 h# 555 flash-w
        h# 0947 h# 5 flash-w
        sleep1
        flash-reset
    then

    \ h# dead d# 11. flash!

    h# 100 0do
        i flash-r hex4 space
    loop cr
    cr cr
    d# 0. h# 80 flash-dump
    cr cr

    flash-bytes

    exit
    flash-unlock
    h# 80 h# 555 flash-w
    h# aa h# 555 flash-w
    h# 55 h# 2aa flash-w
    h# 10 h# 555 flash-w
    s" waiting for erase" type cr
    begin
        h# 0 flash-r dup hex4 cr
        h# 80 and
    until

    h# 100 0do
        i flash-r hex4 space
    loop cr
;
[THEN]

include sprite.fs

variable cursory \ ptr to start of line in video memory
variable cursorx \ offset to char

64 constant width
50 constant wrapcolumn

: vga-at-xy ( u1 u2 )
    cursory !
    cursorx !
;

: home  d# 0 vga_scroll ! d# 0 d# 0 vga-at-xy ;

: vga-line ( -- a ) \ address of current line
    cursory @ vga_scroll @ + d# 31 and d# 6 lshift 
    h# 8000 or
;

: vga-erase ( a u -- )
    bounds begin
        2dupxor
    while
        h# 00 over ! 1+
    repeat 2drop
;

: vga-page
    home vga-line d# 2048 vga-erase
    hide
;

: down1
    cursory @ d# 31 <> if
        d# 1 cursory +!
    else
        d# 1 vga_scroll +!
        vga-line width vga-erase
    then
;

: vga-emit ( c -- )
    dup d# 13 = if
        drop d# 0 cursorx !
    else
        dup d# 10 = if
            drop down1
        else
            d# -32 +
            vga-line cursorx @ + !
            d# 1 cursorx +!
            cursorx @ wrapcolumn = if
                d# 0 cursorx !
                down1
            then
        then
    then
;

: flash>ram ( d. a -- ) \ copy 2K from flash d to a
    >r d2/ r>
    d# 1024 0do
        >r
        2dup flash@
        r> ( d. u a )
        over swab over !
        1+
        tuck !
        1+
        >r d1+ r>
    loop
    drop 2drop
;

: vga-cold
    h# f800 h# f000 do
        d# 0 i !
    loop

    vga-page

    \ pic: Copy 2048 bytes from 180000 to 8000
    \ chr: Copy 2048 bytes from 180800 to f000
    h# 180000. h# 8000 flash>ram
    h# 180800. h# f000 flash>ram

    \ ['] vga-emit 'emit !
;

create glyph 8 allot
: wide1 ( c -- )
    swab
    d# 8 0do
        dup 0<
        if d# 127 else sp then
        \ if [char] * else [char] . then
        vga-emit
        2*
    loop drop
;

: vga-bigemit ( c -- )
    dup d# 13 = if
        drop d# 0 cursorx !
    else
        dup d# 10 = if
            drop d# 8 0do down1 loop
        else
            sp - d# 8 * s>d
            h# 00180800. d+ d2/
            d# 4 0do
                2dup flash@ swab
                i cells glyph + !
                d1+
            loop 2drop

            d# 7 0do
                i glyph + c@ wide1
                d# -8 cursorx +! down1
            loop
            d# 7 glyph + c@ wide1

            d# -7 cursory +!
        then
    then
;

( Game stuff                                 JCB 15:20 11/15/10)

variable seed
: random  ( -- u )
    seed @ d# 23947 * d# 57711 xor dup seed ! ;   


\ Each line is 20.8 us, so 1000 instructions

include sincos.fs

( Stars                                      JCB 15:23 11/15/10)

2variable vision
variable frame
128 constant nstars
create stars 1024 allot

: star 2* cells stars + ;
: 15.*  m* d2* nip ;

\ >>> math.cos(math.pi / 180) * 32767
\ 32762.009427189474
\ >>> math.sin(math.pi / 180) * 32767
\ 571.8630017304688

[ pi 128e0 f/ fcos 32767e0 f* f>d drop ] constant COSa
[ pi 128e0 f/ fsin 32767e0 f* f>d drop ] constant SINa

: rotate ( i -- ) \ rotate star i
    star dup 2@ ( x y )
    over SINa 15.* over COSa 15.* + >r
    swap COSa 15.* swap SINa 15.* - r>
    rot 2!
;

: rotateall
    d# 256 0do i rotate loop ;

: scatterR
    nstars 0do
        random d# 0 i star 2!
        rotateall
        rotateall
        rotateall
        rotateall
    loop
;

: scatterSpiral
    nstars 0do
        i d# 3 and 1+ d# 8000 *
        d# 0 i star 2!
        rotateall
        rotateall
        rotateall
        rotateall
    loop
;

: scatter
    nstars 0do
        \ d# 0 random
        d# 0 i sin
        i star 2!
        i random d# 255 and 0do
            dup rotate
        loop drop
    loop
;

: /128  dup 0< h# fe00 and swap d# 7 rshift or ;
: tx    /128 [ 400 ] literal + ;
: ty    /128 [ 256 ] literal + ;

: plot ( i s ) \ plot star i in sprite s
    >r
    dup star @ tx swap d# 2 lshift
    r> sprite!
;

( Display list                               JCB 16:10 11/15/10)

create dl 1026 allot

: erasedl
    dl d# 1024 bounds begin
        d# -1 over !
        cell+ 2dup=
    until 2drop
;

: makedl
    erasedl

    nstars 0do
        i d# 2 lshift
        cells dl +
        \ cell occupied, use one below
        \ dup @ 0< invert if cell+ then
        i swap !
    loop
;

variable lastsp
: stars-chasebeam
    hide
    d# 0 lastsp !
    d# 512 0do
        begin vga-line@ i = until
        i cells dl + @ dup 0< if
            drop
        else
            lastsp @ 1+ d# 7 and dup lastsp ! plot
        then
        i nstars < if i rotate then
    loop
;



: loadcolors
    d# 8 0do
        dup @
        i cells vga_spritec + !
        cell+
    loop
    drop
;
create cpastels
h# 423 ,
h# 243 ,
h# 234 ,
h# 444 ,
h# 324 ,
h# 432 ,
h# 342 ,
h# 244 ,
: pastels cpastels loadcolors ;

create crainbow
h# 400 ,
h# 440 ,
h# 040 ,
h# 044 ,
h# 004 ,
h# 404 ,
h# 444 ,
h# 444 ,
: rainbow crainbow loadcolors ;

variable prev_sw3_n
: next?  sw3_n @ prev_sw3_n fall? ;

: loadsprites ( da -- )
    2/
    d# 16384 0do
        2dup i s>d d+ flash@
        i vga_spritea !  vga_spriteport !
    loop
    2drop
;

: stars-main
    vga-page
    d# 16384 0do
        h# 204000. 2/ i s>d d+ flash@
        i vga_spritea !  vga_spriteport !
    loop

    vga_addsprites on
    rainbow

    time@ xor seed !
    seed off
    scatter

    d# 7000000. vision setalarm
    d# 0 frame !
    begin
        makedl
        stars-chasebeam
        \ d# 256 0do i i plot loop
        \ rotateall
        frame @ 1+ frame !
        next?
    until
    frame @ . s"  frames" type cr
;

: buttons ( -- u ) \ pb4 pb3 pb2
    pb_a_dir on
    pb_a @ d# 7 xor
    pb_a_dir off
;

include loader.fs
include dns.fs

: preip-handler
    begin
        mac-fullness
    while
        OFFSET_ETH_TYPE packet@ h# 800 = if
            dhcp-wait-offer
        then
        mac-consume
    repeat
;

: haveip-handler
    \ time@ begin ether_irq @ until time@ 2swap d- d. cr
    \ begin ether_irq @ until
    begin
        mac-fullness
    while
        arp-handler
        OFFSET_ETH_TYPE packet@ h# 800 =
        if
            d# 2 OFFSET_IP_DSTIP mac-inoffset mac@n net-my-ip d=
            if
                icmp-handler
            then
            loader-handler
        then
        depth if .s cr then
        mac-consume
    repeat
;

include invaders.fs

: uptime
    time@
    d# 1 d# 1000 m*/
    d# 1 d# 1000 m*/
;

( IP address formatting                      JCB 14:50 10/26/10)

: #ip1  h# ff and s>d #s 2drop ;
: #.    [char] . hold ;
: #ip2  dup #ip1 #. d# 8 rshift #ip1 ;
: #ip   ( ip -- c-addr u) dup #ip2 #. over #ip2 ;

variable prev_sw2_n
: sw2?  sw2_n @ prev_sw2_n fall? ;

include ps2kb.fs

: welcome-main
    vga-cold
    rainbow
    h# 200000. loadsprites
    'emit @ >r
    ['] vga-emit 'emit !
    d# 6 d# 26 vga-at-xy s" Softcore Forth CPU" type

    d# 32 d# 6 vga-at-xy  s" version " type version type
    d# 32 d# 8 vga-at-xy  s" built   " type build.

    ps2listening kbfifo-cold
    home
    begin
        kbfifo-proc
        \ home kbfifocount @ hex4 space d# 63 0do i kbfifo@ d# 0 .r loop cr
        \ ps2get dup h# 800 = if drop else hex4 cr then
        \ d# 32 d# 10 vga-at-xy net-my-ip <# #ip #> type space space
        \ d# 32 d# 12 vga-at-xy s" uptime  " type uptime d.
        haveip-handler

        d# 8 0do
            frame @ i d# 32 * + invert >r
            d# 100 r@ sin* d# 600 +
            d# 100 r> cos* d# 334 +
            i sprite!
        loop

        waitblank d# 1 frame +!
        next?
    until
    r> 'emit !
;

include clock.fs

: frob
    flash_ce_n    on
    flash_ddir off
    d# 32 0do
        d# 1 i d# 7 and lshift
        flash_d !
        d# 30000. sleepus
    loop
    flash_ddir on
;

: main
    decimal
    ['] serout 'emit !
    \ sleep1

    frob

    d# 60 0do cr loop
    s" Welcome! Built " type build. cr 
    snap

    flash-cold
    \ flash-demo
    \ flash-bytes
    vga-cold
    \ sprite-load

    \ d# 947. d# 99 d# 100 m*/ d. cr
    \ .s cr
    mac-cold
    nicwork
    h# decafbad. dhcp-xid!
    d# 3000000. dhcp-alarm setalarm
    false if
        ip-addr dz
        begin
            net-my-ip d0=
        while
            dhcp-alarm isalarm if
                dhcp-discover
                s" DISCOVER" type cr
                d# 3000000. dhcp-alarm setalarm
            then
            preip-handler
        repeat
    else
        ip# 192.168.0.99 ip-addr 2!
        ip# 255.255.255.0 ip-subnetmask 2!
        ip# 192.168.0.1 ip-router 2!
        \ ip# 192.168.2.201 ip-addr 2!
        \ ip# 255.255.255.0 ip-subnetmask 2!
        \ ip# 192.168.2.1 ip-router 2!
    then
    dhcp-status
    arp-reset

    begin
        welcome-main        sleep.1
        clock-main          sleep.1
        stars-main          sleep.1
        invaders-main       sleep.1
        s" looping" type cr
    again

    begin
        haveip-handler
    again
;


]module

org

code 0jump
    \ h# 3e00 ubranch
    main ubranch
    main ubranch
end-code

meta

hex

: create-output-file w/o create-file throw to outfile ;

\ .mem is a memory dump formatted for use with the Xilinx
\ data2mem tool.
s" j1.mem" create-output-file
:noname
    s" @ 20000" type cr
    4000 0 do i t@ s>d <# # # # # #> type cr 2 +loop
; execute

\ .bin is a big-endian binary memory dump
s" j1.bin" create-output-file
:noname 4000 0 do i t@ dup 8 rshift emit emit 2 +loop ; execute

\ .lst file is a human-readable disassembly 
s" j1.lst" create-output-file
d# 0
h# 2000 disassemble-block