factor/contrib/x11/examples/double.factor

49 lines
1.4 KiB
Factor
Raw Permalink Normal View History

2005-12-30 21:51:15 -05:00
USING: kernel sequences namespaces math threads io opengl concurrency
2005-12-30 21:35:38 -05:00
x xlib x11 gl concurrent-widgets ;
2005-12-30 21:53:49 -05:00
SYMBOL: loop-action [ ] loop-action set
2005-12-30 20:53:19 -05:00
2005-12-30 21:53:49 -05:00
SYMBOL: spin 0.0 spin set
2005-12-30 20:53:19 -05:00
: init ( -- ) 0.0 0.0 0.0 0.0 glClearColor GL_FLAT glShadeModel ;
: display ( -- )
GL_COLOR_BUFFER_BIT glClear
glPushMatrix
spin get 0.0 0.0 1.0 glRotatef
1.0 1.0 1.0 glColor3f
-25.0 -25.0 25.0 25.0 glRectf
glPopMatrix
2005-12-30 21:35:38 -05:00
swap-buffers ;
2005-12-30 20:53:19 -05:00
: spin-display ( -- )
spin get 2.0 + spin set
2005-12-30 21:53:49 -05:00
spin get 360.0 > [ spin get 360.0 - spin set ] when display ;
2005-12-30 20:53:19 -05:00
: reshape ( { width height } -- )
2005-12-30 21:35:38 -05:00
>r 0 0 r> [ ] each glViewport
2005-12-30 20:53:19 -05:00
GL_PROJECTION glMatrixMode glLoadIdentity
-50.0 50.0 -50.0 50.0 -1.0 1.0 glOrtho
GL_MODELVIEW glMatrixMode glLoadIdentity ;
: mouse ( event -- )
2005-12-30 21:35:38 -05:00
{ { [ dup XButtonEvent-button Button1 = ]
2005-12-30 21:51:15 -05:00
[ global [ [ spin-display ] loop-action set ] bind drop ] }
2005-12-30 21:35:38 -05:00
{ [ dup XButtonEvent-button Button2 = ]
2005-12-30 21:51:15 -05:00
[ global [ [ ] loop-action set ] bind drop ] }
2005-12-30 20:53:19 -05:00
{ [ t ] [ drop ] } } cond ;
2005-12-30 21:51:15 -05:00
: loop ( -- ) loop-action get call 10 sleep loop ;
2005-12-30 20:53:19 -05:00
f initialize-x
create-pwindow
2006-01-02 13:41:39 -05:00
[ drop reshape ] over set-pwindow-resize-action
[ drop mouse ] over set-pwindow-button-action
2005-12-30 20:53:19 -05:00
window-id win set
2005-12-30 21:35:38 -05:00
StructureNotifyMask ButtonPressMask bitor select-input
2005-12-30 20:53:19 -05:00
{ 250 250 } resize-window { 100 100 } move-window map-window
[ GLX_RGBA GLX_DOUBLEBUFFER ] choose-visual create-context make-current
2005-12-30 21:53:49 -05:00
init [ concurrent-event-loop ] spawn [ loop ] spawn