{ $heading "Documentation conventions" }
"Factor documentation consists of two distinct bodies of text. There is a hierarchy of articles, much like this one, and there is word documentation. Help articles reference word documentation, and vice versa, but not every documented word is referenced from some help article."
$nl
-"Every article has links to parent articles at the top. These can be persued if the article is too specific."
+"Every article has links to parent articles at the top. Explore these if the article you are reading is too specific."
$nl
"Some generic words have " { $strong "Description" } " headings, and others have " { $strong "Contract" } " headings. A distinction is made between words which are not intended to be extended with user-defined methods, and those that are."
{ $heading "Vocabulary naming conventions" }
"A vocabulary name ending in " { $snippet ".private" } " contains words which are either implementation detail, unsafe, or both. For example, the " { $snippet "sequence.private" } " vocabulary contains words which access sequence elements without bounds checking (" { $link "sequences-unsafe" } ")."
$nl
-"You should should avoid using internal words from the Factor library unless absolutely necessary. Similarly, your own code can place words in internal vocabularies if you do not want other people to use them unless they have a good reason."
+"You should avoid using internal words from the Factor library unless absolutely necessary. Similarly, your own code can place words in internal vocabularies if you do not want other people to use them unless they have a good reason."
{ $heading "Word naming conventions" }
"These conventions are not hard and fast, but are usually a good first step in understanding a word's behavior:"
{ $table
QUALIFIED: init
QUALIFIED: layouts
QUALIFIED: source-files
+QUALIFIED: source-files.errors
QUALIFIED: vocabs
IN: tools.deploy.shaker
compiled-crossref
compiled-generic-crossref
compiler-impl
+ compiler.errors:compiler-errors
definition-observers
definitions:crossref
interactive-vocabs
lexer-factory
print-use-hook
root-cache
+ source-files.errors:error-types
vocabs:dictionary
vocabs:load-vocab-hook
word
IN: tools.test.tests
-USING: tools.test ;
+USING: tools.test tools.test.private namespaces kernel sequences ;
\ test-all must-infer
+
+: fake-unit-test ( quot -- )
+ [
+ "fake" file set
+ V{ } clone test-failures set
+ call
+ test-failures get
+ ] with-scope ; inline
+
+[ 1 ] [
+ [
+ [ "OOPS" ] must-fail
+ ] fake-unit-test length
+] unit-test
\ No newline at end of file
f file get f failure ;
:: (unit-test) ( output input -- error ? )
- [ { } input with-datastack output assert-sequence= f f ] [ t ] recover ; inline
+ [ { } input with-datastack output assert-sequence= f f ] [ t ] recover ;
: short-effect ( effect -- pair )
[ in>> length ] [ out>> length ] bi 2array ;
:: (must-infer-as) ( effect quot -- error ? )
- [ quot infer short-effect effect assert= f f ] [ t ] recover ; inline
+ [ quot infer short-effect effect assert= f f ] [ t ] recover ;
:: (must-infer) ( word/quot -- error ? )
word/quot dup word? [ '[ _ execute ] ] when :> quot
- [ quot infer drop f f ] [ t ] recover ; inline
+ [ quot infer drop f f ] [ t ] recover ;
TUPLE: did-not-fail ;
CONSTANT: did-not-fail T{ did-not-fail }
M: did-not-fail summary drop "Did not fail" ;
:: (must-fail-with) ( quot pred -- error ? )
- [ quot call did-not-fail t ]
- [ dup pred call [ drop f f ] [ t ] if ] recover ; inline
+ [ { } quot with-datastack drop did-not-fail t ]
+ [ dup pred call( error -- ? ) [ drop f f ] [ t ] if ] recover ;
:: (must-fail) ( quot -- error ? )
- [ quot call did-not-fail t ] [ drop f f ] recover ; inline
+ [ { } quot with-datastack drop did-not-fail t ] [ drop f f ] recover ;
: experiment-title ( word -- string )
"(" ?head drop ")" ?tail drop { { CHAR: - CHAR: \s } } substitute >title ;
{ $notes "Useful for meta-programming with " { $link define-declared } "." }
{ $examples
{ $code
- "SYMBOL: my-dynamic-word"
+ "<< SYMBOL: my-dynamic-word"
"USING: math random words ;"
- "3 { [ + ] [ - ] [ * ] [ / ] } random curry"
- "(( x -- y )) define-declared"
+ "my-dynamic-word 3 { [ + ] [ - ] [ * ] [ / ] } random curry"
+ "(( x -- y )) define-declared >>"
}
} ;
{ $syntax "execute( stack -- effect )" }
{ $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." } ;
-{ POSTPONE: call( POSTPONE: execute( } related-words
\ No newline at end of file
+{ POSTPONE: call( POSTPONE: execute( } related-words
--- /dev/null
+unportable
: mouse-moved ( x-radians y-radians jamshred -- )
jamshred-player -rot turn-player ;
-: units-per-full-roll ( -- n ) 50 ;
+CONSTANT: units-per-full-roll 50
: jamshred-roll ( jamshred n -- )
[ jamshred-player ] dip 2 pi * * units-per-full-roll / roll-player ;
opengl.demo-support sequences specialized-arrays.float ;
IN: jamshred.gl
-: min-vertices ( -- n ) 6 ; inline
-: max-vertices ( -- n ) 32 ; inline
+CONSTANT: min-vertices 6
+CONSTANT: max-vertices 32
-: n-vertices ( -- n ) 32 ; inline
+CONSTANT: n-vertices 32
! render enough of the tunnel that it looks continuous
-: n-segments-ahead ( -- n ) 60 ; inline
-: n-segments-behind ( -- n ) 40 ; inline
+CONSTANT: n-segments-ahead 60
+CONSTANT: n-segments-behind 40
-: wall-drawing-offset ( -- n )
- #! so that we can't see through the wall, we draw it a bit further away
- 0.15 ;
+! so that we can't see through the wall, we draw it a bit further away
+CONSTANT: wall-drawing-offset 0.15
: wall-drawing-radius ( segment -- r )
radius>> wall-drawing-offset + ;
: <jamshred-gadget> ( jamshred -- gadget )
jamshred-gadget new swap >>jamshred ;
-: default-width ( -- x ) 800 ;
-: default-height ( -- y ) 600 ;
+CONSTANT: default-width 800
+CONSTANT: default-height 600
M: jamshred-gadget pref-dim*
drop default-width default-height 2array ;
{ speed float } ;
! speeds are in GL units / second
-: default-speed ( -- speed ) 1.0 ;
-: max-speed ( -- speed ) 30.0 ;
+CONSTANT: default-speed 1.0
+CONSTANT: max-speed 30.0
: <player> ( name sounds -- player )
[ float-array{ 0 0 5 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 } ] 2dip
! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays colors combinators kernel locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences specialized-arrays.float vectors jamshred.oint ;
+USING: accessors arrays colors combinators kernel literals locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences specialized-arrays.float vectors jamshred.oint ;
IN: jamshred.tunnel
-: n-segments ( -- n ) 5000 ; inline
+CONSTANT: n-segments 5000
TUPLE: segment < oint number color radius ;
C: <segment> segment
: random-color ( -- color )
{ 100 100 100 } [ random 100 / >float ] map first3 1.0 <rgba> ;
-: tunnel-segment-distance ( -- n ) 0.4 ;
-: random-rotation-angle ( -- theta ) pi 20 / ;
+CONSTANT: tunnel-segment-distance 0.4
+CONSTANT: random-rotation-angle $[ pi 20 / ]
: random-segment ( previous-segment -- segment )
clone dup random-rotation-angle random-turn
[ dup peek random-segment over push ] dip 1- (random-segments)
] [ drop ] if ;
-: default-segment-radius ( -- r ) 1 ;
+CONSTANT: default-segment-radius 1
: initial-segment ( -- segment )
float-array{ 0 0 0 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 }
: wall-normal ( seg oint -- n )
location>> vector-to-centre normalize ;
-: distant ( -- n ) 1000 ;
+CONSTANT: distant 1000
: max-real ( a b -- c )
#! sometimes collision-coefficient yields complex roots, so we ignore these (hack)
Alex Chapman
+Diego Martinelli
HELP: ch>morse
{ $values
{ "ch" "A character that has a morse code translation" } { "str" "A string consisting of zero or more dots and dashes" } }
-{ $description "If the given character has a morse code translation, then return that translation, otherwise return an empty string." } ;
+{ $description "If the given character has a morse code translation, then return that translation, otherwise return a ? character." } ;
HELP: morse>ch
{ $values
{ "str" "A string of dots and dashes that represents a single character in morse code" } { "ch" "The translated character" } }
-{ $description "If the given string represents a morse code character, then return that character, otherwise return f" } ;
+{ $description "If the given string represents a morse code character, then return that character, otherwise return a space character." } ;
HELP: >morse
{ $values
! Copyright (C) 2007 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: arrays morse strings tools.test ;
+IN: morse.tests
-[ "" ] [ CHAR: \\ ch>morse ] unit-test
+[ CHAR: ? ] [ CHAR: \\ ch>morse ] unit-test
[ "..." ] [ CHAR: s ch>morse ] unit-test
[ CHAR: s ] [ "..." morse>ch ] unit-test
-[ f ] [ "..--..--.." morse>ch ] unit-test
+[ CHAR: \s ] [ "..--..--.." morse>ch ] unit-test
[ "-- --- .-. ... . / -.-. --- -.. ." ] [ "morse code" >morse ] unit-test
[ "morse code" ] [ "-- --- .-. ... . / -.-. --- -.. ." morse> ] unit-test
[ "hello, world!" ] [ "Hello, World!" >morse morse> ] unit-test
+[ ".- -... -.-." ] [ "abc" >morse ] unit-test
+
+[ "abc" ] [ ".- -... -.-." morse> ] unit-test
+
+[ "morse code" ] [
+ [MORSE
+ -- --- .-. ... . /
+ -.-. --- -.. .
+ MORSE] >morse morse> ] unit-test
+
+[ "morse code 123" ] [
+ [MORSE
+ __ ___ ._. ... . /
+ _._. ___ _.. . /
+ .____ ..___ ...__
+ MORSE] ] unit-test
+
+[ [MORSE
+ -- --- .-. ... . /
+ -.-. --- -.. .
+ MORSE] ] [
+ "morse code" >morse morse>
+] unit-test
+
+[ "factor rocks!" ] [
+ [MORSE
+ ..-. .- -.-. - --- .-. /
+ .-. --- -.-. -.- ... -.-.--
+ MORSE] ] unit-test
! [ ] [ "sos" 0.075 play-as-morse* ] unit-test
! [ ] [ "Factor rocks!" play-as-morse ] unit-test
-! Copyright (C) 2007, 2008 Alex Chapman
+! Copyright (C) 2007, 2008, 2009 Alex Chapman, 2009 Diego Martinelli
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors ascii assocs combinators hashtables kernel lists math
-namespaces make openal parser-combinators promises sequences
-strings synth synth.buffers unicode.case ;
+USING: accessors ascii assocs biassocs combinators hashtables kernel lists literals math namespaces make multiline openal parser sequences splitting strings synth synth.buffers ;
IN: morse
<PRIVATE
-: morse-codes ( -- array )
- {
+
+CONSTANT: dot-char CHAR: .
+CONSTANT: dash-char CHAR: -
+CONSTANT: char-gap-char CHAR: \s
+CONSTANT: word-gap-char CHAR: /
+CONSTANT: unknown-char CHAR: ?
+
+PRIVATE>
+
+CONSTANT: morse-code-table $[
+ H{
{ CHAR: a ".-" }
{ CHAR: b "-..." }
{ CHAR: c "-.-." }
{ CHAR: $ "...-..-" }
{ CHAR: @ ".--.-." }
{ CHAR: \s "/" }
- } ;
+ } >biassoc
+]
-: ch>morse-assoc ( -- assoc )
- morse-codes >hashtable ;
-
-: morse>ch-assoc ( -- assoc )
- morse-codes [ reverse ] map >hashtable ;
-
-PRIVATE>
-
-: ch>morse ( ch -- str )
- ch>lower ch>morse-assoc at* swap "" ? ;
+: ch>morse ( ch -- morse )
+ ch>lower morse-code-table at [ unknown-char ] unless* ;
: morse>ch ( str -- ch )
- morse>ch-assoc at* swap f ? ;
-
-: >morse ( str -- str )
- [
- [ CHAR: \s , ] [ ch>morse % ] interleave
- ] "" make ;
-
+ morse-code-table value-at [ char-gap-char ] unless* ;
+
<PRIVATE
+
+: word>morse ( str -- morse )
+ [ ch>morse ] { } map-as " " join ;
-: dot-char ( -- ch ) CHAR: . ;
-: dash-char ( -- ch ) CHAR: - ;
-: char-gap-char ( -- ch ) CHAR: \s ;
-: word-gap-char ( -- ch ) CHAR: / ;
-
-: =parser ( obj -- parser )
- [ = ] curry satisfy ;
-
-LAZY: 'dot' ( -- parser )
- dot-char =parser ;
-
-LAZY: 'dash' ( -- parser )
- dash-char =parser ;
+: sentence>morse ( str -- morse )
+ " " split [ word>morse ] map " / " join ;
+
+: trim-blanks ( str -- newstr )
+ [ blank? ] trim ; inline
-LAZY: 'char-gap' ( -- parser )
- char-gap-char =parser ;
+: morse>word ( morse -- str )
+ " " split [ morse>ch ] "" map-as ;
-LAZY: 'word-gap' ( -- parser )
- word-gap-char =parser ;
+: morse>sentence ( morse -- sentence )
+ "/" split [ trim-blanks morse>word ] map " " join ;
-LAZY: 'morse-char' ( -- parser )
- 'dot' 'dash' <|> <+> ;
-
-LAZY: 'morse-word' ( -- parser )
- 'morse-char' 'char-gap' list-of ;
-
-LAZY: 'morse-words' ( -- parser )
- 'morse-word' 'word-gap' list-of ;
+: replace-underscores ( str -- str' )
+ [ dup CHAR: _ = [ drop CHAR: - ] when ] map ;
PRIVATE>
-
-: morse> ( str -- str )
- 'morse-words' parse car parsed>> [
- [
- >string morse>ch
- ] map >string
- ] map [ [ CHAR: \s , ] [ % ] interleave ] "" make ;
-
+
+: >morse ( str -- newstr )
+ trim-blanks sentence>morse ;
+
+: morse> ( morse -- plain )
+ replace-underscores morse>sentence ;
+
+SYNTAX: [MORSE "MORSE]" parse-multiline-string morse> parsed ;
+
<PRIVATE
+
SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
: queue ( symbol -- )
: intra-char-gap ( -- ) intra-char-gap-buffer queue ;
: letter-gap ( -- ) letter-gap-buffer queue ;
-: beep-freq ( -- n ) 880 ;
+CONSTANT: beep-freq 880
: <morse-buffer> ( -- buffer )
half-sample-freq <8bit-mono-buffer> ;
M: 16bit-stereo-buffer buffer-data
interleaved-stereo-data 16bit-buffer-data ;
-: telephone-sample-freq ( -- n ) 8000 ;
-: half-sample-freq ( -- n ) 22050 ;
-: cd-sample-freq ( -- n ) 44100 ;
-: digital-sample-freq ( -- n ) 48000 ;
-: professional-sample-freq ( -- n ) 88200 ;
+CONSTANT: telephone-sample-freq 8000
+CONSTANT: half-sample-freq 22050
+CONSTANT: cd-sample-freq 44100
+CONSTANT: digital-sample-freq 48000
+CONSTANT: professional-sample-freq 88200
: send-buffer ( buffer -- buffer )
{
projects / factor.git / commitdiff