]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/images/gif/gif.factor
factor: trim using lists
[factor.git] / extra / images / gif / gif.factor
index 8d4b118d161f8796ce19df621947e846372a83f6..079efdbb5c4ac43065151666625c4d593a7d3f1e 100644 (file)
@@ -1,13 +1,12 @@
 ! Copyrigt (C) 2009 Doug Coleman, Keith Lazuka
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators compression.lzw
-constructors destructors grouping images images.loader io
-io.binary io.buffers io.encodings.string io.encodings.utf8
-kernel make math math.bitwise namespaces sequences ;
+USING: accessors arrays combinators compression.lzw constructors
+endian grouping images images.loader io io.encodings.string
+io.encodings.utf8 kernel make math math.bitwise sequences ;
 IN: images.gif
 
 SINGLETON: gif-image
-"gif" gif-image register-image-class
+"gif" gif-image ?register-image-class
 
 TUPLE: loading-gif
 loading?
@@ -53,18 +52,18 @@ TUPLE: comment-extension
 introducer label comment-data ;
 
 TUPLE: trailer byte ;
-CONSTRUCTOR: trailer ( byte -- obj ) ;
+CONSTRUCTOR: <trailer> trailer ( byte -- obj ) ;
 
-CONSTANT: image-descriptor HEX: 2c
+CONSTANT: IMAGE-DESCRIPTOR 0x2c
 ! Extensions
-CONSTANT: extension-identifier HEX: 21
-CONSTANT: plain-text-extension HEX: 01
-CONSTANT: graphic-control-extension HEX: f9
-CONSTANT: comment-extension HEX: fe
-CONSTANT: application-extension HEX: ff
-CONSTANT: trailer HEX: 3b
-CONSTANT: graphic-control-extension-block-size HEX: 04
-CONSTANT: block-terminator HEX: 00
+CONSTANT: EXTENSION-IDENTIFIER 0x21
+CONSTANT: PLAIN-TEXT-EXTENSION 0x01
+CONSTANT: GRAPHICS-CONTROL-EXTENSION 0xf9
+CONSTANT: COMMENT-EXTENSION 0xfe
+CONSTANT: APPLICATION-EXTENSION 0xff
+CONSTANT: TRAILER 0x3b
+CONSTANT: GRAPHIC-CONTROL-EXTENSION-BLOCK-SIZE 0x04
+CONSTANT: BLOCK-TERMINATOR 0x00
 
 : <loading-gif> ( -- loading-gif )
     \ loading-gif new
@@ -91,11 +90,11 @@ CONSTANT: block-terminator HEX: 00
 
 : read-graphic-control-extension ( -- graphic-control-extension )
     \ graphics-control-extension new
-        1 read le> graphic-control-extension-block-size assert=
+        1 read le> GRAPHIC-CONTROL-EXTENSION-BLOCK-SIZE assert=
         1 read le> >>flags
         2 read le> >>delay-time
         1 read le> >>transparent-color-index
-        1 read le> block-terminator assert= ;
+        1 read le> BLOCK-TERMINATOR assert= ;
 
 : read-plain-text-extension ( -- plain-text-extension )
     \ plain-text-extension new
@@ -113,7 +112,7 @@ CONSTANT: block-terminator HEX: 00
 : read-comment-extension ( -- comment-extension )
     \ comment-extension new
         read-sub-blocks >>comment-data ;
-    
+
 : read-application-extension ( -- read-application-extension )
    \ application-extension new
        1 read le> >>block-size
@@ -168,18 +167,18 @@ ERROR: unimplemented message ;
 
 : read-extension ( loading-gif -- loading-gif )
     read1 {
-        { plain-text-extension [
+        { PLAIN-TEXT-EXTENSION [
             read-plain-text-extension over plain-text-extensions>> push
         ] }
 
-        { graphic-control-extension [
+        { GRAPHICS-CONTROL-EXTENSION [
             read-graphic-control-extension
             over graphic-control-extensions>> push
         ] }
-        { comment-extension [
+        { COMMENT-EXTENSION [
             read-comment-extension over comment-extensions>> push
         ] }
-        { application-extension [
+        { APPLICATION-EXTENSION [
             read-application-extension over application-extensions>> push
         ] }
         { f [ gif-unexpected-eof ] }
@@ -190,13 +189,13 @@ ERROR: unhandled-data byte ;
 
 : read-data ( loading-gif -- loading-gif )
     read1 {
-        { extension-identifier [ read-extension ] }
-        { graphic-control-extension [
+        { EXTENSION-IDENTIFIER [ read-extension ] }
+        { GRAPHICS-CONTROL-EXTENSION [
             read-graphic-control-extension
             over graphic-control-extensions>> push
         ] }
-        { image-descriptor [ read-table-based-image ] }
-        { trailer [ f >>loading? ] }
+        { IMAGE-DESCRIPTOR [ read-table-based-image ] }
+        { TRAILER [ f >>loading? ] }
         [ unhandled-data ]
     } case ;
 
@@ -248,5 +247,5 @@ ERROR: loading-gif-error gif-image ;
 : ensure-loaded ( gif-image -- gif-image )
     dup loading?>> [ loading-gif-error ] when ;
 
-M: gif-image stream>image ( path gif-image -- image )
+M: gif-image stream>image* ( path gif-image -- image )
     drop load-gif ensure-loaded gif>image ;