diff --git a/contrib/x11/examples/automata.factor b/contrib/x11/examples/automata.factor deleted file mode 100644 index f5480b5bbb..0000000000 --- a/contrib/x11/examples/automata.factor +++ /dev/null @@ -1,103 +0,0 @@ -! Ed Cavazos - wayo.cavazos@gmail.com - -! Load, compile and then save your image: -! "load.factor" run-file save -! To run the program: -! USE: automata setup-window random-gallery - -USING: parser kernel hashtables namespaces sequences lists math io -math-contrib threads strings arrays prettyprint x11 x ; - -IN: automata - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! set-rule -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: rule 8 rule set-global - -: rule-keys ( -- { ... } ) -{ { 0 0 0 } - { 0 0 1 } - { 0 1 0 } - { 0 1 1 } - { 1 0 0 } - { 1 0 1 } - { 1 1 0 } - { 1 1 1 } } ; - -: rule-values ( n -- { ... } ) >bin 8 CHAR: 0 pad-left >array [ 48 - ] map ; - -: set-rule ( n -- ) rule-values rule-keys [ rule get set-hash ] 2each ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! step -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: 3nth ( n seq -- slice ) >r dup 3 + r> ; - -: next-chunk ( << slice: a b c >> - value ) >array rule get hash ; - -: (step) ( line -- new-line ) dup length 2 - [ swap 3nth next-chunk ] map-with ; - -: step-line ( line -- new-line ) >r { 0 } r> { 0 } append append (step) ; - -: last ( seq -- item ) dup length 1 - swap nth ; - -: step-line-wrapped ( line -- new-line ) -dup last 1array swap dup first 1array append append (step) ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Display the rule -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: setup-window ( -- ) -f initialize-x create-window win set -{ 400 400 } resize-window map-window flush-dpy ; - -: random-line ( -- line ) window-width [ drop 2 random-int ] map ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! show-line -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: show-point ( { x y } p -- ) 1 = [ draw-point ] [ drop ] if ; - -: (show-line) ( { x y } line -- ) -[ >r dup r> show-point { 1 0 } v+ ] each drop ; - -: show-line ( y line -- ) >r >r 0 r> 2array r> (show-line) ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Go -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: run-rule ( -- last-line ) clear-window -0 random-line window-height [ drop 2dup show-line >r 1 + r> step-line ] -each nip flush-dpy ; - -: run-rule-wrapped ( -- last-line ) clear-window -0 random-line 400 [ drop 2dup show-line >r 1 + r> step-line-wrapped ] each nip -flush-dpy ; - -: continue-rule ( first-line -- last-line ) clear-window -0 swap 400 [ drop 2dup show-line swap 1 + swap step-line ] each nip -flush-dpy ; - -: continue-rule-wrapped ( first-line -- last-line ) clear-window -0 swap 400 [ drop 2dup show-line swap 1 + swap step-line-wrapped ] each nip -flush-dpy ; - -: random-gallery ( -- ) -255 random-int 1 + dup unparse print flush -set-rule run-rule 5000 sleep random-gallery ; - -SYMBOL: interesting - -{ 150 193 165 146 144 86 104 } interesting set-global - -: random-item ( seq -- item ) dup length random-int swap nth ; - -: random-interesting-gallery ( -- ) -interesting get random-item set-rule run-rule drop 10000 sleep -random-interesting-gallery ; diff --git a/contrib/x11/examples/boids.factor b/contrib/x11/examples/boids.factor deleted file mode 100644 index b5bbd4bf66..0000000000 --- a/contrib/x11/examples/boids.factor +++ /dev/null @@ -1,273 +0,0 @@ -! Eduardo Cavazos - wayo.cavazos@gmail.com - -! Load, compile and then save your image: -! "load.factor" run-file save -! To run the program: -! USE: boids setup-window run-boids - -USING: threads namespaces math kernel sequences arrays x11 x ; IN: boids - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: separation-radius 100 separation-radius set-global -SYMBOL: alignment-radius 100 alignment-radius set-global -SYMBOL: cohesion-radius 100 cohesion-radius set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: separation-view-angle 90 separation-view-angle set-global -SYMBOL: alignment-view-angle 90 alignment-view-angle set-global -SYMBOL: cohesion-view-angle 90 cohesion-view-angle set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: separation-weight 1.0 separation-weight set-global -SYMBOL: alignment-weight 0.5 alignment-weight set-global -SYMBOL: cohesion-weight 1.0 cohesion-weight set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: world-size { 400 400 } world-size set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -TUPLE: boid pos vel ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: time-slice 0.5 time-slice set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! random-boid and random-boids -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! : random-range dupd swap - random-int + ; - -: random-range ( a b -- n ) 1 + dupd swap - random-int + ; - -! : random-n ( n -- random-0-to-n-1 ) -! 1 - 0 swap random-int ; - -: random-pos ( -- pos ) world-size get [ random-int ] map ; - -: random-vel ( -- vel ) 2 >array [ drop -10 10 random-range ] map ; - -: random-boid ( -- boid ) random-pos random-vel ; - -: random-boids ( n -- boids ) >array [ drop random-boid ] map ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: boids - -: setup-window - f initialize-x - create-window win set - world-size get resize-window - map-window - flush-dpy - 50 random-boids boids set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! draw-boid -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: boid-point-a ( boid -- point-a ) boid-pos ; - -: boid-point-b ( boid -- point-b ) - dup >r boid-pos - r> boid-vel normalize 20 v*n - v+ ; - -: boid-points ( boid -- point-a point-b ) - dup >r boid-point-a r> boid-point-b ; - -: draw-boid ( boid -- ) boid-points draw-line ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: distance ( boid boid -- n ) boid-pos swap boid-pos v- norm ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: r->d ( radians -- degrees ) 180 * pi / ; - -: constrain ( n a b -- n ) >r max r> min ; - -: angle-between ( vec vec -- angle ) - 2dup >r >r - v. r> norm r> norm * / -1 1 constrain acos r->d ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: relative-angle ( self other -- angle ) - over >r >r - boid-vel r> boid-pos r> boid-pos v- angle-between ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: vsum ( vector-of-vectors --- vec ) { 0 0 } [ v+ ] reduce ; - -: average-position ( boids -- pos ) - [ boid-pos ] map dup >r vsum r> length v/n ; - -: average-velocity ( boids -- vel ) - [ boid-vel ] map dup >r vsum r> length v/n ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: subset-with ( obj seq quot -- seq | quot: obj elt -- elt ) - [ >r dup r> ] swap append subset ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: within-radius? ( self other radius -- ? ) >r distance r> <= ; - -: within-view-angle? ( self other view-angle -- ? ) - >r relative-angle r> 2 / <= ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: within-separation-radius? ( self other -- ? ) - separation-radius get within-radius? ; - -: within-separation-view? ( self other -- ? ) - separation-view-angle get within-view-angle? ; - -: within-separation-neighborhood? ( self other -- ? ) - [ eq? not ] 2keep - [ within-separation-radius? ] 2keep - within-separation-view? - and and ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: within-alignment-radius? ( self other -- ? ) - alignment-radius get within-radius? ; - -: within-alignment-view? ( self other -- ? ) - alignment-view-angle get within-view-angle? ; - -: within-alignment-neighborhood? ( self other -- ? ) - [ eq? not ] 2keep - [ within-alignment-radius? ] 2keep - within-alignment-view? - and and ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: within-cohesion-radius? ( self other -- ? ) - cohesion-radius get within-radius? ; - -: within-cohesion-view? ( self other -- ? ) - cohesion-view-angle get within-view-angle? ; - -: within-cohesion-neighborhood? ( self other -- ? ) - [ eq? not ] 2keep - [ within-cohesion-radius? ] 2keep - within-cohesion-view? - and and ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: separation-force ( self -- force ) - ! boids get [ within-separation-neighborhood? ] subset-with - boids get [ >r dup r> within-separation-neighborhood? ] subset - dup length 0 = - [ drop drop { 0 0 } ] - [ average-position - >r boid-pos r> v- - normalize - separation-weight get - v*n ] - if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: alignment-force ( self -- force ) - ! boids get [ within-alignment-neighborhood? ] subset-with - boids get [ >r dup r> within-alignment-neighborhood? ] subset swap drop - dup length 0 = - [ drop { 0 0 } ] - [ average-velocity - normalize - alignment-weight get - v*n ] - if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: cohesion-force ( self -- force ) - ! boids get [ within-cohesion-neighborhood? ] subset-with - boids get [ >r dup r> within-cohesion-neighborhood? ] subset - dup length 0 = - [ drop drop { 0 0 } ] - [ average-position - swap ! avg-pos self - boid-pos v- - normalize - cohesion-weight get - v*n ] - if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! F = m a -! -! We let m be equal to 1 so then this is simply: F = a - -! : acceleration ( boid -- acceleration ) -! dup >r dup >r -! separation-force r> alignment-force r> cohesion-force v+ v+ ; - -: acceleration ( boid -- acceleration ) - dup dup - separation-force rot - alignment-force rot - cohesion-force v+ v+ ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! iterate-boid -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: new-pos ( boid -- pos ) - dup >r boid-pos r> boid-vel time-slice get v*n v+ ; - -! : new-vel ( boid -- vel ) -! dup >r boid-vel r> acceleration time-slice get v*n v+ ; - -: new-vel ( boid -- vel ) - dup boid-vel swap acceleration time-slice get v*n v+ ; - -: wrap-x ( x -- x ) - dup 0 world-size get nth >= [ drop 0 ] when - dup 0 < [ drop 0 world-size get nth 1 - ] when ; - -: wrap-y ( y -- y ) - dup 1 world-size get nth >= [ drop 0 ] when - dup 0 < [ drop 1 world-size get nth 1 - ] when ; - -: wrap-pos ( pos -- pos ) [ ] each wrap-y swap wrap-x swap 2array ; - -: iterate-boid ( self -- self ) dup >r new-pos wrap-pos r> new-vel ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: iterate-boids ( -- ) boids get [ iterate-boid ] map boids set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: draw-boids ( -- ) boids get [ draw-boid ] each flush-dpy ; - -: run-boids ( -- ) iterate-boids clear-window draw-boids 1 sleep run-boids ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Comments from others: -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! slava foo get blah foo set ==> foo [ blah ] change -! slava dup >r blah r> ==> [ blah ] keep - -! : execute-with ( item [ word word ... ] -- results ... ) -! [ over >r execute r> ] each drop ; - diff --git a/contrib/x11/examples/cube.factor b/contrib/x11/examples/cube.factor deleted file mode 100644 index fbd807ef10..0000000000 --- a/contrib/x11/examples/cube.factor +++ /dev/null @@ -1,63 +0,0 @@ -USING: kernel sequences namespaces math threads io opengl concurrency -x11 x gl concurrent-widgets ; - -SYMBOL: pval - -: p pval get ; -: -p pval get neg ; - -: wire-cube ( size -- ) -2.0 / pval set -GL_LINE_LOOP glBegin --p -p -p glVertex3f - p -p -p glVertex3f - p p -p glVertex3f --p p -p glVertex3f -glEnd -GL_LINE_LOOP glBegin --p -p p glVertex3f - p -p p glVertex3f - p p p glVertex3f --p p p glVertex3f -glEnd -GL_LINES glBegin --p -p -p glVertex3f --p -p p glVertex3f - p -p -p glVertex3f - p -p p glVertex3f --p p -p glVertex3f --p p p glVertex3f - p p -p glVertex3f - p p p glVertex3f -glEnd ; - -: init ( -- ) 0.0 0.0 0.0 0.0 glClearColor GL_FLAT glShadeModel ; - -: display ( -- ) -GL_COLOR_BUFFER_BIT glClear -1.0 1.0 1.0 glColor3f -glLoadIdentity -0.0 0.0 5.0 0.0 0.0 0.0 0.0 1.0 0.0 gluLookAt -1.0 2.0 1.0 glScalef -1.0 wire-cube -glFlush ; - -: reshape ( { width height } -- ) ->r 0 0 r> [ ] each glViewport -GL_PROJECTION glMatrixMode -glLoadIdentity --1.0 1.0 -1.0 1.0 1.5 20.0 glFrustum -GL_MODELVIEW glMatrixMode -display ; - -f initialize-x - -create-pwindow -[ drop reshape ] over set-pwindow-resize-action -window-id win set -StructureNotifyMask select-input -{ 500 500 } resize-window { 100 100 } move-window map-window - -[ GLX_RGBA ] choose-visual create-context make-current - -init [ concurrent-event-loop ] spawn display \ No newline at end of file diff --git a/contrib/x11/examples/double.factor b/contrib/x11/examples/double.factor deleted file mode 100644 index 81d9444e5d..0000000000 --- a/contrib/x11/examples/double.factor +++ /dev/null @@ -1,56 +0,0 @@ -USING: kernel sequences namespaces math hashtables threads io opengl -concurrency x11 x gl concurrent-widgets ; - -SYMBOL: loop-action - -! [ ] loop-action set - -SYMBOL: spin 0.0 spin set - -: 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 -swap-buffers ; - -: spin-display ( -- ) -spin get 2.0 + spin set -spin get 360.0 > [ spin get 360.0 - spin set ] when display ; - -: reshape ( { width height } -- ) ->r 0 0 r> [ ] each glViewport -GL_PROJECTION glMatrixMode glLoadIdentity --50.0 50.0 -50.0 50.0 -1.0 1.0 glOrtho -GL_MODELVIEW glMatrixMode glLoadIdentity ; - -: mouse ( event -- ) -{ { [ dup XButtonEvent-button Button1 = ] - [ global [ [ spin-display ] loop-action set ] bind drop ] } - { [ dup XButtonEvent-button Button2 = ] - [ global [ [ ] loop-action set ] bind drop ] } - { [ t ] [ drop ] } } cond ; - -: loop ( -- ) loop-action get call 10 sleep loop ; - -! : loop ( -- ) loop-action global hash call 10 sleep loop ; - -! The following line wasn't needed in 0.79 -! USE: hashtables 10 window-table set - -f initialize-x - -create-pwindow -[ drop reshape ] over set-pwindow-resize-action -[ "button pressed" print drop mouse ] over set-pwindow-button-action -window-id win set -StructureNotifyMask ButtonPressMask bitor select-input -{ 250 250 } resize-window { 100 100 } move-window map-window - -[ GLX_RGBA GLX_DOUBLEBUFFER ] choose-visual create-context make-current - -init [ concurrent-event-loop ] spawn [ loop ] spawn \ No newline at end of file diff --git a/contrib/x11/examples/example-01.factor b/contrib/x11/examples/example-01.factor deleted file mode 100644 index 293198d0a0..0000000000 --- a/contrib/x11/examples/example-01.factor +++ /dev/null @@ -1,12 +0,0 @@ - -USING: io concurrency x concurrent-widgets ; - -f initialize-x - -"Hey Hey" create-label -[ map-window ] with-window-object - -"Yo Yo Yo" [ "button pressed" print ] create-button -[ map-window ] with-window-object - -[ concurrent-event-loop ] spawn \ No newline at end of file diff --git a/contrib/x11/examples/example-02.factor b/contrib/x11/examples/example-02.factor deleted file mode 100644 index 4c2768b95f..0000000000 --- a/contrib/x11/examples/example-02.factor +++ /dev/null @@ -1,48 +0,0 @@ - -USING: kernel namespaces sequences x concurrency concurrent-widgets ; - -SYMBOL: win-a SYMBOL: win-b SYMBOL: win-c SYMBOL: win-d - -f initialize-x - -[ win-a win-b win-c win-d ] [ create-window swap set ] each -[ win-a win-b win-c win-d ] [ "black" "red" "green" "blue" ] -[ lookup-color swap get win set set-window-background ] 2each - -[ win-b win-c win-d ] [ get win set win-a get reparent-window ] each - -[ win-a win-b win-c win-d ] [ get win set map-window ] each - -win-a get [ { 300 300 } resize-window ] with-win - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: button-horizontal - -"Horizontal" -[ win-a get - [ stack-children arrange-children-horizontally ] with-win -] create-button -button-horizontal set -button-horizontal get -[ { 100 20 } resize-window - map-window -] with-window-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: button-vertical - -"Vertical" -[ win-a get - [ stack-children arrange-children-vertically ] with-win -] create-button -button-vertical set -button-vertical get -[ { 100 20 } resize-window - map-window -] with-window-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -[ concurrent-event-loop ] spawn \ No newline at end of file diff --git a/contrib/x11/examples/example-03.factor b/contrib/x11/examples/example-03.factor deleted file mode 100644 index eab62bd342..0000000000 --- a/contrib/x11/examples/example-03.factor +++ /dev/null @@ -1,38 +0,0 @@ - -USING: kernel namespaces sequences io x concurrency concurrent-widgets ; - -SYMBOL: win-a -SYMBOL: button-a -SYMBOL: button-b -SYMBOL: button-c - -f initialize-x - -create-window-object win-a set - -win-a get [ "black" lookup-color set-window-background ] with-window-object - -"Hey Hey Hey" [ "button pressed" print ] create-button button-a set -"Yo Yo Yo" [ "button pressed" print ] create-button button-b set -"Foo" [ "button pressed" print ] create-button button-c set - -[ button-a button-b button-c ] [ "red" "green" "blue" ] -[ lookup-color swap get [ set-window-background ] with-window-object ] -2each - -[ button-a button-b button-c ] -[ get [ { 100 20 } resize-window ] with-window-object ] -each - -[ button-a button-b button-c ] -[ get [ win-a get window-id reparent-window ] with-window-object ] -each - -win-a get [ map-window ] with-window-object - -[ button-a button-b button-c ] [ get [ map-window ] with-window-object ] -each - -win-a get [ arrange-children-vertically ] with-window-object - -[ concurrent-event-loop ] spawn \ No newline at end of file diff --git a/contrib/x11/examples/hello.factor b/contrib/x11/examples/hello.factor deleted file mode 100644 index e6249379e5..0000000000 --- a/contrib/x11/examples/hello.factor +++ /dev/null @@ -1,22 +0,0 @@ -USING: kernel words namespaces sequences x11 opengl x gl ; - -: display ( -- ) -GL_COLOR_BUFFER_BIT glClear -1.0 1.0 1.0 glColor3f -GL_POLYGON glBegin -0.25 0.25 0.0 glVertex3f -0.75 0.25 0.0 glVertex3f -0.75 0.75 0.0 glVertex3f -0.25 0.75 0.0 glVertex3f -glEnd -glFlush ; - -: init ( -- ) -0.0 0.0 0.0 0.0 glClearColor -GL_PROJECTION glMatrixMode -glLoadIdentity -0.0 1.0 0.0 1.0 -1.0 1.0 glOrtho -; - -f initialize-x create-window win set { 250 250 } resize-window map-window -[ GLX_RGBA ] choose-visual create-context make-current init display \ No newline at end of file diff --git a/contrib/x11/examples/lesson2.factor b/contrib/x11/examples/lesson2.factor deleted file mode 100644 index e81d72c55e..0000000000 --- a/contrib/x11/examples/lesson2.factor +++ /dev/null @@ -1,167 +0,0 @@ -IN: nehe -USING: opengl x11 xlib syntax kernel sequences alien namespaces math threads generic io prettyprint ; - -TUPLE: gl-window dpy screen win ctx x y width height depth ; -SYMBOL: current-window - -SYMBOL: dpy -SYMBOL: screen -SYMBOL: root -SYMBOL: win -SYMBOL: ctx -SYMBOL: title -SYMBOL: vi -SYMBOL: x -SYMBOL: y -SYMBOL: width -SYMBOL: height - -: >int-array ( seq -- int-array ) - dup length dup "int" -rot [ - pick set-int-nth - ] 2each ; - -: attr-list ( -- c-array ) - [ - GLX_RGBA , GLX_DOUBLEBUFFER , - GLX_RED_SIZE , 4 , - GLX_GREEN_SIZE , 4 , - GLX_BLUE_SIZE , 4 , - GLX_DEPTH_SIZE , 16 , - None , - ] f make >int-array ; - -: resize-gl-scene ( glwin -- ) - 0 0 rot [ gl-window-width ] keep [ gl-window-height ] keep >r glViewport - GL_PROJECTION glMatrixMode - glLoadIdentity - 45 r> [ gl-window-width ] keep gl-window-height / 0.1 100 gluPerspective - GL_MODELVIEW glMatrixMode ; - -: gl-init ( glwin -- ) - GL_SMOOTH glShadeModel - 0 0 0 0 glClearColor - 1 glClearDepth - GL_DEPTH_TEST glEnable - GL_LEQUAL glDepthFunc - GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST glHint - resize-gl-scene - glFlush ; - -: normal-XSetWindowAttributes ( cmap -- valuemask attr ) - [ - set-XSetWindowAttributes-colormap - ] keep - ExposureMask KeyPressMask bitor ButtonPressMask bitor StructureNotifyMask bitor - over set-XSetWindowAttributes-event_mask - dup 1 swap set-XSetWindowAttributes-border_pixel - CWBorderPixel CWColormap bitor CWEventMask bitor swap ; - -: make-display ( display-num -- display ) - dup [ ] when XOpenDisplay dup dpy set ; - -: make-screen ( display -- screen ) - XDefaultScreen dup screen set ; - -: make-vi ( display screen -- vi ) - attr-list glXChooseVisual dup vi set ; - -: make-ctx ( display vi -- ) - 0 GL_TRUE glXCreateContext ctx set ; - -: make-colormap ( -- cmap ) - dpy get vi get 2dup XVisualInfo-screen XRootWindow dup root set - swap XVisualInfo-visual AllocNone XCreateColormap ; - -: make-win ( valuemask attr -- win ) - >r >r dpy get root get x get y get width get height get 0 vi get - dup XVisualInfo-depth InputOutput rot XVisualInfo-visual r> r> XCreateWindow dup win set ; - -: make-gl-window ( display-num x y width height depth title -- glwin ) - [ - title set depth set height set width set y set x set - make-display dup dup make-screen make-vi make-ctx - make-colormap normal-XSetWindowAttributes make-win - dpy get swap 2dup over "WM_DELETE_WINDOW" 1 XInternAtom 1 XSetWMProtocols drop - 2dup title get dup None 0 0 over XSetStandardProperties drop - 2dup XMapRaised drop - 2dup ctx get glXMakeCurrent 2drop - screen get win get ctx get x get y get width get height get depth get - dup gl-init - dup global [ current-window set ] bind - ] with-scope ; - -: draw-gl-scene ( -- ) - GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear - glLoadIdentity - -1.5 0 -6 glTranslatef - GL_TRIANGLES [ - 0 1 0 glVertex3f - -1 -1 0 glVertex3f - 1 -1 0 glVertex3f - ] do-state - 3 0 0 glTranslatef - GL_QUADS [ - -1 1 1 glVertex3f - 1 1 0 glVertex3f - 1 -1 0 glVertex3f - -1 -1 0 glVertex3f - ] do-state - current-window get dup gl-window-dpy swap gl-window-win glXSwapBuffers ; - -: kill-gl-window ( glwin -- ) - dup gl-window-ctx [ - over gl-window-dpy dup None 0 glXMakeCurrent drop - swap glXDestroyContext - 0 over set-gl-window-ctx - ] when* - gl-window-dpy XCloseDisplay ; - -GENERIC: (handle-event) ( glwin xevent -- continue? ) - -M: x-expose-event (handle-event) - nip XExposeEvent-count 0 = [ draw-gl-scene ] when t ; - -M: x-configure-notify-event (handle-event) - #! resize if the width or height has changed - [ XConfigureEvent-width swap gl-window-width = ] 2keep - [ XConfigureEvent-height swap gl-window-height = and ] 2keep rot [ - 2drop - ] [ - [ XConfigureEvent-width swap set-gl-window-width ] 2keep - [ XConfigureEvent-height swap set-gl-window-height ] 2keep - drop resize-gl-scene - ] if t ; - -M: x-button-press-event (handle-event) - #! quit if a mouse button is pressed - 2drop f ; - -PREDICATE: x-key-press-event quit-key-event - 0 XLookupKeysym dup CHAR: q = swap XK_Escape = or ; - -M: quit-key-event (handle-event) - 2drop f ; - -M: x-client-message-event (handle-event) - swap gl-window-dpy swap XClientMessageEvent-message_type XGetAtomName - "WM_PROTOCOLS" = not ; - -M: object (handle-event) - #! unknown event, ignore and continue - 2drop t ; - -: handle-event ( glwin xevent -- continue? ) - over gl-window-dpy over XNextEvent drop (handle-event) ; - -: (loop) ( glwin xevent -- continue? ) - over gl-window-dpy XPending 0 > [ - 2dup handle-event [ (loop) ] [ 2drop f ] if - ] [ 2drop t ] if ; - -: loop ( glwin xevent -- ) - 2dup (loop) [ draw-gl-scene loop ] [ 2drop ] if ; - -: main ( -- ) - ":0.0" 10 10 640 480 16 "NeHe Lesson 2" make-gl-window - dup loop kill-gl-window ; diff --git a/contrib/x11/gl.factor b/contrib/x11/gl.factor deleted file mode 100644 index e839e47114..0000000000 --- a/contrib/x11/gl.factor +++ /dev/null @@ -1,17 +0,0 @@ -USING: kernel words sequences alien arrays namespaces x11 x ; IN: gl - -: >int-array ( seq -- ) -dup length "int" swap dup length >array [ pick set-int-nth ] 2each ; - -: >attributes ( seq -- attributes ) -0 add [ dup word? [ execute ] [ ] if ] map ; - -: choose-visual ( attributes -- XVisualInfo* ) ->attributes >int-array dpy get scr get rot glXChooseVisual ; - -: create-context ( XVisualInfo* -- GLXContext ) ->r dpy get r> 0 1 glXCreateContext ; - -: make-current ( GLXContext -- ) >r dpy get win get r> glXMakeCurrent drop ; - -: swap-buffers ( -- ) dpy get win get glXSwapBuffers ; diff --git a/contrib/x11/load.factor b/contrib/x11/load.factor index f83b4bc894..fb395694c1 100644 --- a/contrib/x11/load.factor +++ b/contrib/x11/load.factor @@ -1,5 +1,9 @@ REQUIRES: contrib/concurrency ; -PROVIDE: contrib/x11 { - "rectangle.factor" "x.factor" "draw-string.factor" "concurrent-widgets.factor" "gl.factor" -} ; \ No newline at end of file +PROVIDE: contrib/x11 +{ +files+ { + "rectangle.factor" + "x.factor" + "draw-string.factor" + "concurrent-widgets.factor" +} } ; \ No newline at end of file