Merge to upstream

[factor.git] / basis / tools / deploy / windows / ico / ico.factor

diff --git a/basis/tools/deploy/windows/ico/ico.factor b/basis/tools/deploy/windows/ico/ico.factor
index 8ea7af348dca653238579b71458cbae01da06c52..46610c487db4c2ed4f68f44ffd882882a151e60b 100755 (executable)
--- a/basis/tools/deploy/windows/ico/ico.factor
+++ b/basis/tools/deploy/windows/ico/ico.factor
@@ -1,72 +1,72 @@
-USING: accessors alien alien.c-types arrays classes.struct combinators\r
-io.backend kernel locals math sequences specialized-arrays\r
-tools.deploy.windows windows.kernel32 windows.types ;\r
-IN: tools.deploy.windows.ico\r
-\r
-<PRIVATE\r
-\r
-STRUCT: ico-header\r
-    { Reserved WORD }\r
-    { Type WORD }\r
-    { ImageCount WORD } ;\r
-\r
-STRUCT: ico-directory-entry\r
-    { Width        BYTE  }\r
-    { Height       BYTE  }\r
-    { Colors       BYTE  }\r
-    { Reserved     BYTE  }\r
-    { Planes       WORD  }\r
-    { BitsPerPixel WORD  }\r
-    { ImageSize    DWORD }\r
-    { ImageOffset  DWORD } ;\r
-SPECIALIZED-ARRAY: ico-directory-entry\r
-\r
-STRUCT: group-directory-entry\r
-    { Width        BYTE  }\r
-    { Height       BYTE  }\r
-    { Colors       BYTE  }\r
-    { Reserved     BYTE  }\r
-    { Planes       WORD  }\r
-    { BitsPerPixel WORD  }\r
-    { ImageSize    DWORD }\r
-    { ImageResourceID WORD } ;\r
-\r
-: ico>group-directory-entry ( ico i -- group )\r
-    [ {\r
-        [ Width>> ] [ Height>> ] [ Colors>> ] [ Reserved>> ]\r
-        [ Planes>> ] [ BitsPerPixel>> ] [ ImageSize>> ]\r
-    } cleave ] [ 1 + ] bi* group-directory-entry <struct-boa> >c-ptr ; inline\r
-\r
-: ico-icon ( directory-entry bytes -- subbytes )\r
-    [ [ ImageOffset>> dup ] [ ImageSize>> + ] bi ] dip subseq ; inline\r
-\r
-:: ico-group-and-icons ( bytes -- group-bytes icon-bytes )\r
-    bytes ico-header memory>struct :> header\r
-\r
-    ico-header heap-size bytes <displaced-alien> \r
-    header ImageCount>> <direct-ico-directory-entry-array> :> directory\r
-\r
-    directory dup length iota [ ico>group-directory-entry ] { } 2map-as\r
-        :> group-directory\r
-    directory [ bytes ico-icon ] { } map-as :> icon-bytes\r
-\r
-    header clone >c-ptr group-directory concat append\r
-    icon-bytes ; inline\r
-\r
-PRIVATE>\r
-\r
-:: embed-icon-resource ( exe ico-bytes id -- )\r
-    exe normalize-path 1 BeginUpdateResource :> hUpdate\r
-    hUpdate [\r
-        ico-bytes ico-group-and-icons :> ( group icons )\r
-        hUpdate RT_GROUP_ICON id 0 group dup byte-length\r
-        UpdateResource drop\r
-\r
-        icons [| icon i |\r
-            hUpdate RT_ICON i 1 + MAKEINTRESOURCE 0 icon dup byte-length\r
-            UpdateResource drop\r
-        ] each-index\r
-\r
-        hUpdate 0 EndUpdateResource drop\r
-    ] when ;\r
-\r
+USING: accessors alien alien.c-types arrays classes.struct combinators
+io.backend kernel locals math sequences specialized-arrays
+tools.deploy.windows windows.kernel32 windows.types ;
+IN: tools.deploy.windows.ico
+
+<PRIVATE
+
+STRUCT: ico-header
+    { Reserved WORD }
+    { Type WORD }
+    { ImageCount WORD } ;
+
+STRUCT: ico-directory-entry
+    { Width        BYTE  }
+    { Height       BYTE  }
+    { Colors       BYTE  }
+    { Reserved     BYTE  }
+    { Planes       WORD  }
+    { BitsPerPixel WORD  }
+    { ImageSize    DWORD }
+    { ImageOffset  DWORD } ;
+SPECIALIZED-ARRAY: ico-directory-entry
+
+STRUCT: group-directory-entry
+    { Width        BYTE  }
+    { Height       BYTE  }
+    { Colors       BYTE  }
+    { Reserved     BYTE  }
+    { Planes       WORD  }
+    { BitsPerPixel WORD  }
+    { ImageSize    DWORD }
+    { ImageResourceID WORD } ;
+
+: ico>group-directory-entry ( ico i -- group )
+    [ {
+        [ Width>> ] [ Height>> ] [ Colors>> ] [ Reserved>> ]
+        [ Planes>> ] [ BitsPerPixel>> ] [ ImageSize>> ]
+    } cleave ] [ 1 + ] bi* group-directory-entry <struct-boa> >c-ptr ; inline
+
+: ico-icon ( directory-entry bytes -- subbytes )
+    [ [ ImageOffset>> dup ] [ ImageSize>> + ] bi ] dip subseq ; inline
+
+:: ico-group-and-icons ( bytes -- group-bytes icon-bytes )
+    bytes ico-header memory>struct :> header
+
+    ico-header heap-size bytes <displaced-alien> 
+    header ImageCount>> <direct-ico-directory-entry-array> :> directory
+
+    directory dup length iota [ ico>group-directory-entry ] { } 2map-as
+        :> group-directory
+    directory [ bytes ico-icon ] { } map-as :> icon-bytes
+
+    header clone >c-ptr group-directory concat append
+    icon-bytes ; inline
+
+PRIVATE>
+
+:: embed-icon-resource ( exe ico-bytes id -- )
+    exe normalize-path 1 BeginUpdateResource :> hUpdate
+    hUpdate [
+        ico-bytes ico-group-and-icons :> ( group icons )
+        hUpdate RT_GROUP_ICON id 0 group dup byte-length
+        UpdateResource drop
+
+        icons [| icon i |
+            hUpdate RT_ICON i 1 + MAKEINTRESOURCE 0 icon dup byte-length
+            UpdateResource drop
+        ] each-index
+
+        hUpdate 0 EndUpdateResource drop
+    ] when ;
+