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

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

Overview
Comment:A bit refactoring, added a very simple example
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 4784aecda7000eb6cfe397de138ea85d708cc5f8
User & Date: bernd 2014-04-29 13:02:02.870
Context
2014-05-14
21:02
Better keyboard handling check-in: c71e1435c8 user: bernd tags: trunk
2014-04-29
13:02
A bit refactoring, added a very simple example check-in: 4784aecda7 user: bernd tags: trunk
2014-04-01
20:23
Destdir depends on where it is called check-in: 7aa55ededf user: bernd tags: trunk
Changes
Side-by-Side Diff Ignore Whitespace Patch
Changes to gl-helper.fs.
︙
205
206
207
208
209
210
211
212
213



214
215
216
217
218
219
220

205
206
207
208
209
210
211


212
213
214
215
216
217
218
219
220
221








-
-
+
+
+








    2dup ';' scan 2dup 1 /string 2>r drop >r over r> swap - nip
    BEGIN  2dup >wordend  dup WHILE  2nip >wordend >word  REPEAT  2drop
    2r> 2swap ;

Variable $attrib

: >bindattrib ( xt program -- )  0 { prog idx } shader>string
    BEGIN  s" attribute " >attrib extract-name dup  WHILE  $attrib $!
	    prog idx $attrib $@ over + 0 swap c! glBindAttribLocation
    BEGIN  s" attribute " >attrib extract-name dup  WHILE
	    $attrib $!  0 $attrib c$+!
	    prog idx $attrib $@ drop glBindAttribLocation
	    idx 1+ to idx
    REPEAT  2drop 2drop ;

: >univattrib ( xt program -- )  { prog }
    shader>string
    BEGIN  s" uniform " >attrib extract-name dup  WHILE  $attrib $!
	    prog $attrib $@ over + 0 swap c! glGetUniformLocation ,
︙
404
405
406
407
408
409
410




411
412
413
414
415

416
417
418
419
420
421
422
423

405
406
407
408
409
410
411
412
413
414
415
416
417
418
419

420

421
422
423
424
425
426
427








+
+
+
+




-
+
-








    0e sf!+ near f2* top bottom f- f/ sf!+ 0e sf!+ 0e sf!+
    right left f+ right left f- f/ sf!+
    top bottom f+ top bottom f- f/ sf!+
    near far f+ near far f- f/ sf!+ -1e sf!+
    sfloat+ sfloat+ near far f* f2* near far f- f/ sf!+ 0e sf!+
    drop ;

: ap-set ( -- )
    ap-matrix MVPMatrix set-matrix
    ap-matrix MVMatrix set-matrix ;

: >ap ( near far scale -- ) f2* 1/f { f: scale }
    scale dpy-w @ fm* fdup fnegate fswap
    scale dpy-h @ fm* fdup fnegate fswap >ortho
    \ cr ap-matrix .matrix
    ap-matrix MVPMatrix set-matrix
    ap-set ;
    ap-matrix MVMatrix set-matrix ;
: >apxy ( xoff yoff -- )  y-apos sf!  x-apos sf! ;

\ textures

Create white-texture \ aabbggrr
  $ffffffff l,  $ffffffff l,
  $ffffffff l,  $ffffffff l,
︙
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537

512
513
514
515
516
517
518
















519
520
521
522
523
524
525








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








    none-tex no-texture
    Texture 0 glUniform1i
    Ambient 1 ambient% glUniform1fv
    LightPos 0.0e 0.0e -0.3e glUniform3f
    z-bias set-color+
    .01e 100e dpy-w @ dpy-h @ min s>f f2/ 100 fm* >ap ;

: 2d-vertex ( index addr -- ) >r
    dup 2 GL_FLOAT  0 0 r> glVertexAttribPointer
    glEnableVertexAttribArray ;

: 3d-vertex ( index addr -- ) >r
    dup 3 GL_FLOAT  0 0 r> glVertexAttribPointer
    glEnableVertexAttribArray ;

: 4d-vertex ( index addr -- ) >r
    dup 4 GL_FLOAT  0 0 r> glVertexAttribPointer
    glEnableVertexAttribArray ;

: rgba-vertex ( index addr -- ) >r
    dup 4 GL_UNSIGNED_BYTE GL_TRUE 0 r> glVertexAttribPointer
    glEnableVertexAttribArray ;

\ glDrawElements helper

$8 cells buffer: gl-buffers
: buf@ ( n -- buf ) cells gl-buffers + @ ;
: bind-buf ( type n -- ) buf@ glBindBuffer ;

0 Value array-buf
︙
Changes to gl-sample.fs. 
1
2
3
4
5

6
7
8
9
10
11
12

1
2
3
4

5
6
7
8
9
10
11
12





-
+








\ opengl example

require gl-helper.fs

also opengl
also opengl also [IFDEF] android android [THEN]

tex: ascii-tex

: load-textures ( -- )
    ascii-tex s" ascii.png" load-texture wrap mipmap ;

\ triangle example
︙
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

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








-
-
-
-
-
-
-
-
-
-
-


















-
-
-








    1e0 2e0 >st v+
    0e0 0e0 >st v+ o> ;

: normals >v
    3 0 DO  0e 0e -1e n>xyz v+  LOOP  o> ;

Variable new-config

[IFDEF] android
also android

:noname  defers window-init
    ['] VertexShader ['] FragmentShader create-program to program
    program init load-textures ; IS window-init

:noname new-config on ; is config-changed
[THEN]

FVariable touch -100e touch f!
FVariable motion 0.01e motion f!

: draw-tri-angle ( f -- )
    0.01e 0.02e 0.15e 1.0e glClearColor
    clear
    Ambient 1 ambient% glUniform1fv
    v0  set-triangle
    normals texcoords colors
    none-tex
    i0  0 i, 1 i, 2 i,
    GL_TRIANGLES draw-elements
    v0 colors'
    ascii-tex
    GL_TRIANGLES draw-elements
    sync ;

: draw-tri { f: angle -- angle' }
    new-config @ IF
	dpy-w @ dpy-h @ getwh dpy-w @ dpy-h @ d<> IF  new-config off  THEN
    THEN
    angle draw-tri-angle
    >looper
    *input >r r@ IF
	r@ action @ abs 1 <> 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/
︙
Added gl-simple.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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

\ simple opengl test

[defined] init-opengl 0= constant standalone
require gl-helper.fs
also opengl
also [IFDEF] android android [THEN]
standalone [if] init-opengl buffer-init [then]

: simple-init ( -- )
    ['] VertexShader ['] FragmentShader create-program to program
    program init  0e >y-pos
    1e 0e 0e 1e glClearColor ;

: draw ( -- )  none-tex
    v0 >v
    -1e -1e >xy  $FFFFFFFF rgba>c  n> v+
     1e -1e >xy  $FFFFFFFF rgba>c  n> v+
     0e  1e >xy  $FFFFFFFF rgba>c  n> v+ v>
    i0 0 i, 1 i, 2 i,
    GL_TRIANGLES draw-elements ;

: simple ( -- )  simple-init
  1 level# +!  begin clear draw sync >looper level# @ 0= until ;

simple






Changes to gl-terminal.fs.






︙


94
95
96
97
98
99
100
101
102


103
104
105
106
107
108
109

94
95
96
97
98
99
100


101
102
103
104
105
106
107
108
109








-
-
+
+








$ff40bf40 l, \ dimm Green
$ff40bfbf l, \ dimm Yellow
$ffbf4040 l, \ dimm Blue
$ffbf40bf l, \ dimm Magenta
$ffbfbf40 l, \ dimm Cyan
$ffbfbfbf l, \ dimm White

: term-load-textures ( -- )
    chars-tex s" ascii.png" load-texture 2drop linear
: term-load-textures ( addr u -- )
    chars-tex load-texture 2drop linear
    GL_TEXTURE2 glActiveTexture
    color-tex color-matrix $10 1 rgba-map nearest
    GL_TEXTURE0 glActiveTexture ;

Variable color-index
bl dup $70 and 5 lshift or $F0F and 4 lshift color-index !
Variable std-bg




︙


310
311
312
313
314
315
316
317

318
319
320


321
322
323
324
325
326
327

310
311
312
313
314
315
316

317
318
319

320
321
322
323
324
325
326
327
328








-
+


-
+
+








' gl-page IS page
' gl-attr! IS attr!
default-out op-vector !

\ initialize

: term-init ( -- )
    clazz >o hideProgress o>
    [IFDEF] clazz clazz >o hideProgress o> [THEN]
    >screen-orientation
    create-terminal-program to terminal-program
    terminal-program terminal-init term-load-textures form-chooser
    terminal-program terminal-init
    s" ascii.png" 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/gl-helper.fs.






︙


205
206
207
208
209
210
211
212
213



214
215
216
217
218
219
220

205
206
207
208
209
210
211


212
213
214
215
216
217
218
219
220
221








-
-
+
+
+








    2dup ';' scan 2dup 1 /string 2>r drop >r over r> swap - nip
    BEGIN  2dup >wordend  dup WHILE  2nip >wordend >word  REPEAT  2drop
    2r> 2swap ;

Variable $attrib

: >bindattrib ( xt program -- )  0 { prog idx } shader>string
    BEGIN  s" attribute " >attrib extract-name dup  WHILE  $attrib $!
	    prog idx $attrib $@ over + 0 swap c! glBindAttribLocation
    BEGIN  s" attribute " >attrib extract-name dup  WHILE
	    $attrib $!  0 $attrib c$+!
	    prog idx $attrib $@ drop glBindAttribLocation
	    idx 1+ to idx
    REPEAT  2drop 2drop ;

: >univattrib ( xt program -- )  { prog }
    shader>string
    BEGIN  s" uniform " >attrib extract-name dup  WHILE  $attrib $!
	    prog $attrib $@ over + 0 swap c! glGetUniformLocation ,




︙


404
405
406
407
408
409
410




411
412
413
414
415

416
417
418
419
420
421
422
423

405
406
407
408
409
410
411
412
413
414
415
416
417
418
419

420

421
422
423
424
425
426
427








+
+
+
+




-
+
-








    0e sf!+ near f2* top bottom f- f/ sf!+ 0e sf!+ 0e sf!+
    right left f+ right left f- f/ sf!+
    top bottom f+ top bottom f- f/ sf!+
    near far f+ near far f- f/ sf!+ -1e sf!+
    sfloat+ sfloat+ near far f* f2* near far f- f/ sf!+ 0e sf!+
    drop ;

: ap-set ( -- )
    ap-matrix MVPMatrix set-matrix
    ap-matrix MVMatrix set-matrix ;

: >ap ( near far scale -- ) f2* 1/f { f: scale }
    scale dpy-w @ fm* fdup fnegate fswap
    scale dpy-h @ fm* fdup fnegate fswap >ortho
    \ cr ap-matrix .matrix
    ap-matrix MVPMatrix set-matrix
    ap-set ;
    ap-matrix MVMatrix set-matrix ;
: >apxy ( xoff yoff -- )  y-apos sf!  x-apos sf! ;

\ textures

Create white-texture \ aabbggrr
  $ffffffff l,  $ffffffff l,
  $ffffffff l,  $ffffffff l,




︙


508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537

512
513
514
515
516
517
518
















519
520
521
522
523
524
525








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








    none-tex no-texture
    Texture 0 glUniform1i
    Ambient 1 ambient% glUniform1fv
    LightPos 0.0e 0.0e -0.3e glUniform3f
    z-bias set-color+
    .01e 100e dpy-w @ dpy-h @ min s>f f2/ 100 fm* >ap ;

: 2d-vertex ( index addr -- ) >r
    dup 2 GL_FLOAT  0 0 r> glVertexAttribPointer
    glEnableVertexAttribArray ;

: 3d-vertex ( index addr -- ) >r
    dup 3 GL_FLOAT  0 0 r> glVertexAttribPointer
    glEnableVertexAttribArray ;

: 4d-vertex ( index addr -- ) >r
    dup 4 GL_FLOAT  0 0 r> glVertexAttribPointer
    glEnableVertexAttribArray ;

: rgba-vertex ( index addr -- ) >r
    dup 4 GL_UNSIGNED_BYTE GL_TRUE 0 r> glVertexAttribPointer
    glEnableVertexAttribArray ;

\ glDrawElements helper

$8 cells buffer: gl-buffers
: buf@ ( n -- buf ) cells gl-buffers + @ ;
: bind-buf ( type n -- ) buf@ glBindBuffer ;

0 Value array-buf




︙





Changes to gles2/gl-sample.fs.





1
2
3
4
5

6
7
8
9
10
11
12

1
2
3
4

5
6
7
8
9
10
11
12





-
+








\ opengl example

require gl-helper.fs

also opengl
also opengl also [IFDEF] android android [THEN]

tex: ascii-tex

: load-textures ( -- )
    ascii-tex s" ascii.png" load-texture wrap mipmap ;

\ triangle example




︙


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

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








-
-
-
-
-
-
-
-
-
-
-


















-
-
-








    1e0 2e0 >st v+
    0e0 0e0 >st v+ o> ;

: normals >v
    3 0 DO  0e 0e -1e n>xyz v+  LOOP  o> ;

Variable new-config

[IFDEF] android
also android

:noname  defers window-init
    ['] VertexShader ['] FragmentShader create-program to program
    program init load-textures ; IS window-init

:noname new-config on ; is config-changed
[THEN]

FVariable touch -100e touch f!
FVariable motion 0.01e motion f!

: draw-tri-angle ( f -- )
    0.01e 0.02e 0.15e 1.0e glClearColor
    clear
    Ambient 1 ambient% glUniform1fv
    v0  set-triangle
    normals texcoords colors
    none-tex
    i0  0 i, 1 i, 2 i,
    GL_TRIANGLES draw-elements
    v0 colors'
    ascii-tex
    GL_TRIANGLES draw-elements
    sync ;

: draw-tri { f: angle -- angle' }
    new-config @ IF
	dpy-w @ dpy-h @ getwh dpy-w @ dpy-h @ d<> IF  new-config off  THEN
    THEN
    angle draw-tri-angle
    >looper
    *input >r r@ IF
	r@ action @ abs 1 <> 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/




︙





Added gles2/gl-simple.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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

\ simple opengl test

[defined] init-opengl 0= constant standalone
require gl-helper.fs
also opengl
also [IFDEF] android android [THEN]
standalone [if] init-opengl buffer-init [then]

: simple-init ( -- )
    ['] VertexShader ['] FragmentShader create-program to program
    program init  0e >y-pos
    1e 0e 0e 1e glClearColor ;

: draw ( -- )  none-tex
    v0 >v
    -1e -1e >xy  $FFFFFFFF rgba>c  n> v+
     1e -1e >xy  $FFFFFFFF rgba>c  n> v+
     0e  1e >xy  $FFFFFFFF rgba>c  n> v+ v>
    i0 0 i, 1 i, 2 i,
    GL_TRIANGLES draw-elements ;

: simple ( -- )  simple-init
  1 level# +!  begin clear draw sync >looper level# @ 0= until ;

simple






Changes to gles2/gl-terminal.fs.






︙


94
95
96
97
98
99
100
101
102


103
104
105
106
107
108
109

94
95
96
97
98
99
100


101
102
103
104
105
106
107
108
109








-
-
+
+








$ff40bf40 l, \ dimm Green
$ff40bfbf l, \ dimm Yellow
$ffbf4040 l, \ dimm Blue
$ffbf40bf l, \ dimm Magenta
$ffbfbf40 l, \ dimm Cyan
$ffbfbfbf l, \ dimm White

: term-load-textures ( -- )
    chars-tex s" ascii.png" load-texture 2drop linear
: term-load-textures ( addr u -- )
    chars-tex load-texture 2drop linear
    GL_TEXTURE2 glActiveTexture
    color-tex color-matrix $10 1 rgba-map nearest
    GL_TEXTURE0 glActiveTexture ;

Variable color-index
bl dup $70 and 5 lshift or $F0F and 4 lshift color-index !
Variable std-bg




︙


310
311
312
313
314
315
316
317

318
319
320


321
322
323
324
325
326
327

310
311
312
313
314
315
316

317
318
319

320
321
322
323
324
325
326
327
328








-
+


-
+
+








' gl-page IS page
' gl-attr! IS attr!
default-out op-vector !

\ initialize

: term-init ( -- )
    clazz >o hideProgress o>
    [IFDEF] clazz clazz >o hideProgress o> [THEN]
    >screen-orientation
    create-terminal-program to terminal-program
    terminal-program terminal-init term-load-textures form-chooser
    terminal-program terminal-init
    s" ascii.png" 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















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