From c8c7221c5825d181db14e2fc98131120a1cfb35b Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 10 Oct 2007 17:35:32 -0500 Subject: [PATCH 1/7] Add springies.models.2x2snake --- .../springies/models/2x2snake/2x2snake.factor | 223 ++++++++++++++++++ 1 file changed, 223 insertions(+) create mode 100644 extra/springies/models/2x2snake/2x2snake.factor diff --git a/extra/springies/models/2x2snake/2x2snake.factor b/extra/springies/models/2x2snake/2x2snake.factor new file mode 100644 index 0000000000..41ba6143c9 --- /dev/null +++ b/extra/springies/models/2x2snake/2x2snake.factor @@ -0,0 +1,223 @@ + +USING: kernel namespaces arrays sequences threads math math.vectors + ui random bake springies springies.ui ; + +IN: springies.models.2x2snake + +: model ( -- ) + +{ } clone >nodes +{ } clone >springs +0.002 >time-slice +gravity off + +1 147.0 324.0 0.0 0.0 1.0 1.0 mass +2 164.0 324.0 0.0 0.0 1.0 1.0 mass +3 182.0 324.0 0.0 0.0 1.0 1.0 mass +4 200.0 324.0 0.0 0.0 1.0 1.0 mass +5 218.0 324.0 0.0 0.0 1.0 1.0 mass +6 236.0 324.0 0.0 0.0 1.0 1.0 mass +7 254.0 324.0 0.0 0.0 1.0 1.0 mass +8 272.0 324.0 0.0 0.0 1.0 1.0 mass +9 290.0 324.0 0.0 0.0 1.0 1.0 mass +10 308.0 324.0 0.0 0.0 1.0 1.0 mass +11 326.0 324.0 0.0 0.0 1.0 1.0 mass +12 344.0 324.0 0.0 0.0 1.0 1.0 mass +13 362.0 324.0 0.0 0.0 1.0 1.0 mass +14 380.0 324.0 0.0 0.0 1.0 1.0 mass +15 398.0 324.0 0.0 0.0 1.0 1.0 mass +16 416.0 324.0 0.0 0.0 1.0 1.0 mass +17 434.0 324.0 0.0 0.0 1.0 1.0 mass +18 452.0 324.0 0.0 0.0 1.0 1.0 mass +19 470.0 324.0 0.0 0.0 1.0 1.0 mass +20 147.0 298.0 0.0 0.0 1.0 1.0 mass +21 164.0 298.0 0.0 0.0 1.0 1.0 mass +22 182.0 298.0 0.0 0.0 1.0 1.0 mass +23 200.0 298.0 0.0 0.0 1.0 1.0 mass +24 218.0 298.0 0.0 0.0 1.0 1.0 mass +25 236.0 298.0 0.0 0.0 1.0 1.0 mass +26 254.0 298.0 0.0 0.0 1.0 1.0 mass +27 272.0 298.0 0.0 0.0 1.0 1.0 mass +28 290.0 298.0 0.0 0.0 1.0 1.0 mass +29 308.0 298.0 0.0 0.0 1.0 1.0 mass +30 326.0 298.0 0.0 0.0 1.0 1.0 mass +31 344.0 298.0 0.0 0.0 1.0 1.0 mass +32 362.0 298.0 0.0 0.0 1.0 1.0 mass +33 380.0 298.0 0.0 0.0 1.0 1.0 mass +34 398.0 298.0 0.0 0.0 1.0 1.0 mass +35 416.0 298.0 0.0 0.0 1.0 1.0 mass +36 434.0 298.0 0.0 0.0 1.0 1.0 mass +37 452.0 298.0 0.0 0.0 1.0 1.0 mass +38 470.0 298.0 0.0 0.0 1.0 1.0 mass +1 1 2 200.0 1.500000 18.0 spng +2 3 2 200.0 1.500000 18.0 spng +3 3 4 200.0 1.500000 18.0 spng +4 4 5 200.0 1.500000 18.0 spng +5 5 6 200.0 1.500000 18.0 spng +6 6 7 200.0 1.500000 18.0 spng +7 7 8 200.0 1.500000 18.0 spng +8 8 9 200.0 1.500000 18.0 spng +9 9 10 200.0 1.500000 18.0 spng +10 10 11 200.0 1.500000 18.0 spng +11 11 12 200.0 1.500000 18.0 spng +12 12 13 200.0 1.500000 18.0 spng +13 13 14 200.0 1.500000 18.0 spng +14 14 15 200.0 1.500000 18.0 spng +15 15 16 200.0 1.500000 18.0 spng +16 16 17 200.0 1.500000 18.0 spng +17 17 18 200.0 1.500000 18.0 spng +18 18 19 200.0 1.500000 18.0 spng +19 1 3 200.0 1.500000 36.0 spng +20 2 4 200.0 1.500000 36.0 spng +21 3 5 200.0 1.500000 36.0 spng +22 4 6 200.0 1.500000 36.0 spng +23 5 7 200.0 1.500000 36.0 spng +24 6 8 200.0 1.500000 36.0 spng +25 7 9 200.0 1.500000 36.0 spng +26 8 10 200.0 1.500000 36.0 spng +27 9 11 200.0 1.500000 36.0 spng +28 10 12 200.0 1.500000 36.0 spng +29 11 13 200.0 1.500000 36.0 spng +30 12 14 200.0 1.500000 36.0 spng +31 13 15 200.0 1.500000 36.0 spng +32 14 16 200.0 1.500000 36.0 spng +33 15 17 200.0 1.500000 36.0 spng +34 16 18 200.0 1.500000 36.0 spng +35 17 19 200.0 1.500000 36.0 spng +36 20 21 200.0 1.500000 18.0 spng +37 22 21 200.0 1.500000 18.0 spng +38 22 23 200.0 1.500000 18.0 spng +39 23 24 200.0 1.500000 18.0 spng +40 24 25 200.0 1.500000 18.0 spng +41 25 26 200.0 1.500000 18.0 spng +42 26 27 200.0 1.500000 18.0 spng +43 27 28 200.0 1.500000 18.0 spng +44 28 29 200.0 1.500000 18.0 spng +45 29 30 200.0 1.500000 18.0 spng +46 30 31 200.0 1.500000 18.0 spng +47 31 32 200.0 1.500000 18.0 spng +48 32 33 200.0 1.500000 18.0 spng +49 33 34 200.0 1.500000 18.0 spng +50 34 35 200.0 1.500000 18.0 spng +51 35 36 200.0 1.500000 18.0 spng +52 36 37 200.0 1.500000 18.0 spng +53 37 38 200.0 1.500000 18.0 spng +54 20 22 200.0 1.500000 36.0 spng +55 21 23 200.0 1.500000 36.0 spng +56 22 24 200.0 1.500000 36.0 spng +57 23 25 200.0 1.500000 36.0 spng +58 24 26 200.0 1.500000 36.0 spng +59 25 27 200.0 1.500000 36.0 spng +60 26 28 200.0 1.500000 36.0 spng +61 27 29 200.0 1.500000 36.0 spng +62 28 30 200.0 1.500000 36.0 spng +63 29 31 200.0 1.500000 36.0 spng +64 30 32 200.0 1.500000 36.0 spng +65 31 33 200.0 1.500000 36.0 spng +66 32 34 200.0 1.500000 36.0 spng +67 33 35 200.0 1.500000 36.0 spng +68 34 36 200.0 1.500000 36.0 spng +69 35 37 200.0 1.500000 36.0 spng +70 36 38 200.0 1.500000 36.0 spng +71 1 20 200.0 1.500000 26.0 spng +72 2 21 200.0 1.500000 26.0 spng +73 3 22 200.0 1.500000 26.0 spng +74 4 23 200.0 1.500000 26.0 spng +75 5 24 200.0 1.500000 26.0 spng +76 25 6 200.0 1.500000 26.0 spng +77 7 26 200.0 1.500000 26.0 spng +78 27 8 200.0 1.500000 26.0 spng +79 9 28 200.0 1.500000 26.0 spng +80 29 10 200.0 1.500000 26.0 spng +81 11 30 200.0 1.500000 26.0 spng +82 31 12 200.0 1.500000 26.0 spng +83 13 32 200.0 1.500000 26.0 spng +84 33 14 200.0 1.500000 26.0 spng +85 15 34 200.0 1.500000 26.0 spng +86 35 16 200.0 1.500000 26.0 spng +87 17 36 200.0 1.500000 26.0 spng +88 37 18 200.0 1.500000 26.0 spng +89 19 38 200.0 1.500000 26.0 spng +90 1 21 200.0 1.500000 31.064449 spng +91 2 20 200.0 1.500000 31.064449 spng +92 2 22 200.0 1.500000 31.622777 spng +93 3 21 200.0 1.500000 31.622777 spng +94 3 23 200.0 1.500000 31.622777 spng +95 4 22 200.0 1.500000 31.622777 spng +96 4 24 200.0 1.500000 31.622777 spng +97 5 23 200.0 1.500000 31.622777 spng +98 5 25 200.0 1.500000 31.622777 spng +99 6 24 200.0 1.500000 31.622777 spng +100 6 26 200.0 1.500000 31.622777 spng +101 7 25 200.0 1.500000 31.622777 spng +102 7 27 200.0 1.500000 31.622777 spng +103 8 26 200.0 1.500000 31.622777 spng +104 8 28 200.0 1.500000 31.622777 spng +105 9 27 200.0 1.500000 31.622777 spng +106 9 29 200.0 1.500000 31.622777 spng +107 10 28 200.0 1.500000 31.622777 spng +108 10 30 200.0 1.500000 31.622777 spng +109 11 29 200.0 1.500000 31.622777 spng +110 11 31 200.0 1.500000 31.622777 spng +111 12 30 200.0 1.500000 31.622777 spng +112 12 32 200.0 1.500000 31.622777 spng +113 13 31 200.0 1.500000 31.622777 spng +114 13 33 200.0 1.500000 31.622777 spng +115 14 32 200.0 1.500000 31.622777 spng +116 14 34 200.0 1.500000 31.622777 spng +117 15 33 200.0 1.500000 31.622777 spng +118 15 35 200.0 1.500000 31.622777 spng +119 16 34 200.0 1.500000 31.622777 spng +120 16 36 200.0 1.500000 31.622777 spng +121 17 35 200.0 1.500000 31.622777 spng +122 17 37 200.0 1.500000 31.622777 spng +123 18 36 200.0 1.500000 31.622777 spng +124 18 38 200.0 1.500000 31.622777 spng +125 19 37 200.0 1.500000 31.622777 spng +126 1 22 200.0 1.500000 43.600459 spng +127 3 20 200.0 1.500000 43.600459 spng +128 2 23 200.0 1.500000 44.407207 spng +129 4 21 200.0 1.500000 44.407207 spng +130 3 24 200.0 1.500000 44.407207 spng +131 5 22 200.0 1.500000 44.407207 spng +132 4 25 200.0 1.500000 44.407207 spng +133 6 23 200.0 1.500000 44.407207 spng +134 5 26 200.0 1.500000 44.407207 spng +135 7 24 200.0 1.500000 44.407207 spng +136 6 27 200.0 1.500000 44.407207 spng +137 8 25 200.0 1.500000 44.407207 spng +138 7 28 200.0 1.500000 44.407207 spng +139 9 26 200.0 1.500000 44.407207 spng +140 8 29 200.0 1.500000 44.407207 spng +141 10 27 200.0 1.500000 44.407207 spng +142 9 30 200.0 1.500000 44.407207 spng +143 11 28 200.0 1.500000 44.407207 spng +144 10 31 200.0 1.500000 44.407207 spng +145 12 29 200.0 1.500000 44.407207 spng +146 11 32 200.0 1.500000 44.407207 spng +147 13 30 200.0 1.500000 44.407207 spng +148 12 33 200.0 1.500000 44.407207 spng +149 14 31 200.0 1.500000 44.407207 spng +150 13 34 200.0 1.500000 44.407207 spng +151 15 33 200.0 1.500000 31.622777 spng +152 32 15 200.0 1.500000 44.407207 spng +153 14 35 200.0 1.500000 44.407207 spng +154 16 33 200.0 1.500000 44.407207 spng +155 15 36 200.0 1.500000 44.407207 spng +156 34 17 200.0 1.500000 44.407207 spng +157 16 37 200.0 1.500000 44.407207 spng +158 18 35 200.0 1.500000 44.407207 spng +159 17 38 200.0 1.500000 44.407207 spng +160 19 36 200.0 1.500000 44.407207 spng + +! Send the half of the snake in a random direction + +nodes> 10 [ swap nth ] curry* map +nodes> 10 [ 19 + swap nth ] curry* map append +100 random -50 + 100 random 100 + { -1 1 } random * 2array +[ swap set-node-vel ] curry +each ; + +: go ( -- ) [ model ] go* ; + +MAIN: go \ No newline at end of file From 4a96490e480faf75e113cc6ad3582e4cb809e539 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 10 Oct 2007 17:36:08 -0500 Subject: [PATCH 2/7] Make springies ui 800x600 --- extra/springies/ui/ui.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/springies/ui/ui.factor b/extra/springies/ui/ui.factor index 156b9a8d6b..f14a7e3fe5 100644 --- a/extra/springies/ui/ui.factor +++ b/extra/springies/ui/ui.factor @@ -51,7 +51,7 @@ DEFER: maybe-loop : springies-window* ( -- ) C[ display ] >slate - { 700 500 } slate> set-slate-dim + { 800 600 } slate> set-slate-dim C[ { 500 500 } >world-size loop on [ run ] in-thread ] slate> set-slate-graft C[ loop off ] slate> set-slate-ungraft From b7be5d1750a2f852c5dc37cfba53ee98448d9f1f Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 11 Oct 2007 14:12:58 -0500 Subject: [PATCH 3/7] lsys.ui: Fix pit - 'f' cannot be called anymore --- extra/lsys/ui/ui.factor | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/extra/lsys/ui/ui.factor b/extra/lsys/ui/ui.factor index 2602adfcee..45372aec6c 100644 --- a/extra/lsys/ui/ui.factor +++ b/extra/lsys/ui/ui.factor @@ -14,8 +14,12 @@ USING: kernel namespaces threads math math.vectors quotations sequences ui.gadgets.theme vars rewrite-closures self pos ori turtle opengl.camera - lsys.tortoise lsys.tortoise.graphics lsys.strings -; + lsys.tortoise lsys.tortoise.graphics + lsys.strings.rewrite lsys.strings.interpret ; + + ! lsys.strings + ! lsys.strings.rewrite + ! lsys.strings.interpret IN: lsys.ui @@ -147,7 +151,7 @@ make-pile 1 over set-pack-fill "L-system control" open-window ; : lsys-viewer ( -- ) -f >slate +[ ] >slate { 400 400 } clone slate> set-slate-dim { From 03a01984dd309c750e7544bdd807f77bad42e01d Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 11 Oct 2007 14:14:12 -0500 Subject: [PATCH 4/7] Refactor lsys string rewriting and interpretation --- extra/lsys/strings/interpret/interpret.factor | 35 ++++++++++++ extra/lsys/strings/rewrite/rewrite.factor | 36 ++++++++++++ extra/lsys/strings/strings.factor | 56 ++----------------- extra/lsys/tortoise/graphics/graphics.factor | 7 ++- 4 files changed, 81 insertions(+), 53 deletions(-) create mode 100644 extra/lsys/strings/interpret/interpret.factor create mode 100644 extra/lsys/strings/rewrite/rewrite.factor diff --git a/extra/lsys/strings/interpret/interpret.factor b/extra/lsys/strings/interpret/interpret.factor new file mode 100644 index 0000000000..bcd87ca137 --- /dev/null +++ b/extra/lsys/strings/interpret/interpret.factor @@ -0,0 +1,35 @@ + +USING: kernel sequences quotations assocs math math.parser + combinators.lib vars lsys.strings ; + +IN: lsys.strings.interpret + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VAR: command-table + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: exec-command ( string -- ) command-table> at >quotation call ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: command ( string -- command ) 1 head ; + +: parameter ( string -- parameter ) + [ drop 2 ] [ length 1- ] [ ] tri subseq string>number ; + +: exec-command* ( string -- ) + [ parameter ] [ command ] bi + command-table> at dup + [ 1 tail* call ] [ 3drop ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: (interpret) ( slice -- ) + { { [ empty? ] [ drop ] } + { [ has-param? ] [ next+rest* [ exec-command* ] [ (interpret) ] bi* ] } + { [ t ] [ next+rest [ exec-command ] [ (interpret) ] bi* ] } } + switch ; + +: interpret ( string -- ) (interpret) ; diff --git a/extra/lsys/strings/rewrite/rewrite.factor b/extra/lsys/strings/rewrite/rewrite.factor new file mode 100644 index 0000000000..18db67ec95 --- /dev/null +++ b/extra/lsys/strings/rewrite/rewrite.factor @@ -0,0 +1,36 @@ + +USING: kernel sbufs strings sequences assocs math + combinators.lib vars lsys.strings ; + +IN: lsys.strings.rewrite + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VAR: rules + +: lookup ( str -- str ) [ 1 head rules> at ] [ ] bi or ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VAR: accum + +: push-next ( next -- ) lookup accum> push-all ; + +: (rewrite) ( slice -- ) + { { [ empty? ] [ drop ] } + { [ has-param? ] [ next+rest* [ push-next ] [ (rewrite) ] bi* ] } + { [ t ] [ next+rest [ push-next ] [ (rewrite) ] bi* ] } } + switch ; + +: rewrite ( string -- string ) + dup length 10 * >accum + (rewrite) + accum> >string ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VAR: result + +: iterate ( -- ) result> rewrite >result ; + +: iterations ( n -- ) [ iterate ] times ; diff --git a/extra/lsys/strings/strings.factor b/extra/lsys/strings/strings.factor index 64fe648146..3c9dfcab6c 100644 --- a/extra/lsys/strings/strings.factor +++ b/extra/lsys/strings/strings.factor @@ -1,60 +1,14 @@ -USING: kernel combinators math math.parser assocs sequences quotations vars ; +USING: kernel sequences math combinators.lib ; IN: lsys.strings -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Lindenmayer string rewriting ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Maybe use an array instead of a quot in the work of segment +: has-param? ( slice -- ? ) { [ length 1 > ] [ second CHAR: ( = ] } <-&& ; -VAR: rules +: next+rest ( slice -- next rest ) [ 1 head ] [ 1 tail-slice ] bi ; -: segment ( str -- seq ) -{ { [ dup "" = ] [ drop [ ] ] } - { [ dup length 1 = ] [ 1quotation ] } - { [ 1 over nth CHAR: ( = ] - [ CHAR: ) over index 1 + ! str i - 2dup head ! str i head - -rot tail ! head tail - segment swap add* ] } - { [ t ] [ dup 1 head swap 1 tail segment swap add* ] } } -cond ; +: index-rest ( slice -- i ) CHAR: ) swap index 1+ ; -: lookup ( str -- str ) dup 1 head rules> at dup [ nip ] [ drop ] if ; - -: rewrite ( str -- str ) segment [ lookup ] map concat ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -VAR: result - -: iterate ( -- ) result> rewrite >result ; - -: iterations ( n -- ) [ iterate ] times ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Lindenmayer string interpretation -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -VAR: command-table - -: segment-command ( seg -- command ) 1 head ; - -: segment-parameter ( seg -- parameter ) -dup length 1 - 2 swap rot subseq string>number ; - -: segment-parts ( seg -- param command ) -dup segment-parameter swap segment-command ; - -: exec-command ( str -- ) command-table> at dup [ call ] [ drop ] if ; - -: exec-command-with-param ( param command -- ) -command-table> at dup [ peek 1quotation call ] [ 2drop ] if ; - -: (interpret) ( seg -- ) -dup length 1 = -[ exec-command ] [ segment-parts exec-command-with-param ] if ; - -: interpret ( str -- ) segment [ (interpret) ] each ; +: next+rest* ( slice -- next rest ) dup index-rest [ head ] [ tail-slice ] 2bi ; diff --git a/extra/lsys/tortoise/graphics/graphics.factor b/extra/lsys/tortoise/graphics/graphics.factor index c212ab435d..d8429e7aaf 100644 --- a/extra/lsys/tortoise/graphics/graphics.factor +++ b/extra/lsys/tortoise/graphics/graphics.factor @@ -1,7 +1,10 @@ USING: kernel math vectors sequences opengl.gl math.vectors -math.matrices vars opengl self pos ori turtle lsys.tortoise -lsys.strings ; + math.matrices vars opengl self pos ori turtle lsys.tortoise + + lsys.strings.interpret ; + + ! lsys.strings IN: lsys.tortoise.graphics From 5f3dde7e26c7555bd4e8dd1181021434110bd7b4 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 12 Oct 2007 10:17:57 +1300 Subject: [PATCH 5/7] Fix concurrency:fulfill unbalanced stack issue --- cp_dir | 0 extra/concurrency/concurrency.factor | 6 ++++-- 2 files changed, 4 insertions(+), 2 deletions(-) mode change 100644 => 100755 cp_dir diff --git a/cp_dir b/cp_dir old mode 100644 new mode 100755 diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor index 32ae3e5940..14f74f5d55 100644 --- a/extra/concurrency/concurrency.factor +++ b/extra/concurrency/concurrency.factor @@ -286,13 +286,15 @@ TUPLE: promise fulfilled? value processes ; : fulfill ( value promise -- ) #! Set the future of the promise to the given value. Threads #! blocking on the promise will then be released. - dup promise-fulfilled? [ + dup promise-fulfilled? [ + 2drop + ] [ [ set-promise-value ] keep [ t swap set-promise-fulfilled? ] keep [ promise-processes ] keep 0 swap set-promise-processes [ schedule-thread ] each yield - ] unless ; + ] if ; Date: Thu, 11 Oct 2007 18:22:24 -0400 Subject: [PATCH 6/7] Clicks in the pane don't scroll anymore --- extra/ui/gadgets/panes/panes.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ui/gadgets/panes/panes.factor b/extra/ui/gadgets/panes/panes.factor index 6adaca7746..bc38c9d46a 100644 --- a/extra/ui/gadgets/panes/panes.factor +++ b/extra/ui/gadgets/panes/panes.factor @@ -353,7 +353,6 @@ M: f sloppy-pick-up* : move-caret ( pane -- ) dup hand-rel over sloppy-pick-up - 2dup gadget-at-path scroll>gadget over set-pane-caret relayout-1 ; @@ -372,6 +371,7 @@ M: f sloppy-pick-up* dup caret>mark ] when ] if + dup dup pane-caret gadget-at-path scroll>gadget ] when drop ; : end-selection ( pane -- ) From 419241386160db3937517cc9c34eb0cc7c462561 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 12 Oct 2007 16:30:36 -0400 Subject: [PATCH 7/7] Change cut stack effect --- core/effects/effects.factor | 2 +- core/generator/registers/registers.factor | 2 +- core/prettyprint/prettyprint.factor | 2 +- core/sequences/sequences-docs.factor | 6 +++--- core/sequences/sequences.factor | 12 ++++++------ core/tuples/tuples.factor | 2 +- extra/base64/base64.factor | 2 +- extra/help/markup/markup.factor | 2 +- extra/io/sniffer/filter/bsd/bsd.factor | 2 +- extra/irc/irc.factor | 2 +- extra/tar/tar.factor | 2 +- extra/tools/interpreter/interpreter.factor | 4 ++-- extra/xml/xml.factor | 2 +- 13 files changed, 21 insertions(+), 21 deletions(-) diff --git a/core/effects/effects.factor b/core/effects/effects.factor index d881184508..ee929507c8 100644 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -53,7 +53,7 @@ M: effect clone [ effect-in clone ] keep effect-out clone ; : split-shuffle ( stack shuffle -- stack1 stack2 ) - effect-in length swap cut* ; + effect-in length cut* ; : load-shuffle ( stack shuffle -- ) effect-in [ set ] 2each ; diff --git a/core/generator/registers/registers.factor b/core/generator/registers/registers.factor index 68e63ac605..bbde2ff6f4 100644 --- a/core/generator/registers/registers.factor +++ b/core/generator/registers/registers.factor @@ -296,7 +296,7 @@ M: phantom-retainstack finalize-height GENERIC: cut-phantom ( n phantom -- seq ) M: phantom-stack cut-phantom - [ delegate cut* swap ] keep set-delegate ; + [ delegate swap cut* swap ] keep set-delegate ; : phantom-append ( seq stack -- ) over length over adjust-phantom push-all ; diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 01cff3b7b3..011a8cc851 100644 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -120,7 +120,7 @@ SYMBOL: -> : remove-breakpoints ( quot pos -- quot' ) over quotation? [ - 1+ swap cut [ (remove-breakpoints) ] 2apply + 1+ cut [ (remove-breakpoints) ] 2apply [ -> ] swap 3append ] [ drop diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index c553eac0df..91253ee9e0 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -904,17 +904,17 @@ HELP: tail? { delete-nth remove delete } related-words HELP: cut-slice -{ $values { "n" "a non-negative integer" } { "seq" sequence } { "before" sequence } { "after" "a slice" } } +{ $values { "seq" sequence } { "n" "a non-negative integer" } { "before" sequence } { "after" "a slice" } } { $description "Outputs a pair of sequences, where " { $snippet "before" } " consists of the first " { $snippet "n" } " elements of " { $snippet "seq" } " and has the same type, while " { $snippet "after" } " is a slice of the remaining elements." } { $notes "Unlike " { $link cut } ", the run time of this word is proportional to the length of " { $snippet "before" } ", not " { $snippet "after" } ", so it is suitable for use in an iterative algorithm which cuts successive pieces off a sequence." } ; HELP: cut -{ $values { "n" "a non-negative integer" } { "seq" sequence } { "before" sequence } { "after" sequence } } +{ $values { "seq" sequence } { "n" "a non-negative integer" } { "before" sequence } { "after" sequence } } { $description "Outputs a pair of sequences, where " { $snippet "before" } " consists of the first " { $snippet "n" } " elements of " { $snippet "seq" } ", while " { $snippet "after" } " holds the remaining elements. Both output sequences have the same type as " { $snippet "seq" } "." } { $notes "Since this word copies the entire tail of the sequence, it should not be used in a loop. If this is important, consider using " { $link cut-slice } " instead, since it returns a slice for the tail instead of copying." } ; HELP: cut* -{ $values { "n" "a non-negative integer" } { "seq" sequence } { "before" sequence } { "after" sequence } } +{ $values { "seq" sequence } { "n" "a non-negative integer" } { "before" sequence } { "after" sequence } } { $description "Outputs a pair of sequences, where " { $snippet "after" } " consists of the last " { $snippet "n" } " elements of " { $snippet "seq" } ", while " { $snippet "before" } " holds the remaining elements. Both output sequences have the same type as " { $snippet "seq" } "." } ; HELP: start* diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index a31c869f24..3c63cd5cb4 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -604,14 +604,14 @@ M: sequence <=> tuck length tail-slice* sequence= ] if ; -: cut-slice ( n seq -- before after ) - swap [ head ] 2keep tail-slice ; +: cut-slice ( seq n -- before after ) + [ head ] 2keep tail-slice ; -: cut ( n seq -- before after ) - swap [ head ] 2keep tail ; +: cut ( seq n -- before after ) + [ head ] 2keep tail ; -: cut* ( n seq -- before after ) - swap [ head* ] 2keep tail* ; +: cut* ( seq n -- before after ) + [ head* ] 2keep tail* ; r tuple>array 2 swap cut r> + >r tuple>array 2 cut r> [ [ swap ?nth ] [ drop f ] if* ] curry* map append (>tuple) ; diff --git a/extra/base64/base64.factor b/extra/base64/base64.factor index c354de9ad1..7bbf422ea0 100644 --- a/extra/base64/base64.factor +++ b/extra/base64/base64.factor @@ -33,7 +33,7 @@ PRIVATE> : >base64 ( seq -- base64 ) #! cut string into two pieces, convert 3 bytes at a time #! pad string with = when not enough bits - [ length dup 3 mod - ] keep cut swap + dup length dup 3 mod - swap [ 3 group [ encode3 % ] each dup empty? [ drop ] [ >base64-rem % ] if diff --git a/extra/help/markup/markup.factor b/extra/help/markup/markup.factor index c2eddaf8dd..52bc75780c 100644 --- a/extra/help/markup/markup.factor +++ b/extra/help/markup/markup.factor @@ -113,7 +113,7 @@ M: f print-element drop ; "Examples" $heading print-element ; : $example ( element -- ) - 1 swap cut* swap "\n" join dup [ + 1 cut* swap "\n" join dup [ input-style get format nl print-element ] ($code) ; diff --git a/extra/io/sniffer/filter/bsd/bsd.factor b/extra/io/sniffer/filter/bsd/bsd.factor index fc34b3448b..c6882352d0 100644 --- a/extra/io/sniffer/filter/bsd/bsd.factor +++ b/extra/io/sniffer/filter/bsd/bsd.factor @@ -11,7 +11,7 @@ IN: io.sniffer.filter.bsd "long" heap-size 1- [ + ] keep bitnot bitand ; M: unix-io packet. ( string -- ) - 18 swap cut swap >byte-array bpfh. + 18 cut swap >byte-array bpfh. (packet.) ; M: unix-io sniffer-loop ( stream -- ) diff --git a/extra/irc/irc.factor b/extra/irc/irc.factor index 0f2a0fb19e..0f2f2c371a 100644 --- a/extra/irc/irc.factor +++ b/extra/irc/irc.factor @@ -77,7 +77,7 @@ SYMBOL: irc-client trim-: "!" split first ; : irc-split ( string -- seq ) 1 swap [ [ CHAR: : = ] find* ] keep - swap [ cut trim-: ] [ nip f ] if >r [ blank? ] trim trim-: + swap [ swap cut trim-: ] [ nip f ] if >r [ blank? ] trim trim-: " " split r> [ 1array append ] when* ; : me? ( name -- ? ) irc-client get irc-client-nick nick-name = ; diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index 9ee727a110..e41264680c 100644 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -34,7 +34,7 @@ linkname magic version uname gname devmajor devminor prefix ; 155 read-c-string* over set-tar-header-prefix ; : header-checksum ( seq -- x ) - 148 swap cut-slice 8 tail-slice + 148 cut-slice 8 tail-slice [ 0 [ + ] reduce ] 2apply + 256 + ; TUPLE: checksum-error ; diff --git a/extra/tools/interpreter/interpreter.factor b/extra/tools/interpreter/interpreter.factor index f1e36032a0..a43a4b46ce 100644 --- a/extra/tools/interpreter/interpreter.factor +++ b/extra/tools/interpreter/interpreter.factor @@ -98,7 +98,7 @@ PRIVATE> 2dup nth \ break = [ nip ] [ - >r 1+ r> cut [ break ] swap 3append + swap 1+ cut [ break ] swap 3append ] if ] (step) ; @@ -107,7 +107,7 @@ PRIVATE> : step-into ( interpreter -- ) [ - cut [ + swap cut [ swap % unclip literalize , \ (step-into) , % ] [ ] make ] (step) ; diff --git a/extra/xml/xml.factor b/extra/xml/xml.factor index 0889d790b0..826b16b213 100644 --- a/extra/xml/xml.factor +++ b/extra/xml/xml.factor @@ -93,7 +93,7 @@ M: closer process : make-xml-doc ( prolog seq -- xml-doc ) dup [ tag? ] find - >r assure-tags swap cut 1 tail + >r assure-tags cut 1 tail no-pre/post no-post-tags r> swap ;