From b2c0d4c5be5126c03c87f8cbde4f5a35a02484b0 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 15 Dec 2008 18:16:18 -0600
Subject: [PATCH 1/5] Remove old 'bubble-chamber'
---
.../bubble-chamber/bubble-chamber-docs.factor | 84 ------------------
extra/bubble-chamber/bubble-chamber.factor | 88 -------------------
extra/bubble-chamber/common/common.factor | 12 ---
.../particle/axion/axion.factor | 68 --------------
.../particle/hadron/hadron.factor | 59 -------------
.../particle/muon/colors/colors.factor | 53 -----------
.../bubble-chamber/particle/muon/muon.factor | 63 -------------
extra/bubble-chamber/particle/particle.factor | 68 --------------
.../particle/quark/quark.factor | 53 -----------
extra/bubble-chamber/tags.txt | 1 -
10 files changed, 549 deletions(-)
delete mode 100644 extra/bubble-chamber/bubble-chamber-docs.factor
delete mode 100644 extra/bubble-chamber/bubble-chamber.factor
delete mode 100644 extra/bubble-chamber/common/common.factor
delete mode 100644 extra/bubble-chamber/particle/axion/axion.factor
delete mode 100644 extra/bubble-chamber/particle/hadron/hadron.factor
delete mode 100644 extra/bubble-chamber/particle/muon/colors/colors.factor
delete mode 100644 extra/bubble-chamber/particle/muon/muon.factor
delete mode 100644 extra/bubble-chamber/particle/particle.factor
delete mode 100644 extra/bubble-chamber/particle/quark/quark.factor
delete mode 100644 extra/bubble-chamber/tags.txt
diff --git a/extra/bubble-chamber/bubble-chamber-docs.factor b/extra/bubble-chamber/bubble-chamber-docs.factor
deleted file mode 100644
index 72ffb63848..0000000000
--- a/extra/bubble-chamber/bubble-chamber-docs.factor
+++ /dev/null
@@ -1,84 +0,0 @@
-
-USING: help.syntax help.markup ;
-
-USING: bubble-chamber.particle.muon
- bubble-chamber.particle.quark
- bubble-chamber.particle.hadron
- bubble-chamber.particle.axion ;
-
-IN: bubble-chamber
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-HELP: muon
-
- { $class-description
- "The muon is a colorful particle with an entangled friend."
- "It draws both itself and its horizontally symmetric partner."
- "A high range of speed and almost no speed decay allow the"
- "muon to reach the extents of the window, often forming rings"
- "where theta has decayed but speed remains stable. The result"
- "is color almost everywhere in the general direction of collision,"
- "stabilized into fuzzy rings." } ;
-
-HELP: quark
-
- { $class-description
- "The quark draws as a translucent black. Their large numbers"
- "create fields of blackness overwritten only by the glowing shadows of "
- "Hadrons. "
- "quarks are allowed to accelerate away with speed decay values above 1.0. "
- "Each quark has an entangled friend. Both particles are drawn identically,"
- "mirrored along the y-axis." } ;
-
-HELP: hadron
-
- { $class-description
- "Hadrons collide from totally random directions. "
- "Those hadrons that do not exit the drawing area, "
- "tend to stabilize into perfect circular orbits. "
- "Each hadron draws with a slight glowing emboss. "
- "The hadron itself is not drawn." } ;
-
-HELP: axion
-
- { $class-description
- "The axion particle draws a bold black path. Axions exist "
- "in a slightly higher dimension and as such are drawn with "
- "elevated embossed shadows. Axions are quick to stabilize "
- "and fall into single pixel orbits axions automatically "
- "recollide themselves after stabilizing." } ;
-
-{ muon quark hadron axion } related-words
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-ARTICLE: "bubble-chamber" "Bubble Chamber"
-
-"The " { $vocab-link "bubble-chamber" }
-" is a generative painting system of imaginary "
-"colliding particles. A single super-massive collision produces a "
-"discrete universe of four particle types. Particles draw their "
-"positions over time as pixel exposures.\n"
-"\n"
-"Four types of particles exist. The behavior and graphic appearance of "
-"each particle type is unique.\n"
- { $subsection muon }
- { $subsection quark }
- { $subsection hadron }
- { $subsection axion }
-"\n"
-"After you run the vocabulary, a window will appear. Click the "
-"mouse in a random area to fire 11 particles of each type. "
-"Another way to fire particles is to press the "
-"spacebar. This fires all the particles.\n"
-"\n"
-"Bubble Chamber was created by Jared Tarbell. "
-"It was originally implemented in Processing. "
-"It was ported to Factor by Eduardo Cavazos. "
-"The original work is on display here: "
-{ $url
-"http://www.complexification.net/gallery/machines/bubblechamber/" } ;
-
-ABOUT: "bubble-chamber"
-
diff --git a/extra/bubble-chamber/bubble-chamber.factor b/extra/bubble-chamber/bubble-chamber.factor
deleted file mode 100644
index 4b0db46c35..0000000000
--- a/extra/bubble-chamber/bubble-chamber.factor
+++ /dev/null
@@ -1,88 +0,0 @@
-
-USING: kernel namespaces sequences random math math.constants math.libm vars
- ui
- processing
- processing.gadget
- bubble-chamber.common
- bubble-chamber.particle
- bubble-chamber.particle.muon
- bubble-chamber.particle.quark
- bubble-chamber.particle.hadron
- bubble-chamber.particle.axion ;
-
-IN: bubble-chamber
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VARS: particles muons quarks hadrons axions ;
-
-VAR: boom
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: collide-all ( -- )
-
- 2 pi * 1random >collision-theta
-
- particles> [ collide ] each ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: collide-one ( -- )
-
- dim 2 / mouse-x - dim 2 / mouse-y - fatan2 >collision-theta
-
- hadrons> random collide
- quarks> random collide
- muons> random collide ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: mouse-pressed ( -- )
- boom on
- 1 background ! kludge
- 11 [ drop collide-one ] each ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: key-released ( -- )
- key " " =
- [
- boom on
- 1 background
- collide-all
- ]
- when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: bubble-chamber ( -- )
-
- 1000 1000 size*
-
- [
- 1 background
- no-stroke
-
- 1789 [ drop <muon> ] map >muons
- 1300 [ drop <quark> ] map >quarks
- 1000 [ drop <hadron> ] map >hadrons
- 111 [ drop <axion> ] map >axions
-
- muons> quarks> hadrons> axions> 3append append >particles
-
- collide-one
- ] setup
-
- [
- boom>
- [ particles> [ move ] each ]
- when
- ] draw
-
- [ mouse-pressed ] button-down
- [ key-released ] key-up ;
-
-: go ( -- ) [ bubble-chamber run ] with-ui ;
-
-MAIN: go
\ No newline at end of file
diff --git a/extra/bubble-chamber/common/common.factor b/extra/bubble-chamber/common/common.factor
deleted file mode 100644
index c9ce687535..0000000000
--- a/extra/bubble-chamber/common/common.factor
+++ /dev/null
@@ -1,12 +0,0 @@
-
-USING: kernel math accessors combinators.cleave vars ;
-
-IN: bubble-chamber.common
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: collision-theta
-
-: dim ( -- dim ) 1000 ;
-
-: center ( -- point ) dim 2 / dup {2} ; foldable
diff --git a/extra/bubble-chamber/particle/axion/axion.factor b/extra/bubble-chamber/particle/axion/axion.factor
deleted file mode 100644
index 2dafc36cde..0000000000
--- a/extra/bubble-chamber/particle/axion/axion.factor
+++ /dev/null
@@ -1,68 +0,0 @@
-
-USING: kernel sequences random accessors multi-methods
- math math.constants math.ranges math.points combinators.cleave
- processing processing.shapes
- bubble-chamber.common bubble-chamber.particle ;
-
-IN: bubble-chamber.particle.axion
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-TUPLE: axion < particle ;
-
-: <axion> ( -- axion ) axion new initialize-particle ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-METHOD: collide { axion }
-
- center >>pos
- 2 pi * 1random >>theta
- 1.0 6.0 2random >>speed
- 0.998 1.000 2random >>speed-d
- 0 >>theta-d
- 0 >>theta-dd
-
- [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
-
- drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: dy>alpha ( dy -- alpha ) neg 6 * 30 + 255.0 / ;
-
-: axion-white ( dy -- dy ) dup 1 swap dy>alpha {2} stroke ;
-: axion-black ( dy -- dy ) dup 0 swap dy>alpha {2} stroke ;
-
-: axion-point- ( particle dy -- particle ) >r dup pos>> r> v-y point ;
-: axion-point+ ( particle dy -- particle ) >r dup pos>> r> v+y point ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-METHOD: move { axion }
-
- { 0.06 0.59 } stroke
- dup pos>> point
-
- 1 4 [a,b] [ axion-white axion-point- ] each
- 1 4 [a,b] [ axion-black axion-point+ ] each
-
- dup vel>> move-by
-
- turn
-
- step-theta
- step-theta-d
- step-speed-mul
-
- [ ] [ speed-d>> 0.9999 * ] bi >>speed-d
-
- 1000 random 996 >
- [
- dup speed>> neg >>speed
- dup speed-d>> neg 2 + >>speed-d
-
- 100 random 30 > [ collide ] [ drop ] if
- ]
- [ drop ]
- if ;
diff --git a/extra/bubble-chamber/particle/hadron/hadron.factor b/extra/bubble-chamber/particle/hadron/hadron.factor
deleted file mode 100644
index 910df97789..0000000000
--- a/extra/bubble-chamber/particle/hadron/hadron.factor
+++ /dev/null
@@ -1,59 +0,0 @@
-
-USING: kernel random math math.constants math.points accessors multi-methods
- processing processing.shapes
- bubble-chamber.common
- bubble-chamber.particle colors ;
-
-IN: bubble-chamber.particle.hadron
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-TUPLE: hadron < particle ;
-
-: <hadron> ( -- hadron ) hadron new initialize-particle ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-METHOD: collide { hadron }
-
- center >>pos
- 2 pi * 1random >>theta
- 0.5 3.5 2random >>speed
- 0.996 1.001 2random >>speed-d
- 0 >>theta-d
- 0 >>theta-dd
-
- [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
-
- 0 1 0 1 rgba boa >>myc
-
- drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-METHOD: move { hadron }
-
- { 1 0.11 } stroke
- dup pos>> 1 v-y point
-
- { 0 0.11 } stroke
- dup pos>> 1 v+y point
-
- dup vel>> move-by
-
- turn
-
- step-theta
- step-theta-d
- step-speed-mul
-
- 1000 random 997 >
- [
- 1.0 >>speed-d
- 0.00001 >>theta-dd
-
- 100 random 70 > [ dup collide ] when
- ]
- when
-
- out-of-bounds? [ collide ] [ drop ] if ;
diff --git a/extra/bubble-chamber/particle/muon/colors/colors.factor b/extra/bubble-chamber/particle/muon/colors/colors.factor
deleted file mode 100644
index 644bed833b..0000000000
--- a/extra/bubble-chamber/particle/muon/colors/colors.factor
+++ /dev/null
@@ -1,53 +0,0 @@
-
-USING: kernel sequences math math.constants math.order accessors
- processing
- colors ;
-
-IN: bubble-chamber.particle.muon.colors
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: good-colors ( -- seq )
- {
- T{ rgba f 0.23 0.14 0.17 1 }
- T{ rgba f 0.23 0.14 0.15 1 }
- T{ rgba f 0.21 0.14 0.15 1 }
- T{ rgba f 0.51 0.39 0.33 1 }
- T{ rgba f 0.49 0.33 0.20 1 }
- T{ rgba f 0.55 0.45 0.32 1 }
- T{ rgba f 0.69 0.63 0.51 1 }
- T{ rgba f 0.64 0.39 0.18 1 }
- T{ rgba f 0.73 0.42 0.20 1 }
- T{ rgba f 0.71 0.45 0.29 1 }
- T{ rgba f 0.79 0.45 0.22 1 }
- T{ rgba f 0.82 0.56 0.34 1 }
- T{ rgba f 0.88 0.72 0.49 1 }
- T{ rgba f 0.85 0.69 0.40 1 }
- T{ rgba f 0.96 0.92 0.75 1 }
- T{ rgba f 0.99 0.98 0.87 1 }
- T{ rgba f 0.85 0.82 0.69 1 }
- T{ rgba f 0.99 0.98 0.87 1 }
- T{ rgba f 0.82 0.82 0.79 1 }
- T{ rgba f 0.65 0.69 0.67 1 }
- T{ rgba f 0.53 0.60 0.55 1 }
- T{ rgba f 0.57 0.53 0.68 1 }
- T{ rgba f 0.47 0.42 0.56 1 }
- } ;
-
-: anti-colors ( -- seq ) good-colors <reversed> ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: color-fraction ( particle -- particle fraction ) dup theta>> pi + 2 pi * / ;
-
-: set-good-color ( particle -- particle )
- color-fraction dup 0 1 between?
- [ good-colors at-fraction-of >>myc ]
- [ drop ]
- if ;
-
-: set-anti-color ( particle -- particle )
- color-fraction dup 0 1 between?
- [ anti-colors at-fraction-of >>mya ]
- [ drop ]
- if ;
diff --git a/extra/bubble-chamber/particle/muon/muon.factor b/extra/bubble-chamber/particle/muon/muon.factor
deleted file mode 100644
index c5ee71c1b0..0000000000
--- a/extra/bubble-chamber/particle/muon/muon.factor
+++ /dev/null
@@ -1,63 +0,0 @@
-
-USING: kernel arrays sequences random
- math
- math.ranges
- math.functions
- math.vectors
- multi-methods accessors
- combinators.cleave
- processing
- processing.shapes
- bubble-chamber.common
- bubble-chamber.particle
- bubble-chamber.particle.muon.colors ;
-
-IN: bubble-chamber.particle.muon
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-TUPLE: muon < particle ;
-
-: <muon> ( -- muon ) muon new initialize-particle ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-METHOD: collide { muon }
-
- center >>pos
- 2 32 [a,b] random >>speed
- 0.0001 0.001 2random >>speed-d
-
- collision-theta> -0.1 0.1 2random + >>theta
- 0 >>theta-d
- 0 >>theta-dd
-
- [ 0.001 theta-dd-small? ] [ -0.1 0.1 random-theta-dd ] [ ] while
-
- set-good-color
- set-anti-color
-
- drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-METHOD: move { muon }
-
- dup myc>> 0.16 >>alpha stroke
- dup pos>> point
-
- dup mya>> 0.16 >>alpha stroke
- dup pos>> first2 >r dim swap - r> 2array point
-
- dup
- [ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
- move-by
-
- step-theta
- step-theta-d
- step-speed-sub
-
- out-of-bounds? [ collide ] [ drop ] if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
diff --git a/extra/bubble-chamber/particle/particle.factor b/extra/bubble-chamber/particle/particle.factor
deleted file mode 100644
index 8b13e9b4b7..0000000000
--- a/extra/bubble-chamber/particle/particle.factor
+++ /dev/null
@@ -1,68 +0,0 @@
-
-USING: kernel sequences combinators
- math math.vectors math.functions multi-methods
- accessors combinators.cleave processing
- bubble-chamber.common colors ;
-
-IN: bubble-chamber.particle
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-GENERIC: collide ( particle -- )
-GENERIC: move ( particle -- )
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-TUPLE: particle pos vel speed speed-d theta theta-d theta-dd myc mya ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: initialize-particle ( particle -- particle )
-
- 0 0 {2} >>pos
- 0 0 {2} >>vel
-
- 0 >>speed
- 0 >>speed-d
- 0 >>theta
- 0 >>theta-d
- 0 >>theta-dd
-
- 0 0 0 1 rgba boa >>myc
- 0 0 0 1 rgba boa >>mya ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: move-by ( obj delta -- obj ) over pos>> v+ >>pos ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: theta-dd-small? ( par limit -- par ? ) >r dup theta-dd>> abs r> < ;
-
-: random-theta-dd ( par a b -- par ) 2random >>theta-dd ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: turn ( particle -- particle )
- dup
- [ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
- >>vel ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: step-theta ( p -- p ) [ ] [ theta>> ] [ theta-d>> ] tri + >>theta ;
-: step-theta-d ( p -- p ) [ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d ;
-: step-speed-sub ( p -- p ) [ ] [ speed>> ] [ speed-d>> ] tri - >>speed ;
-: step-speed-mul ( p -- p ) [ ] [ speed>> ] [ speed-d>> ] tri * >>speed ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: x ( particle -- x ) pos>> first ;
-: y ( particle -- x ) pos>> second ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: out-of-bounds? ( particle -- particle ? )
- dup
- { [ x dim neg < ] [ x dim 2 * > ] [ y dim neg < ] [ y dim 2 * > ] } cleave
- or or or ;
diff --git a/extra/bubble-chamber/particle/quark/quark.factor b/extra/bubble-chamber/particle/quark/quark.factor
deleted file mode 100644
index 194b97a9cd..0000000000
--- a/extra/bubble-chamber/particle/quark/quark.factor
+++ /dev/null
@@ -1,53 +0,0 @@
-
-USING: kernel arrays sequences random math accessors multi-methods
- processing processing.shapes
- bubble-chamber.common
- bubble-chamber.particle ;
-
-IN: bubble-chamber.particle.quark
-
-TUPLE: quark < particle ;
-
-: <quark> ( -- quark ) quark new initialize-particle ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-METHOD: collide { quark }
-
- center >>pos
- collision-theta> -0.11 0.11 2random + >>theta
- 0.5 3.0 2random >>speed
-
- 0.996 1.001 2random >>speed-d
- 0 >>theta-d
- 0 >>theta-dd
-
- [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
-
- drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-METHOD: move { quark }
-
- dup myc>> 0.13 >>alpha stroke
- dup pos>> point
-
- dup pos>> first2 >r dim swap - r> 2array point
-
- [ ] [ vel>> ] bi move-by
-
- turn
-
- step-theta
- step-theta-d
- step-speed-mul
-
- 1000 random 997 >
- [
- dup speed>> neg >>speed
- 2 over speed-d>> - >>speed-d
- ]
- when
-
- out-of-bounds? [ collide ] [ drop ] if ;
diff --git a/extra/bubble-chamber/tags.txt b/extra/bubble-chamber/tags.txt
deleted file mode 100644
index cb5fc203e1..0000000000
--- a/extra/bubble-chamber/tags.txt
+++ /dev/null
@@ -1 +0,0 @@
-demos
From a02cc592c6d9859c7dd984bd330d794edea2ef5d Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 15 Dec 2008 18:24:05 -0600
Subject: [PATCH 2/5] remove old 'processing' vocabulary
---
extra/processing/processing.factor | 313 -----------------------------
1 file changed, 313 deletions(-)
delete mode 100644 extra/processing/processing.factor
diff --git a/extra/processing/processing.factor b/extra/processing/processing.factor
deleted file mode 100644
index f351c989f0..0000000000
--- a/extra/processing/processing.factor
+++ /dev/null
@@ -1,313 +0,0 @@
-
-USING: kernel namespaces threads combinators sequences arrays
- math math.functions math.ranges random
- opengl.gl opengl.glu vars multi-methods generalizations shuffle
- ui
- ui.gestures
- ui.gadgets
- combinators
- combinators.lib
- combinators.cleave
- rewrite-closures bake bake.fry accessors newfx
- processing.gadget math.geometry.rect
- processing.shapes
- colors ;
-
-IN: processing
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: 2random ( a b -- num ) 2dup swap - 100 / <range> random ;
-
-: 1random ( b -- num ) 0 swap 2random ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: chance ( fraction -- ? ) 0 1 2random > ;
-
-: percent-chance ( percent -- ? ) 100 / chance ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! : at-fraction ( seq fraction -- val ) over length 1- * nth-at ;
-
-: at-fraction ( seq fraction -- val ) over length 1- * at ;
-
-: at-fraction-of ( fraction seq -- val ) swap at-fraction ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-GENERIC: canonical-color-value ( obj -- color )
-
-METHOD: canonical-color-value { number } dup dup 1 rgba boa ;
-
-METHOD: canonical-color-value { array }
- dup length
- {
- { 2 [ first2 >r dup dup r> rgba boa ] }
- { 3 [ first3 1 rgba boa ] }
- { 4 [ first4 rgba boa ] }
- }
- case ;
-
-! METHOD: canonical-color-value { rgba }
-! { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave 4array ;
-
-METHOD: canonical-color-value { color } ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: fill ( value -- ) canonical-color-value >fill-color ;
-: stroke ( value -- ) canonical-color-value >stroke-color ;
-
-! : no-fill ( -- ) 0 fill-color> set-fourth ;
-! : no-stroke ( -- ) 0 stroke-color> set-fourth ;
-
-: no-fill ( -- ) fill-color> 0 >>alpha drop ;
-: no-stroke ( -- ) stroke-color> 0 >>alpha drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: stroke-weight ( w -- ) glLineWidth ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! : quad-vertices ( x1 y1 x2 y2 x3 y3 x4 y4 -- )
-! GL_POLYGON glBegin
-! glVertex2d
-! glVertex2d
-! glVertex2d
-! glVertex2d
-! glEnd ;
-
-! : quad ( x1 y1 x2 y2 x3 y3 x4 y4 -- )
-
-! 8 ndup
-
-! GL_FRONT_AND_BACK GL_FILL glPolygonMode
-! fill-color> set-color
-
-! quad-vertices
-
-! GL_FRONT_AND_BACK GL_LINE glPolygonMode
-! stroke-color> set-color
-
-! quad-vertices ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! : ellipse-disk ( x y width height -- )
-! glPushMatrix
-! >r >r
-! 0 glTranslated
-! r> r> 1 glScaled
-! gluNewQuadric
-! dup 0 0.5 20 1 gluDisk
-! gluDeleteQuadric
-! glPopMatrix ;
-
-! : ellipse-center ( x y width height -- )
-
-! 4dup
-
-! GL_FRONT_AND_BACK GL_FILL glPolygonMode
-! stroke-color> set-color
-
-! ellipse-disk
-
-! GL_FRONT_AND_BACK GL_FILL glPolygonMode
-! fill-color> set-color
-
-! [ 2 - ] bi@ ! [ stroke-width 1+ - ] bi@
-
-! ellipse-disk ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! SYMBOL: CENTER
-! SYMBOL: RADIUS
-! SYMBOL: CORNER
-! SYMBOL: CORNERS
-
-! SYMBOL: ellipse-mode-value
-
-! : ellipse-mode ( val -- ) ellipse-mode-value set ;
-
-! : ellipse-radius ( x y hori vert -- ) [ 2 * ] bi@ ellipse-center ;
-
-! : ellipse-corner ( x y width height -- )
-! [ drop nip 2 / + ] 4keep
-! [ nip rot drop 2 / + ] 4keep
-! [ >r >r 2drop r> r> ] 4keep
-! 4drop
-! ellipse-center ;
-
-! : ellipse-corners ( x1 y1 x2 y2 -- )
-! [ drop nip + 2 / ] 4keep
-! [ nip rot drop + 2 / ] 4keep
-! [ drop nip - abs 1+ ] 4keep
-! [ nip rot drop - abs 1+ ] 4keep
-! 4drop
-! ellipse-center ;
-
-! : ellipse ( a b c d -- )
-! ellipse-mode-value get
-! {
-! { CENTER [ ellipse-center ] }
-! { RADIUS [ ellipse-radius ] }
-! { CORNER [ ellipse-corner ] }
-! { CORNERS [ ellipse-corners ] }
-! }
-! case ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-GENERIC: background ( value -- )
-
-METHOD: background { number }
- dup dup 1 glClearColor
- GL_COLOR_BUFFER_BIT glClear ;
-
-METHOD: background { array }
- dup length
- {
- { 2 [ first2 >r dup dup r> glClearColor GL_COLOR_BUFFER_BIT glClear ] }
- { 3 [ first3 1 glClearColor GL_COLOR_BUFFER_BIT glClear ] }
- { 4 [ first4 glClearColor GL_COLOR_BUFFER_BIT glClear ] }
- }
- case ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: translate ( x y -- ) 0 glTranslated ;
-
-: rotate ( angle -- ) 0 0 1 glRotated ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: mouse ( -- point ) hand-loc get ;
-
-: mouse-x ( -- x ) mouse first ;
-: mouse-y ( -- y ) mouse second ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: frame-rate-value
-
-: frame-rate ( fps -- ) 1000 swap / >frame-rate-value ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! VAR: slate
-
-VAR: loop-flag
-
-: defaults ( -- )
- 0.8 background
- ! CENTER ellipse-mode
- 60 frame-rate ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: size-val
-
-: size ( seq -- ) size-val set ;
-
-: size* ( width height -- ) 2array size-val set ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: setup-action
-SYMBOL: draw-action
-
-! : setup ( quot -- ) closed-quot setup-action set ;
-! : draw ( quot -- ) closed-quot draw-action set ;
-
-: setup ( quot -- ) setup-action set ;
-: draw ( quot -- ) draw-action set ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: key-down-action
-SYMBOL: key-up-action
-
-: key-down ( quot -- ) closed-quot key-down-action set ;
-: key-up ( quot -- ) closed-quot key-up-action set ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: button-down-action
-SYMBOL: button-up-action
-
-: button-down ( quot -- ) closed-quot button-down-action set ;
-: button-up ( quot -- ) closed-quot button-up-action set ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: start-processing-thread ( -- )
- loop-flag get not
- [
- loop-flag on
- [
- [ loop-flag get ]
- processing-gadget get frame-rate-value> '[ , relayout-1 , sleep ]
- [ ]
- while
- ]
- in-thread
- ]
- when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: get-size ( -- size ) processing-gadget get rect-dim ;
-
-: width ( -- width ) get-size first ;
-: height ( -- height ) get-size second ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: setup-called
-
-: setup-called? ( -- ? ) setup-called get ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: run ( -- )
-
- loop-flag off
-
- 500 sleep
-
- <processing-gadget>
- size-val get >>pdim
- dup "Processing" open-window
-
- 500 sleep
-
- defaults
-
- setup-called off
-
- [
- setup-called? not
- [
- setup-action get call
- setup-called on
- ]
- [
- draw-action get call
- ]
- if
- ]
- closed-quot >>action
-
- key-down-action get >>key-down
- key-up-action get >>key-up
-
- button-down-action get >>button-down
- button-up-action get >>button-up
-
- processing-gadget set
-
- start-processing-thread ;
\ No newline at end of file
From a34958661948e25193b43a11062d9355b7186c49 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 15 Dec 2008 18:26:11 -0600
Subject: [PATCH 3/5] Remove 'processing.gadget' (all demos converted to use
standard ui idioms)
---
extra/processing/gadget/gadget.factor | 69 ---------------------------
1 file changed, 69 deletions(-)
delete mode 100644 extra/processing/gadget/gadget.factor
diff --git a/extra/processing/gadget/gadget.factor b/extra/processing/gadget/gadget.factor
deleted file mode 100644
index 0b3bb6dc01..0000000000
--- a/extra/processing/gadget/gadget.factor
+++ /dev/null
@@ -1,69 +0,0 @@
-
-USING: kernel namespaces combinators
- ui.gestures accessors ui.gadgets.frame-buffer ;
-
-IN: processing.gadget
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-TUPLE: processing-gadget < frame-buffer button-down button-up key-down key-up ;
-
-: <processing-gadget> ( -- gadget ) processing-gadget new-frame-buffer ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: mouse-pressed-value
-SYMBOL: key-pressed-value
-
-SYMBOL: button-value
-SYMBOL: key-value
-
-: key-pressed? ( -- ? ) key-pressed-value get ;
-: mouse-pressed? ( -- ? ) mouse-pressed-value get ;
-
-: key ( -- key ) key-value get ;
-: button ( -- val ) button-value get ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: processing-gadget handle-gesture ( gesture gadget -- ? )
- swap
- {
- {
- [ dup key-down? ]
- [
- sym>> key-value set
- key-pressed-value on
- key-down>> dup [ call ] [ drop ] if
- t
- ]
- }
- {
- [ dup key-up? ]
- [
- key-pressed-value off
- drop
- key-up>> dup [ call ] [ drop ] if
- t
- ] }
- {
- [ dup button-down? ]
- [
- #>> button-value set
- mouse-pressed-value on
- button-down>> dup [ call ] [ drop ] if
- t
- ]
- }
- {
- [ dup button-up? ]
- [
- mouse-pressed-value off
- drop
- button-up>> dup [ call ] [ drop ] if
- t
- ]
- }
- { [ t ] [ 2drop t ] }
- }
- cond ;
From 98bfac3f63b483fa31cf6f15c9decfe7dfb56099 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 15 Dec 2008 18:32:52 -0600
Subject: [PATCH 4/5] Remove 'ui.gadgets.frame-buffer'
---
.../gadgets/frame-buffer/frame-buffer.factor | 115 ------------------
1 file changed, 115 deletions(-)
delete mode 100644 extra/ui/gadgets/frame-buffer/frame-buffer.factor
diff --git a/extra/ui/gadgets/frame-buffer/frame-buffer.factor b/extra/ui/gadgets/frame-buffer/frame-buffer.factor
deleted file mode 100644
index 2d58037982..0000000000
--- a/extra/ui/gadgets/frame-buffer/frame-buffer.factor
+++ /dev/null
@@ -1,115 +0,0 @@
-
-USING: kernel alien.c-types combinators sequences splitting grouping
- opengl.gl ui.gadgets ui.render
- math math.vectors accessors math.geometry.rect ;
-
-IN: ui.gadgets.frame-buffer
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-TUPLE: frame-buffer < gadget action pdim last-dim graft ungraft pixels ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init-frame-buffer-pixels ( frame-buffer -- frame-buffer )
- dup
- rect-dim product "uint[4]" <c-array>
- >>pixels ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: new-frame-buffer ( class -- gadget )
- new-gadget
- [ ] >>action
- { 100 100 } >>pdim
- [ ] >>graft
- [ ] >>ungraft ;
-
-: <frame-buffer> ( -- frame-buffer ) frame-buffer new-frame-buffer ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: draw-pixels ( fb -- fb )
- dup >r
- dup >r
- rect-dim first2 GL_RGBA GL_UNSIGNED_INT r> pixels>> glDrawPixels
- r> ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: read-pixels ( fb -- fb )
- dup >r
- dup >r
- >r
- 0 0 r> rect-dim first2 GL_RGBA GL_UNSIGNED_INT r> pixels>> glReadPixels
- r> ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: frame-buffer pref-dim* pdim>> ;
-M: frame-buffer graft* graft>> call ;
-M: frame-buffer ungraft* ungraft>> call ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: copy-row ( old new -- )
- 2dup min-length swap >r head-slice 0 r> copy ;
-
-! : copy-pixels ( old-pixels old-width new-pixels new-width -- )
-! [ group ] 2bi@
-! [ copy-row ] 2each ;
-
-! : copy-pixels ( old-pixels old-width new-pixels new-width -- )
-! [ 16 * group ] 2bi@
-! [ copy-row ] 2each ;
-
-: copy-pixels ( old-pixels old-width new-pixels new-width -- )
- [ 16 * <sliced-groups> ] 2bi@
- [ copy-row ] 2each ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: frame-buffer layout* ( fb -- )
- {
- {
- [ dup last-dim>> f = ]
- [
- init-frame-buffer-pixels
- dup
- rect-dim >>last-dim
- drop
- ]
- }
- {
- [ dup [ rect-dim ] [ last-dim>> ] bi = not ]
- [
- dup [ pixels>> ] [ last-dim>> first ] bi
-
- rot init-frame-buffer-pixels
- dup rect-dim >>last-dim
-
- [ pixels>> ] [ rect-dim first ] bi
-
- copy-pixels
- ]
- }
- { [ t ] [ drop ] }
- }
- cond ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: frame-buffer draw-gadget* ( fb -- )
-
- dup rect-dim { 0 1 } v* first2 glRasterPos2i
-
- draw-pixels
-
- dup action>> call
-
- glFlush
-
- read-pixels
-
- drop ;
-
From 1e9f7b65b5a3d8ce18276ded58d8a6a82a35c493 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 15 Dec 2008 18:36:52 -0600
Subject: [PATCH 5/5] Add extra/frame-buffer
---
extra/frame-buffer/frame-buffer.factor | 112 +++++++++++++++++++++++++
1 file changed, 112 insertions(+)
create mode 100644 extra/frame-buffer/frame-buffer.factor
diff --git a/extra/frame-buffer/frame-buffer.factor b/extra/frame-buffer/frame-buffer.factor
new file mode 100644
index 0000000000..708c0d8bd4
--- /dev/null
+++ b/extra/frame-buffer/frame-buffer.factor
@@ -0,0 +1,112 @@
+
+USING: accessors alien.c-types combinators grouping kernel
+ locals math math.geometry.rect math.vectors opengl.gl sequences
+ ui.gadgets ui.render ;
+
+IN: frame-buffer
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+TUPLE: <frame-buffer> < gadget pixels last-dim ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+GENERIC: update-frame-buffer ( <frame-buffer> -- )
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init-frame-buffer-pixels ( frame-buffer -- )
+ dup
+ rect-dim product "uint[4]" <c-array>
+ >>pixels
+ drop ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: frame-buffer ( -- <frame-buffer> ) <frame-buffer> new-gadget ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: draw-pixels ( FRAME-BUFFER -- )
+
+ FRAME-BUFFER rect-dim first2
+ GL_RGBA
+ GL_UNSIGNED_INT
+ FRAME-BUFFER pixels>>
+ glDrawPixels ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: read-pixels ( FRAME-BUFFER -- )
+
+ 0
+ 0
+ FRAME-BUFFER rect-dim first2
+ GL_RGBA
+ GL_UNSIGNED_INT
+ FRAME-BUFFER pixels>>
+ glReadPixels ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: copy-row ( OLD NEW -- )
+
+ [let | LEN [ OLD NEW min-length ] |
+
+ OLD LEN head-slice 0 NEW copy ] ;
+
+: copy-pixels ( old-pixels old-width new-pixels new-width -- )
+ [ 16 * <sliced-groups> ] 2bi@
+ [ copy-row ] 2each ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: update-last-dim ( frame-buffer -- ) dup rect-dim >>last-dim drop ;
+
+M:: <frame-buffer> layout* ( FRAME-BUFFER -- )
+
+ {
+ {
+ [ FRAME-BUFFER last-dim>> f = ]
+ [
+ FRAME-BUFFER init-frame-buffer-pixels
+
+ FRAME-BUFFER update-last-dim
+ ]
+ }
+ {
+ [ FRAME-BUFFER [ rect-dim ] [ last-dim>> ] bi = not ]
+ [
+ [let | OLD-PIXELS [ FRAME-BUFFER pixels>> ]
+ OLD-WIDTH [ FRAME-BUFFER last-dim>> first ] |
+
+ FRAME-BUFFER init-frame-buffer-pixels
+
+ FRAME-BUFFER update-last-dim
+
+ [let | NEW-PIXELS [ FRAME-BUFFER pixels>> ]
+ NEW-WIDTH [ FRAME-BUFFER last-dim>> first ] |
+
+ OLD-PIXELS OLD-WIDTH NEW-PIXELS NEW-WIDTH copy-pixels ] ]
+ ]
+ }
+ { [ t ] [ ] }
+ }
+ cond ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+M:: <frame-buffer> draw-gadget* ( FRAME-BUFFER -- )
+
+ FRAME-BUFFER rect-dim { 0 1 } v* first2 glRasterPos2i
+
+ FRAME-BUFFER draw-pixels
+
+ FRAME-BUFFER update-frame-buffer
+
+ glFlush
+
+ FRAME-BUFFER read-pixels ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+