Paste: tga

! Copyright (C) 2010 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license.
USING: accessors images images.loader io io.binary kernel
locals math sequences ;
IN: images.tga

SINGLETON: tga-image
"tga" tga-image register-image-class

ERROR: bad-tga-header ;

:: read-tga ( -- image )
    1 read le> :> id-length
    1 read le> 0 = [ bad-tga-header ] unless
    1 read le> { 2 } member? [ bad-tga-header ] unless
    9 read drop
    2 read le> :> width
    2 read le> :> height
    1 read le> dup { 24 32 } member? [ bad-tga-header ] unless :> bpp
    1 read le> :> descriptor
    id-length read drop
    width height * bpp 8 align 8 / * read :> data

    image new                                  
    descriptor 7 bitand 0 = [ RGB ] [ ARGB ] if >>component-order
    RGB >>component-order
    { width height } >>dim
    descriptor 24 bitand -3 shift { 0 1 } member? >>upside-down?
    data >>bitmap
    ubyte-components >>component-type ;
    
M: tga-image stream>image
    drop [ read-tga ] with-input-stream ;