extra/: more uses of the do-state combinator

factor-shell
Björn Lindqvist 2018-01-27 20:07:00 +01:00
parent 66ce47e30a
commit 88e1f091b9
4 changed files with 24 additions and 26 deletions

View File

@ -1,7 +1,7 @@
! Copyright (C) 2010 Anton Gorenko. ! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.strings gdk.gl.ffi gobject.ffi gtk.ffi gtk.gl.ffi USING: alien.strings gdk.gl.ffi gobject.ffi gtk.ffi gtk.gl.ffi
io.encodings.utf8 kernel locals opengl.gl ; io.encodings.utf8 kernel locals opengl.demo-support opengl.gl ;
IN: gtk-samples.opengl IN: gtk-samples.opengl
! This sample is based on ! This sample is based on
@ -25,14 +25,14 @@ IN: gtk-samples.opengl
[ [
GL_COLOR_BUFFER_BIT glClear GL_COLOR_BUFFER_BIT glClear
GL_TRIANGLES glBegin GL_TRIANGLES [
1.0 0.0 0.0 glColor3f 1.0 0.0 0.0 glColor3f
0 1 glVertex2i 0 1 glVertex2i
0.0 1.0 0.0 glColor3f 0.0 1.0 0.0 glColor3f
-1 -1 glVertex2i -1 -1 glVertex2i
0.0 0.0 1.0 glColor3f 0.0 0.0 1.0 glColor3f
1 -1 glVertex2i 1 -1 glVertex2i
glEnd ] do-state
gl-drawable gdk_gl_drawable_is_double_buffered 1 = gl-drawable gdk_gl_drawable_is_double_buffered 1 =
[ gl-drawable gdk_gl_drawable_swap_buffers ] [ gl-drawable gdk_gl_drawable_swap_buffers ]

View File

@ -1,8 +1,8 @@
! Copyright (C) 2010 Erik Charlebois. ! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel locals math math.order math.polynomials USING: accessors kernel locals math math.order math.polynomials
math.splines opengl.gl sequences ui.gadgets ui.gadgets.panes ui.render math.splines opengl.demo-support opengl.gl sequences ui.gadgets
arrays ; ui.gadgets.panes ui.render arrays ;
IN: math.splines.viewer IN: math.splines.viewer
<PRIVATE <PRIVATE
@ -33,11 +33,11 @@ M:: spline-gadget draw-gadget* ( gadget -- )
[ second y-min - y-max y-min - / gadget spline-dim>> second * ] bi 2array [ second y-min - y-max y-min - / gadget spline-dim>> second * ] bi 2array
] map :> pts ] map :> pts
GL_LINE_STRIP glBegin GL_LINE_STRIP [
pts [ pts [
first2 neg gadget spline-dim>> second + glVertex2f first2 neg gadget spline-dim>> second + glVertex2f
] each ] each ]
glEnd ; do-state ;
:: <spline-gadget> ( polynomials dim steps -- gadget ) :: <spline-gadget> ( polynomials dim steps -- gadget )
spline-gadget new spline-gadget new

View File

@ -1,7 +1,7 @@
! From http://www.ffconsultancy.com/ocaml/maze/index.html ! From http://www.ffconsultancy.com/ocaml/maze/index.html
USING: accessors arrays fry kernel math math.order math.vectors USING: accessors arrays fry kernel math math.order math.vectors
namespaces opengl.gl random sequences ui ui.gadgets namespaces opengl.demo-support opengl.gl random sequences ui
ui.gadgets.canvas ui.render ; ui.gadgets ui.gadgets.canvas ui.render ;
IN: maze IN: maze
CONSTANT: line-width 8 CONSTANT: line-width 8
@ -25,7 +25,7 @@ SYMBOL: visited
: (draw-maze) ( cell -- ) : (draw-maze) ( cell -- )
dup vertex dup vertex
glEnd glEnd
GL_POINTS glBegin dup vertex glEnd GL_POINTS [ dup vertex ] do-state
GL_LINE_STRIP glBegin GL_LINE_STRIP glBegin
dup vertex dup vertex
dup visit dup visit
@ -42,9 +42,9 @@ SYMBOL: visited
line-width 2 - glPointSize line-width 2 - glPointSize
1.0 1.0 1.0 1.0 glColor4d 1.0 1.0 1.0 1.0 glColor4d
dup '[ _ t <array> ] replicate visited set dup '[ _ t <array> ] replicate visited set
GL_LINE_STRIP glBegin GL_LINE_STRIP [
{ 0 0 } dup vertex (draw-maze) { 0 0 } dup vertex (draw-maze)
glEnd ; ] do-state ;
TUPLE: maze < canvas ; TUPLE: maze < canvas ;

View File

@ -1,10 +1,8 @@
USING: alien.c-types alien.data arrays colors.constants grouping USING: alien.c-types alien.data arrays colors.constants grouping
kernel locals math math.vectors namespaces opengl opengl.gl kernel locals math math.vectors namespaces opengl opengl.demo-support
opengl.glu sequences sequences.generalizations shuffle ; opengl.gl opengl.glu sequences sequences.generalizations shuffle ;
IN: processing.shapes IN: processing.shapes
: do-state ( mode quot -- ) swap glBegin call glEnd ; inline
SYMBOL: fill-color SYMBOL: fill-color
SYMBOL: stroke-color SYMBOL: stroke-color