From 7c6b3e6278fe4a94a9ae4b408b2d5c7a6eff9c44 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 6 Jan 2009 16:31:11 -0600 Subject: [PATCH 01/38] L-system: Handle case of 'f' string (use axiom) --- extra/L-system/L-system.factor | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/extra/L-system/L-system.factor b/extra/L-system/L-system.factor index 97a971de47..a38581b0f9 100644 --- a/extra/L-system/L-system.factor +++ b/extra/L-system/L-system.factor @@ -254,9 +254,7 @@ DEFER: default-L-parser-values ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -TUPLE: < gadget - camera display-list - commands axiom rules string ; +TUPLE: < gadget camera display-list commands axiom rules string ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -332,7 +330,7 @@ TUPLE: < gadget ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! :: iterate-L-system-string ( L-SYSTEM -- ) - L-SYSTEM string>> + L-SYSTEM string>> L-SYSTEM axiom>> or L-SYSTEM rules>> iterate-string L-SYSTEM (>>string) ; @@ -357,7 +355,7 @@ TUPLE: < gadget L-SYSTEM display-list>> GL_COMPILE glNewList turtle - L-SYSTEM string>> + L-SYSTEM string>> L-SYSTEM axiom>> or L-SYSTEM commands>> interpret-string drop @@ -403,16 +401,12 @@ M:: pref-dim* ( L-SYSTEM -- dim ) { 400 400 } ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -:: camera-left ( L-SYSTEM -- ) - L-SYSTEM camera>> 5 turn-left drop - L-SYSTEM relayout-1 ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - :: with-camera ( L-SYSTEM QUOT -- ) L-SYSTEM camera>> QUOT call drop L-SYSTEM relayout-1 ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + H{ { T{ key-down f f "LEFT" } [ [ 5 turn-left ] with-camera ] } From ca7ffd6ea223271951204ac53d858bb518a8984a Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 20:57:49 +0100 Subject: [PATCH 02/38] Separate lazy lists from core primes number generation --- extra/math/primes/factors/factors.factor | 2 +- extra/math/primes/lists/authors.txt | 1 + extra/math/primes/lists/lists-docs.factor | 10 ++++++++++ extra/math/primes/lists/lists-tests.factor | 6 ++++++ extra/math/primes/lists/lists.factor | 9 +++++++++ extra/math/primes/lists/summary.txt | 1 + extra/math/primes/primes-docs.factor | 10 +--------- extra/math/primes/primes-tests.factor | 9 ++------- extra/math/primes/primes.factor | 11 +++-------- extra/project-euler/007/007.factor | 2 +- extra/project-euler/134/134.factor | 2 +- 11 files changed, 36 insertions(+), 27 deletions(-) create mode 100644 extra/math/primes/lists/authors.txt create mode 100644 extra/math/primes/lists/lists-docs.factor create mode 100644 extra/math/primes/lists/lists-tests.factor create mode 100644 extra/math/primes/lists/lists.factor create mode 100644 extra/math/primes/lists/summary.txt diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor index 282c46c82e..8e22757249 100644 --- a/extra/math/primes/factors/factors.factor +++ b/extra/math/primes/factors/factors.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007-2009 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel lists make math math.primes sequences ; +USING: arrays kernel lists make math math.primes.lists sequences ; IN: math.primes.factors array ] unit-test +{ { 101 103 107 109 113 } } [ 5 100 lprimes-from ltake list>array ] unit-test +{ { 1000117 1000121 } } [ 2 1000100 lprimes-from ltake list>array ] unit-test +{ { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test diff --git a/extra/math/primes/lists/lists.factor b/extra/math/primes/lists/lists.factor new file mode 100644 index 0000000000..13f314f6ba --- /dev/null +++ b/extra/math/primes/lists/lists.factor @@ -0,0 +1,9 @@ +! Copyright (C) 2007-2009 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel lists.lazy math math.primes ; +IN: math.primes.lists + +: lprimes ( -- list ) 2 [ next-prime ] lfrom-by ; + +: lprimes-from ( n -- list ) + dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; diff --git a/extra/math/primes/lists/summary.txt b/extra/math/primes/lists/summary.txt new file mode 100644 index 0000000000..39a780a26b --- /dev/null +++ b/extra/math/primes/lists/summary.txt @@ -0,0 +1 @@ +Infinite stream of prime numbers through lazy lists diff --git a/extra/math/primes/primes-docs.factor b/extra/math/primes/primes-docs.factor index 516b081624..c7dbc950e8 100644 --- a/extra/math/primes/primes-docs.factor +++ b/extra/math/primes/primes-docs.factor @@ -11,15 +11,7 @@ HELP: prime? { $values { "n" "an integer" } { "?" "a boolean" } } { $description "Test if an integer is a prime number." } ; -{ lprimes lprimes-from primes-upto primes-between } related-words - -HELP: lprimes -{ $values { "list" "a lazy list" } } -{ $description "Return a sorted list containing all the prime numbers." } ; - -HELP: lprimes-from -{ $values { "n" "an integer" } { "list" "a lazy list" } } -{ $description "Return a sorted list containing all the prime numbers greater or equal to " { $snippet "n" } "." } ; +{ primes-upto primes-between } related-words HELP: primes-upto { $values { "n" "an integer" } { "seq" "a sequence" } } diff --git a/extra/math/primes/primes-tests.factor b/extra/math/primes/primes-tests.factor index b0b25285c0..db738399ef 100644 --- a/extra/math/primes/primes-tests.factor +++ b/extra/math/primes/primes-tests.factor @@ -1,14 +1,9 @@ -USING: arrays math.primes tools.test lists.lazy ; +USING: arrays math.primes tools.test ; { 1237 } [ 1234 next-prime ] unit-test { f t } [ 1234 prime? 1237 prime? ] unit-test -{ { 2 3 5 7 11 13 17 19 23 29 } } [ 10 lprimes ltake list>array ] unit-test -{ { 101 103 107 109 113 } } [ 5 100 lprimes-from ltake list>array ] unit-test -{ { 1000117 1000121 } } [ 2 1000100 lprimes-from ltake list>array ] unit-test -{ { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test { { 2 3 5 7 } } [ 10 primes-upto >array ] unit-test { { 999983 1000003 } } [ 999982 1000010 primes-between >array ] unit-test { { 4999963 4999999 5000011 5000077 5000081 } } -[ 4999962 5000082 primes-between >array ] -unit-test +[ 4999962 5000082 primes-between >array ] unit-test diff --git a/extra/math/primes/primes.factor b/extra/math/primes/primes.factor index fa42d7385a..807ebf097b 100644 --- a/extra/math/primes/primes.factor +++ b/extra/math/primes/primes.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2007 Samuel Tardieu. +! Copyright (C) 2007-2009 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators kernel lists.lazy math math.functions -math.miller-rabin math.order math.primes.erato math.ranges sequences ; +USING: combinators kernel math math.functions math.miller-rabin +math.order math.primes.erato math.ranges sequences ; IN: math.primes : next-prime ( n -- p ) next-odd [ dup really-prime? ] [ 2 + ] [ ] until ; foldable -: lprimes ( -- list ) 2 [ next-prime ] lfrom-by ; - -: lprimes-from ( n -- list ) - dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; - : primes-between ( low high -- seq ) [ dup 3 max dup even? [ 1 + ] when ] dip 2 [ prime? ] filter diff --git a/extra/project-euler/007/007.factor b/extra/project-euler/007/007.factor index f2b659fe94..f40108e4d7 100644 --- a/extra/project-euler/007/007.factor +++ b/extra/project-euler/007/007.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: lists math math.primes ; +USING: lists math math.primes.lists ; IN: project-euler.007 ! http://projecteuler.net/index.php?section=problems&id=7 diff --git a/extra/project-euler/134/134.factor b/extra/project-euler/134/134.factor index 7bdf17ef68..e00e86865d 100644 --- a/extra/project-euler/134/134.factor +++ b/extra/project-euler/134/134.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel lists lists.lazy math.algebra math math.functions - math.order math.primes math.ranges project-euler.common sequences ; + math.order math.primes.lists math.ranges project-euler.common sequences ; IN: project-euler.134 ! http://projecteuler.net/index.php?section=problems&id=134 From 594bd3aee87eeeecaa1d93e26aa03feeacf52454 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 21:12:48 +0100 Subject: [PATCH 03/38] Move math.primes from extra to basis --- {extra => basis}/math/primes/authors.txt | 0 {extra => basis}/math/primes/erato/authors.txt | 0 {extra => basis}/math/primes/erato/erato-docs.factor | 0 {extra => basis}/math/primes/erato/erato-tests.factor | 0 {extra => basis}/math/primes/erato/erato.factor | 0 {extra => basis}/math/primes/erato/summary.txt | 0 {extra => basis}/math/primes/primes-docs.factor | 0 {extra => basis}/math/primes/primes-tests.factor | 0 {extra => basis}/math/primes/primes.factor | 0 {extra => basis}/math/primes/summary.txt | 0 10 files changed, 0 insertions(+), 0 deletions(-) rename {extra => basis}/math/primes/authors.txt (100%) rename {extra => basis}/math/primes/erato/authors.txt (100%) rename {extra => basis}/math/primes/erato/erato-docs.factor (100%) rename {extra => basis}/math/primes/erato/erato-tests.factor (100%) rename {extra => basis}/math/primes/erato/erato.factor (100%) rename {extra => basis}/math/primes/erato/summary.txt (100%) rename {extra => basis}/math/primes/primes-docs.factor (100%) rename {extra => basis}/math/primes/primes-tests.factor (100%) rename {extra => basis}/math/primes/primes.factor (100%) rename {extra => basis}/math/primes/summary.txt (100%) diff --git a/extra/math/primes/authors.txt b/basis/math/primes/authors.txt similarity index 100% rename from extra/math/primes/authors.txt rename to basis/math/primes/authors.txt diff --git a/extra/math/primes/erato/authors.txt b/basis/math/primes/erato/authors.txt similarity index 100% rename from extra/math/primes/erato/authors.txt rename to basis/math/primes/erato/authors.txt diff --git a/extra/math/primes/erato/erato-docs.factor b/basis/math/primes/erato/erato-docs.factor similarity index 100% rename from extra/math/primes/erato/erato-docs.factor rename to basis/math/primes/erato/erato-docs.factor diff --git a/extra/math/primes/erato/erato-tests.factor b/basis/math/primes/erato/erato-tests.factor similarity index 100% rename from extra/math/primes/erato/erato-tests.factor rename to basis/math/primes/erato/erato-tests.factor diff --git a/extra/math/primes/erato/erato.factor b/basis/math/primes/erato/erato.factor similarity index 100% rename from extra/math/primes/erato/erato.factor rename to basis/math/primes/erato/erato.factor diff --git a/extra/math/primes/erato/summary.txt b/basis/math/primes/erato/summary.txt similarity index 100% rename from extra/math/primes/erato/summary.txt rename to basis/math/primes/erato/summary.txt diff --git a/extra/math/primes/primes-docs.factor b/basis/math/primes/primes-docs.factor similarity index 100% rename from extra/math/primes/primes-docs.factor rename to basis/math/primes/primes-docs.factor diff --git a/extra/math/primes/primes-tests.factor b/basis/math/primes/primes-tests.factor similarity index 100% rename from extra/math/primes/primes-tests.factor rename to basis/math/primes/primes-tests.factor diff --git a/extra/math/primes/primes.factor b/basis/math/primes/primes.factor similarity index 100% rename from extra/math/primes/primes.factor rename to basis/math/primes/primes.factor diff --git a/extra/math/primes/summary.txt b/basis/math/primes/summary.txt similarity index 100% rename from extra/math/primes/summary.txt rename to basis/math/primes/summary.txt From b3d175821a0a9d94680e2fbf8be31275a798902c Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 7 Jan 2009 15:08:08 -0600 Subject: [PATCH 04/38] Unicode word breaks --- basis/unicode/breaks/breaks-tests.factor | 2 +- basis/unicode/breaks/breaks.factor | 69 ++++++++++++++++-------- 2 files changed, 49 insertions(+), 22 deletions(-) diff --git a/basis/unicode/breaks/breaks-tests.factor b/basis/unicode/breaks/breaks-tests.factor index 39baa8f808..b91cb2b26c 100644 --- a/basis/unicode/breaks/breaks-tests.factor +++ b/basis/unicode/breaks/breaks-tests.factor @@ -36,4 +36,4 @@ IN: unicode.breaks.tests ] each ; grapheme-break-test parse-test-file [ >graphemes ] test -! word-break-test parse-test-file [ >words ] test +word-break-test parse-test-file [ >words ] test diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index 9d2bad4724..5652cc2906 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -110,10 +110,10 @@ VALUE: grapheme-table str [ dup quot call cut-slice swap , quot (>pieces) - ] unless-empty ; + ] unless-empty ; inline recursive : >pieces ( str quot -- graphemes ) - [ (>pieces) ] { } make ; + [ (>pieces) ] { } make ; inline : >graphemes ( str -- graphemes ) [ first-grapheme ] >pieces ; @@ -139,14 +139,14 @@ to: word-break-table C-ENUM: wOther wCR wLF wNewline wExtend wFormat wKatakana wALetter wMidLetter wMidNum wMidNumLet wNumeric wExtendNumLet words ; -MEMO: word-break-classes ( -- table ) +: word-break-classes ( -- table ) ! Is there a way to avoid this? H{ - { "Other" wOther } { "CR" wCR } { "LF" wLF } { "Newline" wNewline } - { "Extend" wExtend } { "Format" wFormat } { "Katakana" wKatakana } - { "ALetter" wALetter } { "MidLetter" wMidLetter } - { "MidNum" wMidNum } { "MidNumLet" wMidNumLet } { "Numeric" wNumeric } - { "ExtendNumLet" wExtendNumLet } - } [ execute ] assoc-map ; + { "Other" 0 } { "CR" 1 } { "LF" 2 } { "Newline" 3 } + { "Extend" 4 } { "Format" 5 } { "Katakana" 6 } + { "ALetter" 7 } { "MidLetter" 8 } + { "MidNum" 9 } { "MidNumLet" 10 } { "Numeric" 11 } + { "ExtendNumLet" 12 } + } ; : word-break-prop ( char -- word-break-prop ) word-break-table interval-at @@ -185,22 +185,49 @@ words init-table table [ make-word-table finish-word-table ] with-variable to: word-table -: word-break? ( class1 class2 -- ? ) - word-table nth nth not ; +: word-table-nth ( class1 class2 -- ? ) + word-table nth nth ; -: skip? ( char -- ? ) - word-break-prop { 4 5 } member? ; ! wExtend or wFormat +: property-not= ( i str property -- ? ) + pick [ + [ ?nth ] dip swap + [ word-break-prop = not ] [ drop f ] if* + ] [ 3drop t ] if ; -: word-break-next ( old-class new-char -- next-class ? ) - word-break-prop dup { 4 5 } member? - [ drop f ] [ tuck word-break? ] if ; +: format/extended? ( ch -- ? ) + word-break-prop { 4 5 } member? ; -: first-word ( str -- i ) - unclip-slice word-break-prop over - [ word-break-next ] find-index +:: walk-up ( str i -- j ) + i 1 + str [ format/extended? not ] find-from drop + 1+ str [ format/extended? not ] find-from drop ; ! possible bounds error? + +:: walk-down ( str i -- j ) + i str [ format/extended? not ] find-last-from drop + 1- str [ format/extended? not ] find-last-from drop ; ! possible bounds error? + +:: word-break? ( table-entry i str -- ? ) + table-entry { + { t [ f ] } + { f [ t ] } + { check-letter-after + [ str i walk-up str wALetter property-not= ] } + { check-letter-before + [ str i walk-down str wALetter property-not= ] } + { check-number-after + [ str i walk-up str wNumeric property-not= ] } + { check-number-before + [ str i walk-down str wNumeric property-not= ] } + } case ; + +:: word-break-next ( old-class new-char i str -- next-class ? ) + new-char word-break-prop dup { 4 5 } member? + [ drop old-class dup { 1 2 3 } member? ] + [ old-class over word-table-nth i str word-break? ] if ; + +:: first-word ( str -- i ) + str unclip-slice word-break-prop over + [ swap str word-break-next ] assoc-find 2drop nip swap length or 1+ ; -! This must be changed to ignore format/extended chars and -! handle symbols in the table specially : >words ( str -- words ) [ first-word ] >pieces ; From 397790241f2aa13b67b9b3dc58c1110640b2beee Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 22:16:39 +0100 Subject: [PATCH 05/38] math.primes.factors rewrite --- extra/math/primes/factors/factors.factor | 39 +++++++++--------------- 1 file changed, 14 insertions(+), 25 deletions(-) diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor index 8e22757249..05d6b26010 100644 --- a/extra/math/primes/factors/factors.factor +++ b/extra/math/primes/factors/factors.factor @@ -1,40 +1,29 @@ ! Copyright (C) 2007-2009 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel lists make math math.primes.lists sequences ; +USING: arrays combinators kernel make math math.primes sequences ; IN: math.primes.factors [ - swap uncons swap [ pick call ] dip swap (factors) - ] [ 3drop ] if ; inline recursive - -: decompose ( n quot -- seq ) [ lprimes rot (factors) ] { } make ; inline +: write-factor ( n d -- n' d ) + 2dup mod zero? [ [ [ count-factor ] keep swap 2array , ] keep ] when ; PRIVATE> -: factors ( n -- seq ) [ (factor) ] decompose ; flushable +: group-factors ( n -- seq ) + [ 2 [ over 1 > ] [ write-factor next-prime ] [ ] while 2drop ] { } make ; -: group-factors ( n -- seq ) [ (count) ] decompose ; flushable +: unique-factors ( n -- seq ) group-factors [ first ] map ; -: unique-factors ( n -- seq ) [ (unique) ] decompose ; flushable +: factors ( n -- seq ) group-factors [ first2 swap ] map concat ; : totient ( n -- t ) - dup 2 < [ - drop 0 - ] [ - dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / * - ] if ; foldable + { + { [ dup 2 < ] [ drop 0 ] } + [ dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / * ] + } cond ; foldable From 6a2f46ed7f5a472806830282eb2579a36861a5ba Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 23:01:27 +0100 Subject: [PATCH 06/38] Move math.primes.factors from extra to basis --- {extra => basis}/math/primes/factors/authors.txt | 0 {extra => basis}/math/primes/factors/factors-docs.factor | 0 {extra => basis}/math/primes/factors/factors-tests.factor | 0 {extra => basis}/math/primes/factors/factors.factor | 0 {extra => basis}/math/primes/factors/summary.txt | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename {extra => basis}/math/primes/factors/authors.txt (100%) rename {extra => basis}/math/primes/factors/factors-docs.factor (100%) rename {extra => basis}/math/primes/factors/factors-tests.factor (100%) rename {extra => basis}/math/primes/factors/factors.factor (100%) rename {extra => basis}/math/primes/factors/summary.txt (100%) diff --git a/extra/math/primes/factors/authors.txt b/basis/math/primes/factors/authors.txt similarity index 100% rename from extra/math/primes/factors/authors.txt rename to basis/math/primes/factors/authors.txt diff --git a/extra/math/primes/factors/factors-docs.factor b/basis/math/primes/factors/factors-docs.factor similarity index 100% rename from extra/math/primes/factors/factors-docs.factor rename to basis/math/primes/factors/factors-docs.factor diff --git a/extra/math/primes/factors/factors-tests.factor b/basis/math/primes/factors/factors-tests.factor similarity index 100% rename from extra/math/primes/factors/factors-tests.factor rename to basis/math/primes/factors/factors-tests.factor diff --git a/extra/math/primes/factors/factors.factor b/basis/math/primes/factors/factors.factor similarity index 100% rename from extra/math/primes/factors/factors.factor rename to basis/math/primes/factors/factors.factor diff --git a/extra/math/primes/factors/summary.txt b/basis/math/primes/factors/summary.txt similarity index 100% rename from extra/math/primes/factors/summary.txt rename to basis/math/primes/factors/summary.txt From e4b3f01e9e0b275275716b1bca8c8957ad31a3a1 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 23:16:27 +0100 Subject: [PATCH 07/38] Fix bit-array>integer byte ordering --- basis/bit-arrays/bit-arrays-tests.factor | 2 ++ basis/bit-arrays/bit-arrays.factor | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/bit-arrays/bit-arrays-tests.factor b/basis/bit-arrays/bit-arrays-tests.factor index 24c27fa15b..1de49d353d 100644 --- a/basis/bit-arrays/bit-arrays-tests.factor +++ b/basis/bit-arrays/bit-arrays-tests.factor @@ -78,3 +78,5 @@ IN: bit-arrays.tests } bit-array>integer ] unit-test [ 49 ] [ 49 dup set-bits [ ] count ] unit-test + +[ HEX: 100 ] [ ?{ f f f f f f f f t } bit-array>integer ] unit-test diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index 18796fbfed..f1ba71ce1e 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -83,7 +83,7 @@ M: bit-array byte-length length 7 + -3 shift ; ] if ; : bit-array>integer ( bit-array -- n ) - 0 swap underlying>> dup length [ + 0 swap underlying>> dup length [ alien-unsigned-1 swap 8 shift bitor ] with each ; From 589e509469072e6a05068022ebf81bd0bb450b99 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 16:24:56 -0600 Subject: [PATCH 08/38] L-system: Add rotating pedestal --- extra/L-system/L-system.factor | 51 +++++++++++++++++++++++++++++----- 1 file changed, 44 insertions(+), 7 deletions(-) diff --git a/extra/L-system/L-system.factor b/extra/L-system/L-system.factor index a38581b0f9..43e6cbbfa6 100644 --- a/extra/L-system/L-system.factor +++ b/extra/L-system/L-system.factor @@ -1,9 +1,9 @@ -USING: accessors arrays assocs colors combinators.short-circuit -kernel locals math math.functions math.matrices math.order -math.parser math.trig math.vectors opengl opengl.demo-support -opengl.gl sbufs sequences strings ui.gadgets ui.gadgets.worlds -ui.gestures ui.render ; +USING: accessors arrays assocs calendar colors +combinators.short-circuit kernel locals math math.functions +math.matrices math.order math.parser math.trig math.vectors +opengl opengl.demo-support opengl.gl sbufs sequences strings +threads ui.gadgets ui.gadgets.worlds ui.gestures ui.render ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -254,7 +254,27 @@ DEFER: default-L-parser-values ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -TUPLE: < gadget camera display-list commands axiom rules string ; +TUPLE: < gadget + camera display-list pedestal paused commands axiom rules string ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: iterate-system ( GADGET -- ) GADGET pedestal>> 0.5 + GADGET (>>pedestal) ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: start-rotation-thread ( GADGET -- ) + GADGET f >>paused drop + [ + [ + GADGET paused>> + [ f ] + [ GADGET iterate-system GADGET relayout-1 25 milliseconds sleep t ] + if + ] + loop + ] + in-thread ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -385,6 +405,10 @@ M:: draw-gadget* ( L-SYSTEM -- ) ! draw axis white gl-color GL_LINES glBegin { 0 0 0 } gl-vertex { 0 0 1 } gl-vertex glEnd + ! rotate pedestal + + L-SYSTEM pedestal>> 0 0 1 glRotated + L-SYSTEM display-list>> glCallList ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -417,6 +441,11 @@ H{ { T{ key-down f f "a" } [ [ 1 step-turtle ] with-camera ] } { T{ key-down f f "z" } [ [ -1 step-turtle ] with-camera ] } + { T{ key-down f f "q" } [ [ 5 roll-left ] with-camera ] } + { T{ key-down f f "w" } [ [ 5 roll-right ] with-camera ] } + + { T{ key-down f f "r" } [ start-rotation-thread ] } + { T{ key-down f f "x" } [ @@ -435,8 +464,16 @@ set-gestures : L-system ( -- L-system ) new-gadget + + 0 >>pedestal - turtle 45 turn-left 45 pitch-up 5 step-turtle 180 turn-left >>camera ; + ! turtle 45 turn-left 45 pitch-up 5 step-turtle 180 turn-left >>camera ; + + turtle 90 pitch-down -5 step-turtle 2 strafe-up >>camera + + dup start-rotation-thread + + ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 13cf6ec4be623f4fece0b972579adaa4ca2c4780 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 16:25:32 -0600 Subject: [PATCH 09/38] L-system.models.abop-1: Minor tweaks --- extra/L-system/models/abop-1/abop-1.factor | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/extra/L-system/models/abop-1/abop-1.factor b/extra/L-system/models/abop-1/abop-1.factor index 45cc522470..34f1d4777a 100644 --- a/extra/L-system/models/abop-1/abop-1.factor +++ b/extra/L-system/models/abop-1/abop-1.factor @@ -1,5 +1,5 @@ -USING: accessors kernel ui L-system ; +USING: accessors ui L-system ; IN: L-system.models.abop-1 @@ -12,15 +12,13 @@ IN: L-system.models.abop-1 "c(12)FFAL" >>axiom { - { "A" "F[&'(.8)!BL]>(137)'!(.9)A" } - { "B" "F[-'(.8)!(.9)$CL]'!(.9)C" } - { "C" "F[+'(.8)!(.9)$BL]'!(.9)B" } + { "A" "F [ & '(.8) ! B L ] >(137) ' !(.9) A" } + { "B" "F [ - '(.8) !(.9) $ C L ] ' !(.9) C" } + { "C" "F [ + '(.8) !(.9) $ B L ] ' !(.9) B" } - { "L" "~c(8){+(30)f-(120)f-(120)f}" } + { "L" " ~ c(8) { +(30) f -(120) f -(120) f }" } } - >>rules - - dup axiom>> >>string ; + >>rules ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 80ada88038a71dc8e0325bf1a8eeaaf47fe049bc Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 16:26:19 -0600 Subject: [PATCH 10/38] Add L-system.models.abop-2 --- extra/L-system/models/abop-2/abop-2.factor | 28 ++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 extra/L-system/models/abop-2/abop-2.factor diff --git a/extra/L-system/models/abop-2/abop-2.factor b/extra/L-system/models/abop-2/abop-2.factor new file mode 100644 index 0000000000..2ed8f64abe --- /dev/null +++ b/extra/L-system/models/abop-2/abop-2.factor @@ -0,0 +1,28 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-2 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-2 ( -- ) + + L-parser-dialect >>commands + + "c(12)FAL" >>axiom + + { + { "A" "F[&'(.7)!BL]>(137)[&'(.6)!BL]>(137)'(.9)!(.9)A" } + { "B" "F[-'(.7)!(.9)$CL]'(.9)!(.9)C" } + { "C" "F[+'(.7)!(.9)$BL]'(.9)!(.9)B" } + + { "L" "~c(8){+f(.1)-f(.1)-f(.1)+|+f(.1)-f(.1)-f(.1)}" } + + } >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-2 "L-system" open-window ] with-ui ; + +MAIN: main + \ No newline at end of file From d75f686a686b712e321c6e41fea0384cf6b61b13 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 16:47:25 -0600 Subject: [PATCH 11/38] L-system: offer help via F1 --- extra/L-system/L-system.factor | 31 +++++++++++++++++++++++++++---- 1 file changed, 27 insertions(+), 4 deletions(-) diff --git a/extra/L-system/L-system.factor b/extra/L-system/L-system.factor index 43e6cbbfa6..9b8bdc1914 100644 --- a/extra/L-system/L-system.factor +++ b/extra/L-system/L-system.factor @@ -1,9 +1,10 @@ USING: accessors arrays assocs calendar colors -combinators.short-circuit kernel locals math math.functions -math.matrices math.order math.parser math.trig math.vectors -opengl opengl.demo-support opengl.gl sbufs sequences strings -threads ui.gadgets ui.gadgets.worlds ui.gestures ui.render ; +combinators.short-circuit help.markup help.syntax kernel locals +math math.functions math.matrices math.order math.parser +math.trig math.vectors opengl opengl.demo-support opengl.gl +sbufs sequences strings threads ui.gadgets ui.gadgets.worlds +ui.gestures ui.render ui.tools.workspace ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -455,6 +456,8 @@ H{ drop ] } + + { T{ key-down f f "F1" } [ drop "L-system" help-window ] } } set-gestures @@ -477,3 +480,23 @@ set-gestures ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +ARTICLE: "L-system" "L-system" + +"Press 'x' to iterate the L-system." $nl + +"Camera control:" + +{ $table + + { "a" "Forward" } + { "z" "Backward" } + + { "LEFT" "Turn left" } + { "RIGHT" "Turn right" } + { "UP" "Pitch down" } + { "DOWN" "Pitch up" } + + { "q" "Roll left" } + { "w" "Roll right" } } ; + +ABOUT: "L-system" \ No newline at end of file From 501fb3ccf1d70482bda85c67085b0492220789f3 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 7 Jan 2009 17:59:01 -0600 Subject: [PATCH 12/38] Unicode docs --- basis/bootstrap/unicode/unicode.factor | 2 +- basis/unicode/breaks/breaks-docs.factor | 39 ++++++++++++ basis/unicode/breaks/breaks.factor | 13 +++- basis/unicode/case/case-docs.factor | 19 ++++++ basis/unicode/case/case.factor | 7 ++- .../unicode/categories/categories-docs.factor | 59 +++++++++++++++++++ basis/unicode/collation/collation-docs.factor | 8 +-- basis/unicode/normalize/normalize-docs.factor | 33 +++++++++++ basis/unicode/normalize/normalize.factor | 11 +++- basis/unicode/unicode-docs.factor | 16 +++++ basis/unicode/unicode.factor | 1 + 11 files changed, 197 insertions(+), 11 deletions(-) create mode 100644 basis/unicode/breaks/breaks-docs.factor create mode 100644 basis/unicode/case/case-docs.factor create mode 100644 basis/unicode/categories/categories-docs.factor create mode 100644 basis/unicode/normalize/normalize-docs.factor create mode 100644 basis/unicode/unicode-docs.factor create mode 100644 basis/unicode/unicode.factor diff --git a/basis/bootstrap/unicode/unicode.factor b/basis/bootstrap/unicode/unicode.factor index 1046d41bdc..1e9f8b8642 100644 --- a/basis/bootstrap/unicode/unicode.factor +++ b/basis/bootstrap/unicode/unicode.factor @@ -1,4 +1,4 @@ -USING: strings.parser kernel namespaces unicode.data ; +USING: strings.parser kernel namespaces unicode unicode.data ; IN: bootstrap.unicode [ name>char [ "Invalid character" throw ] unless* ] diff --git a/basis/unicode/breaks/breaks-docs.factor b/basis/unicode/breaks/breaks-docs.factor new file mode 100644 index 0000000000..552883a299 --- /dev/null +++ b/basis/unicode/breaks/breaks-docs.factor @@ -0,0 +1,39 @@ +USING: help.syntax help.markup strings ; +IN: unicode.breaks + +ABOUT: "unicode.breaks" + +ARTICLE: "unicode.breaks" "Word and grapheme breaks" +"The " { $vocab-link "unicode.breaks" "unicode.breaks" } " vocabulary partially implements Unicode Standard Annex #29. This provides for segmentation of a string along grapheme and word boundaries. In Unicode, a grapheme, or a basic unit of display in text, may be more than one code point. For example, in the string \"e\\u000301\" (where U+0301 is a combining acute accent), there is only one grapheme, as the acute accent goes above the e, forming a single grapheme. Word breaks, in general, are more complicated than simply splitting by whitespace, and the Unicode algorithm provides for that." +$nl "Operations for graphemes:" +{ $subsection first-grapheme } +{ $subsection last-grapheme } +{ $subsection >graphemes } +{ $subsection string-reverse } +"Operations on words:" +{ $subsection first-word } +{ $subsection >words } ; + +HELP: first-grapheme +{ $values { "str" string } { "i" "an index" } } +{ $description "Finds the length of the first grapheme of the string. This can be used repeatedly to efficiently traverse the graphemes of the string, using slices." } ; + +HELP: last-grapheme +{ $values { "str" string } { "i" "an index" } } +{ $description "Finds the index of the start of the last grapheme of the string. This can be used to traverse the graphemes of a string backwards." } ; + +HELP: >graphemes +{ $values { "str" string } { "graphemes" "an array of strings" } } +{ $description "Divides a string into a sequence of individual graphemes." } ; + +HELP: string-reverse +{ $values { "str" string } { "rts" string } } +{ $description "Reverses a string, leaving graphemes in-tact." } ; + +HELP: first-word +{ $values { "str" string } { "i" "index" } } +{ $description "Finds the length of the first word in the string." } ; + +HELP: >words +{ $values { "str" string } { "words" "an array of strings" } } +{ $description "Divides the string up into words." } ; diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index 5652cc2906..b85e8879e1 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -2,11 +2,12 @@ ! See http://factorcode.org/license.txt for BSD license. USING: combinators.short-circuit unicode.categories kernel math combinators splitting sequences math.parser io.files io assocs -arrays namespaces make math.ranges unicode.normalize values +arrays namespaces make math.ranges unicode.normalize.private values io.encodings.ascii unicode.syntax unicode.data compiler.units alien.syntax sets accessors interval-maps memoize locals words ; IN: unicode.breaks + + : first-grapheme ( str -- i ) unclip-slice grapheme-class over [ grapheme-class tuck grapheme-break? ] find-index nip swap length or 1+ ; +pieces) ( str quot -- ) str [ dup quot call cut-slice @@ -115,6 +120,8 @@ VALUE: grapheme-table : >pieces ( str quot -- graphemes ) [ (>pieces) ] { } make ; inline +PRIVATE> + : >graphemes ( str -- graphemes ) [ first-grapheme ] >pieces ; @@ -125,6 +132,8 @@ VALUE: grapheme-table unclip-last-slice grapheme-class swap [ grapheme-class dup rot grapheme-break? ] find-last-index ?1+ nip ; + + :: first-word ( str -- i ) str unclip-slice word-break-prop over [ swap str word-break-next ] assoc-find 2drop diff --git a/basis/unicode/case/case-docs.factor b/basis/unicode/case/case-docs.factor new file mode 100644 index 0000000000..a5790f9a54 --- /dev/null +++ b/basis/unicode/case/case-docs.factor @@ -0,0 +1,19 @@ +USING: help.syntax help.markup ; +IN: unicode.case + +ABOUT: "unicode.case" + +ARTICLE: "unicode.case" "Case mapping" +"When considering Unicode in general and not just ASCII or a smaller character set, putting a string in upper case, title case or lower case is slightly more complicated. In most contexts it's best to use the general Unicode routines for case conversion. There is an additional type of casing, case-fold, which is defined as bringing a string into upper case and then lower. This exists because in some cases it is different from simple lower case." +{ $subsection >upper } +{ $subsection >lower } +{ $subsection >title } +{ $subsection >case-fold } +"To test if a string is in a given case:" +{ $subsection upper? } +{ $subsection lower? } +{ $subsection title? } +{ $subsection case-fold? } +"For certain languages (Turkish, Azeri, Lithuanian), case mapping is dependent on locale; To change this, set the following variable to the ISO-639-1 code for your language:" +{ $subsection locale } +"This is unnecessary for most languages." ; diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index ea1baa6e9c..42fd13fc97 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -5,14 +5,15 @@ unicode.normalize math unicode.categories combinators assocs strings splitting kernel accessors ; IN: unicode.case +lower ( ch -- lower ) simple-lower at-default ; : ch>upper ( ch -- upper ) simple-upper at-default ; : ch>title ( ch -- title ) simple-title at-default ; - +PRIVATE> SYMBOL: locale ! Just casing locale, or overall? - + : >lower ( string -- lower ) i-dot? [ turk>lower ] when final-sigma [ lower>> ] [ ch>lower ] map-case ; diff --git a/basis/unicode/categories/categories-docs.factor b/basis/unicode/categories/categories-docs.factor new file mode 100644 index 0000000000..421fa90dd2 --- /dev/null +++ b/basis/unicode/categories/categories-docs.factor @@ -0,0 +1,59 @@ +! Copyright (C) 2009 Your name. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel ; +IN: unicode.categories + +HELP: LETTER? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Determines whether the code point is an upper-cased letter" } ; + +HELP: Letter? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Determines whether the code point is a letter of any case" } ; + +HELP: alpha? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Determines whether the code point is alphanumeric" } ; + +HELP: blank? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Determines whether the code point is whitespace" } ; + +HELP: character? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Determines whether a number is a code point which has been assigned" } ; + +HELP: control? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Determines whether a code point is a control character" } ; + +HELP: digit? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Determines whether a code point is a digit" } ; + +HELP: letter? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Determines whether a code point is a lower-cased letter" } ; + +HELP: printable? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Determines whether a code point is printable, as opposed to being a control character or formatting character" } ; + +HELP: uncased? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Determines whether a character has a case" } ; + +ARTICLE: "unicode.categories" "Character classes" +{ $vocab-link "unicode.categories" } " is a vocabulary which provides predicates for determining if a code point has a particular property, for example being a lower cased letter. These should be used in preference to the " { $vocab-link "ASCII" "ascii" } " equivalents in most cases. Below are links to the useful predicates, but note that each of these is defined to be a predicate class." +{ $subsection blank? } +{ $subsection letter? } +{ $subsection LETTER? } +{ $subsection Letter? } +{ $subsection digit? } +{ $subsection printable? } +{ $subsection alpha? } +{ $subsection control? } +{ $subsection uncased? } +{ $subsection character? } ; + +ABOUT: "unicode.categories" diff --git a/basis/unicode/collation/collation-docs.factor b/basis/unicode/collation/collation-docs.factor index 3847ca2237..183ca85b69 100644 --- a/basis/unicode/collation/collation-docs.factor +++ b/basis/unicode/collation/collation-docs.factor @@ -1,10 +1,8 @@ USING: help.syntax help.markup strings byte-arrays ; IN: unicode.collation -ABOUT: "unicode.collation" - -ARTICLE: "unicode.collation" "Unicode collation algorithm (UCA)" -"The Unicode Collation Algorithm (UTS #10) forms a reasonable way to sort strings when accouting for all of the characters in Unicode. At the moment, only the default Unicode collation element table (DUCET) is used, but a more accurate collation would take locale into account. The following words are defined:" +ARTICLE: "unicode.collation" "Collation and weak comparison" +"The " { $vocab-link "unicode.collation" "unicode.collation" } " vocabulary implements the Unicode Collation Algorithm. The Unicode Collation Algorithm (UTS #10) forms a reasonable way to sort strings when accouting for all of the characters in Unicode. It is far preferred over code point order when sorting for human consumption, in user interfaces. At the moment, only the default Unicode collation element table (DUCET) is used, but a more accurate collation would take locale into account. The following words are defined:" { $subsection sort-strings } { $subsection collation-key } { $subsection string<=> } @@ -13,6 +11,8 @@ ARTICLE: "unicode.collation" "Unicode collation algorithm (UCA)" { $subsection tertiary= } { $subsection quaternary= } ; +ABOUT: "unicode.collation" + HELP: sort-strings { $values { "strings" "a sequence of strings" } { "sorted" "the strings in DUCET order" } } { $description "This word takes a sequence of strings and sorts them according to the UCA, using code point order as a tie-breaker." } ; diff --git a/basis/unicode/normalize/normalize-docs.factor b/basis/unicode/normalize/normalize-docs.factor new file mode 100644 index 0000000000..423332fb6e --- /dev/null +++ b/basis/unicode/normalize/normalize-docs.factor @@ -0,0 +1,33 @@ +USING: help.syntax help.markup strings ; +IN: unicode.normalize + +ABOUT: "unicode.normalize" + +ARTICLE: "unicode.normalize" "Unicode normalization" +"The " { $vocab-link "unicode.normalize" "unicode.normalize" } " vocabulary defines words for normalizing Unicode strings. In Unicode, it is often possible to have multiple sequences of characters which really represent exactly the same thing. For example, to represent e with an acute accent above, there are two possible strings: \"e\\u000301\" (the e character, followed by the combining acute accent character) and \"\\u0000e9\" (a single character, e with an acute accent). There are four normalization forms: NFD, NFC, NFKD, and NFKC. Basically, in NFD and NFKD, everything is expanded, whereas in NFC and NFKC, everything is contracted. In NFKD and NFKC, more things are expanded and contracted. This is a process which loses some information, so it should be done only with care. Most of the world uses NFC to communicate, but for many purposes, NFD/NFKD is easier to process. For more information, see Unicode Standard Annex #15 and section 3 of the Unicode standard." +{ $subsection nfc } +{ $subsection nfd } +{ $subsection nfkc } +{ $subsection nfkd } +"If two strings in a normalization form are appended, the result may not be in that normalization form still. To append two strings in NFD and make sure the result is in NFD, the following procedure is supplied:" +{ $subsection string-append } ; + +HELP: nfc +{ $values { "string" string } { "nfc" "a string in NFC" } } +{ $description "Converts a string to Normalization Form C" } ; + +HELP: nfd +{ $values { "string" string } { "nfd" "a string in NFD" } } +{ $description "Converts a string to Normalization Form D" } ; + +HELP: nfkc +{ $values { "string" string } { "nfkc" "a string in NFKC" } } +{ $description "Converts a string to Normalization Form KC" } ; + +HELP: nfkd +{ $values { "string" string } { "nfc" "a string in NFKD" } } +{ $description "Converts a string to Normalization Form KD" } ; + +HELP: string-append +{ $values { "s1" "a string in NFD" } { "s2" "a string in NFD" } { "string" "a string in NFD" } } +{ $description "Appends two strings, putting the result in NFD." } ; diff --git a/basis/unicode/normalize/normalize.factor b/basis/unicode/normalize/normalize.factor index 7a411a0141..eacdb2724a 100644 --- a/basis/unicode/normalize/normalize.factor +++ b/basis/unicode/normalize/normalize.factor @@ -4,6 +4,7 @@ USING: sequences namespaces make unicode.data kernel math arrays locals sorting.insertion accessors assocs ; IN: unicode.normalize + + +: nfd ( string -- nfd ) [ canonical-entry ] decompose ; -: nfkd ( string -- string ) +: nfkd ( string -- nfkd ) [ compatibility-entry ] decompose ; : string-append ( s1 s2 -- string ) @@ -87,6 +90,8 @@ IN: unicode.normalize 0 over ?nth non-starter? [ length dupd reorder-back ] [ drop ] if ; + + : nfc ( string -- nfc ) nfd compose ; diff --git a/basis/unicode/unicode-docs.factor b/basis/unicode/unicode-docs.factor new file mode 100644 index 0000000000..5b7b7e9ab3 --- /dev/null +++ b/basis/unicode/unicode-docs.factor @@ -0,0 +1,16 @@ +USING: help.markup help.syntax ; +IN: unicode + +ARTICLE: "unicode" "Unicode" +"Unicode is a set of characters, or " { $emphasis "code points" } " covering what's used in most world writing systems. Any Factor string can hold any of these code points transparently; a factor string is a sequence of Unicode code points. Unicode is accompanied by several standard algorithms for common operations like encoding in files, capitalizing a string, finding the boundaries between words, etc. When a programmer is faced with a string manipulation problem, where the string represents human language, a Unicode algorithm is often much better than the naive one. This is not in terms of efficiency, but rather internationalization. Even English text that remains in ASCII is better served by the Unicode collation algorithm than a naive algorithm. The Unicode algorithms implemented here are:" +{ $vocab-subsection "Case mapping" "unicode.case" } +{ $vocab-subsection "Collation and weak comparison" "unicode.collation" } +{ $vocab-subsection "Character classes" "unicode.categories" } +{ $vocab-subsection "Word and grapheme breaks" "unicode.breaks" } +{ $vocab-subsection "Unicode normalization" "unicode.normalize" } +"The following are mostly for internal use:" +{ $vocab-subsection "Unicode syntax" "unicode.syntax" } +{ $vocab-subsection "Unicode data tables" "unicode.data" } +{ $see-also "io.encodings" } ; + +ABOUT: "unicode" diff --git a/basis/unicode/unicode.factor b/basis/unicode/unicode.factor new file mode 100644 index 0000000000..32adb961d4 --- /dev/null +++ b/basis/unicode/unicode.factor @@ -0,0 +1 @@ +IN: unicode From 676ead93a515f35954f52ecbf714875bae23aa98 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 01:30:12 +0100 Subject: [PATCH 13/38] FUEL: Extract word refactoring. --- extra/fuel/fuel.factor | 2 +- misc/fuel/README | 2 ++ misc/fuel/fuel-mode.el | 2 ++ misc/fuel/fuel-refactor.el | 45 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 50 insertions(+), 1 deletion(-) create mode 100644 misc/fuel/fuel-refactor.el diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 60420b3c39..becbf2161a 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -269,7 +269,7 @@ MEMO: fuel-article-title ( name -- title/f ) help-path [ dup article-title swap 2array ] map ; inline : (fuel-word-help) ( word -- element ) - dup \ article swap article-title rot + \ article swap dup article-title swap [ { [ fuel-parent-topics [ \ $doc-path prefix , ] unless-empty ] diff --git a/misc/fuel/README b/misc/fuel/README index 14a9ca8b5d..f5d366a22e 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -74,6 +74,8 @@ beast. - C-cM-<, C-cC-d< : show callers of word at point - C-cM->, C-cC-d> : show callees of word at point + - C-cC-xw : extract region as a separate word + *** In the listener: - TAB : complete word at point diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 651cc323d0..c0728dbbc5 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -224,6 +224,8 @@ interacting with a factor listener is at your disposal. (fuel-mode--key ?e ?w 'fuel-edit-word) (fuel-mode--key ?e ?x 'fuel-eval-definition) +(fuel-mode--key ?x ?w 'fuel-refactor-extract-word) + (fuel-mode--key ?d ?> 'fuel-show-callees) (fuel-mode--key ?d ?< 'fuel-show-callers) (fuel-mode--key ?d ?a 'fuel-autodoc-mode) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el new file mode 100644 index 0000000000..4bf84ad8ec --- /dev/null +++ b/misc/fuel/fuel-refactor.el @@ -0,0 +1,45 @@ +;;; fuel-refactor.el -- code refactoring support + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Thu Jan 08, 2009 00:57 + +;;; Comentary: + +;; Utilities performing refactoring on factor code. + +;;; Code: + +(require 'fuel-stack) +(require 'fuel-syntax) +(require 'fuel-base) + + +;;; Extract word: + +(defun fuel-refactor-extract-word (begin end) + "Extracts current region as a separate word." + (interactive "r") + (let* ((word (read-string "New word name: ")) + (code (buffer-substring begin end)) + (code-str (fuel--region-to-string begin end)) + (stack-effect (or (fuel-stack--infer-effect code-str) + (read-string "Stack effect: ")))) + (goto-char begin) + (delete-region begin end) + (insert word) + (indent-region begin (point)) + (set-mark (point)) + (fuel-syntax--beginning-of-defun) + (open-line 1) + (let ((start (point))) + (insert ": " word " " stack-effect "\n" code " ;\n") + (indent-region start (point))) + (goto-char (mark)))) + + +(provide 'fuel-refactor) +;;; fuel-refactor.el ends here From 73dc586be1cc3fae122ac129a3bf20a9b71871cc Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 01:50:35 +0100 Subject: [PATCH 14/38] FUEL: Highlight new word during fuel-refactor-extract-word. --- misc/fuel/fuel-refactor.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index 4bf84ad8ec..04313e4fdc 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -37,8 +37,11 @@ (open-line 1) (let ((start (point))) (insert ": " word " " stack-effect "\n" code " ;\n") - (indent-region start (point))) - (goto-char (mark)))) + (indent-region start (point)) + (move-overlay fuel-stack--overlay start (point)) + (goto-char (mark)) + (sit-for fuel-stack-highlight-period) + (delete-overlay fuel-stack--overlay)))) (provide 'fuel-refactor) From c30c9f0c03a6de699791d5e310e3d469a1bc247d Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 01:54:22 +0100 Subject: [PATCH 15/38] FUEL: Ooops, missing require. --- misc/fuel/fuel-mode.el | 1 + 1 file changed, 1 insertion(+) diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index c0728dbbc5..c1abcf414b 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -21,6 +21,7 @@ (require 'fuel-eval) (require 'fuel-help) (require 'fuel-xref) +(require 'fuel-refactor) (require 'fuel-stack) (require 'fuel-autodoc) (require 'fuel-font-lock) From 75b0f1e058bb0d6d8064cf7df837151fc4a3f0af Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 02:00:04 +0100 Subject: [PATCH 16/38] FUEL: Adjust region to word boundaries if needed in fuel-refactor-extract-word. --- misc/fuel/fuel-refactor.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index 04313e4fdc..68713e1e4e 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -24,6 +24,10 @@ "Extracts current region as a separate word." (interactive "r") (let* ((word (read-string "New word name: ")) + (begin (save-excursion + (goto-char begin) (fuel-syntax--beginning-of-symbol-pos))) + (end (save-excursion + (goto-char end) (fuel-syntax--end-of-symbol-pos))) (code (buffer-substring begin end)) (code-str (fuel--region-to-string begin end)) (stack-effect (or (fuel-stack--infer-effect code-str) From 6a7de816fc783768b7f87e31408178c0317f06fa Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 02:08:57 +0100 Subject: [PATCH 17/38] FUEL: Better region boundary adjustment in extract-word. --- misc/fuel/fuel-refactor.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index 68713e1e4e..547da19552 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -25,9 +25,14 @@ (interactive "r") (let* ((word (read-string "New word name: ")) (begin (save-excursion - (goto-char begin) (fuel-syntax--beginning-of-symbol-pos))) + (goto-char begin) + (when (zerop (skip-syntax-backward "w")) + (skip-syntax-forward "-")) + (point))) (end (save-excursion - (goto-char end) (fuel-syntax--end-of-symbol-pos))) + (goto-char end) + (skip-syntax-forward "w") + (point))) (code (buffer-substring begin end)) (code-str (fuel--region-to-string begin end)) (stack-effect (or (fuel-stack--infer-effect code-str) From c47f14afcd232d1bbfc778d371a9f2efe86417c4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 7 Jan 2009 21:20:05 -0600 Subject: [PATCH 18/38] Add link --- core/kernel/kernel-docs.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index bac4048706..7a53ff5172 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -691,11 +691,10 @@ HELP: assert= { $values { "a" object } { "b" object } } { $description "Throws an " { $link assert } " error if " { $snippet "a" } " does not equal " { $snippet "b" } "." } ; - ARTICLE: "shuffle-words" "Shuffle words" "Shuffle words rearrange items at the top of the data stack. They control the flow of data between words that perform actions." $nl -"The " { $link "cleave-combinators" } " and " { $link "spread-combinators" } " are closely related to shuffle words and should be used instead where possible because they can result in clearer code; also, see the advice in " { $link "cookbook-philosophy" } "." +"The " { $link "cleave-combinators" } ", " { $link "spread-combinators" } " and " { $link "apply-combinators" } " are closely related to shuffle words and should be used instead where possible because they can result in clearer code; also, see the advice in " { $link "cookbook-philosophy" } "." $nl "Removing stack elements:" { $subsection drop } From eef0db3a3685c12d116a4fdc72b7bce682971212 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 21:23:57 -0600 Subject: [PATCH 19/38] Add L-system.models.abop-3 --- extra/L-system/models/abop-3/abop-3.factor | 25 ++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 extra/L-system/models/abop-3/abop-3.factor diff --git a/extra/L-system/models/abop-3/abop-3.factor b/extra/L-system/models/abop-3/abop-3.factor new file mode 100644 index 0000000000..49a63eb074 --- /dev/null +++ b/extra/L-system/models/abop-3/abop-3.factor @@ -0,0 +1,25 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-3 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-3 ( -- ) + + L-parser-dialect >>commands + + "c(12)FA" >>axiom + + { + { "A" "!(.9)t(.4)FB>(94)B>(132)B" } + { "B" "[&t(.4)F$A]" } + { "F" "'(1.25)F'(.8)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-3 "L-system" open-window ] with-ui ; + +MAIN: main From 19e177f19b8c549290ae98df18cb0909722b50bd Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 21:24:30 -0600 Subject: [PATCH 20/38] Add L-system.models.abop-4 --- extra/L-system/models/abop-4/abop-4.factor | 54 ++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 extra/L-system/models/abop-4/abop-4.factor diff --git a/extra/L-system/models/abop-4/abop-4.factor b/extra/L-system/models/abop-4/abop-4.factor new file mode 100644 index 0000000000..6b2688a478 --- /dev/null +++ b/extra/L-system/models/abop-4/abop-4.factor @@ -0,0 +1,54 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-4 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-4 ( -- ) + + L-parser-dialect >>commands + + "c(12)&(20)N" >>axiom + + { + { + "N" + "FII[&(60)rY]>(90)[&(45)'(0.8)rA]>(90)[&(60)rY]>(90)[&(45)'(0.8)rD]!FIK" + } + { "Y" "[c(4){++l.--l.--l.++|++l.--l.--l.}]" } + { "l" "g(.2)l" } + { "K" "[!c(2)FF>w>(72)w>(72)w>(72)w>(72)w]" } + { "w" "[c(2)^!F][c(5)&(72){-(54)f(3)+(54)f(3)|-(54)f(3)+(54)f(3)}]" } + { "f" "_" } + + { "A" "B" } + { "B" "C" } + { "C" "D" } + { "D" "E" } + { "E" "G" } + { "G" "H" } + { "H" "N" } + + { "I" "FoO" } + { "O" "FoP" } + { "P" "FoQ" } + { "Q" "FoR" } + { "R" "FoS" } + { "S" "FoT" } + { "T" "FoU" } + { "U" "FoV" } + { "V" "FoW" } + { "W" "FoX" } + { "X" "_" } + + { "o" "$t(-0.03)" } + { "r" "~(30)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-4 "L-system" open-window ] with-ui ; + +MAIN: main From fe2c0b19297967a5e0c1acd52cb62cf9a3b384de Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 21:24:44 -0600 Subject: [PATCH 21/38] Add L-system.models.abop-5 --- extra/L-system/models/abop-5/abop-5.factor | 33 ++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 extra/L-system/models/abop-5/abop-5.factor diff --git a/extra/L-system/models/abop-5/abop-5.factor b/extra/L-system/models/abop-5/abop-5.factor new file mode 100644 index 0000000000..abc346946a --- /dev/null +++ b/extra/L-system/models/abop-5/abop-5.factor @@ -0,0 +1,33 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-5 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-5 ( -- ) + + L-parser-dialect >>commands + + "&(90)+(90)a" >>axiom + + { + { "a" "F[+(45)l][-(45)l]^;ca" } + + { "l" "j" } + { "j" "h" } + { "h" "s" } + { "s" "d" } + { "d" "x" } + { "x" "a" } + + { "F" "'(1.17)F'(.855)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-5 "L-system" open-window ] with-ui ; + +MAIN: main + \ No newline at end of file From c0ad6b7c5585dbe7212507f29e969d5c9aa26541 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 7 Jan 2009 21:45:33 -0600 Subject: [PATCH 22/38] More docs; more case words public --- basis/unicode/case/case-docs.factor | 55 +++++++++++++++++++++++++++-- basis/unicode/case/case.factor | 4 ++- basis/unicode/data/data-docs.factor | 51 ++++++++++++++++++++++++++ 3 files changed, 107 insertions(+), 3 deletions(-) create mode 100644 basis/unicode/data/data-docs.factor diff --git a/basis/unicode/case/case-docs.factor b/basis/unicode/case/case-docs.factor index a5790f9a54..86b791ed81 100644 --- a/basis/unicode/case/case-docs.factor +++ b/basis/unicode/case/case-docs.factor @@ -1,4 +1,4 @@ -USING: help.syntax help.markup ; +USING: help.syntax help.markup strings ; IN: unicode.case ABOUT: "unicode.case" @@ -9,6 +9,10 @@ ARTICLE: "unicode.case" "Case mapping" { $subsection >lower } { $subsection >title } { $subsection >case-fold } +"There are analogous routines which operate on individual code points, but these should " { $emphasis "not be used" } " in general as they have slightly different behavior. In some cases, for example, they do not perform the case operation, as a single code point must expand to more than one." +{ $subsection ch>upper } +{ $subsection ch>lower } +{ $subsection ch>title } "To test if a string is in a given case:" { $subsection upper? } { $subsection lower? } @@ -16,4 +20,51 @@ ARTICLE: "unicode.case" "Case mapping" { $subsection case-fold? } "For certain languages (Turkish, Azeri, Lithuanian), case mapping is dependent on locale; To change this, set the following variable to the ISO-639-1 code for your language:" { $subsection locale } -"This is unnecessary for most languages." ; +"This is unnecessary for most locales." ; + +HELP: >upper +{ $values { "string" string } { "upper" string } } +{ $description "Converts a string to upper case." } ; + +HELP: >lower +{ $values { "string" string } { "lower" string } } +{ $description "Converts a string to lower case." } ; + +HELP: >title +{ $values { "string" string } { "title" string } } +{ $description "Converts a string to title case." } ; + +HELP: >case-fold +{ $values { "string" string } { "case-fold" string } } +{ $description "Converts a string to case-folded form." } ; + +HELP: upper? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in upper case." } ; + +HELP: lower? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in lower case." } ; + +HELP: title? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in title case." } ; + +HELP: case-fold? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in case-folded form." } ; + +HELP: ch>lower +{ $values { "ch" "a code point" } { "lower" "a code point" } } +{ $description "Converts a code point to lower case." } +{ $warning "Don't use this unless you know what you're doing! " { $code ">lower" } " is not the same as " { $code "[ ch>lower ] map" } "." } ; + +HELP: ch>upper +{ $values { "ch" "a code point" } { "upper" "a code point" } } +{ $description "Converts a code point to upper case." } +{ $warning "Don't use this unless you know what you're doing! " { $code ">upper" } " is not the same as " { $code "[ ch>upper ] map" } "." } ; + +HELP: ch>title +{ $values { "ch" "a code point" } { "title" "a code point" } } +{ $description "Converts a code point to title case." } +{ $warning "Don't use this unless you know what you're doing! " { $code ">title" } " is not the same as " { $code "[ ch>title ] map" } "." } ; diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index 42fd13fc97..7e61831f36 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -7,12 +7,14 @@ IN: unicode.case : ch>lower ( ch -- lower ) simple-lower at-default ; : ch>upper ( ch -- upper ) simple-upper at-default ; : ch>title ( ch -- title ) simple-title at-default ; -PRIVATE> + SYMBOL: locale ! Just casing locale, or overall? + char } +{ $subsection char>name } +{ $subsection property? } ; + +HELP: load-script +{ $value { "filename" string } { "table" "an interval map" } } +{ $description "This loads a file that looks like Script.txt in the Unicode Character Database and converts it into an efficient interval map, where the keys are characters and the values are strings for the properties." } ; + +HELP: canonical-entry +{ $value { "char" "a code point" } { "seq" string } } +{ $description "Finds the canonical decomposition (NFD) for a code point" } ; + +HELP: combine-chars +{ $value { "a" "a code point" } { "b" "a code point" } { "char/f" "a code point" } } +{ $description "If a followed by b can be combined in NFC, this returns the code point of their combination." } ; + +HELP: compatibility-entry +{ $value { "char" "a code point" } { "seq" string } } +{ $description "This returns the compatibility decomposition (NFKD) for a code point" } ; + +HELP: combining-class +{ $value { "char" "a code point" } { "n" "an integer" } } +{ $description "Finds the combining class of a code point." } ; + +HELP: non-starter? +{ $value { "char" "a code point" } { "?" "a boolean" } } +{ $description "Returns true if the code point has a combining class." } ; + +HELP: char>name +{ $value { "char" "a code point" } { "name" string } } +{ $description "Looks up the name of a given code point. Warning: this is not optimized for speed, to save space." } ; + +HELP: name>char +{ $value { "name" string } { "char" "a code point" } } +{ $description "Looks up the code point corresponding to a given name." } ; + +HELP: property? +{ $value { "char" "a code point" } { "property" string } { "?" "a boolean" } } +{ $description "Tests whether the code point is listed under the given property in PropList.txt in the Unicode Character Database." } ; From 8b351b1ad6e2355d97d20ef97822b470892bd0f2 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 7 Jan 2009 23:13:04 -0600 Subject: [PATCH 23/38] Fixing normalize errors --- basis/unicode/data/data.factor | 10 +++----- basis/unicode/normalize/normalize-docs.factor | 8 +------ .../unicode/normalize/normalize-tests.factor | 2 +- basis/unicode/normalize/normalize.factor | 23 ++++++++++--------- 4 files changed, 17 insertions(+), 26 deletions(-) diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index 3e19c5c30d..8f99b6c160 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -28,10 +28,6 @@ VALUE: properties : char>name ( char -- string ) name-map value-at ; : property? ( char property -- ? ) properties at interval-key? ; -! Convenience functions -: ?between? ( n/f from to -- ? ) - pick [ between? ] [ 3drop f ] if ; - ! Loading data from UnicodeData.txt : split-; ( line -- array ) @@ -206,9 +202,9 @@ SYMBOL: interned : expand-ranges ( assoc -- interval-map ) [ [ - CHAR: . pick member? [ - swap ".." split1 [ hex> ] bi@ 2array - ] [ swap hex> ] if range, + swap CHAR: . over member? [ + ".." split1 [ hex> ] bi@ 2array + ] [ hex> ] if range, ] assoc-each ] { } make ; diff --git a/basis/unicode/normalize/normalize-docs.factor b/basis/unicode/normalize/normalize-docs.factor index 423332fb6e..65f50ab0ae 100644 --- a/basis/unicode/normalize/normalize-docs.factor +++ b/basis/unicode/normalize/normalize-docs.factor @@ -8,9 +8,7 @@ ARTICLE: "unicode.normalize" "Unicode normalization" { $subsection nfc } { $subsection nfd } { $subsection nfkc } -{ $subsection nfkd } -"If two strings in a normalization form are appended, the result may not be in that normalization form still. To append two strings in NFD and make sure the result is in NFD, the following procedure is supplied:" -{ $subsection string-append } ; +{ $subsection nfkd } ; HELP: nfc { $values { "string" string } { "nfc" "a string in NFC" } } @@ -27,7 +25,3 @@ HELP: nfkc HELP: nfkd { $values { "string" string } { "nfc" "a string in NFKD" } } { $description "Converts a string to Normalization Form KD" } ; - -HELP: string-append -{ $values { "s1" "a string in NFD" } { "s2" "a string in NFD" } { "string" "a string in NFD" } } -{ $description "Appends two strings, putting the result in NFD." } ; diff --git a/basis/unicode/normalize/normalize-tests.factor b/basis/unicode/normalize/normalize-tests.factor index 9662389531..25d5ce365c 100644 --- a/basis/unicode/normalize/normalize-tests.factor +++ b/basis/unicode/normalize/normalize-tests.factor @@ -1,6 +1,6 @@ USING: unicode.normalize kernel tools.test sequences unicode.data io.encodings.utf8 io.files splitting math.parser -locals math quotations assocs combinators ; +locals math quotations assocs combinators unicode.normalize.private ; IN: unicode.normalize.tests [ "ab\u000323\u000302cd" ] [ "ab\u000302" "\u000323cd" string-append ] unit-test diff --git a/basis/unicode/normalize/normalize.factor b/basis/unicode/normalize/normalize.factor index eacdb2724a..f13eb07594 100644 --- a/basis/unicode/normalize/normalize.factor +++ b/basis/unicode/normalize/normalize.factor @@ -1,21 +1,24 @@ ! Copyright (C) 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: sequences namespaces make unicode.data kernel math arrays -locals sorting.insertion accessors assocs ; +locals sorting.insertion accessors assocs math.order ; IN: unicode.normalize [ compatibility-entry ] decompose ; : string-append ( s1 s2 -- string ) - ! This could be more optimized, - ! but in practice, it'll almost always just be append [ append ] keep 0 over ?nth non-starter? [ length dupd reorder-back ] [ drop ] if ; From 26711da67511098754000256ede12c16e87157ed Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 23:13:18 -0600 Subject: [PATCH 24/38] L-system: Key gestures for strafing camera. Support for changing turtle values. --- extra/L-system/L-system.factor | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/extra/L-system/L-system.factor b/extra/L-system/L-system.factor index 9b8bdc1914..5bc7ce1db6 100644 --- a/extra/L-system/L-system.factor +++ b/extra/L-system/L-system.factor @@ -256,7 +256,9 @@ DEFER: default-L-parser-values ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! TUPLE: < gadget - camera display-list pedestal paused commands axiom rules string ; + camera display-list pedestal paused + turtle-values + commands axiom rules string ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -376,6 +378,7 @@ TUPLE: < gadget L-SYSTEM display-list>> GL_COMPILE glNewList turtle + L-SYSTEM turtle-values>> [ ] or call L-SYSTEM string>> L-SYSTEM axiom>> or L-SYSTEM commands>> interpret-string @@ -445,6 +448,11 @@ H{ { T{ key-down f f "q" } [ [ 5 roll-left ] with-camera ] } { T{ key-down f f "w" } [ [ 5 roll-right ] with-camera ] } + { T{ key-down f { A+ } "LEFT" } [ [ 1 strafe-left ] with-camera ] } + { T{ key-down f { A+ } "RIGHT" } [ [ 1 strafe-right ] with-camera ] } + { T{ key-down f { A+ } "UP" } [ [ 1 strafe-up ] with-camera ] } + { T{ key-down f { A+ } "DOWN" } [ [ 1 strafe-down ] with-camera ] } + { T{ key-down f f "r" } [ start-rotation-thread ] } { From 07da37ffc8cb0f3e354dd910407705aedf1b75f4 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 23:14:32 -0600 Subject: [PATCH 25/38] L-system.models.abop-2: change default angle --- extra/L-system/models/abop-2/abop-2.factor | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/extra/L-system/models/abop-2/abop-2.factor b/extra/L-system/models/abop-2/abop-2.factor index 2ed8f64abe..1168780300 100644 --- a/extra/L-system/models/abop-2/abop-2.factor +++ b/extra/L-system/models/abop-2/abop-2.factor @@ -9,20 +9,23 @@ IN: L-system.models.abop-2 L-parser-dialect >>commands + [ 30 >>angle ] >>turtle-values + "c(12)FAL" >>axiom { - { "A" "F[&'(.7)!BL]>(137)[&'(.6)!BL]>(137)'(.9)!(.9)A" } - { "B" "F[-'(.7)!(.9)$CL]'(.9)!(.9)C" } - { "C" "F[+'(.7)!(.9)$BL]'(.9)!(.9)B" } + { "A" "F [&'(.7)!BL] >(137) [&'(.6)!BL] >(137) '(.9) !(.9) A" } + + { "B" "F [- '(.7) !(.9) $ C L] '(.9) !(.9) C" } + { "C" "F [+ '(.7) !(.9) $ B L] '(.9) !(.9) B" } { "L" "~c(8){+f(.1)-f(.1)-f(.1)+|+f(.1)-f(.1)-f(.1)}" } } >>rules ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : main ( -- ) [ L-system abop-2 "L-system" open-window ] with-ui ; MAIN: main - \ No newline at end of file From 7c3576c4bb81af720f2315014b069603fb77caa6 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 23:15:04 -0600 Subject: [PATCH 26/38] L-system.models.abop-3: change default angle --- extra/L-system/models/abop-3/abop-3.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/L-system/models/abop-3/abop-3.factor b/extra/L-system/models/abop-3/abop-3.factor index 49a63eb074..f594cafcd3 100644 --- a/extra/L-system/models/abop-3/abop-3.factor +++ b/extra/L-system/models/abop-3/abop-3.factor @@ -9,6 +9,8 @@ IN: L-system.models.abop-3 L-parser-dialect >>commands + [ 30 >>angle ] >>turtle-values + "c(12)FA" >>axiom { From a976830ff1836cdc1bf1dc7600561008ed3de7c3 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 23:15:30 -0600 Subject: [PATCH 27/38] L-system.models.abop-4: change default angle --- extra/L-system/models/abop-4/abop-4.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/L-system/models/abop-4/abop-4.factor b/extra/L-system/models/abop-4/abop-4.factor index 6b2688a478..71cf32d4d7 100644 --- a/extra/L-system/models/abop-4/abop-4.factor +++ b/extra/L-system/models/abop-4/abop-4.factor @@ -9,6 +9,8 @@ IN: L-system.models.abop-4 L-parser-dialect >>commands + [ 18 >>angle ] >>turtle-values + "c(12)&(20)N" >>axiom { From 87e49f19a3be49611854d675388f188ecfac03b5 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 23:15:47 -0600 Subject: [PATCH 28/38] L-system.models.abop-5: change default angle --- extra/L-system/models/abop-5/abop-5.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/L-system/models/abop-5/abop-5.factor b/extra/L-system/models/abop-5/abop-5.factor index abc346946a..5d6576f33a 100644 --- a/extra/L-system/models/abop-5/abop-5.factor +++ b/extra/L-system/models/abop-5/abop-5.factor @@ -9,6 +9,8 @@ IN: L-system.models.abop-5 L-parser-dialect >>commands + [ 5 >>angle ] >>turtle-values + "&(90)+(90)a" >>axiom { From fa73d98c288f25608832af9fce6c554935d46302 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 23:16:09 -0600 Subject: [PATCH 29/38] Add L-system.models.abop-6 --- extra/L-system/models/abop-6/abop-6.factor | 34 ++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 extra/L-system/models/abop-6/abop-6.factor diff --git a/extra/L-system/models/abop-6/abop-6.factor b/extra/L-system/models/abop-6/abop-6.factor new file mode 100644 index 0000000000..0639d53274 --- /dev/null +++ b/extra/L-system/models/abop-6/abop-6.factor @@ -0,0 +1,34 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-6 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-6 ( -- ) + + L-parser-dialect >>commands + + [ 5 >>angle ] >>turtle-values + + ! "&(90)+(90)FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x" + "FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x" + >>axiom + + { + { "a" "F[cdx][cex]F!(.9)a" } + { "x" "a" } + + { "d" "+d" } + { "e" "-e" } + + { "F" "'(1.25)F'(.8)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-6 "L-system" open-window ] with-ui ; + +MAIN: main + \ No newline at end of file From 3a996c1afc7956c86ea782aa497d6870b57aa575 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 23:16:34 -0600 Subject: [PATCH 30/38] Add L-system.models.abop-5-angular --- .../abop-5-angular/abop-5-angular.factor | 33 +++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 extra/L-system/models/abop-5-angular/abop-5-angular.factor diff --git a/extra/L-system/models/abop-5-angular/abop-5-angular.factor b/extra/L-system/models/abop-5-angular/abop-5-angular.factor new file mode 100644 index 0000000000..29b1c72cbc --- /dev/null +++ b/extra/L-system/models/abop-5-angular/abop-5-angular.factor @@ -0,0 +1,33 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-5-angular + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-5-angular ( -- ) + + L-parser-dialect >>commands + + "&(90)+(90)a" >>axiom + + { + { "a" "F[+(45)l][-(45)l]^;ca" } + + { "l" "j" } + { "j" "h" } + { "h" "s" } + { "s" "d" } + { "d" "x" } + { "x" "a" } + + { "F" "'(1.17)F'(.855)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-5-angular "L-system" open-window ] with-ui ; + +MAIN: main + \ No newline at end of file From 09097ee2e676f509302b3afad0b5efef7a4a0470 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 23:17:57 -0600 Subject: [PATCH 31/38] update.latest: Move back to using 'git' protocol instead of 'http' (factorcode.org git daemon seems stable again) --- extra/update/latest/latest.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/update/latest/latest.factor b/extra/update/latest/latest.factor index 98d264d227..77cd184cdb 100644 --- a/extra/update/latest/latest.factor +++ b/extra/update/latest/latest.factor @@ -7,7 +7,7 @@ IN: update.latest : git-pull-master ( -- ) image parent-directory [ - { "git" "pull" "http://factorcode.org/git/factor.git" "master" } + { "git" "pull" "git://factorcode.org/git/factor.git" "master" } run-command ] with-directory ; From 8c7e46283f04314568a60c26c2a68cfc0eb14f51 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 23:23:32 -0600 Subject: [PATCH 32/38] L-system.models.abop-5: Adjust axiom (grow along Z) --- extra/L-system/models/abop-5/abop-5.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/L-system/models/abop-5/abop-5.factor b/extra/L-system/models/abop-5/abop-5.factor index 5d6576f33a..2e373f713c 100644 --- a/extra/L-system/models/abop-5/abop-5.factor +++ b/extra/L-system/models/abop-5/abop-5.factor @@ -11,7 +11,7 @@ IN: L-system.models.abop-5 [ 5 >>angle ] >>turtle-values - "&(90)+(90)a" >>axiom + "a" >>axiom { { "a" "F[+(45)l][-(45)l]^;ca" } From 1aa0684d4580d5caece99e0d0b38dc5ee2629485 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 7 Jan 2009 23:54:19 -0600 Subject: [PATCH 33/38] Case conversion title case fixed --- basis/unicode/breaks/breaks.factor | 13 +++---- basis/unicode/case/case-tests.factor | 2 +- basis/unicode/case/case.factor | 35 +++++++++++-------- .../unicode/collation/collation-tests.factor | 4 +-- basis/unicode/normalize/normalize.factor | 6 ++-- 5 files changed, 31 insertions(+), 29 deletions(-) diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index b85e8879e1..1d2f821750 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -3,7 +3,7 @@ USING: combinators.short-circuit unicode.categories kernel math combinators splitting sequences math.parser io.files io assocs arrays namespaces make math.ranges unicode.normalize.private values -io.encodings.ascii unicode.syntax unicode.data compiler.units +io.encodings.ascii unicode.syntax unicode.data compiler.units fry alien.syntax sets accessors interval-maps memoize locals words ; IN: unicode.breaks @@ -111,14 +111,9 @@ PRIVATE> pieces) ( str quot -- ) - str [ - dup quot call cut-slice - swap , quot (>pieces) - ] unless-empty ; inline recursive - -: >pieces ( str quot -- graphemes ) - [ (>pieces) ] { } make ; inline +: >pieces ( str quot: ( str -- i ) -- graphemes ) + [ dup empty? not ] swap '[ dup @ cut-slice swap ] + [ ] produce nip ; inline PRIVATE> diff --git a/basis/unicode/case/case-tests.factor b/basis/unicode/case/case-tests.factor index 0083e49672..f9d304e05c 100644 --- a/basis/unicode/case/case-tests.factor +++ b/basis/unicode/case/case-tests.factor @@ -4,7 +4,7 @@ USING: unicode.case tools.test namespaces ; \ >lower must-infer \ >title must-infer -[ "Hello How Are You? I'M Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test +[ "Hello How Are You? I'm Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test [ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test [ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test [ t ] [ "hello how are you?" lower? ] unit-test diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index 7e61831f36..5d103e2dd0 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: unicode.data sequences sequences.next namespaces make unicode.normalize math unicode.categories combinators -assocs strings splitting kernel accessors ; +assocs strings splitting kernel accessors unicode.breaks ; IN: unicode.case -: >lower ( string -- lower ) - i-dot? [ turk>lower ] when - final-sigma [ lower>> ] [ ch>lower ] map-case ; -: >upper ( string -- upper ) - i-dot? [ turk>upper ] when +: (>lower) ( string -- lower ) + [ lower>> ] [ ch>lower ] map-case ; + +: (>title) ( string -- title ) + [ title>> ] [ ch>title ] map-case ; + +: (>upper) ( string -- upper ) [ upper>> ] [ ch>upper ] map-case ; +: title-word ( string -- title ) + unclip 1string [ (>lower) ] [ (>title) ] bi* prepend ; + +PRIVATE> + +: >lower ( string -- lower ) + i-dot? [ turk>lower ] when + final-sigma (>lower) ; + +: >upper ( string -- upper ) + i-dot? [ turk>upper ] when (>upper) ; + : >title ( string -- title ) - final-sigma - CHAR: \s swap - [ tuck word-boundary swapd - [ title>> ] [ lower>> ] if ] - [ tuck word-boundary swapd - [ ch>title ] [ ch>lower ] if ] - map-case nip ; + final-sigma >words [ title-word ] map concat ; : >case-fold ( string -- fold ) >upper >lower ; diff --git a/basis/unicode/collation/collation-tests.factor b/basis/unicode/collation/collation-tests.factor index be6af2d920..d3d0b8199d 100644 --- a/basis/unicode/collation/collation-tests.factor +++ b/basis/unicode/collation/collation-tests.factor @@ -1,6 +1,6 @@ USING: io io.files splitting grouping unicode.collation sequences kernel io.encodings.utf8 math.parser math.order -tools.test assocs io.streams.null words ; +tools.test assocs words ; IN: unicode.collation.tests : parse-test ( -- strings ) @@ -25,4 +25,4 @@ IN: unicode.collation.tests unit-test parse-test 2 -[ [ test-two ] assoc-each ] with-null-writer +[ test-two ] assoc-each diff --git a/basis/unicode/normalize/normalize.factor b/basis/unicode/normalize/normalize.factor index f13eb07594..58ce412a2e 100644 --- a/basis/unicode/normalize/normalize.factor +++ b/basis/unicode/normalize/normalize.factor @@ -155,7 +155,7 @@ DEFER: compose-iter ] if (compose) ] when* ; -: compose ( str -- comp ) +: combine ( str -- comp ) [ main-str set 0 ind set @@ -166,7 +166,7 @@ DEFER: compose-iter PRIVATE> : nfc ( string -- nfc ) - nfd compose ; + nfd combine ; : nfkc ( string -- nfkc ) - nfkd compose ; + nfkd combine ; From 6c89466706a743e54688330c19a64e18a1e01fae Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 7 Jan 2009 23:55:30 -0600 Subject: [PATCH 34/38] Add L-system.models.airhorse --- .../L-system/models/airhorse/airhorse.factor | 53 +++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 extra/L-system/models/airhorse/airhorse.factor diff --git a/extra/L-system/models/airhorse/airhorse.factor b/extra/L-system/models/airhorse/airhorse.factor new file mode 100644 index 0000000000..f65c7b824f --- /dev/null +++ b/extra/L-system/models/airhorse/airhorse.factor @@ -0,0 +1,53 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.airhorse + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: airhorse ( -- ) + + L-parser-dialect >>commands + + [ 10 >>angle ] >>turtle-values + + "C" >>axiom + + { + { "C" "LBW" } + + { "B" "[[''aH]|[g]]" } + { "a" "Fs+;'a" } + { "g" "Ft+;'g" } + { "s" "[::cc!!!!&&[FFcccZ]^^^^FFcccZ]" } + { "t" "[c!!!!&[FF]^^FF]" } + + { "L" "O" } + { "O" "P" } + { "P" "Q" } + { "Q" "R" } + { "R" "U" } + { "U" "X" } + { "X" "Y" } + { "Y" "V" } + { "V" "[cc!!!&(90)[Zp]|[Zp]]" } + { "p" "h>(120)h>(120)h" } + { "h" "[+(40)!F'''p]" } + + { "H" "[cccci[>(50)dcFFF][<(50)ecFFF]]" } + { "d" "Z!&Z!&:'d" } + { "e" "Z!^Z!^:'e" } + { "i" "-:/i" } + + { "W" "[%[!!cb][<<>>!!cb]]" } + { "b" "Fl!+Fl+;'b" } + { "l" "[-cc{--z++z++z--|--z++z++z}]" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system airhorse "L-system" open-window ] with-ui ; + +MAIN: main + \ No newline at end of file From 3b44c824ee8cd98955825bbc01ccb4bd4715d102 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 17:00:48 +0100 Subject: [PATCH 35/38] FUEL: Better word extraction. --- misc/fuel/README | 3 ++- misc/fuel/fuel-mode.el | 3 ++- misc/fuel/fuel-refactor.el | 37 +++++++++++++++++++++++++------------ 3 files changed, 29 insertions(+), 14 deletions(-) diff --git a/misc/fuel/README b/misc/fuel/README index f5d366a22e..4747adb4a0 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -74,7 +74,8 @@ beast. - C-cM-<, C-cC-d< : show callers of word at point - C-cM->, C-cC-d> : show callees of word at point - - C-cC-xw : extract region as a separate word + - C-cC-xs : extract innermost sexp (up to point) as a separate word + - C-cC-xr : extract region as a separate word *** In the listener: diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index c1abcf414b..467270651a 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -225,7 +225,8 @@ interacting with a factor listener is at your disposal. (fuel-mode--key ?e ?w 'fuel-edit-word) (fuel-mode--key ?e ?x 'fuel-eval-definition) -(fuel-mode--key ?x ?w 'fuel-refactor-extract-word) +(fuel-mode--key ?x ?s 'fuel-refactor-extract-sexp) +(fuel-mode--key ?x ?r 'fuel-refactor-extract-region) (fuel-mode--key ?d ?> 'fuel-show-callees) (fuel-mode--key ?d ?< 'fuel-show-callers) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index 547da19552..a414f17795 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -20,23 +20,13 @@ ;;; Extract word: -(defun fuel-refactor-extract-word (begin end) - "Extracts current region as a separate word." - (interactive "r") +(defun fuel-refactor--extract (begin end) (let* ((word (read-string "New word name: ")) - (begin (save-excursion - (goto-char begin) - (when (zerop (skip-syntax-backward "w")) - (skip-syntax-forward "-")) - (point))) - (end (save-excursion - (goto-char end) - (skip-syntax-forward "w") - (point))) (code (buffer-substring begin end)) (code-str (fuel--region-to-string begin end)) (stack-effect (or (fuel-stack--infer-effect code-str) (read-string "Stack effect: ")))) + (unless (< begin end) (error "No proper region to extract")) (goto-char begin) (delete-region begin end) (insert word) @@ -52,6 +42,29 @@ (sit-for fuel-stack-highlight-period) (delete-overlay fuel-stack--overlay)))) +(defun fuel-refactor-extract-region (begin end) + "Extracts current region as a separate word." + (interactive "r") + (let ((begin (save-excursion + (goto-char begin) + (when (zerop (skip-syntax-backward "w")) + (skip-syntax-forward "-")) + (point))) + (end (save-excursion + (goto-char end) + (skip-syntax-forward "w") + (point)))) + (fuel-refactor--extract begin end))) + +(defun fuel-refactor-extract-sexp () + "Extracts current innermost sexp (up to point) as a separate +word." + (interactive) + (fuel-refactor-extract-region (1+ (fuel-syntax--beginning-of-sexp-pos)) + (if (looking-at-p ";") (point) + (fuel-syntax--end-of-symbol-pos)))) + + (provide 'fuel-refactor) ;;; fuel-refactor.el ends here From c5f55dc36d1d1467358178223f4446d07dfb9a16 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 18:47:17 +0100 Subject: [PATCH 36/38] FUEL: New command: fuel-show-file-words. --- extra/fuel/fuel.factor | 3 ++ misc/fuel/README | 1 + misc/fuel/fuel-mode.el | 32 +------------- misc/fuel/fuel-syntax.el | 11 +++-- misc/fuel/fuel-xref.el | 93 +++++++++++++++++++++++++++++++++------- 5 files changed, 89 insertions(+), 51 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index becbf2161a..50f02f1a1a 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -201,6 +201,9 @@ SYMBOL: :uses : fuel-apropos-xref ( str -- ) words-matching fuel-format-xrefs fuel-eval-set-result ; inline +: fuel-vocab-xref ( vocab -- ) + words fuel-format-xrefs fuel-eval-set-result ; inline + ! Completion support : fuel-filter-prefix ( seq prefix -- seq ) diff --git a/misc/fuel/README b/misc/fuel/README index 4747adb4a0..f722b18598 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -70,6 +70,7 @@ beast. - C-cC-ds : short help word at point - C-cC-de : show stack effect of current sexp (with prefix, region) - C-cC-dp : find words containing given substring (M-x fuel-apropos) + - C-cC-dv : show words in current file (with prefix, ask for vocab) - C-cM-<, C-cC-d< : show callers of word at point - C-cM->, C-cC-d> : show callees of word at point diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 467270651a..f448e67d57 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -132,37 +132,6 @@ With prefix argument, ask for the file name." (let ((file (car (fuel-mode--read-file arg)))) (when file (fuel-debug--uses-for-file file)))) -(defvar fuel-mode--word-history nil) - -(defun fuel-show-callers (&optional arg) - "Show a list of callers of word at point. -With prefix argument, ask for word." - (interactive "P") - (let ((word (if arg (fuel-completion--read-word "Find callers for: " - (fuel-syntax-symbol-at-point) - fuel-mode--word-history) - (fuel-syntax-symbol-at-point)))) - (when word - (message "Looking up %s's callers ..." word) - (fuel-xref--show-callers word)))) - -(defun fuel-show-callees (&optional arg) - "Show a list of callers of word at point. -With prefix argument, ask for word." - (interactive "P") - (let ((word (if arg (fuel-completion--read-word "Find callees for: " - (fuel-syntax-symbol-at-point) - fuel-mode--word-history) - (fuel-syntax-symbol-at-point)))) - (when word - (message "Looking up %s's callees ..." word) - (fuel-xref--show-callees word)))) - -(defun fuel-apropos (str) - "Show a list of words containing the given substring." - (interactive "MFind words containing: ") - (message "Looking up %s's references ..." str) - (fuel-xref--apropos str)) ;;; Minor mode definition: @@ -230,6 +199,7 @@ interacting with a factor listener is at your disposal. (fuel-mode--key ?d ?> 'fuel-show-callees) (fuel-mode--key ?d ?< 'fuel-show-callers) +(fuel-mode--key ?d ?v 'fuel-show-file-words) (fuel-mode--key ?d ?a 'fuel-autodoc-mode) (fuel-mode--key ?d ?p 'fuel-apropos) (fuel-mode--key ?d ?d 'fuel-help) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 2c3de32d4f..e1981eff47 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -312,6 +312,12 @@ (defsubst fuel-syntax--usings () (funcall fuel-syntax--usings-function)) +(defun fuel-syntax--file-has-private () + (save-excursion + (goto-char (point-min)) + (and (re-search-forward "\\_<" nil t) + (re-search-forward "\\_\\_>" nil t)))) + (defun fuel-syntax--find-usings (&optional no-private) (save-excursion (let ((usings)) @@ -319,10 +325,7 @@ (while (re-search-backward fuel-syntax--using-lines-regex nil t) (dolist (u (split-string (match-string-no-properties 1) nil t)) (push u usings))) - (goto-char (point-min)) - (when (and (not no-private) - (re-search-forward "\\_<" nil t) - (re-search-forward "\\_\\_>" nil t)) + (when (and (not no-private) (fuel-syntax--file-has-private)) (goto-char (point-max)) (push (concat (fuel-syntax--find-in) ".private") usings)) usings))) diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el index 470c2a8762..f754c626f7 100644 --- a/misc/fuel/fuel-xref.el +++ b/misc/fuel/fuel-xref.el @@ -13,6 +13,8 @@ ;;; Code: +(require 'fuel-edit) +(require 'fuel-completion) (require 'fuel-help) (require 'fuel-eval) (require 'fuel-syntax) @@ -82,7 +84,7 @@ cursor at the first ocurrence of the used word." ((= 1 count) (format "1 word %s %s:" cc word)) (t (format "%s words %s %s:" count cc word)))) -(defun fuel-xref--insert-ref (ref) +(defun fuel-xref--insert-ref (ref &optional no-vocab) (when (and (stringp (first ref)) (stringp (third ref)) (numberp (fourth ref))) @@ -94,29 +96,28 @@ cursor at the first ocurrence of the used word." (fourth ref)) 'file (third ref) 'line (fourth ref)) - (when (stringp (second ref)) + (when (and (not no-vocab) (stringp (second ref))) (insert (format " (in %s)" (second ref)))) (newline) t)) -(defun fuel-xref--fill-buffer (word cc refs) +(defun fuel-xref--fill-buffer (word cc refs &optional no-vocab app) (let ((inhibit-read-only t) (count 0)) (with-current-buffer (fuel-xref--buffer) - (erase-buffer) - (dolist (ref refs) - (when (fuel-xref--insert-ref ref) (setq count (1+ count)))) - (goto-char (point-min)) - (insert (fuel-xref--title word cc count) "\n\n") - (when (> count 0) - (setq fuel-xref--word (and cc word)) - (goto-char (point-max)) - (insert "\n" fuel-xref--help-string "\n")) - (goto-char (point-min)) - count))) + (let ((start (if app (goto-char (point-max)) + (erase-buffer) + (point-min)))) + (dolist (ref refs) + (when (fuel-xref--insert-ref ref no-vocab) (setq count (1+ count)))) + (newline) + (goto-char start) + (save-excursion + (insert (fuel-xref--title word cc count) "\n\n")) + count)))) -(defun fuel-xref--fill-and-display (word cc refs) - (let ((count (fuel-xref--fill-buffer word cc refs))) +(defun fuel-xref--fill-and-display (word cc refs &optional no-vocab) + (let ((count (fuel-xref--fill-buffer word cc refs no-vocab))) (if (zerop count) (error (fuel-xref--title word cc 0)) (message "") @@ -137,6 +138,65 @@ cursor at the first ocurrence of the used word." (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) (fuel-xref--fill-and-display str "containing" res))) +(defun fuel-xref--show-vocab (vocab &optional app) + (let* ((cmd `(:fuel* ((,vocab fuel-vocab-xref)) ,vocab)) + (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) + (fuel-xref--fill-buffer vocab "in vocabulary" res t app))) + +(defun fuel-xref--show-vocab-words (vocab &optional private) + (fuel-xref--show-vocab vocab) + (when private + (fuel-xref--show-vocab (format "%s.private" (substring-no-properties vocab)) + t)) + (fuel-popup--display (fuel-xref--buffer)) + (goto-char (point-min))) + + +;;; User commands: + +(defvar fuel-xref--word-history nil) + +(defun fuel-show-callers (&optional arg) + "Show a list of callers of word at point. +With prefix argument, ask for word." + (interactive "P") + (let ((word (if arg (fuel-completion--read-word "Find callers for: " + (fuel-syntax-symbol-at-point) + fuel-xref--word-history) + (fuel-syntax-symbol-at-point)))) + (when word + (message "Looking up %s's callers ..." word) + (fuel-xref--show-callers word)))) + +(defun fuel-show-callees (&optional arg) + "Show a list of callers of word at point. +With prefix argument, ask for word." + (interactive "P") + (let ((word (if arg (fuel-completion--read-word "Find callees for: " + (fuel-syntax-symbol-at-point) + fuel-xref--word-history) + (fuel-syntax-symbol-at-point)))) + (when word + (message "Looking up %s's callees ..." word) + (fuel-xref--show-callees word)))) + +(defun fuel-apropos (str) + "Show a list of words containing the given substring." + (interactive "MFind words containing: ") + (message "Looking up %s's references ..." str) + (fuel-xref--apropos str)) + +(defun fuel-show-file-words (&optional arg) + "Show a list of words in current file. +With prefix argument, ask for the vocab." + (interactive "P") + (let ((vocab (or (and (not arg) (fuel-syntax--current-vocab)) + (fuel-edit--read-vocabulary-name)))) + (when vocab + (fuel-xref--show-vocab-words vocab + (fuel-syntax--file-has-private))))) + + ;;; Xref mode: @@ -159,6 +219,7 @@ cursor at the first ocurrence of the used word." (kill-all-local-variables) (buffer-disable-undo) (use-local-map fuel-xref-mode-map) + (set-syntax-table fuel-syntax--syntax-table) (setq mode-name "FUEL Xref") (setq major-mode 'fuel-xref-mode) (font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab))) From 4f4198d85040ae4c16002489074aaa49d4c52478 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 8 Jan 2009 15:00:59 -0600 Subject: [PATCH 37/38] Cleaning up case conversion (still need Lithuanian tests) --- basis/unicode/case/case-tests.factor | 4 +- basis/unicode/case/case.factor | 105 ++++++++++++++------------- 2 files changed, 55 insertions(+), 54 deletions(-) diff --git a/basis/unicode/case/case-tests.factor b/basis/unicode/case/case-tests.factor index f9d304e05c..6e26a36a19 100644 --- a/basis/unicode/case/case-tests.factor +++ b/basis/unicode/case/case-tests.factor @@ -6,12 +6,12 @@ USING: unicode.case tools.test namespaces ; [ "Hello How Are You? I'm Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test [ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test -[ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test +[ "\u0003C3a\u0003C2 \u0003C3\u0003C2 \u0003C3a\u0003C2" ] [ "\u0003A3A\u0003A3 \u0003A3\u0003A3 \u0003A3A\u0003A3" >lower ] unit-test [ t ] [ "hello how are you?" lower? ] unit-test [ "tr" locale set [ "i\u000131i \u000131jj" ] [ "i\u000131I\u000307 IJj" >lower ] unit-test -! [ "I\u00307\u000131i Ijj" ] [ "i\u000131I\u000307 IJj" >title ] unit-test + [ "I\u000307\u000131i Ijj" ] [ "i\u000131I\u000307 IJj" >title ] unit-test [ "I\u000307II\u000307 IJJ" ] [ "i\u000131I\u000307 IJj" >upper ] unit-test "lt" locale set ! Lithuanian casing tests diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index 5d103e2dd0..b0472cd9cb 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: unicode.data sequences sequences.next namespaces make -unicode.normalize math unicode.categories combinators -assocs strings splitting kernel accessors unicode.breaks ; +unicode.normalize math unicode.categories combinators unicode.syntax +assocs strings splitting kernel accessors unicode.breaks fry ; IN: unicode.case SYMBOL: locale ! Just casing locale, or overall? upper ( ? next ch -- ? ) - rot [ 2drop f ] - [ swap dot-over = over "ij" member? and swap , ] if ; - : lithuanian>upper ( string -- lower ) - [ f swap [ lithuanian-ch>upper ] each-next drop ] "" make ; + "i\u000307" "i" replace + "j\u000307" "j" replace ; : mark-above? ( ch -- ? ) combining-class 230 = ; -: lithuanian-ch>lower ( next ch -- ) - ! This fails to add a dot above in certain edge cases - ! where there is a non-above combining mark before an above one - ! in Lithuanian - dup , "IJ" member? swap mark-above? and [ dot-over , ] when ; +: with-rest ( seq quot: ( seq -- seq ) -- seq ) + [ unclip ] dip swap slip prefix ; inline + +: add-dots ( seq -- seq ) + [ [ "" ] [ + dup first mark-above? + [ CHAR: combining-dot-above prefix ] when + ] if-empty ] with-rest ; : lithuanian>lower ( string -- lower ) - [ [ lithuanian-ch>lower ] each-next ] "" make ; - -: turk-ch>upper ( ch -- ) - dup CHAR: i = - [ drop CHAR: I , dot-over , ] [ , ] if ; + "i" split add-dots "i" join + "j" split add-dots "i" join ; : turk>upper ( string -- upper-i ) - [ [ turk-ch>upper ] each ] "" make ; - -: turk-ch>lower ( ? next ch -- ? ) - { - { [ rot ] [ 2drop f ] } - { [ dup CHAR: I = ] [ - drop dot-over = - dup CHAR: i HEX: 131 ? , - ] } - [ , drop f ] - } cond ; + "i" "I\u000307" replace ; : turk>lower ( string -- lower-i ) - [ f swap [ turk-ch>lower ] each-next drop ] "" make ; + "I\u000307" "i" replace + "I" "\u000131" replace ; -: word-boundary ( prev char -- new ? ) - dup non-starter? [ drop dup ] when - swap uncased? ; +: fix-sigma-end ( string -- string ) + [ "" ] [ + dup peek CHAR: greek-small-letter-sigma = + [ 1 head* CHAR: greek-small-letter-final-sigma suffix ] when + ] if-empty ; : sigma-map ( string -- string ) - [ - swap [ uncased? ] keep not or - [ drop HEX: 3C2 ] when - ] map-next ; + { CHAR: greek-capital-letter-sigma } split [ [ + [ { CHAR: greek-small-letter-sigma } ] [ + dup first uncased? + CHAR: greek-small-letter-final-sigma + CHAR: greek-small-letter-sigma ? prefix + ] if-empty + ] map ] with-rest concat fix-sigma-end ; : final-sigma ( string -- string ) - HEX: 3A3 over member? [ sigma-map ] when ; + CHAR: greek-capital-letter-sigma + over member? [ sigma-map ] when ; : map-case ( string string-quot char-quot -- case ) [ @@ -83,26 +84,26 @@ SYMBOL: locale ! Just casing locale, or overall? ] 2curry each ] "" make ; inline -: (>lower) ( string -- lower ) - [ lower>> ] [ ch>lower ] map-case ; - -: (>title) ( string -- title ) - [ title>> ] [ ch>title ] map-case ; - -: (>upper) ( string -- upper ) - [ upper>> ] [ ch>upper ] map-case ; - -: title-word ( string -- title ) - unclip 1string [ (>lower) ] [ (>title) ] bi* prepend ; - PRIVATE> : >lower ( string -- lower ) - i-dot? [ turk>lower ] when - final-sigma (>lower) ; + i-dot? [ turk>lower ] when final-sigma + [ lower>> ] [ ch>lower ] map-case ; : >upper ( string -- upper ) - i-dot? [ turk>upper ] when (>upper) ; + i-dot? [ turk>upper ] when + [ upper>> ] [ ch>upper ] map-case ; + +title) ( string -- title ) + i-dot? [ turk>upper ] when + [ title>> ] [ ch>title ] map-case ; + +: title-word ( string -- title ) + unclip 1string [ >lower ] [ (>title) ] bi* prepend ; + +PRIVATE> : >title ( string -- title ) final-sigma >words [ title-word ] map concat ; From e927d844045e00d34f48aa5dbd279c403da8c7e1 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 8 Jan 2009 15:38:03 -0600 Subject: [PATCH 38/38] Fixing doc errors --- basis/unicode/case/case-docs.factor | 2 +- .../unicode/categories/categories-docs.factor | 72 ++++++++----------- basis/unicode/data/data-docs.factor | 18 ++--- basis/unicode/data/data.factor | 4 +- basis/unicode/normalize/normalize-docs.factor | 2 +- 5 files changed, 44 insertions(+), 54 deletions(-) diff --git a/basis/unicode/case/case-docs.factor b/basis/unicode/case/case-docs.factor index 86b791ed81..da582c659a 100644 --- a/basis/unicode/case/case-docs.factor +++ b/basis/unicode/case/case-docs.factor @@ -35,7 +35,7 @@ HELP: >title { $description "Converts a string to title case." } ; HELP: >case-fold -{ $values { "string" string } { "case-fold" string } } +{ $values { "string" string } { "fold" string } } { $description "Converts a string to case-folded form." } ; HELP: upper? diff --git a/basis/unicode/categories/categories-docs.factor b/basis/unicode/categories/categories-docs.factor index 421fa90dd2..a7fe8d1e02 100644 --- a/basis/unicode/categories/categories-docs.factor +++ b/basis/unicode/categories/categories-docs.factor @@ -3,57 +3,47 @@ USING: help.markup help.syntax kernel ; IN: unicode.categories -HELP: LETTER? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Determines whether the code point is an upper-cased letter" } ; +HELP: LETTER +{ $class-description "The class of upper cased letters" } ; -HELP: Letter? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Determines whether the code point is a letter of any case" } ; +HELP: Letter +{ $class-description "The class of letters" } ; -HELP: alpha? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Determines whether the code point is alphanumeric" } ; +HELP: alpha +{ $class-description "The class of code points which are alphanumeric" } ; -HELP: blank? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Determines whether the code point is whitespace" } ; +HELP: blank +{ $class-description "The class of code points which are whitespace" } ; -HELP: character? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Determines whether a number is a code point which has been assigned" } ; +HELP: character +{ $class-description "The class of numbers which are pre-defined Unicode code points" } ; -HELP: control? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Determines whether a code point is a control character" } ; +HELP: control +{ $class-description "The class of control characters" } ; -HELP: digit? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Determines whether a code point is a digit" } ; +HELP: digit +{ $class-description "The class of code coints which are digits" } ; -HELP: letter? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Determines whether a code point is a lower-cased letter" } ; +HELP: letter +{ $class-description "The class of code points which are lower-cased letters" } ; -HELP: printable? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Determines whether a code point is printable, as opposed to being a control character or formatting character" } ; +HELP: printable +{ $class-description "The class of characters which are printable, as opposed to being control or formatting characters" } ; -HELP: uncased? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Determines whether a character has a case" } ; +HELP: uncased +{ $class-description "The class of letters which don't have a case" } ; ARTICLE: "unicode.categories" "Character classes" -{ $vocab-link "unicode.categories" } " is a vocabulary which provides predicates for determining if a code point has a particular property, for example being a lower cased letter. These should be used in preference to the " { $vocab-link "ASCII" "ascii" } " equivalents in most cases. Below are links to the useful predicates, but note that each of these is defined to be a predicate class." -{ $subsection blank? } -{ $subsection letter? } -{ $subsection LETTER? } -{ $subsection Letter? } -{ $subsection digit? } -{ $subsection printable? } -{ $subsection alpha? } -{ $subsection control? } -{ $subsection uncased? } -{ $subsection character? } ; +{ $vocab-link "unicode.categories" } " is a vocabulary which provides predicates for determining if a code point has a particular property, for example being a lower cased letter. These should be used in preference to the " { $vocab-link "ascii" } " equivalents in most cases. Below are links to classes of characters, but note that each of these also has a predicate defined, which is usually more useful." +{ $subsection blank } +{ $subsection letter } +{ $subsection LETTER } +{ $subsection Letter } +{ $subsection digit } +{ $subsection printable } +{ $subsection alpha } +{ $subsection control } +{ $subsection uncased } +{ $subsection character } ; ABOUT: "unicode.categories" diff --git a/basis/unicode/data/data-docs.factor b/basis/unicode/data/data-docs.factor index a918728285..55fed31386 100644 --- a/basis/unicode/data/data-docs.factor +++ b/basis/unicode/data/data-docs.factor @@ -15,37 +15,37 @@ ARTICLE: "unicode.data" "Unicode data tables" { $subsection property? } ; HELP: load-script -{ $value { "filename" string } { "table" "an interval map" } } +{ $values { "filename" string } { "table" "an interval map" } } { $description "This loads a file that looks like Script.txt in the Unicode Character Database and converts it into an efficient interval map, where the keys are characters and the values are strings for the properties." } ; HELP: canonical-entry -{ $value { "char" "a code point" } { "seq" string } } +{ $values { "char" "a code point" } { "seq" string } } { $description "Finds the canonical decomposition (NFD) for a code point" } ; HELP: combine-chars -{ $value { "a" "a code point" } { "b" "a code point" } { "char/f" "a code point" } } +{ $values { "a" "a code point" } { "b" "a code point" } { "char/f" "a code point" } } { $description "If a followed by b can be combined in NFC, this returns the code point of their combination." } ; HELP: compatibility-entry -{ $value { "char" "a code point" } { "seq" string } } +{ $values { "char" "a code point" } { "seq" string } } { $description "This returns the compatibility decomposition (NFKD) for a code point" } ; HELP: combining-class -{ $value { "char" "a code point" } { "n" "an integer" } } +{ $values { "char" "a code point" } { "n" "an integer" } } { $description "Finds the combining class of a code point." } ; HELP: non-starter? -{ $value { "char" "a code point" } { "?" "a boolean" } } +{ $values { "char" "a code point" } { "?" "a boolean" } } { $description "Returns true if the code point has a combining class." } ; HELP: char>name -{ $value { "char" "a code point" } { "name" string } } +{ $values { "char" "a code point" } { "name" string } } { $description "Looks up the name of a given code point. Warning: this is not optimized for speed, to save space." } ; HELP: name>char -{ $value { "name" string } { "char" "a code point" } } +{ $values { "name" string } { "char" "a code point" } } { $description "Looks up the code point corresponding to a given name." } ; HELP: property? -{ $value { "char" "a code point" } { "property" string } { "?" "a boolean" } } +{ $values { "char" "a code point" } { "property" string } { "?" "a boolean" } } { $description "Tests whether the code point is listed under the given property in PropList.txt in the Unicode Character Database." } ; diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index 8f99b6c160..cf4130ca4d 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -24,8 +24,8 @@ VALUE: properties : compatibility-entry ( char -- seq ) compatibility-map at ; : combining-class ( char -- n ) class-map at ; : non-starter? ( char -- ? ) class-map key? ; -: name>char ( string -- char ) name-map at ; -: char>name ( char -- string ) name-map value-at ; +: name>char ( name -- char ) name-map at ; +: char>name ( char -- name ) name-map value-at ; : property? ( char property -- ? ) properties at interval-key? ; ! Loading data from UnicodeData.txt diff --git a/basis/unicode/normalize/normalize-docs.factor b/basis/unicode/normalize/normalize-docs.factor index 65f50ab0ae..4b1e3485ef 100644 --- a/basis/unicode/normalize/normalize-docs.factor +++ b/basis/unicode/normalize/normalize-docs.factor @@ -23,5 +23,5 @@ HELP: nfkc { $description "Converts a string to Normalization Form KC" } ; HELP: nfkd -{ $values { "string" string } { "nfc" "a string in NFKD" } } +{ $values { "string" string } { "nfkd" "a string in NFKD" } } { $description "Converts a string to Normalization Form KD" } ;