From 94baa7d7fa084ffed47aa1e2240b268c9e6ef8f7 Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Wed, 8 Apr 2009 18:12:27 -0500 Subject: [PATCH 1/3] Call ScriptStringOut with ETO_OPAQUE --- basis/windows/uniscribe/uniscribe.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor index 7cfda41dc9..f6cacfb683 100755 --- a/basis/windows/uniscribe/uniscribe.factor +++ b/basis/windows/uniscribe/uniscribe.factor @@ -59,10 +59,10 @@ TUPLE: script-string font string metrics ssa size image disposed ; ssa>> ! ssa 0 ! iX 0 ! iY - 0 ! uOptions - f ! prc + ETO_OPAQUE ! uOptions ] - [ selection-start/end ] bi + [ [ { 0 0 } ] dip size>> ] + [ selection-start/end ] tri ! iMinSel ! iMaxSel FALSE ! fDisabled @@ -108,7 +108,7 @@ M: script-string dispose* SYMBOL: cached-script-strings -: cached-script-string ( string font -- script-string ) +: cached-script-string ( font string -- script-string ) cached-script-strings get-global [ ] 2cache ; [ cached-script-strings set-global ] From 49852f57153cd24e23912d8b4efd7c00a4e86f3a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Apr 2009 18:42:01 -0500 Subject: [PATCH 2/3] fix saving bitmaps --- basis/images/bitmap/bitmap-tests.factor | 28 +++++++++++- basis/images/bitmap/bitmap.factor | 60 +++++++++++++++---------- 2 files changed, 62 insertions(+), 26 deletions(-) diff --git a/basis/images/bitmap/bitmap-tests.factor b/basis/images/bitmap/bitmap-tests.factor index e154df26a1..c7012cfd42 100644 --- a/basis/images/bitmap/bitmap-tests.factor +++ b/basis/images/bitmap/bitmap-tests.factor @@ -1,6 +1,6 @@ USING: images.bitmap images.viewer io.encodings.binary io.files io.files.unique kernel tools.test images.loader -literals sequences ; +literals sequences checksums.md5 checksums ; IN: images.bitmap.tests CONSTANT: test-bitmap24 "vocab:images/test-images/thiswayup24.bmp" @@ -11,6 +11,11 @@ CONSTANT: test-bitmap4 "vocab:images/test-images/rgb4bit.bmp" CONSTANT: test-bitmap1 "vocab:images/test-images/1bit.bmp" +CONSTANT: test-40 "vocab:images/test-images/40red24bit.bmp" +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 @@ -24,4 +29,23 @@ CONSTANT: test-bitmap1 "vocab:images/test-images/1bit.bmp" $ test-bitmap8 $ test-bitmap24 "vocab:ui/render/test/reference.bmp" -} [ [ ] swap [ load-image drop ] curry unit-test ] each \ No newline at end of file +} [ [ ] swap [ load-image drop ] curry unit-test ] each + + +: test-bitmap-save ( path -- ? ) + [ md5 checksum-file ] + [ load-image ] bi + "bitmap-save-test" unique-file + [ save-bitmap ] + [ md5 checksum-file ] bi = ; + +[ + t +] [ + { + $ test-40 + $ test-41 + $ test-42 + $ test-43 + } [ test-bitmap-save ] all? +] unit-test diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index 8209159a8e..48095bb26b 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -37,14 +37,14 @@ M: bitmap-magic summary ERROR: bmp-not-supported n ; : reverse-lines ( byte-array width -- byte-array ) - 3 * concat ; inline + concat ; inline : raw-bitmap>seq ( loading-bitmap -- array ) dup bit-count>> { { 32 [ color-index>> ] } - { 24 [ [ color-index>> ] [ width>> ] bi reverse-lines ] } - { 8 [ [ 8bit>buffer ] [ width>> ] bi reverse-lines ] } + { 24 [ [ color-index>> ] [ width>> 3 * ] bi reverse-lines ] } + { 8 [ [ 8bit>buffer ] [ width>> 3 * ] bi reverse-lines ] } [ bmp-not-supported ] } case >byte-array ; @@ -81,30 +81,31 @@ ERROR: bmp-not-supported n ; : image-size ( loading-bitmap -- n ) [ [ width>> ] [ height>> ] bi * ] [ bit-count>> 8 /i ] bi * abs ; +: bitmap-padding ( width -- n ) + 3 * 4 mod 4 swap - 4 mod ; inline + :: fixup-color-index ( loading-bitmap -- loading-bitmap ) loading-bitmap width>> :> width width 3 * :> width*3 - loading-bitmap height>> abs :> height - loading-bitmap color-index>> length :> color-index-length - color-index-length height /i :> stride - color-index-length width*3 height * - height /i :> padding + loading-bitmap width>> bitmap-padding :> padding + loading-bitmap [ color-index>> length ] [ height>> abs ] bi /i :> stride + loading-bitmap padding 0 > [ - loading-bitmap [ + [ stride [ width*3 head-slice ] map concat ] change-color-index - ] [ - loading-bitmap - ] if ; + ] when ; : parse-bitmap ( loading-bitmap -- loading-bitmap ) dup rgb-quads-length read >>rgb-quads dup color-index-length read >>color-index fixup-color-index ; -: load-bitmap-data ( path loading-bitmap -- loading-bitmap ) - [ binary ] dip '[ - _ parse-file-header parse-bitmap-header parse-bitmap +: load-bitmap-data ( path -- loading-bitmap ) + binary [ + loading-bitmap new + parse-file-header parse-bitmap-header parse-bitmap ] with-file-reader ; ERROR: unknown-component-order bitmap ; @@ -117,8 +118,7 @@ ERROR: unknown-component-order bitmap ; [ unknown-component-order ] } case ; -: loading-bitmap>bitmap-image ( loading-bitmap -- bitmap-image ) - [ bitmap-image new ] dip +: loading-bitmap>bitmap-image ( bitmap-image loading-bitmap -- bitmap-image ) { [ raw-bitmap>seq >>bitmap ] [ [ width>> ] [ height>> abs ] bi 2array >>dim ] @@ -127,20 +127,30 @@ ERROR: unknown-component-order bitmap ; } cleave ; M: bitmap-image load-image* ( path loading-bitmap -- bitmap ) - drop loading-bitmap new - load-bitmap-data - loading-bitmap>bitmap-image ; + swap load-bitmap-data loading-bitmap>bitmap-image ; PRIVATE> -: bitmap>color-index ( bitmap-array -- byte-array ) - 4 [ 3 head-slice ] map B{ } join ; inline +: bitmap>color-index ( bitmap -- byte-array ) + [ + bitmap>> + 4 + [ 3 head-slice ] map + B{ } join + ] [ + dim>> first dup bitmap-padding dup 0 > [ + [ 3 * group ] dip '[ _ append ] map + B{ } join + ] [ + 2drop + ] if + ] bi ; : save-bitmap ( image path -- ) binary [ B{ CHAR: B CHAR: M } write [ - bitmap>> bitmap>color-index length 14 + 40 + write4 + bitmap>color-index length 14 + 40 + write4 0 write4 54 write4 40 write4 @@ -159,7 +169,7 @@ PRIVATE> [ drop 0 write4 ] ! size-image - [ bitmap>> bitmap>color-index length write4 ] + [ bitmap>color-index length write4 ] ! x-pels [ drop 0 write4 ] @@ -175,7 +185,9 @@ PRIVATE> ! rgb-quads [ - [ bitmap>> bitmap>color-index ] [ dim>> first ] bi + [ bitmap>color-index ] + [ dim>> first 3 * ] + [ dim>> first bitmap-padding + ] tri reverse-lines write ] } cleave From 07cf80f0a8b1c1c105e4a7eb89263bfb3fb48e4b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Apr 2009 18:42:26 -0500 Subject: [PATCH 3/3] fix stack effect for unique-file --- basis/io/files/unique/unique-docs.factor | 2 +- basis/io/files/unique/unique.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/files/unique/unique-docs.factor b/basis/io/files/unique/unique-docs.factor index 74fc045032..6a7be47813 100644 --- a/basis/io/files/unique/unique-docs.factor +++ b/basis/io/files/unique/unique-docs.factor @@ -62,8 +62,8 @@ HELP: current-temporary-directory HELP: unique-file { $values + { "prefix" string } { "path" "a pathname string" } - { "path'" "a pathname string" } } { $description "Creates a temporary file in the directory stored in " { $link current-temporary-directory } " and outputs the path name." } ; diff --git a/basis/io/files/unique/unique.factor b/basis/io/files/unique/unique.factor index 7bd96aa63b..0e4338e3e0 100644 --- a/basis/io/files/unique/unique.factor +++ b/basis/io/files/unique/unique.factor @@ -64,7 +64,7 @@ PRIVATE> [ unique-directory ] dip '[ _ with-temporary-directory ] [ delete-tree ] bi ; inline -: unique-file ( path -- path' ) +: unique-file ( prefix -- path ) "" make-unique-file ; {