diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index b2a0e56c0a..0845264d61 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -49,6 +49,7 @@ $nl { "associative mapping" { "an object whose class implements the " { $link "assocs-protocol" } } } { "boolean" { { $link t } " or " { $link f } } } { "class" { "a set of objects identified by a " { $emphasis "class word" } " together with a discriminating predicate. See " { $link "classes" } } } + { "combinator" { "a word taking a quotation or another word as input; a higher-order function. See " { $link "combinators" } } } { "definition specifier" { "an instance of " { $link definition } " which implements the " { $link "definition-protocol" } } } { "generalized boolean" { "an object interpreted as a boolean; a value of " { $link f } " denotes false and anything else denotes true" } } { "generic word" { "a word whose behavior depends can be specialized on the class of one of its inputs. See " { $link "generic" } } } @@ -56,6 +57,7 @@ $nl { "object" { "any datum which can be identified" } } { "ordering specifier" { "see " { $link "order-specifiers" } } } { "pathname string" { "an OS-specific pathname which identifies a file" } } + { "quotation" { "an anonymous function; an instance of the " { $link quotation } " class. More generally, instances of the " { $link callable } " class can be used in many places documented to expect quotations" } } { "sequence" { "a sequence; see " { $link "sequence-protocol" } } } { "slot" { "a component of an object which can store a value" } } { "stack effect" { "a pictorial representation of a word's inputs and outputs, for example " { $snippet "+ ( x y -- z )" } ". See " { $link "effects" } } } diff --git a/basis/images/bitmap/bitmap-tests.factor b/basis/images/bitmap/bitmap-tests.factor index c7012cfd42..29ba3b9b80 100644 --- a/basis/images/bitmap/bitmap-tests.factor +++ b/basis/images/bitmap/bitmap-tests.factor @@ -1,6 +1,7 @@ USING: images.bitmap images.viewer io.encodings.binary io.files io.files.unique kernel tools.test images.loader -literals sequences checksums.md5 checksums ; +literals sequences checksums.md5 checksums +images.normalization ; IN: images.bitmap.tests CONSTANT: test-bitmap24 "vocab:images/test-images/thiswayup24.bmp" @@ -16,15 +17,6 @@ CONSTANT: test-41 "vocab:images/test-images/41red24bit.bmp" CONSTANT: test-42 "vocab:images/test-images/42red24bit.bmp" CONSTANT: test-43 "vocab:images/test-images/43red24bit.bmp" -[ t ] -[ - test-bitmap24 - [ binary file-contents ] [ load-image ] bi - - "test-bitmap24" unique-file - [ save-bitmap ] [ binary file-contents ] bi = -] unit-test - { $ test-bitmap8 $ test-bitmap24 @@ -34,7 +26,7 @@ CONSTANT: test-43 "vocab:images/test-images/43red24bit.bmp" : test-bitmap-save ( path -- ? ) [ md5 checksum-file ] - [ load-image ] bi + [ load-image normalize-image ] bi "bitmap-save-test" unique-file [ save-bitmap ] [ md5 checksum-file ] bi = ; @@ -47,5 +39,6 @@ CONSTANT: test-43 "vocab:images/test-images/43red24bit.bmp" $ test-41 $ test-42 $ test-43 + $ test-bitmap24 } [ test-bitmap-save ] all? ] unit-test diff --git a/basis/images/images.factor b/basis/images/images.factor index b32953f67c..178b91ab52 100755 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -3,7 +3,7 @@ USING: combinators kernel accessors ; IN: images -SINGLETONS: L BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR +SINGLETONS: L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ; UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ; @@ -11,6 +11,7 @@ UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ; : bytes-per-pixel ( component-order -- n ) { { L [ 1 ] } + { LA [ 2 ] } { BGR [ 3 ] } { RGB [ 3 ] } { BGRA [ 4 ] } @@ -33,4 +34,4 @@ TUPLE: image dim component-order upside-down? bitmap ; : has-alpha? ( image -- ? ) component-order>> alpha-channel? ; -GENERIC: load-image* ( path tuple -- image ) \ No newline at end of file +GENERIC: load-image* ( path tuple -- image ) diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor index b8bafc021f..fe33cc8f00 100644 --- a/basis/images/loader/loader.factor +++ b/basis/images/loader/loader.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: constructors kernel splitting unicode.case combinators -accessors images.bitmap images.tiff images images.normalization -io.pathnames ; +accessors images.bitmap images.tiff images io.pathnames ; IN: images.loader ERROR: unknown-image-extension extension ; @@ -16,4 +15,4 @@ ERROR: unknown-image-extension extension ; } case ; : load-image ( path -- image ) - dup image-class new load-image* normalize-image ; + dup image-class new load-image* ; diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index 80eaff8140..6bf1ea2ff1 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -463,6 +463,7 @@ ERROR: unknown-component-order ifd ; { { 16 16 16 } [ 2 seq>native-endianness ] } { { 8 8 8 8 } [ ] } { { 8 8 8 } [ ] } + { 8 [ ] } [ unknown-component-order ] } case >>bitmap ; @@ -474,11 +475,11 @@ ERROR: unknown-component-order ifd ; { { 16 16 16 } [ R16G16B16 ] } { { 8 8 8 8 } [ RGBA ] } { { 8 8 8 } [ RGB ] } + { 8 [ LA ] } [ unknown-component-order ] } case ; : normalize-alpha-data ( seq -- byte-array ) - ! [ normalize-alpha-data ] change-bitmap B{ } like dup byte-array>float-array 4 diff --git a/basis/opengl/capabilities/capabilities.factor b/basis/opengl/capabilities/capabilities.factor index 09d49b33c2..ad04ce7fa5 100755 --- a/basis/opengl/capabilities/capabilities.factor +++ b/basis/opengl/capabilities/capabilities.factor @@ -32,6 +32,8 @@ IN: opengl.capabilities (gl-version) drop ; : gl-vendor-version ( -- version ) (gl-version) nip ; +: gl-vendor ( -- name ) + GL_VENDOR glGetString ; : has-gl-version? ( version -- ? ) gl-version version-before? ; : (make-gl-version-error) ( required-version -- ) diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor index 1900deb5b8..76e0c473b9 100755 --- a/basis/opengl/textures/textures.factor +++ b/basis/opengl/textures/textures.factor @@ -1,13 +1,23 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs cache colors.constants destructors fry kernel -opengl opengl.gl combinators images images.tesselation grouping -specialized-arrays.float sequences math math.vectors -math.matrices generalizations fry arrays namespaces ; +opengl opengl.gl opengl.capabilities combinators images +images.tesselation grouping specialized-arrays.float sequences math +math.vectors math.matrices generalizations fry arrays namespaces +system ; IN: opengl.textures SYMBOL: non-power-of-2-textures? +: check-extensions ( -- ) + #! ATI frglx driver doesn't implement GL_ARB_texture_non_power_of_two properly. + #! See thread 'Linux font display problem' April 2009 on Factor-talk + gl-vendor "ATI Technologies Inc." = not os macosx? or [ + "2.0" { "GL_ARB_texture_non_power_of_two" } + has-gl-version-or-extensions? + non-power-of-2-textures? set + ] when ; + : gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ; : delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ; @@ -20,6 +30,8 @@ M: RGBA component-order>format drop GL_RGBA GL_UNSIGNED_BYTE ; M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ; M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ; M: BGRX component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ; +M: LA component-order>format drop GL_LUMINANCE_ALPHA GL_UNSIGNED_BYTE ; +M: L component-order>format drop GL_LUMINANCE GL_UNSIGNED_BYTE ; SLOT: display-list @@ -163,4 +175,4 @@ PRIVATE> : ( image loc -- texture ) over dim>> max-texture-size [ <= ] 2all? [ ] - [ [ max-texture-size tesselate ] dip ] if ; \ No newline at end of file + [ [ max-texture-size tesselate ] dip ] if ; diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index fc392c595d..1bbf46c69e 100755 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -70,8 +70,8 @@ M:: cocoa-ui-backend (open-window) ( world -- ) world dim>> :> view view world world>NSRect :> window view -> release - window world window-loc>> auto-position world view register-window + window world window-loc>> auto-position world window save-position window install-window-delegate view window world (>>handle) diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index b59848260d..602c9bec73 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -336,7 +336,7 @@ CLASS: { ! Initialization { "updateFactorGadgetSize:" "void" { "id" "SEL" "id" } - [ 2drop dup view-dim swap window (>>dim) yield ] + [ 2drop [ window ] [ view-dim ] bi >>dim drop yield ] } { "doCommandBySelector:" "void" { "id" "SEL" "SEL" } diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index f671add531..a186de7670 100644 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs continuations kernel math models -namespaces opengl opengl.capabilities opengl.textures sequences io -combinators combinators.short-circuit fry math.vectors math.rectangles -cache ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks +namespaces opengl opengl.textures sequences io combinators +combinators.short-circuit fry math.vectors math.rectangles cache +ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks ui.commands ; IN: ui.gadgets.worlds @@ -77,10 +77,6 @@ SYMBOL: flush-layout-cache-hook flush-layout-cache-hook [ [ ] ] initialize -: check-extensions ( -- ) - "2.0" { "GL_ARB_texture_non_power_of_two" } has-gl-version-or-extensions? - non-power-of-2-textures? set ; - : (draw-world) ( world -- ) dup handle>> [ check-extensions diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index dff7726d08..1de3912f28 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -12,7 +12,10 @@ IN: ui ! Assoc mapping aliens to gadgets SYMBOL: windows -: window ( handle -- world ) windows get-global at ; +ERROR: no-window handle ; + +: window ( handle -- world ) + windows get-global ?at [ no-window ] unless ; : window-focus ( handle -- gadget ) window world-focus ; diff --git a/basis/urls/encoding/encoding-tests.factor b/basis/urls/encoding/encoding-tests.factor index 87b1812ef8..78e31a764d 100644 --- a/basis/urls/encoding/encoding-tests.factor +++ b/basis/urls/encoding/encoding-tests.factor @@ -26,3 +26,7 @@ USING: urls.encoding tools.test arrays kernel assocs present accessors ; [ H{ { "text" "hello world" } } ] [ "text=hello+world" query>assoc ] unit-test [ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test + +[ "a" ] [ { { "a" f } } assoc>query ] unit-test + +[ H{ { "a" f } } ] [ "a" query>assoc ] unit-test \ No newline at end of file diff --git a/basis/urls/encoding/encoding.factor b/basis/urls/encoding/encoding.factor index 7fed4b5f58..15b71ac0db 100644 --- a/basis/urls/encoding/encoding.factor +++ b/basis/urls/encoding/encoding.factor @@ -72,6 +72,15 @@ PRIVATE> ] when* ] 2keep set-at ; +: assoc-strings ( assoc -- assoc' ) + [ + { + { [ dup not ] [ ] } + { [ dup array? ] [ [ present ] map ] } + [ present 1array ] + } cond + ] assoc-map ; + PRIVATE> : query>assoc ( query -- assoc ) @@ -86,11 +95,8 @@ PRIVATE> : assoc>query ( assoc -- str ) [ - dup array? [ [ present ] map ] [ present 1array ] if - ] assoc-map - [ - [ + assoc-strings [ [ url-encode ] dip - [ url-encode "=" glue , ] with each + [ [ url-encode "=" glue , ] with each ] [ , ] if* ] assoc-each ] { } make "&" join ; diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor index f45ad6449e..f2ecd6ec69 100644 --- a/basis/urls/urls-tests.factor +++ b/basis/urls/urls-tests.factor @@ -80,6 +80,15 @@ CONSTANT: urls } "ftp://slava:secret@ftp.kernel.org/" } + { + T{ url + { protocol "http" } + { host "foo.com" } + { path "/" } + { query H{ { "a" f } } } + } + "http://foo.com/?a" + } } urls [ diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor index f6cacfb683..fb0c134b9a 100755 --- a/basis/windows/uniscribe/uniscribe.factor +++ b/basis/windows/uniscribe/uniscribe.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel assocs math sequences fry io.encodings.string -io.encodings.utf16n accessors arrays combinators destructors locals -cache namespaces init images.normalization fonts alien.c-types -windows windows.usp10 windows.offscreen windows.gdi32 -windows.ole32 windows.types windows.fonts opengl.textures ; +io.encodings.utf16n accessors arrays combinators destructors +cache namespaces init fonts alien.c-types windows windows.usp10 +windows.offscreen windows.gdi32 windows.ole32 windows.types +windows.fonts opengl.textures locals ; IN: windows.uniscribe TUPLE: script-string font string metrics ssa size image disposed ; @@ -112,4 +112,4 @@ SYMBOL: cached-script-strings cached-script-strings get-global [ ] 2cache ; [ cached-script-strings set-global ] -"windows.uniscribe" add-init-hook \ No newline at end of file +"windows.uniscribe" add-init-hook diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor index 32cab65904..d76faddf15 100644 --- a/core/classes/tuple/tuple-docs.factor +++ b/core/classes/tuple/tuple-docs.factor @@ -92,7 +92,7 @@ ARTICLE: "tuple-constructors" "Tuple constructors" $nl "Constructors play a part in enforcing the invariant that slot values must always match slot declarations. The " { $link new } " word fills in the tuple with initial values, and " { $link boa } " ensures that the values on the stack match the corresponding slot declarations. See " { $link "tuple-declarations" } "." $nl -"All tuple construction should be done through constructor words, and construction primitives should be encapsulated and never called outside of the vocabulary where the class is defined, because this encourages looser coupling. For example, a constructor word could be changed to use memoization instead of always constructing a new instance, or it could be changed to construt a different class, without breaking callers." +"All tuple construction should be done through constructor words, and construction primitives should be encapsulated and never called outside of the vocabulary where the class is defined, because this encourages looser coupling. For example, a constructor word could be changed to use memoization instead of always constructing a new instance, or it could be changed to construct a different class, without breaking callers." $nl "Examples of constructors:" { $code @@ -220,13 +220,13 @@ ARTICLE: "tuple-examples" "Tuple examples" " \"project manager\" >>position ;" } "An alternative strategy is to define the most general BOA constructor first:" { $code - ": ( name position -- person )" + ": ( name position -- employee )" " 40000 employee boa ;" } "Now we can define more specific constructors:" { $code - ": ( name -- person )" - " \"manager\" ;" } + ": ( name -- employee )" + " \"manager\" ;" } "An example using reader words:" { $code "TUPLE: check to amount number ;" @@ -256,7 +256,7 @@ ARTICLE: "tuple-examples" "Tuple examples" ": next-position ( role -- newrole )" " positions [ index 1+ ] keep nth ;" "" - ": promote ( person -- person )" + ": promote ( employee -- employee )" " [ 1.2 * ] change-salary" " [ next-position ] change-position ;" } diff --git a/basis/images/normalization/authors.txt b/extra/images/normalization/authors.txt similarity index 100% rename from basis/images/normalization/authors.txt rename to extra/images/normalization/authors.txt diff --git a/basis/images/normalization/normalization.factor b/extra/images/normalization/normalization.factor similarity index 100% rename from basis/images/normalization/normalization.factor rename to extra/images/normalization/normalization.factor