Check-in [ff69bb0126]
Not logged in

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

Overview
Comment:Fixed scrolling
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ff69bb0126d74254fb832ab0230c84b4ff501af5
User & Date: bernd 2014-01-23 15:35:58
Context
2014-01-23
16:05
Slideshow finetuning check-in: 293240b31b user: bernd tags: trunk
15:35
Fixed scrolling check-in: ff69bb0126 user: bernd tags: trunk
2014-01-21
01:02
Sensor example check-in: 7c22743d9a user: bernd tags: trunk
Changes

Changes to gl-helper.fs.

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
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 !







<







|




|







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
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 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  ( -- r ) *input downtime 2@ d>f 1e-3 f* ;
: short? ( -- flag )
    delta-tc short-click# f< ;
: long? ( -- flag )
    delta-tc long-click# f> ;
: !click ( -- )  0e motion-x0 f! 0e motion-y0 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 !

Changes to gl-terminal.fs.

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

: 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
		need-show off
	    endof
	    0 of  !click  endof
	    1 of  ?toggle  endof
	    7 of  ?toggle  endof
	    last-y0 motion-y0 ['] +scroll drag-motion
	endcase
	r@ action on
    THEN  rdrop ;

:noname ( flag -- flag ) screen-sync screen-slide scroll-slide ; IS screen-ops

' gl-type ' gl-emit ' gl-cr ' gl-form output: >screen

>screen
' gl-atxy IS at-xy
' gl-at-deltaxy IS at-deltaxy
' gl-page IS page







>
>
>
>
>





|
|
|
|
|
|
|
|
|
|
|
<
<
<







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

: 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 ;

: scrolling ( y0 -- )
    rows swap last-y0 motion-y0 ['] +scroll do-motion
    long? IF  kbflag @ IF  togglekb  THEN  THEN
    need-show off ;

: screen-slide ( -- )
    *input >r
    r@ IF
	r@ action @ \ dup -1 <> IF  dup . delta-t f. cr  THEN
	case
	    1 of  ?toggle  r@ action on  endof
	    abs 1 <> IF  r@ y0 @ scrolling  
	    ELSE  last-y0 motion-y0 ['] +scroll drag-motion  THEN
	    0
	endcase
    THEN  rdrop ;

:noname ( flag -- flag ) screen-sync
\    [: touch>event screen-slide ;] is android-touch
    screen-slide scroll-slide ; IS screen-ops




' gl-type ' gl-emit ' gl-cr ' gl-form output: >screen

>screen
' gl-atxy IS at-xy
' gl-at-deltaxy IS at-deltaxy
' gl-page IS page

Changes to gles2/android.fs.

25
26
27
28
29
30
31

32
33
34
35
36
37
38
...
257
258
259
260
261
262
263
264
265
266
267
268
269
270

271
272
273
274
275
276
277
...
283
284
285
286
287
288
289

290
291
292
293
294
295
296
    begin-structure app_input_state
    field: action
    field: flags
    field: metastate
    field: edgeflags
    field: pressure
    field: size

    field: tcount
    field: x0
    field: y0
    field: x1
    field: y1
    field: x2
    field: y2
................................................................................
	0= IF  getUnicodeChar dup 0>
	    IF    android-unicode
	    ELSE  drop  getKeyCode  android-keycode
	    THEN
	THEN
    THEN o> ;

: android-touch ( event -- ) dup to touch-event >o
    me-getAction *input action !
    getFlags *input flags !
    getMetaState *input metastate !
    getEdgeFlags *input edgeflags !
    0 getPressure f>s *input pressure !
    0 getSize f>s *input size !

    getPointerCount dup *input tcount !
    *input x0 swap
    0 ?DO
	I getY f>s
	I getX f>s
	rot dup >r 2! r> 2 cells +
    LOOP  drop
................................................................................
:noname to sensor ; IS android-sensor

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

Defer android-surface-changed ' ]gref is recurse
Defer android-surface-redraw ' ]gref is recurse
Defer android-video-size ' ]gref is recurse


: android-surface-created ( surface -- )
    >o  env o ANativeWindow_fromSurface app window !  gref> ;
: android-surface-destroyed ( surface -- )
    >o  app window off  gref> ;
: android-global-layout ( 0 -- ) drop config-changed ;








>







 







|






>







 







>







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
...
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
...
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
    begin-structure app_input_state
    field: action
    field: flags
    field: metastate
    field: edgeflags
    field: pressure
    field: size
    2field: downtime
    field: tcount
    field: x0
    field: y0
    field: x1
    field: y1
    field: x2
    field: y2
................................................................................
	0= IF  getUnicodeChar dup 0>
	    IF    android-unicode
	    ELSE  drop  getKeyCode  android-keycode
	    THEN
	THEN
    THEN o> ;

: touch>event ( event -- ) dup to touch-event >o
    me-getAction *input action !
    getFlags *input flags !
    getMetaState *input metastate !
    getEdgeFlags *input edgeflags !
    0 getPressure f>s *input pressure !
    0 getSize f>s *input size !
    getEventTime getDownTime d- *input downtime 2!
    getPointerCount dup *input tcount !
    *input x0 swap
    0 ?DO
	I getY f>s
	I getX f>s
	rot dup >r 2! r> 2 cells +
    LOOP  drop
................................................................................
:noname to sensor ; IS android-sensor

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

Defer android-surface-changed ' ]gref is recurse
Defer android-surface-redraw ' ]gref is recurse
Defer android-video-size ' ]gref is recurse
Defer android-touch ' touch>event is recurse

: android-surface-created ( surface -- )
    >o  env o ANativeWindow_fromSurface app window !  gref> ;
: android-surface-destroyed ( surface -- )
    >o  app window off  gref> ;
: android-global-layout ( 0 -- ) drop config-changed ;

Changes to gles2/gl-helper.fs.

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
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 !







<







|




|







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
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 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  ( -- r ) *input downtime 2@ d>f 1e-3 f* ;
: short? ( -- flag )
    delta-tc short-click# f< ;
: long? ( -- flag )
    delta-tc long-click# f> ;
: !click ( -- )  0e motion-x0 f! 0e motion-y0 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 !

Changes to gles2/gl-terminal.fs.

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

: 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
		need-show off
	    endof
	    0 of  !click  endof
	    1 of  ?toggle  endof
	    7 of  ?toggle  endof
	    last-y0 motion-y0 ['] +scroll drag-motion
	endcase
	r@ action on
    THEN  rdrop ;

:noname ( flag -- flag ) screen-sync screen-slide scroll-slide ; IS screen-ops

' gl-type ' gl-emit ' gl-cr ' gl-form output: >screen

>screen
' gl-atxy IS at-xy
' gl-at-deltaxy IS at-deltaxy
' gl-page IS page







>
>
>
>
>





|
|
|
|
|
|
|
|
|
|
|
<
<
<







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

: 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 ;

: scrolling ( y0 -- )
    rows swap last-y0 motion-y0 ['] +scroll do-motion
    long? IF  kbflag @ IF  togglekb  THEN  THEN
    need-show off ;

: screen-slide ( -- )
    *input >r
    r@ IF
	r@ action @ \ dup -1 <> IF  dup . delta-t f. cr  THEN
	case
	    1 of  ?toggle  r@ action on  endof
	    abs 1 <> IF  r@ y0 @ scrolling  
	    ELSE  last-y0 motion-y0 ['] +scroll drag-motion  THEN
	    0
	endcase
    THEN  rdrop ;

:noname ( flag -- flag ) screen-sync
\    [: touch>event screen-slide ;] is android-touch
    screen-slide scroll-slide ; IS screen-ops




' gl-type ' gl-emit ' gl-cr ' gl-form output: >screen

>screen
' gl-atxy IS at-xy
' gl-at-deltaxy IS at-deltaxy
' gl-page IS page

Changes to gles2/jni-helper.fs.

54
55
56
57
58
59
60

61
62
63
64
65
66
67
jni-method: getPointerCount getPointerCount ()I
jni-method: getX getX (I)F
jni-method: getY getY (I)F
jni-method: me-getAction getAction ()I
jni-method: getFlags getFlags ()I
jni-method: getEdgeFlags getEdgeFlags ()I
jni-method: getEventTime getEventTime ()J

jni-method: getMetaState getMetaState ()I
jni-method: getSize getSize (I)F
jni-method: getPressure getPressure (I)F

jni-class: java/util/List

jni-method: l-get get (I)Ljava/lang/Object;







>







54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
jni-method: getPointerCount getPointerCount ()I
jni-method: getX getX (I)F
jni-method: getY getY (I)F
jni-method: me-getAction getAction ()I
jni-method: getFlags getFlags ()I
jni-method: getEdgeFlags getEdgeFlags ()I
jni-method: getEventTime getEventTime ()J
jni-method: getDownTime getDownTime ()J
jni-method: getMetaState getMetaState ()I
jni-method: getSize getSize (I)F
jni-method: getPressure getPressure (I)F

jni-class: java/util/List

jni-method: l-get get (I)Ljava/lang/Object;