Check-in [af01051ada]
Not logged in
Home Timeline Branches Tags Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Rewrite for Gforth\NativeActivity
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: af01051ada0fb5dcf51071d966cd2eed9565079e
User & Date: bernd 2014-01-17 00:13:01.897
Context
2014-01-17
23:42
Rewritten for own native activity implementation - works\! check-in: 9a2d8e9dac user: bernd tags: trunk
00:13
Rewrite for Gforth\NativeActivity check-in: af01051ada user: bernd tags: trunk
2014-01-16
16:23
Sensor stuff check-in: f4dd8495bc user: bernd tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to gl-terminal.fs.
︙︙
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320

>screen
' gl-atxy IS at-xy
' gl-at-deltaxy IS at-deltaxy
' gl-page IS page
' gl-attr! IS attr!
default-out op-vector !

' (type) ' (emit) ' term-cr ' (form)  output: >term
what's at-xy what's at-deltaxy what's page what's attr!
>term
IS attr! IS page IS at-deltaxy IS at-xy
default-out op-vector !
\ initialize

: term-init ( -- )
    >screen-orientation
    create-terminal-program to terminal-program
    terminal-program terminal-init term-load-textures form-chooser
    unit-matrix MVPMatrix set-matrix ;








<
<
<
<
<








302
303
304
305
306
307
308





309
310
311
312
313
314
315

>screen
' gl-atxy IS at-xy
' gl-at-deltaxy IS at-deltaxy
' gl-page IS page
' gl-attr! IS attr!
default-out op-vector !






\ initialize

: term-init ( -- )
    >screen-orientation
    create-terminal-program to terminal-program
    terminal-program terminal-init term-load-textures form-chooser
    unit-matrix MVPMatrix set-matrix ;
︙︙
Changes to gles2/android.fs. 
1
2
3

4
5
6
7
8
9
10

\ wrapper to load Swig-generated libraries

require struct0x.fs


\ public interface, C calls us through these

get-current also forth definitions

Defer ainput
Defer acmd




>








1
2
3
4
5
6
7
8
9
10
11

\ wrapper to load Swig-generated libraries

require struct0x.fs
require unix/socket.fs

\ public interface, C calls us through these

get-current also forth definitions

Defer ainput
Defer acmd
︙︙
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

    field: x7
    field: y7
    field: x8
    field: y8
    field: x9
    field: y9
    end-structure
    












    begin-structure android_app \ excluding private data
    field: userData
    field: onAppCmd \ (int32_t)(*)(struct android_app* app, int32_t cmd);
    field: onInputEvent \ (int32_t)(*)(struct android_app* app, AInputEvent* event);
    field: activity
    field: config
    field: savedState
    field: savedStateSize
    field: looper
    field: inputQueue
    field: window
    ARect +field contentRect
    field: activityState
    field: destroyRequested
    end-structure


    s" android" add-lib
    
    include androidlib.fs

end-c-library

s" APP_STATE" getenv s>number drop Value app

get-current also forth definitions

require jni-helper.fs

set-current previous

Variable need-sync
Variable need-show

app_input_state buffer: *input

*input app userData !

require string.fs

4 buffer: xstring

: >xstring ( xchar -- addr u )
    xstring xc!+ xstring tuck - ;








|
>
>
>
>
>
>
>
>
>
>
>
>















>
|



















|








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

    field: x7
    field: y7
    field: x8
    field: y8
    field: x9
    field: y9
    end-structure

    begin-structure startargs
    field: vm
    field: env
    field: obj
    field: cls
    field: thread-id
    field: ke-fd0
    field: ke-fd1
    field: window
    end-structure

    0 [IF]
    begin-structure android_app \ excluding private data
    field: userData
    field: onAppCmd \ (int32_t)(*)(struct android_app* app, int32_t cmd);
    field: onInputEvent \ (int32_t)(*)(struct android_app* app, AInputEvent* event);
    field: activity
    field: config
    field: savedState
    field: savedStateSize
    field: looper
    field: inputQueue
    field: window
    ARect +field contentRect
    field: activityState
    field: destroyRequested
    end-structure
    [THEN]
    
    s" android" add-lib
    
    include androidlib.fs

end-c-library

s" APP_STATE" getenv s>number drop Value app

get-current also forth definitions

require jni-helper.fs

set-current previous

Variable need-sync
Variable need-show

app_input_state buffer: *input

\ *input app userData !

require string.fs

4 buffer: xstring

: >xstring ( xchar -- addr u )
    xstring xc!+ xstring tuck - ;
︙︙
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232

233
234
235
236
237
238
239

: screen-keep ( -- )  wake-lock IF
	clazz >o getWindow o> >o FLAG_KEEP_SCREEN_ON clearFlags o> THEN ;

\ callbacks

: $err ( xt -- )  $tmp stderr write-file throw ;

ANativeActivityCallbacks buffer: ana-cbs

:noname [: ." onStart " hex. cr ;] $err ;
ANativeActivityCallbacks-onStart: ana-cbs ANativeActivityCallbacks-onStart !
:noname [: ." onResume " hex. cr ;] $err ;
ANativeActivityCallbacks-onResume: ana-cbs ANativeActivityCallbacks-onResume !
:noname [: ." onPause " hex. cr ;] $err ;
ANativeActivityCallbacks-onPause: ana-cbs ANativeActivityCallbacks-onPause !
:noname [: ." onStop " hex. cr ;] $err ;
ANativeActivityCallbacks-onStop: ana-cbs ANativeActivityCallbacks-onStop !
:noname [: ." onDestroy " hex. cr ;] $err ;
ANativeActivityCallbacks-onDestroy: ana-cbs ANativeActivityCallbacks-onDestroy !
:noname [: ." onLowMemory " hex. cr ;] $err ;
ANativeActivityCallbacks-onLowMemory: ana-cbs ANativeActivityCallbacks-onLowMemory !
:noname [: ." onSaveInstanceState " swap hex. hex. cr ;] $err ;
ANativeActivityCallbacks-onSaveInstanceState: ana-cbs ANativeActivityCallbacks-onSaveInstanceState !
:noname [: ." onWindowFocusChanged " swap hex. hex. cr ;] $err ;
ANativeActivityCallbacks-onWindowFocusChanged: ana-cbs ANativeActivityCallbacks-onWindowFocusChanged !
:noname [: ." onNativeWindowCreated " swap hex. hex. cr ;] $err ;
ANativeActivityCallbacks-onNativeWindowCreated: ana-cbs ANativeActivityCallbacks-onNativeWindowCreated !
:noname [: ." onNativeWindowResized " swap hex. hex. cr ;] $err ;
ANativeActivityCallbacks-onNativeWindowResized: ana-cbs ANativeActivityCallbacks-onNativeWindowResized !
:noname [: ." onNativeWindowRedrawNeeded " swap hex. hex. cr ;] $err ;
ANativeActivityCallbacks-onNativeWindowRedrawNeeded: ana-cbs ANativeActivityCallbacks-onNativeWindowRedrawNeeded !
:noname [: ." onNativeWindowDestroyed " swap hex. hex. cr ;] $err ;
ANativeActivityCallbacks-onNativeWindowDestroyed: ana-cbs ANativeActivityCallbacks-onNativeWindowDestroyed !
:noname [: ." onInputQueueCreated " swap hex. hex. cr ;] $err ;
ANativeActivityCallbacks-onInputQueueCreated: ana-cbs ANativeActivityCallbacks-onInputQueueCreated !
:noname [: ." onInputQueueDestroyed " swap hex. hex. cr ;] $err ;
ANativeActivityCallbacks-onInputQueueDestroyed: ana-cbs ANativeActivityCallbacks-onInputQueueDestroyed !
:noname [: ." onContentRectChanged " swap hex. hex. cr ;] $err ;
ANativeActivityCallbacks-onContentRectChanged: ana-cbs ANativeActivityCallbacks-onContentRectChanged !
:noname [: ." onConfigurationChanged " swap hex. hex. cr ;] $err ;
ANativeActivityCallbacks-onConfigurationChanged: ana-cbs ANativeActivityCallbacks-onConfigurationChanged !

ana-cbs app activity @ ANativeActivity-callbacks !

\ event handling

: keycode>keys ( keycode -- addr u )
    case
	AKEYCODE_MENU of  togglekb s" "  endof
	AKEYCODE_BACK of  aback s" "   endof
	akey>ekey 0
    endcase ;


:noname { event -- }
    event AInputEvent_getType
    case
	1 of \ ." Key event" cr
	    event AKeyEvent_getAction AKEY_STATE_DOWN = IF
		event getUnicodeKey
		?dup-IF  >xstring








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<









>








194
195
196
197
198
199
200





































201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217

: screen-keep ( -- )  wake-lock IF
	clazz >o getWindow o> >o FLAG_KEEP_SCREEN_ON clearFlags o> THEN ;

\ callbacks

: $err ( xt -- )  $tmp stderr write-file throw ;






































\ event handling

: keycode>keys ( keycode -- addr u )
    case
	AKEYCODE_MENU of  togglekb s" "  endof
	AKEYCODE_BACK of  aback s" "   endof
	akey>ekey 0
    endcase ;

0 [IF]
:noname { event -- }
    event AInputEvent_getType
    case
	1 of \ ." Key event" cr
	    event AKeyEvent_getAction AKEY_STATE_DOWN = IF
		event getUnicodeKey
		?dup-IF  >xstring
︙︙
255
256
257
258
259
260
261

262
263

















264
265
266
267
268
269
270
271
272

		event I AMotionEvent_getY f>s
		event I AMotionEvent_getX f>s
		rot dup >r 2! r> 2 cells +
	    LOOP
	    drop
	endof
    endcase ; is ainput


16 Value looper-to#

















: >looper  BEGIN  0 poll_looper 0<  UNTIL looper-to# poll_looper drop ;
: ?looper  BEGIN >looper app window @ UNTIL ;

:noname  0 poll_looper drop defers key? ; IS key?
Defer screen-ops ' noop IS screen-ops
:noname  need-show on  BEGIN  >looper key? screen-ops  UNTIL
    defers key dup #cr = key? and IF  key ?dup-IF unkey THEN THEN ;
IS key









>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|








233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268

		event I AMotionEvent_getY f>s
		event I AMotionEvent_getX f>s
		rot dup >r 2! r> 2 cells +
	    LOOP
	    drop
	endof
    endcase ; is ainput
[THEN]

16 Value looper-to#
2Variable loop-event
0 Value poll-file

pollfd %size buffer: looperfds
: fds!+ ( fileno flag addr -- addr' )
    >r r@ events w!  r@ fd l!  r> pollfd %size + ; 

: ?poll-file ( -- )
    poll-file 0= IF  app ke-fd0 @ "r\0" drop fdopen to poll-file  THEN ;
: poll? ( ms -- flag )  looperfds 1 rot 1000 * poll 0> dup >r
    IF  loop-event 2 cells poll-file read-file throw drop
	loop-event 2@ swap akey  THEN  r> ;

: >looper  app ke-fd0 @  POLLIN looperfds fds!+ drop  ?poll-file
    BEGIN  0 poll? 0=  UNTIL  looper-to# poll? drop ;
: ?looper  BEGIN  >looper  app window @ UNTIL ;
	    
\ : >looper  BEGIN  0 poll_looper 0<  UNTIL looper-to# poll_looper drop ;
\ : ?looper  BEGIN >looper app window @ UNTIL ;

:noname  0 poll_looper drop defers key? ; IS key?
Defer screen-ops ' noop IS screen-ops
:noname  need-show on  BEGIN  >looper key? screen-ops  UNTIL
    defers key dup #cr = key? and IF  key ?dup-IF unkey THEN THEN ;
IS key
︙︙
350
351
352
353
354
355
356

357





358

359
360
361
362
363
364
365
366





367

368
369

JValue sensor

Defer android-location ( location -- )
:noname to location ; IS android-location
Defer android-sensor ( sensor -- )
:noname to sensor ; IS android-sensor


:noname ( event type -- )





    CASE

	0 OF  android-key         ENDOF
	1 OF  android-touch       ENDOF
	2 OF  android-location    ENDOF
	3 OF  android-sensor      ENDOF
	4 OF  android-characters  ENDOF
	5 OF  android-unicode     ENDOF
	6 OF  android-keycode     ENDOF
	7 Of  android-touch       ENDOF





    nip ENDCASE ; is akey


previous previous set-current








>
|
>
>
>
>
>
|
>
|
|
|
|
|
|
|
|
>
>
>
>
>
|
>



346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378

JValue sensor

Defer android-location ( location -- )
:noname to location ; IS android-location
Defer android-sensor ( sensor -- )
:noname to sensor ; IS android-sensor

\ stubs, "is recurse" assigns to last defined word

Defer android-surface-created ' drop is recurse
Defer android-surface-changed ' drop is recurse
Defer android-surface-redraw ' drop is recurse
Defer android-surface-destroyed ' drop is recurse
Defer android-global-layout ' drop is recurse

Create aevents
' android-key ,
' android-touch ,
' android-location ,
' android-sensor ,
' android-characters ,
' android-unicode ,
' android-keycode ,
' android-touch ,
' android-surface-created ,
' android-surface-changed ,
' android-surface-redraw ,
' android-surface-destroyed ,
' android-global-layout ,

:noname ( event type -- ) cells aevents + perform ; is akey

previous previous set-current
Changes to gles2/gl-terminal.fs.
︙︙
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320

>screen
' gl-atxy IS at-xy
' gl-at-deltaxy IS at-deltaxy
' gl-page IS page
' gl-attr! IS attr!
default-out op-vector !

' (type) ' (emit) ' term-cr ' (form)  output: >term
what's at-xy what's at-deltaxy what's page what's attr!
>term
IS attr! IS page IS at-deltaxy IS at-xy
default-out op-vector !
\ initialize

: term-init ( -- )
    >screen-orientation
    create-terminal-program to terminal-program
    terminal-program terminal-init term-load-textures form-chooser
    unit-matrix MVPMatrix set-matrix ;








<
<
<
<
<








302
303
304
305
306
307
308





309
310
311
312
313
314
315

>screen
' gl-atxy IS at-xy
' gl-at-deltaxy IS at-deltaxy
' gl-page IS page
' gl-attr! IS attr!
default-out op-vector !






\ initialize

: term-init ( -- )
    >screen-orientation
    create-terminal-program to terminal-program
    terminal-program terminal-init term-load-textures form-chooser
    unit-matrix MVPMatrix set-matrix ;
︙︙
Changes to gles2/jni-helper.fs. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14

\ show/hide keyboard using jni tools

require jni-tools.fs

also android also jni

app activity @ ANativeActivity-clazz @ Value clazz

: gforth-class: ( -- )
    clazz env tuck JNIEnv-getObjectClass() to jniclass ;

gforth-class:

\ jni-sfield: INPUT_METHOD_SERVICE INPUT_METHOD_SERVICE Ljava/lang/String;







|








1
2
3
4
5
6
7
8
9
10
11
12
13
14

\ show/hide keyboard using jni tools

require jni-tools.fs

also android also jni

app obj @ Value clazz

: gforth-class: ( -- )
    clazz env tuck JNIEnv-getObjectClass() to jniclass ;

gforth-class:

\ jni-sfield: INPUT_METHOD_SERVICE INPUT_METHOD_SERVICE Ljava/lang/String;
︙︙
Changes to gles2/jni-tools.fs. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

\ Java Native Interface toolkit

require jni.fs
require mini-oof2.fs \ we only need o for now

get-current also android also jni definitions

JavaVMAttachArgs buffer: vmAA

JNI_VERSION_1_6        vmAA JavaVMAttachArgs-version !
"NativeThread\0" drop  vmAA JavaVMAttachArgs-name !
0                      vmAA JavaVMAttachArgs-group !

app activity @ Value act
act ANativeActivity-vm @ value vm
act ANativeActivity-env @ value env

16 Constant maxargs#

User callargs

: attach ( -- ) \ jni
    \G attach the current thread to the JVM














<
|
|








1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
22

\ Java Native Interface toolkit

require jni.fs
require mini-oof2.fs \ we only need o for now

get-current also android also jni definitions

JavaVMAttachArgs buffer: vmAA

JNI_VERSION_1_6        vmAA JavaVMAttachArgs-version !
"NativeThread\0" drop  vmAA JavaVMAttachArgs-name !
0                      vmAA JavaVMAttachArgs-group !


app vm @ value vm
app env @ value env

16 Constant maxargs#

User callargs

: attach ( -- ) \ jni
    \G attach the current thread to the JVM
︙︙
Fossil version [611144ddd9] 2025-05-16 13:52:48