diff --git a/unmaintained/assocs-lib/authors.txt b/unmaintained/assocs-lib/authors.txt deleted file mode 100644 index 6cfd5da273..0000000000 --- a/unmaintained/assocs-lib/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/assocs-lib/lib-tests.factor b/unmaintained/assocs-lib/lib-tests.factor deleted file mode 100644 index c7e1aa4fbf..0000000000 --- a/unmaintained/assocs-lib/lib-tests.factor +++ /dev/null @@ -1,17 +0,0 @@ -USING: kernel tools.test sequences vectors assocs.lib ; -IN: assocs.lib.tests - -{ 1 1 } [ [ ?push ] histogram ] must-infer-as - -! substitute -[ { 2 } ] [ { 1 } H{ { 1 2 } } [ ?at drop ] curry map ] unit-test -[ { 3 } ] [ { 3 } H{ { 1 2 } } [ ?at drop ] curry map ] unit-test - -[ 2 ] [ 1 H{ { 1 2 } } [ ] [ ] if-at ] unit-test -[ 3 ] [ 3 H{ { 1 2 } } [ ] [ ] if-at ] unit-test - -[ "hi" ] [ 1 H{ { 1 2 } } [ drop "hi" ] when-at ] unit-test -[ 3 ] [ 3 H{ { 1 2 } } [ drop "hi" ] when-at ] unit-test -[ 2 ] [ 1 H{ { 1 2 } } [ drop "hi" ] unless-at ] unit-test -[ "hi" ] [ 3 H{ { 1 2 } } [ drop "hi" ] unless-at ] unit-test - diff --git a/unmaintained/assocs-lib/lib.factor b/unmaintained/assocs-lib/lib.factor deleted file mode 100755 index f1b018f54e..0000000000 --- a/unmaintained/assocs-lib/lib.factor +++ /dev/null @@ -1,49 +0,0 @@ -USING: arrays assocs kernel vectors sequences namespaces - random math.parser math fry ; - -IN: assocs.lib - -: set-assoc-stack ( value key seq -- ) - dupd [ key? ] with find-last nip set-at ; - -: at-default ( key assoc -- value/key ) - dupd at [ nip ] when* ; - -: replace-at ( assoc value key -- assoc ) - [ dupd 1vector ] dip rot set-at ; - -: peek-at* ( assoc key -- obj ? ) - swap at* dup [ [ peek ] dip ] when ; - -: peek-at ( assoc key -- obj ) - peek-at* drop ; - -: >multi-assoc ( assoc -- new-assoc ) - [ 1vector ] assoc-map ; - -: multi-assoc-each ( assoc quot -- ) - [ with each ] curry assoc-each ; inline - -: insert ( value variable -- ) namespace push-at ; - -: generate-key ( assoc -- str ) - [ 32 random-bits >hex ] dip - 2dup key? [ nip generate-key ] [ drop ] if ; - -: set-at-unique ( value assoc -- key ) - dup generate-key [ swap set-at ] keep ; - -: histogram ( assoc quot -- assoc' ) - H{ } clone [ - swap [ change-at ] 2curry assoc-each - ] keep ; inline - -: ?at ( obj assoc -- value/obj ? ) - dupd at* [ [ nip ] [ drop ] if ] keep ; - -: if-at ( obj assoc quot1 quot2 -- ) - [ ?at ] 2dip if ; inline - -: when-at ( obj assoc quot -- ) [ ] if-at ; inline - -: unless-at ( obj assoc quot -- ) [ ] swap if-at ; inline diff --git a/unmaintained/assocs-lib/summary.txt b/unmaintained/assocs-lib/summary.txt deleted file mode 100644 index 24c282540c..0000000000 --- a/unmaintained/assocs-lib/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Non-core assoc words diff --git a/unmaintained/assocs-lib/tags.txt b/unmaintained/assocs-lib/tags.txt deleted file mode 100644 index 42d711b32b..0000000000 --- a/unmaintained/assocs-lib/tags.txt +++ /dev/null @@ -1 +0,0 @@ -collections diff --git a/extra/automata/authors.txt b/unmaintained/automata/authors.txt similarity index 100% rename from extra/automata/authors.txt rename to unmaintained/automata/authors.txt diff --git a/extra/automata/automata.factor b/unmaintained/automata/automata.factor similarity index 100% rename from extra/automata/automata.factor rename to unmaintained/automata/automata.factor diff --git a/extra/automata/summary.txt b/unmaintained/automata/summary.txt similarity index 100% rename from extra/automata/summary.txt rename to unmaintained/automata/summary.txt diff --git a/extra/automata/ui/authors.txt b/unmaintained/automata/ui/authors.txt similarity index 100% rename from extra/automata/ui/authors.txt rename to unmaintained/automata/ui/authors.txt diff --git a/extra/automata/ui/deploy.factor b/unmaintained/automata/ui/deploy.factor similarity index 100% rename from extra/automata/ui/deploy.factor rename to unmaintained/automata/ui/deploy.factor diff --git a/extra/automata/ui/tags.txt b/unmaintained/automata/ui/tags.txt similarity index 100% rename from extra/automata/ui/tags.txt rename to unmaintained/automata/ui/tags.txt diff --git a/extra/automata/ui/ui.factor b/unmaintained/automata/ui/ui.factor similarity index 100% rename from extra/automata/ui/ui.factor rename to unmaintained/automata/ui/ui.factor diff --git a/unmaintained/bake/authors.txt b/unmaintained/bake/authors.txt deleted file mode 100644 index 6cfd5da273..0000000000 --- a/unmaintained/bake/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/bake/bake-tests.factor b/unmaintained/bake/bake-tests.factor deleted file mode 100644 index 64329de92d..0000000000 --- a/unmaintained/bake/bake-tests.factor +++ /dev/null @@ -1,28 +0,0 @@ - -USING: kernel tools.test bake ; - -IN: bake.tests - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: unit-test* ( input output -- ) swap unit-test ; - -: must-be-t ( in -- ) [ t ] swap unit-test ; -: must-be-f ( in -- ) [ f ] swap unit-test ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -[ 10 20 30 `{ , , , } ] [ { 10 20 30 } ] unit-test* - -[ 10 20 30 `{ , { , } , } ] [ { 10 { 20 } 30 } ] unit-test* - -[ 10 { 20 21 22 } 30 `{ , , , } ] [ { 10 { 20 21 22 } 30 } ] unit-test* - -[ 10 { 20 21 22 } 30 `{ , @ , } ] [ { 10 20 21 22 30 } ] unit-test* - -[ { 1 2 3 } `{ @ } ] [ { 1 2 3 } ] unit-test* - -[ { 1 2 3 } { 4 5 6 } { 7 8 9 } `{ @ @ @ } ] -[ { 1 2 3 4 5 6 7 8 9 } ] -unit-test* - diff --git a/unmaintained/bake/bake.factor b/unmaintained/bake/bake.factor deleted file mode 100644 index 25cc0bb289..0000000000 --- a/unmaintained/bake/bake.factor +++ /dev/null @@ -1,97 +0,0 @@ - -USING: kernel parser namespaces sequences quotations arrays vectors splitting - strings words math generalizations - macros combinators.conditional newfx ; - -IN: bake - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: , -SYMBOL: @ - -: comma? ( obj -- ? ) , = ; -: atsym? ( obj -- ? ) @ = ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -DEFER: [bake] - -: broil-element ( obj -- quot ) - { - { [ comma? ] [ drop [ >r ] ] } - { [ f = ] [ [ >r ] prefix-on ] } - { [ integer? ] [ [ >r ] prefix-on ] } - { [ string? ] [ [ >r ] prefix-on ] } - { [ sequence? ] [ [bake] [ >r ] append ] } - { [ word? ] [ literalize [ >r ] prefix-on ] } - { [ drop t ] [ [ >r ] prefix-on ] } - } - 1cond ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: constructor ( seq -- quot ) - { - { [ array? ] [ length [ narray ] prefix-on ] } -! { [ quotation? ] [ length [ ncurry ] prefix-on [ ] prefix ] } - { [ quotation? ] [ length [ narray >quotation ] prefix-on ] } - { [ vector? ] [ length [ narray >vector ] prefix-on ] } - } - 1cond ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: [broil] ( seq -- quot ) - [ reverse [ broil-element ] map concat ] - [ length [ drop [ r> ] ] map concat ] - [ constructor ] - tri append append - >quotation ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: saved-sequence - -: [connector] ( -- quot ) - saved-sequence get quotation? [ [ compose ] ] [ [ append ] ] if ; - -: [starter] ( -- quot ) - saved-sequence get - { - { [ quotation? ] [ drop [ [ ] ] ] } - { [ array? ] [ drop [ { } ] ] } - { [ vector? ] [ drop [ V{ } ] ] } - } - 1cond ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: [simmer] ( seq -- quot ) - - dup saved-sequence set - - { @ } split reverse - [ [ [bake] [connector] append [ >r ] append ] map concat ] - [ length [ drop [ r> ] [connector] append ] map concat ] - bi - - >r 1 invert-index pluck r> ! remove the last append/compose - - [starter] prepend - - append ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: [bake] ( seq -- quot ) [ @ member? ] [ [simmer] ] [ [broil] ] 1if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -MACRO: bake ( seq -- quot ) [bake] ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing -: `V{ \ } [ >vector ] parse-literal \ bake parsed ; parsing -: `[ \ ] [ >quotation ] parse-literal \ bake parsed ; parsing \ No newline at end of file diff --git a/unmaintained/bake/fry/fry-tests.factor b/unmaintained/bake/fry/fry-tests.factor deleted file mode 100755 index 74408dc9f9..0000000000 --- a/unmaintained/bake/fry/fry-tests.factor +++ /dev/null @@ -1,89 +0,0 @@ - -USING: tools.test math prettyprint kernel io arrays vectors sequences - generalizations bake bake.fry ; - -IN: bake.fry.tests - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: unit-test* ( input output -- ) swap unit-test ; - -: must-be-t ( in -- ) [ t ] swap unit-test ; -: must-be-f ( in -- ) [ f ] swap unit-test ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -[ [ 3 + ] ] [ 3 '[ , + ] ] unit-test - -[ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test - -[ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test - -[ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test - -[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test - -[ [ "a" write "b" print ] ] -[ "a" "b" '[ , write , print ] ] unit-test - -[ [ 1 2 + 3 4 - ] ] -[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test - -[ 1/2 ] [ - 1 '[ , _ / ] 2 swap call -] unit-test - -[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [ - 1 '[ , _ _ 3array ] - { "a" "b" "c" } { "A" "B" "C" } rot 2map -] unit-test - -[ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [ - '[ 1 _ 2array ] - { "a" "b" "c" } swap map -] unit-test - -[ 1 2 ] [ - 1 2 '[ _ , ] call -] unit-test - -[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [ - 1 2 '[ , _ , 3array ] - { "a" "b" "c" } swap map -] unit-test - -: funny-dip '[ @ _ ] call ; inline - -[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test - -[ { 1 2 3 } ] [ - 3 1 '[ , [ , + ] map ] call -] unit-test - -[ { 1 { 2 { 3 } } } ] [ - 1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call -] unit-test - -{ 1 1 } [ '[ [ [ , ] ] ] ] must-infer-as - -[ { { { 3 } } } ] [ - 3 '[ [ [ , 1array ] call 1array ] call 1array ] call -] unit-test - -[ { { { 3 } } } ] [ - 3 '[ [ [ , 1array ] call 1array ] call 1array ] call -] unit-test - -! [ 10 20 30 40 '[ , V{ , { , } } , ] ] [ [ 10 V{ 20 { 30 } } 40 ] ] unit-test* - -[ 10 20 30 40 '[ , V{ , { , } } , ] ] -[ [ 10 20 30 >r r> 1 narray >r >r r> r> 2 narray >vector 40 ] ] -unit-test* - -[ { 1 2 3 } { 4 5 6 } { 7 8 9 } '[ , { V{ @ } { , } } ] call ] -[ - { 1 2 3 } - { V{ 4 5 6 } { { 7 8 9 } } } -] -unit-test* - diff --git a/unmaintained/bake/fry/fry.factor b/unmaintained/bake/fry/fry.factor deleted file mode 100644 index d82500edba..0000000000 --- a/unmaintained/bake/fry/fry.factor +++ /dev/null @@ -1,80 +0,0 @@ - -USING: kernel combinators arrays vectors quotations sequences splitting - parser macros sequences.deep - combinators.short-circuit combinators.conditional bake newfx ; - -IN: bake.fry - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: _ - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -DEFER: (shallow-fry) -DEFER: shallow-fry - -: ((shallow-fry)) ( accum quot adder -- result ) - >r shallow-fry r> - append swap dup empty? - [ drop ] - [ [ prepose ] curry append ] - if ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: (shallow-fry) ( accum quot -- result ) - dup empty? - [ drop 1quotation ] - [ - unclip - { - { \ , [ [ curry ] ((shallow-fry)) ] } - { \ @ [ [ compose ] ((shallow-fry)) ] } - [ swap >r suffix r> (shallow-fry) ] - } - case - ] - if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: deep-fry ( quot -- quot ) - { _ } split1-last dup - [ - shallow-fry [ >r ] rot - deep-fry [ [ dip ] curry r> compose ] 4array concat - ] - [ drop shallow-fry ] - if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: bakeable? ( obj -- ? ) { [ array? ] [ vector? ] } 1|| ; - -: fry-specifier? ( obj -- ? ) { , @ } member-of? ; - -: count-inputs ( quot -- n ) flatten [ fry-specifier? ] count ; - -: commas ( n -- seq ) , ; - -: [fry] ( quot -- quot' ) - [ - { - { [ callable? ] [ [ count-inputs commas ] [ [fry] ] bi append ] } - { [ bakeable? ] [ [ count-inputs commas ] [ [bake] ] bi append ] } - { [ drop t ] [ 1quotation ] } - } - 1cond - ] - map concat deep-fry ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -MACRO: fry ( seq -- quot ) [fry] ; - -: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing diff --git a/unmaintained/bake/summary.txt b/unmaintained/bake/summary.txt deleted file mode 100644 index cfc944a0b2..0000000000 --- a/unmaintained/bake/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Bake is similar to make but with additional features diff --git a/unmaintained/bitfields/authors.txt b/unmaintained/bitfields/authors.txt deleted file mode 100644 index f990dd0ed2..0000000000 --- a/unmaintained/bitfields/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Daniel Ehrenberg diff --git a/unmaintained/bitfields/bitfields-docs.factor b/unmaintained/bitfields/bitfields-docs.factor deleted file mode 100644 index ae670237a6..0000000000 --- a/unmaintained/bitfields/bitfields-docs.factor +++ /dev/null @@ -1,17 +0,0 @@ -USING: help.markup help.syntax ; -IN: bitfields - -HELP: BITFIELD: -{ $syntax "BITFIELD: name slot:size... ;" } -{ $values { "name" "name of bitfield" } { "slot" "names of slots" } { "size" "sizes of slots" } } -{ $description "Creates a new bitfield specification, with the constructor and slot accessors of the form name-slot. Slots' values can be changed by words of the form with-name-slot, with the stack effect " { $code "( newvalue bitfield -- newbitfield )" } ". The slots have the amount of space specified, in bits, after the colon. The constructor and setters do not check to make sure there is no overflow, and any inappropriately high value (except in the first field) will corrupt the bitfield. To check overflow, use " { $link POSTPONE: SAFE-BITFIELD: } " instead. Padding can be included by writing the binary number to be used as a pad in the middle of the bitfield specification. The first slot written will have the most significant digits. Note that bitfields do not form a class; they are merely integers. For efficiency across platforms, it is often the best to keep the total size at or below 29, allowing fixnums to be used on all platforms." } -{ $see-also define-bitfield } ; - -HELP: define-bitfield -{ $values { "classname" "a string" } { "slots" "slot specifications" } } -{ $description "Defines a bitfield constructor and slot accessors and setters. The workings of these are described in more detail at " { $link POSTPONE: BITFIELD: } ". The slot specifications should be an assoc. Any key which looks like a binary number will be treated as padding." } ; - -HELP: SAFE-BITFIELD: -{ $syntax "SAFE-BITFIELD: name slot:size... ;" } -{ $values { "name" "name of bitfield" } { "slot" "name of slots" } { "size" "size in bits of slots" } } -{ $description "Defines a bitfield in the same way as " { $link POSTPONE: BITFIELD: } " but the constructor and slot setters check for overflow." } ; diff --git a/unmaintained/bitfields/bitfields-tests.factor b/unmaintained/bitfields/bitfields-tests.factor deleted file mode 100755 index bbd4aa3db0..0000000000 --- a/unmaintained/bitfields/bitfields-tests.factor +++ /dev/null @@ -1,22 +0,0 @@ -USING: tools.test bitfields kernel ; -IN: bitfields.tests - -SAFE-BITFIELD: foo bar:5 baz:10 111 bing:2 ; - -[ 21 ] [ 21 852 3 foo-bar ] unit-test -[ 852 ] [ 21 852 3 foo-baz ] unit-test -[ 3 ] [ 21 852 3 foo-bing ] unit-test - -[ 23 ] [ 21 852 3 23 swap with-foo-bar foo-bar ] unit-test -[ 855 ] [ 21 852 3 855 swap with-foo-baz foo-baz ] unit-test -[ 1 ] [ 21 852 3 1 swap with-foo-bing foo-bing ] unit-test - -[ 100 0 0 ] must-fail -[ 0 5000 0 ] must-fail -[ 0 0 10 ] must-fail - -[ 100 0 with-foo-bar ] must-fail -[ 5000 0 with-foo-baz ] must-fail -[ 10 0 with-foo-bing ] must-fail - -[ BIN: 00101100000000111111 ] [ BIN: 101 BIN: 1000000001 BIN: 11 ] unit-test diff --git a/unmaintained/bitfields/bitfields.factor b/unmaintained/bitfields/bitfields.factor deleted file mode 100755 index 90e588be48..0000000000 --- a/unmaintained/bitfields/bitfields.factor +++ /dev/null @@ -1,111 +0,0 @@ -USING: parser lexer kernel math sequences namespaces make assocs -summary words splitting math.parser arrays sequences.next -mirrors generalizations compiler.units ; -IN: bitfields - -! Example: -! BITFIELD: blah short:16 char:8 nothing:5 ; -! defines blah-short blah-char blah-nothing. - -! An efficient bitfield has a sum of 29 bits or less -! so it can fit in a fixnum. -! No class is defined and there is no overflow checking. -! The first field is the most significant. - -: >ranges ( slots/sizes -- slots/ranges ) - ! range is { start length } - reverse 0 swap [ - swap >r tuck >r [ + ] keep r> 2array r> swap - ] assoc-map nip reverse ; - -SYMBOL: safe-bitfields? ! default f; set at parsetime - -TUPLE: check< number bound ; -M: check< summary drop "Number exceeds upper bound" ; - -: check< ( num cmp -- num ) - 2dup < [ drop ] [ \ check< boa throw ] if ; - -: ?check ( length -- ) - safe-bitfields? get [ 2^ , \ check< , ] [ drop ] if ; - -: put-together ( lengths -- ) - ! messy because of bounds checking - dup length 1- [ \ >r , ] times [ 0 swap ] % [ - ?check [ \ bitor , , [ shift r> ] % ] when* - ] each-next \ bitor , ; - -: padding-name? ( string -- ? ) - [ "10" member? ] all? ; - -: pad ( i name -- ) - bin> , , \ -nrot , ; - -: add-padding ( names -- ) - - [ dup padding-name? [ pad ] [ 2drop ] if ] assoc-each ; - -: [constructor] ( names lengths -- quot ) - [ swap add-padding put-together ] [ ] make ; - -: define-constructor ( classname slots -- ) - [ keys ] keep values [constructor] - >r in get constructor-word dup save-location r> - define ; - -: range>accessor ( range -- quot ) - [ - dup first neg , \ shift , - second 2^ 1- , \ bitand , - ] [ ] make ; - -: [accessors] ( lengths -- accessors ) - [ range>accessor ] map ; - -: clear-range ( range -- num ) - first2 dupd + [ 2^ 1- ] bi@ bitnot bitor ; - -: range>setter ( range -- quot ) - [ - \ >r , dup second ?check \ r> , - dup clear-range , - [ bitand >r ] % - first , [ shift r> bitor ] % - ] [ ] make ; - -: [setters] ( lengths -- setters ) - [ range>setter ] map ; - -: parse-slots ( slotspecs -- slots ) - [ ":" split1 string>number [ dup length ] unless* ] { } map>assoc ; - -: define-slots ( prefix names quots -- ) - >r [ "-" glue create-in ] with map r> - [ define ] 2each ; - -: define-accessors ( classname slots -- ) - dup values [accessors] - >r keys r> define-slots ; - -: define-setters ( classname slots -- ) - >r "with-" prepend r> - dup values [setters] - >r keys r> define-slots ; - -: filter-pad ( slots -- slots ) - [ drop padding-name? not ] assoc-filter ; - -: define-bitfield ( classname slots -- ) - [ - [ define-constructor ] 2keep - >ranges filter-pad [ define-setters ] 2keep define-accessors - ] with-compilation-unit ; - -: parse-bitfield ( -- ) - scan ";" parse-tokens parse-slots define-bitfield ; - -: BITFIELD: - parse-bitfield ; parsing - -: SAFE-BITFIELD: - [ safe-bitfields? on parse-bitfield ] with-scope ; parsing diff --git a/unmaintained/bitfields/summary.txt b/unmaintained/bitfields/summary.txt deleted file mode 100644 index fa2f7ff5c2..0000000000 --- a/unmaintained/bitfields/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Simple system for specifying packed bitfields diff --git a/unmaintained/bitfields/tags.txt b/unmaintained/bitfields/tags.txt deleted file mode 100644 index f4274299b1..0000000000 --- a/unmaintained/bitfields/tags.txt +++ /dev/null @@ -1 +0,0 @@ -extensions diff --git a/unmaintained/camera/authors.txt b/unmaintained/camera/authors.txt deleted file mode 100755 index bbc876e7b6..0000000000 --- a/unmaintained/camera/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Adam Wendt diff --git a/unmaintained/camera/camera.factor b/unmaintained/camera/camera.factor deleted file mode 100644 index c324e53edc..0000000000 --- a/unmaintained/camera/camera.factor +++ /dev/null @@ -1,16 +0,0 @@ - -USING: kernel namespaces math.vectors opengl pos ori turtle self ; - -IN: opengl.camera - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: camera-eye ( -- point ) pos> ; - -: camera-focus ( -- point ) [ 1 step-turtle pos> ] save-self ; - -: camera-up ( -- dirvec ) -[ 90 pitch-up pos> 1 step-turtle pos> swap v- ] save-self ; - -: do-look-at ( camera -- ) -[ >self camera-eye camera-focus camera-up gl-look-at ] with-scope ; diff --git a/unmaintained/combinators-lib/authors.txt b/unmaintained/combinators-lib/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/combinators-lib/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/combinators-lib/lib-docs.factor b/unmaintained/combinators-lib/lib-docs.factor deleted file mode 100755 index cde3b4d259..0000000000 --- a/unmaintained/combinators-lib/lib-docs.factor +++ /dev/null @@ -1,22 +0,0 @@ -USING: help.syntax help.markup kernel prettyprint sequences -quotations math ; -IN: combinators.lib - -HELP: generate -{ $values { "generator" quotation } { "predicate" quotation } { "obj" object } } -{ $description "Loop until the generator quotation generates an object that satisfies predicate quotation." } -{ $unchecked-example - "! Generate a random 20-bit prime number congruent to 3 (mod 4)" - "USING: combinators.lib math math.miller-rabin prettyprint ;" - "[ 20 random-prime ] [ 4 mod 3 = ] generate ." - "526367" -} ; - -HELP: %chance -{ $values { "quot" quotation } { "n" integer } } -{ $description "Calls the quotation " { $snippet "n" } " percent of the time." } -{ $unchecked-example - "USING: io ;" - "[ \"hello, world! maybe.\" print ] 50 %chance" - "" -} ; diff --git a/unmaintained/combinators-lib/lib-tests.factor b/unmaintained/combinators-lib/lib-tests.factor deleted file mode 100755 index 9489798b9b..0000000000 --- a/unmaintained/combinators-lib/lib-tests.factor +++ /dev/null @@ -1,24 +0,0 @@ -USING: combinators.lib kernel math random sequences tools.test continuations - arrays vectors ; -IN: combinators.lib.tests - -[ 6 -1 ] [ 5 0 1 [ + ] [ - ] bi, bi* ] unit-test -[ 6 -1 1 ] [ 5 0 1 1 [ + ] [ - ] [ * ] tri, tri* ] unit-test - -[ 5 4 ] [ 5 0 1 [ + ] [ - ] bi*, bi ] unit-test -[ 5 4 5 ] [ 5 0 1 1 [ + ] [ - ] [ * ] tri*, tri ] unit-test - -[ 5 6 ] [ 5 0 1 [ + ] bi@, bi ] unit-test -[ 5 6 7 ] [ 5 0 1 2 [ + ] tri@, tri ] unit-test - -[ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test -[ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test - -[ { "foo" "xbarx" } ] -[ - { "oof" "bar" } { [ reverse ] [ "x" dup surround ] } parallel-call -] unit-test - -{ 1 1 } [ - [ even? ] [ drop 1 ] [ drop 2 ] ifte -] must-infer-as diff --git a/unmaintained/combinators-lib/lib.factor b/unmaintained/combinators-lib/lib.factor deleted file mode 100755 index 9b3abe3984..0000000000 --- a/unmaintained/combinators-lib/lib.factor +++ /dev/null @@ -1,138 +0,0 @@ -! Copyright (C) 2007, 2008 Slava Pestov, Chris Double, -! Doug Coleman, Eduardo Cavazos, -! Daniel Ehrenberg. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel combinators fry namespaces make quotations hashtables -sequences assocs arrays stack-checker effects math math.ranges -generalizations macros continuations random locals accessors ; - -IN: combinators.lib - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Currying cleave combinators -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: bi, ( obj quot quot -- quot' quot' ) - [ [ curry ] curry ] bi@ bi ; inline -: tri, ( obj quot quot quot -- quot' quot' quot' ) - [ [ curry ] curry ] tri@ tri ; inline - -: bi*, ( obj obj quot quot -- quot' quot' ) - [ [ curry ] curry ] bi@ bi* ; inline -: tri*, ( obj obj obj quot quot quot -- quot' quot' quot' ) - [ [ curry ] curry ] tri@ tri* ; inline - -: bi@, ( obj obj quot -- quot' quot' ) - [ curry ] curry bi@ ; inline -: tri@, ( obj obj obj quot -- quot' quot' quot' ) - [ curry ] curry tri@ ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Generalized versions of core combinators -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: quad ( x p q r s -- ) [ keep ] 3dip [ keep ] 2dip [ keep ] dip call ; inline - -: 4slip ( quot a b c d -- a b c d ) 4 nslip ; inline - -: 4keep ( w x y z quot -- w x y z ) 4 nkeep ; inline - -: 2with ( param1 param2 obj quot -- obj curry ) - with with ; inline - -: 3with ( param1 param2 param3 obj quot -- obj curry ) - with with with ; inline - -: with* ( obj assoc quot -- assoc curry ) - swapd [ [ -rot ] dip call ] 2curry ; inline - -: 2with* ( obj1 obj2 assoc quot -- assoc curry ) - with* with* ; inline - -: 3with* ( obj1 obj2 obj3 assoc quot -- assoc curry ) - with* with* with* ; inline - -: assoc-each-with ( obj assoc quot -- ) - with* assoc-each ; inline - -: assoc-map-with ( obj assoc quot -- assoc ) - with* assoc-map ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! ifte -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -MACRO: preserving ( predicate -- quot ) - dup infer in>> - dup 1+ - '[ _ _ nkeep _ nrot ] ; - -MACRO: ifte ( quot quot quot -- ) - '[ _ preserving _ _ if ] ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! switch -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -MACRO: switch ( quot -- ) - [ [ [ preserving ] curry ] dip ] assoc-map - [ cond ] curry ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Conceptual implementation: - -! : pcall ( seq quots -- seq ) [ call ] 2map ; - -MACRO: parallel-call ( quots -- ) - [ '[ [ unclip @ ] dip [ push ] keep ] ] map concat - '[ V{ } clone @ nip >array ] ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! map-call and friends -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: (make-call-with) ( quots -- quot ) - [ [ keep ] curry ] map concat [ drop ] append ; - -MACRO: map-call-with ( quots -- ) - [ (make-call-with) ] keep length [ narray ] curry compose ; - -: (make-call-with2) ( quots -- quot ) - [ [ 2dup >r >r ] prepend [ r> r> ] append ] map concat - [ 2drop ] append ; - -MACRO: map-call-with2 ( quots -- ) - [ - [ [ 2dup >r >r ] prepend [ r> r> ] append ] map concat - [ 2drop ] append - ] keep length [ narray ] curry append ; - -MACRO: map-exec-with ( words -- ) - [ 1quotation ] map [ map-call-with ] curry ; - -MACRO: construct-slots ( assoc tuple-class -- tuple ) - [ new ] curry swap [ - [ dip ] curry swap 1quotation [ keep ] curry compose - ] { } assoc>map concat compose ; - -: 2quot-with ( obj seq quot1 quot2 -- seq quot1 quot2 ) - >r pick >r with r> r> swapd with ; - -MACRO: multikeep ( word out-indexes -- ... ) - [ - dup >r [ \ npick \ >r 3array % ] each - % - r> [ drop \ r> , ] each - ] [ ] make ; - -: generate ( generator predicate -- obj ) - '[ dup @ dup [ nip ] unless ] - swap do until ; - -MACRO: predicates ( seq -- quot/f ) - dup [ 1quotation [ drop ] prepend ] map - [ [ [ dup ] prepend ] map ] dip zip [ drop f ] suffix - [ cond ] curry ; - -: %chance ( quot n -- ) 100 random > swap when ; inline diff --git a/extra/easy-help/easy-help.factor b/unmaintained/easy-help/easy-help.factor similarity index 100% rename from extra/easy-help/easy-help.factor rename to unmaintained/easy-help/easy-help.factor diff --git a/extra/easy-help/expand-markup/expand-markup.factor b/unmaintained/easy-help/expand-markup/expand-markup.factor similarity index 100% rename from extra/easy-help/expand-markup/expand-markup.factor rename to unmaintained/easy-help/expand-markup/expand-markup.factor diff --git a/unmaintained/factorbot.factor b/unmaintained/factorbot.factor deleted file mode 100644 index 43940d2f79..0000000000 --- a/unmaintained/factorbot.factor +++ /dev/null @@ -1,108 +0,0 @@ -! Simple IRC bot written in Factor. - -REQUIRES: apps/http-server ; - -USING: errors generic hashtables help html http io kernel math -memory namespaces parser prettyprint sequences strings threads -words inspector network ; -IN: factorbot - -SYMBOL: irc-stream -SYMBOL: nickname -SYMBOL: speaker -SYMBOL: receiver - -: irc-write ( s -- ) irc-stream get stream-write ; -: irc-print ( s -- ) - irc-stream get stream-print - irc-stream get stream-flush ; - -: nick ( nick -- ) - dup nickname set "NICK " irc-write irc-print ; - -: login ( nick -- ) - dup nick - "USER " irc-write irc-write - " hostname servername :irc.factor" irc-print ; - -: connect ( server -- ) 6667 irc-stream set ; - -: disconnect ( -- ) irc-stream get stream-close ; - -: join ( chan -- ) - "JOIN " irc-write irc-print ; - -GENERIC: handle-irc ( line -- ) -PREDICATE: string privmsg " " split1 nip "PRIVMSG" head? ; -PREDICATE: string ping "PING" head? ; - -M: object handle-irc ( line -- ) - drop ; - -: parse-privmsg ( line -- text ) - " " split1 nip - "PRIVMSG " ?head drop - " " split1 swap receiver set - ":" ?head drop ; - -M: privmsg handle-irc ( line -- ) - parse-privmsg - " " split1 swap - "factorbot-commands" lookup dup - [ execute ] [ 2drop ] if ; - -M: ping handle-irc ( line -- ) - "PING " ?head drop "PONG " swap append irc-print ; - -: parse-irc ( line -- ) - ":" ?head [ "!" split1 swap speaker set ] when handle-irc ; - -: say ( line nick -- ) - "PRIVMSG " irc-write irc-write " :" irc-write irc-print ; - -: respond ( line -- ) - receiver get nickname get = speaker receiver ? get say ; - -: irc-loop ( -- ) - irc-stream get stream-readln - [ dup print flush parse-irc irc-loop ] when* ; - -: factorbot - "irc.freenode.net" connect - "factorbot" login - "#concatenative" join - [ irc-loop ] [ irc-stream get stream-close ] cleanup ; - -: factorbot-loop [ factorbot ] try 30000 sleep factorbot-loop ; - -: multiline-respond ( string -- ) - string-lines [ respond ] each ; - -: object-href - "http://factorcode.org" swap browser-link-href append ; - -: not-found ( str -- ) - "Sorry, I couldn't find anything for " swap append respond ; - -IN: factorbot-commands - -: see ( text -- ) - dup words-named dup empty? [ - drop - not-found - ] [ - nip [ - dup summary " -- " - rot object-href 3append respond - ] each - ] if ; - -: memory ( text -- ) - drop [ room. ] with-string-writer multiline-respond ; - -: quit ( text -- ) - drop speaker get "slava" = [ disconnect ] when ; - -PROVIDE: apps/factorbot ; - -MAIN: apps/factorbot factorbot ; diff --git a/unmaintained/factory/authors.txt b/unmaintained/factory/authors.txt deleted file mode 100644 index 6cfd5da273..0000000000 --- a/unmaintained/factory/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/factory/commands/authors.txt b/unmaintained/factory/commands/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/factory/commands/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/factory/commands/commands.factor b/unmaintained/factory/commands/commands.factor deleted file mode 100644 index 6bf5ee8d4f..0000000000 --- a/unmaintained/factory/commands/commands.factor +++ /dev/null @@ -1,73 +0,0 @@ -USING: kernel combinators sequences math math.functions math.vectors mortar - slot-accessors x x.widgets.wm.root x.widgets.wm.frame sequences.lib ; -IN: factory.commands - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: up-till-frame ( window -- wm-frame ) -{ { [ dup is? ] - [ ] } - { [ dup $dpy $default-root $id over $id = ] - [ drop f ] } - { [ t ] - [ <- parent up-till-frame ] } } cond ; - -: pointer-window ( -- window ) dpy> <- pointer-window ; - -: pointer-frame ( -- wm-frame ) -pointer-window up-till-frame dup is? [ ] [ drop f ] if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: maximize ( -- ) pointer-frame wm-frame-maximize drop ; - -: minimize ( -- ) pointer-frame <- unmap drop ; - -: maximize-vertical ( -- ) pointer-frame wm-frame-maximize-vertical drop ; - -: restore ( -- ) pointer-frame <- restore-state drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - -: tile-master ( -- ) - -wm-root> - <- children - [ <- mapped? ] filter - [ check-window-table ] map - reverse - -unclip - { 0 0 } <-- move - wm-root> <- size { 1/2 1 } v* - [ floor ] map <-- resize - <- adjust-child -drop - -dup empty? [ drop ] [ - -wm-root> <- width 2 / floor [ <-- set-width ] curry map -wm-root> <- height over length / floor [ <-- set-height ] curry map - -wm-root> <- width 2 / floor [ <-- set-x ] curry map - -wm-root> <- height over length / over length [ * floor ] map-with -[ <-- set-y <- adjust-child ] 2map - -drop - -] if ; - -! : tile-master ( -- ) - -! wm-root> -! <- children -! [ <- mapped? ] filter -! [ check-window-table ] map -! reverse - -! { { [ dup empty? ] [ drop ] } -! { [ dup length 1 = ] [ drop maximize ] } -! { [ t ] [ tile-master* ] } diff --git a/unmaintained/factory/factory-menus b/unmaintained/factory/factory-menus deleted file mode 100644 index 35ee75e31b..0000000000 --- a/unmaintained/factory/factory-menus +++ /dev/null @@ -1,122 +0,0 @@ -! -*-factor-*- - -USING: kernel unix vars mortar mortar.sugar slot-accessors - x.widgets.wm.menu x.widgets.wm.unmapped-frames-menu - factory.commands factory.load ; - -IN: factory - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Helper words - -: new-wm-menu ( -- menu ) new* 1 <-- set-border-width ; - -: shrink-wrap ( menu -- ) dup <- calc-size <-- resize drop ; - -: set-menu-items ( items menu -- ) swap >>items shrink-wrap ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -VAR: apps-menu - -apps-menu> not [ new-wm-menu >apps-menu ] when - -{ { "Emacs" [ "emacs &" system drop ] } - { "KMail" [ "kmail &" system drop ] } - { "Akregator" [ "akregator &" system drop ] } - { "Amarok" [ "amarok &" system drop ] } - { "K3b" [ "k3b &" system drop ] } - { "xchat" [ "xchat &" system drop ] } - { "Nautilus" [ "nautilus --no-desktop &" system drop ] } - { "synaptic" [ "gksudo synaptic &" system drop ] } - { "Volume control" [ "gnome-volume-control &" system drop ] } - { "Azureus" [ "~/azureus/azureus &" system drop ] } - { "Xephyr" [ "Xephyr -host-cursor :1 &" system drop ] } - { "Stop Xephyr" [ "pkill Xephyr &" system drop ] } - { "Stop Firefox" [ "pkill firefox &" system drop ] } -} apps-menu> set-menu-items - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -VAR: emacs-menu - -emacs-menu> not [ new-wm-menu >emacs-menu ] when - -{ { "Start Emacs" [ "emacs &" system drop ] } - { "Small" [ "emacsclient -e '(make-small-frame-command)' &" system drop ] } - { "Large" [ "emacsclient -e '(make-frame-command)' &" system drop ] } - { "Full" [ "emacsclient -e '(make-full-frame-command)' &" system drop ] } - { "Gnus" [ "emacsclient -e '(gnus-other-frame)' &" system drop ] } - { "Factor" [ "emacsclient -e '(run-factor-other-frame)' &" system drop ] } -} emacs-menu> set-menu-items - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -VAR: mail-menu - -mail-menu> not [ new-wm-menu >mail-menu ] when - -{ { "Kmail" [ "kmail &" system drop ] } - { "compose" [ "kmail --composer &" system drop ] } - { "slava" [ "kmail slava@factorcode.org &" system drop ] } - { "erg" [ "kmail doug.coleman@gmail.com &" system drop ] } - { "doublec" [ "kmail chris.double@double.co.nz &" system drop ] } - { "yuuki" [ "kmail matthew.willis@mac.com &" system drop ] } -} mail-menu> set-menu-items - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -VAR: factor-menu - -factor-menu> not [ new-wm-menu >factor-menu ] when - -{ { "Factor" [ "cd /scratch/repos/Factor ; ./factor &" system drop ] } - { "Factor (tty)" - [ "cd /scratch/repos/Factor ; xterm -e ./factor -run=listener &" - system drop ] } - { "Terminal : repos/Factor" - [ "cd /scratch/repos/Factor ; xterm &" system drop ] } - { "darcs whatsnew" - [ "cd /scratch/repos/Factor ; xterm -e 'darcs whatsnew | less' &" - system drop ] } - { "darcs pull" - [ "cd /scratch/repos/Factor ; xterm -e 'darcs pull http://factorcode.org/repos' &" system drop ] } - { "darcs push" - [ "cd /scratch/repos/Factor ; xterm -e 'darcs push dharmatech@onigirihouse.com:doc-root/repos' &" system drop ] } -} factor-menu> set-menu-items - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -VAR: factory-menu - -factory-menu> not [ new-wm-menu >factory-menu ] when - -{ { "Maximize" [ maximize ] } - { "Maximize Vertical" [ maximize-vertical ] } - { "Restore" [ restore ] } - { "Hide" [ minimize ] } - { "Tile Master" [ tile-master ] } -} - -factory-menu> set-menu-items - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! VAR: root-menu - -{ { "xterm" [ "urxvt -bd grey +sb &" system drop ] } - { "Firefox" [ "firefox &" system drop ] } - { "xclock" [ "xclock &" system drop ] } - { "Apps >" [ apps-menu> <- popup ] } - { "Factor >" [ factor-menu> <- popup ] } - { "Unmapped frames >" [ unmapped-frames-menu> <- popup ] } - { "Emacs >" [ emacs-menu> <- popup ] } - { "Mail >" [ mail-menu> <- popup ] } - { "onigirihouse" [ "xterm -e 'ssh dharmatech@onigirihouse.com' &" - system drop ] } - { "Edit menus" [ edit-factory-menus ] } - { "Reload menus" [ load-factory-menus ] } - { "Factory >" [ factory-menu> <- popup ] } -} root-menu> set-menu-items - diff --git a/unmaintained/factory/factory-rc b/unmaintained/factory/factory-rc deleted file mode 100644 index 6d46c07a2a..0000000000 --- a/unmaintained/factory/factory-rc +++ /dev/null @@ -1,26 +0,0 @@ -! -*-factor-*- - -USING: kernel mortar x - x.widgets.wm.root - x.widgets.wm.workspace - x.widgets.wm.unmapped-frames-menu - factory.load - tty-server ; - -IN: factory - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -create-root-menu -create-unmapped-frames-menu -load-factory-menus -6 setup-workspaces - -wm-root> - no-modifiers "F12" [ root-menu> <- popup ] <---- set-key-action - control-alt "LEFT" [ prev-workspace ] <---- set-key-action - control-alt "RIGHT" [ next-workspace ] <---- set-key-action - alt "TAB" [ circulate-focus ] <---- set-key-action -drop - -9010 tty-server diff --git a/unmaintained/factory/factory.factor b/unmaintained/factory/factory.factor deleted file mode 100644 index 6faf334fc3..0000000000 --- a/unmaintained/factory/factory.factor +++ /dev/null @@ -1,37 +0,0 @@ - -USING: kernel parser io io.files namespaces sequences editors threads vars - mortar mortar.sugar slot-accessors - x - x.widgets.wm.root - x.widgets.wm.frame - x.widgets.wm.menu - factory.load - factory.commands ; - -IN: factory - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: manage-windows ( -- ) -dpy get $default-root <- children [ <- mapped? ] filter -[ $id new* drop ] each ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -VAR: root-menu - -: create-root-menu ( -- ) new* 1 <-- set-border-width >root-menu ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: start-factory ( display-string -- ) - new* >dpy -install-default-error-handler -create-wm-root -init-atoms -manage-windows -load-factory-rc ; - -: factory ( -- ) f start-factory stop ; - -MAIN: factory \ No newline at end of file diff --git a/unmaintained/factory/load/authors.txt b/unmaintained/factory/load/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/factory/load/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/factory/load/load.factor b/unmaintained/factory/load/load.factor deleted file mode 100644 index 018fe5ea23..0000000000 --- a/unmaintained/factory/load/load.factor +++ /dev/null @@ -1,32 +0,0 @@ - -USING: kernel io.files parser editors sequences ; - -IN: factory.load - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: file-or ( file file -- file ) over exists? [ drop ] [ nip ] if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: personal-factory-rc ( -- path ) home "/.factory-rc" append ; - -: system-factory-rc ( -- path ) "extra/factory/factory-rc" resource-path ; - -: factory-rc ( -- path ) personal-factory-rc system-factory-rc file-or ; - -: load-factory-rc ( -- ) factory-rc run-file ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: personal-factory-menus ( -- path ) home "/.factory-menus" append ; - -: system-factory-menus ( -- path ) -"extra/factory/factory-menus" resource-path ; - -: factory-menus ( -- path ) -personal-factory-menus system-factory-menus file-or ; - -: load-factory-menus ( -- ) factory-menus run-file ; - -: edit-factory-menus ( -- ) factory-menus 0 edit-location ; diff --git a/unmaintained/factory/summary.txt b/unmaintained/factory/summary.txt deleted file mode 100644 index e3b9c11ffa..0000000000 --- a/unmaintained/factory/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Window manager for the X Window System diff --git a/unmaintained/factory/tags.txt b/unmaintained/factory/tags.txt deleted file mode 100644 index bf31fdbc2e..0000000000 --- a/unmaintained/factory/tags.txt +++ /dev/null @@ -1 +0,0 @@ -applications diff --git a/unmaintained/fs/authors.txt b/unmaintained/fs/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/fs/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/fs/fs.factor b/unmaintained/fs/fs.factor deleted file mode 100644 index 6cb9f68934..0000000000 --- a/unmaintained/fs/fs.factor +++ /dev/null @@ -1,23 +0,0 @@ -USING: alien.syntax ; -IN: unix.linux.fs - -: MS_RDONLY 1 ; ! Mount read-only. -: MS_NOSUID 2 ; ! Ignore suid and sgid bits. -: MS_NODEV 4 ; ! Disallow access to device special files. -: MS_NOEXEC 8 ; ! Disallow program execution. -: MS_SYNCHRONOUS 16 ; ! Writes are synced at once. -: MS_REMOUNT 32 ; ! Alter flags of a mounted FS. -: MS_MANDLOCK 64 ; ! Allow mandatory locks on an FS. -: S_WRITE 128 ; ! Write on file/directory/symlink. -: S_APPEND 256 ; ! Append-only file. -: S_IMMUTABLE 512 ; ! Immutable file. -: MS_NOATIME 1024 ; ! Do not update access times. -: MS_NODIRATIME 2048 ; ! Do not update directory access times. -: MS_BIND 4096 ; ! Bind directory at different place. - -FUNCTION: int mount -( char* special_file, char* dir, char* fstype, ulong options, void* data ) ; - -! FUNCTION: int umount2 ( char* file, int flags ) ; - -FUNCTION: int umount ( char* file ) ; diff --git a/unmaintained/fs/tags.txt b/unmaintained/fs/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/unmaintained/fs/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/unmaintained/gap-buffer/authors.txt b/unmaintained/gap-buffer/authors.txt deleted file mode 100644 index e9c193bac7..0000000000 --- a/unmaintained/gap-buffer/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Alex Chapman diff --git a/unmaintained/gap-buffer/cursortree/authors.txt b/unmaintained/gap-buffer/cursortree/authors.txt deleted file mode 100644 index e9c193bac7..0000000000 --- a/unmaintained/gap-buffer/cursortree/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Alex Chapman diff --git a/unmaintained/gap-buffer/cursortree/cursortree-tests.factor b/unmaintained/gap-buffer/cursortree/cursortree-tests.factor deleted file mode 100644 index 2b3ff69c97..0000000000 --- a/unmaintained/gap-buffer/cursortree/cursortree-tests.factor +++ /dev/null @@ -1,17 +0,0 @@ -USING: assocs kernel gap-buffer.cursortree tools.test sequences trees -arrays strings ; -IN: gap-buffer.cursortree.tests - -[ t ] [ "this is a test string" 0 at-beginning? ] unit-test -[ t ] [ "this is a test string" dup length at-end? ] unit-test -[ 3 ] [ "this is a test string" 3 cursor-pos ] unit-test -[ CHAR: i ] [ "this is a test string" 3 element< ] unit-test -[ CHAR: s ] [ "this is a test string" 3 element> ] unit-test -[ t ] [ "this is a test string" 3 CHAR: a over set-element< CHAR: t over set-element> cursor-tree "that is a test string" sequence= ] unit-test -[ 0 ] [ "this is a test string" dup dup 3 remove-cursor cursors length ] unit-test -[ t ] [ "this is a test string" 3 8 over set-cursor-pos dup 1array swap cursor-tree cursors sequence= ] unit-test -[ "this is no longer a test string" ] [ "this is a test string" 8 "no longer " over insert cursor-tree >string ] unit-test -[ "refactor" ] [ "factor" 0 CHAR: e over insert CHAR: r over insert cursor-tree >string ] unit-test -[ "refactor" ] [ "factor" 0 CHAR: r over insert CHAR: e over insert cursor-tree >string ] unit-test -[ "this a test string" 5 ] [ "this is a test string" 5 dup delete> dup delete> dup delete> dup cursor-tree >string swap cursor-pos ] unit-test -[ "this a test string" 5 ] [ "this is a test string" 8 dup delete< dup delete< dup delete< dup cursor-tree >string swap cursor-pos ] unit-test diff --git a/unmaintained/gap-buffer/cursortree/cursortree.factor b/unmaintained/gap-buffer/cursortree/cursortree.factor deleted file mode 100644 index 4249aea2d9..0000000000 --- a/unmaintained/gap-buffer/cursortree/cursortree.factor +++ /dev/null @@ -1,94 +0,0 @@ -! Copyright (C) 2007 Alex Chapman All Rights Reserved. -! See http://factorcode.org/license.txt for BSD license. -USING: assocs kernel gap-buffer generic trees trees.avl math -sequences quotations ; -IN: gap-buffer.cursortree - -TUPLE: cursortree cursors ; - -: ( seq -- cursortree ) - cursortree new tuck set-delegate - over set-cursortree-cursors ; - -GENERIC: cursortree-gb ( cursortree -- gb ) -M: cursortree cursortree-gb ( cursortree -- gb ) delegate ; -GENERIC: set-cursortree-gb ( gb cursortree -- ) -M: cursortree set-cursortree-gb ( gb cursortree -- ) set-delegate ; - -TUPLE: cursor i tree ; -TUPLE: left-cursor ; -TUPLE: right-cursor ; - -: cursor-index ( cursor -- i ) cursor-i ; - -: add-cursor ( cursortree cursor -- ) dup cursor-index rot push-at ; - -: remove-cursor ( cursortree cursor -- ) - tuck cursor-index swap cursortree-cursors at* [ delete ] [ 2drop ] if ; - -: set-cursor-index ( index cursor -- ) - dup cursor-tree over remove-cursor tuck set-cursor-i - dup cursor-tree cursortree-cursors swap add-cursor ; - -GENERIC: cursor-pos ( cursor -- n ) -GENERIC: set-cursor-pos ( n cursor -- ) -M: left-cursor cursor-pos ( cursor -- n ) [ cursor-i 1+ ] keep cursor-tree index>position ; -M: right-cursor cursor-pos ( cursor -- n ) [ cursor-i ] keep cursor-tree index>position ; -M: left-cursor set-cursor-pos ( n cursor -- ) >r 1- r> [ cursor-tree position>index ] keep set-cursor-index ; -M: right-cursor set-cursor-pos ( n cursor -- ) [ cursor-tree position>index ] keep set-cursor-index ; - -: ( cursortree -- cursor ) - cursor new tuck set-cursor-tree ; - -: make-cursor ( cursortree pos cursor -- cursor ) - >r swap r> tuck set-delegate tuck set-cursor-pos ; - -: ( cursortree pos -- left-cursor ) - left-cursor new make-cursor ; - -: ( cursortree pos -- right-cursor ) - right-cursor new make-cursor ; - -: cursors ( cursortree -- seq ) - cursortree-cursors values concat ; - -: cursor-positions ( cursortree -- seq ) - cursors [ cursor-pos ] map ; - -M: cursortree move-gap ( n cursortree -- ) - #! Get the position of each cursor before the move, then re-set the - #! position afterwards. This will update any changed cursor indices. - dup cursor-positions >r tuck cursortree-gb move-gap - cursors r> swap [ set-cursor-pos ] 2each ; - -: element@< ( cursor -- pos cursortree ) [ cursor-pos 1- ] keep cursor-tree ; -: element@> ( cursor -- pos cursortree ) [ cursor-pos ] keep cursor-tree ; - -: at-beginning? ( cursor -- ? ) cursor-pos 0 = ; -: at-end? ( cursor -- ? ) element@> length = ; - -: insert ( obj cursor -- ) element@> insert* ; - -: element< ( cursor -- elem ) element@< nth ; -: element> ( cursor -- elem ) element@> nth ; - -: set-element< ( elem cursor -- ) element@< set-nth ; -: set-element> ( elem cursor -- ) element@> set-nth ; - -GENERIC: fix-cursor ( cursortree cursor -- ) - -M: left-cursor fix-cursor ( cursortree cursor -- ) - >r gb-gap-start 1- r> set-cursor-index ; - -M: right-cursor fix-cursor ( cursortree cursor -- ) - >r gb-gap-end r> set-cursor-index ; - -: fix-cursors ( old-gap-end cursortree -- ) - tuck cursortree-cursors at [ fix-cursor ] with each ; - -M: cursortree delete* ( pos cursortree -- ) - tuck move-gap dup gb-gap-end swap dup (delete*) fix-cursors ; - -: delete< ( cursor -- ) element@< delete* ; -: delete> ( cursor -- ) element@> delete* ; - diff --git a/unmaintained/gap-buffer/cursortree/summary.txt b/unmaintained/gap-buffer/cursortree/summary.txt deleted file mode 100644 index e57688fad0..0000000000 --- a/unmaintained/gap-buffer/cursortree/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Collection of 'cursors' representing locations in a gap buffer diff --git a/unmaintained/gap-buffer/gap-buffer-tests.factor b/unmaintained/gap-buffer/gap-buffer-tests.factor deleted file mode 100644 index 85dc7b3c88..0000000000 --- a/unmaintained/gap-buffer/gap-buffer-tests.factor +++ /dev/null @@ -1,40 +0,0 @@ -USING: kernel sequences tools.test gap-buffer strings math ; - -! test copy-elements -[ { 0 3 4 3 4 5 } ] [ { 0 1 2 3 4 5 } dup >r -2 3 5 r> copy-elements ] unit-test -[ { 0 1 2 1 2 5 } ] [ { 0 1 2 3 4 5 } dup >r 2 2 0 r> copy-elements ] unit-test -[ "01234567856" ] [ "01234567890" dup >r 4 6 4 r> copy-elements ] unit-test - -! test sequence protocol (like, length, nth, set-nth) -[ "gap buffers are cool" ] [ "gap buffers are cool" "" like ] unit-test - -! test move-gap-back-inside -[ t f ] [ 5 "0123456" move-gap-forward? >r move-gap-back-inside? 2nip r> ] unit-test -[ "0123456" ] [ "0123456" 5 over move-gap >string ] unit-test -! test move-gap-forward-inside -[ t ] [ "I once ate a spaniel" 15 over move-gap 17 swap move-gap-forward-inside? 2nip ] unit-test -[ "I once ate a spaniel" ] [ "I once ate a spaniel" 15 over move-gap 17 over move-gap >string ] unit-test -! test move-gap-back-around -[ f f ] [ 2 "terriers are ok too" move-gap-forward? >r move-gap-back-inside? 2nip r> ] unit-test -[ "terriers are ok too" ] [ "terriers are ok too" 2 over move-gap >string ] unit-test -! test move-gap-forward-around -[ f t ] [ "god is nam's best friend" 2 over move-gap 22 over position>index swap move-gap-forward? >r move-gap-forward-inside? 2nip r> ] unit-test -[ "god is nam's best friend" ] [ "god is nam's best friend" 2 over move-gap 22 over move-gap >string ] unit-test - -! test changing buffer contents -[ "factory" ] [ "factor" CHAR: y 6 pick insert* >string ] unit-test -! test inserting multiple elements in different places. buffer should grow -[ "refractory" ] [ "factor" CHAR: y 6 pick insert* "re" 0 pick insert* CHAR: r 3 pick insert* >string ] unit-test -! test deleting elements. buffer should shrink -[ "for" ] [ "factor" 3 [ 1 over delete* ] times >string ] unit-test -! more testing of nth and set-nth -[ "raptor" ] [ "factor" CHAR: p 2 pick set-nth 5 over nth 0 pick set-nth >string ] unit-test - -! test stack/queue operations -[ "slaughter" ] [ "laughter" CHAR: s over push-start >string ] unit-test -[ "pantonio" ] [ "pant" "onio" over push-end >string ] unit-test -[ CHAR: f "actor" ] [ "factor" dup pop-start swap >string ] unit-test -[ CHAR: s "pant" ] [ "pants" dup pop-end swap >string ] unit-test -[ "end this is the " ] [ "this is the end " 4 over rotate >string ] unit-test -[ "your jedi training is finished " ] [ "finished your jedi training is " -9 over rotate >string ] unit-test - diff --git a/unmaintained/gap-buffer/gap-buffer.factor b/unmaintained/gap-buffer/gap-buffer.factor deleted file mode 100644 index 55a1276dd4..0000000000 --- a/unmaintained/gap-buffer/gap-buffer.factor +++ /dev/null @@ -1,294 +0,0 @@ -! Copyright (C) 2007 Alex Chapman All Rights Reserved. -! See http://factorcode.org/license.txt for BSD license. -! -! gap buffer -- largely influenced by Strandh and Villeneuve's Flexichain -! for a good introduction see: -! http://p-cos.net/lisp-ecoop/submissions/StrandhVilleneuveMoore.pdf -USING: kernel arrays sequences sequences.private circular math -math.order math.functions generic ; -IN: gap-buffer - -! gap-start -- the first element of the gap -! gap-end -- the first element after the gap -! expand-factor -- should be > 1 -! min-size -- < 5 is not sensible - -TUPLE: gb - gap-start - gap-end - expand-factor - min-size ; - -GENERIC: gb-seq ( gb -- seq ) -GENERIC: set-gb-seq ( seq gb -- ) -M: gb gb-seq ( gb -- seq ) delegate ; -M: gb set-gb-seq ( seq gb -- ) set-delegate ; - -: required-space ( n gb -- n ) - tuck gb-expand-factor * ceiling >fixnum swap gb-min-size max ; - -: ( seq -- gb ) - gb new - 5 over set-gb-min-size - 1.5 over set-gb-expand-factor - [ >r length r> set-gb-gap-start ] 2keep - [ swap length over required-space swap set-gb-gap-end ] 2keep - [ - over length over required-space rot { } like resize-array swap set-gb-seq - ] keep ; - -M: gb like ( seq gb -- seq ) drop ; - -: gap-length ( gb -- n ) [ gb-gap-end ] keep gb-gap-start - ; - -: buffer-length ( gb -- n ) gb-seq length ; - -M: gb length ( gb -- n ) [ buffer-length ] keep gap-length - ; - -: valid-position? ( pos gb -- ? ) - #! one element past the end of the buffer is a valid position when we're inserting - length -1 swap between? ; - -: valid-index? ( i gb -- ? ) - buffer-length -1 swap between? ; - -TUPLE: position-out-of-bounds position gap-buffer ; -C: position-out-of-bounds - -: position>index ( pos gb -- i ) - 2dup valid-position? [ - 2dup gb-gap-start >= [ - gap-length + - ] [ drop ] if - ] [ - throw - ] if ; - -TUPLE: index-out-of-bounds index gap-buffer ; -C: index-out-of-bounds - -: index>position ( i gb -- pos ) - 2dup valid-index? [ - 2dup gb-gap-end >= [ - gap-length - - ] [ drop ] if - ] [ - throw - ] if ; - -M: gb virtual@ ( n gb -- n seq ) [ position>index ] keep gb-seq ; - -M: gb nth ( n gb -- elt ) bounds-check virtual@ nth-unsafe ; - -M: gb nth-unsafe ( n gb -- elt ) virtual@ nth-unsafe ; - -M: gb set-nth ( elt n seq -- ) bounds-check virtual@ set-nth-unsafe ; - -M: gb set-nth-unsafe ( elt n seq -- ) virtual@ set-nth-unsafe ; - -M: gb virtual-seq gb-seq ; - -INSTANCE: gb virtual-sequence - -! ------------- moving the gap ------------------------------- - -: (copy-element) ( to start seq -- ) tuck nth -rot set-nth ; - -: copy-element ( dst start seq -- ) >r [ + ] keep r> (copy-element) ; - -: copy-elements-back ( dst start seq n -- ) - dup 0 > [ - >r [ copy-element ] 3keep >r 1+ r> r> 1- copy-elements-back - ] [ 3drop drop ] if ; - -: copy-elements-forward ( dst start seq n -- ) - dup 0 > [ - >r [ copy-element ] 3keep >r 1- r> r> 1- copy-elements-forward - ] [ 3drop drop ] if ; - -: copy-elements ( dst start end seq -- ) - pick pick > [ - >r dupd - r> swap copy-elements-forward - ] [ - >r over - r> swap copy-elements-back - ] if ; - -! the gap can be moved either forward or back. Moving the gap 'inside' means -! moving elements across the gap. Moving the gap 'around' means changing the -! start of the circular buffer to avoid moving as many elements. - -! We decide which method (inside or around) to pick based on the number of -! elements that will need to be moved. We always try to move as few elements as -! possible. - -: move-gap? ( i gb -- i gb ? ) 2dup gb-gap-end = not ; - -: move-gap-forward? ( i gb -- i gb ? ) 2dup gb-gap-start >= ; - -: move-gap-back-inside? ( i gb -- i gb ? ) - #! is it cheaper to move the gap inside than around? - 2dup [ gb-gap-start swap 2 * - ] keep [ buffer-length ] keep gb-gap-end - <= ; - -: move-gap-forward-inside? ( i gb -- i gb ? ) - #! is it cheaper to move the gap inside than around? - 2dup [ gb-gap-end >r 2 * r> - ] keep [ gb-gap-start ] keep buffer-length + <= ; - -: move-gap-forward-inside ( i gb -- ) - [ dup gap-length neg swap gb-gap-end rot ] keep gb-seq copy-elements ; - -: move-gap-back-inside ( i gb -- ) - [ dup gap-length swap gb-gap-start 1- rot 1- ] keep gb-seq copy-elements ; - -: move-gap-forward-around ( i gb -- ) - 0 over move-gap-back-inside [ - dup buffer-length [ - swap gap-length - neg swap - ] keep - ] keep [ - gb-seq copy-elements - ] keep dup gap-length swap gb-seq change-circular-start ; - -: move-gap-back-around ( i gb -- ) - dup buffer-length over move-gap-forward-inside [ - length swap -1 - ] keep [ - gb-seq copy-elements - ] keep dup length swap gb-seq change-circular-start ; - -: move-gap-forward ( i gb -- ) - move-gap-forward-inside? [ - move-gap-forward-inside - ] [ - move-gap-forward-around - ] if ; - -: move-gap-back ( i gb -- ) - move-gap-back-inside? [ - move-gap-back-inside - ] [ - move-gap-back-around - ] if ; - -: (move-gap) ( i gb -- ) - move-gap? [ - move-gap-forward? [ - move-gap-forward - ] [ - move-gap-back - ] if - ] [ 2drop ] if ; - -: fix-gap ( n gb -- ) - 2dup [ gap-length + ] keep set-gb-gap-end set-gb-gap-start ; - -! moving the gap to position 5 means that the element in position 5 will be immediately after the gap -GENERIC: move-gap ( n gb -- ) - -M: gb move-gap ( n gb -- ) 2dup [ position>index ] keep (move-gap) fix-gap ; - -! ------------ resizing ------------------------------------- - -: enough-room? ( n gb -- ? ) - #! is there enough room to add 'n' elements to gb? - tuck length + swap buffer-length <= ; - -: set-new-gap-end ( array gb -- ) - [ buffer-length swap length swap - ] keep - [ gb-gap-end + ] keep set-gb-gap-end ; - -: after-gap ( gb -- gb ) - dup gb-seq swap gb-gap-end tail ; - -: before-gap ( gb -- gb ) - dup gb-gap-start head ; - -: copy-after-gap ( array gb -- ) - #! copy everything after the gap in 'gb' into the end of 'array', - #! and change 'gb's gap-end to reflect the gap-end in 'array' - dup after-gap >r 2dup set-new-gap-end gb-gap-end swap r> -rot copy ; - -: copy-before-gap ( array gb -- ) - #! copy everything before the gap in 'gb' into the start of 'array' - before-gap 0 rot copy ; ! gap start doesn't change - -: resize-buffer ( gb new-size -- ) - f swap 2dup copy-before-gap 2dup copy-after-gap - >r r> set-gb-seq ; - -: decrease-buffer-size ( gb -- ) - #! the gap is too big, so resize to something sensible - dup length over required-space resize-buffer ; - -: increase-buffer-size ( n gb -- ) - #! increase the buffer to fit at least 'n' more elements - tuck length + over required-space resize-buffer ; - -: gb-too-big? ( gb -- ? ) - dup buffer-length over gb-min-size > [ - dup length over buffer-length rot gb-expand-factor sq / < - ] [ drop f ] if ; - -: ?decrease ( gb -- ) - dup gb-too-big? [ - decrease-buffer-size - ] [ drop ] if ; - -: ensure-room ( n gb -- ) - #! ensure that ther will be enough room for 'n' more elements - 2dup enough-room? [ 2drop ] [ - increase-buffer-size - ] if ; - -! ------- editing operations --------------- - -GENERIC# insert* 2 ( seq position gb -- ) - -: prepare-insert ( seq position gb -- seq gb ) - tuck move-gap over length over ensure-room ; - -: insert-elements ( seq gb -- ) - dup gb-gap-start swap gb-seq copy ; - -: increment-gap-start ( gb n -- ) - over gb-gap-start + swap set-gb-gap-start ; - -! generic dispatch identifies numbers as sequences before numbers... -! M: number insert* ( elem position gb -- ) >r >r 1array r> r> insert* ; -: number-insert ( num position gb -- ) >r >r 1array r> r> insert* ; - -M: sequence insert* ( seq position gb -- ) - pick number? [ - number-insert - ] [ - prepare-insert [ insert-elements ] 2keep swap length increment-gap-start - ] if ; - -: (delete*) ( gb -- ) - dup gb-gap-end 1+ over set-gb-gap-end ?decrease ; - -GENERIC: delete* ( pos gb -- ) - -M: gb delete* ( position gb -- ) - tuck move-gap (delete*) ; - -! -------- stack/queue operations ----------- - -: push-start ( obj gb -- ) 0 swap insert* ; - -: push-end ( obj gb -- ) [ length ] keep insert* ; - -: pop-elem ( position gb -- elem ) [ nth ] 2keep delete* ; - -: pop-start ( gb -- elem ) 0 swap pop-elem ; - -: pop-end ( gb -- elem ) [ length 1- ] keep pop-elem ; - -: rotate ( n gb -- ) - dup length 1 > [ - swap dup 0 > [ - [ dup [ pop-end ] keep push-start ] - ] [ - neg [ dup [ pop-start ] keep push-end ] - ] if times drop - ] [ 2drop ] if ; - diff --git a/unmaintained/gap-buffer/summary.txt b/unmaintained/gap-buffer/summary.txt deleted file mode 100644 index 0da4c0075d..0000000000 --- a/unmaintained/gap-buffer/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Gap buffer data structure diff --git a/unmaintained/gap-buffer/tags.txt b/unmaintained/gap-buffer/tags.txt deleted file mode 100644 index b5e4471134..0000000000 --- a/unmaintained/gap-buffer/tags.txt +++ /dev/null @@ -1,2 +0,0 @@ -collections -sequences diff --git a/unmaintained/geom/dim/authors.txt b/unmaintained/geom/dim/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/geom/dim/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/geom/dim/dim.factor b/unmaintained/geom/dim/dim.factor deleted file mode 100644 index 1cac5d765f..0000000000 --- a/unmaintained/geom/dim/dim.factor +++ /dev/null @@ -1,16 +0,0 @@ - -USING: sequences mortar slot-accessors ; - -IN: geom.dim - -SYMBOL: - - { "dim" } accessors define-independent-class - - { - -"width" !( dim -- width ) [ $dim first ] - -"height" !( dim -- second ) [ $dim second ] - -} add-methods \ No newline at end of file diff --git a/unmaintained/geom/pos/authors.txt b/unmaintained/geom/pos/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/geom/pos/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/geom/pos/pos.factor b/unmaintained/geom/pos/pos.factor deleted file mode 100644 index b626c40e37..0000000000 --- a/unmaintained/geom/pos/pos.factor +++ /dev/null @@ -1,28 +0,0 @@ - -USING: kernel arrays sequences math.vectors mortar slot-accessors ; - -IN: geom.pos - -SYMBOL: - - { "pos" } accessors define-independent-class - - { - -"x" !( pos -- x ) [ $pos first ] - -"y" !( pos -- y ) [ $pos second ] - -"set-x" !( pos x -- pos ) [ 0 pick $pos set-nth ] - -"set-y" !( pos y -- pos ) [ 1 pick $pos set-nth ] - -"distance" !( pos pos -- distance ) [ $pos swap $pos v- norm ] - -"move-by" !( pos offset -- pos ) [ over $pos v+ >>pos ] - -"move-by-x" !( pos x-offset -- pos ) [ 0 2array <-- move-by ] - -"move-by-y" !( pos y-offset -- pos ) [ 0 swap 2array <-- move-by ] - -} add-methods \ No newline at end of file diff --git a/unmaintained/geom/rect/authors.txt b/unmaintained/geom/rect/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/geom/rect/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/geom/rect/rect.factor b/unmaintained/geom/rect/rect.factor deleted file mode 100644 index 573b8e0e1d..0000000000 --- a/unmaintained/geom/rect/rect.factor +++ /dev/null @@ -1,41 +0,0 @@ - -USING: kernel namespaces arrays sequences math.vectors - mortar slot-accessors geom.pos geom.dim ; - -IN: geom.rect - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USE: math - -: v+y ( pos y -- pos ) 0 swap 2array v+ ; - -: v-y ( pos y -- pos ) 0 swap 2array v- ; - -: v+x ( pos x -- pos ) 0 2array v+ ; - -: v-x ( pos x -- pos ) 0 2array v- ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: - - - class-slots class-slots append - class-methods class-methods append { H{ } } append - { H{ } } -4array set-global - -! { 0 0 } { 0 0 } new - - { - -"top-left" !( rect -- point ) [ $pos ] - -"top-right" !( rect -- point ) [ dup $pos swap <- width 1- v+x ] - -"bottom-left" !( rect -- point ) [ dup $pos swap <- height 1- v+y ] - -"bottom-right" !( rect -- point ) [ dup $pos swap $dim { 1 1 } v- v+ ] - -} add-methods \ No newline at end of file diff --git a/unmaintained/id3/authors.txt b/unmaintained/id3/authors.txt deleted file mode 100644 index bbc876e7b6..0000000000 --- a/unmaintained/id3/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Adam Wendt diff --git a/unmaintained/id3/id3-docs.factor b/unmaintained/id3/id3-docs.factor deleted file mode 100644 index 8083514c0d..0000000000 --- a/unmaintained/id3/id3-docs.factor +++ /dev/null @@ -1,29 +0,0 @@ -! Coyright (C) 2007 Adam Wendt -! See http://factorcode.org/license.txt for BSD license. -USING: help.syntax help.markup ; -IN: id3 - -ARTICLE: "id3-tags" "ID3 Tags" -"The " { $vocab-link "id3" } " vocabulary is used to read ID3 tags from MP3 audio streams." -{ $subsection id3v2 } -{ $subsection read-tag } -{ $subsection id3v2? } -{ $subsection read-id3v2 } ; - -ABOUT: "id3-tags" - -HELP: id3v2 -{ $values { "filename" "a pathname string" } { "tag/f" "a tag or f" } } -{ $description "Outputs a " { $link tag } " or " { $link f } " if file does not start with an ID3 tag." } ; - -HELP: read-tag -{ $values { "stream" "a stream" } { "tag/f" "a tag or f" } } -{ $description "Outputs a " { $link tag } " or " { $link f } " if stream does not start with an ID3 tag." } ; - -HELP: id3v2? -{ $values { "?" "a boolean" } } -{ $description "Tests if the current input stream begins with an ID3 tag." } ; - -HELP: read-id3v2 -{ $values { "tag/f" "a tag or f" } } -{ $description "Outputs a " { $link tag } " or " { $link f } " if the current input stream does not start with an ID3 tag." } ; diff --git a/unmaintained/id3/id3.factor b/unmaintained/id3/id3.factor deleted file mode 100755 index 7f39025c4c..0000000000 --- a/unmaintained/id3/id3.factor +++ /dev/null @@ -1,142 +0,0 @@ -! Copyright (C) 2007 Adam Wendt. -! See http://factorcode.org/license.txt for BSD license. - -USING: arrays combinators io io.binary io.files io.paths -io.encodings.utf16 kernel math math.parser namespaces sequences -splitting strings assocs unicode.categories io.encodings.binary ; - -IN: id3 - -TUPLE: tag header frames ; -C: tag - -TUPLE: header version revision flags size extended-header ; -C:
header - -TUPLE: frame id size flags data ; -C: frame - -TUPLE: extended-header size flags update crc restrictions ; -C: extended-header - -: debug-stream ( msg -- ) -! global [ . flush ] bind ; - drop ; - -: >hexstring ( str -- hex ) - >array [ >hex 2 CHAR: 0 pad-left ] map concat ; - -: good-frame-id? ( id -- ? ) - [ [ LETTER? ] keep digit? or ] all? ; - -! 4 byte syncsafe integer (28 effective bits) -: >syncsafe ( seq -- int ) - 0 [ >r 7 shift r> bitor ] reduce ; - -: read-size ( -- size ) - 4 read >syncsafe ; - -: read-frame-id ( -- id ) - 4 read ; - -: read-frame-flags ( -- flags ) - 2 read ; - -: read-frame-size ( -- size ) - 4 read be> ; - -: text-frame? ( id -- ? ) - "T" head? ; - -: read-text ( size -- text ) - read1 swap 1 - read swap 1 = [ decode-utf16 ] [ ] if - "\0" ?tail drop ; ! remove null terminator - -: read-popm ( size -- popm ) - read-text ; - -: read-frame-data ( id size -- data ) - swap - { - { [ dup text-frame? ] [ drop read-text ] } - { [ "POPM" = ] [ read-popm ] } - { [ t ] [ read ] } - } cond ; - -: (read-frame) ( id -- frame ) - read-frame-size read-frame-flags 2over read-frame-data ; - -: read-frame ( -- frame/f ) - read-frame-id dup good-frame-id? [ (read-frame) ] [ drop f ] if ; - -: (read-frames) ( vector -- frames ) - read-frame [ over push (read-frames) ] when* ; - -: read-frames ( -- frames ) - V{ } clone (read-frames) ; - -: read-eh-flags ( -- flags ) - read1 read le> ; - -: read-eh-data ( size -- data ) - 6 - read ; - -: read-crc ( flags -- crc ) - 5 bit? [ read1 read >syncsafe ] [ f ] if ; - -: tag-is-update? ( flags -- ? ) - 6 bit? dup [ read1 drop ] [ ] if ; - -: (read-tag-restrictions) ( -- restrictions ) - read1 dup read le> ; - -: read-tag-restrictions ( flags -- restrictions/f ) - 4 bit? [ (read-tag-restrictions) ] [ f ] if ; - -: (read-extended-header) ( -- extended-header ) - read-size read-eh-flags dup tag-is-update? over dup - read-crc swap read-tag-restrictions ; - -: read-extended-header ( flags -- extended-header/f ) - 6 bit? [ (read-extended-header) ] [ f ] if ; - -: read-header ( version -- header ) - read1 read1 read-size over read-extended-header
; - -: (read-id3v2) ( version -- tag ) - read-header read-frames ; - -: supported-version? ( version -- ? ) - { 3 4 } member? ; - -: read-id3v2 ( -- tag/f ) - read1 dup supported-version? - [ (read-id3v2) ] [ drop f ] if ; - -: id3v2? ( -- ? ) - 3 read "ID3" sequence= ; - -: read-tag ( stream -- tag/f ) - id3v2? [ read-id3v2 ] [ f ] if ; - -: id3v2 ( filename -- tag/f ) - binary [ read-tag ] with-file-reader ; - -: file? ( path -- ? ) - stat 3drop not ; - -: files ( paths -- files ) - [ file? ] subset ; - -: mp3? ( path -- ? ) - ".mp3" tail? ; - -: mp3s ( paths -- mp3s ) - [ mp3? ] subset ; - -: id3? ( file -- ? ) - binary [ id3v2? ] with-file-reader ; - -: id3s ( files -- id3s ) - [ id3? ] subset ; - diff --git a/unmaintained/id3/summary.txt b/unmaintained/id3/summary.txt deleted file mode 100644 index 62016172bd..0000000000 --- a/unmaintained/id3/summary.txt +++ /dev/null @@ -1 +0,0 @@ -ID3 music file tag parser diff --git a/unmaintained/if/authors.txt b/unmaintained/if/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/if/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/if/if.factor b/unmaintained/if/if.factor deleted file mode 100644 index 0a908831ee..0000000000 --- a/unmaintained/if/if.factor +++ /dev/null @@ -1,98 +0,0 @@ - -USING: alien.syntax ; - -IN: unix.linux.if - -: IFNAMSIZ 16 ; -: IF_NAMESIZE 16 ; -: IFHWADDRLEN 6 ; - -! Standard interface flags (netdevice->flags) - -: IFF_UP HEX: 1 ; ! interface is up -: IFF_BROADCAST HEX: 2 ; ! broadcast address valid -: IFF_DEBUG HEX: 4 ; ! turn on debugging -: IFF_LOOPBACK HEX: 8 ; ! is a loopback net -: IFF_POINTOPOINT HEX: 10 ; ! interface is has p-p link -: IFF_NOTRAILERS HEX: 20 ; ! avoid use of trailers -: IFF_RUNNING HEX: 40 ; ! interface running and carrier ok -: IFF_NOARP HEX: 80 ; ! no ARP protocol -: IFF_PROMISC HEX: 100 ; ! receive all packets -: IFF_ALLMULTI HEX: 200 ; ! receive all multicast packets - -: IFF_MASTER HEX: 400 ; ! master of a load balancer -: IFF_SLAVE HEX: 800 ; ! slave of a load balancer - -: IFF_MULTICAST HEX: 1000 ; ! Supports multicast - -! #define IFF_VOLATILE -! (IFF_LOOPBACK|IFF_POINTOPOINT|IFF_BROADCAST|IFF_MASTER|IFF_SLAVE|IFF_RUNNING) - -: IFF_PORTSEL HEX: 2000 ; ! can set media type -: IFF_AUTOMEDIA HEX: 4000 ; ! auto media select active -: IFF_DYNAMIC HEX: 8000 ; ! dialup device with changing addresses - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -C-STRUCT: struct-ifmap - { "ulong" "mem-start" } - { "ulong" "mem-end" } - { "ushort" "base-addr" } - { "uchar" "irq" } - { "uchar" "dma" } - { "uchar" "port" } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Hmm... the generic sockaddr type isn't defined anywhere. -! Put it here for now. - -TYPEDEF: ushort sa_family_t - -C-STRUCT: struct-sockaddr - { "sa_family_t" "sa_family" } - { { "char" 14 } "sa_data" } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! C-UNION: union-ifr-ifrn { "char" IFNAMSIZ } ; - -C-UNION: union-ifr-ifrn { "char" 16 } ; - -C-UNION: union-ifr-ifru - "struct-sockaddr" -! "sockaddr" - "short" - "int" - "struct-ifmap" -! { "char" IFNAMSIZ } - { "char" 16 } - "caddr_t" ; - -C-STRUCT: struct-ifreq - { "union-ifr-ifrn" "ifr-ifrn" } - { "union-ifr-ifru" "ifr-ifru" } ; - -: ifr-name ( struct-ifreq -- value ) struct-ifreq-ifr-ifrn ; - -: ifr-hwaddr ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ; -: ifr-addr ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ; -: ifr-dstaddr ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ; -: ifr-broadaddr ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ; -: ifr-netmask ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ; -: ifr-flags ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -C-UNION: union-ifc-ifcu "caddr_t" "struct-ifreq*" ; - -C-STRUCT: struct-ifconf - { "int" "ifc-len" } - { "union-ifc-ifcu" "ifc-ifcu" } ; - -: ifc-len ( struct-ifconf -- value ) struct-ifconf-ifc-len ; - -: ifc-buf ( struct-ifconf -- value ) struct-ifconf-ifc-ifcu ; -: ifc-req ( struct-ifconf -- value ) struct-ifconf-ifc-ifcu ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! \ No newline at end of file diff --git a/unmaintained/if/tags.txt b/unmaintained/if/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/unmaintained/if/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/unmaintained/ifreq/authors.txt b/unmaintained/ifreq/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/ifreq/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/ifreq/ifreq.factor b/unmaintained/ifreq/ifreq.factor deleted file mode 100644 index 5dc1c0fde2..0000000000 --- a/unmaintained/ifreq/ifreq.factor +++ /dev/null @@ -1,60 +0,0 @@ - -USING: kernel alien alien.c-types - io.sockets - unix - unix.linux.sockios - unix.linux.if ; - -IN: unix.linux.ifreq - -: set-if-addr ( name addr -- ) - "struct-ifreq" - rot ascii string>alien over set-struct-ifreq-ifr-ifrn - swap 0 make-sockaddr over set-struct-ifreq-ifr-ifru - - AF_INET SOCK_DGRAM 0 socket SIOCSIFADDR rot ioctl drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: set-if-flags ( name flags -- ) - "struct-ifreq" - rot ascii string>alien over set-struct-ifreq-ifr-ifrn - swap over set-struct-ifreq-ifr-ifru - - AF_INET SOCK_DGRAM 0 socket SIOCSIFFLAGS rot ioctl drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: set-if-dst-addr ( name addr -- ) - "struct-ifreq" - rot ascii string>alien over set-struct-ifreq-ifr-ifrn - swap 0 make-sockaddr over set-struct-ifreq-ifr-ifru - - AF_INET SOCK_DGRAM 0 socket SIOCSIFDSTADDR rot ioctl drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: set-if-brd-addr ( name addr -- ) - "struct-ifreq" - rot ascii string>alien over set-struct-ifreq-ifr-ifrn - swap 0 make-sockaddr over set-struct-ifreq-ifr-ifru - - AF_INET SOCK_DGRAM 0 socket SIOCSIFBRDADDR rot ioctl drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: set-if-netmask ( name addr -- ) - "struct-ifreq" - rot ascii string>alien over set-struct-ifreq-ifr-ifrn - swap 0 make-sockaddr over set-struct-ifreq-ifr-ifru - - AF_INET SOCK_DGRAM 0 socket SIOCSIFNETMASK rot ioctl drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: set-if-metric ( name metric -- ) - "struct-ifreq" - rot ascii string>alien over set-struct-ifreq-ifr-ifrn - swap over set-struct-ifreq-ifr-ifru - - AF_INET SOCK_DGRAM 0 socket SIOCSIFMETRIC rot ioctl drop ; \ No newline at end of file diff --git a/unmaintained/ifreq/tags.txt b/unmaintained/ifreq/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/unmaintained/ifreq/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/unmaintained/jamshred/authors.txt b/unmaintained/jamshred/authors.txt deleted file mode 100644 index e9c193bac7..0000000000 --- a/unmaintained/jamshred/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Alex Chapman diff --git a/unmaintained/jamshred/deploy.factor b/unmaintained/jamshred/deploy.factor deleted file mode 100644 index 9a18cf1f9b..0000000000 --- a/unmaintained/jamshred/deploy.factor +++ /dev/null @@ -1,12 +0,0 @@ -USING: tools.deploy.config ; -V{ - { deploy-ui? t } - { deploy-io 1 } - { deploy-reflection 1 } - { deploy-compiler? t } - { deploy-math? t } - { deploy-word-props? f } - { deploy-c-types? f } - { "stop-after-last-window?" t } - { deploy-name "Jamshred" } -} diff --git a/unmaintained/jamshred/game/authors.txt b/unmaintained/jamshred/game/authors.txt deleted file mode 100755 index e9c193bac7..0000000000 --- a/unmaintained/jamshred/game/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Alex Chapman diff --git a/unmaintained/jamshred/game/game.factor b/unmaintained/jamshred/game/game.factor deleted file mode 100644 index 9cb5bc7c3a..0000000000 --- a/unmaintained/jamshred/game/game.factor +++ /dev/null @@ -1,40 +0,0 @@ -! Copyright (C) 2007, 2008 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel opengl arrays sequences jamshred.log jamshred.player jamshred.sound jamshred.tunnel math math.constants math.vectors ; -IN: jamshred.game - -TUPLE: jamshred sounds tunnel players running quit ; - -: ( -- jamshred ) - "Player 1" pick - 2dup swap play-in-tunnel 1array f f jamshred boa ; - -: jamshred-player ( jamshred -- player ) - ! TODO: support more than one player - players>> first ; - -: jamshred-update ( jamshred -- ) - dup running>> [ - jamshred-player update-player - ] [ drop ] if ; - -: toggle-running ( jamshred -- ) - dup running>> [ - f >>running drop - ] [ - [ jamshred-player moved ] - [ t >>running drop ] bi - ] if ; - -: mouse-moved ( x-radians y-radians jamshred -- ) - jamshred-player -rot turn-player ; - -: units-per-full-roll ( -- n ) 50 ; - -: jamshred-roll ( jamshred n -- ) - [ jamshred-player ] dip 2 pi * * units-per-full-roll / roll-player ; - -: mouse-scroll-x ( jamshred x -- ) jamshred-roll ; - -: mouse-scroll-y ( jamshred y -- ) - neg swap jamshred-player change-player-speed ; diff --git a/unmaintained/jamshred/gl/authors.txt b/unmaintained/jamshred/gl/authors.txt deleted file mode 100755 index e9c193bac7..0000000000 --- a/unmaintained/jamshred/gl/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Alex Chapman diff --git a/unmaintained/jamshred/gl/gl.factor b/unmaintained/jamshred/gl/gl.factor deleted file mode 100644 index b78e7de88e..0000000000 --- a/unmaintained/jamshred/gl/gl.factor +++ /dev/null @@ -1,99 +0,0 @@ -! Copyright (C) 2007, 2008 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types jamshred.game jamshred.oint -jamshred.player jamshred.tunnel kernel math math.constants -math.functions math.vectors opengl opengl.gl opengl.glu -opengl.demo-support sequences specialized-arrays.float ; -IN: jamshred.gl - -: min-vertices 6 ; inline -: max-vertices 32 ; inline - -: n-vertices ( -- n ) 32 ; inline - -! render enough of the tunnel that it looks continuous -: n-segments-ahead ( -- n ) 60 ; inline -: n-segments-behind ( -- n ) 40 ; inline - -: wall-drawing-offset ( -- n ) - #! so that we can't see through the wall, we draw it a bit further away - 0.15 ; - -: wall-drawing-radius ( segment -- r ) - radius>> wall-drawing-offset + ; - -: wall-up ( segment -- v ) - [ wall-drawing-radius ] [ up>> ] bi n*v ; - -: wall-left ( segment -- v ) - [ wall-drawing-radius ] [ left>> ] bi n*v ; - -: segment-vertex ( theta segment -- vertex ) - [ - [ wall-up swap sin v*n ] [ wall-left swap cos v*n ] 2bi v+ - ] [ - location>> v+ - ] bi ; - -: segment-vertex-normal ( vertex segment -- normal ) - location>> swap v- normalize ; - -: segment-vertex-and-normal ( segment theta -- vertex normal ) - swap [ segment-vertex ] keep dupd segment-vertex-normal ; - -: equally-spaced-radians ( n -- seq ) - #! return a sequence of n numbers between 0 and 2pi - dup [ / pi 2 * * ] curry map ; - -: draw-segment-vertex ( segment theta -- ) - over color>> gl-color segment-vertex-and-normal - gl-normal gl-vertex ; - -: draw-vertex-pair ( theta next-segment segment -- ) - rot tuck draw-segment-vertex draw-segment-vertex ; - -: draw-segment ( next-segment segment -- ) - GL_QUAD_STRIP [ - [ draw-vertex-pair ] 2curry - n-vertices equally-spaced-radians F{ 0.0 } append swap each - ] do-state ; - -: draw-segments ( segments -- ) - 1 over length pick subseq swap [ draw-segment ] 2each ; - -: segments-to-render ( player -- segments ) - dup nearest-segment>> number>> dup n-segments-behind - - swap n-segments-ahead + rot tunnel>> sub-tunnel ; - -: draw-tunnel ( player -- ) - segments-to-render draw-segments ; - -: init-graphics ( width height -- ) - GL_DEPTH_TEST glEnable - GL_SCISSOR_TEST glDisable - 1.0 glClearDepth - 0.0 0.0 0.0 0.0 glClearColor - GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear - GL_PROJECTION glMatrixMode glLoadIdentity - dup 0 = [ 2drop ] [ / >float 45.0 swap 0.1 100.0 gluPerspective ] if - GL_MODELVIEW glMatrixMode glLoadIdentity - GL_LEQUAL glDepthFunc - GL_LIGHTING glEnable - GL_LIGHT0 glEnable - GL_FOG glEnable - GL_FOG_DENSITY 0.09 glFogf - GL_FRONT GL_AMBIENT_AND_DIFFUSE glColorMaterial - GL_COLOR_MATERIAL glEnable - GL_LIGHT0 GL_POSITION float-array{ 0.0 0.0 0.0 1.0 } underlying>> glLightfv - GL_LIGHT0 GL_AMBIENT float-array{ 0.2 0.2 0.2 1.0 } underlying>> glLightfv - GL_LIGHT0 GL_DIFFUSE float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv - GL_LIGHT0 GL_SPECULAR float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv ; - -: player-view ( player -- ) - [ location>> ] - [ [ location>> ] [ forward>> ] bi v+ ] - [ up>> ] tri gl-look-at ; - -: draw-jamshred ( jamshred width height -- ) - init-graphics jamshred-player [ player-view ] [ draw-tunnel ] bi ; - diff --git a/unmaintained/jamshred/jamshred.factor b/unmaintained/jamshred/jamshred.factor deleted file mode 100755 index d0b74417d1..0000000000 --- a/unmaintained/jamshred/jamshred.factor +++ /dev/null @@ -1,94 +0,0 @@ -! Copyright (C) 2007, 2008 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.geometry.rect math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ; -IN: jamshred - -TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ; - -: ( jamshred -- gadget ) - jamshred-gadget new-gadget swap >>jamshred ; - -: default-width ( -- x ) 800 ; -: default-height ( -- y ) 600 ; - -M: jamshred-gadget pref-dim* - drop default-width default-height 2array ; - -M: jamshred-gadget draw-gadget* ( gadget -- ) - [ jamshred>> ] [ rect-dim first2 draw-jamshred ] bi ; - -: jamshred-loop ( gadget -- ) - dup jamshred>> quit>> [ - drop - ] [ - [ jamshred>> jamshred-update ] - [ relayout-1 ] - [ 10 milliseconds sleep yield jamshred-loop ] tri - ] if ; - -: fullscreen ( gadget -- ) - find-world t swap set-fullscreen* ; - -: no-fullscreen ( gadget -- ) - find-world f swap set-fullscreen* ; - -: toggle-fullscreen ( world -- ) - [ fullscreen? not ] keep set-fullscreen* ; - -M: jamshred-gadget graft* ( gadget -- ) - [ jamshred-loop ] curry in-thread ; - -M: jamshred-gadget ungraft* ( gadget -- ) - jamshred>> t swap (>>quit) ; - -: jamshred-restart ( jamshred-gadget -- ) - >>jamshred drop ; - -: pix>radians ( n m -- theta ) - / pi 4 * * ; ! 2 / / pi 2 * * ; - -: x>radians ( x gadget -- theta ) - #! translate motion of x pixels to an angle - rect-dim first pix>radians neg ; - -: y>radians ( y gadget -- theta ) - #! translate motion of y pixels to an angle - rect-dim second pix>radians ; - -: (handle-mouse-motion) ( jamshred-gadget mouse-motion -- ) - over jamshred>> >r - [ first swap x>radians ] 2keep second swap y>radians - r> mouse-moved ; - -: handle-mouse-motion ( jamshred-gadget -- ) - hand-loc get [ - over last-hand-loc>> [ - v- (handle-mouse-motion) - ] [ 2drop ] if* - ] 2keep >>last-hand-loc drop ; - -: handle-mouse-scroll ( jamshred-gadget -- ) - jamshred>> scroll-direction get - [ first mouse-scroll-x ] - [ second mouse-scroll-y ] 2bi ; - -: quit ( gadget -- ) - [ no-fullscreen ] [ close-window ] bi ; - -jamshred-gadget H{ - { T{ key-down f f "r" } [ jamshred-restart ] } - { T{ key-down f f " " } [ jamshred>> toggle-running ] } - { T{ key-down f f "f" } [ find-world toggle-fullscreen ] } - { T{ key-down f f "UP" } [ jamshred>> jamshred-player 1 swap change-player-speed ] } - { T{ key-down f f "DOWN" } [ jamshred>> jamshred-player -1 swap change-player-speed ] } - { T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] } - { T{ key-down f f "RIGHT" } [ jamshred>> -1 jamshred-roll ] } - { T{ key-down f f "q" } [ quit ] } - { T{ motion } [ handle-mouse-motion ] } - { T{ mouse-scroll } [ handle-mouse-scroll ] } -} set-gestures - -: jamshred-window ( -- gadget ) - [ dup "Jamshred" open-window ] with-ui ; - -MAIN: jamshred-window diff --git a/unmaintained/jamshred/log/log.factor b/unmaintained/jamshred/log/log.factor deleted file mode 100644 index 33498d8a2e..0000000000 --- a/unmaintained/jamshred/log/log.factor +++ /dev/null @@ -1,10 +0,0 @@ -USING: kernel logging ; -IN: jamshred.log - -LOG: (jamshred-log) DEBUG - -: with-jamshred-log ( quot -- ) - "jamshred" swap with-logging ; - -: jamshred-log ( message -- ) - [ (jamshred-log) ] with-jamshred-log ; ! ugly... diff --git a/unmaintained/jamshred/oint/authors.txt b/unmaintained/jamshred/oint/authors.txt deleted file mode 100755 index e9c193bac7..0000000000 --- a/unmaintained/jamshred/oint/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Alex Chapman diff --git a/unmaintained/jamshred/oint/oint-tests.factor b/unmaintained/jamshred/oint/oint-tests.factor deleted file mode 100644 index 401935fd01..0000000000 --- a/unmaintained/jamshred/oint/oint-tests.factor +++ /dev/null @@ -1,8 +0,0 @@ -USING: jamshred.oint tools.test ; -IN: jamshred.oint-tests - -[ { 0 -1 -1 } ] [ { 0 1 -1 } { 0 -1 0 } reflect ] unit-test -[ { 0 1 0 } ] [ { 1 1 0 } { 1 0 0 } proj-perp ] unit-test -[ { 1 0 0 } ] [ { 1 1 0 } { 0 1 0 } proj-perp ] unit-test -[ { 1/2 -1/2 0 } ] [ { 1 0 0 } { 1 1 0 } proj-perp ] unit-test -[ { -1/2 1/2 0 } ] [ { 0 1 0 } { 1 1 0 } proj-perp ] unit-test diff --git a/unmaintained/jamshred/oint/oint.factor b/unmaintained/jamshred/oint/oint.factor deleted file mode 100644 index 808e92a1f9..0000000000 --- a/unmaintained/jamshred/oint/oint.factor +++ /dev/null @@ -1,73 +0,0 @@ -! Copyright (C) 2007, 2008 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays float-arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ; -IN: jamshred.oint - -! An oint is a point with three linearly independent unit vectors -! given relative to that point. In jamshred a player's location and -! direction are given by the player's oint. Similarly, a tunnel -! segment's location and orientation are given by an oint. - -TUPLE: oint location forward up left ; -C: oint - -: rotation-quaternion ( theta axis -- quaternion ) - swap 2 / dup cos swap sin rot n*v first3 rect> >r rect> r> 2array ; - -: rotate-vector ( q qrecip v -- v ) - v>q swap q* q* q>v ; - -: rotate-oint ( oint theta axis -- ) - rotation-quaternion dup qrecip pick - [ forward>> rotate-vector >>forward ] - [ up>> rotate-vector >>up ] - [ left>> rotate-vector >>left ] 3tri drop ; - -: left-pivot ( oint theta -- ) - over left>> rotate-oint ; - -: up-pivot ( oint theta -- ) - over up>> rotate-oint ; - -: forward-pivot ( oint theta -- ) - over forward>> rotate-oint ; - -: random-float+- ( n -- m ) - #! find a random float between -n/2 and n/2 - dup 10000 * >fixnum random 10000 / swap 2 / - ; - -: random-turn ( oint theta -- ) - 2 / 2dup random-float+- left-pivot random-float+- up-pivot ; - -: location+ ( v oint -- ) - [ location>> v+ ] [ (>>location) ] bi ; - -: go-forward ( distance oint -- ) - [ forward>> n*v ] [ location+ ] bi ; - -: distance-vector ( oint oint -- vector ) - [ location>> ] bi@ swap v- ; - -: distance ( oint oint -- distance ) - distance-vector norm ; - -: scalar-projection ( v1 v2 -- n ) - #! the scalar projection of v1 onto v2 - tuck v. swap norm / ; - -: proj-perp ( u v -- w ) - dupd proj v- ; - -: perpendicular-distance ( oint oint -- distance ) - tuck distance-vector swap 2dup left>> scalar-projection abs - -rot up>> scalar-projection abs + ; - -:: reflect ( v n -- v' ) - #! bounce v on a surface with normal n - v v n v. n n v. / 2 * n n*v v- ; - -: half-way ( p1 p2 -- p3 ) - over v- 2 v/n v+ ; - -: half-way-between-oints ( o1 o2 -- p ) - [ location>> ] bi@ half-way ; diff --git a/unmaintained/jamshred/player/authors.txt b/unmaintained/jamshred/player/authors.txt deleted file mode 100755 index e9c193bac7..0000000000 --- a/unmaintained/jamshred/player/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Alex Chapman diff --git a/unmaintained/jamshred/player/player.factor b/unmaintained/jamshred/player/player.factor deleted file mode 100644 index 72f26a2c79..0000000000 --- a/unmaintained/jamshred/player/player.factor +++ /dev/null @@ -1,137 +0,0 @@ -! Copyright (C) 2007, 2008 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: accessors colors combinators float-arrays jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle strings system ; -IN: jamshred.player - -TUPLE: player < oint - { name string } - { sounds sounds } - tunnel - nearest-segment - { last-move integer } - { speed float } ; - -! speeds are in GL units / second -: default-speed ( -- speed ) 1.0 ; -: max-speed ( -- speed ) 30.0 ; - -: ( name sounds -- player ) - [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] 2dip - f f 0 default-speed player boa ; - -: turn-player ( player x-radians y-radians -- ) - >r over r> left-pivot up-pivot ; - -: roll-player ( player z-radians -- ) - forward-pivot ; - -: to-tunnel-start ( player -- ) - [ tunnel>> first dup location>> ] - [ tuck (>>location) (>>nearest-segment) ] bi ; - -: play-in-tunnel ( player segments -- ) - >>tunnel to-tunnel-start ; - -: update-nearest-segment ( player -- ) - [ tunnel>> ] [ dup nearest-segment>> nearest-segment ] - [ (>>nearest-segment) ] tri ; - -: update-time ( player -- seconds-passed ) - millis swap [ last-move>> - 1000 / ] [ (>>last-move) ] 2bi ; - -: moved ( player -- ) millis swap (>>last-move) ; - -: speed-range ( -- range ) - max-speed [0,b] ; - -: change-player-speed ( inc player -- ) - [ + speed-range clamp-to-range ] change-speed drop ; - -: multiply-player-speed ( n player -- ) - [ * speed-range clamp-to-range ] change-speed drop ; - -: distance-to-move ( seconds-passed player -- distance ) - speed>> * ; - -: bounce ( d-left player -- d-left' player ) - { - [ dup nearest-segment>> bounce-off-wall ] - [ sounds>> bang ] - [ 3/4 swap multiply-player-speed ] - [ ] - } cleave ; - -:: (distance) ( heading player -- current next location heading ) - player nearest-segment>> - player [ tunnel>> ] [ nearest-segment>> ] bi heading heading-segment - player location>> heading ; - -: distance-to-heading-segment ( heading player -- distance ) - (distance) distance-to-next-segment ; - -: distance-to-heading-segment-area ( heading player -- distance ) - (distance) distance-to-next-segment-area ; - -: distance-to-collision ( player -- distance ) - dup nearest-segment>> (distance-to-collision) ; - -: almost-to-collision ( player -- distance ) - distance-to-collision 0.1 - dup 0 < [ drop 0 ] when ; - -: from ( player -- radius distance-from-centre ) - [ nearest-segment>> dup radius>> swap ] [ location>> ] bi - distance-from-centre ; - -: distance-from-wall ( player -- distance ) from - ; -: fraction-from-centre ( player -- fraction ) from swap / ; -: fraction-from-wall ( player -- fraction ) - fraction-from-centre 1 swap - ; - -: update-nearest-segment2 ( heading player -- ) - 2dup distance-to-heading-segment-area 0 <= [ - [ tunnel>> ] [ nearest-segment>> rot heading-segment ] - [ (>>nearest-segment) ] tri - ] [ - 2drop - ] if ; - -:: move-player-on-heading ( d-left player distance heading -- d-left' player ) - [let* | d-to-move [ d-left distance min ] - move-v [ d-to-move heading n*v ] | - move-v player location+ - heading player update-nearest-segment2 - d-left d-to-move - player ] ; - -: distance-to-move-freely ( player -- distance ) - [ almost-to-collision ] - [ [ forward>> ] keep distance-to-heading-segment-area ] bi min ; - -: ?move-player-freely ( d-left player -- d-left' player ) - over 0 > [ - ! must make sure we are moving a significant distance, otherwise - ! we can recurse endlessly due to floating-point imprecision. - ! (at least I /think/ that's what causes it...) - dup distance-to-move-freely dup 0.1 > [ - over forward>> move-player-on-heading ?move-player-freely - ] [ drop ] if - ] when ; - -: drag-heading ( player -- heading ) - [ forward>> ] [ nearest-segment>> forward>> proj ] bi ; - -: drag-player ( d-left player -- d-left' player ) - dup [ [ drag-heading ] keep distance-to-heading-segment-area ] - [ drag-heading move-player-on-heading ] bi ; - -: (move-player) ( d-left player -- d-left' player ) - ?move-player-freely over 0 > [ - ! bounce - drag-player - (move-player) - ] when ; - -: move-player ( player -- ) - [ update-time ] [ distance-to-move ] [ (move-player) 2drop ] tri ; - -: update-player ( player -- ) - [ move-player ] [ nearest-segment>> white swap (>>color) ] bi ; diff --git a/unmaintained/jamshred/sound/bang.wav b/unmaintained/jamshred/sound/bang.wav deleted file mode 100644 index b15af141ec..0000000000 Binary files a/unmaintained/jamshred/sound/bang.wav and /dev/null differ diff --git a/unmaintained/jamshred/sound/sound.factor b/unmaintained/jamshred/sound/sound.factor deleted file mode 100644 index c19c67671f..0000000000 --- a/unmaintained/jamshred/sound/sound.factor +++ /dev/null @@ -1,15 +0,0 @@ -! Copyright (C) 2008 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: accessors io.files kernel openal sequences ; -IN: jamshred.sound - -TUPLE: sounds bang ; - -: assign-sound ( source wav-path -- ) - resource-path create-buffer-from-wav AL_BUFFER swap set-source-param ; - -: ( -- sounds ) - init-openal 1 gen-sources first sounds boa - dup bang>> "extra/jamshred/sound/bang.wav" assign-sound ; - -: bang ( sounds -- ) bang>> source-play check-error ; diff --git a/unmaintained/jamshred/summary.txt b/unmaintained/jamshred/summary.txt deleted file mode 100644 index e26fc1cf8b..0000000000 --- a/unmaintained/jamshred/summary.txt +++ /dev/null @@ -1 +0,0 @@ -A simple 3d tunnel racing game diff --git a/unmaintained/jamshred/tags.txt b/unmaintained/jamshred/tags.txt deleted file mode 100644 index 8ae5957a4b..0000000000 --- a/unmaintained/jamshred/tags.txt +++ /dev/null @@ -1,2 +0,0 @@ -applications -games diff --git a/unmaintained/jamshred/tunnel/authors.txt b/unmaintained/jamshred/tunnel/authors.txt deleted file mode 100755 index e9c193bac7..0000000000 --- a/unmaintained/jamshred/tunnel/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Alex Chapman diff --git a/unmaintained/jamshred/tunnel/tunnel-tests.factor b/unmaintained/jamshred/tunnel/tunnel-tests.factor deleted file mode 100644 index 9486713f55..0000000000 --- a/unmaintained/jamshred/tunnel/tunnel-tests.factor +++ /dev/null @@ -1,45 +0,0 @@ -! Copyright (C) 2007, 2008 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays float-arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences tools.test ; -IN: jamshred.tunnel.tests - -[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 } - T{ segment f { 1 1 1 } f f f 1 } - T{ oint f { 0 0 0.25 } } - nearer-segment number>> ] unit-test - -[ 0 ] [ T{ oint f { 0 0 0 } } find-nearest-segment number>> ] unit-test -[ 1 ] [ T{ oint f { 0 0 -1 } } find-nearest-segment number>> ] unit-test -[ 2 ] [ T{ oint f { 0 0.1 -2.1 } } find-nearest-segment number>> ] unit-test - -[ 3 ] [ T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward number>> ] unit-test - -[ F{ 0 0 0 } ] [ T{ oint f { 0 0 -0.25 } } over first nearest-segment location>> ] unit-test - -: test-segment-oint ( -- oint ) - { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } ; - -[ { -1 0 0 } ] [ test-segment-oint { 1 0 0 } vector-to-centre ] unit-test -[ { 1 0 0 } ] [ test-segment-oint { -1 0 0 } vector-to-centre ] unit-test -[ { 0 -1 0 } ] [ test-segment-oint { 0 1 0 } vector-to-centre ] unit-test -[ { 0 1 0 } ] [ test-segment-oint { 0 -1 0 } vector-to-centre ] unit-test -[ { -1 0 0 } ] [ test-segment-oint { 1 0 -1 } vector-to-centre ] unit-test -[ { 1 0 0 } ] [ test-segment-oint { -1 0 -1 } vector-to-centre ] unit-test -[ { 0 -1 0 } ] [ test-segment-oint { 0 1 -1 } vector-to-centre ] unit-test -[ { 0 1 0 } ] [ test-segment-oint { 0 -1 -1 } vector-to-centre ] unit-test - -: simplest-straight-ahead ( -- oint segment ) - { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } - initial-segment ; - -[ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-heading ] unit-test -[ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-relative-location ] unit-test - -: simple-collision-up ( -- oint segment ) - { 0 0 0 } { 0 1 0 } { 0 0 1 } { -1 0 0 } - initial-segment ; - -[ { 0.0 1.0 0.0 } ] [ simple-collision-up sideways-heading ] unit-test -[ { 0.0 0.0 0.0 } ] [ simple-collision-up sideways-relative-location ] unit-test -[ { 0.0 1.0 0.0 } ] -[ simple-collision-up collision-vector 0 0 0 3array v+ ] unit-test diff --git a/unmaintained/jamshred/tunnel/tunnel.factor b/unmaintained/jamshred/tunnel/tunnel.factor deleted file mode 100755 index 52f2d38dd1..0000000000 --- a/unmaintained/jamshred/tunnel/tunnel.factor +++ /dev/null @@ -1,167 +0,0 @@ -! Copyright (C) 2007, 2008 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays colors combinators float-arrays kernel -locals math math.constants math.matrices math.order math.ranges -math.vectors math.quadratic random sequences vectors jamshred.oint ; -IN: jamshred.tunnel - -: n-segments ( -- n ) 5000 ; inline - -TUPLE: segment < oint number color radius ; -C: segment - -: segment-number++ ( segment -- ) - [ number>> 1+ ] keep (>>number) ; - -: random-color ( -- color ) - { 100 100 100 } [ random 100 / >float ] map first3 1.0 ; - -: tunnel-segment-distance ( -- n ) 0.4 ; -: random-rotation-angle ( -- theta ) pi 20 / ; - -: random-segment ( previous-segment -- segment ) - clone dup random-rotation-angle random-turn - tunnel-segment-distance over go-forward - random-color >>color dup segment-number++ ; - -: (random-segments) ( segments n -- segments ) - dup 0 > [ - >r dup peek random-segment over push r> 1- (random-segments) - ] [ drop ] if ; - -: default-segment-radius ( -- r ) 1 ; - -: initial-segment ( -- segment ) - F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } - 0 random-color default-segment-radius ; - -: random-segments ( n -- segments ) - initial-segment 1vector swap (random-segments) ; - -: simple-segment ( n -- segment ) - [ F{ 0 0 -1 } n*v F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] keep - random-color default-segment-radius ; - -: simple-segments ( n -- segments ) - [ simple-segment ] map ; - -: ( -- segments ) - n-segments random-segments ; - -: ( -- segments ) - n-segments simple-segments ; - -: sub-tunnel ( from to segments -- segments ) - #! return segments between from and to, after clamping from and to to - #! valid values - [ sequence-index-range [ clamp-to-range ] curry bi@ ] keep ; - -: nearer-segment ( segment segment oint -- segment ) - #! return whichever of the two segments is nearer to the oint - >r 2dup r> tuck distance >r distance r> < -rot ? ; - -: (find-nearest-segment) ( nearest next oint -- nearest ? ) - #! find the nearest of 'next' and 'nearest' to 'oint', and return - #! t if the nearest hasn't changed - pick >r nearer-segment dup r> = ; - -: find-nearest-segment ( oint segments -- segment ) - dup first swap rest-slice rot [ (find-nearest-segment) ] curry - find 2drop ; - -: nearest-segment-forward ( segments oint start -- segment ) - rot dup length swap find-nearest-segment ; - -: nearest-segment-backward ( segments oint start -- segment ) - swapd 1+ 0 spin find-nearest-segment ; - -: nearest-segment ( segments oint start-segment -- segment ) - #! find the segment nearest to 'oint', and return it. - #! start looking at segment 'start-segment' - number>> over >r - [ nearest-segment-forward ] 3keep - nearest-segment-backward r> nearer-segment ; - -: get-segment ( segments n -- segment ) - over sequence-index-range clamp-to-range swap nth ; - -: next-segment ( segments current-segment -- segment ) - number>> 1+ get-segment ; - -: previous-segment ( segments current-segment -- segment ) - number>> 1- get-segment ; - -: heading-segment ( segments current-segment heading -- segment ) - #! the next segment on the given heading - over forward>> v. 0 <=> { - { +gt+ [ next-segment ] } - { +lt+ [ previous-segment ] } - { +eq+ [ nip ] } ! current segment - } case ; - -:: distance-to-next-segment ( current next location heading -- distance ) - [let | cf [ current forward>> ] | - cf next location>> v. cf location v. - cf heading v. / ] ; - -:: distance-to-next-segment-area ( current next location heading -- distance ) - [let | cf [ current forward>> ] - h [ next current half-way-between-oints ] | - cf h v. cf location v. - cf heading v. / ] ; - -: vector-to-centre ( seg loc -- v ) - over location>> swap v- swap forward>> proj-perp ; - -: distance-from-centre ( seg loc -- distance ) - vector-to-centre norm ; - -: wall-normal ( seg oint -- n ) - location>> vector-to-centre normalize ; - -: distant ( -- n ) 1000 ; - -: max-real ( a b -- c ) - #! sometimes collision-coefficient yields complex roots, so we ignore these (hack) - dup real? [ - over real? [ max ] [ nip ] if - ] [ - drop dup real? [ drop distant ] unless - ] if ; - -:: collision-coefficient ( v w r -- c ) - v norm 0 = [ - distant - ] [ - [let* | a [ v dup v. ] - b [ v w v. 2 * ] - c [ w dup v. r sq - ] | - c b a quadratic max-real ] - ] if ; - -: sideways-heading ( oint segment -- v ) - [ forward>> ] bi@ proj-perp ; - -: sideways-relative-location ( oint segment -- loc ) - [ [ location>> ] bi@ v- ] keep forward>> proj-perp ; - -: (distance-to-collision) ( oint segment -- distance ) - [ sideways-heading ] [ sideways-relative-location ] - [ nip radius>> ] 2tri collision-coefficient ; - -: collision-vector ( oint segment -- v ) - dupd (distance-to-collision) swap forward>> n*v ; - -: bounce-forward ( segment oint -- ) - [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ; - -: bounce-left ( segment oint -- ) - #! must be done after forward - [ forward>> vneg ] dip [ left>> swap reflect ] - [ forward>> proj-perp normalize ] [ (>>left) ] tri ; - -: bounce-up ( segment oint -- ) - #! must be done after forward and left! - nip [ forward>> ] [ left>> cross ] [ (>>up) ] tri ; - -: bounce-off-wall ( oint segment -- ) - swap [ bounce-forward ] [ bounce-left ] [ bounce-up ] 2tri ; - diff --git a/unmaintained/lisp/authors.txt b/unmaintained/lisp/authors.txt deleted file mode 100644 index 4b7af4aac0..0000000000 --- a/unmaintained/lisp/authors.txt +++ /dev/null @@ -1 +0,0 @@ -James Cash diff --git a/unmaintained/lisp/lisp-docs.factor b/unmaintained/lisp/lisp-docs.factor deleted file mode 100644 index c970a1e0b7..0000000000 --- a/unmaintained/lisp/lisp-docs.factor +++ /dev/null @@ -1,22 +0,0 @@ -IN: lisp -USING: help.markup help.syntax ; -HELP: into factor quotations and calls it" } -{ $see-also lisp-string>factor } ; - -HELP: lisp-string>factor -{ $values { "str" "a string of lisp code" } { "quot" "the quotation the lisp compiles into" } } -{ $description "Turns a string of lisp into a factor quotation" } ; - -ARTICLE: "lisp" "Lisp in Factor" -"This is a simple implementation of a Lisp dialect, which somewhat resembles Scheme." $nl -"It works in two main stages: " -{ $list - { "Parse (via " { $vocab-link "lisp.parser" } " the Lisp code into a " - { $snippet "s-exp" } " tuple." } - { "Transform the " { $snippet "s-exp" } " into a Factor quotation, via " { $link convert-form } } -} - -{ $subsection "lisp.parser" } ; - -ABOUT: "lisp" \ No newline at end of file diff --git a/unmaintained/lisp/lisp-tests.factor b/unmaintained/lisp/lisp-tests.factor deleted file mode 100644 index 5f849c4416..0000000000 --- a/unmaintained/lisp/lisp-tests.factor +++ /dev/null @@ -1,94 +0,0 @@ -! Copyright (C) 2008 James Cash -! See http://factorcode.org/license.txt for BSD license. -USING: lisp lisp.parser tools.test sequences math kernel parser arrays lists -quotations ; - -IN: lisp.test - -[ - define-lisp-builtins - - { 5 } [ - "(+ 2 3)" lisp-eval - ] unit-test - - { 8.3 } [ - "(- 10.4 2.1)" lisp-eval - ] unit-test - - { 3 } [ - "((lambda (x y) (+ x y)) 1 2)" lisp-eval - ] unit-test - - { 42 } [ - "((lambda (x y z) (+ x (- y z))) 40 3 1)" lisp-eval - ] unit-test - - { "b" } [ - "(cond (#f \"a\") (#t \"b\"))" lisp-eval - ] unit-test - - { "b" } [ - "(cond ((< 1 2) \"b\") (#t \"a\"))" lisp-eval - ] unit-test - - { +nil+ } [ - "(list)" lisp-eval - ] unit-test - - { { 1 2 3 4 5 } } [ - "(list 1 2 3 4 5)" lisp-eval list>seq - ] unit-test - - { { 1 2 { 3 { 4 } 5 } } } [ - "(list 1 2 (list 3 (list 4) 5))" lisp-eval cons>seq - ] unit-test - - { 5 } [ - "(begin (+ 1 4))" lisp-eval - ] unit-test - - { 5 } [ - "(begin (+ 5 6) (+ 1 4))" lisp-eval - ] unit-test - - { t } [ - T{ lisp-symbol f "if" } lisp-macro? - ] unit-test - - { 1 } [ - "(if #t 1 2)" lisp-eval - ] unit-test - - { 3 } [ - "((lambda (x) (if x (+ 1 2) (- 3 5))) #t)" lisp-eval - ] unit-test - - { { 5 4 3 } } [ - "((lambda (x &rest xs) (cons x xs)) 5 4 3)" lisp-eval cons>seq - ] unit-test - - { { 5 } } [ - "((lambda (x &rest xs) (cons x xs)) 5)" lisp-eval cons>seq - ] unit-test - - { { 1 2 3 4 } } [ - "((lambda (&rest xs) xs) 1 2 3 4)" lisp-eval cons>seq - ] unit-test - - { 10 } [ - - ] unit-test - - { 4 } [ - - ] unit-test - - { { 3 3 4 } } [ - cons>seq - ] unit-test - -] with-interactive-vocabs diff --git a/unmaintained/lisp/lisp.factor b/unmaintained/lisp/lisp.factor deleted file mode 100644 index 4a933501e8..0000000000 --- a/unmaintained/lisp/lisp.factor +++ /dev/null @@ -1,178 +0,0 @@ -! Copyright (C) 2008 James Cash -! See http://factorcode.org/license.txt for BSD license. -USING: kernel peg sequences arrays strings -namespaces combinators math locals locals.private locals.backend accessors -vectors syntax lisp.parser assocs parser words -quotations fry lists summary combinators.short-circuit continuations multiline ; -IN: lisp - -DEFER: convert-form -DEFER: funcall -DEFER: lookup-var -DEFER: lookup-macro -DEFER: lisp-macro? -DEFER: lisp-var? -DEFER: define-lisp-macro - -! Functions to convert s-exps to quotations -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: convert-body ( cons -- quot ) - [ ] [ convert-form compose ] foldl ; inline - -: convert-cond ( cons -- quot ) - cdr [ 2car [ convert-form ] bi@ 2array ] - { } lmap-as '[ _ cond ] ; - -: convert-general-form ( cons -- quot ) - uncons [ convert-body ] [ convert-form ] bi* '[ _ @ funcall ] ; - -! words for convert-lambda -> _ at ] [ ] bi or ] traverse ] } - { [ dup lisp-symbol? ] [ name>> swap at ] } - [ nip ] - } cond ; - -: localize-lambda ( body vars -- newvars newbody ) - swap [ make-locals dup push-locals ] dip - dupd [ localize-body convert-form ] with lmap>array - >quotation swap pop-locals ; - -: split-lambda ( cons -- body-cons vars-seq ) - cdr uncons [ name>> ] lmap>array ; inline - -: rest-lambda ( body vars -- quot ) - "&rest" swap [ remove ] [ index ] 2bi - [ localize-lambda lambda-rewrite call ] dip - swap '[ _ cut '[ @ _ seq>list ] call _ call call ] 1quotation ; - -: normal-lambda ( body vars -- quot ) - localize-lambda lambda-rewrite '[ @ compose call call ] 1quotation ; -PRIVATE> - -: convert-lambda ( cons -- quot ) - split-lambda "&rest" over member? [ rest-lambda ] [ normal-lambda ] if ; - -: convert-quoted ( cons -- quot ) - cadr 1quotation ; - -: convert-defmacro ( cons -- quot ) - cdr [ convert-lambda ] [ car name>> ] bi define-lisp-macro [ ] ; - -: macro-expand ( cons -- quot ) - uncons [ list>seq >quotation ] [ lookup-macro ] bi* call call ; - -: expand-macros ( cons -- cons ) - dup list? [ [ expand-macros ] lmap dup car lisp-macro? [ macro-expand expand-macros ] when ] when ; - -: convert-begin ( cons -- quot ) - cdr [ convert-form ] [ ] lmap-as [ 1 tail* ] [ but-last ] bi - [ '[ { } _ with-datastack drop ] ] map prepend '[ _ [ call ] each ] ; - -: form-dispatch ( cons lisp-symbol -- quot ) - name>> - { { "lambda" [ convert-lambda ] } - { "defmacro" [ convert-defmacro ] } - { "quote" [ convert-quoted ] } - { "cond" [ convert-cond ] } - { "begin" [ convert-begin ] } - [ drop convert-general-form ] - } case ; - -: convert-list-form ( cons -- quot ) - dup car - { - { [ dup lisp-symbol? ] [ form-dispatch ] } - [ drop convert-general-form ] - } cond ; - -: convert-form ( lisp-form -- quot ) - { - { [ dup cons? ] [ convert-list-form ] } - { [ dup lisp-var? ] [ lookup-var 1quotation ] } - { [ dup lisp-symbol? ] [ '[ _ lookup-var ] ] } - [ 1quotation ] - } cond ; - -: lisp-string>factor ( str -- quot ) - lisp-expr expand-macros convert-form ; - -: lisp-eval ( str -- * ) - lisp-string>factor call ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: lisp-env -SYMBOL: macro-env - -ERROR: no-such-var variable-name ; -M: no-such-var summary drop "No such variable" ; - -: init-env ( -- ) - H{ } clone lisp-env set - H{ } clone macro-env set ; - -: lisp-define ( quot name -- ) - lisp-env get set-at ; - -: define-lisp-var ( lisp-symbol body -- ) - swap name>> lisp-define ; - -: lisp-get ( name -- word ) - lisp-env get at ; - -: lookup-var ( lisp-symbol -- quot ) - [ name>> ] [ lisp-var? ] bi [ lisp-get ] [ no-such-var ] if ; - -: lisp-var? ( lisp-symbol -- ? ) - dup lisp-symbol? [ name>> lisp-env get key? ] [ drop f ] if ; - -: funcall ( quot sym -- * ) - [ 1array [ call ] with-datastack >quotation ] dip curry call ; inline - -: define-primitive ( name vocab word -- ) - swap lookup 1quotation '[ _ compose call ] swap lisp-define ; - -: lookup-macro ( lisp-symbol -- lambda ) - name>> macro-env get at ; - -: define-lisp-macro ( quot name -- ) - macro-env get set-at ; - -: lisp-macro? ( car -- ? ) - dup lisp-symbol? [ name>> macro-env get key? ] [ drop f ] if ; - -: define-lisp-builtins ( -- ) - init-env - - f "#f" lisp-define - t "#t" lisp-define - - "+" "math" "+" define-primitive - "-" "math" "-" define-primitive - "<" "math" "<" define-primitive - ">" "math" ">" define-primitive - - "cons" "lists" "cons" define-primitive - "car" "lists" "car" define-primitive - "cdr" "lists" "cdr" define-primitive - "append" "lists" "lappend" define-primitive - "nil" "lists" "nil" define-primitive - "nil?" "lists" "nil?" define-primitive - - "set" "lisp" "define-lisp-var" define-primitive - - "(set 'list (lambda (&rest xs) xs))" lisp-eval - "(defmacro setq (var val) (list 'set (list 'quote var) val))" lisp-eval - - <" (defmacro defun (name vars &rest body) - (list 'setq name (cons 'lambda (cons vars body)))) "> lisp-eval - - "(defmacro if (pred tr fl) (list 'cond (list pred tr) (list (quote #t) fl)))" lisp-eval - ; - -: " parse-multiline-string "(begin " prepend ")" append define-lisp-builtins - lisp-string>factor parsed \ call parsed ; parsing \ No newline at end of file diff --git a/unmaintained/lisp/parser/authors.txt b/unmaintained/lisp/parser/authors.txt deleted file mode 100644 index 4b7af4aac0..0000000000 --- a/unmaintained/lisp/parser/authors.txt +++ /dev/null @@ -1 +0,0 @@ -James Cash diff --git a/unmaintained/lisp/parser/parser-docs.factor b/unmaintained/lisp/parser/parser-docs.factor deleted file mode 100644 index fc16a0a310..0000000000 --- a/unmaintained/lisp/parser/parser-docs.factor +++ /dev/null @@ -1,6 +0,0 @@ -IN: lisp.parser -USING: help.markup help.syntax ; - -ARTICLE: "lisp.parser" "Parsing strings of Lisp" -"This vocab uses " { $vocab-link "peg.ebnf" } " to turn strings of Lisp into " { $snippet "s-exp" } "s, which are then used by" -{ $vocab-link "lisp" } " to produce Factor quotations." ; \ No newline at end of file diff --git a/unmaintained/lisp/parser/parser-tests.factor b/unmaintained/lisp/parser/parser-tests.factor deleted file mode 100644 index 911a8d3440..0000000000 --- a/unmaintained/lisp/parser/parser-tests.factor +++ /dev/null @@ -1,80 +0,0 @@ -! Copyright (C) 2008 James Cash -! See http://factorcode.org/license.txt for BSD license. -USING: lisp.parser tools.test peg peg.ebnf lists ; - -IN: lisp.parser.tests - -{ 1234 } [ - "1234" "atom" \ lisp-expr rule parse -] unit-test - -{ -42 } [ - "-42" "atom" \ lisp-expr rule parse -] unit-test - -{ 37/52 } [ - "37/52" "atom" \ lisp-expr rule parse -] unit-test - -{ 123.98 } [ - "123.98" "atom" \ lisp-expr rule parse -] unit-test - -{ "" } [ - "\"\"" "atom" \ lisp-expr rule parse -] unit-test - -{ "aoeu" } [ - "\"aoeu\"" "atom" \ lisp-expr rule parse -] unit-test - -{ "aoeu\"de" } [ - "\"aoeu\\\"de\"" "atom" \ lisp-expr rule parse -] unit-test - -{ T{ lisp-symbol f "foobar" } } [ - "foobar" "atom" \ lisp-expr rule parse -] unit-test - -{ T{ lisp-symbol f "+" } } [ - "+" "atom" \ lisp-expr rule parse -] unit-test - -{ +nil+ } [ - "()" lisp-expr -] unit-test - -{ T{ - cons - f - T{ lisp-symbol f "foo" } - T{ - cons - f - 1 - T{ cons f 2 T{ cons f "aoeu" +nil+ } } - } } } [ - "(foo 1 2 \"aoeu\")" lisp-expr -] unit-test - -{ T{ cons f - 1 - T{ cons f - T{ cons f 3 T{ cons f 4 +nil+ } } - T{ cons f 2 +nil+ } } - } -} [ - "(1 (3 4) 2)" lisp-expr -] unit-test - -{ { T{ lisp-symbol { name "quote" } } { 1 2 3 } } } [ - "'(1 2 3)" lisp-expr cons>seq -] unit-test - -{ { T{ lisp-symbol f "quote" } T{ lisp-symbol f "foo" } } } [ - "'foo" lisp-expr cons>seq -] unit-test - -{ { 1 2 { T{ lisp-symbol { name "quote" } } { 3 4 } } 5 } } [ - "(1 2 '(3 4) 5)" lisp-expr cons>seq -] unit-test \ No newline at end of file diff --git a/unmaintained/lisp/parser/parser.factor b/unmaintained/lisp/parser/parser.factor deleted file mode 100644 index 50f58692d5..0000000000 --- a/unmaintained/lisp/parser/parser.factor +++ /dev/null @@ -1,41 +0,0 @@ -! Copyright (C) 2008 James Cash -! See http://factorcode.org/license.txt for BSD license. -USING: kernel peg peg.ebnf math.parser sequences arrays strings -math fry accessors lists combinators.short-circuit ; - -IN: lisp.parser - -TUPLE: lisp-symbol name ; -C: lisp-symbol - -EBNF: lisp-expr -_ = (" " | "\t" | "\n")* -LPAREN = "(" -RPAREN = ")" -dquote = '"' -squote = "'" -digit = [0-9] -integer = ("-")? (digit)+ => [[ first2 append string>number ]] -float = integer "." (digit)* => [[ first3 >string [ number>string ] 2dip 3append string>number ]] -rational = integer "/" (digit)+ => [[ first3 nip string>number / ]] -number = float - | rational - | integer -id-specials = "!" | "$" | "%" | "&" | "*" | "/" | ":" - | "<" | "#" | " =" | ">" | "?" | "^" | "_" - | "~" | "+" | "-" | "." | "@" -letters = [a-zA-Z] => [[ 1array >string ]] -initials = letters | id-specials -numbers = [0-9] => [[ 1array >string ]] -subsequents = initials | numbers -identifier = initials (subsequents)* => [[ first2 concat append ]] -escaped = "\" . => [[ second ]] -string = dquote ( escaped | !(dquote) . )* dquote => [[ second >string ]] -atom = number - | identifier - | string -s-expression = LPAREN (list-item)* RPAREN => [[ second seq>cons ]] -list-item = _ ( atom | s-expression | quoted ) _ => [[ second ]] -quoted = squote list-item => [[ second nil cons "quote" swap cons ]] -expr = list-item -;EBNF \ No newline at end of file diff --git a/unmaintained/lisp/parser/summary.txt b/unmaintained/lisp/parser/summary.txt deleted file mode 100644 index aa407b3dfb..0000000000 --- a/unmaintained/lisp/parser/summary.txt +++ /dev/null @@ -1 +0,0 @@ -EBNF grammar for parsing Lisp diff --git a/unmaintained/lisp/parser/tags.txt b/unmaintained/lisp/parser/tags.txt deleted file mode 100644 index d1f6fa1ef3..0000000000 --- a/unmaintained/lisp/parser/tags.txt +++ /dev/null @@ -1,2 +0,0 @@ -lisp -parsing diff --git a/unmaintained/lisp/summary.txt b/unmaintained/lisp/summary.txt deleted file mode 100644 index 7277c2a5b5..0000000000 --- a/unmaintained/lisp/summary.txt +++ /dev/null @@ -1 +0,0 @@ -A Lisp interpreter/compiler in Factor diff --git a/unmaintained/lisp/tags.txt b/unmaintained/lisp/tags.txt deleted file mode 100644 index c369ccae57..0000000000 --- a/unmaintained/lisp/tags.txt +++ /dev/null @@ -1,2 +0,0 @@ -lisp -languages diff --git a/unmaintained/mad/api/api.factor b/unmaintained/mad/api/api.factor deleted file mode 100644 index fdc2903d46..0000000000 --- a/unmaintained/mad/api/api.factor +++ /dev/null @@ -1,95 +0,0 @@ -! Copyright (C) 2007 Adam Wendt. -! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types byte-arrays io io.binary io.files kernel mad - namespaces prettyprint sbufs sequences tools.interpreter vars - io.encodings.binary ; -IN: mad.api - -VARS: buffer-start buffer-length output-callback-var ; - -: create-mad-callback-generic ( sequence parameters -- alien ) - swap >r >r "mad_flow" r> "cdecl" r> alien-callback ; inline - -: create-input-callback ( sequence -- alien ) - { "void*" "mad_stream*" } create-mad-callback-generic ; inline - -: create-header-callback ( sequence -- alien ) - { "void*" "mad_header*" } create-mad-callback-generic ; inline - -: create-filter-callback ( sequence -- alien ) - { "void*" "mad_stream*" "mad_frame*" } create-mad-callback-generic ; inline - -: create-output-callback ( sequence -- alien ) - { "void*" "mad_header*" "mad_pcm*" } create-mad-callback-generic ; inline - -: create-error-callback ( sequence -- alien ) - { "void*" "mad_stream*" "mad_frame*" } create-mad-callback-generic ; inline - -: create-message-callback ( sequence -- alien ) - { "void*" "void*" "uint*" } create-mad-callback-generic ; inline - -: input ( buffer mad_stream -- mad_flow ) - "input" print flush - nip ! mad_stream - buffer-start get ! mad_stream start - buffer-length get ! mad_stream start length - dup 0 = ! mad-stream start length bool - [ 3drop MAD_FLOW_STOP ] ! mad_flow - [ mad_stream_buffer ! - 0 buffer-length set ! - MAD_FLOW_CONTINUE ] if ; ! mad_flow - -: input-callback ( -- callback ) - [ input ] create-input-callback ; - -: header-callback ( -- callback ) - [ "header" print flush drop drop MAD_FLOW_CONTINUE ] create-header-callback ; - -: filter-callback ( -- callback ) - [ "filter" print flush 3drop MAD_FLOW_CONTINUE ] create-filter-callback ; - -: write-sample ( sample -- ) - 4 >le write ; - -: output ( data header pcm -- mad_flow ) - "output" . flush - -rot 2drop output-callback-var> call - [ MAD_FLOW_CONTINUE ] [ MAD_FLOW_STOP ] if ; - -: output-stdout ( pcm -- ? ) - [ mad_pcm-channels ] keep - [ mad_pcm-length ] keep swap - [ - [ mad_pcm-sample-right ] 2keep - [ mad_pcm-sample-left ] 2keep - drop -rot write-sample pick - 2 = [ write-sample ] [ drop ] if - ] each drop t ; - -: output-callback ( -- callback ) - [ output ] create-output-callback ; - -: error-callback ( -- callback ) - [ "error" print flush drop drop drop MAD_FLOW_CONTINUE ] create-error-callback ; - -: message-callback ( -- callback ) - [ "message" print flush drop drop drop MAD_FLOW_CONTINUE ] create-message-callback ; - -: mad-init ( decoder -- ) - 0 input-callback 0 0 output-callback error-callback message-callback mad_decoder_init ; - -: make-decoder ( -- decoder ) - "mad_decoder" malloc-object ; - -: mad-run ( -- int ) - make-decoder [ mad-init ] keep MAD_DECODER_MODE_SYNC mad_decoder_run ; - -: init-vars ( alien length -- ) - buffer-length set buffer-start set ; - -: decode-mp3 ( filename -- results ) - [ malloc-file-contents ] keep file-length init-vars mad-run ; - -: mad-test ( -- results ) - [ output-stdout ] >output-callback-var - "/home/adam/download/mp3/Misc/wutbf.mp3" decode-mp3 ; diff --git a/unmaintained/mad/api/authors.txt b/unmaintained/mad/api/authors.txt deleted file mode 100755 index bbc876e7b6..0000000000 --- a/unmaintained/mad/api/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Adam Wendt diff --git a/unmaintained/mad/authors.txt b/unmaintained/mad/authors.txt deleted file mode 100644 index bbc876e7b6..0000000000 --- a/unmaintained/mad/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Adam Wendt diff --git a/unmaintained/mad/mad-tests.factor b/unmaintained/mad/mad-tests.factor deleted file mode 100644 index c53b14f6bf..0000000000 --- a/unmaintained/mad/mad-tests.factor +++ /dev/null @@ -1,12 +0,0 @@ -! Copyright (C) 2007 Adam Wendt. -! See http://factorcode.org/license.txt for BSD license. -! -IN: temporary - -USING: kernel mad mad.api alien alien.c-types tools.test -namespaces ; - -: setup-buffer ( -- ) - 0 buffer-start set 0 buffer-length set ; - -[ t ] [ 0 "mad_stream" malloc-object setup-buffer input MAD_FLOW_STOP = ] unit-test diff --git a/unmaintained/mad/mad.factor b/unmaintained/mad/mad.factor deleted file mode 100644 index ce65c066b4..0000000000 --- a/unmaintained/mad/mad.factor +++ /dev/null @@ -1,156 +0,0 @@ -! Copyright (C) 2007 Adam Wendt. -! See http://factorcode.org/license.txt for BSD license. -! -USING: alien alien.c-types alien.syntax combinators kernel math system ; -IN: mad - -<< "mad" { - { [ macosx? ] [ "libmad.0.dylib" ] } - { [ unix? ] [ "libmad.so" ] } - { [ windows? ] [ "mad.dll" ] } - } cond "cdecl" add-library >> - -LIBRARY: mad - -TYPEDEF: int mad_fixed_t -TYPEDEF: int mad_fixed64hi_t -TYPEDEF: uint mad_fixed64lo_t - -TYPEDEF: int mad_flow -TYPEDEF: int mad_decoder_mode -TYPEDEF: int mad_error -TYPEDEF: int mad_layer -TYPEDEF: int mad_mode -TYPEDEF: int mad_emphasis - -C-STRUCT: mad_timer_t - { "long" "seconds" } - { "ulong" "fraction" } -; - -C-STRUCT: mad_bitptr - { "uchar*" "byte" } - { "short" "cache" } - { "short" "left" } -; - -C-STRUCT: mad_stream - { "uchar*" "buffer" } - { "uchar*" "buffend" } - { "long" "skiplen" } - { "int" "sync" } - { "ulong" "freerate" } - { "uchar*" "this_frame" } - { "uchar*" "next_frame" } - { "mad_bitptr" "ptr" } - { "mad_bitptr" "anc_ptr" } - { "uchar*" "main_data" } - { "int" "md_len" } - { "int" "options" } - { "mad_error" "error" } -; - -C-STRUCT: struct_async - { "long" "pid" } - { "int" "in" } - { "int" "out" } -; - -C-STRUCT: mad_header - { "mad_layer" "layer" } - { "mad_mode" "mode" } - { "int" "mode_extension" } - { "mad_emphasis" "emphasis" } - { "ulong" "bitrate" } - { "uint" "samplerate" } - { "ushort" "crc_check" } - { "ushort" "crc_target" } - { "int" "flags" } - { "int" "private_bits" } - { "mad_timer_t" "duration" } -; - -C-STRUCT: mad_frame - { "mad_header" "header" } - { "int" "options" } - { { "mad_fixed_t" 2304 } "sbsample" } - { "mad_fixed_t*" "overlap" } -; - -C-STRUCT: mad_pcm - { "uint" "samplerate" } - { "ushort" "channels" } - { "ushort" "length" } - { { "mad_fixed_t" 2304 } "samples" } -; - -: mad_pcm-sample-left ( pcm int -- sample ) - swap mad_pcm-samples int-nth ; -: mad_pcm-sample-right ( pcm int -- sample ) - 1152 + swap mad_pcm-samples int-nth ; - -C-STRUCT: mad_synth - { { "mad_fixed_t" 1024 } "filter" } - { "uint" "phase" } - { "mad_pcm" "pcm" } -; - -C-STRUCT: struct_sync - { "mad_stream" "stream" } - { "mad_frame" "frame" } - { "mad_synth" "synth" } -; - -C-STRUCT: mad_decoder - { "mad_decoder_mode" "mode" } - { "int" "options" } - { "struct_async" "async" } - { "struct_sync*" "sync" } - { "void*" "cb_data" } - { "void*" "input_func" } - { "void*" "header_func" } - { "void*" "filter_func" } - { "void*" "output_func" } - { "void*" "error_func" } - { "void*" "message_func" } -; - -: MAD_F_FRACBITS ( -- number ) 28 ; inline -: MAD_F_ONE HEX: 10000000 ; - -: MAD_DECODER_MODE_SYNC ( -- number ) HEX: 0 ; inline -: MAD_DECODER_MODE_ASYNC ( -- number ) HEX: 1 ; inline - -: MAD_FLOW_CONTINUE ( -- number ) HEX: 0 ; inline -: MAD_FLOW_STOP ( -- number ) HEX: 10 ; inline -: MAD_FLOW_BREAK ( -- number ) HEX: 11 ; inline -: MAD_FLOW_IGNORE ( -- number ) HEX: 20 ; inline - -: MAD_ERROR_NONE ( -- number ) HEX: 0 ; inline -: MAD_ERROR_BUFLEN ( -- number ) HEX: 1 ; inline -: MAD_ERROR_BUFPTR ( -- number ) HEX: 2 ; inline -: MAD_ERROR_NOMEM ( -- number ) HEX: 31 ; inline -: MAD_ERROR_LOSTSYNC ( -- number ) HEX: 101 ; inline -: MAD_ERROR_BADLAYER ( -- number ) HEX: 102 ; inline -: MAD_ERROR_BADBITRATE ( -- number ) HEX: 103 ; inline -: MAD_ERROR_BADSAMPLERATE ( -- number ) HEX: 104 ; inline -: MAD_ERROR_BADEMPHASIS ( -- number ) HEX: 105 ; inline -: MAD_ERROR_BADCRC ( -- number ) HEX: 201 ; inline -: MAD_ERROR_BADBITALLOC ( -- number ) HEX: 211 ; inline -: MAD_ERROR_BADSCALEFACTOR ( -- number ) HEX: 221 ; inline -: MAD_ERROR_BADMODE ( -- number ) HEX: 222 ; inline -: MAD_ERROR_BADFRAMELEN ( -- number ) HEX: 231 ; inline -: MAD_ERROR_BADBIGVALUES ( -- number ) HEX: 232 ; inline -: MAD_ERROR_BADBLOCKTYPE ( -- number ) HEX: 233 ; inline -: MAD_ERROR_BADSCFSI ( -- number ) HEX: 234 ; inline -: MAD_ERROR_BADDATAPTR ( -- number ) HEX: 235 ; inline -: MAD_ERROR_BADPART3LEN ( -- number ) HEX: 236 ; inline -: MAD_ERROR_BADHUFFTABLE ( -- number ) HEX: 237 ; inline -: MAD_ERROR_BADHUFFDATA ( -- number ) HEX: 238 ; inline -: MAD_ERROR_BADSTEREO ( -- number ) HEX: 239 ; inline - - -FUNCTION: void mad_decoder_init ( mad_decoder* decoder, void* data, void* input_func, void* header_func, void* filter_func, void* output_func, void* error_func, void* message_func ) ; -FUNCTION: int mad_decoder_run ( mad_decoder* decoder, mad_decoder_mode mode ) ; -FUNCTION: void mad_stream_buffer ( mad_stream* stream, uchar* start, ulong length ) ; - diff --git a/unmaintained/mad/player/authors.txt b/unmaintained/mad/player/authors.txt deleted file mode 100755 index bbc876e7b6..0000000000 --- a/unmaintained/mad/player/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Adam Wendt diff --git a/unmaintained/mad/player/player.factor b/unmaintained/mad/player/player.factor deleted file mode 100644 index 3d0b1c16c2..0000000000 --- a/unmaintained/mad/player/player.factor +++ /dev/null @@ -1,58 +0,0 @@ -! Copyright (C) 2007 Adam Wendt. -! See http://factorcode.org/license.txt for BSD license. -! -USING: alien.c-types io kernel libc mad mad.api math namespaces openal prettyprint sequences tools.interpreter vars ; -IN: mad.player - -VARS: openal-buffer ; - -: get-format ( pcm -- format ) - mad_pcm-channels 2 = - [ AL_FORMAT_STEREO16 ] [ AL_FORMAT_MONO16 ] if ; - -: no-error? ( -- ? ) - alGetError dup . flush AL_NO_ERROR = ; - -: round ( sample -- rounded ) - 1 MAD_F_FRACBITS 16 - shift + ; - -: clip ( sample -- clipped ) MAD_F_ONE 1- min MAD_F_ONE neg max ; - -: quantize ( sample -- quantized ) - MAD_F_FRACBITS 1+ 16 - neg shift ; - -: scale-sample ( sample -- scaled ) - round clip quantize ; - -: get-needed-size ( pcm -- size ) - [ mad_pcm-channels ] keep mad_pcm-length 2 * * ; - -: make-data ( pcm -- ) - [ mad_pcm-channels ] keep ! channels pcm - [ mad_pcm-length ] keep swap ! channels pcm length - [ ! channels pcm counter - [ mad_pcm-sample-right ] 2keep ! channels right pcm counter - [ mad_pcm-sample-left ] 2keep ! channels right left pcm counter - drop -rot scale-sample , pick ! channels pcm right channels - 2 = [ scale-sample , ] [ drop ] if ! channels pcm right - ] each 2drop ; - -: array>alien ( alien array -- ) dup length [ pick set-int-nth ] 2each drop ; - -: fill-data ( pcm alien -- ) - swap [ make-data ] { } make array>alien ; - -: get-data ( pcm -- size alien ) - [ get-needed-size ] keep over - malloc [ fill-data ] keep ; - -: output-openal ( pcm -- ? ) - openal-buffer> swap ! buffer pcm - [ get-format ] keep ! buffer format pcm - [ get-data ] keep ! buffer format size alien pcm - mad_pcm-samplerate ! buffer format size alien samplerate - swapd alBufferData no-error? - ; - -: play-mp3 ( filename -- ) - gen-buffer >openal-buffer [ output-openal ] >output-callback-var decode-mp3 ; diff --git a/unmaintained/mad/summary.txt b/unmaintained/mad/summary.txt deleted file mode 100644 index a9a902032d..0000000000 --- a/unmaintained/mad/summary.txt +++ /dev/null @@ -1 +0,0 @@ -libmad MP3 library binding diff --git a/unmaintained/mortar/authors.txt b/unmaintained/mortar/authors.txt deleted file mode 100644 index 6cfd5da273..0000000000 --- a/unmaintained/mortar/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/mortar/mortar.factor b/unmaintained/mortar/mortar.factor deleted file mode 100755 index 1842b9a1e2..0000000000 --- a/unmaintained/mortar/mortar.factor +++ /dev/null @@ -1,182 +0,0 @@ - -USING: kernel io parser lexer words namespaces quotations arrays assocs sequences - splitting grouping math generalizations ; - -IN: mortar - -! class { name slots methods class-methods } - -: class-name ( class -- name ) dup symbol? [ get ] when first ; - -: class-slots ( class -- slots ) dup symbol? [ get ] when second ; - -: class-methods ( class -- methods ) dup symbol? [ get ] when third ; - -: class-class-methods ( class -- methods ) dup symbol? [ get ] when fourth ; - -: class? ( thing -- ? ) -dup array? -[ dup length 4 = [ first symbol? ] [ drop f ] if ] -[ drop f ] -if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: add-method ( class name quot -- ) -rot get class-methods peek swapd set-at ; - -: add-class-method ( class name quot -- ) -rot get class-class-methods peek swapd set-at ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! object { class values } - -: object-class ( object -- class ) first ; - -: object-values ( object -- values ) second ; - -: object? ( thing -- ? ) -dup array? -[ dup length 2 = [ first class? ] [ drop f ] if ] -[ drop f ] -if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: is? ( object class -- ? ) swap object-class class-name = ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: new ( class -- object ) -get dup >r class-slots length narray r> swap 2array ; - -: new-empty ( class -- object ) -get dup >r class-slots length f r> swap 2array ; - -! : new* ( class -- object ) new-empty <- init ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: slot-value ( object slot -- value ) -over object-class class-slots index swap object-values nth ; - -: set-slot-value ( object slot value -- object ) -swap pick object-class class-slots index pick object-values set-nth ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! : send-message ( object message -- ) -! over object-class class-methods assoc-stack call ; - -: send-message ( object message -- ) -2dup swap object-class class-methods assoc-stack dup -[ nip call ] -! [ drop nip "message not understood: " write print flush ] -[ drop "message not understood: " write print drop ] -if ; - -: <- scan parsed \ send-message parsed ; parsing - -! : send-message* ( message n -- ) -! 1+ npick object-class class-methods assoc-stack call ; - -: send-message* ( message n -- ) -1+ npick dupd object-class class-methods assoc-stack dup -[ nip call ] -[ drop "message not understood: " write print flush ] -if ; - -: <-- scan parsed 2 parsed \ send-message* parsed ; parsing - -: <--- scan parsed 3 parsed \ send-message* parsed ; parsing - -: <---- scan parsed 4 parsed \ send-message* parsed ; parsing - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: send-message-to-class ( class message -- ) -over class-class-methods assoc-stack call ; - -: <<- scan parsed \ send-message-to-class parsed ; parsing - -: send-message-to-class* ( message n -- ) -1+ npick class-class-methods assoc-stack call ; - -: <<-- scan parsed 2 parsed \ send-message-to-class* parsed ; parsing - -: <<--- scan parsed 3 parsed \ send-message-to-class* parsed ; parsing - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: send-message-next ( object message -- ) -over object-class class-methods but-last assoc-stack call ; - -: <-~ scan parsed \ send-message-next parsed ; parsing - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! : new* ( class -- object ) <<- create ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -IN: slot-accessors - -IN: mortar - -! : generate-slot-getter ( name -- ) -! "$" over append "slot-accessors" create swap [ slot-value ] curry -! define-compound ; - -: generate-slot-getter ( name -- ) -"$" over append "slot-accessors" create swap [ slot-value ] curry define ; - -! : generate-slot-setter ( name -- ) -! ">>" over append "slot-accessors" create swap [ swap set-slot-value ] curry -! define-compound ; - -: generate-slot-setter ( name -- ) -">>" over append "slot-accessors" create swap [ swap set-slot-value ] curry -define ; - -: generate-slot-accessors ( name -- ) -dup -generate-slot-getter -generate-slot-setter ; - -: accessors ( seq -- seq ) dup peek [ generate-slot-accessors ] each ; parsing - -! : slots: -! ";" parse-tokens dup [ generate-slot-accessors ] each parsed ; parsing - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! : ( string -- symbol ) in get create dup define-symbol ; - -: empty-method-table ( -- array ) H{ } clone 1array ; - -! : define-simple-class ( name parent slots -- ) -! >r >r -! r> dup class-slots r> append -! swap dup class-methods empty-method-table append -! swap class-class-methods empty-method-table append -! 4array dup first set-global ; - -: define-simple-class ( name parent slots -- ) ->r dup class-slots r> append -swap dup class-methods empty-method-table append -swap class-class-methods empty-method-table append -4array dup first set-global ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: define-independent-class ( name slots -- ) -empty-method-table empty-method-table 4array dup first set-global ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: add-methods ( class seq -- ) 2 group [ first2 add-method ] with each ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: !( ")" parse-tokens drop ; parsing \ No newline at end of file diff --git a/unmaintained/mortar/sugar/sugar.factor b/unmaintained/mortar/sugar/sugar.factor deleted file mode 100644 index 04d2f6f651..0000000000 --- a/unmaintained/mortar/sugar/sugar.factor +++ /dev/null @@ -1,6 +0,0 @@ - -USING: mortar ; - -IN: mortar.sugar - -: new* ( class -- object ) <<- create ; \ No newline at end of file diff --git a/unmaintained/mortar/tags.txt b/unmaintained/mortar/tags.txt deleted file mode 100644 index f4274299b1..0000000000 --- a/unmaintained/mortar/tags.txt +++ /dev/null @@ -1 +0,0 @@ -extensions diff --git a/unmaintained/namespaces-lib/authors.txt b/unmaintained/namespaces-lib/authors.txt deleted file mode 100644 index 6cfd5da273..0000000000 --- a/unmaintained/namespaces-lib/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/namespaces-lib/lib-tests.factor b/unmaintained/namespaces-lib/lib-tests.factor deleted file mode 100755 index d3f5a12faa..0000000000 --- a/unmaintained/namespaces-lib/lib-tests.factor +++ /dev/null @@ -1 +0,0 @@ - diff --git a/unmaintained/namespaces-lib/lib.factor b/unmaintained/namespaces-lib/lib.factor deleted file mode 100755 index dfa4df245c..0000000000 --- a/unmaintained/namespaces-lib/lib.factor +++ /dev/null @@ -1,23 +0,0 @@ -USING: kernel namespaces namespaces.private quotations sequences - assocs.lib math.parser math generalizations locals mirrors - macros ; - -IN: namespaces.lib - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: save-namestack ( quot -- ) namestack slip set-namestack ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: set* ( val var -- ) namestack* set-assoc-stack ; - -: make-object ( quot class -- object ) - new [ swap bind ] keep ; inline - -: with-object ( object quot -- ) - [ ] dip bind ; inline diff --git a/unmaintained/namespaces-lib/summary.txt b/unmaintained/namespaces-lib/summary.txt deleted file mode 100644 index ec8129b6a7..0000000000 --- a/unmaintained/namespaces-lib/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Non-core namespace words diff --git a/unmaintained/namespaces-lib/tags.txt b/unmaintained/namespaces-lib/tags.txt deleted file mode 100644 index 42d711b32b..0000000000 --- a/unmaintained/namespaces-lib/tags.txt +++ /dev/null @@ -1 +0,0 @@ -collections diff --git a/unmaintained/obj/alist/alist.factor b/unmaintained/obj/alist/alist.factor deleted file mode 100644 index a4e8ebb7c8..0000000000 --- a/unmaintained/obj/alist/alist.factor +++ /dev/null @@ -1,11 +0,0 @@ - -USING: arrays sequences ; - -IN: obj.alist - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -PREDICATE: alist < sequence [ pair? ] all? ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - diff --git a/unmaintained/obj/examples/todo/todo.factor b/unmaintained/obj/examples/todo/todo.factor deleted file mode 100644 index 3d545479e9..0000000000 --- a/unmaintained/obj/examples/todo/todo.factor +++ /dev/null @@ -1,83 +0,0 @@ - -USING: kernel sequences sets combinators.cleave - obj obj.view obj.util obj.print ; - -IN: obj.examples.todo - -SYM: person types adjoin -SYM: todo types adjoin - -SYM: owners properties adjoin -SYM: eta properties adjoin -SYM: notes properties adjoin - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: slava { type person } define-object -SYM: doug { type person } define-object -SYM: ed { type person } define-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: compiler-bugs - { - type todo - owners { slava } - notes { - "Investitage FEP on Terrorist" - "Problem with cutler in VirtualBox?" - } - } -define-object - -SYM: remove-old-accessors-from-core - { - type todo - owners { slava } - } -define-object - -SYM: move-db-and-web-framework-to-basis - { - type todo - owners { slava } - } -define-object - -SYM: remove-old-accessors-from-basis - { - type todo - owners { doug ed } - } -define-object - -SYM: blas-on-bsd - { - type todo - owners { slava doug } - } -define-object - -SYM: multi-methods-backend - { - type todo - owners { slava } - } -define-object - -SYM: update-core-for-multi-methods { type todo owners { slava } } define-object -SYM: update-basis-for-multi-methods { type todo } define-object -SYM: update-extra-for-multi-methods { type todo } define-object - - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: todo-list ( -- ) - objects [ type -> todo = ] filter - [ { [ self -> ] [ owners -> ] [ eta -> ] } 1arr ] - map - { "ITEM" "OWNERS" "ETA" } prefix - print-table ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - diff --git a/unmaintained/obj/misc/misc.factor b/unmaintained/obj/misc/misc.factor deleted file mode 100644 index 06b3056ea0..0000000000 --- a/unmaintained/obj/misc/misc.factor +++ /dev/null @@ -1,8 +0,0 @@ - -USING: kernel namespaces sequences assocs sequences.deep obj ; - -IN: obj.misc - -: related ( obj -- seq ) - objects dupd remove [ get values flatten member? ] with filter ; - diff --git a/unmaintained/obj/obj.factor b/unmaintained/obj/obj.factor deleted file mode 100644 index a4af627926..0000000000 --- a/unmaintained/obj/obj.factor +++ /dev/null @@ -1,45 +0,0 @@ - -USING: kernel words namespaces arrays vectors hashtables - sequences assocs sets grouping - combinators.conditional - combinators.short-circuit - obj.util obj.alist ; - -IN: obj - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: properties ( -- properties ) V{ } ; - -SYM: self properties adjoin -SYM: type properties adjoin -SYM: title properties adjoin - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: types ( -- types ) V{ } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: >obj ( val -- obj ) [ symbol? ] [ get ] [ ] 1if ; - -: -> ( obj pro -- val ) swap >obj at ; - -PREDICATE: obj < alist { [ self -> ] [ type -> ] } 1&& ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: objects ( -- objects ) V{ } ; - -: define-object ( symbol table -- ) - 2 group >vector - self rot 2array prefix - dup dup self -> set-global - self -> objects adjoin ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -PREDICATE: ptr < symbol get obj? ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - diff --git a/unmaintained/obj/papers/papers.factor b/unmaintained/obj/papers/papers.factor deleted file mode 100644 index 46683ad997..0000000000 --- a/unmaintained/obj/papers/papers.factor +++ /dev/null @@ -1,178 +0,0 @@ - -USING: sets obj obj.util obj.view ; - -IN: obj.papers - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: title properties adjoin -SYM: abstract properties adjoin -SYM: authors properties adjoin -SYM: file properties adjoin -SYM: date properties adjoin -SYM: participants properties adjoin -SYM: description properties adjoin - -SYM: chapter properties adjoin -SYM: section properties adjoin -SYM: paragraph properties adjoin -SYM: content properties adjoin - -SYM: subjects properties adjoin -SYM: source properties adjoin - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: paper types adjoin -SYM: person types adjoin -SYM: event types adjoin - -SYM: excerpt types adjoin - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: bay-wei-chang { type person } define-object -SYM: chuck-moore { type person } define-object -SYM: craig-chambers { type person } define-object -SYM: david-ungar { type person } define-object -SYM: frank-g-halasz { type person } define-object -SYM: gerald-jay-sussman { type person } define-object -SYM: guy-lewis-steele-jr { type person } define-object -SYM: randall-b-smith { type person } define-object -SYM: randall-h-trigg { type person } define-object -SYM: robert-adams { type person } define-object -SYM: russell-noftsker { type person } define-object -SYM: thomas-p-moran { type person } define-object -SYM: urs-holzle { type person } define-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: programming-as-an-experience - { - type paper - title "Programming as an Experience: The Inspiration for Self" - abstract "The Self system attempts to integrate intellectual and non-intellectual aspects of programming to create an overall experience. The language semantics, user interface, and implementation each help create this integrated experience. The language semantics embed the programmer in a uniform world of simple ob jects that can be modified without appealing to definitions of abstractions. In a similar way, the graphical interface puts the user into a uniform world of tangible objects that can be directly manipulated and changed without switching modes. The implementation strives to support the world-of-objects illusion by minimiz ing perceptible pauses and by providing true source-level semantics without sac rificing performance. As a side benefit, it encourages factoring. Although we see areas that fall short of the vision, on the whole, the language, interface, and im plementation conspire so that the Self programmer lives and acts in a consistent and malleable world of objects." - authors { randall-b-smith david-ungar } - date 1995 - } -define-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: self-the-power-of-simplicity - { - type paper - title "Self: The Power of Simplicity" - abstract "Self is an object-oriented language for exploratory programming based on a small number of simple and concrete ideas: prototypes, slots, and behavior. Prototypes combine inheritance and instantiation to provide a framework that is simpler and more flexible than most object-oriented languages. Slots unite variables and procedures into a single construct. This permits the inheritance hierarchy to take over the function of lexical scoping in conventional languages. Finally, because Self does not distinguish state from behavior, it narrows the gaps between ordinary objects, procedures, and closures. Self's simplicity and expressiveness offer new insights into object-oriented computation." - authors { randall-b-smith david-ungar } - date 1987 - } -define-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: parents-are-shared-parts - { - type paper - title "Parents are Shared Parts: Inheritance and Encapsulation in Self" - abstract "The design of inheritance and encapsulation in Self, an object-oriented language based on prototypes, results from understanding that inheritance allows parents to be shared parts of their children. The programmer resolves ambiguities arising from multiple inheritance by prioritizing an object's parents. Unifying unordered and ordered multiple inheritance supports differential programming of abstractions and methods, combination of unrelated abstractions, unequal combination of abstractions, and mixins. In Self, a private slot may be accessed if the sending method is a shared part of the receiver, allowing privileged communication between related objects. Thus, classless Self enjoys the benefits of class-based encapsulation." - authors { craig-chambers david-ungar bay-wei-chang urs-holzle } - date 1991 - } -define-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: organizing-programs-without-classes - { - type paper - title "Organizing Programs Without Classes" - abstract "All organizational functions carried out by classes can be accomplished in a simple and natural way by object inheritance in classless languages, with no need for special mechanisms. A single model--dividing types into prototypes and traits--supports sharing of behavior and extending or replacing representations. A natural extension, dynamic object inheritance, can model behavioral modes. Object inheritance can also be used to provide structured name spaces for well-known objects. Classless languages can even express 'class-based' encapsulation. These stylized uses of object inheritance become instantly recognizable idioms, and extend the repertory of organizing principles to cover a wider range of programs." - authors { david-ungar craig-chambers bay-wei-chang urs-holzle } - date 1991 - } -define-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: scheme-an-interpreter-for-extended-lambda-calculus - { - type paper - title "Scheme: An Interpreter for Extended Lambda Calculus" - abstract "Inspired by ACTORS [Greif and Hewitt] [Smith and Hewitt], we have implemented an interpreter for a LISP-like language, SCHEME, based on the lambda calculus [Church], but extended for side effects, multiprocessing, and process synchronization. The purpose of this implementation is tutorial. We wish to: (1) alleviate the confusion caused by Micro-PLANNER, CONNIVER, etc. by clarifying the embedding of non-recursive control structures in a recursive host language like LISP. (2) explain how to use these control structures, independent of such issues as pattern matching and data base manipulation. (3) have a simple concrete experimental domain for certain issues of programming semantics and style." - authors { gerald-jay-sussman guy-lewis-steele-jr } - date 1975 - } -define-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: symbolics-is-founded - { - type event - participants { russell-noftsker robert-adams } - date 1980 - } -define-object - -SYM: symbolics-funding-from-gi - { - type event - description "Symbolics receives $500,000 from General Instruments" - date 1982 - } -define-object - -SYM: symbolics-files-for-bankruptcy - { - type event - date "1993-01-28" - } -define-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: the-evolution-of-forth - { - type paper - title "The Evolution of Forth" - authors { chuck-moore "elizabeth-d-rather" "donald-r-colburn" } - abstract - "Forth is unique among programming languages in that its development and proliferation has been a grass-roots effort unsupported by any major corporate or academic sponsors. Originally conceived and developed by a single individual, its later development has progressed under two significant influences: professional programmers who developed tools to solve application problems and then commercialized them, and the interests of hobbyists concerned with free distribution of Forth. These influences have produced a language markedly different from traditional programming languages." - date 1993 - } -define-object - -SYM: first-complete-stand-alone-forth - { - type event - participants { chuck-moore } - date 1971 - } -define-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: notecards-in-a-nutshell - { - type paper - authors { frank-g-halasz thomas-p-moran randall-h-trigg } - date 1987 - } -define-object - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYM: the-evolution-of-forth-excerpt-2-1-1 - { - type excerpt - source the-evolution-of-forth - chapter 2 - section 1 - paragraph 1 - content - "Moore developed the first complete, stand-alone implementation of Forth in 1971 for the 11-meter radio telescope operated by the National Radio Astronomy Observatory (NRAO) at Kitt Peak, Arizona. This system ran on two early minicomputers (a 16 KB DDP-116 and a 32 KB H316) joined by a serial link. Both a multiprogrammed system and a multiprocessor system (in that both computers shared responsibility for controlling the telescope and its scientific instruments), it was responsible for pointing and tracking the telescope, collecting data and recording it on magnetic tape, and supporting an interactive graphics terminal on which an astronomer could analyze previously recorded data. The multiprogrammed nature of the system allowed all these functions to be performed concurrently, without timing conflicts or other interference." - subjects { chuck-moore first-complete-stand-alone-forth } - } -define-object - diff --git a/unmaintained/obj/print/print.factor b/unmaintained/obj/print/print.factor deleted file mode 100644 index 000e161387..0000000000 --- a/unmaintained/obj/print/print.factor +++ /dev/null @@ -1,37 +0,0 @@ - -USING: kernel arrays strings sequences assocs io io.styles prettyprint colors - combinators.conditional ; - -IN: obj.print - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: write-wrapped ( string -- ) H{ { wrap-margin 500 } } [ write ] with-nesting ; - -! : print-elt ( val -- ) -! { -! { [ string? ] [ write-wrapped ] } -! { [ array? ] [ [ . ] each ] } -! { [ drop t ] [ . ] } -! } -! 1cond ; - -USING: accessors vocabs help.markup ; - -: print-elt ( val -- ) - { - { [ vocab? ] [ [ name>> ] [ ] bi write-object ] } - { [ string? ] [ write-wrapped ] } - { [ array? ] [ [ . ] each ] } - { [ drop t ] [ . ] } - } - 1cond ; - -: print-grid ( grid -- ) - H{ { table-gap { 10 10 } } { table-border T{ rgba f 0 0 0 1 } } } - [ [ [ [ [ print-elt ] with-cell ] each ] with-row ] each ] tabular-output ; - -: print-table ( assoc -- ) >alist print-grid ; - -: print-seq ( seq -- ) [ 1array ] map print-grid ; - diff --git a/unmaintained/obj/util/util.factor b/unmaintained/obj/util/util.factor deleted file mode 100644 index 086fcd1835..0000000000 --- a/unmaintained/obj/util/util.factor +++ /dev/null @@ -1,8 +0,0 @@ - -USING: kernel parser words ; - -IN: obj.util - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: SYM: CREATE-WORD dup define-symbol parsed ; parsing \ No newline at end of file diff --git a/unmaintained/obj/view/view.factor b/unmaintained/obj/view/view.factor deleted file mode 100644 index cf5ca33745..0000000000 --- a/unmaintained/obj/view/view.factor +++ /dev/null @@ -1,52 +0,0 @@ - -USING: kernel words namespaces arrays sequences prettyprint - help.topics help.markup bake combinators.cleave - obj obj.misc obj.print ; - -IN: obj.view - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: $tab ( seq -- ) first print-table ; -: $obj ( seq -- ) first print-table ; -: $seq ( seq -- ) first print-seq ; -: $ptr ( seq -- ) first get print-table ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -PREDICATE: obj-type < symbol types member? ; - -M: obj-type article-title ( type -- title ) unparse ; - -M: obj-type article-content ( type -- content ) - objects [ type -> = ] with filter - { $seq , } bake ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -M: ptr article-title ( ptr -- title ) [ title -> ] [ unparse ] bi or ; - -M: ptr article-content ( ptr -- content ) - { - [ get { $obj , } bake ] - [ drop { $heading "Related\n" } ] - [ related { $seq , } bake ] - } - 1arr ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -PREDICATE: obj-list < word \ objects = ; - -M: obj-list article-title ( objects -- title ) drop "Objects" ; - -! M: obj-list article-content ( objects -- title ) -! execute -! [ [ type -> ] [ ] bi 2array ] map -! { $tab , } bake ; - -M: obj-list article-content ( objects -- title ) - drop - objects - [ [ type -> ] [ ] bi 2array ] map - { $tab , } bake ; \ No newline at end of file diff --git a/extra/ori/authors.txt b/unmaintained/ori/authors.txt similarity index 100% rename from extra/ori/authors.txt rename to unmaintained/ori/authors.txt diff --git a/extra/ori/ori-tests.factor b/unmaintained/ori/ori-tests.factor similarity index 100% rename from extra/ori/ori-tests.factor rename to unmaintained/ori/ori-tests.factor diff --git a/extra/ori/ori.factor b/unmaintained/ori/ori.factor similarity index 100% rename from extra/ori/ori.factor rename to unmaintained/ori/ori.factor diff --git a/extra/pos/authors.txt b/unmaintained/pos/authors.txt similarity index 100% rename from extra/pos/authors.txt rename to unmaintained/pos/authors.txt diff --git a/extra/pos/pos.factor b/unmaintained/pos/pos.factor similarity index 100% rename from extra/pos/pos.factor rename to unmaintained/pos/pos.factor diff --git a/unmaintained/prolog/authors.txt b/unmaintained/prolog/authors.txt deleted file mode 100644 index 194cb22416..0000000000 --- a/unmaintained/prolog/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Gavin Harrison diff --git a/unmaintained/prolog/prolog.factor b/unmaintained/prolog/prolog.factor deleted file mode 100755 index ea55ac5bf5..0000000000 --- a/unmaintained/prolog/prolog.factor +++ /dev/null @@ -1,84 +0,0 @@ -! Copyright (C) 2007 Gavin Harrison -! See http://factorcode.org/license.txt for BSD license. - -USING: kernel sequences arrays vectors namespaces math strings - combinators continuations quotations io assocs ascii ; - -IN: prolog - -SYMBOL: pldb -SYMBOL: plchoice - -: init-pl ( -- ) V{ } clone pldb set V{ } clone plchoice set ; - -: reset-choice ( -- ) V{ } clone plchoice set ; -: remove-choice ( -- ) plchoice get pop drop ; -: add-choice ( continuation -- ) - dup continuation? [ plchoice get push ] [ drop ] if ; -: last-choice ( -- ) plchoice get pop continue ; - -: rules ( -- vector ) pldb get ; -: rule ( n -- rule ) dup rules length >= [ drop "No." ] [ rules nth ] if ; - -: var? ( pl-obj -- ? ) - dup string? [ 0 swap nth LETTER? ] [ drop f ] if ; -: const? ( pl-obj -- ? ) var? not ; - -: check-arity ( pat fact -- pattern fact ? ) 2dup [ length ] 2apply = ; -: check-elements ( pat fact -- ? ) [ over var? [ 2drop t ] [ = ] if ] 2all? ; -: (double-bound) ( key value assoc -- ? ) - pick over at* [ pick = >r 3drop r> ] [ drop swapd set-at t ] if ; -: single-bound? ( pat-d pat-f -- ? ) - H{ } clone [ (double-bound) ] curry 2all? ; -: match-pattern ( pat fact -- ? ) - check-arity [ 2dup check-elements -rot single-bound? and ] [ 2drop f ] if ; -: good-result? ( pat fact -- pat fact ? ) - 2dup dup "No." = [ 2drop t ] [ match-pattern ] if ; - -: add-rule ( name pat body -- ) 3array rules dup length swap set-nth ; - -: (lookup-rule) ( name num -- pat-f rules ) - dup rule dup "No." = >r 0 swap nth swapd dupd = swapd r> or - [ dup rule [ ] callcc0 add-choice ] when - dup number? [ 1+ (lookup-rule) ] [ 2nip ] if ; - -: add-bindings ( pat-d pat-f binds -- binds ) - clone - [ over var? over const? or - [ 2drop ] [ rot dup >r set-at r> ] if - ] 2reduce ; -: init-binds ( pat-d pat-f -- binds ) V{ } clone add-bindings >alist ; - -: replace-if-bound ( binds elt -- binds elt' ) - over 2dup key? [ at ] [ drop ] if ; -: deep-replace ( binds seq -- binds seq' ) - [ dup var? [ replace-if-bound ] - [ dup array? [ dupd deep-replace nip ] when ] if - ] map ; - -: backtrace? ( result -- ) - dup "No." = [ remove-choice last-choice ] - [ [ last-choice ] unless ] if ; - -: resolve-rule ( pat-d pat-f rule-body -- binds ) - >r 2dup init-binds r> [ deep-replace >quotation call dup backtrace? - dup t = [ drop ] when ] each ; - -: rule>pattern ( rule -- pattern ) 1 swap nth ; -: rule>body ( rule -- body ) 2 swap nth ; - -: binds>fact ( pat-d pat-f binds -- fact ) - [ 2dup key? [ at ] [ drop ] if ] curry map good-result? - [ nip ] [ last-choice ] if ; - -: lookup-rule ( name pat -- fact ) - swap 0 (lookup-rule) dup "No." = - [ nip ] - [ dup rule>pattern swapd check-arity - [ rot rule>body resolve-rule dup -roll binds>fact nip ] [ last-choice ] if - ] if ; - -: binding-resolve ( binds name pat -- binds ) - tuck lookup-rule dup backtrace? spin add-bindings ; - -: is ( binds val var -- binds ) rot [ set-at ] keep ; diff --git a/unmaintained/prolog/summary.txt b/unmaintained/prolog/summary.txt deleted file mode 100644 index 48ad1f312e..0000000000 --- a/unmaintained/prolog/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Implementation of an embedded prolog for factor diff --git a/unmaintained/prolog/tags.txt b/unmaintained/prolog/tags.txt deleted file mode 100644 index eab42feac7..0000000000 --- a/unmaintained/prolog/tags.txt +++ /dev/null @@ -1 +0,0 @@ -languages diff --git a/unmaintained/random-tester/authors.txt b/unmaintained/random-tester/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/unmaintained/random-tester/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/random-tester/databank/authors.txt b/unmaintained/random-tester/databank/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/unmaintained/random-tester/databank/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/random-tester/databank/databank.factor b/unmaintained/random-tester/databank/databank.factor deleted file mode 100644 index 45ee779372..0000000000 --- a/unmaintained/random-tester/databank/databank.factor +++ /dev/null @@ -1,11 +0,0 @@ -USING: kernel math.constants ; -IN: random-tester.databank - -: databank ( -- array ) - { - ! V{ } H{ } V{ 3 } { 3 } { } "" "asdf" - pi 1/0. -1/0. 0/0. [ ] - f t "" 0 0.0 3.14 2 -3 -7 20 3/4 -3/4 1.2/3 3.5 - C{ 2 2 } C{ 1/0. 1/0. } - } ; - diff --git a/unmaintained/random-tester/random-tester.factor b/unmaintained/random-tester/random-tester.factor deleted file mode 100755 index cbf9f52fa6..0000000000 --- a/unmaintained/random-tester/random-tester.factor +++ /dev/null @@ -1,49 +0,0 @@ -USING: compiler continuations io kernel math namespaces -prettyprint quotations random sequences vectors -compiler.units ; -USING: random-tester.databank random-tester.safe-words -random-tester.random ; -IN: random-tester - -SYMBOL: errored -SYMBOL: before -SYMBOL: after -SYMBOL: quot -ERROR: random-tester-error ; - -: setup-test ( #data #code -- data... quot ) - #! Variable stack effect - >r [ databank random ] times r> - ! 200 300 random-cond ; - ! random-if ; - [ drop \ safe-words get random ] map >quotation ; - -: test-compiler ! ( data... quot -- ... ) - errored off - dup quot set - datastack 1 head* before set - [ call ] [ drop ] recover - datastack after set - clear - before get [ ] each - quot get [ compile-call ] [ errored on ] recover ; - -: do-test ! ( data... quot -- ) - .s flush test-compiler - errored get [ - datastack after get 2dup = [ - 2drop - ] [ - [ . ] each - "--" print - [ . ] each - quot get . - random-tester-error - ] if - ] unless clear ; - -: random-test1 ( #data #code -- ) - setup-test do-test ; - -: random-test2 ( -- ) - 3 2 setup-test do-test ; diff --git a/unmaintained/random-tester/random/authors.txt b/unmaintained/random-tester/random/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/unmaintained/random-tester/random/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/random-tester/random/random.factor b/unmaintained/random-tester/random/random.factor deleted file mode 100755 index 7bedcb8cec..0000000000 --- a/unmaintained/random-tester/random/random.factor +++ /dev/null @@ -1,86 +0,0 @@ -USING: kernel math sequences namespaces hashtables words -arrays parser compiler syntax io prettyprint random -math.constants math.functions layouts random-tester.utils -random-tester.safe-words quotations fry combinators ; -IN: random-tester - -! Tweak me -: max-length 15 ; inline -: max-value 1000000000 ; inline - -! varying bit-length random number -: random-bits ( n -- int ) - random 2 swap ^ random ; - -: random-seq ( -- seq ) - { [ ] { } V{ } "" } random - [ max-length random [ max-value random , ] times ] swap make ; - -: random-string - [ max-length random [ max-value random , ] times ] "" make ; - -: special-integers ( -- seq ) \ special-integers get ; -[ { -1 0 1 } % most-negative-fixnum , most-positive-fixnum , first-bignum , ] -{ } make \ special-integers set-global -: special-floats ( -- seq ) \ special-floats get ; -[ { 0.0 -0.0 } % e , pi , 1./0. , -1./0. , 0./0. , epsilon , epsilon neg , ] -{ } make \ special-floats set-global -: special-complexes ( -- seq ) \ special-complexes get ; -[ - { -1 0 1 C{ 0 1 } C{ 0 -1 } } % - e , e neg , pi , pi neg , - 0 pi rect> , 0 pi neg rect> , pi neg 0 rect> , pi pi rect> , - pi pi neg rect> , pi neg pi rect> , pi neg pi neg rect> , - e neg e neg rect> , e e rect> , -] { } make \ special-complexes set-global - -: random-fixnum ( -- fixnum ) - most-positive-fixnum random 1+ 50% [ neg 1- ] when >fixnum ; - -: random-bignum ( -- bignum ) - 400 random-bits first-bignum + 50% [ neg ] when ; - -: random-integer ( -- n ) - 50% [ - random-fixnum - ] [ - 50% [ random-bignum ] [ special-integers get random ] if - ] if ; - -: random-positive-integer ( -- int ) - random-integer dup 0 < [ - neg - ] [ - dup 0 = [ 1 + ] when - ] if ; - -: random-ratio ( -- ratio ) - 1000000000 dup [ random ] bi@ 1+ / 50% [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ; - -: random-float ( -- float ) - 50% [ random-ratio ] [ special-floats get random ] if - 50% - [ .0000000000000000001 /f ] [ 50% [ .00000000000000001 * ] when ] if - >float ; - -: random-number ( -- number ) - { - [ random-integer ] - [ random-ratio ] - [ random-float ] - } do-one ; - -: random-complex ( -- C ) - random-number random-number rect> ; - -: random-quot ( n -- quot ) - [ \ safe-words get random ] replicate >quotation ; - -: random-if ( n -- quot ) - [ random-quot ] [ random-quot ] bi - '[ , , if ] ; - -: random-cond ( m n -- quot ) - [ '[ , [ random-quot ] [ random-quot ] bi 2array ] replicate ] - [ random-quot ] bi suffix - '[ , cond ] ; diff --git a/unmaintained/random-tester/safe-words/authors.txt b/unmaintained/random-tester/safe-words/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/unmaintained/random-tester/safe-words/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/random-tester/safe-words/safe-words.factor b/unmaintained/random-tester/safe-words/safe-words.factor deleted file mode 100755 index 77e5562f4d..0000000000 --- a/unmaintained/random-tester/safe-words/safe-words.factor +++ /dev/null @@ -1,120 +0,0 @@ -USING: kernel namespaces sequences sets sorting vocabs ; -USING: arrays assocs generic hashtables -math math.intervals math.parser math.order math.functions -refs shuffle vectors words ; -IN: random-tester.safe-words - -: ?-words - { - /f - - bits>float bits>double - float>bits double>bits - - >bignum >boolean >fixnum >float - - array? integer? complex? value-ref? ref? key-ref? - interval? number? - wrapper? tuple? - [-1,1]? between? bignum? both? either? eq? equal? even? fixnum? - float? fp-nan? hashtable? interval-contains? interval-subset? - interval? key-ref? key? number? odd? pair? power-of-2? - ratio? rational? real? zero? assoc? curry? vector? callstack? - - 2^ not - ! arrays - resize-array - ! assocs - (assoc-stack) - new-assoc - assoc-like - - all-integers? (all-integers?) ! hangs? - assoc-push-if - - (clone) assoc-clone-like ! SYMBOL: foo foo dup (clone) = - } ; - -: bignum-words - { - next-power-of-2 (next-power-of-2) - times - hashcode hashcode* - } ; - -: initialization-words - { - init-namespaces - } ; - -: stack-words - { - dup - drop 2drop 3drop - roll -roll 2swap - - >r r> - } ; - -: stateful-words - { - counter - gensym - } ; - -: foo-words - { - set-retainstack - retainstack callstack - datastack - callstack>array - - curry 2curry 3curry compose 3compose - (assoc-each) - } ; - -: exit-words - { - call-clear die - } ; - -: bad-words ( -- array ) - [ - ?-words % - bignum-words % - initialization-words % - stack-words % - stateful-words % - exit-words % - foo-words % - ] { } make ; - -: safe-words ( -- array ) - { - ! "accessors" - "alists" "arrays" "assocs" "bit-arrays" "byte-arrays" - ! "classes" "combinators" "compiler" "continuations" - ! "core-foundation" "definitions" "documents" - ! "float-arrays" "generic" "graphs" "growable" - "hashtables" ! io.* - "kernel" "math" - "math.bitfields" "math.complex" "math.constants" "math.floats" - "math.functions" "math.integers" "math.intervals" "math.libm" - "math.parser" "math.order" "math.ratios" "math.vectors" - ! "namespaces" - "quotations" "sbufs" - ! "queues" "strings" "sequences" - "sets" - "vectors" - ! "words" - } [ words ] map concat bad-words diff natural-sort ; - -safe-words \ safe-words set-global - -! foo dup (clone) = . -! foo dup clone = . -! f [ byte-array>bignum assoc-clone-like ] compile-1 -! 2 3.14 [ number= ] compile-1 -! 3.14 [ assoc? ] compile-1 -! -3 [ ] 2 [ byte-array>bignum denominator ] compile-1 -! : foo ( x -- y ) euler bitand ; { foo } compile 20 foo diff --git a/unmaintained/random-tester/utils/authors.txt b/unmaintained/random-tester/utils/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/unmaintained/random-tester/utils/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/random-tester/utils/utils.factor b/unmaintained/random-tester/utils/utils.factor deleted file mode 100644 index a025bbf45f..0000000000 --- a/unmaintained/random-tester/utils/utils.factor +++ /dev/null @@ -1,34 +0,0 @@ -USING: arrays assocs combinators.lib continuations kernel -math math.functions memoize namespaces quotations random sequences -sequences.private shuffle ; -IN: random-tester.utils - -: %chance ( n -- ? ) - 100 random > ; - -: 10% ( -- ? ) 10 %chance ; -: 20% ( -- ? ) 20 %chance ; -: 30% ( -- ? ) 30 %chance ; -: 40% ( -- ? ) 40 %chance ; -: 50% ( -- ? ) 50 %chance ; -: 60% ( -- ? ) 60 %chance ; -: 70% ( -- ? ) 70 %chance ; -: 80% ( -- ? ) 80 %chance ; -: 90% ( -- ? ) 90 %chance ; - -: call-if ( quot ? -- ) swap when ; inline - -: with-10% ( quot -- ) 10% call-if ; inline -: with-20% ( quot -- ) 20% call-if ; inline -: with-30% ( quot -- ) 30% call-if ; inline -: with-40% ( quot -- ) 40% call-if ; inline -: with-50% ( quot -- ) 50% call-if ; inline -: with-60% ( quot -- ) 60% call-if ; inline -: with-70% ( quot -- ) 70% call-if ; inline -: with-80% ( quot -- ) 80% call-if ; inline -: with-90% ( quot -- ) 90% call-if ; inline - -: random-key keys random ; -: random-value [ random-key ] keep at ; - -: do-one ( seq -- ) random call ; inline diff --git a/extra/random-weighted/authors.txt b/unmaintained/random-weighted/authors.txt similarity index 100% rename from extra/random-weighted/authors.txt rename to unmaintained/random-weighted/authors.txt diff --git a/extra/random-weighted/random-weighted.factor b/unmaintained/random-weighted/random-weighted.factor similarity index 100% rename from extra/random-weighted/random-weighted.factor rename to unmaintained/random-weighted/random-weighted.factor diff --git a/unmaintained/raptor/authors.txt b/unmaintained/raptor/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/raptor/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/raptor/config.factor b/unmaintained/raptor/config.factor deleted file mode 100644 index 29e26d4381..0000000000 --- a/unmaintained/raptor/config.factor +++ /dev/null @@ -1,165 +0,0 @@ - -USING: namespaces threads - unix.process unix.linux.if unix.linux.ifreq unix.linux.route - raptor.cron ; - -IN: raptor - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Networking -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: configure-lo ( -- ) - "lo" "127.0.0.1" set-if-addr - "lo" { IFF_UP } flags set-if-flags ; - -: configure-eth1 ( -- ) - "eth1" "192.168.1.10" set-if-addr - "eth1" { IFF_UP IFF_MULTICAST } flags set-if-flags ; - -: configure-route ( -- ) - "0.0.0.0" "192.168.1.1" "0.0.0.0" { RTF_UP RTF_GATEWAY } flags route ; - -[ - configure-lo - configure-eth1 - configure-route -] networking-hook set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Filesystems -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -"/dev/hda1" root-device set-global - -{ "/dev/hda5" } swap-devices set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! boot-hook -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -[ - start-wait-loop - - ! rcS.d - - "mountvirtfs" start-service - - ! "hostname.sh" start-service - "narodnik" set-hostname - - "keymap.sh" start-service - "linux-restricted-modules-common" start-service - "udev" start-service - "mountdevsubfs" start-service - "module-init-tools" start-service - "procps.sh" start-service - - ! "checkroot.sh" start-service - - activate-swap - mount-root - - "mtab" start-service - "checkfs.sh" start-service - "mountall.sh" start-service - - start-networking -! "loopback" start-service -! "networking" start-service - - "hwclock.sh" start-service - "displayconfig-hwprobe.py" start-service - "screen" start-service - "x11-common" start-service - "bootmisc.sh" start-service - "urandom" start-service - - ! rc2.d - - "vbesave" start-service - "acpid" start-service - "powernowd.early" start-service - "sysklogd" start-service - "klogd" start-service - "dbus" start-service - "apmd" start-service - "hotkey-setup" start-service - "laptop-mode" start-service - "makedev" start-service - "nvidia-kernel" start-service - "postfix" start-service - "powernowd" start-service - "ntp-server" start-service - "binfmt-support" start-service - "acpi-support" start-service - "rc.local" start-service - "rmnologin" start-service - - schedule-cron-jobs - - [ [ "/dev/tty2" tty-listener ] forever ] in-thread - [ [ "/dev/tty3" tty-listener ] forever ] in-thread - [ [ "/dev/tty4" tty-listener ] forever ] in-thread - [ [ "/dev/tty5" getty ] forever ] in-thread - [ [ "/dev/tty6" getty ] forever ] in-thread - -] boot-hook set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! reboot-hook -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -[ - "acpi-support" stop-service - "apmd" stop-service - "dbus" stop-service - "hotkey-setup" stop-service - "laptop-mode" stop-service - "makedev" stop-service - "nvidia-kernel" stop-service - "powernowd" stop-service - "acpid" stop-service - "hwclock.sh" stop-service - "alsa-utils" stop-service - "klogd" stop-service - "binfmt-support" stop-service - "sysklogd" stop-service - "linux-restricted-modules-common" stop-service - "sendsigs" stop-service - "urandom" stop-service - "umountnfs.sh" stop-service - "networking" stop-service - "umountfs" stop-service - "umountroot" stop-service - "reboot" stop-service -] reboot-hook set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! shutdown-hook -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -[ - "acpi-support" stop-service - "apmd" stop-service - "dbus" stop-service - "hotkey-setup" stop-service - "laptop-mode" stop-service - "makedev" stop-service - "nvidia-kernel" stop-service - "postfix" stop-service - "powernowd" stop-service - "acpid" stop-service - "hwclock.sh" stop-service - "alsa-utils" stop-service - "klogd" stop-service - "binfmt-support" stop-service - "sysklogd" stop-service - "linux-restricted-modules-common" stop-service - "sendsigs" stop-service - "urandom" stop-service - "umountnfs.sh" stop-service - "umountfs" stop-service - "umountroot" stop-service - "halt" stop-service -] shutdown-hook set-global \ No newline at end of file diff --git a/unmaintained/raptor/cron/authors.txt b/unmaintained/raptor/cron/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/raptor/cron/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/raptor/cron/cron.factor b/unmaintained/raptor/cron/cron.factor deleted file mode 100755 index d818fb487d..0000000000 --- a/unmaintained/raptor/cron/cron.factor +++ /dev/null @@ -1,62 +0,0 @@ - -USING: kernel namespaces threads sequences calendar - combinators.lib debugger ; - -IN: raptor.cron - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -TUPLE: when minute hour day-of-month month day-of-week ; - -C: when - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: slot-match? ( now-slot when-slot -- ? ) dup f = [ 2drop t ] [ member? ] if ; - -: minute-match? ( now when -- ? ) - [ timestamp-minute ] [ when-minute ] bi* slot-match? ; - -: hour-match? ( now when -- ? ) - [ timestamp-hour ] [ when-hour ] bi* slot-match? ; - -: day-of-month-match? ( now when -- ? ) - [ timestamp-day ] [ when-day-of-month ] bi* slot-match? ; - -: month-match? ( now when -- ? ) - [ timestamp-month ] [ when-month ] bi* slot-match? ; - -: day-of-week-match? ( now when -- ? ) - [ day-of-week ] [ when-day-of-week ] bi* slot-match? ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: when=now? ( when -- ? ) - now swap - { [ minute-match? ] - [ hour-match? ] - [ day-of-month-match? ] - [ month-match? ] - [ day-of-week-match? ] } - <--&& ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: recurring-job ( when quot -- ) - [ swap when=now? [ try ] [ drop ] if 60000 sleep ] [ recurring-job ] 2bi ; - -: schedule ( when quot -- ) [ recurring-job ] 2curry in-thread ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: cron-jobs-hourly -SYMBOL: cron-jobs-daily -SYMBOL: cron-jobs-weekly -SYMBOL: cron-jobs-monthly - -: schedule-cron-jobs ( -- ) - { 17 } f f f f [ cron-jobs-hourly get call ] schedule - { 25 } { 6 } f f f [ cron-jobs-daily get call ] schedule - { 47 } { 6 } f f { 7 } [ cron-jobs-weekly get call ] schedule - { 52 } { 6 } { 1 } f f [ cron-jobs-monthly get call ] schedule ; - diff --git a/unmaintained/raptor/cron/tags.txt b/unmaintained/raptor/cron/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/unmaintained/raptor/cron/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/unmaintained/raptor/cronjobs.factor b/unmaintained/raptor/cronjobs.factor deleted file mode 100644 index 436fb8580f..0000000000 --- a/unmaintained/raptor/cronjobs.factor +++ /dev/null @@ -1,34 +0,0 @@ - -USING: kernel namespaces threads arrays sequences - raptor raptor.cron ; - -IN: raptor - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -[ - "/etc/cron.daily/apt" fork-exec-arg - "/etc/cron.daily/aptitude" fork-exec-arg - "/etc/cron.daily/bsdmainutils" fork-exec-arg - "/etc/cron.daily/find.notslocate" fork-exec-arg - "/etc/cron.daily/logrotate" fork-exec-arg - "/etc/cron.daily/man-db" fork-exec-arg - "/etc/cron.daily/ntp-server" fork-exec-arg - "/etc/cron.daily/slocate" fork-exec-arg - "/etc/cron.daily/standard" fork-exec-arg - "/etc/cron.daily/sysklogd" fork-exec-arg - "/etc/cron.daily/tetex-bin" fork-exec-arg -] cron-jobs-daily set-global - -[ - "/etc/cron.weekly/cvs" fork-exec-arg - "/etc/cron.weekly/man-db" fork-exec-arg - "/etc/cron.weekly/ntp-server" fork-exec-arg - "/etc/cron.weekly/popularity-contest" fork-exec-arg - "/etc/cron.weekly/sysklogd" fork-exec-arg -] cron-jobs-weekly set-global - -[ - "/etc/cron.monthly/scrollkeeper" fork-exec-arg - "/etc/cron.monthly/standard" fork-exec-arg -] cron-jobs-monthly set-global \ No newline at end of file diff --git a/unmaintained/raptor/raptor.factor b/unmaintained/raptor/raptor.factor deleted file mode 100755 index c0605fe837..0000000000 --- a/unmaintained/raptor/raptor.factor +++ /dev/null @@ -1,80 +0,0 @@ - -USING: kernel parser namespaces threads arrays sequences unix unix.process - bake ; - -IN: raptor - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: boot-hook -SYMBOL: reboot-hook -SYMBOL: shutdown-hook -SYMBOL: networking-hook - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: reload-raptor-config ( -- ) - "/etc/raptor/config.factor" run-file - "/etc/raptor/cronjobs.factor" run-file ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: fork-exec-wait ( pathname args -- ) - fork dup 0 = [ drop exec drop ] [ 2nip wait-for-pid drop ] if ; - -: fork-exec-args-wait ( args -- ) [ first ] [ ] bi fork-exec-wait ; - -: fork-exec-arg ( arg -- ) 1array [ fork-exec-args-wait ] curry in-thread ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: forever ( quot -- ) [ call ] [ forever ] bi ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: start-service ( name -- ) "/etc/init.d/" " start" surround system drop ; -: stop-service ( name -- ) "/etc/init.d/" " stop" surround system drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-args-wait ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: io io.files io.streams.lines io.streams.plain io.streams.duplex - listener io.encodings.utf8 ; - -: tty-listener ( tty -- ) - dup utf8 [ - swap utf8 [ - [ - listener - ] with-stream - ] with-disposal - ] with-disposal ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: unix.linux.swap unix.linux.fs ; - -SYMBOL: root-device -SYMBOL: swap-devices - -: activate-swap ( -- ) swap-devices get [ 0 swapon drop ] each ; - -: mount-root ( -- ) root-device get "/" "ext3" MS_REMOUNT f mount drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: start-networking ( -- ) networking-hook get call ; - -: set-hostname ( name -- ) `{ "/bin/hostname" , } fork-exec-args-wait ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: boot ( -- ) boot-hook get call ; -: reboot ( -- ) reboot-hook get call ; -: shutdown ( -- ) shutdown-hook get call ; - -MAIN: boot - diff --git a/unmaintained/raptor/readme b/unmaintained/raptor/readme deleted file mode 100644 index dfb6890cda..0000000000 --- a/unmaintained/raptor/readme +++ /dev/null @@ -1,134 +0,0 @@ - -Raptor Linux - -*** Introduction *** - -Raptor Linux is a mod of Ubuntu 6.06 (Dapper Drake) - -This is unlikely to work on another version of Ubuntu, much less -another Linux distribution. - -*** Features *** - - * /sbin/init is replaced with Factor - * Virtual terminals managed by Factor - * Listeners run on virtual terminals - * Native support for static ip networking - * Crontab replacement - -*** Install *** - - # mkdir -v /etc/raptor - - # cp -v /scratch/factor/extra/raptor/{config,cronjobs}.factor /etc/raptor - - ( scratchpad ) USE: raptor - ( scratchpad ) reload-raptor-config - ( scratchpad ) save - - # mv -v /sbin/{init,init.orig} - - # cp -v /scratch/factor/factor /sbin/init - - # cp -v /scratch/factor/factor.image /sbin/init.image - -*** Filesystems *** - - # emacs /etc/raptor/config.factor - -Edit the root-device and swap-devices variables. - -*** Static IP networking *** - -If you use a static IP in your network then Factor can take care of -networking. - - # emacs /etc/raptor/config.factor - - (change the settings accordingly) - -The udev system has a hook to bring up ethernet interfaces when they -are detected. Let's remove this hook since we'll be bringing up the -interface. Actually, we'll move it, not delete it. - - # mv -v /etc/udev/rules.d/85-ifupdown.rules /root - -*** DHCP networking *** - -If you're using dhcp then we'll fall back on what Ubuntu offers. In -your config.factor change the line : - - start-networking - -to - - "loopback" start-service - "networking" start-service - -Add these to your reboot-hook and shutdown-hook : - - "loopback" stop-service - "networking" stop-service - -*** Editing the hooks *** - -The items in boot-hook correspond to the things in '/etc/rcS.d' and -'/etc/rc2.d'. Feel free to add and remove items from that hook. For -example, I removed the printer services. I also removed other things -that I didn't feel were necessary on my system. - -Look for the line with the call to 'set-hostname' and edit it appropriately. - -*** Grub *** - -Edit your '/boot/grub/menu.lst'. Basically, copy and paste your -current good entry. My default entry is this: - -title Ubuntu, kernel 2.6.15-28-686 -root (hd0,0) -kernel /boot/vmlinuz-2.6.15-28-686 root=/dev/hda1 ro quiet splash -initrd /boot/initrd.img-2.6.15-28-686 -savedefault -boot - -I pasted a copy above it and edited it to look like this: - -title Raptor, kernel 2.6.15-28-686 -root (hd0,0) -kernel /boot/vmlinuz-2.6.15-28-686 root=/dev/hda1 ro quiet -run=ubuntu.dapper.boot -initrd /boot/initrd.img-2.6.15-28-686 -savedefault -boot - -* Note that I removed the 'splash' kernel option - -* Note the '-run=ubuntu.dapper.boot' option. Unfortunately, this isn't - working yet... - -*** Boot *** - -Reboot or turn on your computer. Eventually, hopefully, you'll be at a -Factor prompt. Boot your system: - - ( scratchpad ) boot - -You'll probably be prompted to select a vocab. Select 'raptor'. - -*** Now what *** - -The virtual consoles are allocated like so: - - 1 - Main listener console - 2 - listener - 3 - listener - 4 - listener - 5 - getty - 6 - getty - -So you're next step might be to alt-f5, login, and run startx. - -*** Join the fun *** - -Take a loot at what happens during run levels S and 2. Implement a -Factor version of something. Let me know about it. - diff --git a/unmaintained/raptor/tags.txt b/unmaintained/raptor/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/unmaintained/raptor/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/extra/rewrite-closures/authors.txt b/unmaintained/rewrite-closures/authors.txt similarity index 100% rename from extra/rewrite-closures/authors.txt rename to unmaintained/rewrite-closures/authors.txt diff --git a/extra/rewrite-closures/rewrite-closures.factor b/unmaintained/rewrite-closures/rewrite-closures.factor similarity index 100% rename from extra/rewrite-closures/rewrite-closures.factor rename to unmaintained/rewrite-closures/rewrite-closures.factor diff --git a/extra/rewrite-closures/summary.txt b/unmaintained/rewrite-closures/summary.txt similarity index 100% rename from extra/rewrite-closures/summary.txt rename to unmaintained/rewrite-closures/summary.txt diff --git a/extra/rewrite-closures/tags.txt b/unmaintained/rewrite-closures/tags.txt similarity index 100% rename from extra/rewrite-closures/tags.txt rename to unmaintained/rewrite-closures/tags.txt diff --git a/unmaintained/route/authors.txt b/unmaintained/route/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/route/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/route/route.factor b/unmaintained/route/route.factor deleted file mode 100644 index 4d9bbfae99..0000000000 --- a/unmaintained/route/route.factor +++ /dev/null @@ -1,55 +0,0 @@ - -USING: alien.syntax ; - -IN: unix.linux.route - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -C-STRUCT: struct-rtentry - { "ulong" "rt_pad1" } - { "struct-sockaddr" "rt_dst" } - { "struct-sockaddr" "rt_gateway" } - { "struct-sockaddr" "rt_genmask" } - { "ushort" "rt_flags" } - { "short" "rt_pad2" } - { "ulong" "rt_pad3" } - { "uchar" "rt_tos" } - { "uchar" "rt_class" } - { "short" "rt_pad4" } - { "short" "rt_metric" } - { "char*" "rt_dev" } - { "ulong" "rt_mtu" } - { "ulong" "rt_window" } - { "ushort" "rt_irtt" } ; - -: RTF_UP HEX: 0001 ; ! Route usable. -: RTF_GATEWAY HEX: 0002 ; ! Destination is a gateway. - -: RTF_HOST HEX: 0004 ; ! Host entry (net otherwise). -: RTF_REINSTATE HEX: 0008 ; ! Reinstate route after timeout. -: RTF_DYNAMIC HEX: 0010 ; ! Created dyn. (by redirect). -: RTF_MODIFIED HEX: 0020 ; ! Modified dyn. (by redirect). -: RTF_MTU HEX: 0040 ; ! Specific MTU for this route. -: RTF_MSS RTF_MTU ; ! Compatibility. -: RTF_WINDOW HEX: 0080 ; ! Per route window clamping. -: RTF_IRTT HEX: 0100 ; ! Initial round trip time. -: RTF_REJECT HEX: 0200 ; ! Reject route. -: RTF_STATIC HEX: 0400 ; ! Manually injected route. -: RTF_XRESOLVE HEX: 0800 ; ! External resolver. -: RTF_NOFORWARD HEX: 1000 ; ! Forwarding inhibited. -: RTF_THROW HEX: 2000 ; ! Go to next class. -: RTF_NOPMTUDISC HEX: 4000 ; ! Do not send packets with DF. - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: kernel alien.c-types io.sockets - unix unix.linux.sockios ; - -: route ( dst gateway genmask flags -- ) - >r >r >r >r - "struct-rtentry" - r> 0 make-sockaddr over set-struct-rtentry-rt_dst - r> 0 make-sockaddr over set-struct-rtentry-rt_gateway - r> 0 make-sockaddr over set-struct-rtentry-rt_genmask - r> over set-struct-rtentry-rt_flags - AF_INET SOCK_DGRAM 0 socket SIOCADDRT rot ioctl drop ; diff --git a/unmaintained/route/tags.txt b/unmaintained/route/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/unmaintained/route/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/extra/self/authors.txt b/unmaintained/self/authors.txt similarity index 100% rename from extra/self/authors.txt rename to unmaintained/self/authors.txt diff --git a/extra/self/self.factor b/unmaintained/self/self.factor similarity index 100% rename from extra/self/self.factor rename to unmaintained/self/self.factor diff --git a/extra/self/slots/slots.factor b/unmaintained/self/slots/slots.factor similarity index 100% rename from extra/self/slots/slots.factor rename to unmaintained/self/slots/slots.factor diff --git a/unmaintained/sequences-lib/authors.txt b/unmaintained/sequences-lib/authors.txt deleted file mode 100644 index 07c1c4a765..0000000000 --- a/unmaintained/sequences-lib/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Eduardo Cavazos -Doug Coleman diff --git a/unmaintained/sequences-lib/lib-docs.factor b/unmaintained/sequences-lib/lib-docs.factor deleted file mode 100755 index e279230b1b..0000000000 --- a/unmaintained/sequences-lib/lib-docs.factor +++ /dev/null @@ -1,29 +0,0 @@ -USING: help.syntax help.markup kernel prettyprint sequences -quotations math ; -IN: sequences.lib - -HELP: map-withn -{ $values { "seq" sequence } { "quot" quotation } { "n" number } { "newseq" sequence } } -{ $description "A generalisation of " { $link map } ". The first " { $snippet "n" } " items after the quotation will be " -"passed to the quotation given to map-withn for each element in the sequence." -} -{ $examples - { $example "USING: math sequences.lib prettyprint ;" "1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn .s" "{ 16 17 18 19 20 }" } -} -{ $see-also each-withn } ; - -HELP: each-withn -{ $values { "seq" sequence } { "quot" quotation } { "n" number } } -{ $description "A generalisation of " { $link each } ". The first " { $snippet "n" } " items after the quotation will be " -"passed to the quotation given to each-withn for each element in the sequence." -} -{ $see-also map-withn } ; - -HELP: randomize -{ $values { "seq" sequence } { "seq'" sequence } } -{ $description "Shuffle the elements in the sequence randomly, returning the new sequence." } ; - -HELP: enumerate -{ $values { "seq" sequence } { "seq'" sequence } } -{ $description "Returns a new sequence where each element is an array of { index, value }" } ; - diff --git a/unmaintained/sequences-lib/lib-tests.factor b/unmaintained/sequences-lib/lib-tests.factor deleted file mode 100755 index 509d9b1432..0000000000 --- a/unmaintained/sequences-lib/lib-tests.factor +++ /dev/null @@ -1,58 +0,0 @@ -USING: arrays kernel sequences sequences.lib math math.functions math.ranges - tools.test strings ; -IN: sequences.lib.tests - -[ 1 2 { 3 4 } [ + + drop ] 2 each-withn ] must-infer -{ 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test - -[ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer -{ { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test -{ { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test -[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test - -[ 10 ] [ { 1 2 3 4 } [ + ] reduce* ] unit-test -[ 24 ] [ { 1 2 3 4 } [ * ] reduce* ] unit-test - -[ -4 ] [ 1 -4 [ abs ] higher ] unit-test -[ 1 ] [ 1 -4 [ abs ] lower ] unit-test - -[ { 1 2 3 4 } ] [ { { 1 2 3 4 } { 1 2 3 } } longest ] unit-test -[ { 1 2 3 4 } ] [ { { 1 2 3 } { 1 2 3 4 } } longest ] unit-test - -[ { 1 2 3 } ] [ { { 1 2 3 4 } { 1 2 3 } } shortest ] unit-test -[ { 1 2 3 } ] [ { { 1 2 3 } { 1 2 3 4 } } shortest ] unit-test - -[ 3 ] [ 1 3 bigger ] unit-test -[ 1 ] [ 1 3 smaller ] unit-test - -[ "abd" ] [ "abc" "abd" bigger ] unit-test -[ "abc" ] [ "abc" "abd" smaller ] unit-test - -[ "abe" ] [ { "abc" "abd" "abe" } biggest ] unit-test -[ "abc" ] [ { "abc" "abd" "abe" } smallest ] unit-test - -[ 1 3 ] [ { 1 2 3 } minmax ] unit-test -[ -11 -9 ] [ { -11 -10 -9 } minmax ] unit-test -[ -1/0. 1/0. ] [ { -1/0. 1/0. -11 -10 -9 } minmax ] unit-test - -[ { { 1 } { -1 5 } { 2 4 } } ] -[ { 1 -1 5 2 4 } [ < ] monotonic-split [ >array ] map ] unit-test -[ { { 1 1 1 1 } { 2 2 } { 3 } { 4 } { 5 } { 6 6 6 } } ] -[ { 1 1 1 1 2 2 3 4 5 6 6 6 } [ = ] monotonic-split [ >array ] map ] unit-test - -[ { 1 9 25 } ] [ { 1 3 5 6 } [ sq ] [ even? ] map-until ] unit-test -[ { 2 4 } ] [ { 2 4 1 3 } [ even? ] take-while ] unit-test - -[ { { 0 0 } { 1 0 } { 0 1 } { 1 1 } } ] [ 2 2 exact-strings ] unit-test -[ t ] [ "ab" 4 strings [ >string ] map "abab" swap member? ] unit-test -[ { { } { 1 } { 2 } { 1 2 } } ] [ { 1 2 } power-set ] unit-test - -[ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer -{ { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test -{ { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test -[ 1 2 { 3 4 } [ + + drop ] 2 each-withn ] must-infer -{ 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test -[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test - -[ { { 0 1 } { 1 2 } { 2 3 } } ] [ { 1 2 3 } enumerate ] unit-test - diff --git a/unmaintained/sequences-lib/lib.factor b/unmaintained/sequences-lib/lib.factor deleted file mode 100755 index 72944c09b4..0000000000 --- a/unmaintained/sequences-lib/lib.factor +++ /dev/null @@ -1,149 +0,0 @@ -! Copyright (C) 2007 Slava Pestov, Chris Double, Doug Coleman, -! Eduardo Cavazos, Daniel Ehrenberg. -! See http://factorcode.org/license.txt for BSD license. -USING: combinators.lib kernel sequences math namespaces make -assocs random sequences.private shuffle math.functions arrays -math.parser math.private sorting strings ascii macros assocs.lib -quotations hashtables math.order locals generalizations -math.ranges random fry ; -IN: sequences.lib - -: each-withn ( seq quot n -- ) nwith each ; inline - -: each-with ( seq quot -- ) with each ; inline - -: each-with2 ( obj obj list quot -- ) 2 each-withn ; inline - -: map-withn ( seq quot n -- newseq ) nwith map ; inline - -: map-with ( seq quot -- ) with map ; inline - -: map-with2 ( obj obj list quot -- newseq ) 2 map-withn ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: each-percent ( seq quot -- ) - [ - dup length - dup [ / ] curry - [ 1+ ] prepose - ] dip compose - 2each ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: reduce* ( seq quot -- result ) [ ] swap map-reduce ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: higher ( a b quot -- c ) [ compare +gt+ eq? ] curry most ; inline - -: lower ( a b quot -- c ) [ compare +lt+ eq? ] curry most ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: longer ( a b -- c ) [ length ] higher ; - -: shorter ( a b -- c ) [ length ] lower ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: longest ( seq -- item ) [ longer ] reduce* ; - -: shortest ( seq -- item ) [ shorter ] reduce* ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: bigger ( a b -- c ) [ ] higher ; - -: smaller ( a b -- c ) [ ] lower ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: biggest ( seq -- item ) [ bigger ] reduce* ; - -: smallest ( seq -- item ) [ smaller ] reduce* ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: minmax ( seq -- min max ) - #! find the min and max of a seq in one pass - 1/0. -1/0. rot [ tuck max [ min ] dip ] each ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: ,, ( obj -- ) building get peek push ; -: v, ( -- ) V{ } clone , ; -: ,v ( -- ) building get dup peek empty? [ dup pop* ] when drop ; - -: (monotonic-split) ( seq quot -- newseq ) - [ - [ dup unclip suffix ] dip - v, [ pick ,, call [ v, ] unless ] curry 2each ,v - ] { } make ; - -: monotonic-split ( seq quot -- newseq ) - over empty? [ 2drop { } ] [ (monotonic-split) ] if ; - -ERROR: element-not-found ; -: split-around ( seq quot -- before elem after ) - dupd find over [ element-not-found ] unless - [ cut rest ] dip swap ; inline - -: map-until ( seq quot pred -- newseq ) - '[ [ @ dup @ [ drop t ] [ , f ] if ] find 2drop ] { } make ; - -: take-while ( seq quot -- newseq ) - [ not ] compose - [ find drop [ head-slice ] when* ] curry - [ dup ] prepose keep like ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - -: exact-strings ( alphabet length -- seqs ) - [ dup length ] dip exact-number-strings map-alphabet ; - -: strings ( alphabet length -- seqs ) - [ dup length ] dip number-strings map-alphabet ; - -: switches ( seq1 seq -- subseq ) - ! seq1 is a sequence of ones and zeroes - [ [ length ] keep [ nth 1 = ] curry filter ] dip - [ nth ] curry { } map-as ; - -: power-set ( seq -- subsets ) - 2 over length exact-number-strings swap [ switches ] curry map ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - -: attempt-each ( seq quot -- result ) - (each) iterate-prep (attempt-each-integer) ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: randomize ( seq -- seq' ) - dup length 1 (a,b] [ dup random pick exchange ] each ; - -: enumerate ( seq -- seq' ) >alist ; diff --git a/unmaintained/sequences-lib/summary.txt b/unmaintained/sequences-lib/summary.txt deleted file mode 100644 index e389b415ca..0000000000 --- a/unmaintained/sequences-lib/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Non-core sequence words diff --git a/unmaintained/sequences-lib/tags.txt b/unmaintained/sequences-lib/tags.txt deleted file mode 100644 index 42d711b32b..0000000000 --- a/unmaintained/sequences-lib/tags.txt +++ /dev/null @@ -1 +0,0 @@ -collections diff --git a/unmaintained/sockios/authors.txt b/unmaintained/sockios/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/sockios/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/sockios/sockios.factor b/unmaintained/sockios/sockios.factor deleted file mode 100644 index fd1bb10e2e..0000000000 --- a/unmaintained/sockios/sockios.factor +++ /dev/null @@ -1,64 +0,0 @@ - -IN: unix.linux.sockios - -! Imported from linux-headers-2.6.15-28-686 on Ubuntu 6.06 - -! Routing table calls -: SIOCADDRT HEX: 890B ; ! add routing table entry -: SIOCDELRT HEX: 890C ; ! delete routing table entry -: SIOCRTMSG HEX: 890D ; ! call to routing system - -! Socket configuration controls - -: SIOCGIFNAME HEX: 8910 ; ! get iface name -: SIOCSIFLINK HEX: 8911 ; ! set iface channel -: SIOCGIFCONF HEX: 8912 ; ! get iface list -: SIOCGIFFLAGS HEX: 8913 ; ! get flags -: SIOCSIFFLAGS HEX: 8914 ; ! set flags -: SIOCGIFADDR HEX: 8915 ; ! get PA address -: SIOCSIFADDR HEX: 8916 ; ! set PA address -: SIOCGIFDSTADDR HEX: 8917 ; ! get remote PA address -: SIOCSIFDSTADDR HEX: 8918 ; ! set remote PA address -: SIOCGIFBRDADDR HEX: 8919 ; ! get broadcast PA address -: SIOCSIFBRDADDR HEX: 891a ; ! set broadcast PA address -: SIOCGIFNETMASK HEX: 891b ; ! get network PA mask -: SIOCSIFNETMASK HEX: 891c ; ! set network PA mask -: SIOCGIFMETRIC HEX: 891d ; ! get metric -: SIOCSIFMETRIC HEX: 891e ; ! set metric -: SIOCGIFMEM HEX: 891f ; ! get memory address (BSD) -: SIOCSIFMEM HEX: 8920 ; ! set memory address (BSD) -: SIOCGIFMTU HEX: 8921 ; ! get MTU size -: SIOCSIFMTU HEX: 8922 ; ! set MTU size -: SIOCSIFNAME HEX: 8923 ; ! set interface name -: SIOCSIFHWADDR HEX: 8924 ; ! set hardware address -: SIOCGIFENCAP HEX: 8925 ; ! get/set encapsulations -: SIOCSIFENCAP HEX: 8926 ; -: SIOCGIFHWADDR HEX: 8927 ; ! Get hardware address -: SIOCGIFSLAVE HEX: 8929 ; ! Driver slaving support -: SIOCSIFSLAVE HEX: 8930 ; -: SIOCADDMULTI HEX: 8931 ; ! Multicast address lists -: SIOCDELMULTI HEX: 8932 ; -: SIOCGIFINDEX HEX: 8933 ; ! name -> if_index mapping -: SIOGIFINDEX SIOCGIFINDEX ; ! misprint compatibility :-) -: SIOCSIFPFLAGS HEX: 8934 ; ! set/get extended flags set -: SIOCGIFPFLAGS HEX: 8935 ; -: SIOCDIFADDR HEX: 8936 ; ! delete PA address -: SIOCSIFHWBROADCAST HEX: 8937 ; ! set hardware broadcast addr -: SIOCGIFCOUNT HEX: 8938 ; ! get number of devices - -: SIOCGIFBR HEX: 8940 ; ! Bridging support -: SIOCSIFBR HEX: 8941 ; ! Set bridging options - -: SIOCGIFTXQLEN HEX: 8942 ; ! Get the tx queue length -: SIOCSIFTXQLEN HEX: 8943 ; ! Set the tx queue length - -: SIOCGIFDIVERT HEX: 8944 ; ! Frame diversion support -: SIOCSIFDIVERT HEX: 8945 ; ! Set frame diversion options - -: SIOCETHTOOL HEX: 8946 ; ! Ethtool interface - -: SIOCGMIIPHY HEX: 8947 ; ! Get address of MII PHY in use -: SIOCGMIIREG HEX: 8948 ; ! Read MII PHY register. -: SIOCSMIIREG HEX: 8949 ; ! Write MII PHY register. - -: SIOCWANDEV HEX: 894A ; ! get/set netdev parameters diff --git a/unmaintained/sockios/tags.txt b/unmaintained/sockios/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/unmaintained/sockios/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/extra/sto/sto.factor b/unmaintained/sto/sto.factor similarity index 100% rename from extra/sto/sto.factor rename to unmaintained/sto/sto.factor diff --git a/unmaintained/strings-lib/lib-tests.factor b/unmaintained/strings-lib/lib-tests.factor deleted file mode 100644 index 6e0ce05eaa..0000000000 --- a/unmaintained/strings-lib/lib-tests.factor +++ /dev/null @@ -1,8 +0,0 @@ -USING: kernel sequences strings.lib tools.test ; -IN: temporary - -[ "abcdefghijklmnopqrstuvwxyz" ] [ lower-alpha-chars "" like ] unit-test -[ "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ] [ upper-alpha-chars "" like ] unit-test -[ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" ] [ alpha-chars "" like ] unit-test -[ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" ] [ alphanumeric-chars "" like ] unit-test -[ t ] [ 100 [ random-alphanumeric-char ] replicate alphanumeric-chars [ member? ] curry all? ] unit-test diff --git a/unmaintained/strings-lib/lib.factor b/unmaintained/strings-lib/lib.factor deleted file mode 100644 index 6ecca05ec8..0000000000 --- a/unmaintained/strings-lib/lib.factor +++ /dev/null @@ -1,33 +0,0 @@ -USING: math math.ranges arrays sequences kernel random splitting -strings unicode.case ; -IN: strings.lib - -: >Upper ( str -- str ) - dup empty? [ unclip ch>upper prefix ] unless ; - -: >Upper-dashes ( str -- str ) - "-" split [ >Upper ] map "-" join ; - -: lower-alpha-chars ( -- seq ) - CHAR: a CHAR: z [a,b] ; - -: upper-alpha-chars ( -- seq ) - CHAR: A CHAR: Z [a,b] ; - -: numeric-chars ( -- seq ) - CHAR: 0 CHAR: 9 [a,b] ; - -: alpha-chars ( -- seq ) - lower-alpha-chars upper-alpha-chars append ; - -: alphanumeric-chars ( -- seq ) - alpha-chars numeric-chars append ; - -: random-alpha-char ( -- ch ) - alpha-chars random ; - -: random-alphanumeric-char ( -- ch ) - alphanumeric-chars random ; - -: random-alphanumeric-string ( length -- str ) - [ random-alphanumeric-char ] "" replicate-as ; diff --git a/unmaintained/swap/authors.txt b/unmaintained/swap/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/swap/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/swap/swap.factor b/unmaintained/swap/swap.factor deleted file mode 100644 index b4edaaa8e3..0000000000 --- a/unmaintained/swap/swap.factor +++ /dev/null @@ -1,12 +0,0 @@ - -USING: alien.syntax ; - -IN: unix.linux.swap - -: SWAP_FLAG_PREFER HEX: 8000 ; ! Set if swap priority is specified. -: SWAP_FLAG_PRIO_MASK HEX: 7fff ; -: SWAP_FLAG_PRIO_SHIFT 0 ; - -FUNCTION: int swapon ( char* path, int flags ) ; - -FUNCTION: int swapoff ( char* path ) ; \ No newline at end of file diff --git a/unmaintained/swap/tags.txt b/unmaintained/swap/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/unmaintained/swap/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/unmaintained/x/authors.txt b/unmaintained/x/authors.txt deleted file mode 100644 index 6cfd5da273..0000000000 --- a/unmaintained/x/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/x/font/authors.txt b/unmaintained/x/font/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/x/font/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/x/font/font.factor b/unmaintained/x/font/font.factor deleted file mode 100644 index 77743fa75d..0000000000 --- a/unmaintained/x/font/font.factor +++ /dev/null @@ -1,27 +0,0 @@ - -USING: kernel namespaces arrays sequences math x11.xlib - mortar slot-accessors x ; - -IN: x.font - -SYMBOL: - - { "dpy" "name" "id" "struct" } accessors define-independent-class - - "create" !( name -- font ) [ -new-empty swap >>name dpy get >>dpy -dpy get $ptr over $name XLoadQueryFont >>struct -dup $struct XFontStruct-fid >>id -] add-class-method - - { - -"ascent" !( font -- ascent ) [ $struct XFontStruct-ascent ] - -"descent" !( font -- ascent ) [ $struct XFontStruct-descent ] - -"height" !( font -- ascent ) [ dup <- ascent swap <- descent + ] - -"text-width" !( font string -- width ) [ >r $struct r> dup length XTextWidth ] - -} add-methods \ No newline at end of file diff --git a/unmaintained/x/gc/authors.txt b/unmaintained/x/gc/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/x/gc/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/x/gc/gc.factor b/unmaintained/x/gc/gc.factor deleted file mode 100644 index 8db610a1ac..0000000000 --- a/unmaintained/x/gc/gc.factor +++ /dev/null @@ -1,28 +0,0 @@ - -USING: kernel namespaces arrays x11.xlib mortar mortar.sugar - slot-accessors x x.font ; - -IN: x.gc - -SYMBOL: - - { "dpy" "ptr" "font" } accessors define-independent-class - - "create" !( -- gc ) [ -new-empty dpy get >>dpy -dpy get $ptr dpy get $default-root $id 0 f XCreateGC >>ptr -"6x13" new* >>font -] add-class-method - - { - -"set-subwindow-mode" !( gc mode -- gc ) - [ >r dup $dpy $ptr over $ptr r> XSetSubwindowMode drop ] - -"set-function" !( gc function -- gc ) - [ >r dup $dpy $ptr over $ptr r> XSetFunction drop ] - -"set-foreground" !( gc foreground -- gc ) - [ >r dup $dpy $ptr over $ptr r> lookup-color XSetForeground drop ] - -} add-methods \ No newline at end of file diff --git a/unmaintained/x/keysym-table/authors.txt b/unmaintained/x/keysym-table/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/x/keysym-table/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/x/keysym-table/keysym-table.factor b/unmaintained/x/keysym-table/keysym-table.factor deleted file mode 100644 index 55d2ab43cd..0000000000 --- a/unmaintained/x/keysym-table/keysym-table.factor +++ /dev/null @@ -1,45 +0,0 @@ -USING: kernel strings assocs sequences math ; - -IN: x.keysym-table - -: keysym-table ( -- table ) -H{ { HEX: FF08 "BACKSPACE" } - { HEX: FF09 "TAB" } - { HEX: FF0D "RETURN" } - { HEX: FF8D "ENTER" } - { HEX: FF1B "ESCAPE" } - { HEX: FFFF "DELETE" } - { HEX: FF50 "HOME" } - { HEX: FF51 "LEFT" } - { HEX: FF52 "UP" } - { HEX: FF53 "RIGHT" } - { HEX: FF54 "DOWN" } - { HEX: FF55 "PAGE-UP" } - { HEX: FF56 "PAGE-DOWN" } - { HEX: FF57 "END" } - { HEX: FF58 "BEGIN" } - { HEX: FFBE "F1" } - { HEX: FFBF "F2" } - { HEX: FFC0 "F3" } - { HEX: FFC1 "F4" } - { HEX: FFC2 "F5" } - { HEX: FFC3 "F6" } - { HEX: FFC4 "F7" } - { HEX: FFC5 "F8" } - { HEX: FFC6 "F9" } - { HEX: FFC7 "F10" } - { HEX: FFC8 "F11" } - { HEX: FFC9 "F12" } - { HEX: FFE1 "LEFT-SHIFT" } - { HEX: FFE2 "RIGHT-SHIFT" } - { HEX: FFE3 "LEFT-CONTROL" } - { HEX: FFE4 "RIGHT-CONTROL" } - { HEX: FFE5 "CAPSLOCK" } - { HEX: FFE9 "LEFT-ALT" } - { HEX: FFEA "RIGHT-ALT" } -} ; - -: keysym>name ( keysym -- name ) -dup keysym-table at dup [ nip ] [ drop 1string ] if ; - -: name>keysym ( name -- keysym ) keysym-table value-at ; diff --git a/unmaintained/x/pen/authors.txt b/unmaintained/x/pen/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/x/pen/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/x/pen/pen.factor b/unmaintained/x/pen/pen.factor deleted file mode 100644 index 59b8aeea44..0000000000 --- a/unmaintained/x/pen/pen.factor +++ /dev/null @@ -1,26 +0,0 @@ - -USING: kernel arrays math.vectors mortar mortar.sugar x.gc slot-accessors geom.pos ; - -IN: x.pen - -SYMBOL: - - { "window" "gc" } accessors define-simple-class - - "create" !( window -- pen ) -[ new-empty swap >>window new* >>gc 0 0 2array >>pos ] -add-class-method - - { - -"line-to" ! ( pen point -- pen ) - [ 2dup >r dup $window swap dup $gc swap $pos r> <---- draw-line >>pos ] - -"line-by" ! ( pen offset -- pen ) - [ 2dup >r dup $window swap dup $gc swap $pos dup r> v+ <---- draw-line - <-- move-by ] - -"draw-string" ! ( pen string -- pen ) - [ >r dup dup $window swap dup $gc swap $pos r> <---- draw-string ] - -} add-methods \ No newline at end of file diff --git a/unmaintained/x/widgets/authors.txt b/unmaintained/x/widgets/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/x/widgets/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/x/widgets/button/authors.txt b/unmaintained/x/widgets/button/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/unmaintained/x/widgets/button/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/unmaintained/x/widgets/button/button.factor b/unmaintained/x/widgets/button/button.factor deleted file mode 100644 index ea46b62a69..0000000000 --- a/unmaintained/x/widgets/button/button.factor +++ /dev/null @@ -1,24 +0,0 @@ - -USING: kernel combinators math x11.xlib - mortar mortar.sugar slot-accessors x.gc x.widgets.label ; - -IN: x.widgets.button - -SYMBOL: