]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'png' of git://github.com/klazuka/factor
authorDoug Coleman <doug.coleman@gmail.com>
Mon, 28 Sep 2009 19:29:00 +0000 (14:29 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Mon, 28 Sep 2009 19:29:00 +0000 (14:29 -0500)
1  2 
basis/images/png/png.factor

index 88ec97aadf9d1fc90ac696f6a021902e094e4f8b,f090fe0adf173e6f0b0bdf718f25ef81985916eb..5746a9098b2070a88635f30a65ae3fa1bf93558a
@@@ -99,11 -99,11 +99,11 @@@ ERROR: unimplemented-color-type image 
      a b + c - { a b c } [ [ - abs ] keep 2array ] with map 
      sort-keys first second ;
  
 -:: png-unfilter-line ( prev curr filter -- curr' )
 +:: png-unfilter-line ( width prev curr filter -- curr' )
      prev :> c
 -    prev 3 tail-slice :> b
 +    prev width tail-slice :> b
      curr :> a
 -    curr 3 tail-slice :> x
 +    curr width tail-slice :> x
      x length [0,b)
      filter {
          { filter-none [ drop ] }
          { filter-average [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
          { filter-paeth [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
      } case 
 -    curr 3 tail ;
 +    curr width tail ;
  
 -: reverse-png-filter ( lines -- byte-array )
 -    dup first length 0 <array> prefix
 -    [ { 0 0 } prepend ] map
 +:: reverse-png-filter ( n lines -- byte-array )
 +    lines dup first length 0 <array> prefix
 +    [ n 1 - 0 <array> prepend ] map
      2 clump [
 -        first2 dup [ third ] [ [ 0 2 ] dip set-nth ] bi
 +        n swap first2 [ ] [ n 1 - swap nth ] [ [ 0 n 1 - ] dip set-nth ] tri
          png-unfilter-line
      ] map B{ } concat-as ;
  
  : png-image-bytes ( loading-png -- byte-array )
 -    [ inflate-data ] [ png-group-width ] bi group reverse-png-filter ;
 +    [ png-bytes-per-pixel ] [ inflate-data ] [ png-group-width ] tri group reverse-png-filter ;
  
- : decode-greyscale ( loading-png -- loading-png )
+ : decode-greyscale ( loading-png -- image )
      unimplemented-color-type ;
  
- : decode-truecolor ( loading-png -- loading-png )
+ : decode-truecolor ( loading-png -- image )
      [ <image> ] dip {
          [ png-image-bytes >>bitmap ]
          [ [ width>> ] [ height>> ] bi 2array >>dim ]
          [ drop RGB >>component-order ubyte-components >>component-type ]
      } cleave ;
      
- : decode-indexed-color ( loading-png -- loading-png )
+ : decode-indexed-color ( loading-png -- image )
      unimplemented-color-type ;
  
- : decode-greyscale-alpha ( loading-png -- loading-png )
+ : decode-greyscale-alpha ( loading-png -- image )
      unimplemented-color-type ;
  
- : decode-truecolor-alpha ( loading-png -- loading-png )
+ : decode-truecolor-alpha ( loading-png -- image )
      [ <image> ] dip {
          [ png-image-bytes >>bitmap ]
          [ [ width>> ] [ height>> ] bi 2array >>dim ]
@@@ -169,7 -169,7 +169,7 @@@ ERROR: invalid-color-type/bit-depth loa
  : validate-truecolor-alpha ( loading-png -- loading-png )
      { 8 16 } validate-bit-depth ;
  
- : decode-png ( loading-png -- loading-png ) 
+ : png>image ( loading-png -- image )
      dup color-type>> {
          { greyscale [ validate-greyscale decode-greyscale ] }
          { truecolor [ validate-truecolor decode-truecolor ] }
          [ unknown-color-type ]
      } case ;
  
- M: png-image stream>image
-     drop [
+ : load-png ( stream -- loading-png )
+     [
          <loading-png>
          read-png-header
          read-png-chunks
          parse-ihdr-chunk
-         decode-png
      ] with-input-stream ;
+ M: png-image stream>image
+     drop load-png png>image ;