swapforth

1
( Setup for Ken Boak's VGA shield, which uses an FT812 )
2

3
9  constant CS
4

5
: gd2-sel   0 CS io! ;
6
: gd2-unsel 1 CS io! ;
7
: gd2-spi-init
8
    OUTPUT CS pinMode
9
    gd2-unsel
10
    spi-init
11
;
12

13
include gd2.fs
14

15
\ H and Vsync parameters start at GD.REG_HCYCLE, VCYCLE
16
\ and are ordered: HCYCLE HOFFSET HSIZE HSYNC0 HSYNC1
17

18
: setsync ( visible sync back whole REG -- )
19
    20 GD.cmd_memwrite
20
    GD.c            \ CYCLE
21
    over + GD.c     \ OFFSET
22
    swap GD.c       \ SIZE
23
    0 GD.c          \ SYNC0
24
    GD.c            \ SYNC1
25
;
26

27
: hs GD.REG_HCYCLE setsync ;
28
: vs GD.REG_VCYCLE setsync ;
29

30
: pll ( pll -- ) \ set PLL clock multiplier 
31
    dup GD.pll GD.crystal
32
    13000000 * GD.REG_FREQUENCY GD.!
33
;
34

35
: pclk ( pclk -- ) \ common register settings for EVITA display
36
    0 GD.REG_CSPREAD GD.!
37
    0 GD.REG_SWIZZLE GD.!
38
    0 GD.REG_ROTATE GD.!
39
      GD.REG_PCLK GD.!
40
;
41

42
\ H/V timing parameters order: visible sync back whole
43

44
: res create , does> @ GD.setcustom ;
45
:noname 5 pll 1024 136 160 1344 hs 768 6 29 806 vs 1 pclk ;
46
:noname 3 pll  800 128  88 1056 hs 600 4 23 628 vs 1 pclk ;
47
:noname 4 pll  640  96  48  800 hs 480 2 33 542 vs 2 pclk ;
48
res 640x480  res 800x600  res 1024x768
49

50
1024x768        \ default resolution
51

52
: GD.calibrate ;    ( there is no touch screen )
53

54
: test-page
55
    GD.init
56

57
    0 34 GD.cmd_romfont
58

59
    begin
60
        0 0 $00ff00 1024 768 $ff0000 GD.cmd_gradient
61
        16 16 GD.SCISSORXY
62
        1024 32 - 768 32 - GD.SCISSORSIZE
63
        GD.Clear
64

65
        512 50 GD.SCISSORSIZE
66
        3 0 do
67
            256 i 100 * 484 + GD.SCISSORXY
68
            256 i 100 * 484 + $000000
69
            768 i 100 * 484 + $0000ff i 8 * lshift
70
            GD.cmd_gradient
71
        loop
72
        GD.RestoreContext
73

74
        512 186 150 0
75
        ms@ 1000 /mod 2>r
76
        r@ 3600 / 12 mod    ( hours )
77
        r@ 60 / 60 mod      ( minutes )
78
        r> 60 mod           ( seconds )
79
        r>                  ( ms )
80
        GD.cmd_clock 
81

82
        32 32 30 0
83
        GD.wh s>d <# #s 2drop 'x' hold s>d #s #>
84
        GD.cmd_text
85
        512 404 0 GD.OPT_CENTER s" Hello world" GD.cmd_text
86

87
        GD.swap
88
        GD.finish
89
    again
90
;
91

92
128 48 * 2* constant NB \ bytes in 1024x768 text mode
93

94
: test-vga
95
    GD.init
96

97
    0 GD.TEXTVGA 1024 768 GD.cmd_setbitmap
98

99
    GD.Clear
100
    1 0 GD.BlendFunc
101
    GD.BITMAPS GD.Begin
102
    0 0 0 0 GD.Vertex2ii
103
    GD.swap
104
    begin
105
        0 NB GD.cmd_memwrite
106
        NB 0 do
107
            random GD.c
108
        4 +loop
109
        1000 ms
110
    again
111
;
112

113
: .3 ( u -- ) \ print as 3-digit decimal
114
    s>d <# # # # '.' hold #s #> type space
115
;
116

117
: sync \ wait until REG_FRAMES changes
118
    GD.REG_FRAMES GD.c@
119
    begin
120
        dup GD.REG_FRAMES GD.c@ xor
121
    until
122
    drop
123
;
124

125
: report
126
    cr
127
    \ GD.@ .
128

129
    ." REG_ID              "
130
    GD.REG_ID GD.@ hex2. cr
131

132
    ." resolution          "
133
    GD.wh swap 0 .r 'x' emit . cr
134

135
    ." Measured core freq. "
136
    GD.REG_CLOCK GD.@
137
    1000 ms
138
    GD.REG_CLOCK GD.@
139
    swap - 1000 / .3
140
    ." MHz" cr
141

142
    ." Measured frame rate "
143
    sync ms@
144
    100 0 do sync loop
145
    ms@ swap -
146
    100000000 swap / .3
147
    ." Hz" cr
148
;
149