you have to parse the .ico file yourself and update individual RT_ICON and RT_GROUP_ICON resources. lame

db4
Joe Groff 2010-02-15 14:04:11 -08:00
parent f06e278e17
commit 4ebfd1ef3a
2 changed files with 74 additions and 10 deletions

View File

@ -0,0 +1,72 @@
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 ;

12
basis/tools/deploy/windows/windows.factor Normal file → Executable file
View File

@ -5,7 +5,7 @@ io.encodings.ascii kernel namespaces
sequences locals system splitting tools.deploy.backend sequences locals system splitting tools.deploy.backend
tools.deploy.config tools.deploy.config.editor assocs hashtables tools.deploy.config tools.deploy.config.editor assocs hashtables
prettyprint combinators windows.kernel32 windows.shell32 windows.user32 prettyprint combinators windows.kernel32 windows.shell32 windows.user32
alien.c-types vocabs.metadata vocabs.loader ; alien.c-types vocabs.metadata vocabs.loader tools.deploy.windows.ico ;
IN: tools.deploy.windows IN: tools.deploy.windows
CONSTANT: app-icon-resource-id "APPICON" CONSTANT: app-icon-resource-id "APPICON"
@ -22,17 +22,9 @@ CONSTANT: app-icon-resource-id "APPICON"
dup copy-dll dup copy-dll
deploy-ui? get ".exe" ".com" ? copy-vm ; deploy-ui? get ".exe" ".com" ? copy-vm ;
:: (embed-ico) ( vm ico-bytes -- )
vm 0 BeginUpdateResource :> hUpdate
hUpdate [
hUpdate RT_ICON app-icon-resource-id 0 ico-bytes dup byte-length
UpdateResource drop
hUpdate 0 EndUpdateResource drop
] when ;
: embed-ico ( vm vocab -- ) : embed-ico ( vm vocab -- )
dup vocab-windows-icon-path vocab-append-path dup exists? dup vocab-windows-icon-path vocab-append-path dup exists?
[ binary file-contents (embed-ico) ] [ binary file-contents app-icon-resource-id embed-icon-resource ]
[ 2drop ] if ; [ 2drop ] if ;
M: winnt deploy* M: winnt deploy*