diff --git a/basis/images/bitmap/bitmap-tests.factor b/basis/images/bitmap/bitmap-tests.factor index e250d81ae5..d74c69ef1b 100644 --- a/basis/images/bitmap/bitmap-tests.factor +++ b/basis/images/bitmap/bitmap-tests.factor @@ -1,5 +1,5 @@ USING: images.bitmap images.viewer io.encodings.binary -io.files io.files.unique kernel tools.test ; +io.files io.files.unique kernel tools.test images.loader ; IN: images.bitmap.tests : test-bitmap24 ( -- path ) @@ -17,7 +17,7 @@ IN: images.bitmap.tests [ t ] [ test-bitmap24 - [ binary file-contents ] [ load-bitmap ] bi + [ binary file-contents ] [ load-image ] bi "test-bitmap24" unique-file [ save-bitmap ] [ binary file-contents ] bi = diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index 9005776e40..88eb984488 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -6,15 +6,20 @@ kernel macros math math.bitwise math.functions namespaces sequences strings images endian summary ; IN: images.bitmap -TUPLE: bitmap-image < image ; +TUPLE: bitmap-image < image +magic size reserved offset header-length width +height planes bit-count compression size-image +x-pels y-pels color-used color-important rgb-quads color-index ; ! Currently can only handle 24/32bit bitmaps. ! Handles row-reversed bitmaps (their height is negative) -TUPLE: bitmap magic size reserved offset header-length width -height planes bit-count compression size-image -x-pels y-pels color-used color-important rgb-quads color-index -buffer ; +ERROR: bitmap-magic magic ; + +M: bitmap-magic summary + drop "First two bytes of bitmap stream must be 'BM'" ; + +> abs memory>byte-array ; @@ -37,16 +42,11 @@ ERROR: bmp-not-supported n ; { 1 [ bmp-not-supported ] } } case >byte-array ; -ERROR: bitmap-magic ; - -M: bitmap-magic summary - drop "First two bytes of bitmap stream must be 'BM'" ; - : read2 ( -- n ) 2 read le> ; : read4 ( -- n ) 4 read le> ; : parse-file-header ( bitmap -- bitmap ) - 2 read >string dup "BM" = [ bitmap-magic ] unless >>magic + 2 read dup "BM" sequence= [ bitmap-magic ] unless >>magic read4 >>size read4 >>reserved read4 >>offset ; @@ -79,17 +79,13 @@ M: bitmap-magic summary dup rgb-quads-length read >>rgb-quads dup color-index-length read >>color-index ; -: load-bitmap-data ( path -- bitmap ) - binary [ - bitmap new - parse-file-header parse-bitmap-header parse-bitmap +: load-bitmap-data ( path bitmap -- bitmap ) + [ binary ] dip '[ + _ parse-file-header parse-bitmap-header parse-bitmap ] with-file-reader ; : process-bitmap-data ( bitmap -- bitmap ) - dup raw-bitmap>buffer >>buffer ; - -: load-bitmap ( path -- bitmap ) - load-bitmap-data process-bitmap-data ; + dup raw-bitmap>buffer >>bitmap ; ERROR: unknown-component-order bitmap ; @@ -101,15 +97,16 @@ ERROR: unknown-component-order bitmap ; [ unknown-component-order ] } case ; -: >image ( bitmap -- bitmap-image ) - { - [ [ width>> ] [ height>> ] bi 2array ] - [ bitmap>component-order ] - [ buffer>> ] - } cleave bitmap-image boa ; +: fill-image-slots ( bitmap -- bitmap ) + dup { + [ [ width>> ] [ height>> ] bi 2array >>dim ] + [ bitmap>component-order >>component-order ] + [ bitmap>> >>bitmap ] + } cleave ; -M: bitmap-image load-image* ( path bitmap -- bitmap-image ) - drop load-bitmap >image ; +M: bitmap-image load-image* ( path bitmap -- bitmap ) + load-bitmap-data process-bitmap-data + fill-image-slots ; M: bitmap-image normalize-scan-line-order dup dim>> '[ @@ -118,12 +115,12 @@ M: bitmap-image normalize-scan-line-order MACRO: (nbits>bitmap) ( bits -- ) [ -3 shift ] keep '[ - bitmap new + bitmap-image new 2over * _ * >>size-image swap >>height swap >>width - swap array-copy [ >>buffer ] [ >>color-index ] bi - _ >>bit-count >image + swap array-copy [ >>bitmap ] [ >>color-index ] bi + _ >>bit-count fill-image-slots ] ; : bgr>bitmap ( array height width -- bitmap ) @@ -135,11 +132,13 @@ MACRO: (nbits>bitmap) ( bits -- ) : write2 ( n -- ) 2 >le write ; : write4 ( n -- ) 4 >le write ; +PRIVATE> + : save-bitmap ( bitmap path -- ) binary [ B{ CHAR: B CHAR: M } write [ - buffer>> length 14 + 40 + write4 + color-index>> length 14 + 40 + write4 0 write4 54 write4 40 write4 diff --git a/basis/images/images.factor b/basis/images/images.factor index 5ac0da7a28..5282ceeab4 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -68,7 +68,7 @@ GENERIC: load-image* ( path tuple -- image ) [ 3 [ [ 3 head-slice reverse-here ] each ] - [ add-dummy-alpha ] bi + [ [ 255 suffix ] map ] bi concat ] change-bitmap ] } } case @@ -81,4 +81,4 @@ M: image normalize-scan-line-order ; : normalize-image ( image -- image ) [ >byte-array ] change-bitmap normalize-component-order - normalize-scan-line-order ; \ No newline at end of file + normalize-scan-line-order ; diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor index 06e4c686f3..1d4de79f07 100644 --- a/extra/images/viewer/viewer.factor +++ b/extra/images/viewer/viewer.factor @@ -10,7 +10,7 @@ TUPLE: image-gadget < gadget { image image } ; M: image-gadget pref-dim* image>> dim>> ; -: draw-image ( tiff -- ) +: draw-image ( image -- ) 0 0 glRasterPos2i 1.0 -1.0 glPixelZoom [ dim>> first2 GL_RGBA GL_UNSIGNED_BYTE ] [ bitmap>> ] bi glDrawPixels ;