Check-in [a0018d1a41]
Not logged in

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

Overview
Comment:Use larger texture to map all frames into one texture (less draw calls)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a0018d1a41e2203f67a2e48673ff230138fca07d
User & Date: bernd 2013-11-21 23:29:16.908
Context
2013-11-22
00:25
Test slightly rewritten check-in: c180975216 user: bernd tags: trunk
2013-11-21
23:29
Use larger texture to map all frames into one texture (less draw calls) check-in: a0018d1a41 user: bernd tags: trunk
17:04
More tests check-in: 0a777f3526 user: bernd tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to gl-helper.fs.
160
161
162
163
164
165
166
167
168

169
170
171
172
173
174
175
    choose-config create-context getwh ;

?looper \ init-opengl ." Screen size: " dpy-w ? dpy-h ? cr

\ gl shader program

: .glsl-error ( shader -- )
    $1000 pad pad cell+ glGetShaderInfoLog pad cell+ pad @
    BEGIN  #lf $split dup  WHILE  2swap cr type  REPEAT  2drop cr type ;


: compile-shader ( source shadertype -- shader )
    \ ." Compile shader:" cr over @ cstring>sstring type
    glCreateShader dup >r IF
	r@ 1 rot 0 glShaderSource
	r@ glCompileShader
	r@ .glsl-error







|
|
>







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
    choose-config create-context getwh ;

?looper \ init-opengl ." Screen size: " dpy-w ? dpy-h ? cr

\ gl shader program

: .glsl-error ( shader -- )
    $1000 pad pad cell+ glGetShaderInfoLog pad cell+ pad @ #lf skip
    BEGIN  #lf $split dup  WHILE  2swap cr type  REPEAT  2drop
    dup IF  cr type  ELSE  2drop  THEN ;

: compile-shader ( source shadertype -- shader )
    \ ." Compile shader:" cr over @ cstring>sstring type
    glCreateShader dup >r IF
	r@ 1 rot 0 glShaderSource
	r@ glCompileShader
	r@ .glsl-error
414
415
416
417
418
419
420










421
422
423
424
425
426
427
    0 GL_RGBA GL_UNSIGNED_BYTE addr glTexImage2D
    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;

: rgba-map { addr w h -- }
    GL_TEXTURE_2D 0 GL_RGBA w h
    0 GL_RGBA GL_UNSIGNED_BYTE addr glTexImage2D ;











: wrap ( -- )
    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;
: mipmap ( -- )  GL_TEXTURE_2D glGenerateMipmap ;
: linear ( -- )
    GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri







>
>
>
>
>
>
>
>
>
>







415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
    0 GL_RGBA GL_UNSIGNED_BYTE addr glTexImage2D
    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;

: rgba-map { addr w h -- }
    GL_TEXTURE_2D 0 GL_RGBA w h
    0 GL_RGBA GL_UNSIGNED_BYTE addr glTexImage2D ;

: rgba-subtex { addr x y w h -- }
    GL_TEXTURE_2D 0 x y w h
    GL_RGBA GL_UNSIGNED_BYTE addr glTexSubImage2D ;

: rgba-newtex { w h -- }
    w h * 2* 2* dup allocate throw { len addr }  addr len erase
    GL_TEXTURE_2D 0 GL_RGBA w h
    0 GL_RGBA GL_UNSIGNED_BYTE addr glTexImage2D
    addr free throw ;

: wrap ( -- )
    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;
: mipmap ( -- )  GL_TEXTURE_2D glGenerateMipmap ;
: linear ( -- )
    GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
Changes to gles2/gl-helper.fs.
160
161
162
163
164
165
166
167
168

169
170
171
172
173
174
175
    choose-config create-context getwh ;

?looper \ init-opengl ." Screen size: " dpy-w ? dpy-h ? cr

\ gl shader program

: .glsl-error ( shader -- )
    $1000 pad pad cell+ glGetShaderInfoLog pad cell+ pad @
    BEGIN  #lf $split dup  WHILE  2swap cr type  REPEAT  2drop cr type ;


: compile-shader ( source shadertype -- shader )
    \ ." Compile shader:" cr over @ cstring>sstring type
    glCreateShader dup >r IF
	r@ 1 rot 0 glShaderSource
	r@ glCompileShader
	r@ .glsl-error







|
|
>







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
    choose-config create-context getwh ;

?looper \ init-opengl ." Screen size: " dpy-w ? dpy-h ? cr

\ gl shader program

: .glsl-error ( shader -- )
    $1000 pad pad cell+ glGetShaderInfoLog pad cell+ pad @ #lf skip
    BEGIN  #lf $split dup  WHILE  2swap cr type  REPEAT  2drop
    dup IF  cr type  ELSE  2drop  THEN ;

: compile-shader ( source shadertype -- shader )
    \ ." Compile shader:" cr over @ cstring>sstring type
    glCreateShader dup >r IF
	r@ 1 rot 0 glShaderSource
	r@ glCompileShader
	r@ .glsl-error
414
415
416
417
418
419
420










421
422
423
424
425
426
427
    0 GL_RGBA GL_UNSIGNED_BYTE addr glTexImage2D
    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;

: rgba-map { addr w h -- }
    GL_TEXTURE_2D 0 GL_RGBA w h
    0 GL_RGBA GL_UNSIGNED_BYTE addr glTexImage2D ;











: wrap ( -- )
    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;
: mipmap ( -- )  GL_TEXTURE_2D glGenerateMipmap ;
: linear ( -- )
    GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri







>
>
>
>
>
>
>
>
>
>







415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
    0 GL_RGBA GL_UNSIGNED_BYTE addr glTexImage2D
    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;

: rgba-map { addr w h -- }
    GL_TEXTURE_2D 0 GL_RGBA w h
    0 GL_RGBA GL_UNSIGNED_BYTE addr glTexImage2D ;

: rgba-subtex { addr x y w h -- }
    GL_TEXTURE_2D 0 x y w h
    GL_RGBA GL_UNSIGNED_BYTE addr glTexSubImage2D ;

: rgba-newtex { w h -- }
    w h * 2* 2* dup allocate throw { len addr }  addr len erase
    GL_TEXTURE_2D 0 GL_RGBA w h
    0 GL_RGBA GL_UNSIGNED_BYTE addr glTexImage2D
    addr free throw ;

: wrap ( -- )
    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;
: mipmap ( -- )  GL_TEXTURE_2D glGenerateMipmap ;
: linear ( -- )
    GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
Changes to gles2/soil-texture.fs.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16








17
18
19
20
21


22
23
\ soil texture

require gl-helper.fs
require soillib.fs
require jpeg-exif.fs

also soil

: >texture ( addr w h -- )
    2 pick >r rgba-texture wrap nearest r> free throw ;
: mem>texture ( addr u -- addr w h )
    over >r  0 0 0 { w^ w w^ h w^ ch# }
    w h ch# SOIL_LOAD_RGBA SOIL_load_image_from_memory
    r> free throw w @ h @  2dup 2>r >texture 2r> ;
: load-texture ( addr u -- w h )
    open-fpath-file throw 2drop slurp-fid mem>texture ;









tex: thumbnails

: load-thumb ( addr u -- w h )
    >thumbnail mem>texture ;



previous









|
|





>
>
>
>
>
>
>
>





>
>


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
\ soil texture

require gl-helper.fs
require soillib.fs
require jpeg-exif.fs

also soil

: >texture ( addr w h -- )
    2 pick >r rgba-texture wrap mipmap nearest r> free throw ;
: mem>texture ( addr u -- w h )
    over >r  0 0 0 { w^ w w^ h w^ ch# }
    w h ch# SOIL_LOAD_RGBA SOIL_load_image_from_memory
    r> free throw w @ h @  2dup 2>r >texture 2r> ;
: load-texture ( addr u -- w h )
    open-fpath-file throw 2drop slurp-fid mem>texture ;
: >subtex ( addr x y w h -- )
    4 pick >r rgba-subtex wrap mipmap nearest r> free throw ;
: mem>subtex ( x y addr u -- w h )
    over >r  0 0 0 { w^ w w^ h w^ ch# }
    w h ch# SOIL_LOAD_RGBA SOIL_load_image_from_memory
    r> free throw -rot w @ h @  2dup 2>r >subtex 2r> ;
: load-subtex ( x y addr u -- w h )
    open-fpath-file throw 2drop slurp-fid mem>subtex ;

tex: thumbnails

: load-thumb ( addr u -- w h )
    >thumbnail mem>texture ;
: load-subthumb ( x y addr u -- w h )
    >thumbnail mem>subtex ;

previous
Changes to soil-texture.fs.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16








17
18
19
20
21


22
23
\ soil texture

require gl-helper.fs
require soillib.fs
require jpeg-exif.fs

also soil

: >texture ( addr w h -- )
    2 pick >r rgba-texture wrap nearest r> free throw ;
: mem>texture ( addr u -- addr w h )
    over >r  0 0 0 { w^ w w^ h w^ ch# }
    w h ch# SOIL_LOAD_RGBA SOIL_load_image_from_memory
    r> free throw w @ h @  2dup 2>r >texture 2r> ;
: load-texture ( addr u -- w h )
    open-fpath-file throw 2drop slurp-fid mem>texture ;









tex: thumbnails

: load-thumb ( addr u -- w h )
    >thumbnail mem>texture ;



previous









|
|





>
>
>
>
>
>
>
>





>
>


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
\ soil texture

require gl-helper.fs
require soillib.fs
require jpeg-exif.fs

also soil

: >texture ( addr w h -- )
    2 pick >r rgba-texture wrap mipmap nearest r> free throw ;
: mem>texture ( addr u -- w h )
    over >r  0 0 0 { w^ w w^ h w^ ch# }
    w h ch# SOIL_LOAD_RGBA SOIL_load_image_from_memory
    r> free throw w @ h @  2dup 2>r >texture 2r> ;
: load-texture ( addr u -- w h )
    open-fpath-file throw 2drop slurp-fid mem>texture ;
: >subtex ( addr x y w h -- )
    4 pick >r rgba-subtex wrap mipmap nearest r> free throw ;
: mem>subtex ( x y addr u -- w h )
    over >r  0 0 0 { w^ w w^ h w^ ch# }
    w h ch# SOIL_LOAD_RGBA SOIL_load_image_from_memory
    r> free throw -rot w @ h @  2dup 2>r >subtex 2r> ;
: load-subtex ( x y addr u -- w h )
    open-fpath-file throw 2drop slurp-fid mem>subtex ;

tex: thumbnails

: load-thumb ( addr u -- w h )
    >thumbnail mem>texture ;
: load-subthumb ( x y addr u -- w h )
    >thumbnail mem>subtex ;

previous
Changes to widgets-test.fs.
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
frame new value f1
frame new value f2
frame new value f3
frame new value f4
frame new value f5
frame new value f6
f1 >o rdrop
0 x ! 0 y ! dpy-w @ 4 / w ! dpy-h @ 2/ h !
32 border ! $FFFFFFFF frame-color !
' button1 frame-tex !
draw draw,
f2 >o rdrop
dpy-w @ 2/ x ! 0 y ! dpy-w @ 2/ w ! dpy-h @ h !
32 border ! $FF7FFFFF frame-color !
' button2 frame-tex !
draw draw,
f3 >o rdrop
0 x ! dpy-h @ 2/ y ! dpy-w @ 2/ w ! dpy-h @ 2/ 2/ h !
16 border ! $FFFF7FFF frame-color !
' button3 frame-tex !
draw draw,
f4 >o rdrop
0 x ! dpy-h @ 3 4 */ y ! dpy-w @ 4 / w ! dpy-h @ 5 / h !
32 border ! $FF7F7FFF frame-color !
' button3 frame-tex !
draw draw,
f5 >o rdrop
dpy-w @ 4 / x ! dpy-h @ 3 4 */ y ! dpy-w @ 4 / w ! dpy-h @ 5 / h !
8 border ! $7FFF7FFF frame-color !
' button3 frame-tex !
draw draw,
f6 >o rdrop
dpy-w @ 4 / x ! 0 y ! dpy-w @ 4 / w ! dpy-h @ 2/ h !
16 border ! $7FFFFFFF frame-color !
' button1 frame-tex !
draw draw>

previous







|

|
|

|

|
|

|

|
|

|

|
|

|

|
|

|

|



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
frame new value f1
frame new value f2
frame new value f3
frame new value f4
frame new value f5
frame new value f6
f1 >o rdrop
0 x ! 0 y ! dpy-w @ 4 / w ! dpy-h @ 2/ d !
32 border ! $FFFFFFFF frame-color !
button1
draw
f2 >o rdrop
dpy-w @ 2/ x ! 0 y ! dpy-w @ 2/ w ! dpy-h @ 19 20 */ d !
32 border ! $FF7FFFFF frame-color !
button2
draw
f3 >o rdrop
0 x ! dpy-h @ 2/ y ! dpy-w @ 2/ w ! dpy-h @ 2/ 2/ d !
16 border ! $FFFF7FFF frame-color !
button3
draw
f4 >o rdrop
0 x ! dpy-h @ 3 4 */ y ! dpy-w @ 4 / w ! dpy-h @ 5 / d !
32 border ! $FF7F7FFF frame-color !
button3
draw
f5 >o rdrop
dpy-w @ 4 / x ! dpy-h @ 3 4 */ y ! dpy-w @ 4 / w ! dpy-h @ 5 / d !
8 border ! $7FFF7FFF frame-color !
button3
draw
f6 >o rdrop
dpy-w @ 4 / x ! 0 y ! dpy-w @ 4 / w ! dpy-h @ 2/ d !
16 border ! $7FFFFFFF frame-color !
button1
draw draw>

previous
Changes to widgets.fs.
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
    method hglue
    method vglue
    method hglue@ \ cached variant
    method vglue@ \ cached variant
    method xywh
end-class widget

:noname x @ y @ w @ h @ d @ + ; widget to xywh

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

tex: button1
tex: button2
tex: button3

widget class
    field: frame-tex
    field: frame-color
end-class tile

$FFFFFFFF Value defcolor
Variable xoff
Variable yoff


: draw-rectangle { f: x1 f: y1 f: x2 f: y2 -- }
    i? >v
    x1 y2 >xy defcolor rgba>c n> 0e 1e >st v+
    x2 y2 >xy defcolor rgba>c n> 1e 1e >st v+
    x2 y1 >xy defcolor rgba>c n> 1e 0e >st v+
    x1 y1 >xy defcolor rgba>c n> 0e 0e >st v+
    v> dup i, dup 1+ i, dup 2 + i, dup i, dup 2 + i, 3 + i, ;
: tile-draw ( -- )  frame-tex perform
    xywh { x y w h }
    x s>f y s>f x w + s>f y h + s>f
    draw-rectangle GL_TRIANGLES draw-elements ;

' tile-draw tile is draw

tile class







|








|
|
<


|



|
|
|
>



|
|
|
|

|







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
    method hglue
    method vglue
    method hglue@ \ cached variant
    method vglue@ \ cached variant
    method xywh
end-class widget

:noname x @ y @ h @ - w @ h @ d @ + ; widget to xywh

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

tex: style-tex \ 8 x 8 subimages, each sized 128x128
style-tex 1024 dup rgba-newtex


widget class
    field: frame#
    field: frame-color
end-class tile

: #>st ( x y frame -- ) \ using frame#
    8 /mod
    s>f f+ .125e f* fswap
    s>f f+ .125e f* fswap >st ;

: draw-rectangle { f: x1 f: y1 f: x2 f: y2 -- }
    i? >v
    x1 y2 >xy frame-color @ rgba>c n> 0e 1e frame# @ #>st v+
    x2 y2 >xy frame-color @ rgba>c n> 1e 1e frame# @ #>st v+
    x2 y1 >xy frame-color @ rgba>c n> 1e 0e frame# @ #>st v+
    x1 y1 >xy frame-color @ rgba>c n> 0e 0e frame# @ #>st v+
    v> dup i, dup 1+ i, dup 2 + i, dup i, dup 2 + i, 3 + i, ;
: tile-draw ( -- )
    xywh { x y w h }
    x s>f y s>f x w + s>f y h + s>f
    draw-rectangle GL_TRIANGLES draw-elements ;

' tile-draw tile is draw

tile class
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

135




136

137
138
139
140
141

8 c, 9 c, 12 c,   9 c, 12 c, 13 c,
9 c, 10 c, 13 c,  10 c, 13 c, 14 c,
10 c, 11 c, 14 c, 11 c, 14 c, 15 c,
here button-triangles - Constant button-triangles#

: frame-draw ( -- )
    frame-tex perform  frame-color @ border @ xywh { c b x y w h }
    i? >v
    4 0 DO
	4 0 DO
	    x b I button-border + c@ >r
	    r@ 1 and 0= IF drop 0      THEN
	    r> 2 and    IF negate w +  THEN  + s>f
	    y b J button-border + c@ >r
	    r@ 1 and 0= IF drop 0      THEN
	    r> 2 and    IF negate h +  THEN  + s>f >xy
	    c rgba>c
	    n>
	    I sfloats button-st + sf@
	    J sfloats button-st + sf@ >st v+
	LOOP
    LOOP
    v>
    button-triangles button-triangles# bounds DO
	dup I c@ + i,
    LOOP drop
; ' frame-draw frame to draw

: <draw ( -- )  v0 i0
    program glUseProgram
    -1e 1e >apxy
    .01e 100e 100e >ap
    0.6e 0.4e 0.2e 1.0e glClearColor clear
    Ambient 1 ambient% glUniform1fv ;
: draw> ( -- )  GL_TRIANGLES draw-elements sync v0 i0 ;
: draw, ( -- )  GL_TRIANGLES draw-elements v0 i0 ;








button1 "button2.png" load-texture 2drop \ don't need w/h
button2 "button3.png" load-texture 2drop \ don't need w/h
button3 "button.png" load-texture 2drop \ don't need w/h

previous previous previous set-current







|












|









|





|
>

>
>
>
>

>
|
|
<


98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

145
146

8 c, 9 c, 12 c,   9 c, 12 c, 13 c,
9 c, 10 c, 13 c,  10 c, 13 c, 14 c,
10 c, 11 c, 14 c, 11 c, 14 c, 15 c,
here button-triangles - Constant button-triangles#

: frame-draw ( -- )
    frame# @ frame-color @ border @ xywh { f c b x y w h }
    i? >v
    4 0 DO
	4 0 DO
	    x b I button-border + c@ >r
	    r@ 1 and 0= IF drop 0      THEN
	    r> 2 and    IF negate w +  THEN  + s>f
	    y b J button-border + c@ >r
	    r@ 1 and 0= IF drop 0      THEN
	    r> 2 and    IF negate h +  THEN  + s>f >xy
	    c rgba>c
	    n>
	    I sfloats button-st + sf@
	    J sfloats button-st + sf@ f #>st v+
	LOOP
    LOOP
    v>
    button-triangles button-triangles# bounds DO
	dup I c@ + i,
    LOOP drop
; ' frame-draw frame to draw

: <draw ( -- )  v0 i0
    program glUseProgram  style-tex
    -1e 1e >apxy
    .01e 100e 100e >ap
    0.6e 0.4e 0.2e 1.0e glClearColor clear
    Ambient 1 ambient% glUniform1fv ;
: draw> ( -- )  GL_TRIANGLES draw-elements sync 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