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

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

Overview
Comment:Removed unused libraries
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 3e6683c6bb6d45d9b0e608434edb6d2cd460b327
User & Date: bernd 2014-01-10 18:38:48.118
Context
2014-01-10
23:04
Location service added check-in: 6a0066556d user: bernd tags: trunk
18:38
Removed unused libraries check-in: 3e6683c6bb user: bernd tags: trunk
2013-11-29
19:54
Add links check-in: 00cbb91fbd user: bernd tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to freetype-gl/configure.ac.
︙︙
17
18
19
20
21
22
23


24
25
26

	;;
     *)
	LIBGL=GL
	;;
esac
AC_SUBST(LIBADD)
AC_SUBST(LIBGL)



AC_CONFIG_FILES([Makefile])
AC_OUTPUT








>
>




17
18
19
20
21
22
23
24
25
26
27
28

	;;
     *)
	LIBGL=GL
	;;
esac
AC_SUBST(LIBADD)
AC_SUBST(LIBGL)
LIBTOOL=${CC%gcc}libtool
AC_SUBST(LIBTOOL)

AC_CONFIG_FILES([Makefile])
AC_OUTPUT
Changes to ftgl-helper.fs. 
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18

\ freetype GL example

\ needs wide char arguments

Variable wide$
Variable widec


: >wide$ ( addr u -- addr' u' )  s" " wide$ $!
    over + swap ?DO
        I xc@+ widec l! widec 4 wide$ $+!
    I - +LOOP  wide$ $@ ;

\ freetype stuff

require freetype-gl.fs

also freetype-gl
also opengl








>
|
<
<
|








1
2
3
4
5
6
7
8
9


10
11
12
13
14
15
16
17

\ freetype GL example

\ needs wide char arguments

Variable wide$
Variable widec

: >widec ( char -- ) widec l! widec 4 wide$ $+! ;
: >wide$ ( addr u -- addr' )  s" " wide$ $!


    bounds ?DO  I xc@+ >widec  I - +LOOP  0 >widec  wide$ $@ drop ;

\ freetype stuff

require freetype-gl.fs

also freetype-gl
also opengl
︙︙
89
90
91
92
93
94
95
96

97

98
99
100
101
102
103
104
105
106
107
108
109
110
111

    fover f- fnegate fd fmin fswap fh fmax ;

: layout-string ( addr u -- fw fh fd ) \ depth is ow far it goes down
    0 -rot  0e 0e 0e  bounds ?DO
	I xc@+ swap >r xchar@xy r>
    I - +LOOP  drop ;

: load-glyphs ( -- )

    font

    "#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\0" >wide$ drop texture_font_load_glyphs drop ;

program init

: <render ( -- )
    program glUseProgram
    1-bias set-color+
    .01e 100e 100e >ap
    atlas-tex v0 i0 ;

: render> ( -- )  GL_TRIANGLES draw-elements
    ( Coloradd 0e fdup fdup fdup glUniform4f ) ;

previous previous








|
>
|
>
|














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

    fover f- fnegate fd fmin fswap fh fmax ;

: layout-string ( addr u -- fw fh fd ) \ depth is ow far it goes down
    0 -rot  0e 0e 0e  bounds ?DO
	I xc@+ swap >r xchar@xy r>
    I - +LOOP  drop ;

: load-glyph$ ( addr u -- ) >wide$
    font swap texture_font_load_glyphs drop ;

: load-ascii ( -- )
    "#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" load-glyph$ ;

program init

: <render ( -- )
    program glUseProgram
    1-bias set-color+
    .01e 100e 100e >ap
    atlas-tex v0 i0 ;

: render> ( -- )  GL_TRIANGLES draw-elements
    ( Coloradd 0e fdup fdup fdup glUniform4f ) ;

previous previous
Changes to gl-helper.fs. 
1
2
3
4
5
6
7




8
9
10
11
12
13
14

\ opengl common stuff

require unix/mmap.fs
require mini-oof2.fs

: w, ( n -- )  here 2 allot w! ;
: l, ( n -- )  here 4 allot l! ;





s" os-type" environment? [IF]
    2dup s" linux-android" str= [IF] 2drop
	require opengl.fs
	
	also opengl
	








>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

\ opengl common stuff

require unix/mmap.fs
require mini-oof2.fs

: w, ( n -- )  here 2 allot w! ;
: l, ( n -- )  here 4 allot l! ;

Variable dpy-w
Variable dpy-h
0 Value ctx

s" os-type" environment? [IF]
    2dup s" linux-android" str= [IF] 2drop
	require opengl.fs
	
	also opengl
︙︙
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

	    s" precision mediump float;        // required for GLES 2.0" ;
    [ELSE]
	s" linux-gnu" str= [IF]
	    require opengl/opengl.fs
	    
	    also opengl
	
	    require opengl/linux.fs
	    also \ same voc stack effect as on android

	    align here
	    GLX_SAMPLE_BUFFERS  l, 1 l,
	    GLX_SAMPLES         l, 4 l,
	    here
	    GLX_RED_SIZE        l, 8 l,
	    GLX_GREEN_SIZE      l, 8 l,








|
<








44
45
46
47
48
49
50
51

52
53
54
55
56
57
58

	    s" precision mediump float;        // required for GLES 2.0" ;
    [ELSE]
	s" linux-gnu" str= [IF]
	    require opengl/opengl.fs
	    
	    also opengl
	
	    require opengl/linux.fs \ same voc stack effect as on android


	    align here
	    GLX_SAMPLE_BUFFERS  l, 1 l,
	    GLX_SAMPLES         l, 4 l,
	    here
	    GLX_RED_SIZE        l, 8 l,
	    GLX_GREEN_SIZE      l, 8 l,
︙︙
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

	: add-precision s" " ;
    [THEN]
[THEN]

Variable configs
Variable numconfigs
Variable eglformat
Variable dpy-w
Variable dpy-h

: ??gl .s ." gl: " glGetError . ; ' ??gl is printdebugdata

[IFDEF] android
    : win app window @ ;
    
    0 Value egldpy
    0 Value surface
    0 Value eglcontext
    
    : getwh ( -- )
	egldpy surface EGL_WIDTH dpy-w eglQuerySurface drop
	egldpy surface EGL_HEIGHT dpy-h eglQuerySurface drop
	0 0 dpy-w @ dpy-h @ glViewport ;

    : >screen-orientation ( -- )








<
<








<








68
69
70
71
72
73
74


75
76
77
78
79
80
81
82

83
84
85
86
87
88
89

	: add-precision s" " ;
    [THEN]
[THEN]

Variable configs
Variable numconfigs
Variable eglformat



: ??gl .s ." gl: " glGetError . ; ' ??gl is printdebugdata

[IFDEF] android
    : win app window @ ;
    
    0 Value egldpy
    0 Value surface

    
    : getwh ( -- )
	egldpy surface EGL_WIDTH dpy-w eglQuerySurface drop
	egldpy surface EGL_HEIGHT dpy-h eglQuerySurface drop
	0 0 dpy-w @ dpy-h @ glViewport ;

    : >screen-orientation ( -- )
︙︙
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

		." default config only" EXIT
	    THEN
	THEN ;
    
    : create-context ( -- )
	win 0 0 eglformat ANativeWindow_setBuffersGeometry drop
	egldpy configs @ win 0 eglCreateWindowSurface to surface
	egldpy configs @ 0 eglattribs eglCreateContext to eglcontext
	egldpy surface dup eglcontext eglMakeCurrent drop ;

    : sync ( -- )
	egldpy surface eglSwapBuffers drop ;
[THEN]

[IFDEF] linux
    fpath+ gles2
    0 Value visual
    0 Value ctx

    \ I have no luck with glXChooseVisual - this is a replacement:
    Variable nitems
    Variable val
    : glXVisual? ( visinfo attrib -- flag ) true { flag }
	BEGIN  dup l@  WHILE
		2dup dpy -rot l@ val glXGetConfig drop
		dup 4 + l@ val @ u<= flag and to flag
		8 +
	REPEAT  2drop flag ;
    
    : glXChooseVisual' ( dpy screen attrib -- ) { attrib }
	pad nitems XGetVisualInfo nitems @ XVisualInfo * bounds ?DO
	    I attrib glXVisual?  IF  I unloop  EXIT  THEN
	XVisualInfo +LOOP 0 ;
    
    : choose-config ( -- )
	get-display dpy-h ! dpy-w !
	dpy screen attrib3 glXChooseVisual' dup 0= IF  drop
	    dpy screen attrib2 glXChooseVisual' dup 0= IF  drop
		dpy screen attrib glXChooseVisual' dup
		0= abort" Unable to choose Visual"
	    THEN
	THEN  to visual ;

    : create-context ( -- )
	default-events "GL-Window\0" drop dpy-w @ dpy-h @ simple-win
	dpy visual 0 1 glXCreateContext to ctx
	dpy win ctx glXMakeCurrent drop ;

    : getwh ( -- )
	0 0 dpy-w @ dpy-h @ glViewport ;

    : >screen-orientation ;

    : sync ( -- )
	dpy win glXSwapBuffers ;
[THEN]

: init-opengl ( -- )








|
|








<
















|








|




<
<
<








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

		." default config only" EXIT
	    THEN
	THEN ;
    
    : create-context ( -- )
	win 0 0 eglformat ANativeWindow_setBuffersGeometry drop
	egldpy configs @ win 0 eglCreateWindowSurface to surface
	egldpy configs @ 0 eglattribs eglCreateContext to ctx
	egldpy surface dup ctx eglMakeCurrent drop ;

    : sync ( -- )
	egldpy surface eglSwapBuffers drop ;
[THEN]

[IFDEF] linux
    fpath+ gles2
    0 Value visual


    \ I have no luck with glXChooseVisual - this is a replacement:
    Variable nitems
    Variable val
    : glXVisual? ( visinfo attrib -- flag ) true { flag }
	BEGIN  dup l@  WHILE
		2dup dpy -rot l@ val glXGetConfig drop
		dup 4 + l@ val @ u<= flag and to flag
		8 +
	REPEAT  2drop flag ;
    
    : glXChooseVisual' ( dpy screen attrib -- ) { attrib }
	pad nitems XGetVisualInfo nitems @ XVisualInfo * bounds ?DO
	    I attrib glXVisual?  IF  I unloop  EXIT  THEN
	XVisualInfo +LOOP 0 ;
    
    : choose-config ( -- ) \ visual ?EXIT
	get-display dpy-h ! dpy-w !
	dpy screen attrib3 glXChooseVisual' dup 0= IF  drop
	    dpy screen attrib2 glXChooseVisual' dup 0= IF  drop
		dpy screen attrib glXChooseVisual' dup
		0= abort" Unable to choose Visual"
	    THEN
	THEN  to visual ;

    : create-context ( -- ) \ win ?EXIT
	default-events "GL-Window\0" drop dpy-w @ dpy-h @ simple-win
	dpy visual 0 1 glXCreateContext to ctx
	dpy win ctx glXMakeCurrent drop ;




    : >screen-orientation ;

    : sync ( -- )
	dpy win glXSwapBuffers ;
[THEN]

: init-opengl ( -- )
︙︙
310
311
312
313
314
315
316


317
318
319
320
321
322
323

0 Value LightPos
0 Value Texture
0 Value ambient
0 Value Coloradd
0 Value program

: create-program { vs-xt fs-xt -- program }


    glCreateProgram dup >r IF
	r@ vs-xt execute glAttachShader
	r@ fs-xt execute glAttachShader
	vs-xt r@ >bindattrib
	r@ glLinkProgram THEN
    r> ;









>
>








306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321

0 Value LightPos
0 Value Texture
0 Value ambient
0 Value Coloradd
0 Value program

: create-program { vs-xt fs-xt -- program }
    vs-xt recompile-shader
    fs-xt recompile-shader
    glCreateProgram dup >r IF
	r@ vs-xt execute glAttachShader
	r@ fs-xt execute glAttachShader
	vs-xt r@ >bindattrib
	r@ glLinkProgram THEN
    r> ;
︙︙
390
391
392
393
394
395
396



397
398
399
400
401
402
403

	I 4 sfloats bounds DO
	    I sf@ f.
	1 sfloats +LOOP cr
    4 sfloats +LOOP ;

: set-matrix ( addr handle -- ) swap >r
    1 false r> glUniformMatrix4fv ;




: set-color+ ( addr -- )  Coloradd 1 rot glUniform4fv ;

: >ortho { f: near f: far f: left f: right f: top f: bottom -- }
    ap-matrix
    near f2* right left f- f/ sf!+ 0e sf!+ 0e sf!+ 0e sf!+
    0e sf!+ near f2* top bottom f- f/ sf!+ 0e sf!+ 0e sf!+








>
>
>








388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404

	I 4 sfloats bounds DO
	    I sf@ f.
	1 sfloats +LOOP cr
    4 sfloats +LOOP ;

: set-matrix ( addr handle -- ) swap >r
    1 false r> glUniformMatrix4fv ;

: >x-pos ( r -- ) x-pos sf!  unit-matrix MVPMatrix set-matrix ;
: >y-pos ( r -- ) y-pos sf!  unit-matrix MVPMatrix set-matrix ;

: set-color+ ( addr -- )  Coloradd 1 rot glUniform4fv ;

: >ortho { f: near f: far f: left f: right f: top f: bottom -- }
    ap-matrix
    near f2* right left f- f/ sf!+ 0e sf!+ 0e sf!+ 0e sf!+
    0e sf!+ near f2* top bottom f- f/ sf!+ 0e sf!+ 0e sf!+
︙︙
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640











































641

: f>c ( r g b a -- )  c.a sf! c.b sf! c.g sf! c.r sf! ;
: n>xyz ( x y z -- ) n.z sf! n.y sf! n.x sf! 1e n.t sf! ;
: n> ( -- ) -1e n.z sf! 0e n.y sf! 0e n.x sf! 1e n.t sf! ;
: >st ( s t -- ) t.t sf! t.s sf! ;

\ window closed/reopened

: recompile-shaders ( -- )
    ['] VertexShader recompile-shader
    ['] FragmentShader recompile-shader ;

: helper-init  init-opengl texture-init recompile-shaders
    ['] VertexShader ['] FragmentShader create-program to program
    program init  buffer-init ;

:noname  defers window-init helper-init ; IS window-init

\ click region stuff

: click-regions ( w h -- x' y' )  >r >r
    *input x0 @ r> dpy-w @ */
    *input y0 @ r> dpy-h @ */ ;












































previous








<
<
<
<
|











>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


619
620
621
622
623
624
625




626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681

: f>c ( r g b a -- )  c.a sf! c.b sf! c.g sf! c.r sf! ;
: n>xyz ( x y z -- ) n.z sf! n.y sf! n.x sf! 1e n.t sf! ;
: n> ( -- ) -1e n.z sf! 0e n.y sf! 0e n.x sf! 1e n.t sf! ;
: >st ( s t -- ) t.t sf! t.s sf! ;

\ window closed/reopened





: helper-init  init-opengl texture-init
    ['] VertexShader ['] FragmentShader create-program to program
    program init  buffer-init ;

:noname  defers window-init helper-init ; IS window-init

\ click region stuff

: click-regions ( w h -- x' y' )  >r >r
    *input x0 @ r> dpy-w @ */
    *input y0 @ r> dpy-h @ */ ;

\ toggle and drag time stuff

: ftime ( -- r ) ntime d>f 1e-9 f* ;

0.5e FConstant rel-drag
0.3e FConstant abs-drag
FVariable drag-time
: f!@ ( r1 addr -- r2 ) dup f@ fswap f! ;
: delta-t ( -- r )
    ftime fdup drag-time f!@ f- fdup 1e f> IF  fdrop 0e  THEN ;

Fvariable click-time
FVariable motion-x0
FVariable motion-y0
Variable last-x0  -100 last-x0 !
Variable last-y0  -100 last-y0 !
0.15e FConstant short-click#
0.5e  FConstant long-click#

: delta-tc  ftime click-time f@ f- ;
: short? ( -- flag )
    delta-tc short-click# f< ;
: long? ( -- flag )
    delta-tc long-click# f> ;
: !click ( -- ) ftime click-time f! ;
[IFUNDEF] togglekb : togglekb ; [THEN]
: ?toggle ( -- )
    short? motion-y0 f@ f0= and IF  togglekb need-show off  THEN ;

: do-motion { rows cur old motion xt -- }
    old @ -100 = IF
	cur old !
    ELSE
	cur old @ over old ! swap -
	s>f dpy-h @ s>f rows fm/ f/ fdup motion f! xt execute
    THEN ;

: drag-motion { old motion xt -- } delta-t { f: dt }
    motion f@ rel-drag dt f** f*
    fdup f0< fabs abs-drag dt f* f- 0e fmax IF fnegate THEN
    fdup motion f! fdup f0<> IF  xt execute  ELSE  fdrop  THEN
    -100 old ! ;

previous
Changes to gl-sample.fs.
︙︙
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

    v0 colors'
    ascii-tex
    GL_TRIANGLES draw-elements
    sync
    2drop \ ntime d- dnegate ." Frame time: " d. cr
    >looper
    *input >r r@ IF
	r@ action @ 2 = IF
	    \ ." Touch at " r@ x0 ? r@ y0 ? cr
	    \ r@ x0 @ 20 < r@ y0 @ 20 < and IF -1 (bye) THEN
	    r@ x0 @ dpy-w @ 2/ - s>f dpy-h @ 2/ fm/
	    r@ y0 @ dpy-h @ 2/ - s>f dpy-h @ 2/ fm/
	    fover fover fnegate -0.15e lightpos glUniform3f
	    fatan2
	    touch f@ -100e f= IF








|








69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

    v0 colors'
    ascii-tex
    GL_TRIANGLES draw-elements
    sync
    2drop \ ntime d- dnegate ." Frame time: " d. cr
    >looper
    *input >r r@ IF
	r@ pressure @ 0> IF
	    \ ." Touch at " r@ x0 ? r@ y0 ? cr
	    \ r@ x0 @ 20 < r@ y0 @ 20 < and IF -1 (bye) THEN
	    r@ x0 @ dpy-w @ 2/ - s>f dpy-h @ 2/ fm/
	    r@ y0 @ dpy-h @ 2/ - s>f dpy-h @ 2/ fm/
	    fover fover fnegate -0.15e lightpos glUniform3f
	    fatan2
	    touch f@ -100e f= IF
︙︙
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114


115

	    ambient% sf@ 0.05e f- 0.5e fmax ambient% sf!
	ELSE
	    ambient% sf@ 0.05e f+ 1.0e fmin ambient% sf!
	    angle motion f@ f+ to angle
	    motion f@ 0.01e f- 0.95e f* 0.01e f+ motion f!
	    -100e touch f!
	THEN
	." Motion: " motion f@ f. cr 0 -1 at-deltaxy
	r@ action off
    THEN
    rdrop angle ;

: tri-loop ( -- ) 1 level# +! 0e  BEGIN draw-tri level# @ 0= UNTIL fdrop ;

: gl-sample ( -- )
    ['] VertexShader ['] FragmentShader create-program to program
    program init load-textures .info
    tri-loop ;

previous previous



gl-sample








|
<





|






>
>


94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

	    ambient% sf@ 0.05e f- 0.5e fmax ambient% sf!
	ELSE
	    ambient% sf@ 0.05e f+ 1.0e fmin ambient% sf!
	    angle motion f@ f+ to angle
	    motion f@ 0.01e f- 0.95e f* 0.01e f+ motion f!
	    -100e touch f!
	THEN
	\ ." Motion: " motion f@ f. cr 0 -1 at-deltaxy

    THEN
    rdrop angle ;

: tri-loop ( -- ) 1 level# +! 0e  BEGIN draw-tri level# @ 0= UNTIL fdrop ;

: gl-sample ( -- ) [IFDEF] hidekb  hidekb [THEN]
    ['] VertexShader ['] FragmentShader create-program to program
    program init load-textures .info
    tri-loop ;

previous previous

win 0= [IF] window-init [THEN]

gl-sample
Changes to gl-slideshow.fs.
︙︙
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
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
240
241
242
243
244
245
246
247
248
249

	    pi f* fcos 1e f- [ pi f2/ fnegate ] FLiteral f* fcos 1e f-
	    fdup n1 n2 < IF fnegate  THEN yshift n1 draw-slide
	    2e f+ n1 n2 < IF fnegate  THEN yshift n2 draw-slide
	    draw-slide>  REPEAT
    <draw-slide n2 draw-slide draw-slide>
    fdrop ;

: slideshow-init ( -- ) recompile-shaders
    ['] VertexShader ['] FragmentShader create-program to program program init
    unit-matrix MVPMatrix set-matrix  buffer-init ;

Variable current-slide

: prefetch ( -- )
    current-slide @ 1+ slidelist $[]# 1- min read-in
    current-slide @ 1- 0 max read-in ;
: prefetch-thumb ( -- ) ;

: +slide ( n -- n1 n2 )
    current-slide @ tuck + 0 max slidelist $[]# 1- min dup current-slide ! ;

: thumb-slide ( n -- ) +slide
    <draw-slide current-slide @ draw-thumbs draw-slide> ;

: thumb-yr ( -- float )  current-slide @ thumb# / s>f
    y-pos sf@ f2/ thumb# fm* f+ ;

: thumb-scroll ( r -- )  fdup floor fdup f>s thumb# * current-slide ! f-
    f2* thumb# fm/ >y-pos  0 thumb-slide ;

: +thumb-slide ( delta -- )
    thumb-yr f+ slidelist $[]# thumb# / 1 - s>f fmin
    0e fmax thumb-scroll ;
 


: slide-input ( -- )
    >looper
    *input >r r@ IF
	case  r@ action @  r@ action on
	    1 ( AMOTION_EVENT_ACTION_UP ) of
		short? IF
		    3 3 click-regions
		    BEGIN
			2dup 1 0 d= IF  2drop -1 +slide 1e  vslide  LEAVE  THEN
			2dup 1 2 d= IF  2drop  1 +slide 1e  vslide  LEAVE  THEN
			2dup 0 1 d= IF  2drop -1 +slide 1e  hslide  LEAVE  THEN
			2dup 2 1 d= IF  2drop  1 +slide 1e  hslide  LEAVE  THEN
			2dup 1 1 d= IF  2drop  1 +slide .5e fade    LEAVE  THEN
			2drop
		    DONE
		THEN
	    endof
	    0 of  !click  endof
	endcase
    THEN
    rdrop ;

: reshow ( -- ) [IFDEF] android  kbflag @ IF  togglekb  THEN [THEN] 0e >y-pos
    slideshow-init <draw-slide current-slide @ draw-slide draw-slide>
    1 level# +! BEGIN  prefetch slide-input  level# @ 0= UNTIL ;




: thumb-input ( -- )
    ekey? IF  ekey case
	    k-up    of  [ thumb# dup * negate ]L thumb-slide  endof
	    k-down  of  [ thumb# dup *        ]L thumb-slide  endof
	endcase
    THEN
    >looper
    *input >r r@ IF
	case  r@ action @  r@ action on
	    1 ( AMOTION_EVENT_ACTION_UP ) of
		short? IF
		    thumb# dup click-regions
		    thumb# * + current-slide +!
		    -1 level# +!  reshow  1 level# +!
		    0 thumb-slide
		THEN
	    endof
	    0 of  !click  r@ y0 @ last-y0 !  endof
	    2 of
		thumb# r@ y0 @ last-y0 motion-y0 ['] +thumb-slide do-motion
		2drop
	    endof
	    last-y0 motion-y0 ['] +thumb-slide drag-motion
	endcase
    THEN
    rdrop ;

: rethumb ( -- ) [IFDEF] android  kbflag @ IF  togglekb  THEN [THEN] 0e >y-pos








|

|

















|




|
|
>
>

|




















|
|

>
>
>







|






|






<








162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
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
240
241
242
243
244
245
246

247
248
249
250
251
252
253

	    pi f* fcos 1e f- [ pi f2/ fnegate ] FLiteral f* fcos 1e f-
	    fdup n1 n2 < IF fnegate  THEN yshift n1 draw-slide
	    2e f+ n1 n2 < IF fnegate  THEN yshift n2 draw-slide
	    draw-slide>  REPEAT
    <draw-slide n2 draw-slide draw-slide>
    fdrop ;

: slideshow-init ( -- )  ctx 0= IF  helper-init  THEN
    ['] VertexShader ['] FragmentShader create-program to program program init
    unit-matrix MVPMatrix set-matrix ;

Variable current-slide

: prefetch ( -- )
    current-slide @ 1+ slidelist $[]# 1- min read-in
    current-slide @ 1- 0 max read-in ;
: prefetch-thumb ( -- ) ;

: +slide ( n -- n1 n2 )
    current-slide @ tuck + 0 max slidelist $[]# 1- min dup current-slide ! ;

: thumb-slide ( n -- ) +slide
    <draw-slide current-slide @ draw-thumbs draw-slide> ;

: thumb-yr ( -- float )  current-slide @ thumb# / s>f
    y-pos sf@ f2/ thumb# fm* f+ ;

: thumb-scroll ( r -- ) fdup floor fdup f>s thumb# * current-slide ! f-
    f2* thumb# fm/ >y-pos  0 thumb-slide ;

: +thumb-slide ( delta -- )
    thumb-yr f+ slidelist $[]# thumb# / 1 - s>f fmin
    0e fmax thumb-scroll 2drop ;

: ?esc ( -- )  key? IF  key #esc = IF  -1 level# +!  THEN  THEN ;

: slide-input ( -- )
    >looper ?esc
    *input >r r@ IF
	case  r@ action @  r@ action on
	    1 ( AMOTION_EVENT_ACTION_UP ) of
		short? IF
		    3 3 click-regions
		    BEGIN
			2dup 1 0 d= IF  2drop -1 +slide 1e  vslide  LEAVE  THEN
			2dup 1 2 d= IF  2drop  1 +slide 1e  vslide  LEAVE  THEN
			2dup 0 1 d= IF  2drop -1 +slide 1e  hslide  LEAVE  THEN
			2dup 2 1 d= IF  2drop  1 +slide 1e  hslide  LEAVE  THEN
			2dup 1 1 d= IF  2drop  1 +slide .5e fade    LEAVE  THEN
			2drop
		    DONE
		THEN
	    endof
	    0 of  !click  endof
	endcase
    THEN
    rdrop ;

: (reshow) ( -- )
    0e >y-pos <draw-slide current-slide @ draw-slide draw-slide>
    1 level# +! BEGIN  prefetch slide-input  level# @ 0= UNTIL ;

: reshow ( -- ) [IFDEF] android  kbflag @ IF  togglekb  THEN [THEN]
    slideshow-init (reshow) ;

: thumb-input ( -- )
    ekey? IF  ekey case
	    k-up    of  [ thumb# dup * negate ]L thumb-slide  endof
	    k-down  of  [ thumb# dup *        ]L thumb-slide  endof
	endcase
    THEN
    >looper ?esc
    *input >r r@ IF
	case  r@ action @  r@ action on
	    1 ( AMOTION_EVENT_ACTION_UP ) of
		short? IF
		    thumb# dup click-regions
		    thumb# * + current-slide +!
		    -1 level# +!  (reshow)  1 level# +!
		    0 thumb-slide
		THEN
	    endof
	    0 of  !click  r@ y0 @ last-y0 !  endof
	    2 of
		thumb# r@ y0 @ last-y0 motion-y0 ['] +thumb-slide do-motion

	    endof
	    last-y0 motion-y0 ['] +thumb-slide drag-motion
	endcase
    THEN
    rdrop ;

: rethumb ( -- ) [IFDEF] android  kbflag @ IF  togglekb  THEN [THEN] 0e >y-pos
︙︙
Changes to gl-terminal.fs. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

\ OpenGL terminal

require ansi.fs \ we may want to support colorize.fs

\ opengl common stuff

require gl-helper.fs

[IFDEF] android  also android [THEN]

GL_FRAGMENT_SHADER shader: TerminalShader
#precision
uniform vec3 u_LightPos;        // The position of the light in eye space.
uniform sampler2D u_Texture;    // The input texture.
uniform float u_Ambient;        // ambient lighting level
uniform sampler2D u_Charmap;    // The character map









|








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

\ OpenGL terminal

require ansi.fs \ we may want to support colorize.fs

\ opengl common stuff

require gl-helper.fs

also [IFDEF] android android [THEN]

GL_FRAGMENT_SHADER shader: TerminalShader
#precision
uniform vec3 u_LightPos;        // The position of the light in eye space.
uniform sampler2D u_Texture;    // The input texture.
uniform float u_Ambient;        // ambient lighting level
uniform sampler2D u_Charmap;    // The character map
︙︙
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

    count s>f $FF fm/
    count s>f $FF fm/
    count s>f $FF fm/
    c@    s>f $FF fm/ glClearColor ;

: std-bg! ( index -- )  dup bg! dup std-bg ! bg>clear ;

7 std-bg! 0 fg!



128 Value videocols
1   Value videorows

2Variable gl-xy  0 0 gl-xy 2!
2Variable gl-wh 24 80 gl-wh 2!
Variable gl-lineend
Variable scroll-y
FVariable scroll-dest
FVariable scroll-source
FVariable scroll-time

: ftime ( -- r ) ntime d>f 1e-9 f* ;

: form-chooser ( -- )
    dpy-w @ dpy-h @ > IF  24 80  ELSE  40 48  THEN  gl-wh 2! ;

: show-rows ( -- n ) videorows scroll-y @ - rows 1+ min ;
: nextpow2 ( n -- n' )
    1 BEGIN  2dup u>  WHILE 2*  REPEAT  nip ;









|
>
>












<
<








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

    count s>f $FF fm/
    count s>f $FF fm/
    count s>f $FF fm/
    c@    s>f $FF fm/ glClearColor ;

: std-bg! ( index -- )  dup bg! dup std-bg ! bg>clear ;

: >white White std-bg! Black fg! ;
: >black Black std-bg! White fg! ;
>white

128 Value videocols
1   Value videorows

2Variable gl-xy  0 0 gl-xy 2!
2Variable gl-wh 24 80 gl-wh 2!
Variable gl-lineend
Variable scroll-y
FVariable scroll-dest
FVariable scroll-source
FVariable scroll-time



: form-chooser ( -- )
    dpy-w @ dpy-h @ > IF  24 80  ELSE  40 48  THEN  gl-wh 2! ;

: show-rows ( -- n ) videorows scroll-y @ - rows 1+ min ;
: nextpow2 ( n -- n' )
    1 BEGIN  2dup u>  WHILE 2*  REPEAT  nip ;
︙︙
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203


    v0 >rectangle >texcoords
    GL_TEXTURE0 glActiveTexture
    chars-tex
    i0 0 i, 1 i, 2 i, 0 i, 2 i, 3 i,
    GL_TRIANGLES draw-elements ;

: >x-pos ( r -- ) x-pos sf!  unit-matrix MVPMatrix set-matrix ;
: >y-pos ( r -- ) y-pos sf!  unit-matrix MVPMatrix set-matrix ;

: screen-scroll ( r -- )  fdup floor fdup f>s scroll-y ! f-
    f2* rows fm/ >y-pos  need-sync on ;

: gl-char' ( -- addr )
    gl-xy 2@ videocols * + sfloats videomem + ;

: gl-form ( -- h w ) gl-wh 2@ ;








<
<
<








187
188
189
190
191
192
193



194
195
196
197
198
199
200


    v0 >rectangle >texcoords
    GL_TEXTURE0 glActiveTexture
    chars-tex
    i0 0 i, 1 i, 2 i, 0 i, 2 i, 3 i,
    GL_TRIANGLES draw-elements ;




: screen-scroll ( r -- )  fdup floor fdup f>s scroll-y ! f-
    f2* rows fm/ >y-pos  need-sync on ;

: gl-char' ( -- addr )
    gl-xy 2@ videocols * + sfloats videomem + ;

: gl-form ( -- h w ) gl-wh 2@ ;
︙︙
264
265
266
267
268
269
270

271

272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328

    getwh  >screen-orientation
    need-sync on ;
\    ." config changed to: " w ? h ? cr

\ Google is stupid: This event comes too early
\ Make Gforth sync the screen up to four times till the config really changes
:noname

    4 0 DO  dpy-w @ dpy-h @ config-changer dpy-w @ dpy-h @ d<> screen-sync ?LEAVE LOOP

    config-changer form-chooser screen-sync ;
is config-changed

Variable last-x0  -100 last-x0 !
Variable last-y0  -100 last-y0 !
FVariable motion-x0
FVariable motion-y0

: scroll-yr ( -- float )  scroll-y @ s>f
    y-pos sf@ f2/ rows fm* f+ ;

: +scroll ( -- )
    scroll-yr f+ videorows 1 - s>f fmin
    0e fmax screen-scroll ;

0.5e FConstant rel-drag
0.3e FConstant abs-drag
FVariable drag-time
: f!@ ( r1 addr -- r2 ) dup f@ fswap f! ;
: delta-t ( -- r )
    ftime fdup drag-time f!@ f- fdup 1e f> IF  fdrop 0e  THEN ;

Fvariable click-time
0.15e FConstant short-click#
0.5e  FConstant long-click#

: delta-tc  ftime click-time f@ f- ;
: short? ( -- flag )
    delta-tc short-click# f< ;
: long? ( -- flag )
    delta-tc long-click# f> ;
: !click ( -- ) ftime click-time f! ;
[IFUNDEF] togglekb : togglekb ; [THEN]
: ?toggle ( -- )
    short? motion-y0 f@ f0= and IF  togglekb need-show off  THEN ;

: do-motion { rows cur old motion xt -- }
    old @ -100 = IF
	cur old !
    ELSE
	cur old @ over old ! swap -
	s>f dpy-h @ s>f rows fm/ f/ fdup motion f! xt execute
    THEN ;

: drag-motion { old motion xt -- } delta-t { f: dt }
    motion f@ rel-drag dt f** f*
    fdup f0< fabs abs-drag dt f* f- 0e fmax IF fnegate THEN
    fdup motion f! fdup f0<> IF  xt execute  ELSE  fdrop  THEN
    -100 old ! ;

: screen-slide ( -- )
    *input >r
    r@ IF
	r@ action @ \ dup -1 <> IF  dup . delta-t f. cr  THEN
	case  2 of
		rows r@ y0 @ last-y0 motion-y0 ['] +scroll do-motion
		long? IF  kbflag @ IF  togglekb  THEN  THEN








>
|
>



<
<
<
<
<







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








261
262
263
264
265
266
267
268
269
270
271
272
273





274
275
276
277
278
279
280



































281
282
283
284
285
286
287

    getwh  >screen-orientation
    need-sync on ;
\    ." config changed to: " w ? h ? cr

\ Google is stupid: This event comes too early
\ Make Gforth sync the screen up to four times till the config really changes
:noname
    [IFDEF] android 4 [ELSE] 1 [THEN] 0 DO
	dpy-w @ dpy-h @ config-changer dpy-w @ dpy-h @ d<> screen-sync ?LEAVE
    LOOP
    config-changer form-chooser screen-sync ;
is config-changed






: scroll-yr ( -- float )  scroll-y @ s>f
    y-pos sf@ f2/ rows fm* f+ ;

: +scroll ( -- )
    scroll-yr f+ videorows 1 - s>f fmin
    0e fmax screen-scroll ;




































: screen-slide ( -- )
    *input >r
    r@ IF
	r@ action @ \ dup -1 <> IF  dup . delta-t f. cr  THEN
	case  2 of
		rows r@ y0 @ last-y0 motion-y0 ['] +scroll do-motion
		long? IF  kbflag @ IF  togglekb  THEN  THEN
︙︙
356
357
358
359
360
361
362
363
364
365
366
367
368
369


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

:noname  defers window-init ['] TerminalShader recompile-shader
    term-init config-changer ; IS window-init

window-init

previous \ remove opengl from search order
[IFDEF] android  previous  [THEN]








<
|



|
<

315
316
317
318
319
320
321

322
323
324
325
326



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


:noname  defers window-init term-init config-changer ; IS window-init

window-init

previous previous \ remove opengl from search order
Deleted gles2/.libs/libopenvg.so.

cannot compute difference between binary files

Deleted gles2/.libs/libpng.so.

cannot compute difference between binary files

Changes to gles2/.libs/libsoil.so.

cannot compute difference between binary files

Changes to gles2/android.fs.
︙︙
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328













329
330

	APP_CMD_START of [: ." app start" cr ;] $err endof
	APP_CMD_STOP of [: ." app stop" cr ;] $err endof
	dup [: ." app cmd " . cr ;] $err
    endcase ; is acmd

also jni

:noname ( event type -- )
    >o
    getAction dup 2 = IF  drop ."
	getKeyCode dup 0= IF
	    drop getCharacters jstring>sstring unkeys jfree
	ELSE
	    keycode>keys unkeys
	THEN
    ELSE
	0= IF  getUnicodeChar dup 0>
	    IF    >xstring unkeys
	    ELSE  drop  getKeyCode  keycode>keys  unkeys
	    THEN
	THEN
    THEN o> ; is akey














previous previous set-current








|
<
|











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



307
308
309
310
311
312
313
314

315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342

	APP_CMD_START of [: ." app start" cr ;] $err endof
	APP_CMD_STOP of [: ." app stop" cr ;] $err endof
	dup [: ." app cmd " . cr ;] $err
    endcase ; is acmd

also jni

: android-key ( event -- )

    >o getAction dup 2 = IF  drop ."
	getKeyCode dup 0= IF
	    drop getCharacters jstring>sstring unkeys jfree
	ELSE
	    keycode>keys unkeys
	THEN
    ELSE
	0= IF  getUnicodeChar dup 0>
	    IF    >xstring unkeys
	    ELSE  drop  getKeyCode  keycode>keys  unkeys
	    THEN
	THEN
    THEN o> ;

Defer android-touch ( event -- )
' drop IS android-touch

Defer android-location ( location -- )
' drop IS android-location

:noname ( event type -- )
    CASE
	0 OF  android-key       ENDOF
	1 OF  android-touch     ENDOF
	2 OF  android-location  ENDOF
    ENDCASE  drop ; is akey

previous previous set-current
Changes to gles2/ftgl-helper.fs. 
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18

\ freetype GL example

\ needs wide char arguments

Variable wide$
Variable widec


: >wide$ ( addr u -- addr' u' )  s" " wide$ $!
    over + swap ?DO
        I xc@+ widec l! widec 4 wide$ $+!
    I - +LOOP  wide$ $@ ;

\ freetype stuff

require freetype-gl.fs

also freetype-gl
also opengl








>
|
<
<
|








1
2
3
4
5
6
7
8
9


10
11
12
13
14
15
16
17

\ freetype GL example

\ needs wide char arguments

Variable wide$
Variable widec

: >widec ( char -- ) widec l! widec 4 wide$ $+! ;
: >wide$ ( addr u -- addr' )  s" " wide$ $!


    bounds ?DO  I xc@+ >widec  I - +LOOP  0 >widec  wide$ $@ drop ;

\ freetype stuff

require freetype-gl.fs

also freetype-gl
also opengl
︙︙
89
90
91
92
93
94
95
96

97

98
99
100
101
102
103
104
105
106
107
108
109
110
111

    fover f- fnegate fd fmin fswap fh fmax ;

: layout-string ( addr u -- fw fh fd ) \ depth is ow far it goes down
    0 -rot  0e 0e 0e  bounds ?DO
	I xc@+ swap >r xchar@xy r>
    I - +LOOP  drop ;

: load-glyphs ( -- )

    font

    "#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\0" >wide$ drop texture_font_load_glyphs drop ;

program init

: <render ( -- )
    program glUseProgram
    1-bias set-color+
    .01e 100e 100e >ap
    atlas-tex v0 i0 ;

: render> ( -- )  GL_TRIANGLES draw-elements
    ( Coloradd 0e fdup fdup fdup glUniform4f ) ;

previous previous








|
>
|
>
|














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

    fover f- fnegate fd fmin fswap fh fmax ;

: layout-string ( addr u -- fw fh fd ) \ depth is ow far it goes down
    0 -rot  0e 0e 0e  bounds ?DO
	I xc@+ swap >r xchar@xy r>
    I - +LOOP  drop ;

: load-glyph$ ( addr u -- ) >wide$
    font swap texture_font_load_glyphs drop ;

: load-ascii ( -- )
    "#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" load-glyph$ ;

program init

: <render ( -- )
    program glUseProgram
    1-bias set-color+
    .01e 100e 100e >ap
    atlas-tex v0 i0 ;

: render> ( -- )  GL_TRIANGLES draw-elements
    ( Coloradd 0e fdup fdup fdup glUniform4f ) ;

previous previous
Changes to gles2/gl-helper.fs. 
1
2
3
4
5
6
7




8
9
10
11
12
13
14

\ opengl common stuff

require unix/mmap.fs
require mini-oof2.fs

: w, ( n -- )  here 2 allot w! ;
: l, ( n -- )  here 4 allot l! ;





s" os-type" environment? [IF]
    2dup s" linux-android" str= [IF] 2drop
	require opengl.fs
	
	also opengl
	








>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

\ opengl common stuff

require unix/mmap.fs
require mini-oof2.fs

: w, ( n -- )  here 2 allot w! ;
: l, ( n -- )  here 4 allot l! ;

Variable dpy-w
Variable dpy-h
0 Value ctx

s" os-type" environment? [IF]
    2dup s" linux-android" str= [IF] 2drop
	require opengl.fs
	
	also opengl
︙︙
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

	    s" precision mediump float;        // required for GLES 2.0" ;
    [ELSE]
	s" linux-gnu" str= [IF]
	    require opengl/opengl.fs
	    
	    also opengl
	
	    require opengl/linux.fs
	    also \ same voc stack effect as on android

	    align here
	    GLX_SAMPLE_BUFFERS  l, 1 l,
	    GLX_SAMPLES         l, 4 l,
	    here
	    GLX_RED_SIZE        l, 8 l,
	    GLX_GREEN_SIZE      l, 8 l,








|
<








44
45
46
47
48
49
50
51

52
53
54
55
56
57
58

	    s" precision mediump float;        // required for GLES 2.0" ;
    [ELSE]
	s" linux-gnu" str= [IF]
	    require opengl/opengl.fs
	    
	    also opengl
	
	    require opengl/linux.fs \ same voc stack effect as on android


	    align here
	    GLX_SAMPLE_BUFFERS  l, 1 l,
	    GLX_SAMPLES         l, 4 l,
	    here
	    GLX_RED_SIZE        l, 8 l,
	    GLX_GREEN_SIZE      l, 8 l,
︙︙
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

	: add-precision s" " ;
    [THEN]
[THEN]

Variable configs
Variable numconfigs
Variable eglformat
Variable dpy-w
Variable dpy-h

: ??gl .s ." gl: " glGetError . ; ' ??gl is printdebugdata

[IFDEF] android
    : win app window @ ;
    
    0 Value egldpy
    0 Value surface
    0 Value eglcontext
    
    : getwh ( -- )
	egldpy surface EGL_WIDTH dpy-w eglQuerySurface drop
	egldpy surface EGL_HEIGHT dpy-h eglQuerySurface drop
	0 0 dpy-w @ dpy-h @ glViewport ;

    : >screen-orientation ( -- )








<
<








<








68
69
70
71
72
73
74


75
76
77
78
79
80
81
82

83
84
85
86
87
88
89

	: add-precision s" " ;
    [THEN]
[THEN]

Variable configs
Variable numconfigs
Variable eglformat



: ??gl .s ." gl: " glGetError . ; ' ??gl is printdebugdata

[IFDEF] android
    : win app window @ ;
    
    0 Value egldpy
    0 Value surface

    
    : getwh ( -- )
	egldpy surface EGL_WIDTH dpy-w eglQuerySurface drop
	egldpy surface EGL_HEIGHT dpy-h eglQuerySurface drop
	0 0 dpy-w @ dpy-h @ glViewport ;

    : >screen-orientation ( -- )
︙︙
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

		." default config only" EXIT
	    THEN
	THEN ;
    
    : create-context ( -- )
	win 0 0 eglformat ANativeWindow_setBuffersGeometry drop
	egldpy configs @ win 0 eglCreateWindowSurface to surface
	egldpy configs @ 0 eglattribs eglCreateContext to eglcontext
	egldpy surface dup eglcontext eglMakeCurrent drop ;

    : sync ( -- )
	egldpy surface eglSwapBuffers drop ;
[THEN]

[IFDEF] linux
    fpath+ gles2
    0 Value visual
    0 Value ctx

    \ I have no luck with glXChooseVisual - this is a replacement:
    Variable nitems
    Variable val
    : glXVisual? ( visinfo attrib -- flag ) true { flag }
	BEGIN  dup l@  WHILE
		2dup dpy -rot l@ val glXGetConfig drop
		dup 4 + l@ val @ u<= flag and to flag
		8 +
	REPEAT  2drop flag ;
    
    : glXChooseVisual' ( dpy screen attrib -- ) { attrib }
	pad nitems XGetVisualInfo nitems @ XVisualInfo * bounds ?DO
	    I attrib glXVisual?  IF  I unloop  EXIT  THEN
	XVisualInfo +LOOP 0 ;
    
    : choose-config ( -- )
	get-display dpy-h ! dpy-w !
	dpy screen attrib3 glXChooseVisual' dup 0= IF  drop
	    dpy screen attrib2 glXChooseVisual' dup 0= IF  drop
		dpy screen attrib glXChooseVisual' dup
		0= abort" Unable to choose Visual"
	    THEN
	THEN  to visual ;

    : create-context ( -- )
	default-events "GL-Window\0" drop dpy-w @ dpy-h @ simple-win
	dpy visual 0 1 glXCreateContext to ctx
	dpy win ctx glXMakeCurrent drop ;

    : getwh ( -- )
	0 0 dpy-w @ dpy-h @ glViewport ;

    : >screen-orientation ;

    : sync ( -- )
	dpy win glXSwapBuffers ;
[THEN]

: init-opengl ( -- )








|
|








<
















|








|




<
<
<








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

		." default config only" EXIT
	    THEN
	THEN ;
    
    : create-context ( -- )
	win 0 0 eglformat ANativeWindow_setBuffersGeometry drop
	egldpy configs @ win 0 eglCreateWindowSurface to surface
	egldpy configs @ 0 eglattribs eglCreateContext to ctx
	egldpy surface dup ctx eglMakeCurrent drop ;

    : sync ( -- )
	egldpy surface eglSwapBuffers drop ;
[THEN]

[IFDEF] linux
    fpath+ gles2
    0 Value visual


    \ I have no luck with glXChooseVisual - this is a replacement:
    Variable nitems
    Variable val
    : glXVisual? ( visinfo attrib -- flag ) true { flag }
	BEGIN  dup l@  WHILE
		2dup dpy -rot l@ val glXGetConfig drop
		dup 4 + l@ val @ u<= flag and to flag
		8 +
	REPEAT  2drop flag ;
    
    : glXChooseVisual' ( dpy screen attrib -- ) { attrib }
	pad nitems XGetVisualInfo nitems @ XVisualInfo * bounds ?DO
	    I attrib glXVisual?  IF  I unloop  EXIT  THEN
	XVisualInfo +LOOP 0 ;
    
    : choose-config ( -- ) \ visual ?EXIT
	get-display dpy-h ! dpy-w !
	dpy screen attrib3 glXChooseVisual' dup 0= IF  drop
	    dpy screen attrib2 glXChooseVisual' dup 0= IF  drop
		dpy screen attrib glXChooseVisual' dup
		0= abort" Unable to choose Visual"
	    THEN
	THEN  to visual ;

    : create-context ( -- ) \ win ?EXIT
	default-events "GL-Window\0" drop dpy-w @ dpy-h @ simple-win
	dpy visual 0 1 glXCreateContext to ctx
	dpy win ctx glXMakeCurrent drop ;




    : >screen-orientation ;

    : sync ( -- )
	dpy win glXSwapBuffers ;
[THEN]

: init-opengl ( -- )
︙︙
310
311
312
313
314
315
316


317
318
319
320
321
322
323

0 Value LightPos
0 Value Texture
0 Value ambient
0 Value Coloradd
0 Value program

: create-program { vs-xt fs-xt -- program }


    glCreateProgram dup >r IF
	r@ vs-xt execute glAttachShader
	r@ fs-xt execute glAttachShader
	vs-xt r@ >bindattrib
	r@ glLinkProgram THEN
    r> ;









>
>








306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321

0 Value LightPos
0 Value Texture
0 Value ambient
0 Value Coloradd
0 Value program

: create-program { vs-xt fs-xt -- program }
    vs-xt recompile-shader
    fs-xt recompile-shader
    glCreateProgram dup >r IF
	r@ vs-xt execute glAttachShader
	r@ fs-xt execute glAttachShader
	vs-xt r@ >bindattrib
	r@ glLinkProgram THEN
    r> ;
︙︙
390
391
392
393
394
395
396



397
398
399
400
401
402
403

	I 4 sfloats bounds DO
	    I sf@ f.
	1 sfloats +LOOP cr
    4 sfloats +LOOP ;

: set-matrix ( addr handle -- ) swap >r
    1 false r> glUniformMatrix4fv ;




: set-color+ ( addr -- )  Coloradd 1 rot glUniform4fv ;

: >ortho { f: near f: far f: left f: right f: top f: bottom -- }
    ap-matrix
    near f2* right left f- f/ sf!+ 0e sf!+ 0e sf!+ 0e sf!+
    0e sf!+ near f2* top bottom f- f/ sf!+ 0e sf!+ 0e sf!+








>
>
>








388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404

	I 4 sfloats bounds DO
	    I sf@ f.
	1 sfloats +LOOP cr
    4 sfloats +LOOP ;

: set-matrix ( addr handle -- ) swap >r
    1 false r> glUniformMatrix4fv ;

: >x-pos ( r -- ) x-pos sf!  unit-matrix MVPMatrix set-matrix ;
: >y-pos ( r -- ) y-pos sf!  unit-matrix MVPMatrix set-matrix ;

: set-color+ ( addr -- )  Coloradd 1 rot glUniform4fv ;

: >ortho { f: near f: far f: left f: right f: top f: bottom -- }
    ap-matrix
    near f2* right left f- f/ sf!+ 0e sf!+ 0e sf!+ 0e sf!+
    0e sf!+ near f2* top bottom f- f/ sf!+ 0e sf!+ 0e sf!+
︙︙
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640











































641

: f>c ( r g b a -- )  c.a sf! c.b sf! c.g sf! c.r sf! ;
: n>xyz ( x y z -- ) n.z sf! n.y sf! n.x sf! 1e n.t sf! ;
: n> ( -- ) -1e n.z sf! 0e n.y sf! 0e n.x sf! 1e n.t sf! ;
: >st ( s t -- ) t.t sf! t.s sf! ;

\ window closed/reopened

: recompile-shaders ( -- )
    ['] VertexShader recompile-shader
    ['] FragmentShader recompile-shader ;

: helper-init  init-opengl texture-init recompile-shaders
    ['] VertexShader ['] FragmentShader create-program to program
    program init  buffer-init ;

:noname  defers window-init helper-init ; IS window-init

\ click region stuff

: click-regions ( w h -- x' y' )  >r >r
    *input x0 @ r> dpy-w @ */
    *input y0 @ r> dpy-h @ */ ;












































previous








<
<
<
<
|











>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


619
620
621
622
623
624
625




626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681

: f>c ( r g b a -- )  c.a sf! c.b sf! c.g sf! c.r sf! ;
: n>xyz ( x y z -- ) n.z sf! n.y sf! n.x sf! 1e n.t sf! ;
: n> ( -- ) -1e n.z sf! 0e n.y sf! 0e n.x sf! 1e n.t sf! ;
: >st ( s t -- ) t.t sf! t.s sf! ;

\ window closed/reopened





: helper-init  init-opengl texture-init
    ['] VertexShader ['] FragmentShader create-program to program
    program init  buffer-init ;

:noname  defers window-init helper-init ; IS window-init

\ click region stuff

: click-regions ( w h -- x' y' )  >r >r
    *input x0 @ r> dpy-w @ */
    *input y0 @ r> dpy-h @ */ ;

\ toggle and drag time stuff

: ftime ( -- r ) ntime d>f 1e-9 f* ;

0.5e FConstant rel-drag
0.3e FConstant abs-drag
FVariable drag-time
: f!@ ( r1 addr -- r2 ) dup f@ fswap f! ;
: delta-t ( -- r )
    ftime fdup drag-time f!@ f- fdup 1e f> IF  fdrop 0e  THEN ;

Fvariable click-time
FVariable motion-x0
FVariable motion-y0
Variable last-x0  -100 last-x0 !
Variable last-y0  -100 last-y0 !
0.15e FConstant short-click#
0.5e  FConstant long-click#

: delta-tc  ftime click-time f@ f- ;
: short? ( -- flag )
    delta-tc short-click# f< ;
: long? ( -- flag )
    delta-tc long-click# f> ;
: !click ( -- ) ftime click-time f! ;
[IFUNDEF] togglekb : togglekb ; [THEN]
: ?toggle ( -- )
    short? motion-y0 f@ f0= and IF  togglekb need-show off  THEN ;

: do-motion { rows cur old motion xt -- }
    old @ -100 = IF
	cur old !
    ELSE
	cur old @ over old ! swap -
	s>f dpy-h @ s>f rows fm/ f/ fdup motion f! xt execute
    THEN ;

: drag-motion { old motion xt -- } delta-t { f: dt }
    motion f@ rel-drag dt f** f*
    fdup f0< fabs abs-drag dt f* f- 0e fmax IF fnegate THEN
    fdup motion f! fdup f0<> IF  xt execute  ELSE  fdrop  THEN
    -100 old ! ;

previous
Changes to gles2/gl-sample.fs.
︙︙
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

    v0 colors'
    ascii-tex
    GL_TRIANGLES draw-elements
    sync
    2drop \ ntime d- dnegate ." Frame time: " d. cr
    >looper
    *input >r r@ IF
	r@ action @ 2 = IF
	    \ ." Touch at " r@ x0 ? r@ y0 ? cr
	    \ r@ x0 @ 20 < r@ y0 @ 20 < and IF -1 (bye) THEN
	    r@ x0 @ dpy-w @ 2/ - s>f dpy-h @ 2/ fm/
	    r@ y0 @ dpy-h @ 2/ - s>f dpy-h @ 2/ fm/
	    fover fover fnegate -0.15e lightpos glUniform3f
	    fatan2
	    touch f@ -100e f= IF








|








69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

    v0 colors'
    ascii-tex
    GL_TRIANGLES draw-elements
    sync
    2drop \ ntime d- dnegate ." Frame time: " d. cr
    >looper
    *input >r r@ IF
	r@ pressure @ 0> IF
	    \ ." Touch at " r@ x0 ? r@ y0 ? cr
	    \ r@ x0 @ 20 < r@ y0 @ 20 < and IF -1 (bye) THEN
	    r@ x0 @ dpy-w @ 2/ - s>f dpy-h @ 2/ fm/
	    r@ y0 @ dpy-h @ 2/ - s>f dpy-h @ 2/ fm/
	    fover fover fnegate -0.15e lightpos glUniform3f
	    fatan2
	    touch f@ -100e f= IF
︙︙
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114


115

	    ambient% sf@ 0.05e f- 0.5e fmax ambient% sf!
	ELSE
	    ambient% sf@ 0.05e f+ 1.0e fmin ambient% sf!
	    angle motion f@ f+ to angle
	    motion f@ 0.01e f- 0.95e f* 0.01e f+ motion f!
	    -100e touch f!
	THEN
	." Motion: " motion f@ f. cr 0 -1 at-deltaxy
	r@ action off
    THEN
    rdrop angle ;

: tri-loop ( -- ) 1 level# +! 0e  BEGIN draw-tri level# @ 0= UNTIL fdrop ;

: gl-sample ( -- )
    ['] VertexShader ['] FragmentShader create-program to program
    program init load-textures .info
    tri-loop ;

previous previous



gl-sample








|
<





|






>
>


94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

	    ambient% sf@ 0.05e f- 0.5e fmax ambient% sf!
	ELSE
	    ambient% sf@ 0.05e f+ 1.0e fmin ambient% sf!
	    angle motion f@ f+ to angle
	    motion f@ 0.01e f- 0.95e f* 0.01e f+ motion f!
	    -100e touch f!
	THEN
	\ ." Motion: " motion f@ f. cr 0 -1 at-deltaxy

    THEN
    rdrop angle ;

: tri-loop ( -- ) 1 level# +! 0e  BEGIN draw-tri level# @ 0= UNTIL fdrop ;

: gl-sample ( -- ) [IFDEF] hidekb  hidekb [THEN]
    ['] VertexShader ['] FragmentShader create-program to program
    program init load-textures .info
    tri-loop ;

previous previous

win 0= [IF] window-init [THEN]

gl-sample
Changes to gles2/gl-terminal.fs. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

\ OpenGL terminal

require ansi.fs \ we may want to support colorize.fs

\ opengl common stuff

require gl-helper.fs

[IFDEF] android  also android [THEN]

GL_FRAGMENT_SHADER shader: TerminalShader
#precision
uniform vec3 u_LightPos;        // The position of the light in eye space.
uniform sampler2D u_Texture;    // The input texture.
uniform float u_Ambient;        // ambient lighting level
uniform sampler2D u_Charmap;    // The character map









|








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

\ OpenGL terminal

require ansi.fs \ we may want to support colorize.fs

\ opengl common stuff

require gl-helper.fs

also [IFDEF] android android [THEN]

GL_FRAGMENT_SHADER shader: TerminalShader
#precision
uniform vec3 u_LightPos;        // The position of the light in eye space.
uniform sampler2D u_Texture;    // The input texture.
uniform float u_Ambient;        // ambient lighting level
uniform sampler2D u_Charmap;    // The character map
︙︙
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

    count s>f $FF fm/
    count s>f $FF fm/
    count s>f $FF fm/
    c@    s>f $FF fm/ glClearColor ;

: std-bg! ( index -- )  dup bg! dup std-bg ! bg>clear ;

7 std-bg! 0 fg!



128 Value videocols
1   Value videorows

2Variable gl-xy  0 0 gl-xy 2!
2Variable gl-wh 24 80 gl-wh 2!
Variable gl-lineend
Variable scroll-y
FVariable scroll-dest
FVariable scroll-source
FVariable scroll-time

: ftime ( -- r ) ntime d>f 1e-9 f* ;

: form-chooser ( -- )
    dpy-w @ dpy-h @ > IF  24 80  ELSE  40 48  THEN  gl-wh 2! ;

: show-rows ( -- n ) videorows scroll-y @ - rows 1+ min ;
: nextpow2 ( n -- n' )
    1 BEGIN  2dup u>  WHILE 2*  REPEAT  nip ;









|
>
>












<
<








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

    count s>f $FF fm/
    count s>f $FF fm/
    count s>f $FF fm/
    c@    s>f $FF fm/ glClearColor ;

: std-bg! ( index -- )  dup bg! dup std-bg ! bg>clear ;

: >white White std-bg! Black fg! ;
: >black Black std-bg! White fg! ;
>white

128 Value videocols
1   Value videorows

2Variable gl-xy  0 0 gl-xy 2!
2Variable gl-wh 24 80 gl-wh 2!
Variable gl-lineend
Variable scroll-y
FVariable scroll-dest
FVariable scroll-source
FVariable scroll-time



: form-chooser ( -- )
    dpy-w @ dpy-h @ > IF  24 80  ELSE  40 48  THEN  gl-wh 2! ;

: show-rows ( -- n ) videorows scroll-y @ - rows 1+ min ;
: nextpow2 ( n -- n' )
    1 BEGIN  2dup u>  WHILE 2*  REPEAT  nip ;
︙︙
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203


    v0 >rectangle >texcoords
    GL_TEXTURE0 glActiveTexture
    chars-tex
    i0 0 i, 1 i, 2 i, 0 i, 2 i, 3 i,
    GL_TRIANGLES draw-elements ;

: >x-pos ( r -- ) x-pos sf!  unit-matrix MVPMatrix set-matrix ;
: >y-pos ( r -- ) y-pos sf!  unit-matrix MVPMatrix set-matrix ;

: screen-scroll ( r -- )  fdup floor fdup f>s scroll-y ! f-
    f2* rows fm/ >y-pos  need-sync on ;

: gl-char' ( -- addr )
    gl-xy 2@ videocols * + sfloats videomem + ;

: gl-form ( -- h w ) gl-wh 2@ ;








<
<
<








187
188
189
190
191
192
193



194
195
196
197
198
199
200


    v0 >rectangle >texcoords
    GL_TEXTURE0 glActiveTexture
    chars-tex
    i0 0 i, 1 i, 2 i, 0 i, 2 i, 3 i,
    GL_TRIANGLES draw-elements ;




: screen-scroll ( r -- )  fdup floor fdup f>s scroll-y ! f-
    f2* rows fm/ >y-pos  need-sync on ;

: gl-char' ( -- addr )
    gl-xy 2@ videocols * + sfloats videomem + ;

: gl-form ( -- h w ) gl-wh 2@ ;
︙︙
264
265
266
267
268
269
270

271

272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328

    getwh  >screen-orientation
    need-sync on ;
\    ." config changed to: " w ? h ? cr

\ Google is stupid: This event comes too early
\ Make Gforth sync the screen up to four times till the config really changes
:noname

    4 0 DO  dpy-w @ dpy-h @ config-changer dpy-w @ dpy-h @ d<> screen-sync ?LEAVE LOOP

    config-changer form-chooser screen-sync ;
is config-changed

Variable last-x0  -100 last-x0 !
Variable last-y0  -100 last-y0 !
FVariable motion-x0
FVariable motion-y0

: scroll-yr ( -- float )  scroll-y @ s>f
    y-pos sf@ f2/ rows fm* f+ ;

: +scroll ( -- )
    scroll-yr f+ videorows 1 - s>f fmin
    0e fmax screen-scroll ;

0.5e FConstant rel-drag
0.3e FConstant abs-drag
FVariable drag-time
: f!@ ( r1 addr -- r2 ) dup f@ fswap f! ;
: delta-t ( -- r )
    ftime fdup drag-time f!@ f- fdup 1e f> IF  fdrop 0e  THEN ;

Fvariable click-time
0.15e FConstant short-click#
0.5e  FConstant long-click#

: delta-tc  ftime click-time f@ f- ;
: short? ( -- flag )
    delta-tc short-click# f< ;
: long? ( -- flag )
    delta-tc long-click# f> ;
: !click ( -- ) ftime click-time f! ;
[IFUNDEF] togglekb : togglekb ; [THEN]
: ?toggle ( -- )
    short? motion-y0 f@ f0= and IF  togglekb need-show off  THEN ;

: do-motion { rows cur old motion xt -- }
    old @ -100 = IF
	cur old !
    ELSE
	cur old @ over old ! swap -
	s>f dpy-h @ s>f rows fm/ f/ fdup motion f! xt execute
    THEN ;

: drag-motion { old motion xt -- } delta-t { f: dt }
    motion f@ rel-drag dt f** f*
    fdup f0< fabs abs-drag dt f* f- 0e fmax IF fnegate THEN
    fdup motion f! fdup f0<> IF  xt execute  ELSE  fdrop  THEN
    -100 old ! ;

: screen-slide ( -- )
    *input >r
    r@ IF
	r@ action @ \ dup -1 <> IF  dup . delta-t f. cr  THEN
	case  2 of
		rows r@ y0 @ last-y0 motion-y0 ['] +scroll do-motion
		long? IF  kbflag @ IF  togglekb  THEN  THEN








>
|
>



<
<
<
<
<







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








261
262
263
264
265
266
267
268
269
270
271
272
273





274
275
276
277
278
279
280



































281
282
283
284
285
286
287

    getwh  >screen-orientation
    need-sync on ;
\    ." config changed to: " w ? h ? cr

\ Google is stupid: This event comes too early
\ Make Gforth sync the screen up to four times till the config really changes
:noname
    [IFDEF] android 4 [ELSE] 1 [THEN] 0 DO
	dpy-w @ dpy-h @ config-changer dpy-w @ dpy-h @ d<> screen-sync ?LEAVE
    LOOP
    config-changer form-chooser screen-sync ;
is config-changed






: scroll-yr ( -- float )  scroll-y @ s>f
    y-pos sf@ f2/ rows fm* f+ ;

: +scroll ( -- )
    scroll-yr f+ videorows 1 - s>f fmin
    0e fmax screen-scroll ;




































: screen-slide ( -- )
    *input >r
    r@ IF
	r@ action @ \ dup -1 <> IF  dup . delta-t f. cr  THEN
	case  2 of
		rows r@ y0 @ last-y0 motion-y0 ['] +scroll do-motion
		long? IF  kbflag @ IF  togglekb  THEN  THEN
︙︙
356
357
358
359
360
361
362
363
364
365
366
367
368
369


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

:noname  defers window-init ['] TerminalShader recompile-shader
    term-init config-changer ; IS window-init

window-init

previous \ remove opengl from search order
[IFDEF] android  previous  [THEN]








<
|



|
<

315
316
317
318
319
320
321

322
323
324
325
326



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


:noname  defers window-init term-init config-changer ; IS window-init

window-init

previous previous \ remove opengl from search order
Changes to gles2/jni-helper.fs. 
1
2
3
4
5
6
7
8
9
10
11




12
13
14
15
16
17
18

\ show/hide keyboard using jni tools

require jni-tools.fs

also android also jni

app activity @ ANativeActivity-clazz @ dup Value clazz
env tuck JNIEnv-getObjectClass() to jniclass

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




jni-method: getSystemService getSystemService (Ljava/lang/String;)Ljava/lang/Object;
jni-method: getWindow getWindow ()Landroid/view/Window;

jni-class: android/app/Activity
jni-method: getWindowManager getWindowManager ()Landroid/view/WindowManager;

jni-class: android/view/WindowManager










|
|
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

\ show/hide keyboard using jni tools

require jni-tools.fs

also android also jni

app activity @ ANativeActivity-clazz @ dup Value clazz
env tuck JNIEnv-getObjectClass() to jniclass

\ jni-sfield: INPUT_METHOD_SERVICE INPUT_METHOD_SERVICE Ljava/lang/String;
\ jni-sfield: POWER_SERVICE POWER_SERVICE Ljava/lang/String;
: INPUT_METHOD_SERVICE js" input_method" ;
: POWER_SERVICE        js" power" ;
: LOCATION_SERVICE     js" location" ;

jni-method: getSystemService getSystemService (Ljava/lang/String;)Ljava/lang/Object;
jni-method: getWindow getWindow ()Landroid/view/Window;

jni-class: android/app/Activity
jni-method: getWindowManager getWindowManager ()Landroid/view/WindowManager;

jni-class: android/view/WindowManager
︙︙
Added gles2/jni-location.fs. 
























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

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

\ location services

also jni

jni-class: android/location/Location

jni-method: getAccuracy getAccuracy ()F
jni-method: getAltitude getAltitude ()D
jni-method: getBearing getBearing ()F
jni-method: getAltitude getAltitude ()D
jni-method: getLatitude getLatitude ()D
jni-method: getLongitude getLongitude ()D
jni-method: getProvider getProvider ()Ljava/lang/String;
jni-method: getSpeed getSpeed ()F
jni-method: getTime getTime ()J

jni-class: android/location/LocationManager

jni-method: getAllProviders getAllProviders ()Ljava/util/List;
jni-method: getProviders getProviders (Z)Ljava/util/List;
jni-method: getProvider getProvider (Ljava/lang/String;)Landroid/location/LocationProvider;
jni-method: requestLocationUpdates requestLocationUpdates (Ljava/lang/String;JFLandroid/location/LocationListener;)V
jni-method: getLastKnownLocation getLastKnownLocation (Ljava/lang/String;)Landroid/location/Location;
jni-method: removeUpdates removeUpdates (Landroid/location/LocationListener;)V


previous
Added gles2/libcc.android. 










































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

#!/bin/bash

ENGINE=gforth-x32
KERNL=$(gforth-x32 --debug -e bye 2>&1 |grep "Opened image file: "|sed -e 's/Opened image file: //g' -e 's/gforth.fi/kernl*.fi/g')
VERSION=$($ENGINE --version 2>&1 | tr ' ' '/')
srcdir=.
DESTDIR=/home/bernd/proj/net2o
prefix= 
ARCH=""
exec_prefix=${prefix}
libexecdir=$package${exec_prefix}/lib
libccdir=$libexecdir/$VERSION/libcc-named/
LIBRARY="opengl.fs android.fs png.fs soillib.fs openmax.fs jni.fs freetype-gl.fs" #  openvglib.fs
ANDROID=${ANDROID-~/proj/gforths/gforth-android}

for i in $LIBRARY
do
    echo "generating library $i"
    $ENGINE -i $KERNL -p ".:~+:$ANDROID" exboot.fs startup.fs -e ": android ;" -e "also c-lib s\" `pwd`/lib/$VERSION/libcc-named/\" >libcc-named-dir libcc-path clear-path libcc-named-dir libcc-path also-path :noname 2drop s\" $DESTDIR$libccdir\" ; is replace-rpath previous" $srcdir/$i -e bye
done
Changes to gles2/omx-example.fs.
︙︙
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191

: start-file ( -- )
    setup-player  true init-enqueue  ppause pvol# pvol ;

also opengl

0 Value oes-program

: omx-init create-oes-program to oes-program ;

also android

\ vertices


0.005e Fconstant m-lr








|








177
178
179
180
181
182
183
184
185
186
187
188
189
190
191

: start-file ( -- )
    setup-player  true init-enqueue  ppause pvol# pvol ;

also opengl

0 Value oes-program

: omx-init ( -- ) create-oes-program to oes-program ;

also android

\ vertices


0.005e Fconstant m-lr
︙︙
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220

    >v
    rx m-lr f2* f- -0.96e >xy n> r% m-lr f- 0.98e >st c 0e -c 1e f>c v+
    rx             -0.9e  >xy n> r%         0.95e >st -c c 0e 1e f>c v+
    rx m-lr f2* f+ -0.96e >xy n> r% m-lr f+ 0.98e >st 0e -c c 1e f>c v+
    v> 4 i, 5 i, 6 i, ;

: rectangle ( -- )
    >v
    -1e  1e >xy n> 0e 0e >st  $000000FF rgba>c v+
     1e  1e >xy n> 1e 0e >st  $000000FF rgba>c v+
     1e -1e >xy n> 1e 1e >st  $000000FF rgba>c v+
    -1e -1e >xy n> 0e 1e >st  $000000FF rgba>c v+
    v> 0 i, 1 i, 2 i, 0 i, 2 i, 3 i, ;

\ player








|








206
207
208
209
210
211
212
213
214
215
216
217
218
219
220

    >v
    rx m-lr f2* f- -0.96e >xy n> r% m-lr f- 0.98e >st c 0e -c 1e f>c v+
    rx             -0.9e  >xy n> r%         0.95e >st -c c 0e 1e f>c v+
    rx m-lr f2* f+ -0.96e >xy n> r% m-lr f+ 0.98e >st 0e -c c 1e f>c v+
    v> 4 i, 5 i, 6 i, ;

: rectangle ( -- )
    i>off >v
    -1e  1e >xy n> 0e 0e >st  $000000FF rgba>c v+
     1e  1e >xy n> 1e 0e >st  $000000FF rgba>c v+
     1e -1e >xy n> 1e 1e >st  $000000FF rgba>c v+
    -1e -1e >xy n> 0e 1e >st  $000000FF rgba>c v+
    v> 0 i, 1 i, 2 i, 0 i, 2 i, 3 i, ;

\ player
︙︙
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315

	    utime lastseek 2@ delta-seek d+ du> IF
		5 3 click-regions
		2dup 2 1 d= IF  pplay? IF
			ppause
			get-deltat mkv-time-off f! 0e first-timestamp f!
		    ELSE pplay THEN  THEN
		dup 2 = IF
		    r@ x0 @ s>f w @ fm/ 1.1e f* 0.05e f- 0e fmax 1e fmin
		    pplay? IF  ppause  THEN
		    queue-flush  >pos  true init-enqueue pplay
		THEN
		2drop
		utime lastseek 2!
	    THEN
	THEN  r@ action off
    THEN
    rdrop ;

: play-loop ( -- ) hidekb
    screen+keep pplay
    omx-init 1 level# +!
    BEGIN
	draw-frame check-input
	cues>mts-run? 0= pplay? and  IF  ppause  THEN
    level# @ 0= UNTIL
    ppause screen-keep ;
: play-ts ( addr u -- ) ['] read-ts-file is read-ts
    open-mts start-file play-loop ;
: play-mkv ( addr u -- ) ['] pull-queue is read-ts

    'm' emit screen-sync
    <event e$, ->open-mkv 0 elit, ->cues cue-task event>
    'k' emit screen-sync
    start-file
    'v' emit screen-sync
    play-loop stop-player ;
: replay% ( r -- )  >pos  true init-enqueue play-loop ;
: replay ( -- )
    cue-task IF
	<event 0 elit, ->cues cue-task event>
    ELSE
	0. ts-fd reposition-file throw
    THEN
    true init-enqueue play-loop stop-player ;

: gs "/storage/extSdCard/Filme/gangnamstyle.ts" play-ts ;
: jb "/storage/extSdCard/Filme/jb.mkv" play-mkv ;

cue-converter \ start task a bit ahead of game

previous previous previous








|




















|
>















|






266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316

	    utime lastseek 2@ delta-seek d+ du> IF
		5 3 click-regions
		2dup 2 1 d= IF  pplay? IF
			ppause
			get-deltat mkv-time-off f! 0e first-timestamp f!
		    ELSE pplay THEN  THEN
		dup 2 = IF
		    r@ x0 @ s>f dpy-w @ fm/ 1.1e f* 0.05e f- 0e fmax 1e fmin
		    pplay? IF  ppause  THEN
		    queue-flush  >pos  true init-enqueue pplay
		THEN
		2drop
		utime lastseek 2!
	    THEN
	THEN  r@ action off
    THEN
    rdrop ;

: play-loop ( -- ) hidekb
    screen+keep pplay
    omx-init 1 level# +!
    BEGIN
	draw-frame check-input
	cues>mts-run? 0= pplay? and  IF  ppause  THEN
    level# @ 0= UNTIL
    ppause screen-keep ;
: play-ts ( addr u -- ) ['] read-ts-file is read-ts
    open-mts start-file play-loop ;
: play-mkv ( addr u -- )
    ['] pull-queue is read-ts
    'm' emit screen-sync
    <event e$, ->open-mkv 0 elit, ->cues cue-task event>
    'k' emit screen-sync
    start-file
    'v' emit screen-sync
    play-loop stop-player ;
: replay% ( r -- )  >pos  true init-enqueue play-loop ;
: replay ( -- )
    cue-task IF
	<event 0 elit, ->cues cue-task event>
    ELSE
	0. ts-fd reposition-file throw
    THEN
    true init-enqueue play-loop stop-player ;

: gs "/storage/extSdCard/Filme/gangnamstyle.mkv" play-mkv ;
: jb "/storage/extSdCard/Filme/jb.mkv" play-mkv ;

cue-converter \ start task a bit ahead of game

previous previous previous
Added gles2/shlibs/freetype-gl/configure.ac. 


























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

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

## ExampleLib Example: an example of using Automake to link with a library

AC_INIT([freetype-gl], [1.0], [bernd@net2o.de], [freetype-gl for Linux/Android],
        [http://lonesock.net/soil.html])
AC_PREREQ([2.59])
AM_INIT_AUTOMAKE([1.10 -Wall no-define])
AC_CONFIG_MACRO_DIR([m4])
AC_CONFIG_HEADERS([config.h])
AC_PROG_CC
AM_PROG_AR
LT_INIT

case $CC in
     *android*)
	LIBADD="-llog -lglib-android-1.0"
	LIBGL=GLESv2
	;;
     *)
	LIBGL=GL
	;;
esac
AC_SUBST(LIBADD)
AC_SUBST(LIBGL)
LIBTOOL=${CC%gcc}libtool
AC_SUBST(LIBTOOL)

AC_CONFIG_FILES([Makefile])
AC_OUTPUT
Added gles2/shlibs/soil/configure.ac. 


































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

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

## ExampleLib Example: an example of using Automake to link with a library

AC_INIT([SOIL], [1.0], [bernd@net2o.de], [soil for Linux],
        [http://lonesock.net/soil.html])
AC_PREREQ([2.59])
AM_INIT_AUTOMAKE([1.10 -Wall no-define])
AC_CONFIG_MACRO_DIR([m4])
AC_CONFIG_HEADERS([config.h])
AC_PROG_CC
AM_PROG_AR
LT_INIT

LIBTOOL=${CC%gcc}libtool
AC_SUBST(LIBTOOL)
AC_CONFIG_FILES([Makefile])
AC_OUTPUT
Changes to gles2/widgets-test.fs.
︙︙
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81

    f1 >o draw o> f7 >o draw o> f2 >o draw o> f3 >o draw o>
    f8 >o draw o> f4 >o draw o> f5 >o draw o> f6 >o draw o> ;

: widgets-test
    <draw0 draw0>
    <draw1 widgets-draw draw1>
    <draw2 widgets-draw draw2>

    sync ;

also [IFDEF] android android [THEN]

: widgets-demo ( -- ) program init [IFDEF] hidekb  hidekb [THEN]
    1 level# +!  BEGIN  widgets-test >looper  level# @ 0= UNTIL ;

previous








>




|




67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

    f1 >o draw o> f7 >o draw o> f2 >o draw o> f3 >o draw o>
    f8 >o draw o> f4 >o draw o> f5 >o draw o> f6 >o draw o> ;

: widgets-test
    <draw0 draw0>
    <draw1 widgets-draw draw1>
    <draw2 widgets-draw draw2>
    <draw3 widgets-draw draw3>
    sync ;

also [IFDEF] android android [THEN]

: widgets-demo ( -- )  [IFDEF] hidekb  hidekb [THEN]
    1 level# +!  BEGIN  widgets-test >looper  level# @ 0= UNTIL ;

previous
Changes to gles2/widgets.fs.
︙︙
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

    field: parent-w
    field: x
    field: y
    field: w
    field: h \ above baseline
    field: d \ below baseline
    method draw ( -- )
    method hglue

    method vglue
    method hglue@ \ cached variant
    method vglue@ \ cached variant

    method xywh
    method xywhd
    method !size \ set your own size
end-class widget

:noname x @ y @ h @ - w @ h @ d @ + ; widget to xywh
:noname x @ y @ w @ h @ d @ ; widget to xywhd
' noop widget to !size







widget class
    field: child-w
    field: act
    method resized
    method map
end-class box








|
>
|
|
|
>
|
|






>
>
>
>
>
>








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

    field: parent-w
    field: x
    field: y
    field: w
    field: h \ above baseline
    field: d \ below baseline
    method draw ( -- )
    method hglue ( -- typ sub add )
    method dglue ( -- typ sub add )
    method vglue ( -- typ sub add )
    method hglue@ ( -- typ sub add ) \ cached variant
    method dglue@ ( -- typ sub add ) \ cached variant
    method vglue@ ( -- typ sub add ) \ cached variant
    method xywh ( -- x0 y0 w h )
    method xywhd ( -- x y w h d )
    method !size \ set your own size
end-class widget

:noname x @ y @ h @ - w @ h @ d @ + ; widget to xywh
:noname x @ y @ w @ h @ d @ ; widget to xywhd
' noop widget to !size
:noname w @ 0 0 ; widget to hglue
:noname h @ 0 0 ; widget to vglue
:noname d @ 0 0 ; widget to dglue
' hglue widget to hglue@
' vglue widget to vglue@
' dglue widget to dglue@

widget class
    field: child-w
    field: act
    method resized
    method map
end-class box
︙︙
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


widget class
    field: text-string
    field: text-font
    field: text-color
end-class text



: text-draw ( -- ) layer 2 <> ?EXIT




    x @ s>f penxy sf!  y @ s>f penxy sfloat+ sf!
    text-font @ to font  text-color @ color !
    text-string $@ render-string ;
: text-!size ( -- )
    text-string $@ layout-string
    f>s d ! f>s h ! f>s w ! ;
' text-draw text to draw
' text-!size text to !size

\ draw wrapper

: <draw0 ( -- )  0 to layer
    -1e 1e >apxy
    .01e 100e 100e >ap
    0.01e 0.02e 0.15e 1.0e glClearColor
    Ambient 1 ambient% glUniform1fv ;
: draw0> ( -- ) clear v0 i0 ;

: <draw1 ( -- )  1 to layer
    z-bias set-color+
    program glUseProgram  style-tex ;
: draw1> ( -- )  GL_TRIANGLES draw-elements v0 i0 ;

: <draw2 ( -- )  2 to layer


    1-bias set-color+
    program glUseProgram  atlas-tex ;
: draw2> ( -- )  GL_TRIANGLES draw-elements v0 i0 ;

Variable style-i#

: load-style ( addr u -- n )  style-tex
    style-i# @ 8 /mod 128 * >r 128 * r> 2swap load-subtex 2drop
    style-i# @ 1 style-i# +! ;
: style: load-style Create , DOES> @ frame# ! ;

"button.png" style: button1
"button2.png" style: button2
"button3.png" style: button3

previous previous previous set-current








>
>
|
>
>
>
>
|
|
|




















|
>
>


|














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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188


widget class
    field: text-string
    field: text-font
    field: text-color
end-class text

Variable glyphs$

: text-draw ( -- )
    layer 2 = IF
	text-font @ to font text-string $@ glyphs$ $+!
	EXIT  THEN
    layer 3 = IF
	x @ s>f penxy sf!  y @ s>f penxy sfloat+ sf!
	text-font @ to font  text-color @ color !
	text-string $@ render-string THEN ;
: text-!size ( -- )
    text-string $@ layout-string
    f>s d ! f>s h ! f>s w ! ;
' text-draw text to draw
' text-!size text to !size

\ draw wrapper

: <draw0 ( -- )  0 to layer
    -1e 1e >apxy
    .01e 100e 100e >ap
    0.01e 0.02e 0.15e 1.0e glClearColor
    Ambient 1 ambient% glUniform1fv ;
: draw0> ( -- ) clear v0 i0 ;

: <draw1 ( -- )  1 to layer
    z-bias set-color+
    program glUseProgram  style-tex ;
: draw1> ( -- )  GL_TRIANGLES draw-elements v0 i0 ;

: <draw2 ( -- )  2 to layer s" " glyphs$ $! ;
: draw2> ( -- )  glyphs$ $@ load-glyph$ ;
: <draw3 ( -- )  3 to layer
    1-bias set-color+
    program glUseProgram  atlas-tex ;
: draw3> ( -- )  GL_TRIANGLES draw-elements v0 i0 ;

Variable style-i#

: load-style ( addr u -- n )  style-tex
    style-i# @ 8 /mod 128 * >r 128 * r> 2swap load-subtex 2drop
    style-i# @ 1 style-i# +! ;
: style: load-style Create , DOES> @ frame# ! ;

"button.png" style: button1
"button2.png" style: button2
"button3.png" style: button3

previous previous previous set-current
Added jni-location.fs. 
























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

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

\ location services

also jni

jni-class: android/location/Location

jni-method: getAccuracy getAccuracy ()F
jni-method: getAltitude getAltitude ()D
jni-method: getBearing getBearing ()F
jni-method: getAltitude getAltitude ()D
jni-method: getLatitude getLatitude ()D
jni-method: getLongitude getLongitude ()D
jni-method: getProvider getProvider ()Ljava/lang/String;
jni-method: getSpeed getSpeed ()F
jni-method: getTime getTime ()J

jni-class: android/location/LocationManager

jni-method: getAllProviders getAllProviders ()Ljava/util/List;
jni-method: getProviders getProviders (Z)Ljava/util/List;
jni-method: getProvider getProvider (Ljava/lang/String;)Landroid/location/LocationProvider;
jni-method: requestLocationUpdates requestLocationUpdates (Ljava/lang/String;JFLandroid/location/LocationListener;)V
jni-method: getLastKnownLocation getLastKnownLocation (Ljava/lang/String;)Landroid/location/Location;
jni-method: removeUpdates removeUpdates (Landroid/location/LocationListener;)V


previous
Changes to omx-example.fs.
︙︙
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191

: start-file ( -- )
    setup-player  true init-enqueue  ppause pvol# pvol ;

also opengl

0 Value oes-program

: omx-init create-oes-program to oes-program ;

also android

\ vertices


0.005e Fconstant m-lr








|








177
178
179
180
181
182
183
184
185
186
187
188
189
190
191

: start-file ( -- )
    setup-player  true init-enqueue  ppause pvol# pvol ;

also opengl

0 Value oes-program

: omx-init ( -- ) create-oes-program to oes-program ;

also android

\ vertices


0.005e Fconstant m-lr
︙︙
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220

    >v
    rx m-lr f2* f- -0.96e >xy n> r% m-lr f- 0.98e >st c 0e -c 1e f>c v+
    rx             -0.9e  >xy n> r%         0.95e >st -c c 0e 1e f>c v+
    rx m-lr f2* f+ -0.96e >xy n> r% m-lr f+ 0.98e >st 0e -c c 1e f>c v+
    v> 4 i, 5 i, 6 i, ;

: rectangle ( -- )
    >v
    -1e  1e >xy n> 0e 0e >st  $000000FF rgba>c v+
     1e  1e >xy n> 1e 0e >st  $000000FF rgba>c v+
     1e -1e >xy n> 1e 1e >st  $000000FF rgba>c v+
    -1e -1e >xy n> 0e 1e >st  $000000FF rgba>c v+
    v> 0 i, 1 i, 2 i, 0 i, 2 i, 3 i, ;

\ player








|








206
207
208
209
210
211
212
213
214
215
216
217
218
219
220

    >v
    rx m-lr f2* f- -0.96e >xy n> r% m-lr f- 0.98e >st c 0e -c 1e f>c v+
    rx             -0.9e  >xy n> r%         0.95e >st -c c 0e 1e f>c v+
    rx m-lr f2* f+ -0.96e >xy n> r% m-lr f+ 0.98e >st 0e -c c 1e f>c v+
    v> 4 i, 5 i, 6 i, ;

: rectangle ( -- )
    i>off >v
    -1e  1e >xy n> 0e 0e >st  $000000FF rgba>c v+
     1e  1e >xy n> 1e 0e >st  $000000FF rgba>c v+
     1e -1e >xy n> 1e 1e >st  $000000FF rgba>c v+
    -1e -1e >xy n> 0e 1e >st  $000000FF rgba>c v+
    v> 0 i, 1 i, 2 i, 0 i, 2 i, 3 i, ;

\ player
︙︙
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315

	    utime lastseek 2@ delta-seek d+ du> IF
		5 3 click-regions
		2dup 2 1 d= IF  pplay? IF
			ppause
			get-deltat mkv-time-off f! 0e first-timestamp f!
		    ELSE pplay THEN  THEN
		dup 2 = IF
		    r@ x0 @ s>f w @ fm/ 1.1e f* 0.05e f- 0e fmax 1e fmin
		    pplay? IF  ppause  THEN
		    queue-flush  >pos  true init-enqueue pplay
		THEN
		2drop
		utime lastseek 2!
	    THEN
	THEN  r@ action off
    THEN
    rdrop ;

: play-loop ( -- ) hidekb
    screen+keep pplay
    omx-init 1 level# +!
    BEGIN
	draw-frame check-input
	cues>mts-run? 0= pplay? and  IF  ppause  THEN
    level# @ 0= UNTIL
    ppause screen-keep ;
: play-ts ( addr u -- ) ['] read-ts-file is read-ts
    open-mts start-file play-loop ;
: play-mkv ( addr u -- ) ['] pull-queue is read-ts

    'm' emit screen-sync
    <event e$, ->open-mkv 0 elit, ->cues cue-task event>
    'k' emit screen-sync
    start-file
    'v' emit screen-sync
    play-loop stop-player ;
: replay% ( r -- )  >pos  true init-enqueue play-loop ;
: replay ( -- )
    cue-task IF
	<event 0 elit, ->cues cue-task event>
    ELSE
	0. ts-fd reposition-file throw
    THEN
    true init-enqueue play-loop stop-player ;

: gs "/storage/extSdCard/Filme/gangnamstyle.ts" play-ts ;
: jb "/storage/extSdCard/Filme/jb.mkv" play-mkv ;

cue-converter \ start task a bit ahead of game

previous previous previous








|




















|
>















|






266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316

	    utime lastseek 2@ delta-seek d+ du> IF
		5 3 click-regions
		2dup 2 1 d= IF  pplay? IF
			ppause
			get-deltat mkv-time-off f! 0e first-timestamp f!
		    ELSE pplay THEN  THEN
		dup 2 = IF
		    r@ x0 @ s>f dpy-w @ fm/ 1.1e f* 0.05e f- 0e fmax 1e fmin
		    pplay? IF  ppause  THEN
		    queue-flush  >pos  true init-enqueue pplay
		THEN
		2drop
		utime lastseek 2!
	    THEN
	THEN  r@ action off
    THEN
    rdrop ;

: play-loop ( -- ) hidekb
    screen+keep pplay
    omx-init 1 level# +!
    BEGIN
	draw-frame check-input
	cues>mts-run? 0= pplay? and  IF  ppause  THEN
    level# @ 0= UNTIL
    ppause screen-keep ;
: play-ts ( addr u -- ) ['] read-ts-file is read-ts
    open-mts start-file play-loop ;
: play-mkv ( addr u -- )
    ['] pull-queue is read-ts
    'm' emit screen-sync
    <event e$, ->open-mkv 0 elit, ->cues cue-task event>
    'k' emit screen-sync
    start-file
    'v' emit screen-sync
    play-loop stop-player ;
: replay% ( r -- )  >pos  true init-enqueue play-loop ;
: replay ( -- )
    cue-task IF
	<event 0 elit, ->cues cue-task event>
    ELSE
	0. ts-fd reposition-file throw
    THEN
    true init-enqueue play-loop stop-player ;

: gs "/storage/extSdCard/Filme/gangnamstyle.mkv" play-mkv ;
: jb "/storage/extSdCard/Filme/jb.mkv" play-mkv ;

cue-converter \ start task a bit ahead of game

previous previous previous
Changes to opengl/linux.fs. 
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

\ Linux bindings for GLES

include x.fs

also x11

0 Value dpy
0 Value screen-struct
0 Value screen
0 Value win





Variable need-sync
Variable need-show
Variable kbflag


























: get-display ( -- w h )
    "DISPLAY" getenv drop XOpenDisplay to dpy
    dpy XDefaultScreenOfDisplay to screen-struct
    dpy XDefaultScreen to screen


    screen-struct screen-width l@
    screen-struct screen-height l@ ;


: simple-win ( events cstring w h -- )

    2>r dpy dup XDefaultRootWindow


    0 0 2r> 1 0 0 XCreateSimpleWindow  to win


    dpy win rot XStoreName drop

    dpy win rot XSelectInput drop
    dpy win XMapWindow drop

    dpy 0 XSync drop ;


0
KeyPressMask or
KeyReleaseMask or
ButtonPressMask or
ButtonReleaseMask or
EnterWindowMask or
LeaveWindowMask or
PointerMotionMask or
KeymapStateMask or
ExposureMask or
VisibilityChangeMask or
StructureNotifyMask or
ResizeRedirectMask or
SubstructureNotifyMask or
SubstructureRedirectMask or
FocusChangeMask or
PropertyChangeMask or
ColormapChangeMask or
OwnerGrabButtonMask or
Constant default-events

: ?looper ;
: >looper 10 ms ;

: linux ;

Defer window-init    ' noop is window-init
Defer config-changed ' noop is config-changed
Defer screen-ops     ' noop IS screen-ops

: term-cr defers cr ;



|







>
>
>
>





>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




>
>



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









|

|

|




|
|


<
<
<








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

\ Linux bindings for GLES

require x.fs

also x11

0 Value dpy
0 Value screen-struct
0 Value screen
0 Value win
0 Value ic
0 Value im
0 Value xim
0 Value fontset

Variable need-sync
Variable need-show
Variable kbflag

XIMPreeditPosition XIMPreeditArea or
XIMPreeditNothing or XIMPreeditNone or Constant XIMPreedit

: best-im ( -- im )
    XSupportsLocale IF
	"XMODIFIERS" getenv drop ?dup-IF
	    XSetLocaleModifiers  0= IF
		." Warning: Cannot set locale modifiers to '"
		"XMODIFIERS" getenv type  ." '" cr THEN  THEN
    THEN
    dpy 0 0 0 XOpenIM dup to xim
    IF  0 { w^ styles } xim "queryInputStyle\0" drop styles 0 XGetIMValues
	0<> ?EXIT \ didn't succeed
	0  styles @ cell+ @ styles @ w@ cells bounds ?DO
	    I @ dup XIMPreedit and 0<> swap XIMStatusNothing and 0<> and
	    IF  drop I @  LEAVE  THEN
	cell +LOOP  dup 0= IF ." No style found" cr  THEN
	styles @ XFree drop
    ELSE  0  THEN ;

: set-fontset ( -- )
    "-*-FreeSans-*-r-*-*-*-120-*-*-*-*-*-*,-misc-fixed-*-r-*-*-*-130-*-*-*-*-*-*\0" drop 0 0 0 { w^ misslist w^ miss# w^ defstring }
    dpy swap misslist miss# defstring XCreateFontSet to fontset
    misslist @ XFreeStringList ;

: get-display ( -- w h )
    "DISPLAY" getenv drop XOpenDisplay to dpy
    dpy XDefaultScreenOfDisplay to screen-struct
    dpy XDefaultScreen to screen
    best-im to im  set-fontset
    dpy #38 0 XKeycodeToKeysym drop
    screen-struct screen-width l@
    screen-struct screen-height l@ ;

4 buffer: spot \ spot location, two shorts

: get-ic ( win -- ) xim 0= IF  drop  EXIT  THEN
    ic IF  >r ic "focusWindow\0" drop r> 0 XSetICValues drop
	EXIT  THEN
    0 "fontSet\0" drop fontset "spotLocation\0" drop spot 0
    XVaCreateNestedList_2 { win list }
    xim "inputStyle\0" drop im "preeditAttributes\0" drop list
    "focusWindow\0" drop win 0 XCreateIC_3 dup to ic
    list XFree drop
    ?dup-IF  XSetICFocus  THEN ;

: focus-ic ( win -- )  ic IF
	>r ic "focusWindow\0" drop r@ "clientWindow\0" drop r> 0
	XSetICValues_2 drop  ic XSetICFocus
    THEN ;

0
KeyPressMask or
KeyReleaseMask or
ButtonPressMask or
ButtonReleaseMask or
EnterWindowMask or
LeaveWindowMask or
PointerMotionMask or
\ KeymapStateMask or
ExposureMask or
\ VisibilityChangeMask or
StructureNotifyMask or
\ ResizeRedirectMask or
SubstructureNotifyMask or
SubstructureRedirectMask or
FocusChangeMask or
PropertyChangeMask or
\ ColormapChangeMask or
\ OwnerGrabButtonMask or
Constant default-events




: linux ;

Defer window-init    ' noop is window-init
Defer config-changed ' noop is config-changed
Defer screen-ops     ' noop IS screen-ops

: term-cr defers cr ;
︙︙
91
92
93
94
95
96
97

















































































































































































































field: x9
field: y9
end-structure

app_input_state buffer: *input

Variable level#
























































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

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
173
174
175
176
177
178
179
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
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
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342

field: x9
field: y9
end-structure

app_input_state buffer: *input

Variable level#

\ handle X11 events

object class
    cell 4 = [IF]
	drop 0 4 +field e.type
	drop 4 4 +field e.serial
	drop 8 4 +field e.send_event
	drop 12 4 +field e.display
	drop 16 4 +field e.window
	drop 20 4 +field e.r-width
	drop 24 4 +field e.r-height
	drop 28 4 +field e.time
	drop 32 4 +field e.c-width
	drop 36 4 +field e.c-height
	drop 32 4 +field e.x
	drop 36 4 +field e.y
	drop 48 4 +field e.state
	drop 52 4 +field e.code \ key and button
    [ELSE]
	drop 0 4 +field e.type
	drop 8 8 +field e.serial
	drop 16 4 +field e.send_event
	drop 24 8 +field e.display
	drop 32 8 +field e.window
	drop 40 4 +field e.r-width  \ resize
	drop 44 4 +field e.r-height \ resize
	drop 56 8 +field e.time
	drop 56 4 +field e.c-width \ configure
	drop 60 4 +field e.c-height
	drop 64 4 +field e.x
	drop 68 4 +field e.y
	drop 80 4 +field e.state
	drop 84 4 +field e.code \ key and button
    [THEN]
    drop 0 union-_XEvent +field event
    $100 +field look_chars
    4 +field look_key
    4 +field comp_stat
    method DoNull \ doesn't exist
    method DoOne  \ doesn't exit, either
    method DoKeyPress
    method DoKeyRelease
    method DoButtonPress
    method DoButtonRelease
    method DoMotionNotify
    method DoEnterNotify
    method DoLeaveNotify
    method DoFocusIn
    method DoFocusOut
    method DoKeymapNotify
    method DoExpose
    method DoGraphicsExpose
    method DoNoExpose
    method DoVisibilityNotify
    method DoCreateNotify
    method DoDestroyNotify
    method DoUnmapNotify
    method DoMapNotify
    method DoMapRequest
    method DoReparentNotify
    method DoConfigureNotify
    method DoConfigureRequest
    method DoGravityNotify
    method DoResizeRequest
    method DoCirculateNotify
    method DoCirculateRequest
    method DoPropertyNotify
    method DoSelectionClear
    method DoSelectionRequest
    method DoSelectionNotify
    method DoColormapNotify
    method DoClientMessage
    method DoMappingNotify
    method DoGenericEvent
end-class handler-class

User event-handler  handler-class new event-handler !

Variable exposed

: $, ( addr u -- )  here over 1+ allot place ;

Create x-key>ekey \ very minimal set for a start
$FF08 , "\b" $,
$FF09 , "\t" $,
$FF0D , "\r" $,
$FF50 , "\e[H" $,
$FF51 , "\e[D" $,
$FF52 , "\e[A" $,
$FF53 , "\e[C" $,
$FF54 , "\e[B" $,
$FF55 , "\e[5~" $,
$FF56 , "\e[6~" $,
$FFFF , "\b" $, \ is not delete, is backspace!
0 , 0 c,
DOES> ( x-key -- addr u )
  swap >r
  BEGIN  dup cell+ swap @ dup r@ <> and WHILE  count +  REPEAT
  count rdrop ;

: getwh ( -- )
	0 0 dpy-w @ dpy-h @ glViewport ;

:noname ; handler-class to DoNull \ doesn't exist
:noname ; handler-class to DoOne  \ doesn't exit, either
:noname  ic event look_chars $FF look_key comp_stat  XUtf8LookupString
    ?dup-IF  look_chars swap
    ELSE   look_key l@ x-key>ekey  THEN  unkeys
; handler-class to DoKeyPress
:noname ; handler-class to DoKeyRelease
:noname  0 *input action ! 1 *input pressure !
    e.x l@ e.y l@ *input y0 ! *input x0 ! ; handler-class to DoButtonPress
:noname  1 *input action ! 0 *input pressure !
    e.x l@ *input x0 !
    e.y l@ *input y0 ! ; handler-class to DoButtonRelease
:noname
    *input pressure @ IF
	2 *input action !
	e.x l@ e.y l@ *input y0 ! *input x0 !
    THEN ; handler-class to DoMotionNotify
:noname ; handler-class to DoEnterNotify
:noname ; handler-class to DoLeaveNotify
:noname e.window @ focus-ic ; handler-class to DoFocusIn
:noname ; handler-class to DoFocusOut
:noname ; handler-class to DoKeymapNotify
:noname exposed on ; handler-class to DoExpose
:noname exposed on ; handler-class to DoGraphicsExpose
:noname ; handler-class to DoNoExpose
:noname ; handler-class to DoVisibilityNotify
:noname ; handler-class to DoCreateNotify
:noname ; handler-class to DoDestroyNotify
:noname ; handler-class to DoUnmapNotify
:noname ; handler-class to DoMapNotify
:noname ; handler-class to DoMapRequest
:noname ; handler-class to DoReparentNotify
:noname  e.c-width l@ dpy-w ! e.c-height l@ dpy-h !
    ctx IF  config-changed  ELSE  getwh  THEN ; handler-class to DoConfigureNotify
:noname ; handler-class to DoConfigureRequest
:noname ; handler-class to DoGravityNotify
:noname  e.r-width l@ dpy-w ! e.r-height l@ dpy-h ! config-changed ; handler-class to DoResizeRequest
:noname ; handler-class to DoCirculateNotify
:noname ; handler-class to DoCirculateRequest
:noname ; handler-class to DoPropertyNotify
:noname ; handler-class to DoSelectionClear
:noname ; handler-class to DoSelectionRequest
:noname ; handler-class to DoSelectionNotify
:noname ; handler-class to DoColormapNotify
:noname ; handler-class to DoClientMessage
:noname ; handler-class to DoMappingNotify
:noname ; handler-class to DoGenericEvent

: handle-event ( -- ) e.type l@ cells o#+ [ -1 cells , ] @ + perform ;
: get-events ( -- )  event-handler @ >o
    BEGIN  dpy XPending  WHILE  dpy event XNextEvent drop
	    event 0 XFilterEvent 0= IF  handle-event  THEN
    REPEAT o> ;

\ polling of FDs

require unix/socket.fs

User xptimeout  cell uallot drop
#10000000 Value xpoll-timeout# \ 10ms, don't sleep too long
xpoll-timeout# 0 xptimeout 2!
2 Value xpollfd#
User xpollfds
xpollfds pollfd %size xpollfd# * dup cell- uallot drop erase

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

: >poll-events ( -- n )
    stdin fileno POLLIN  xpollfds xfds!+ >r
    dpy IF  dpy XConnectionNumber POLLIN  r> xfds!+  ELSE  r>  THEN
    xpollfds - pollfd %size / ;

: #looper ( delay -- )
    >poll-events >r
    0 xptimeout 2!
    xpollfds r>
    [IFDEF] ppoll
	xptimeout 0 ppoll 0>
    [ELSE]
	xptimeout cell+ @ #1000000 / poll 0>
    [THEN]
    IF
	xpollfds pollfd %size + revents w@ POLLIN = IF  get-events  THEN
    THEN ;

: >looper ( -- )  xpoll-timeout# #looper ;
: >exposed  ( -- )  exposed off  BEGIN  >looper exposed @  UNTIL ;
: ?looper ( -- )  ;

: simple-win ( events cstring w h -- )
    2>r dpy dup XDefaultRootWindow
    0 0 2r> 1 0 0 XCreateSimpleWindow  to win
    dpy win rot XStoreName drop
    dpy win rot XSelectInput drop
    dpy win XMapWindow drop
    win get-ic
    dpy 0 XSync drop >exposed ;

: x-key ( -- key )
    need-show on  key? IF  defers key  EXIT  THEN
    BEGIN  xpoll-timeout# #looper  key? screen-ops UNTIL  defers key ;

' x-key IS key
Changes to opengl/opengl.fs. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

\ wrapper to load Swig-generated libraries

Vocabulary opengl
also opengl definitions

c-library opengl
    \c #include <GL/gl.h>
    \c #define GL_GLEXT_PROTOTYPES
    \c #include <GL/glx.h>

    s" GL" add-lib
    
    \ This is the missing piece:
    \ you need to get a linkable copy of libui.so
    \ s" ui" add-lib
    \ \c void* android_createDisplaySurface(void);
    \ c-function android_createDisplaySurface android_createDisplaySurface -- a ( -- window )
   
    include gl.fs
    include glx.fs

end-c-library

previous definitions




|



















|

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

\ wrapper to load Swig-generated libraries

Vocabulary opengl
get-current also opengl definitions

c-library opengl
    \c #include <GL/gl.h>
    \c #define GL_GLEXT_PROTOTYPES
    \c #include <GL/glx.h>

    s" GL" add-lib
    
    \ This is the missing piece:
    \ you need to get a linkable copy of libui.so
    \ s" ui" add-lib
    \ \c void* android_createDisplaySurface(void);
    \ c-function android_createDisplaySurface android_createDisplaySurface -- a ( -- window )
   
    include gl.fs
    include glx.fs

end-c-library

previous set-current
Changes to opengl/x.fs. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

\ include xlib stuff

Vocabulary X11
also X11 definitions

c-library xlib
    \c #include <X11/X.h>
    \c #include <X11/Xlib.h>
    \c #include <X11/Xutil.h>

    s" X11" add-lib

    include xlib.fs

end-c-library

previous definitions




|












|

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

\ include xlib stuff

Vocabulary X11
get-current also X11 definitions

c-library xlib
    \c #include <X11/X.h>
    \c #include <X11/Xlib.h>
    \c #include <X11/Xutil.h>

    s" X11" add-lib

    include xlib.fs

end-c-library

previous set-current
Changes to opengl/xlib-32.fs.
︙︙
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383

256	constant XIMStatusArea
512	constant XIMStatusCallbacks
1024	constant XIMStatusNothing
2048	constant XIMStatusNone
-1	constant XBufferOverflow
1	constant XLookupNone
2	constant XLookupChars
3	constant XLookupKeySym
4	constant XLookupBoth
1	constant XIMReverse
2	constant XIMUnderline
4	constant XIMHighlight
32	constant XIMPrimary
64	constant XIMSecondary
128	constant XIMTertiary








|








369
370
371
372
373
374
375
376
377
378
379
380
381
382
383

256	constant XIMStatusArea
512	constant XIMStatusCallbacks
1024	constant XIMStatusNothing
2048	constant XIMStatusNone
-1	constant XBufferOverflow
1	constant XLookupNone
2	constant XLookupChars
3	constant XLookupKeySym#
4	constant XLookupBoth
1	constant XIMReverse
2	constant XIMUnderline
4	constant XIMHighlight
32	constant XIMPrimary
64	constant XIMSecondary
128	constant XIMTertiary
︙︙
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793


1794
1795
1796
1797
1798
1799
1800

1801
1802
1803
1804
1805
1806
1807

1808
1809
1810
1811
1812
1813
1814

c-function XwcDrawString XwcDrawString a n a a n n a n -- void
c-function Xutf8DrawString Xutf8DrawString a n a a n n a n -- void
c-function XmbDrawImageString XmbDrawImageString a n a a n n a n -- void
c-function XwcDrawImageString XwcDrawImageString a n a a n n a n -- void
c-function Xutf8DrawImageString Xutf8DrawImageString a n a a n n a n -- void
c-function XOpenIM XOpenIM a a a a -- a
c-function XCloseIM XCloseIM a -- n
c-function XGetIMValues XGetIMValues a  -- a
c-function XSetIMValues XSetIMValues a  -- a
c-function XDisplayOfIM XDisplayOfIM a -- a
c-function XLocaleOfIM XLocaleOfIM a -- a
c-function XCreateIC XCreateIC a  -- a


c-function XDestroyIC XDestroyIC a -- void
c-function XSetICFocus XSetICFocus a -- void
c-function XUnsetICFocus XUnsetICFocus a -- void
c-function XwcResetIC XwcResetIC a -- a
c-function XmbResetIC XmbResetIC a -- a
c-function Xutf8ResetIC Xutf8ResetIC a -- a
c-function XSetICValues XSetICValues a  -- a

c-function XGetICValues XGetICValues a  -- a
c-function XIMOfIC XIMOfIC a -- a
c-function XFilterEvent XFilterEvent a n -- n
c-function XmbLookupString XmbLookupString a a a n a a -- n
c-function XwcLookupString XwcLookupString a a a n a a -- n
c-function Xutf8LookupString Xutf8LookupString a a a n a a -- n
c-function XVaCreateNestedList XVaCreateNestedList n  -- a

c-function XRegisterIMInstantiateCallback XRegisterIMInstantiateCallback a a a a a a -- n
c-function XUnregisterIMInstantiateCallback XUnregisterIMInstantiateCallback a a a a a a -- n
c-function XInternalConnectionNumbers XInternalConnectionNumbers a a a -- n
c-function XProcessInternalConnection XProcessInternalConnection a n -- void
c-function XAddConnectionWatch XAddConnectionWatch a a a -- n
c-function XRemoveConnectionWatch XRemoveConnectionWatch a a a -- void
c-function XSetAuthorization XSetAuthorization a n a n -- void








|
|


|
>
>






|
>
|





|
>








1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818

c-function XwcDrawString XwcDrawString a n a a n n a n -- void
c-function Xutf8DrawString Xutf8DrawString a n a a n n a n -- void
c-function XmbDrawImageString XmbDrawImageString a n a a n n a n -- void
c-function XwcDrawImageString XwcDrawImageString a n a a n n a n -- void
c-function Xutf8DrawImageString Xutf8DrawImageString a n a a n n a n -- void
c-function XOpenIM XOpenIM a a a a -- a
c-function XCloseIM XCloseIM a -- n
c-function XGetIMValues XGetIMValues a a a a -- a
c-function XSetIMValues XSetIMValues a a a a -- a
c-function XDisplayOfIM XDisplayOfIM a -- a
c-function XLocaleOfIM XLocaleOfIM a -- a
c-function XCreateIC XCreateIC a a a a -- a
c-function XCreateIC_2 XCreateIC a a a a a a -- a
c-function XCreateIC_3 XCreateIC a a a a a a a a -- a
c-function XDestroyIC XDestroyIC a -- void
c-function XSetICFocus XSetICFocus a -- void
c-function XUnsetICFocus XUnsetICFocus a -- void
c-function XwcResetIC XwcResetIC a -- a
c-function XmbResetIC XmbResetIC a -- a
c-function Xutf8ResetIC Xutf8ResetIC a -- a
c-function XSetICValues XSetICValues a a a a -- a
c-function XSetICValues_2 XSetICValues a a a a a a -- a
c-function XGetICValues XGetICValues a a a a -- a
c-function XIMOfIC XIMOfIC a -- a
c-function XFilterEvent XFilterEvent a n -- n
c-function XmbLookupString XmbLookupString a a a n a a -- n
c-function XwcLookupString XwcLookupString a a a n a a -- n
c-function Xutf8LookupString Xutf8LookupString a a a n a a -- n
c-function XVaCreateNestedList XVaCreateNestedList n a a a -- a
c-function XVaCreateNestedList_2 XVaCreateNestedList n a a a a a -- a
c-function XRegisterIMInstantiateCallback XRegisterIMInstantiateCallback a a a a a a -- n
c-function XUnregisterIMInstantiateCallback XUnregisterIMInstantiateCallback a a a a a a -- n
c-function XInternalConnectionNumbers XInternalConnectionNumbers a a a -- n
c-function XProcessInternalConnection XProcessInternalConnection a n -- void
c-function XAddConnectionWatch XAddConnectionWatch a a a -- n
c-function XRemoveConnectionWatch XRemoveConnectionWatch a a a -- void
c-function XSetAuthorization XSetAuthorization a n a n -- void
︙︙
Changes to opengl/xlib-64.fs.
︙︙
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383

256	constant XIMStatusArea
512	constant XIMStatusCallbacks
1024	constant XIMStatusNothing
2048	constant XIMStatusNone
-1	constant XBufferOverflow
1	constant XLookupNone
2	constant XLookupChars
3	constant XLookupKeySym
4	constant XLookupBoth
1	constant XIMReverse
2	constant XIMUnderline
4	constant XIMHighlight
32	constant XIMPrimary
64	constant XIMSecondary
128	constant XIMTertiary








|








369
370
371
372
373
374
375
376
377
378
379
380
381
382
383

256	constant XIMStatusArea
512	constant XIMStatusCallbacks
1024	constant XIMStatusNothing
2048	constant XIMStatusNone
-1	constant XBufferOverflow
1	constant XLookupNone
2	constant XLookupChars
3	constant XLookupKeySym#
4	constant XLookupBoth
1	constant XIMReverse
2	constant XIMUnderline
4	constant XIMHighlight
32	constant XIMPrimary
64	constant XIMSecondary
128	constant XIMTertiary
︙︙
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793


1794
1795
1796
1797
1798
1799
1800

1801
1802
1803
1804
1805
1806
1807

1808
1809
1810
1811
1812
1813
1814

c-function XwcDrawString XwcDrawString a n a a n n a n -- void
c-function Xutf8DrawString Xutf8DrawString a n a a n n a n -- void
c-function XmbDrawImageString XmbDrawImageString a n a a n n a n -- void
c-function XwcDrawImageString XwcDrawImageString a n a a n n a n -- void
c-function Xutf8DrawImageString Xutf8DrawImageString a n a a n n a n -- void
c-function XOpenIM XOpenIM a a a a -- a
c-function XCloseIM XCloseIM a -- n
c-function XGetIMValues XGetIMValues a  -- a
c-function XSetIMValues XSetIMValues a  -- a
c-function XDisplayOfIM XDisplayOfIM a -- a
c-function XLocaleOfIM XLocaleOfIM a -- a
c-function XCreateIC XCreateIC a  -- a


c-function XDestroyIC XDestroyIC a -- void
c-function XSetICFocus XSetICFocus a -- void
c-function XUnsetICFocus XUnsetICFocus a -- void
c-function XwcResetIC XwcResetIC a -- a
c-function XmbResetIC XmbResetIC a -- a
c-function Xutf8ResetIC Xutf8ResetIC a -- a
c-function XSetICValues XSetICValues a  -- a

c-function XGetICValues XGetICValues a  -- a
c-function XIMOfIC XIMOfIC a -- a
c-function XFilterEvent XFilterEvent a n -- n
c-function XmbLookupString XmbLookupString a a a n a a -- n
c-function XwcLookupString XwcLookupString a a a n a a -- n
c-function Xutf8LookupString Xutf8LookupString a a a n a a -- n
c-function XVaCreateNestedList XVaCreateNestedList n  -- a

c-function XRegisterIMInstantiateCallback XRegisterIMInstantiateCallback a a a a a a -- n
c-function XUnregisterIMInstantiateCallback XUnregisterIMInstantiateCallback a a a a a a -- n
c-function XInternalConnectionNumbers XInternalConnectionNumbers a a a -- n
c-function XProcessInternalConnection XProcessInternalConnection a n -- void
c-function XAddConnectionWatch XAddConnectionWatch a a a -- n
c-function XRemoveConnectionWatch XRemoveConnectionWatch a a a -- void
c-function XSetAuthorization XSetAuthorization a n a n -- void








|
|


|
>
>






|
>
|





|
>








1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818

c-function XwcDrawString XwcDrawString a n a a n n a n -- void
c-function Xutf8DrawString Xutf8DrawString a n a a n n a n -- void
c-function XmbDrawImageString XmbDrawImageString a n a a n n a n -- void
c-function XwcDrawImageString XwcDrawImageString a n a a n n a n -- void
c-function Xutf8DrawImageString Xutf8DrawImageString a n a a n n a n -- void
c-function XOpenIM XOpenIM a a a a -- a
c-function XCloseIM XCloseIM a -- n
c-function XGetIMValues XGetIMValues a a a a -- a
c-function XSetIMValues XSetIMValues a a a a -- a
c-function XDisplayOfIM XDisplayOfIM a -- a
c-function XLocaleOfIM XLocaleOfIM a -- a
c-function XCreateIC XCreateIC a a a a -- a
c-function XCreateIC_2 XCreateIC a a a a a a -- a
c-function XCreateIC_3 XCreateIC a a a a a a a a -- a
c-function XDestroyIC XDestroyIC a -- void
c-function XSetICFocus XSetICFocus a -- void
c-function XUnsetICFocus XUnsetICFocus a -- void
c-function XwcResetIC XwcResetIC a -- a
c-function XmbResetIC XmbResetIC a -- a
c-function Xutf8ResetIC Xutf8ResetIC a -- a
c-function XSetICValues XSetICValues a a a a -- a
c-function XSetICValues_2 XSetICValues a a a a a a -- a
c-function XGetICValues XGetICValues a a a a -- a
c-function XIMOfIC XIMOfIC a -- a
c-function XFilterEvent XFilterEvent a n -- n
c-function XmbLookupString XmbLookupString a a a n a a -- n
c-function XwcLookupString XwcLookupString a a a n a a -- n
c-function Xutf8LookupString Xutf8LookupString a a a n a a -- n
c-function XVaCreateNestedList XVaCreateNestedList n a a a -- a
c-function XVaCreateNestedList_2 XVaCreateNestedList n a a a a a -- a
c-function XRegisterIMInstantiateCallback XRegisterIMInstantiateCallback a a a a a a -- n
c-function XUnregisterIMInstantiateCallback XUnregisterIMInstantiateCallback a a a a a a -- n
c-function XInternalConnectionNumbers XInternalConnectionNumbers a a a -- n
c-function XProcessInternalConnection XProcessInternalConnection a n -- void
c-function XAddConnectionWatch XAddConnectionWatch a a a -- n
c-function XRemoveConnectionWatch XRemoveConnectionWatch a a a -- void
c-function XSetAuthorization XSetAuthorization a n a n -- void
︙︙
Changes to soil/configure.ac. 
1
2
3
4
5
6
7
8
9
10
11
12


13
14

## ExampleLib Example: an example of using Automake to link with a library

AC_INIT([SOIL], [1.0], [bernd@net2o.de], [soil for Linux],
        [http://lonesock.net/soil.html])
AC_PREREQ([2.59])
AM_INIT_AUTOMAKE([1.10 -Wall no-define])
AC_CONFIG_MACRO_DIR([m4])
AC_CONFIG_HEADERS([config.h])
AC_PROG_CC
AM_PROG_AR
LT_INIT



AC_CONFIG_FILES([Makefile])
AC_OUTPUT













>
>



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

## ExampleLib Example: an example of using Automake to link with a library

AC_INIT([SOIL], [1.0], [bernd@net2o.de], [soil for Linux],
        [http://lonesock.net/soil.html])
AC_PREREQ([2.59])
AM_INIT_AUTOMAKE([1.10 -Wall no-define])
AC_CONFIG_MACRO_DIR([m4])
AC_CONFIG_HEADERS([config.h])
AC_PROG_CC
AM_PROG_AR
LT_INIT

LIBTOOL=${CC%gcc}libtool
AC_SUBST(LIBTOOL)
AC_CONFIG_FILES([Makefile])
AC_OUTPUT
Changes to widgets-test.fs.
︙︙
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81

    f1 >o draw o> f7 >o draw o> f2 >o draw o> f3 >o draw o>
    f8 >o draw o> f4 >o draw o> f5 >o draw o> f6 >o draw o> ;

: widgets-test
    <draw0 draw0>
    <draw1 widgets-draw draw1>
    <draw2 widgets-draw draw2>

    sync ;

also [IFDEF] android android [THEN]

: widgets-demo ( -- ) program init [IFDEF] hidekb  hidekb [THEN]
    1 level# +!  BEGIN  widgets-test >looper  level# @ 0= UNTIL ;

previous








>




|




67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

    f1 >o draw o> f7 >o draw o> f2 >o draw o> f3 >o draw o>
    f8 >o draw o> f4 >o draw o> f5 >o draw o> f6 >o draw o> ;

: widgets-test
    <draw0 draw0>
    <draw1 widgets-draw draw1>
    <draw2 widgets-draw draw2>
    <draw3 widgets-draw draw3>
    sync ;

also [IFDEF] android android [THEN]

: widgets-demo ( -- )  [IFDEF] hidekb  hidekb [THEN]
    1 level# +!  BEGIN  widgets-test >looper  level# @ 0= UNTIL ;

previous
Changes to widgets.fs.
︙︙
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

    field: parent-w
    field: x
    field: y
    field: w
    field: h \ above baseline
    field: d \ below baseline
    method draw ( -- )
    method hglue

    method vglue
    method hglue@ \ cached variant
    method vglue@ \ cached variant

    method xywh
    method xywhd
    method !size \ set your own size
end-class widget

:noname x @ y @ h @ - w @ h @ d @ + ; widget to xywh
:noname x @ y @ w @ h @ d @ ; widget to xywhd
' noop widget to !size







widget class
    field: child-w
    field: act
    method resized
    method map
end-class box








|
>
|
|
|
>
|
|






>
>
>
>
>
>








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

    field: parent-w
    field: x
    field: y
    field: w
    field: h \ above baseline
    field: d \ below baseline
    method draw ( -- )
    method hglue ( -- typ sub add )
    method dglue ( -- typ sub add )
    method vglue ( -- typ sub add )
    method hglue@ ( -- typ sub add ) \ cached variant
    method dglue@ ( -- typ sub add ) \ cached variant
    method vglue@ ( -- typ sub add ) \ cached variant
    method xywh ( -- x0 y0 w h )
    method xywhd ( -- x y w h d )
    method !size \ set your own size
end-class widget

:noname x @ y @ h @ - w @ h @ d @ + ; widget to xywh
:noname x @ y @ w @ h @ d @ ; widget to xywhd
' noop widget to !size
:noname w @ 0 0 ; widget to hglue
:noname h @ 0 0 ; widget to vglue
:noname d @ 0 0 ; widget to dglue
' hglue widget to hglue@
' vglue widget to vglue@
' dglue widget to dglue@

widget class
    field: child-w
    field: act
    method resized
    method map
end-class box
︙︙
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


widget class
    field: text-string
    field: text-font
    field: text-color
end-class text



: text-draw ( -- ) layer 2 <> ?EXIT




    x @ s>f penxy sf!  y @ s>f penxy sfloat+ sf!
    text-font @ to font  text-color @ color !
    text-string $@ render-string ;
: text-!size ( -- )
    text-string $@ layout-string
    f>s d ! f>s h ! f>s w ! ;
' text-draw text to draw
' text-!size text to !size

\ draw wrapper

: <draw0 ( -- )  0 to layer
    -1e 1e >apxy
    .01e 100e 100e >ap
    0.01e 0.02e 0.15e 1.0e glClearColor
    Ambient 1 ambient% glUniform1fv ;
: draw0> ( -- ) clear v0 i0 ;

: <draw1 ( -- )  1 to layer
    z-bias set-color+
    program glUseProgram  style-tex ;
: draw1> ( -- )  GL_TRIANGLES draw-elements v0 i0 ;

: <draw2 ( -- )  2 to layer


    1-bias set-color+
    program glUseProgram  atlas-tex ;
: draw2> ( -- )  GL_TRIANGLES draw-elements v0 i0 ;

Variable style-i#

: load-style ( addr u -- n )  style-tex
    style-i# @ 8 /mod 128 * >r 128 * r> 2swap load-subtex 2drop
    style-i# @ 1 style-i# +! ;
: style: load-style Create , DOES> @ frame# ! ;

"button.png" style: button1
"button2.png" style: button2
"button3.png" style: button3

previous previous previous set-current








>
>
|
>
>
>
>
|
|
|




















|
>
>


|














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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188


widget class
    field: text-string
    field: text-font
    field: text-color
end-class text

Variable glyphs$

: text-draw ( -- )
    layer 2 = IF
	text-font @ to font text-string $@ glyphs$ $+!
	EXIT  THEN
    layer 3 = IF
	x @ s>f penxy sf!  y @ s>f penxy sfloat+ sf!
	text-font @ to font  text-color @ color !
	text-string $@ render-string THEN ;
: text-!size ( -- )
    text-string $@ layout-string
    f>s d ! f>s h ! f>s w ! ;
' text-draw text to draw
' text-!size text to !size

\ draw wrapper

: <draw0 ( -- )  0 to layer
    -1e 1e >apxy
    .01e 100e 100e >ap
    0.01e 0.02e 0.15e 1.0e glClearColor
    Ambient 1 ambient% glUniform1fv ;
: draw0> ( -- ) clear v0 i0 ;

: <draw1 ( -- )  1 to layer
    z-bias set-color+
    program glUseProgram  style-tex ;
: draw1> ( -- )  GL_TRIANGLES draw-elements v0 i0 ;

: <draw2 ( -- )  2 to layer s" " glyphs$ $! ;
: draw2> ( -- )  glyphs$ $@ load-glyph$ ;
: <draw3 ( -- )  3 to layer
    1-bias set-color+
    program glUseProgram  atlas-tex ;
: draw3> ( -- )  GL_TRIANGLES draw-elements v0 i0 ;

Variable style-i#

: load-style ( addr u -- n )  style-tex
    style-i# @ 8 /mod 128 * >r 128 * r> 2swap load-subtex 2drop
    style-i# @ 1 style-i# +! ;
: style: load-style Create , DOES> @ frame# ! ;

"button.png" style: button1
"button2.png" style: button2
"button3.png" style: button3

previous previous previous set-current
Fossil version [611144ddd9] 2025-05-16 13:52:48