rev: 3827f53bae88e48a594610914ba74b9512ead6dd tukan/testing/test_input.sc -rw-r--r-- 4.9 KiB View raw Log this file
3827f53bae88 — Leonard Ritter * more work on module system 3 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
using import ..tukan.GLMain
let sdl = (import ..tukan.sdl)
using import ..tukan.input

using sdl

""""xbox game controller 
    buttons:
    0 A
    1 B
    2 X
    3 Y
    4 BACK
    5 XBOX
    6 START
    7 Left Analog
    8 Right Analog
    9 LB
    10 RB
    11 D-Up
    12 D-Down
    13 D-Left
    14 D-Right

    axes: 
    0 Left Analog X +-
    1 Left Analog Y +- (+ = down)
    2 Right Analog X +-
    3 Right Analog Y +- (+ = down)
    4 LT +
    5 RT +

fn spam-control? (val)
    switch (val as (typeof SDL_KEYDOWN))
    pass SDL_MOUSEMOTION
    case SDL_MOUSEWHEEL true
    default false

inline dispatch-event-field (event f ffail)
    switch (event.type as (typeof SDL_KEYDOWN))
    #pass SDL_AUDIODEVICEADDED
    #case SDL_AUDIODEVICEREMOVED (f event.adevice)
    
    case SDL_CONTROLLERAXISMOTION (f event.caxis "CONTROLLERAXISMOTION" 'caxis)
    
    case SDL_CONTROLLERBUTTONDOWN (f event.cbutton "CONTROLLERBUTTONDOWN" 'cbutton)
    case SDL_CONTROLLERBUTTONUP (f event.cbutton "CONTROLLERBUTTONUP" 'cbutton)
    
    case SDL_CONTROLLERDEVICEADDED (f event.cdevice "CONTROLLERDEVICEADDED" 'cdevice)
    case SDL_CONTROLLERDEVICEREMOVED (f event.cdevice "CONTROLLERDEVICEREMOVED" 'cdevice)
    case SDL_CONTROLLERDEVICEREMAPPED (f event.cdevice "CONTROLLERDEVICEREMAPPED" 'cdevice)
    
    case SDL_DOLLARGESTURE (f event.dgesture "DOLLARGESTURE" 'dgesture)
    case SDL_DOLLARRECORD (f event.dgesture "DOLLARRECORD" 'dgesture)
    
    case SDL_DROPFILE (f event.drop "DROPFILE" 'drop)
    
    case SDL_FINGERMOTION (f event.tfinger "FINGERMOTION" 'tfinger)
    case SDL_FINGERDOWN (f event.tfinger "FINGERDOWN" 'tfinger)
    case SDL_FINGERUP (f event.tfinger "FINGERUP" 'tfinger)

    case SDL_KEYDOWN (f event.key "KEYDOWN" 'key)
    case SDL_KEYUP (f event.key "KEYUP" 'key)
    
    #case SDL_JOYAXISMOTION (f event.jaxis)
    #case SDL_JOYBALLMOTION (f event.jball)
    #case SDL_JOYHATMOTION (f event.jhat)
    
    #pass SDL_JOYBUTTONDOWN
    
    #case SDL_JOYBUTTONUP (f event.jbutton)
    #case SDL_JOYDEVICEADDED (f event.jdevice)
    #case SDL_JOYDEVICEREMOVED (f event.jdevice)
    
    case SDL_MOUSEMOTION (f event.motion "MOUSEMOTION" 'motion)
    
    case SDL_MOUSEBUTTONDOWN (f event.button "MOUSEBUTTONDOWN" 'button)
    case SDL_MOUSEBUTTONUP (f event.button "MOUSEBUTTONUP" 'button)
    
    case SDL_MOUSEWHEEL (f event.wheel "MOUSEWHEEL" 'wheel) 
    case SDL_MULTIGESTURE (f event.mgesture "MULTIGESTURE" 'mgesture)
    case SDL_QUIT (f event.quit "QUIT" 'quit)
    case SDL_SYSWMEVENT (f event.syswm "SYSWMEVENT" 'syswm)
    case SDL_TEXTEDITING (f event.edit "TEXTEDITING" 'edit)
    case SDL_TEXTINPUT (f event.text "TEXTINPUT" 'text)
    case SDL_USEREVENT (f event.user "USEREVENT" 'user)
    case SDL_WINDOWEVENT (f event.window "WINDOWEVENT" 'window)
    default
        ffail;

spice walkstruct (data t...)

    fn recfn (block cls data t)
        returning Value

        let numfields = ('element-count ('storageof cls))
        
        subt := t .. " "
        for i in (range numfields)
            ET := cls @ i
            k := subt .. ('keyof ET) as string
            if (('storageof ET) < tuple)
                sc_expression_append block
                    spice-quote
                        print k "="
                this-function block ET `(extractvalue data i) subt
            else
                sc_expression_append block
                    spice-quote
                        print k "=" (extractvalue data i)    

        sc_expression_append block `()
        block

    let t = ('getarg t... 0)
    let t = 
        if (('typeof t) == Nothing) ""
        else (t as string)
    let cls =
        'typeof data
    let block = (sc_expression_new)
    recfn block cls data t
    block

run-stage;

global lasttime = (Scope)
spamlimit-ms := 500
fn ignore-event? (event)
    if (spam-control? event.type)
        return
            dispatch-event-field event
                inline "ok" (data)
                    let ts = 
                        try (('@ lasttime event.type) as i32)
                        except (err) 0
                    delta := data.timestamp as i32 - ts
                    if (delta < spamlimit-ms)
                        true
                    else
                        'bind lasttime event.type ts
                        false
                inline "fail" ()
                    true
    switch (event.type as (typeof SDL_KEYDOWN))
    case SDL_CONTROLLERAXISMOTION
        and
            (abs event.caxis.value) < 4096
            event.caxis.value != 0
    default false

@@ 'on GLMain.on-event
inline (event glmain)
    if (not (ignore-event? event))
        dispatch-event-field event
            inline "ok" (data name fieldname)
                print "event:" name fieldname
                walkstruct data
                ;
            inline "fail" ()

let glmain =
    GLMain
        title = "Test Input"
        #hidden = true

dump-controller-info none

'run glmain