steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge git://factorcode.org/git/factor

release
Doug Coleman 2007-10-12 20:46:23 -05:00
parent 17c1fe3a35 4192413861
commit 10f0c023d3
23 changed files with 338 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/effects/effects.factor
View File

@ -53,7 +53,7 @@ M: effect clone
[ effect-in clone ] keep effect-out clone <effect> ; [ effect-in clone ] keep effect-out clone <effect> ;
: split-shuffle ( stack shuffle -- stack1 stack2 ) : split-shuffle ( stack shuffle -- stack1 stack2 )
effect-in length swap cut* ; effect-in length cut* ;
: load-shuffle ( stack shuffle -- ) : load-shuffle ( stack shuffle -- )
effect-in [ set ] 2each ; effect-in [ set ] 2each ;

2
core/generator/registers/registers.factor
View File

@ -296,7 +296,7 @@ M: phantom-retainstack finalize-height
GENERIC: cut-phantom ( n phantom -- seq ) GENERIC: cut-phantom ( n phantom -- seq )
M: phantom-stack cut-phantom M: phantom-stack cut-phantom
[ delegate cut* swap ] keep set-delegate ; [ delegate swap cut* swap ] keep set-delegate ;
: phantom-append ( seq stack -- ) : phantom-append ( seq stack -- )
over length over adjust-phantom push-all ; over length over adjust-phantom push-all ;

2
core/prettyprint/prettyprint.factor
View File

@ -120,7 +120,7 @@ SYMBOL: ->
: remove-breakpoints ( quot pos -- quot' ) : remove-breakpoints ( quot pos -- quot' )
over quotation? [ over quotation? [
1+ swap cut [ (remove-breakpoints) ] 2apply 1+ cut [ (remove-breakpoints) ] 2apply
[ -> ] swap 3append [ -> ] swap 3append
] [ ] [
drop drop

6
core/sequences/sequences-docs.factor
View File

@ -904,17 +904,17 @@ HELP: tail?
{ delete-nth remove delete } related-words { delete-nth remove delete } related-words
HELP: cut-slice 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." } { $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." } ; { $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 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" } "." } { $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." } ; { $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* 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" } "." } ; { $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* HELP: start*

12
core/sequences/sequences.factor
View File

@ -604,14 +604,14 @@ M: sequence <=>
tuck length tail-slice* sequence= tuck length tail-slice* sequence=
] if ; ] if ;
: cut-slice ( n seq -- before after ) : cut-slice ( seq n -- before after )
swap [ head ] 2keep tail-slice ; [ head ] 2keep tail-slice ;
: cut ( n seq -- before after ) : cut ( seq n -- before after )
swap [ head ] 2keep tail ; [ head ] 2keep tail ;
: cut* ( n seq -- before after ) : cut* ( seq n -- before after )
swap [ head* ] 2keep tail* ; [ head* ] 2keep tail* ;
<PRIVATE <PRIVATE

2
core/tuples/tuples.factor
View File

@ -30,7 +30,7 @@ M: tuple class class-of-tuple ;
swap [ index ] curry map ; swap [ index ] curry map ;
: reshape-tuple ( oldtuple permutation -- newtuple ) : reshape-tuple ( oldtuple permutation -- newtuple )
>r tuple>array 2 swap cut r> >r tuple>array 2 cut r>
[ [ swap ?nth ] [ drop f ] if* ] curry* map [ [ swap ?nth ] [ drop f ] if* ] curry* map
append (>tuple) ; append (>tuple) ;

0
cp_dir Normal file → Executable file
View File

2
extra/base64/base64.factor
View File

@ -33,7 +33,7 @@ PRIVATE>
: >base64 ( seq -- base64 ) : >base64 ( seq -- base64 )
#! cut string into two pieces, convert 3 bytes at a time #! cut string into two pieces, convert 3 bytes at a time
#! pad string with = when not enough bits #! pad string with = when not enough bits
[ length dup 3 mod - ] keep cut swap dup length dup 3 mod - swap
[ [
3 group [ encode3 % ] each 3 group [ encode3 % ] each
dup empty? [ drop ] [ >base64-rem % ] if dup empty? [ drop ] [ >base64-rem % ] if

6
extra/concurrency/concurrency.factor
View File

@ -286,13 +286,15 @@ TUPLE: promise fulfilled? value processes ;
: fulfill ( value promise -- ) : fulfill ( value promise -- )
#! Set the future of the promise to the given value. Threads #! Set the future of the promise to the given value. Threads
#! blocking on the promise will then be released. #! blocking on the promise will then be released.
dup promise-fulfilled? [ dup promise-fulfilled? [
2drop
] [
[ set-promise-value ] keep [ set-promise-value ] keep
[ t swap set-promise-fulfilled? ] keep [ t swap set-promise-fulfilled? ] keep
[ promise-processes ] keep [ promise-processes ] keep
0 <vector> swap set-promise-processes 0 <vector> swap set-promise-processes
[ schedule-thread ] each yield [ schedule-thread ] each yield
] unless ; ] if ;
<PRIVATE <PRIVATE
: (maybe-block-promise) ( promise -- promise ) : (maybe-block-promise) ( promise -- promise )

2
extra/help/markup/markup.factor
View File

@ -113,7 +113,7 @@ M: f print-element drop ;
"Examples" $heading print-element ; "Examples" $heading print-element ;
: $example ( element -- ) : $example ( element -- )
1 swap cut* swap "\n" join dup <input> [ 1 cut* swap "\n" join dup <input> [
input-style get format nl print-element input-style get format nl print-element
] ($code) ; ] ($code) ;

2
extra/io/sniffer/filter/bsd/bsd.factor
View File

@ -11,7 +11,7 @@ IN: io.sniffer.filter.bsd
"long" heap-size 1- [ + ] keep bitnot bitand ; "long" heap-size 1- [ + ] keep bitnot bitand ;
M: unix-io packet. ( string -- ) M: unix-io packet. ( string -- )
18 swap cut swap >byte-array bpfh. 18 cut swap >byte-array bpfh.
(packet.) ; (packet.) ;
M: unix-io sniffer-loop ( stream -- ) M: unix-io sniffer-loop ( stream -- )

2
extra/irc/irc.factor
View File

@ -77,7 +77,7 @@ SYMBOL: irc-client
trim-: "!" split first ; trim-: "!" split first ;
: irc-split ( string -- seq ) : irc-split ( string -- seq )
1 swap [ [ CHAR: : = ] find* ] keep 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* ; " " split r> [ 1array append ] when* ;
: me? ( name -- ? ) : me? ( name -- ? )
irc-client get irc-client-nick nick-name = ; irc-client get irc-client-nick nick-name = ;

35
extra/lsys/strings/interpret/interpret.factor Normal file
View File

@ -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 -- ) <flat-slice> (interpret) ;

36
extra/lsys/strings/rewrite/rewrite.factor Normal file
View File

@ -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 * <sbuf> >accum
<flat-slice> (rewrite)
accum> >string ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
VAR: result
: iterate ( -- ) result> rewrite >result ;
: iterations ( n -- ) [ iterate ] times ;

56
extra/lsys/strings/strings.factor
View File

@ -1,60 +1,14 @@
USING: kernel combinators math math.parser assocs sequences quotations vars ; USING: kernel sequences math combinators.lib ;
IN: lsys.strings 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 ) : index-rest ( slice -- i ) CHAR: ) swap index 1+ ;
{ { [ 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 ;
: lookup ( str -- str ) dup 1 head rules> at dup [ nip ] [ drop ] if ; : next+rest* ( slice -- next rest ) dup index-rest [ head ] [ tail-slice ] 2bi ;
: 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 ;

7
extra/lsys/tortoise/graphics/graphics.factor
View File

@ -1,7 +1,10 @@
USING: kernel math vectors sequences opengl.gl math.vectors USING: kernel math vectors sequences opengl.gl math.vectors
math.matrices vars opengl self pos ori turtle lsys.tortoise math.matrices vars opengl self pos ori turtle lsys.tortoise
lsys.strings ;
lsys.strings.interpret ;
! lsys.strings
IN: lsys.tortoise.graphics IN: lsys.tortoise.graphics

10
extra/lsys/ui/ui.factor
View File

@ -14,8 +14,12 @@ USING: kernel namespaces threads math math.vectors quotations sequences
ui.gadgets.theme ui.gadgets.theme
vars rewrite-closures vars rewrite-closures
self pos ori turtle opengl.camera 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 IN: lsys.ui
@ -147,7 +151,7 @@ make-pile 1 over set-pack-fill "L-system control" open-window ;
: lsys-viewer ( -- ) : lsys-viewer ( -- )
f <slate> >slate [ ] <slate> >slate
{ 400 400 } clone slate> set-slate-dim { 400 400 } clone slate> set-slate-dim
{ {

223
extra/springies/models/2x2snake/2x2snake.factor Normal file
View File

@ -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

2
extra/springies/ui/ui.factor
View File

@ -51,7 +51,7 @@ DEFER: maybe-loop
: springies-window* ( -- ) : springies-window* ( -- )
C[ display ] <slate> >slate C[ display ] <slate> >slate
{ 700 500 } slate> set-slate-dim { 800 600 } slate> set-slate-dim
C[ { 500 500 } >world-size loop on [ run ] in-thread ] C[ { 500 500 } >world-size loop on [ run ] in-thread ]
slate> set-slate-graft slate> set-slate-graft
C[ loop off ] slate> set-slate-ungraft C[ loop off ] slate> set-slate-ungraft

2
extra/tar/tar.factor
View File

@ -34,7 +34,7 @@ linkname magic version uname gname devmajor devminor prefix ;
155 read-c-string* over set-tar-header-prefix ; 155 read-c-string* over set-tar-header-prefix ;
: header-checksum ( seq -- x ) : header-checksum ( seq -- x )
148 swap cut-slice 8 tail-slice 148 cut-slice 8 tail-slice
[ 0 [ + ] reduce ] 2apply + 256 + ; [ 0 [ + ] reduce ] 2apply + 256 + ;
TUPLE: checksum-error ; TUPLE: checksum-error ;

4
extra/tools/interpreter/interpreter.factor
View File

@ -98,7 +98,7 @@ PRIVATE>
2dup nth \ break = [ 2dup nth \ break = [
nip nip
] [ ] [
>r 1+ r> cut [ break ] swap 3append swap 1+ cut [ break ] swap 3append
] if ] if
] (step) ; ] (step) ;
@ -107,7 +107,7 @@ PRIVATE>
: step-into ( interpreter -- ) : step-into ( interpreter -- )
[ [
cut [ swap cut [
swap % unclip literalize , \ (step-into) , % swap % unclip literalize , \ (step-into) , %
] [ ] make ] [ ] make
] (step) ; ] (step) ;

2
extra/ui/gadgets/panes/panes.factor
View File

@ -353,7 +353,6 @@ M: f sloppy-pick-up*
: move-caret ( pane -- ) : move-caret ( pane -- )
dup hand-rel dup hand-rel
over sloppy-pick-up over sloppy-pick-up
2dup gadget-at-path scroll>gadget
over set-pane-caret over set-pane-caret
relayout-1 ; relayout-1 ;
@ -372,6 +371,7 @@ M: f sloppy-pick-up*
dup caret>mark dup caret>mark
] when ] when
] if ] if
dup dup pane-caret gadget-at-path scroll>gadget
] when drop ; ] when drop ;
: end-selection ( pane -- ) : end-selection ( pane -- )

2
extra/xml/xml.factor
View File

@ -93,7 +93,7 @@ M: closer process
: make-xml-doc ( prolog seq -- xml-doc ) : make-xml-doc ( prolog seq -- xml-doc )
dup [ tag? ] find dup [ tag? ] find
>r assure-tags swap cut 1 tail >r assure-tags cut 1 tail
no-pre/post no-post-tags no-pre/post no-post-tags
r> swap <xml> ; r> swap <xml> ;