From 3c00e7270604518fe27f4b998061b521c6edfe37 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 13 Feb 2009 18:06:55 -0600 Subject: [PATCH 1/4] Clean up extra/twitter a little bit --- extra/twitter/twitter.factor | 73 +++++++++++++++++++++++++----------- 1 file changed, 52 insertions(+), 21 deletions(-) diff --git a/extra/twitter/twitter.factor b/extra/twitter/twitter.factor index 2172d7cf81..d70828b310 100644 --- a/extra/twitter/twitter.factor +++ b/extra/twitter/twitter.factor @@ -1,12 +1,41 @@ +! Copyright (C) 2009 Joe Groff. +! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs combinators hashtables http http.client json.reader kernel macros namespaces sequences -urls.secure urls.encoding ; +urls.secure fry ; IN: twitter +! Configuration SYMBOLS: twitter-username twitter-password twitter-source ; twitter-source [ "factor" ] initialize +: set-twitter-credentials ( username password -- ) + [ twitter-username set ] [ twitter-password set ] bi* ; + + + +! Data types + TUPLE: twitter-status created-at id @@ -28,8 +57,7 @@ TUPLE: twitter-user protected? followers-count ; -MACRO: keys-boa ( keys class -- ) - [ [ \ swap \ at [ ] 3sequence ] map \ cleave ] dip \ boa [ ] 4sequence ; + ( assoc -- user ) { @@ -64,37 +92,40 @@ MACRO: keys-boa ( keys class -- ) : json>twitter-status ( json-object -- tweet ) json> ; -: set-twitter-credentials ( username password -- ) - [ twitter-username set ] [ twitter-password set ] bi* ; +PRIVATE> -: set-request-twitter-auth ( request -- request ) - twitter-username twitter-password [ get ] bi@ set-basic-auth ; +! Updates + - set-request-twitter-auth - http-request nip ; + update-post-data "update" [ ] twitter-request ; + +PRIVATE> : tweet* ( string -- tweet ) (tweet) json>twitter-status ; : tweet ( string -- ) (tweet) drop ; +! Timelines + ] twitter-request json>twitter-statuses ; + +PRIVATE> + : public-timeline ( -- tweets ) - "https://twitter.com/statuses/public_timeline.json" - set-request-twitter-auth - http-request nip json>twitter-statuses ; + "public_timeline" timeline ; : friends-timeline ( -- tweets ) - "https://twitter.com/statuses/friends_timeline.json" - set-request-twitter-auth - http-request nip json>twitter-statuses ; + "friends_timeline" timeline ; : user-timeline ( username -- tweets ) - "https://twitter.com/statuses/user_timeline/" ".json" surround - set-request-twitter-auth - http-request nip json>twitter-statuses ; + "user_timeline/" prepend timeline ; From 83834f802ae3fcf277c53746d2b4c487cd7dc21f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 13 Feb 2009 20:20:22 -0600 Subject: [PATCH 2/4] Fixing twitter --- extra/twitter/twitter.factor | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/extra/twitter/twitter.factor b/extra/twitter/twitter.factor index d70828b310..48388de382 100644 --- a/extra/twitter/twitter.factor +++ b/extra/twitter/twitter.factor @@ -27,8 +27,7 @@ MACRO: keys-boa ( keys class -- ) : set-request-twitter-auth ( request -- request ) twitter-username get twitter-password get set-basic-auth ; -: twitter-request ( string quot -- data ) - [ twitter-url ] dip call +: twitter-request ( request -- data ) set-request-twitter-auth http-request nip ; inline @@ -101,10 +100,11 @@ PRIVATE> [ "status" set twitter-source get "source" set - ] make-assoc ; + ] H{ } make-assoc ; : (tweet) ( string -- json ) - update-post-data "update" [ ] twitter-request ; + update-post-data "update" twitter-url + twitter-request ; PRIVATE> @@ -117,7 +117,8 @@ PRIVATE> ] twitter-request json>twitter-statuses ; + twitter-url + twitter-request json>twitter-statuses ; PRIVATE> From b4e7592ba38d6c602b68f490a641c5d3cf6e0578 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Feb 2009 00:30:59 -0600 Subject: [PATCH 3/4] support predictors --- basis/images/images.factor | 28 ++++++++++++++----------- basis/images/tiff/tiff.factor | 39 +++++++++++++++++++++++++++++++++-- 2 files changed, 53 insertions(+), 14 deletions(-) diff --git a/basis/images/images.factor b/basis/images/images.factor index 32fbc54978..c2dc33608e 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -2,11 +2,12 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors grouping sequences combinators math specialized-arrays.direct.uint byte-arrays -specialized-arrays.direct.ushort ; +specialized-arrays.direct.ushort specialized-arrays.uint +specialized-arrays.ushort specialized-arrays.float ; IN: images SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR -R16G16B16 R32G32B32 ; +R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ; TUPLE: image dim component-order bitmap ; @@ -18,34 +19,37 @@ GENERIC: load-image* ( path tuple -- image ) 3 [ 255 suffix ] map concat ; +: normalize-floats ( byte-array -- byte-array ) + byte-array>float-array [ 255.0 * >integer ] B{ } map-as ; + : normalize-component-order ( image -- image ) dup component-order>> { { RGBA [ ] } + { R32G32B32A32 [ + [ normalize-floats ] change-bitmap + ] } { R32G32B32 [ - [ - dup length 4 / - [ bits>float 255.0 * >integer ] map - >byte-array add-dummy-alpha - ] change-bitmap + [ normalize-floats add-dummy-alpha ] change-bitmap + ] } + { R16G16B16A16 [ + [ byte-array>ushort-array [ -8 shift ] B{ } map-as ] change-bitmap ] } { R16G16B16 [ [ - dup length 2 / - [ -8 shift ] map - >byte-array add-dummy-alpha + byte-array>ushort-array [ -8 shift ] B{ } map-as add-dummy-alpha ] change-bitmap ] } { BGRA [ [ - 4 dup [ [ 0 3 ] dip reverse-here ] each + 4 dup [ 3 head-slice reverse-here ] each ] change-bitmap ] } { RGB [ [ add-dummy-alpha ] change-bitmap ] } { BGR [ [ 3 - [ [ [ 0 3 ] dip reverse-here ] each ] + [ [ 3 head-slice reverse-here ] each ] [ add-dummy-alpha ] bi ] change-bitmap ] } diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index 056f91faaa..c91edbae39 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -5,7 +5,7 @@ compression.lzw constructors endian fry grouping images io io.binary io.encodings.ascii io.encodings.binary io.encodings.string io.encodings.utf8 io.files kernel math math.bitwise math.order math.parser pack prettyprint sequences -strings ; +strings math.vectors ; IN: images.tiff TUPLE: tiff-image < image ; @@ -119,7 +119,9 @@ SINGLETONS: image-length image-width x-resolution y-resolution rows-per-strip strip-offsets strip-byte-counts bits-per-sample samples-per-pixel new-subfile-type orientation software date-time photoshop exif-ifd sub-ifd inter-color-profile -xmp iptc unhandled-ifd-entry ; +xmp iptc fill-order document-name page-number page-name +x-position y-position +unhandled-ifd-entry ; ERROR: bad-tiff-magic bytes ; : tiff-endianness ( byte-array -- ? ) @@ -159,6 +161,9 @@ ERROR: no-tag class ; : find-tag ( idf class -- tag ) swap processed-tags>> ?at [ no-tag ] unless ; +: tag? ( idf class -- tag ) + swap processed-tags>> key? ; + : read-strips ( ifd -- ifd ) dup [ strip-byte-counts find-tag ] @@ -242,6 +247,8 @@ ERROR: bad-small-ifd-type n ; { 258 [ bits-per-sample ] } { 259 [ lookup-compression compression ] } { 262 [ lookup-photometric-interpretation photometric-interpretation ] } + { 266 [ fill-order ] } + { 269 [ ascii decode document-name ] } { 273 [ strip-offsets ] } { 274 [ orientation ] } { 277 [ samples-per-pixel ] } @@ -250,7 +257,11 @@ ERROR: bad-small-ifd-type n ; { 282 [ first x-resolution ] } { 283 [ first y-resolution ] } { 284 [ planar-configuration ] } + { 285 [ page-name ] } + { 286 [ x-position ] } + { 287 [ y-position ] } { 296 [ lookup-resolution-unit resolution-unit ] } + { 297 [ page-number ] } { 305 [ ascii decode software ] } { 306 [ ascii decode date-time ] } { 317 [ lookup-predictor predictor ] } @@ -286,6 +297,27 @@ ERROR: unhandled-compression compression ; : strips>bitmap ( ifd -- ifd ) dup strips>> concat >>bitmap ; +: (strips-predictor) ( ifd -- ifd ) + [ ] + [ image-width find-tag ] + [ samples-per-pixel find-tag ] tri + [ * ] keep + '[ + _ group [ _ group [ rest ] [ first ] bi + [ v+ ] accumulate swap suffix concat ] map + concat >byte-array + ] change-bitmap ; + +: strips-predictor ( ifd -- ifd ) + dup predictor tag? [ + dup predictor find-tag + { + { predictor-none [ ] } + { predictor-horizontal-differencing [ (strips-predictor) ] } + [ bad-predictor ] + } case + ] when ; + ERROR: unknown-component-order ifd ; : fix-bitmap-endianness ( ifd -- ifd ) @@ -302,7 +334,9 @@ ERROR: unknown-component-order ifd ; : ifd-component-order ( ifd -- byte-order ) bits-per-sample find-tag { + { { 32 32 32 32 } [ R32G32B32A32 ] } { { 32 32 32 } [ R32G32B32 ] } + { { 16 16 16 16 } [ R16G16B16A16 ] } { { 16 16 16 } [ R16G16B16 ] } { { 8 8 8 8 } [ RGBA ] } { { 8 8 8 } [ RGB ] } @@ -329,6 +363,7 @@ ERROR: unknown-component-order ifd ; uncompress-strips strips>bitmap fix-bitmap-endianness + strips-predictor drop ] each ] with-endianness From b638a35fd719447ffceb9b020ec34d182012675d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Feb 2009 00:31:17 -0600 Subject: [PATCH 4/4] move >signed to math.bitwise --- basis/endian/endian.factor | 5 +---- basis/math/bitwise/bitwise.factor | 4 ++++ 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/basis/endian/endian.factor b/basis/endian/endian.factor index a453a71704..4928458543 100755 --- a/basis/endian/endian.factor +++ b/basis/endian/endian.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types namespaces io.binary fry -kernel math grouping sequences ; +kernel math grouping sequences math.bitwise ; IN: endian SINGLETONS: big-endian little-endian ; @@ -9,9 +9,6 @@ SINGLETONS: big-endian little-endian ; : compute-native-endianness ( -- class ) 1 *char 0 = big-endian little-endian ? ; -: >signed ( x n -- y ) - 2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ; - SYMBOL: native-endianness native-endianness [ compute-native-endianness ] initialize diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index e60815bf60..339703c0a6 100755 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -102,3 +102,7 @@ PRIVATE> : signed-be> ( bytes -- x ) signed-le> ; + +: >signed ( x n -- y ) + 2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ; +