From 3bf5d2bfd45cb40cf2b8d839dea851e3865cb1b5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 27 Mar 2009 18:31:25 -0500 Subject: [PATCH] Implement image tesselation in image.tesselation. This is used by opengl.textures to break up large bitmaps into multiple smaller textures. The gl-rect and gl-fill-rect words have different stack effects now, so usages were updated. --- basis/images/tesselation/authors.txt | 1 + .../tesselation/tesselation-tests.factor | 46 +++++++++ basis/images/tesselation/tesselation.factor | 35 +++++++ basis/opengl/opengl-docs.factor | 4 +- basis/opengl/opengl.factor | 46 +++++---- basis/opengl/textures/textures-tests.factor | 16 ++- basis/opengl/textures/textures.factor | 99 +++++++++++++++---- basis/ui/gadgets/debug/debug.factor | 2 +- basis/ui/gadgets/editors/editors.factor | 9 +- basis/ui/gadgets/grids/grids-tests.factor | 3 - basis/ui/gadgets/grids/grids.factor | 7 +- basis/ui/gadgets/panes/panes.factor | 4 +- basis/ui/gadgets/tables/tables.factor | 18 ++-- basis/ui/pens/solid/solid.factor | 4 +- basis/ui/render/render.factor | 2 +- extra/cap/cap.factor | 4 +- extra/math/matrices/matrices-tests.factor | 3 + extra/math/matrices/matrices.factor | 5 +- extra/tetris/gl/gl.factor | 2 +- extra/ui/gadgets/lists/lists.factor | 4 +- 20 files changed, 233 insertions(+), 81 deletions(-) create mode 100644 basis/images/tesselation/authors.txt create mode 100644 basis/images/tesselation/tesselation-tests.factor create mode 100644 basis/images/tesselation/tesselation.factor diff --git a/basis/images/tesselation/authors.txt b/basis/images/tesselation/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/images/tesselation/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/images/tesselation/tesselation-tests.factor b/basis/images/tesselation/tesselation-tests.factor new file mode 100644 index 0000000000..2ac8e37ae7 --- /dev/null +++ b/basis/images/tesselation/tesselation-tests.factor @@ -0,0 +1,46 @@ +USING: images accessors kernel tools.test literals math.ranges +byte-arrays ; +IN: images.tesselation + +! Check an invariant we depend on +[ t ] [ + B{ 1 2 3 } >>bitmap dup clone [ bitmap>> ] bi@ eq? +] unit-test + +[ + { + { + T{ image f { 2 2 } L f B{ 1 2 5 6 } } + T{ image f { 2 2 } L f B{ 3 4 7 8 } } + } + { + T{ image f { 2 2 } L f B{ 9 10 13 14 } } + T{ image f { 2 2 } L f B{ 11 12 15 16 } } + } + } +] [ + + 1 16 [a,b] >byte-array >>bitmap + { 4 4 } >>dim + L >>component-order + { 2 2 } tesselate +] unit-test + +[ + { + { + T{ image f { 2 2 } L f B{ 1 2 4 5 } } + T{ image f { 1 2 } L f B{ 3 6 } } + } + { + T{ image f { 2 1 } L f B{ 7 8 } } + T{ image f { 1 1 } L f B{ 9 } } + } + } +] [ + + 1 9 [a,b] >byte-array >>bitmap + { 3 3 } >>dim + L >>component-order + { 2 2 } tesselate +] unit-test \ No newline at end of file diff --git a/basis/images/tesselation/tesselation.factor b/basis/images/tesselation/tesselation.factor new file mode 100644 index 0000000000..694041a28d --- /dev/null +++ b/basis/images/tesselation/tesselation.factor @@ -0,0 +1,35 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: sequences kernel math grouping fry columns locals accessors +images math math.vectors arrays ; +IN: images.tesselation + +: group-rows ( bitmap bitmap-dim -- rows ) + first ; inline + +: tesselate-rows ( bitmap-rows tess-dim -- bitmaps ) + second ; inline + +: tesselate-columns ( bitmap-rows tess-dim -- bitmaps ) + first '[ _ ] map flip ; inline + +: tesselate-bitmap ( bitmap bitmap-dim tess-dim -- bitmap-grid ) + [ group-rows ] dip + [ tesselate-rows ] keep + '[ _ tesselate-columns ] map ; + +: tile-width ( tile-bitmap original-image -- width ) + [ first length ] [ component-order>> bytes-per-pixel ] bi* /i ; + +: ( tile-bitmap original-image -- tile-image ) + clone + swap + [ concat >>bitmap ] + [ [ over tile-width ] [ length ] bi 2array >>dim ] bi ; + +:: tesselate ( image tess-dim -- image-grid ) + image component-order>> bytes-per-pixel :> bpp + image dim>> { bpp 1 } v* :> image-dim' + tess-dim { bpp 1 } v* :> tess-dim' + image bitmap>> image-dim' tess-dim' tesselate-bitmap + [ [ image ] map ] map ; \ No newline at end of file diff --git a/basis/opengl/opengl-docs.factor b/basis/opengl/opengl-docs.factor index acff2dcd9e..f474c97b73 100644 --- a/basis/opengl/opengl-docs.factor +++ b/basis/opengl/opengl-docs.factor @@ -23,11 +23,11 @@ HELP: gl-line { $description "Draws a line between two points." } ; HELP: gl-fill-rect -{ $values { "dim" "a pair of integers" } } +{ $values { "loc" "a pair of integers" } { "dim" "a pair of integers" } } { $description "Draws a filled rectangle with the top-left corner at the origin and the given dimensions." } ; HELP: gl-rect -{ $values { "dim" "a pair of integers" } } +{ $values { "loc" "a pair of integers" } { "dim" "a pair of integers" } } { $description "Draws the outline of a rectangle with the top-left corner at the origin and the given dimensions." } ; HELP: gen-gl-buffer diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 9e39dac20c..0a21f67376 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -3,8 +3,8 @@ ! Portions copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types continuations kernel libc math macros -namespaces math.vectors math.parser opengl.gl opengl.glu -combinators arrays sequences splitting words byte-arrays assocs +namespaces math.vectors math.parser opengl.gl opengl.glu combinators +combinators.smart arrays sequences splitting words byte-arrays assocs colors colors.constants accessors generalizations locals fry specialized-arrays.float specialized-arrays.uint ; IN: opengl @@ -67,42 +67,46 @@ MACRO: all-enabled-client-state ( seq quot -- ) : gl-line ( a b -- ) line-vertices GL_LINES 0 2 glDrawArrays ; -: (rect-vertices) ( dim -- vertices ) +:: (rect-vertices) ( loc dim -- vertices ) #! We use GL_LINE_STRIP with a duplicated first vertex #! instead of GL_LINE_LOOP to work around a bug in Apple's #! X3100 driver. - { - [ drop 0.5 0.5 ] - [ first 0.3 - 0.5 ] - [ [ first 0.3 - ] [ second 0.3 - ] bi ] - [ second 0.3 - 0.5 swap ] - [ drop 0.5 0.5 ] - } cleave 10 float-array{ } nsequence ; + loc first2 :> y :> x + dim first2 :> h :> w + [ + x 0.5 + y 0.5 + + x w + 0.3 - y 0.5 + + x w + 0.3 - y h + 0.3 - + x y h + 0.3 - + x 0.5 + y 0.5 + + ] float-array{ } output>sequence ; -: rect-vertices ( dim -- ) +: rect-vertices ( loc dim -- ) (rect-vertices) gl-vertex-pointer ; : (gl-rect) ( -- ) GL_LINE_STRIP 0 5 glDrawArrays ; -: gl-rect ( dim -- ) +: gl-rect ( loc dim -- ) rect-vertices (gl-rect) ; -: (fill-rect-vertices) ( dim -- vertices ) - { - [ drop 0 0 ] - [ first 0 ] - [ first2 ] - [ second 0 swap ] - } cleave 8 float-array{ } nsequence ; +:: (fill-rect-vertices) ( loc dim -- vertices ) + loc first2 :> y :> x + dim first2 :> h :> w + [ + x y + x w + y + x w + y h + + x y h + + ] float-array{ } output>sequence ; -: fill-rect-vertices ( dim -- ) +: fill-rect-vertices ( loc dim -- ) (fill-rect-vertices) gl-vertex-pointer ; : (gl-fill-rect) ( -- ) GL_QUADS 0 4 glDrawArrays ; -: gl-fill-rect ( dim -- ) +: gl-fill-rect ( loc dim -- ) fill-rect-vertices (gl-fill-rect) ; : do-attribs ( bits quot -- ) diff --git a/basis/opengl/textures/textures-tests.factor b/basis/opengl/textures/textures-tests.factor index 7141caa67d..163871028d 100644 --- a/basis/opengl/textures/textures-tests.factor +++ b/basis/opengl/textures/textures-tests.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: tools.test opengl.textures opengl.textures.private -images kernel namespaces ; +opengl.textures.private images kernel namespaces accessors +sequences ; IN: opengl.textures.tests [ ] [ @@ -52,4 +53,17 @@ IN: opengl.textures.tests { component-order R32G32B32 } { bitmap B{ } } } power-of-2-image +] unit-test + +[ + { + { { 0 0 } { 10 0 } } + { { 0 20 } { 10 20 } } + } +] [ + { + { { 10 20 } { 30 20 } } + { { 10 30 } { 30 300 } } + } + [ [ image new swap >>dim ] map ] map image-locs ] unit-test \ No newline at end of file diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor index 48cdafb837..810aaa2c9c 100644 --- a/basis/opengl/textures/textures.factor +++ b/basis/opengl/textures/textures.factor @@ -1,16 +1,15 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs cache colors.constants destructors fry kernel -opengl opengl.gl combinators images grouping specialized-arrays.float -locals sequences math math.vectors generalizations ; +opengl opengl.gl combinators images images.tesselation grouping +specialized-arrays.float locals sequences math math.vectors +math.matrices generalizations fry columns ; IN: opengl.textures : gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ; : delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ; -TUPLE: texture loc dim texture-coords texture display-list disposed ; - GENERIC: component-order>format ( component-order -- format type ) M: RGB component-order>format drop GL_RGB GL_UNSIGNED_BYTE ; @@ -19,8 +18,14 @@ M: RGBA component-order>format drop GL_RGBA GL_UNSIGNED_BYTE ; M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ; M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ; +GENERIC: draw-texture ( texture -- ) + +GENERIC: draw-scaled-texture ( dim texture -- ) + format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ; GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ; -: draw-textured-rect ( dim texture -- ) +: with-texturing ( quot -- ) GL_TEXTURE_2D [ GL_TEXTURE_BIT [ GL_TEXTURE_COORD_ARRAY [ COLOR: white gl-color - dup loc>> [ - [ [ GL_TEXTURE_2D ] dip texture>> glBindTexture ] - [ init-texture texture-coords>> gl-texture-coord-pointer ] bi - fill-rect-vertices (gl-fill-rect) - GL_TEXTURE_2D 0 glBindTexture - ] with-translation + call ] do-enabled-client-state ] do-attribs - ] do-enabled ; + ] do-enabled ; inline + +: (draw-textured-rect) ( dim texture -- ) + [ loc>> ] + [ [ GL_TEXTURE_2D ] dip texture>> glBindTexture ] + [ init-texture texture-coords>> gl-texture-coord-pointer ] tri + swap gl-fill-rect ; + +: draw-textured-rect ( dim texture -- ) + [ + (draw-textured-rect) + GL_TEXTURE_2D 0 glBindTexture + ] with-texturing ; : texture-coords ( dim -- coords ) [ dup next-power-of-2 /f ] map @@ -92,10 +104,8 @@ M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ; : make-texture-display-list ( texture -- dlist ) GL_COMPILE [ [ dim>> ] keep draw-textured-rect ] make-dlist ; -PRIVATE> - -: ( image loc -- texture ) - texture new swap >>loc +: ( image loc -- texture ) + single-texture new swap >>loc swap [ dim>> >>dim ] keep [ dim>> product 0 = ] keep '[ @@ -105,12 +115,59 @@ PRIVATE> dup make-texture-display-list >>display-list ] unless ; -M: texture dispose* +M: single-texture dispose* [ texture>> [ delete-texture ] when* ] [ display-list>> [ delete-dlist ] when* ] bi ; -: draw-texture ( texture -- ) - display-list>> [ glCallList ] when* ; +M: single-texture draw-texture display-list>> [ glCallList ] when* ; -: draw-scaled-texture ( dim texture -- ) - dup texture>> [ draw-textured-rect ] [ 2drop ] if ; \ No newline at end of file +M: single-texture draw-scaled-texture + dup texture>> [ draw-textured-rect ] [ 2drop ] if ; + +TUPLE: multi-texture grid display-list loc disposed ; + +: image-locs ( image-grid -- loc-grid ) + [ first [ dim>> first ] map ] [ 0 [ dim>> second ] map ] bi + [ 0 [ + ] accumulate nip ] bi@ + cross-zip flip ; + +: ( image-grid loc -- grid ) + [ dup image-locs ] dip + '[ [ _ v+ |dispose ] 2map ] 2map ; + +: draw-textured-grid ( grid -- ) + [ [ [ dim>> ] keep (draw-textured-rect) ] each ] each ; + +: make-textured-grid-display-list ( grid -- dlist ) + GL_COMPILE [ + [ + [ + [ + [ dim>> ] keep (draw-textured-rect) + ] each + ] each + GL_TEXTURE_2D 0 glBindTexture + ] with-texturing + ] make-dlist ; + +: ( image-grid loc -- multi-texture ) + [ + [ + dup + make-textured-grid-display-list + ] keep + f multi-texture boa + ] with-destructors ; + +M: multi-texture draw-texture display-list>> [ glCallList ] when* ; + +M: multi-texture dispose* grid>> [ [ dispose ] each ] each ; + +CONSTANT: max-texture-size { 256 256 } + +PRIVATE> + +: ( image loc -- texture ) + over dim>> max-texture-size [ <= ] 2all? + [ ] + [ [ max-texture-size tesselate ] dip ] if ; \ No newline at end of file diff --git a/basis/ui/gadgets/debug/debug.factor b/basis/ui/gadgets/debug/debug.factor index f8d496c1fc..786a97f689 100644 --- a/basis/ui/gadgets/debug/debug.factor +++ b/basis/ui/gadgets/debug/debug.factor @@ -58,7 +58,7 @@ M: metrics-paint draw-boundary COLOR: red gl-color [ dim>> ] [ >label< line-metrics ] bi [ [ first ] [ ascent>> ] bi* [ nip 0 swap 2array ] [ 2array ] 2bi gl-line ] - [ drop gl-rect ] + [ drop { 0 0 } swap gl-rect ] 2bi ; : ( text font -- gadget ) diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 55622503b6..f5b7f63d22 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -172,11 +172,10 @@ TUPLE: selected-line start end first? last? ; :: draw-selection ( line pair editor -- ) pair [ editor font>> line offset>x ] map :> pair - pair first 0 2array [ - editor selection-color>> gl-color - pair second pair first - round 1 max - editor line-height 2array gl-fill-rect - ] with-translation ; + editor selection-color>> gl-color + pair first 0 2array + pair second pair first - round 1 max editor line-height 2array + gl-fill-rect ; : draw-unselected-line ( line editor -- ) font>> swap draw-text ; diff --git a/basis/ui/gadgets/grids/grids-tests.factor b/basis/ui/gadgets/grids/grids-tests.factor index fb92cd2ac6..b83f1a7003 100644 --- a/basis/ui/gadgets/grids/grids-tests.factor +++ b/basis/ui/gadgets/grids/grids-tests.factor @@ -3,9 +3,6 @@ namespaces math.rectangles accessors ui.gadgets.grids.private ui.gadgets.debug sequences ; IN: ui.gadgets.grids.tests -[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ] -[ { 1 2 } { "a" "b" } cross-zip ] unit-test - [ { 0 0 } ] [ { } pref-dim ] unit-test : 100x100 ( -- gadget ) { 100 100 } >>dim ; diff --git a/basis/ui/gadgets/grids/grids.factor b/basis/ui/gadgets/grids/grids.factor index 4ab080464b..ddcfa1465d 100644 --- a/basis/ui/gadgets/grids/grids.factor +++ b/basis/ui/gadgets/grids/grids.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel math math.order namespaces make sequences words io +USING: arrays kernel math math.order math.matrices namespaces make sequences words io math.vectors ui.gadgets ui.baseline-alignment columns accessors strings.tables math.rectangles fry ; IN: ui.gadgets.grids @@ -33,9 +33,6 @@ PRIVATE> ( gadget -- cell ) @@ -116,7 +113,7 @@ M: grid layout* [ grid>> ] [ ] bi grid-layout ; M: grid children-on ( rect gadget -- seq ) dup children>> empty? [ 2drop f ] [ - { 0 1 } swap grid>> + [ { 0 1 } ] dip grid>> [ 0 fast-children-on ] keep concat ] if ; diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 44da013f2c..a6bd5c4e29 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -79,9 +79,7 @@ GENERIC: draw-selection ( loc obj -- ) M: gadget draw-selection ( loc gadget -- ) swap offset-rect [ - dup loc>> [ - dim>> gl-fill-rect - ] with-translation + rect-bounds gl-fill-rect ] if-fits ; M: node draw-selection ( loc node -- ) diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index 7b1befc539..f2ed5b10e0 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -121,16 +121,15 @@ M: table layout* [ [ line-height ] dip * 0 swap 2array ] [ drop [ dim>> first ] [ line-height ] bi 2array ] 2bi ; -: highlight-row ( table row color quot -- ) - [ [ row-rect rect-bounds ] dip gl-color ] dip - '[ _ @ ] with-translation ; inline +: row-bounds ( table row -- loc dim ) + row-rect rect-bounds ; inline : draw-selected-row ( table -- ) { { [ dup selected-index>> not ] [ drop ] } [ - [ ] [ selected-index>> ] [ selection-color>> ] tri - [ gl-fill-rect ] highlight-row + [ ] [ selected-index>> ] [ selection-color>> gl-color ] tri + row-bounds gl-fill-rect ] } cond ; @@ -139,14 +138,15 @@ M: table layout* { [ dup focused?>> not ] [ drop ] } { [ dup selected-index>> not ] [ drop ] } [ - [ ] [ selected-index>> ] [ focus-border-color>> ] tri - [ gl-rect ] highlight-row + [ ] [ selected-index>> ] [ focus-border-color>> gl-color ] tri + row-bounds gl-rect ] } cond ; : draw-moused-row ( table -- ) dup mouse-index>> dup [ - over mouse-color>> [ gl-rect ] highlight-row + over mouse-color>> gl-color + row-bounds gl-rect ] [ 2drop ] if ; : column-line-offsets ( table -- xs ) @@ -279,7 +279,7 @@ PRIVATE> : row-action ( table -- ) dup selected-row - [ swap [ action>> call ] [ dup hook>> call ] bi ] + [ swap [ action>> call( value -- ) ] [ dup hook>> call( table -- ) ] bi ] [ 2drop ] if ; diff --git a/basis/ui/pens/solid/solid.factor b/basis/ui/pens/solid/solid.factor index 950035e773..fe44a8f341 100644 --- a/basis/ui/pens/solid/solid.factor +++ b/basis/ui/pens/solid/solid.factor @@ -9,8 +9,8 @@ TUPLE: solid < caching-pen color interior-vertices boundary-vertices ; M: solid recompute-pen swap dim>> - [ (fill-rect-vertices) >>interior-vertices ] - [ (rect-vertices) >>boundary-vertices ] + [ [ { 0 0 } ] dip (fill-rect-vertices) >>interior-vertices ] + [ [ { 0 0 } ] dip (rect-vertices) >>boundary-vertices ] bi drop ; > gl-fill-rect ; + { 0 0 } clip get dim>> gl-fill-rect ; GENERIC: draw-gadget* ( gadget -- ) diff --git a/extra/cap/cap.factor b/extra/cap/cap.factor index 64696759bb..f43787673a 100644 --- a/extra/cap/cap.factor +++ b/extra/cap/cap.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays byte-arrays kernel math namespaces -opengl.gl sequences math.vectors ui images images.viewer -models ui.gadgets.worlds ui.gadgets fry alien.syntax ; +opengl.gl sequences math.vectors ui images images.normalization +images.viewer models ui.gadgets.worlds ui.gadgets fry alien.syntax ; IN: cap : screenshot-array ( world -- byte-array ) diff --git a/extra/math/matrices/matrices-tests.factor b/extra/math/matrices/matrices-tests.factor index 6f87109ba0..20942356de 100644 --- a/extra/math/matrices/matrices-tests.factor +++ b/extra/math/matrices/matrices-tests.factor @@ -104,3 +104,6 @@ USING: math.matrices math.vectors tools.test math ; [ { 0 1 0 } ] [ { 0 0 1 } { 1 0 0 } cross ] unit-test [ { 1 0 0 } ] [ { 1 1 0 } { 1 0 0 } proj ] unit-test + +[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ] +[ { 1 2 } { "a" "b" } cross-zip ] unit-test \ No newline at end of file diff --git a/extra/math/matrices/matrices.factor b/extra/math/matrices/matrices.factor index 0088b17372..7c687d753d 100755 --- a/extra/math/matrices/matrices.factor +++ b/extra/math/matrices/matrices.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math math.order math.vectors sequences ; IN: math.matrices @@ -57,3 +57,6 @@ PRIVATE> : norm-gram-schmidt ( seq -- orthonormal ) gram-schmidt [ normalize ] map ; + +: cross-zip ( seq1 seq2 -- seq1xseq2 ) + [ [ 2array ] with map ] curry map ; \ No newline at end of file diff --git a/extra/tetris/gl/gl.factor b/extra/tetris/gl/gl.factor index f8c901ff56..d1f398994e 100644 --- a/extra/tetris/gl/gl.factor +++ b/extra/tetris/gl/gl.factor @@ -8,7 +8,7 @@ IN: tetris.gl #! OpenGL rendering for tetris : draw-block ( block -- ) - [ { 1 1 } gl-fill-rect ] with-translation ; + { 1 1 } gl-fill-rect ; : draw-piece-blocks ( piece -- ) piece-blocks [ draw-block ] each ; diff --git a/extra/ui/gadgets/lists/lists.factor b/extra/ui/gadgets/lists/lists.factor index d7301ca042..aa98793c70 100644 --- a/extra/ui/gadgets/lists/lists.factor +++ b/extra/ui/gadgets/lists/lists.factor @@ -57,9 +57,7 @@ M: list draw-gadget* origin get [ dup color>> gl-color selected-rect [ - dup loc>> [ - dim>> gl-fill-rect - ] with-translation + rect-bounds gl-fill-rect ] when* ] with-translation ;