swapforth

1
\ Send a buffer as a sequence of run/literal pairs
2
\ a pair looks like:
3
\   #-to-repeat #-to-insert <literals>
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 0             ( 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
00302010    ( 00102410 )   constant    REG_SCREENSHOT_EN    \ Set to enable screenshot mode
59
00302014    ( 00102414 )   constant    REG_SCREENSHOT_Y     \ Y line register
60
00302018    ( 00102418 )   constant    REG_SCREENSHOT_START \ Screenshot start trigger
61
003020e8    ( 001024d8 )   constant    REG_SCREENSHOT_BUSY  \ Screenshot ready flags
62
00302174    ( 00102554 )   constant    REG_SCREENSHOT_READ  \ Set to enable readout
63
003c2000    ( 001c2000 )   constant    RAM_SCREENSHOT       \ Screenshot readout buffer
64
decimal
65

66
: GD.screenshot
67
    GD.finish
68
    1 REG_SCREENSHOT_EN GD.c!
69
    GD.REG_PCLK GD.@
70
    0 GD.REG_PCLK GD.c!
71
    cr ." !screenshot"
72
    GD.REG_HSIZE GD.@ send32 GD.REG_VSIZE GD.@ send32
73
    GD.REG_VSIZE GD.@ 0 do
74
        i REG_SCREENSHOT_Y GD.!
75
        1 REG_SCREENSHOT_START GD.c!
76
        begin
77
            REG_SCREENSHOT_BUSY dup GD.@
78
            swap cell+ GD.@ or 0=
79
        until
80
        1 REG_SCREENSHOT_READ GD.c!
81
        pad GD.REG_HSIZE GD.@ cells RAM_SCREENSHOT GD.move
82
        pad GD.REG_HSIZE GD.@ 4 * rlc \ type
83
        0 REG_SCREENSHOT_READ GD.c!
84
    loop
85
    0 REG_SCREENSHOT_EN GD.!
86
    GD.REG_PCLK GD.c!
87
    \ key [char] k <> 100 and throw
88
;
89