-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 ;
+