Merge branch 'master' of git://factorcode.org/git/factor
commit
8f99661f9a
|
@ -342,8 +342,8 @@ M: v-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' )
|
||||||
|
|
||||||
ERROR: unsupported-bitmap-file magic ;
|
ERROR: unsupported-bitmap-file magic ;
|
||||||
|
|
||||||
: load-bitmap ( path -- loading-bitmap )
|
: load-bitmap ( stream -- loading-bitmap )
|
||||||
binary stream-throws <limited-file-reader> [
|
[
|
||||||
\ loading-bitmap new
|
\ loading-bitmap new
|
||||||
parse-file-header [ >>file-header ] [ ] bi magic>> {
|
parse-file-header [ >>file-header ] [ ] bi magic>> {
|
||||||
{ "BM" [
|
{ "BM" [
|
||||||
|
@ -363,7 +363,7 @@ ERROR: unsupported-bitmap-file magic ;
|
||||||
: loading-bitmap>bytes ( loading-bitmap -- byte-array )
|
: loading-bitmap>bytes ( loading-bitmap -- byte-array )
|
||||||
uncompress-bitmap bitmap>bytes ;
|
uncompress-bitmap bitmap>bytes ;
|
||||||
|
|
||||||
M: bitmap-image load-image* ( path bitmap-image -- bitmap )
|
M: bitmap-image stream>image ( stream bitmap-image -- bitmap )
|
||||||
drop load-bitmap
|
drop load-bitmap
|
||||||
[ image new ] dip
|
[ image new ] dip
|
||||||
{
|
{
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Doug Coleman
|
|
@ -0,0 +1,7 @@
|
||||||
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: http.client images.loader images.loader.private kernel ;
|
||||||
|
IN: images.http
|
||||||
|
|
||||||
|
: load-http-image ( path -- image )
|
||||||
|
[ http-get nip ] [ image-class new ] bi load-image* ;
|
|
@ -68,8 +68,6 @@ TUPLE: image dim component-order component-type upside-down? bitmap ;
|
||||||
|
|
||||||
: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
|
: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
|
||||||
|
|
||||||
GENERIC: load-image* ( path class -- image )
|
|
||||||
|
|
||||||
: bytes-per-component ( component-type -- n )
|
: bytes-per-component ( component-type -- n )
|
||||||
{
|
{
|
||||||
{ ubyte-components [ 1 ] }
|
{ ubyte-components [ 1 ] }
|
||||||
|
|
|
@ -6,7 +6,7 @@ images.processing io io.binary io.encodings.binary io.files
|
||||||
io.streams.byte-array kernel locals math math.bitwise
|
io.streams.byte-array kernel locals math math.bitwise
|
||||||
math.constants math.functions math.matrices math.order
|
math.constants math.functions math.matrices math.order
|
||||||
math.ranges math.vectors memoize multiline namespaces
|
math.ranges math.vectors memoize multiline namespaces
|
||||||
sequences sequences.deep ;
|
sequences sequences.deep images.loader ;
|
||||||
IN: images.jpeg
|
IN: images.jpeg
|
||||||
|
|
||||||
QUALIFIED-WITH: bitstreams bs
|
QUALIFIED-WITH: bitstreams bs
|
||||||
|
@ -19,6 +19,9 @@ TUPLE: jpeg-image < image
|
||||||
{ huff-tables initial: { f f f f } }
|
{ huff-tables initial: { f f f f } }
|
||||||
{ components } ;
|
{ components } ;
|
||||||
|
|
||||||
|
"jpg" jpeg-image register-image-class
|
||||||
|
"jpeg" jpeg-image register-image-class
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: <jpeg-image> ( headers bitstream -- image )
|
: <jpeg-image> ( headers bitstream -- image )
|
||||||
|
@ -353,17 +356,13 @@ ERROR: not-a-jpeg-image ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: load-jpeg ( path -- image )
|
M: jpeg-image stream>image ( stream jpeg-image -- bitmap )
|
||||||
binary [
|
drop [
|
||||||
parse-marker { SOI } = [ not-a-jpeg-image ] unless
|
parse-marker { SOI } = [ not-a-jpeg-image ] unless
|
||||||
parse-headers
|
parse-headers
|
||||||
contents <jpeg-image>
|
contents <jpeg-image>
|
||||||
] with-file-reader
|
] with-input-stream
|
||||||
dup jpeg-image [
|
dup jpeg-image [
|
||||||
baseline-parse
|
baseline-parse
|
||||||
baseline-decompress
|
baseline-decompress
|
||||||
] with-variable ;
|
] with-variable ;
|
||||||
|
|
||||||
M: jpeg-image load-image* ( path jpeg-image -- bitmap )
|
|
||||||
drop load-jpeg ;
|
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,9 @@
|
||||||
! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
|
! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel splitting unicode.case combinators accessors images
|
USING: accessors assocs byte-arrays combinators images
|
||||||
io.pathnames namespaces assocs ;
|
io.encodings.binary io.pathnames io.streams.byte-array
|
||||||
|
io.streams.limited kernel namespaces splitting strings
|
||||||
|
unicode.case ;
|
||||||
IN: images.loader
|
IN: images.loader
|
||||||
|
|
||||||
ERROR: unknown-image-extension extension ;
|
ERROR: unknown-image-extension extension ;
|
||||||
|
@ -15,10 +17,26 @@ types [ H{ } clone ] initialize
|
||||||
file-extension >lower types get ?at
|
file-extension >lower types get ?at
|
||||||
[ unknown-image-extension ] unless ;
|
[ unknown-image-extension ] unless ;
|
||||||
|
|
||||||
|
: open-image-file ( path -- stream )
|
||||||
|
binary stream-throws <limited-file-reader> ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
GENERIC# load-image* 1 ( obj class -- image )
|
||||||
|
|
||||||
|
GENERIC: stream>image ( stream class -- image )
|
||||||
|
|
||||||
: register-image-class ( extension class -- )
|
: register-image-class ( extension class -- )
|
||||||
swap types get set-at ;
|
swap types get set-at ;
|
||||||
|
|
||||||
: load-image ( path -- image )
|
: load-image ( path -- image )
|
||||||
dup image-class load-image* ;
|
[ open-image-file ] [ image-class ] bi load-image* ;
|
||||||
|
|
||||||
|
M: byte-array load-image*
|
||||||
|
[ binary <byte-reader> ] dip stream>image ;
|
||||||
|
|
||||||
|
M: limited-stream load-image* stream>image ;
|
||||||
|
|
||||||
|
M: string load-image* [ open-image-file ] dip stream>image ;
|
||||||
|
|
||||||
|
M: pathname load-image* [ open-image-file ] dip stream>image ;
|
||||||
|
|
|
@ -111,14 +111,11 @@ ERROR: unimplemented-color-type image ;
|
||||||
[ unknown-color-type ]
|
[ unknown-color-type ]
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
: load-png ( path -- image )
|
M: png-image stream>image
|
||||||
binary stream-throws <limited-file-reader> [
|
drop [
|
||||||
<loading-png>
|
<loading-png>
|
||||||
read-png-header
|
read-png-header
|
||||||
read-png-chunks
|
read-png-chunks
|
||||||
parse-ihdr-chunk
|
parse-ihdr-chunk
|
||||||
decode-png
|
decode-png
|
||||||
] with-input-stream ;
|
] with-input-stream ;
|
||||||
|
|
||||||
M: png-image load-image*
|
|
||||||
drop load-png ;
|
|
||||||
|
|
|
@ -517,14 +517,14 @@ ERROR: unknown-component-order ifd ;
|
||||||
: with-tiff-endianness ( loading-tiff quot -- )
|
: with-tiff-endianness ( loading-tiff quot -- )
|
||||||
[ dup endianness>> ] dip with-endianness ; inline
|
[ dup endianness>> ] dip with-endianness ; inline
|
||||||
|
|
||||||
: load-tiff-ifds ( path -- loading-tiff )
|
: load-tiff-ifds ( stream -- loading-tiff )
|
||||||
binary [
|
[
|
||||||
<loading-tiff>
|
<loading-tiff>
|
||||||
read-header [
|
read-header [
|
||||||
dup ifd-offset>> read-ifds
|
dup ifd-offset>> read-ifds
|
||||||
process-ifds
|
process-ifds
|
||||||
] with-tiff-endianness
|
] with-tiff-endianness
|
||||||
] with-file-reader ;
|
] with-input-stream* ;
|
||||||
|
|
||||||
: process-chunky-ifd ( ifd -- )
|
: process-chunky-ifd ( ifd -- )
|
||||||
read-strips
|
read-strips
|
||||||
|
@ -555,13 +555,18 @@ ERROR: unknown-component-order ifd ;
|
||||||
ifds>> [ process-ifd ] each ;
|
ifds>> [ process-ifd ] each ;
|
||||||
|
|
||||||
: load-tiff ( path -- loading-tiff )
|
: load-tiff ( path -- loading-tiff )
|
||||||
[ load-tiff-ifds dup ] keep
|
[ load-tiff-ifds dup ]
|
||||||
binary [
|
[
|
||||||
|
[ [ 0 seek-absolute ] dip stream-seek ]
|
||||||
|
[
|
||||||
|
[
|
||||||
[ process-tif-ifds ] with-tiff-endianness
|
[ process-tif-ifds ] with-tiff-endianness
|
||||||
] with-file-reader ;
|
] with-input-stream
|
||||||
|
] bi
|
||||||
|
] bi ;
|
||||||
|
|
||||||
! tiff files can store several images -- we just take the first for now
|
! tiff files can store several images -- we just take the first for now
|
||||||
M: tiff-image load-image* ( path tiff-image -- image )
|
M: tiff-image stream>image ( stream tiff-image -- image )
|
||||||
drop load-tiff tiff>image ;
|
drop load-tiff tiff>image ;
|
||||||
|
|
||||||
{ "tif" "tiff" } [ tiff-image register-image-class ] each
|
{ "tif" "tiff" } [ tiff-image register-image-class ] each
|
||||||
|
|
|
@ -98,5 +98,8 @@ PRIVATE>
|
||||||
M: limited-stream stream-read-until
|
M: limited-stream stream-read-until
|
||||||
swap BV{ } clone (read-until) [ 2nip B{ } like ] dip ;
|
swap BV{ } clone (read-until) [ 2nip B{ } like ] dip ;
|
||||||
|
|
||||||
|
M: limited-stream stream-seek
|
||||||
|
stream>> stream-seek ;
|
||||||
|
|
||||||
M: limited-stream dispose
|
M: limited-stream dispose
|
||||||
stream>> dispose ;
|
stream>> dispose ;
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: assocs html.parser kernel math sequences strings ascii
|
USING: assocs html.parser kernel math sequences strings ascii
|
||||||
arrays generalizations shuffle namespaces make
|
arrays generalizations shuffle namespaces make
|
||||||
splitting http accessors io combinators http.client urls
|
splitting http accessors io combinators http.client urls
|
||||||
urls.encoding fry prettyprint sets ;
|
urls.encoding fry prettyprint sets combinators.short-circuit ;
|
||||||
IN: html.parser.analyzer
|
IN: html.parser.analyzer
|
||||||
|
|
||||||
TUPLE: link attributes clickable ;
|
TUPLE: link attributes clickable ;
|
||||||
|
@ -103,6 +103,15 @@ TUPLE: link attributes clickable ;
|
||||||
[ [ name>> "a" = ] [ attributes>> "href" swap at ] bi and ]
|
[ [ name>> "a" = ] [ attributes>> "href" swap at ] bi and ]
|
||||||
find-between-all ;
|
find-between-all ;
|
||||||
|
|
||||||
|
: find-images ( vector -- vector' )
|
||||||
|
[
|
||||||
|
{
|
||||||
|
[ name>> "img" = ]
|
||||||
|
[ attributes>> "src" swap at ]
|
||||||
|
} 1&&
|
||||||
|
] find-all
|
||||||
|
values [ attributes>> "src" swap at ] map ;
|
||||||
|
|
||||||
: <link> ( vector -- link )
|
: <link> ( vector -- link )
|
||||||
[ first attributes>> ]
|
[ first attributes>> ]
|
||||||
[ [ name>> { text "img" } member? ] filter ] bi
|
[ [ name>> { text "img" } member? ] filter ] bi
|
||||||
|
|
Loading…
Reference in New Issue