remove the grpahics vocab
Doug Coleman
parent
a1e45570f5
commit
4ff9557351
|
|
@ -1 +0,0 @@
|
||||||
Doug Coleman
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Doug Coleman
|
|
||||||
|
|
@ -1,30 +0,0 @@
|
||||||
USING: graphics.bitmap graphics.viewer io.encodings.binary
|
|
||||||
io.files io.files.unique kernel tools.test ;
|
|
||||||
IN: graphics.bitmap.tests
|
|
||||||
|
|
||||||
: test-bitmap32-alpha ( -- path )
|
|
||||||
"resource:extra/graphics/bitmap/test-images/32alpha.bmp" ;
|
|
||||||
|
|
||||||
: test-bitmap24 ( -- path )
|
|
||||||
"resource:extra/graphics/bitmap/test-images/thiswayup24.bmp" ;
|
|
||||||
|
|
||||||
: test-bitmap16 ( -- path )
|
|
||||||
"resource:extra/graphics/bitmap/test-images/rgb16bit.bmp" ;
|
|
||||||
|
|
||||||
: test-bitmap8 ( -- path )
|
|
||||||
"resource:extra/graphics/bitmap/test-images/rgb8bit.bmp" ;
|
|
||||||
|
|
||||||
: test-bitmap4 ( -- path )
|
|
||||||
"resource:extra/graphics/bitmap/test-images/rgb4bit.bmp" ;
|
|
||||||
|
|
||||||
: test-bitmap1 ( -- path )
|
|
||||||
"resource:extra/graphics/bitmap/test-images/1bit.bmp" ;
|
|
||||||
|
|
||||||
[ t ]
|
|
||||||
[
|
|
||||||
test-bitmap24
|
|
||||||
[ binary file-contents ] [ load-bitmap ] bi
|
|
||||||
|
|
||||||
"test-bitmap24" unique-file
|
|
||||||
[ save-bitmap ] [ binary file-contents ] bi =
|
|
||||||
] unit-test
|
|
||||||
|
|
@ -1,139 +0,0 @@
|
||||||
! Copyright (C) 2007, 2009 Doug Coleman.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: accessors alien alien.c-types arrays byte-arrays columns
|
|
||||||
combinators fry grouping io io.binary io.encodings.binary
|
|
||||||
io.files kernel libc macros math math.bitwise math.functions
|
|
||||||
namespaces opengl opengl.gl prettyprint sequences strings
|
|
||||||
summary ui ui.gadgets.panes ;
|
|
||||||
IN: graphics.bitmap
|
|
||||||
|
|
||||||
! 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
|
|
||||||
alpha-channel-zero?
|
|
||||||
array ;
|
|
||||||
|
|
||||||
: array-copy ( bitmap array -- bitmap array' )
|
|
||||||
over size-image>> abs memory>byte-array ;
|
|
||||||
|
|
||||||
MACRO: (nbits>bitmap) ( bits -- )
|
|
||||||
[ -3 shift ] keep '[
|
|
||||||
bitmap new
|
|
||||||
2over * _ * >>size-image
|
|
||||||
swap >>height
|
|
||||||
swap >>width
|
|
||||||
swap array-copy [ >>array ] [ >>color-index ] bi
|
|
||||||
_ >>bit-count
|
|
||||||
] ;
|
|
||||||
|
|
||||||
: bgr>bitmap ( array height width -- bitmap )
|
|
||||||
24 (nbits>bitmap) ;
|
|
||||||
|
|
||||||
: bgra>bitmap ( array height width -- bitmap )
|
|
||||||
32 (nbits>bitmap) ;
|
|
||||||
|
|
||||||
: 8bit>array ( bitmap -- array )
|
|
||||||
[ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
|
|
||||||
[ color-index>> >array ] bi [ swap nth ] with map concat ;
|
|
||||||
|
|
||||||
ERROR: bmp-not-supported n ;
|
|
||||||
|
|
||||||
: raw-bitmap>array ( bitmap -- array )
|
|
||||||
dup bit-count>>
|
|
||||||
{
|
|
||||||
{ 32 [ color-index>> ] }
|
|
||||||
{ 24 [ color-index>> ] }
|
|
||||||
{ 16 [ bmp-not-supported ] }
|
|
||||||
{ 8 [ 8bit>array ] }
|
|
||||||
{ 4 [ bmp-not-supported ] }
|
|
||||||
{ 2 [ bmp-not-supported ] }
|
|
||||||
{ 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
|
|
||||||
read4 >>size
|
|
||||||
read4 >>reserved
|
|
||||||
read4 >>offset ;
|
|
||||||
|
|
||||||
: parse-bitmap-header ( bitmap -- bitmap )
|
|
||||||
read4 >>header-length
|
|
||||||
read4 >>width
|
|
||||||
read4 >>height
|
|
||||||
read2 >>planes
|
|
||||||
read2 >>bit-count
|
|
||||||
read4 >>compression
|
|
||||||
read4 >>size-image
|
|
||||||
read4 >>x-pels
|
|
||||||
read4 >>y-pels
|
|
||||||
read4 >>color-used
|
|
||||||
read4 >>color-important ;
|
|
||||||
|
|
||||||
: rgb-quads-length ( bitmap -- n )
|
|
||||||
[ offset>> 14 - ] [ header-length>> ] bi - ;
|
|
||||||
|
|
||||||
: color-index-length ( bitmap -- n )
|
|
||||||
{
|
|
||||||
[ width>> ]
|
|
||||||
[ planes>> * ]
|
|
||||||
[ bit-count>> * 31 + 32 /i 4 * ]
|
|
||||||
[ height>> abs * ]
|
|
||||||
} cleave ;
|
|
||||||
|
|
||||||
: parse-bitmap ( bitmap -- bitmap )
|
|
||||||
dup rgb-quads-length read >>rgb-quads
|
|
||||||
dup color-index-length read >>color-index ;
|
|
||||||
|
|
||||||
: (load-bitmap) ( path -- bitmap )
|
|
||||||
binary [
|
|
||||||
bitmap new
|
|
||||||
parse-file-header parse-bitmap-header parse-bitmap
|
|
||||||
] with-file-reader ;
|
|
||||||
|
|
||||||
: alpha-channel-zero? ( bitmap -- ? )
|
|
||||||
array>> 4 <sliced-groups> 3 <column> [ 0 = ] all? ;
|
|
||||||
|
|
||||||
: load-bitmap ( path -- bitmap )
|
|
||||||
(load-bitmap)
|
|
||||||
dup raw-bitmap>array >>array
|
|
||||||
dup alpha-channel-zero? >>alpha-channel-zero? ;
|
|
||||||
|
|
||||||
: write2 ( n -- ) 2 >le write ;
|
|
||||||
: write4 ( n -- ) 4 >le write ;
|
|
||||||
|
|
||||||
: save-bitmap ( bitmap path -- )
|
|
||||||
binary [
|
|
||||||
B{ CHAR: B CHAR: M } write
|
|
||||||
[
|
|
||||||
array>> length 14 + 40 + write4
|
|
||||||
0 write4
|
|
||||||
54 write4
|
|
||||||
40 write4
|
|
||||||
] [
|
|
||||||
{
|
|
||||||
[ width>> write4 ]
|
|
||||||
[ height>> write4 ]
|
|
||||||
[ planes>> 1 or write2 ]
|
|
||||||
[ bit-count>> 24 or write2 ]
|
|
||||||
[ compression>> 0 or write4 ]
|
|
||||||
[ size-image>> write4 ]
|
|
||||||
[ x-pels>> 0 or write4 ]
|
|
||||||
[ y-pels>> 0 or write4 ]
|
|
||||||
[ color-used>> 0 or write4 ]
|
|
||||||
[ color-important>> 0 or write4 ]
|
|
||||||
[ rgb-quads>> write ]
|
|
||||||
[ color-index>> write ]
|
|
||||||
} cleave
|
|
||||||
] bi
|
|
||||||
] with-file-writer ;
|
|
||||||
Binary file not shown.
|
Before Width: | Height: | Size: 1.6 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 5.2 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 11 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 59 KiB |
|
|
@ -1 +0,0 @@
|
||||||
bitmap graphics
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Doug Coleman
|
|
||||||
Binary file not shown.
|
|
@ -1,11 +0,0 @@
|
||||||
! Copyright (C) 2009 Doug Coleman.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: tools.test graphics.tiff ;
|
|
||||||
IN: graphics.tiff.tests
|
|
||||||
|
|
||||||
: tiff-test-path ( -- path )
|
|
||||||
"resource:extra/graphics/tiff/rgb.tiff" ;
|
|
||||||
|
|
||||||
: tiff-test-path2 ( -- path )
|
|
||||||
"resource:extra/graphics/tiff/octagon.tiff" ;
|
|
||||||
|
|
||||||
|
|
@ -1,271 +0,0 @@
|
||||||
! Copyright (C) 2009 Doug Coleman.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: accessors combinators io io.encodings.binary io.files
|
|
||||||
kernel pack endian tools.hexdump constructors sequences arrays
|
|
||||||
sorting.slots math.order math.parser prettyprint classes
|
|
||||||
io.binary assocs math math.bitwise byte-arrays grouping ;
|
|
||||||
IN: graphics.tiff
|
|
||||||
|
|
||||||
TUPLE: tiff endianness the-answer ifd-offset ifds ;
|
|
||||||
|
|
||||||
CONSTRUCTOR: tiff ( -- tiff )
|
|
||||||
V{ } clone >>ifds ;
|
|
||||||
|
|
||||||
TUPLE: ifd count ifd-entries next
|
|
||||||
processed-tags strips buffer ;
|
|
||||||
CONSTRUCTOR: ifd ( count ifd-entries next -- ifd ) ;
|
|
||||||
|
|
||||||
TUPLE: ifd-entry tag type count offset/value ;
|
|
||||||
CONSTRUCTOR: ifd-entry ( tag type count offset/value -- ifd-entry ) ;
|
|
||||||
|
|
||||||
SINGLETONS: photometric-interpretation
|
|
||||||
photometric-interpretation-white-is-zero
|
|
||||||
photometric-interpretation-black-is-zero
|
|
||||||
photometric-interpretation-rgb
|
|
||||||
photometric-interpretation-palette-color ;
|
|
||||||
ERROR: bad-photometric-interpretation n ;
|
|
||||||
: lookup-photometric-interpretation ( n -- singleton )
|
|
||||||
{
|
|
||||||
{ 0 [ photometric-interpretation-white-is-zero ] }
|
|
||||||
{ 1 [ photometric-interpretation-black-is-zero ] }
|
|
||||||
{ 2 [ photometric-interpretation-rgb ] }
|
|
||||||
{ 3 [ photometric-interpretation-palette-color ] }
|
|
||||||
[ bad-photometric-interpretation ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
SINGLETONS: compression
|
|
||||||
compression-none
|
|
||||||
compression-CCITT-2
|
|
||||||
compression-lzw
|
|
||||||
compression-pack-bits ;
|
|
||||||
ERROR: bad-compression n ;
|
|
||||||
: lookup-compression ( n -- compression )
|
|
||||||
{
|
|
||||||
{ 1 [ compression-none ] }
|
|
||||||
{ 2 [ compression-CCITT-2 ] }
|
|
||||||
{ 5 [ compression-lzw ] }
|
|
||||||
{ 32773 [ compression-pack-bits ] }
|
|
||||||
[ bad-compression ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
SINGLETONS: resolution-unit
|
|
||||||
resolution-unit-none
|
|
||||||
resolution-unit-inch
|
|
||||||
resolution-unit-centimeter ;
|
|
||||||
ERROR: bad-resolution-unit n ;
|
|
||||||
: lookup-resolution-unit ( n -- object )
|
|
||||||
{
|
|
||||||
{ 1 [ resolution-unit-none ] }
|
|
||||||
{ 2 [ resolution-unit-inch ] }
|
|
||||||
{ 3 [ resolution-unit-centimeter ] }
|
|
||||||
[ bad-resolution-unit ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
SINGLETONS: predictor
|
|
||||||
predictor-none
|
|
||||||
predictor-horizontal-differencing ;
|
|
||||||
ERROR: bad-predictor n ;
|
|
||||||
: lookup-predictor ( n -- object )
|
|
||||||
{
|
|
||||||
{ 1 [ predictor-none ] }
|
|
||||||
{ 2 [ predictor-horizontal-differencing ] }
|
|
||||||
[ bad-predictor ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
SINGLETONS: planar-configuration
|
|
||||||
planar-configuration-chunky
|
|
||||||
planar-configuration-planar ;
|
|
||||||
ERROR: bad-planar-configuration n ;
|
|
||||||
: lookup-planar-configuration ( n -- object )
|
|
||||||
{
|
|
||||||
{ 1 [ planar-configuration-chunky ] }
|
|
||||||
{ 2 [ planar-configuration-planar ] }
|
|
||||||
[ bad-planar-configuration ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
ERROR: bad-sample-format n ;
|
|
||||||
SINGLETONS: sample-format
|
|
||||||
sample-format-unsigned-integer
|
|
||||||
sample-format-signed-integer
|
|
||||||
sample-format-ieee-float
|
|
||||||
sample-format-undefined-data ;
|
|
||||||
: lookup-sample-format ( seq -- object )
|
|
||||||
[
|
|
||||||
{
|
|
||||||
{ 1 [ sample-format-unsigned-integer ] }
|
|
||||||
{ 2 [ sample-format-signed-integer ] }
|
|
||||||
{ 3 [ sample-format-ieee-float ] }
|
|
||||||
{ 4 [ sample-format-undefined-data ] }
|
|
||||||
[ bad-sample-format ]
|
|
||||||
} case
|
|
||||||
] map ;
|
|
||||||
|
|
||||||
ERROR: bad-extra-samples n ;
|
|
||||||
SINGLETONS: extra-samples
|
|
||||||
extra-samples-unspecified-alpha-data
|
|
||||||
extra-samples-associated-alpha-data
|
|
||||||
extra-samples-unassociated-alpha-data ;
|
|
||||||
: lookup-extra-samples ( seq -- object )
|
|
||||||
{
|
|
||||||
{ 0 [ extra-samples-unspecified-alpha-data ] }
|
|
||||||
{ 1 [ extra-samples-associated-alpha-data ] }
|
|
||||||
{ 2 [ extra-samples-unassociated-alpha-data ] }
|
|
||||||
[ bad-extra-samples ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
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
|
|
||||||
unhandled-ifd-entry ;
|
|
||||||
|
|
||||||
ERROR: bad-tiff-magic bytes ;
|
|
||||||
: tiff-endianness ( byte-array -- ? )
|
|
||||||
{
|
|
||||||
{ B{ CHAR: M CHAR: M } [ big-endian ] }
|
|
||||||
{ B{ CHAR: I CHAR: I } [ little-endian ] }
|
|
||||||
[ bad-tiff-magic ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
: read-header ( tiff -- tiff )
|
|
||||||
2 read tiff-endianness [ >>endianness ] keep
|
|
||||||
[
|
|
||||||
2 read endian> >>the-answer
|
|
||||||
4 read endian> >>ifd-offset
|
|
||||||
] with-endianness ;
|
|
||||||
|
|
||||||
: push-ifd ( tiff ifd -- tiff ) over ifds>> push ;
|
|
||||||
|
|
||||||
: read-ifd ( -- ifd )
|
|
||||||
2 read endian>
|
|
||||||
2 read endian>
|
|
||||||
4 read endian>
|
|
||||||
4 read endian> <ifd-entry> ;
|
|
||||||
|
|
||||||
: read-ifds ( tiff -- tiff )
|
|
||||||
dup ifd-offset>> seek-absolute seek-input
|
|
||||||
2 read endian>
|
|
||||||
dup [ read-ifd ] replicate
|
|
||||||
4 read endian>
|
|
||||||
[ <ifd> push-ifd ] [ 0 = [ read-ifds ] unless ] bi ;
|
|
||||||
|
|
||||||
ERROR: no-tag class ;
|
|
||||||
|
|
||||||
: ?at ( key assoc -- value/key ? )
|
|
||||||
dupd at* [ nip t ] [ drop f ] if ; inline
|
|
||||||
|
|
||||||
: find-tag ( idf class -- tag )
|
|
||||||
swap processed-tags>> ?at [ no-tag ] unless ;
|
|
||||||
|
|
||||||
: read-strips ( ifd -- ifd )
|
|
||||||
dup
|
|
||||||
[ strip-byte-counts find-tag ]
|
|
||||||
[ strip-offsets find-tag ] bi
|
|
||||||
2dup [ integer? ] both? [
|
|
||||||
seek-absolute seek-input read 1array
|
|
||||||
] [
|
|
||||||
[ seek-absolute seek-input read ] { } 2map-as
|
|
||||||
] if >>strips ;
|
|
||||||
|
|
||||||
ERROR: unknown-ifd-type n ;
|
|
||||||
|
|
||||||
: bytes>bits ( n/byte-array -- n )
|
|
||||||
dup byte-array? [ byte-array>bignum ] when ;
|
|
||||||
|
|
||||||
: value-length ( ifd-entry -- n )
|
|
||||||
[ count>> ] [ type>> ] bi {
|
|
||||||
{ 1 [ ] }
|
|
||||||
{ 2 [ ] }
|
|
||||||
{ 3 [ 2 * ] }
|
|
||||||
{ 4 [ 4 * ] }
|
|
||||||
{ 5 [ 8 * ] }
|
|
||||||
{ 6 [ ] }
|
|
||||||
{ 7 [ ] }
|
|
||||||
{ 8 [ 2 * ] }
|
|
||||||
{ 9 [ 4 * ] }
|
|
||||||
{ 10 [ 8 * ] }
|
|
||||||
{ 11 [ 4 * ] }
|
|
||||||
{ 12 [ 8 * ] }
|
|
||||||
[ unknown-ifd-type ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
ERROR: bad-small-ifd-type n ;
|
|
||||||
|
|
||||||
: adjust-offset/value ( ifd-entry -- obj )
|
|
||||||
[ offset/value>> 4 >endian ] [ type>> ] bi
|
|
||||||
{
|
|
||||||
{ 1 [ 1 head endian> ] }
|
|
||||||
{ 3 [ 2 head endian> ] }
|
|
||||||
{ 4 [ endian> ] }
|
|
||||||
{ 6 [ 1 head endian> 8 >signed ] }
|
|
||||||
{ 8 [ 2 head endian> 16 >signed ] }
|
|
||||||
{ 9 [ endian> 32 >signed ] }
|
|
||||||
{ 11 [ endian> bits>float ] }
|
|
||||||
[ bad-small-ifd-type ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
: offset-bytes>obj ( bytes type -- obj )
|
|
||||||
{
|
|
||||||
{ 1 [ ] } ! blank
|
|
||||||
{ 2 [ ] } ! read c strings here
|
|
||||||
{ 3 [ 2 <sliced-groups> [ endian> ] map ] }
|
|
||||||
{ 4 [ 4 <sliced-groups> [ endian> ] map ] }
|
|
||||||
{ 5 [ 8 <sliced-groups> [ "II" unpack first2 / ] map ] }
|
|
||||||
{ 6 [ [ 8 >signed ] map ] }
|
|
||||||
{ 7 [ ] } ! blank
|
|
||||||
{ 8 [ 2 <sliced-groups> [ endian> 16 >signed ] map ] }
|
|
||||||
{ 9 [ 4 <sliced-groups> [ endian> 32 >signed ] map ] }
|
|
||||||
{ 10 [ 8 group [ "ii" unpack first2 / ] map ] }
|
|
||||||
{ 11 [ 4 group [ "f" unpack ] map ] }
|
|
||||||
{ 12 [ 8 group [ "d" unpack ] map ] }
|
|
||||||
[ unknown-ifd-type ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
: ifd-entry-value ( ifd-entry -- n )
|
|
||||||
dup value-length 4 <= [
|
|
||||||
adjust-offset/value
|
|
||||||
] [
|
|
||||||
[ offset/value>> seek-absolute seek-input ]
|
|
||||||
[ value-length read ]
|
|
||||||
[ type>> ] tri offset-bytes>obj
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
: process-ifd-entry ( ifd-entry -- value class )
|
|
||||||
[ ifd-entry-value ] [ tag>> ] bi {
|
|
||||||
{ 254 [ new-subfile-type ] }
|
|
||||||
{ 256 [ image-width ] }
|
|
||||||
{ 257 [ image-length ] }
|
|
||||||
{ 258 [ bits-per-sample ] }
|
|
||||||
{ 259 [ lookup-compression compression ] }
|
|
||||||
{ 262 [ lookup-photometric-interpretation photometric-interpretation ] }
|
|
||||||
{ 273 [ strip-offsets ] }
|
|
||||||
{ 274 [ orientation ] }
|
|
||||||
{ 277 [ samples-per-pixel ] }
|
|
||||||
{ 278 [ rows-per-strip ] }
|
|
||||||
{ 279 [ strip-byte-counts ] }
|
|
||||||
{ 282 [ x-resolution ] }
|
|
||||||
{ 283 [ y-resolution ] }
|
|
||||||
{ 284 [ planar-configuration ] }
|
|
||||||
{ 296 [ lookup-resolution-unit resolution-unit ] }
|
|
||||||
{ 317 [ lookup-predictor predictor ] }
|
|
||||||
{ 338 [ lookup-extra-samples extra-samples ] }
|
|
||||||
{ 339 [ lookup-sample-format sample-format ] }
|
|
||||||
[ nip unhandled-ifd-entry ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
: process-ifd ( ifd -- ifd )
|
|
||||||
dup ifd-entries>>
|
|
||||||
[ process-ifd-entry swap ] H{ } map>assoc >>processed-tags ;
|
|
||||||
|
|
||||||
: strips>buffer ( ifd -- ifd )
|
|
||||||
dup strips>> concat >>buffer ;
|
|
||||||
|
|
||||||
: (load-tiff) ( path -- tiff )
|
|
||||||
binary [
|
|
||||||
<tiff>
|
|
||||||
read-header dup endianness>> [
|
|
||||||
read-ifds
|
|
||||||
dup ifds>> [ process-ifd read-strips strips>buffer drop ] each
|
|
||||||
] with-endianness
|
|
||||||
] with-file-reader ;
|
|
||||||
|
|
||||||
: load-tiff ( path -- tiff ) (load-tiff) ;
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Doug Coleman
|
|
||||||
|
|
@ -1,66 +0,0 @@
|
||||||
! Copyright (C) 2007 Doug Coleman.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: accessors arrays combinators graphics.bitmap kernel math
|
|
||||||
math.functions namespaces opengl opengl.gl ui ui.gadgets
|
|
||||||
ui.gadgets.panes ui.render graphics.tiff sequences ;
|
|
||||||
IN: graphics.viewer
|
|
||||||
|
|
||||||
TUPLE: graphics-gadget < gadget image ;
|
|
||||||
|
|
||||||
GENERIC: draw-image ( image -- )
|
|
||||||
GENERIC: width ( image -- w )
|
|
||||||
GENERIC: height ( image -- h )
|
|
||||||
|
|
||||||
M: graphics-gadget pref-dim*
|
|
||||||
image>> [ width ] keep height abs 2array ;
|
|
||||||
|
|
||||||
M: graphics-gadget draw-gadget* ( gadget -- )
|
|
||||||
origin get [ image>> draw-image ] with-translation ;
|
|
||||||
|
|
||||||
: <graphics-gadget> ( bitmap -- gadget )
|
|
||||||
\ graphics-gadget new-gadget
|
|
||||||
swap >>image ;
|
|
||||||
|
|
||||||
: bits>gl-params ( n -- gl-bgr gl-format )
|
|
||||||
{
|
|
||||||
{ 32 [ GL_BGRA GL_UNSIGNED_BYTE ] }
|
|
||||||
{ 24 [ GL_BGR GL_UNSIGNED_BYTE ] }
|
|
||||||
{ 8 [ GL_BGR GL_UNSIGNED_BYTE ] }
|
|
||||||
{ 4 [ GL_BGR GL_UNSIGNED_BYTE ] }
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
M: bitmap draw-image ( bitmap -- )
|
|
||||||
dup height>> 0 < [
|
|
||||||
0 0 glRasterPos2i
|
|
||||||
1.0 -1.0 glPixelZoom
|
|
||||||
] [
|
|
||||||
0 over height>> abs glRasterPos2i
|
|
||||||
1.0 1.0 glPixelZoom
|
|
||||||
] if
|
|
||||||
[ width>> ] keep
|
|
||||||
[
|
|
||||||
[ height>> abs ] keep
|
|
||||||
bit-count>> bits>gl-params
|
|
||||||
] keep array>> glDrawPixels ;
|
|
||||||
|
|
||||||
M: bitmap width ( bitmap -- ) width>> ;
|
|
||||||
M: bitmap height ( bitmap -- ) height>> ;
|
|
||||||
|
|
||||||
: bitmap. ( path -- )
|
|
||||||
load-bitmap <graphics-gadget> gadget. ;
|
|
||||||
|
|
||||||
: bitmap-window ( path -- gadget )
|
|
||||||
load-bitmap <graphics-gadget> [ "bitmap" open-window ] keep ;
|
|
||||||
|
|
||||||
M: tiff width ( tiff -- ) ifds>> first image-width find-tag ;
|
|
||||||
M: tiff height ( tiff -- ) ifds>> first image-length find-tag ;
|
|
||||||
|
|
||||||
M: tiff draw-image ( tiff -- )
|
|
||||||
[ 0 0 glRasterPos2i 1.0 -1.0 glPixelZoom ] dip
|
|
||||||
ifds>> first
|
|
||||||
{
|
|
||||||
[ image-width find-tag ]
|
|
||||||
[ image-length find-tag ]
|
|
||||||
[ bits-per-sample find-tag sum bits>gl-params ]
|
|
||||||
[ buffer>> ]
|
|
||||||
} cleave glDrawPixels ;
|
|
||||||
Loading…
Reference in New Issue