diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 37eb5f148e..df6c9dadc5 100755 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -485,3 +485,5 @@ must-fail-with [ t ] [ "staging-problem-test-1" "parser.tests" lookup >boolean ] unit-test [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test + +[ "DEFER: blah" eval ] [ error>> no-current-vocab? ] must-fail-with diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 3f46d1dd30..46e93753b5 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -236,7 +236,7 @@ PREDICATE: unexpected-eof < unexpected ERROR: no-current-vocab ; M: no-current-vocab summary ( obj -- ) - drop "Current vocabulary is f, use IN:" ; + drop "Not in a vocabulary; IN: form required" ; : current-vocab ( -- str ) in get [ no-current-vocab ] unless* ; diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index 97fbc973f0..205d4d34bf 100644 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -28,7 +28,7 @@ HELP: adjoin { $description "Removes all elements equal to " { $snippet "elt" } ", and adds " { $snippet "elt" } " at the end of the sequence." } { $examples { $example - "USING: namespaces prettyprint sequences ;" + "USING: namespaces prettyprint sets ;" "V{ \"beans\" \"salsa\" \"cheese\" } \"v\" set" "\"nachos\" \"v\" get adjoin" "\"salsa\" \"v\" get adjoin" diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 7ed79f77f1..27c8609a99 100755 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -100,7 +100,7 @@ IN: bootstrap.syntax ] define-syntax "DEFER:" [ - scan in get create + scan current-vocab create dup old-definitions get [ delete-at ] with each set-word ] define-syntax diff --git a/extra/html/components/components-tests.factor b/extra/html/components/components-tests.factor index f2b0049a8e..1a0f849a8f 100644 --- a/extra/html/components/components-tests.factor +++ b/extra/html/components/components-tests.factor @@ -1,7 +1,7 @@ IN: html.components.tests USING: tools.test kernel io.streams.string io.streams.null accessors inspector html.streams -html.components ; +html.components namespaces ; [ ] [ blank-values ] unit-test diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index a6e76cdc9e..79470131f3 100755 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -203,9 +203,7 @@ TUPLE: sprite loc dim dim2 dlist texture ; dup sprite-loc gl-translate GL_TEXTURE_2D over sprite-texture glBindTexture init-texture - GL_QUADS [ dup sprite-dim2 four-sides ] do-state - dup sprite-dim { 1 0 } v* - swap sprite-loc v- gl-translate + GL_QUADS [ sprite-dim2 four-sides ] do-state GL_TEXTURE_2D 0 glBindTexture ; : rect-vertices ( lower-left upper-right -- ) diff --git a/extra/tangle/html/html-tests.factor b/extra/tangle/html/html-tests.factor index 8e7d8c24e1..88ad748400 100644 --- a/extra/tangle/html/html-tests.factor +++ b/extra/tangle/html/html-tests.factor @@ -1,4 +1,4 @@ -USING: html kernel semantic-db tangle.html tools.test ; +USING: kernel semantic-db tangle.html tools.test ; IN: tangle.html.tests [ "test" ] [ "test" >html ] unit-test diff --git a/extra/trees/splay/splay-tests.factor b/extra/trees/splay/splay-tests.factor index 29bc153030..e54e3cd538 100644 --- a/extra/trees/splay/splay-tests.factor +++ b/extra/trees/splay/splay-tests.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2005 Mackenzie Straight. ! See http://factorcode.org/license.txt for BSD license. USING: kernel tools.test trees.splay math namespaces assocs -sequences random ; +sequences random sets ; IN: trees.splay.tests : randomize-numeric-splay-tree ( splay-tree -- ) diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor index 1c83bc9713..3512bbf670 100755 --- a/extra/ui/freetype/freetype.factor +++ b/extra/ui/freetype/freetype.factor @@ -3,7 +3,8 @@ USING: alien alien.accessors alien.c-types arrays io kernel libc math math.vectors namespaces opengl opengl.gl prettyprint assocs sequences io.files io.styles continuations freetype -ui.gadgets.worlds ui.render ui.backend byte-arrays ; +ui.gadgets.worlds ui.render ui.backend byte-arrays accessors +locals ; IN: ui.freetype @@ -41,8 +42,8 @@ M: font hashcode* drop font hashcode* ; ] bind ; M: freetype-renderer free-fonts ( world -- ) - dup world-handle select-gl-context - world-fonts [ nip second free-sprites ] assoc-each ; + [ handle>> select-gl-context ] + [ fonts>> [ nip second free-sprites ] assoc-each ] bi ; : ttf-name ( font style -- name ) 2array H{ @@ -67,7 +68,7 @@ M: freetype-renderer free-fonts ( world -- ) #! We use FT_New_Memory_Face, not FT_New_Face, since #! FT_New_Face only takes an ASCII path name and causes #! problems on localized versions of Windows - freetype -rot 0 f [ + [ freetype ] 2dip 0 f [ FT_New_Memory_Face freetype-error ] keep *void* ; @@ -85,29 +86,29 @@ SYMBOL: dpi : font-units>pixels ( n font -- n ) face-size face-size-y-scale FT_MulFix ; -: init-ascent ( font face -- ) - dup face-y-max swap font-units>pixels swap set-font-ascent ; +: init-ascent ( font face -- font ) + dup face-y-max swap font-units>pixels >>ascent ; inline -: init-descent ( font face -- ) - dup face-y-min swap font-units>pixels swap set-font-descent ; +: init-descent ( font face -- font ) + dup face-y-min swap font-units>pixels >>descent ; inline -: init-font ( font -- ) - dup font-handle 2dup init-ascent dupd init-descent - dup font-ascent over font-descent - ft-ceil - swap set-font-height ; +: init-font ( font -- font ) + dup handle>> init-ascent + dup handle>> init-descent + dup [ ascent>> ] [ descent>> ] bi - ft-ceil >>height ; inline + +: set-char-size ( handle size -- ) + 0 swap 6 shift dpi get-global dup FT_Set_Char_Size freetype-error ; : ( handle -- font ) - H{ } clone - { set-font-handle set-font-widths } font construct - dup init-font ; - -: (open-font) ( font -- open-font ) - first3 >r open-face dup 0 r> 6 shift - dpi get-global dpi get-global FT_Set_Char_Size - freetype-error ; + font new + H{ } clone >>widths + over first2 open-face >>handle + dup handle>> rot third set-char-size + init-font ; M: freetype-renderer open-font ( font -- open-font ) - freetype drop open-fonts get [ (open-font) ] cache ; + freetype drop open-fonts get [ ] cache ; : load-glyph ( font char -- glyph ) >r font-handle dup r> 0 FT_Load_Char @@ -132,30 +133,35 @@ M: freetype-renderer string-height ( open-font string -- h ) load-glyph dup FT_RENDER_MODE_NORMAL FT_Render_Glyph freetype-error ; -: copy-pixel ( bit tex -- bit tex ) - 255 f pick set-alien-unsigned-1 1+ - f pick alien-unsigned-1 - f pick set-alien-unsigned-1 >r 1+ r> 1+ ; +:: copy-pixel ( i j bitmap texture -- i j ) + 255 j texture set-char-nth + i bitmap char-nth j 1 + texture set-char-nth + i 1 + j 2 + ; inline -: (copy-row) ( bit tex bitend texend -- bitend texend ) - >r pick over >= [ - 2nip r> - ] [ - >r copy-pixel r> r> (copy-row) - ] if ; +:: (copy-row) ( i j bitmap texture end -- ) + i end < [ + i j bitmap texture copy-pixel + bitmap texture end (copy-row) + ] when ; inline -: copy-row ( bit tex width width2 -- bitend texend width width2 ) - [ pick + >r pick + r> (copy-row) ] 2keep ; +:: copy-row ( i j bitmap texture width width2 -- i j ) + i j bitmap texture i width + (copy-row) + i width + + j width2 + ; inline -: copy-bitmap ( glyph texture -- ) - over glyph-bitmap-rows >r - over glyph-bitmap-width dup next-power-of-2 2 * - >r >r >r glyph-bitmap-buffer alien-address r> r> r> r> - [ copy-row ] times 2drop 2drop ; +:: copy-bitmap ( glyph texture -- ) + [let* | bitmap [ glyph glyph-bitmap-buffer ] + rows [ glyph glyph-bitmap-rows ] + width [ glyph glyph-bitmap-width ] + width2 [ width next-power-of-2 2 * ] | + 0 0 + rows [ bitmap texture width width2 copy-row ] times + 2drop + ] ; : bitmap>texture ( glyph sprite -- id ) tuck sprite-size2 * 2 * [ - alien-address [ copy-bitmap ] keep gray-texture + [ copy-bitmap ] keep gray-texture ] with-malloc ; : glyph-texture-loc ( glyph font -- loc ) @@ -163,34 +169,47 @@ M: freetype-renderer string-height ( open-font string -- h ) font-ascent swap glyph-hori-bearing-y - ft-floor 2array ; : glyph-texture-size ( glyph -- dim ) - dup glyph-bitmap-width next-power-of-2 - swap glyph-bitmap-rows next-power-of-2 2array ; + [ glyph-bitmap-width next-power-of-2 ] + [ glyph-bitmap-rows next-power-of-2 ] + bi 2array ; -: ( font char -- sprite ) +: ( open-font char -- sprite ) over >r render-glyph dup r> glyph-texture-loc over glyph-size pick glyph-texture-size [ bitmap>texture ] keep [ init-sprite ] keep ; -: draw-char ( open-font char sprites -- ) - [ dupd ] cache nip - sprite-dlist glCallList ; +:: char-sprite ( open-font sprites char -- sprite ) + char sprites [ open-font swap ] cache ; -: (draw-string) ( open-font sprites string loc -- ) +: draw-char ( open-font sprites char loc -- ) + GL_MODELVIEW [ + 0 0 glTranslated + char-sprite sprite-dlist glCallList + ] do-matrix ; + +: char-widths ( open-font string -- widths ) + [ char-width ] with { } map-as ; + +: scan-sums ( seq -- seq' ) + 0 [ + ] accumulate nip ; + +:: (draw-string) ( open-font sprites string loc -- ) GL_TEXTURE_2D [ - [ - [ >r 2dup r> swap draw-char ] each 2drop + loc [ + string open-font string char-widths scan-sums [ + [ open-font sprites ] 2dip draw-char + ] 2each ] with-translation ] do-enabled ; -: font-sprites ( open-font world -- pair ) - world-fonts [ open-font H{ } clone 2array ] cache ; +: font-sprites ( font world -- open-font sprites ) + world-fonts [ open-font H{ } clone 2array ] cache first2 ; M: freetype-renderer draw-string ( font string loc -- ) - >r >r world get font-sprites first2 r> r> (draw-string) ; + >r >r world get font-sprites r> r> (draw-string) ; : run-char-widths ( open-font string -- widths ) - [ char-width ] with { } map-as - dup 0 [ + ] accumulate nip swap 2 v/n v+ ; + char-widths [ scan-sums ] [ 2 v/n ] bi v+ ; M: freetype-renderer x>offset ( x open-font string -- n ) dup >r run-char-widths [ <= ] with find drop diff --git a/extra/unicode/collation/collation-tests.factor b/extra/unicode/collation/collation-tests.factor index c9d6cb808f..b4a54bb11d 100755 --- a/extra/unicode/collation/collation-tests.factor +++ b/extra/unicode/collation/collation-tests.factor @@ -20,7 +20,7 @@ IN: unicode.collation.tests [ execute ] 2with each ; [ f f f f ] [ "hello" "hi" test-equality ] unit-test -[ t f f f ] [ "hello" "hˇllo" test-equality ] unit-test +[ t f f f ] [ "hello" "h\u0000e9llo" test-equality ] unit-test [ t t f f ] [ "hello" "HELLO" test-equality ] unit-test [ t t t f ] [ "hello" "h e l l o." test-equality ] unit-test [ t t t t ] [ "hello" "\0hello\0" test-equality ] unit-test