read-tga ( -- image )

Vocabulary

images.tga

Inputs

None

Outputs

image

an object

Definition

USING: accessors continuations images io kernel sequences ;

IN: images.tga

:: read-tga ( -- image )
    read-id-length :> id-length read-color-map-type :> map-type
    read-image-type :> image-type read-color-map-first
    :> map-first read-color-map-length :> map-length
    read-color-map-entry-size :> map-entry-size read-x-origin
    :> x-origin read-y-origin :> y-origin read-image-width
    :> image-width read-image-height :> image-height
    read-pixel-depth :> pixel-depth read-image-descriptor
    :> ( alpha-bits pixel-order ) id-length read-image-id
    :> image-id map-type map-length map-entry-size
    read-color-map
    :> color-map-data image-width image-height pixel-depth
    read-image-data :> image-data [
        26 seek-end seek-input
        read-extension-area-offset :> extension-offset
        read-developer-directory-offset :> directory-offset
        read-signature extension-offset 0 = [
            extension-offset seek-absolute seek-input
            read-extension-size read-author-name :> author-name
            read-author-comments :> author-comments
            read-date-timestamp :> date-timestamp read-job-name
            :> job-name read-job-time :> job-time
            read-software-id :> software-id
            read-software-version :> software-version
            read-key-color :> key-color read-pixel-aspect-ratio
            :> aspect-ratio read-gamma-value :> gamma-value
            read-color-correction-offset
            :> color-correction-offset read-postage-stamp-offset
            :> postage-stamp-offset read-scan-line-offset
            :> scan-line-offset read-premultiplied-alpha
            :> premultiplied-alpha color-correction-offset 0 = [
                color-correction-offset seek-absolute seek-input
                read-color-correction-table
                :> color-correction-table
            ] unless postage-stamp-offset 0 = [
                postage-stamp-offset seek-absolute seek-input
                pixel-depth read-postage-stamp-image
                :> postage-data
            ] unless scan-line-offset seek-absolute seek-input
            image-height read-scan-line-table :> scan-offsets
            directory-offset 0 =
            [ f ] [
                directory-offset seek-absolute seek-input
                read-developer-directory read-developer-areas
            ] if :> developer-areas
        ] unless
    ] ignore-errors map-type 0 = [ bad-tga-unsupported ] unless
    image-type 2 = [ bad-tga-unsupported ] unless pixel-depth
    { 24 32 } member? [ bad-tga-unsupported ] unless pixel-order
    { 0 2 } member? [ bad-tga-unsupported ] unless
    image new alpha-bits 0 = [ BGR ] [ BGRA ] if
    >>component-order { image-width image-height } >>dim
    pixel-order 0 = >>upside-down? image-data >>bitmap
    ubyte-components >>component-type ;