1(*
2    Copyright (c) 2001, 2015
3        David C.J. Matthews
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License version 2.1 as published by the Free Software Foundation.
8
9    This library is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12    Lesser General Public License for more details.
13
14    You should have received a copy of the GNU Lesser General Public
15    License along with this library; if not, write to the Free Software
16    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17*)
18
19structure Resource :
20  sig
21    datatype ResourceType =
22        RT_CURSOR | RT_BITMAP | RT_ICON | RT_MENU | RT_DIALOG | RT_STRING | RT_FONTDIR |
23        RT_FONT | RT_ACCELERATOR | RT_RCDATA | RT_MESSAGETABLE | RT_GROUP_CURSOR |
24        RT_GROUP_ICON | RT_VERSION | RT_DLGINCLUDE | RT_ANICURSOR | RT_ANIICON |
25        RT_PLUGPLAY | RT_VXD
26
27    type HRSRC
28    type HRSRCGLOBAL
29    type HINSTANCE
30
31    datatype RESID = IdAsInt of int | IdAsString of string
32    val MAKEINTRESOURCE : int -> RESID
33
34    type HUPDATE
35
36    val BeginUpdateResource : string * bool -> HUPDATE
37    val EndUpdateResource : HUPDATE * bool -> unit
38    val FindResource : HINSTANCE * RESID * ResourceType -> HRSRC
39    val FindResourceEx : HINSTANCE * ResourceType * RESID * Locale.LANGID -> HRSRC
40    val FreeLibrary : HINSTANCE -> unit
41    val LoadLibrary : string -> HINSTANCE
42    val LoadResource : HINSTANCE * HRSRC -> HRSRCGLOBAL
43    val LoadString : HINSTANCE * RESID -> string
44    val LockResource : HRSRCGLOBAL -> Word8Vector.vector
45    val SizeofResource : HINSTANCE * HRSRC -> int
46    val UpdateResource :
47       HUPDATE * ResourceType * RESID * Locale.LANGID * Word8Vector.vector option -> unit
48  end
49 =
50struct
51    open Foreign
52    open Base
53
54    datatype RESID = datatype RESID
55
56    fun MAKEINTRESOURCE i =
57        if i >= 0 andalso i < 65536 then IdAsInt i
58        else raise Fail "resource id out of range"
59
60    fun checkHandle h = (checkResult(not(isHNull h)); h)
61
62    datatype ResourceType =
63        RT_CURSOR | RT_BITMAP | RT_ICON | RT_MENU | RT_DIALOG | RT_STRING | RT_FONTDIR |
64        RT_FONT | RT_ACCELERATOR | RT_RCDATA | RT_MESSAGETABLE | RT_GROUP_CURSOR |
65        RT_GROUP_ICON | RT_VERSION | RT_DLGINCLUDE | RT_ANICURSOR | RT_ANIICON |
66        RT_PLUGPLAY | RT_VXD
67
68    local
69
70        fun toRes 1 = RT_CURSOR | toRes 2 = RT_BITMAP | toRes 3 = RT_ICON | toRes 4 = RT_MENU
71         |  toRes 5 = RT_DIALOG | toRes 6 = RT_STRING | toRes 7 = RT_FONTDIR | toRes 8 = RT_FONT
72         |  toRes 9 = RT_ACCELERATOR | toRes 10 = RT_RCDATA | toRes 11 = RT_MESSAGETABLE
73         |  toRes 12 = RT_GROUP_CURSOR | toRes 14 = RT_GROUP_ICON | toRes 16 = RT_VERSION
74         |  toRes 17 = RT_DLGINCLUDE | toRes 19 = RT_PLUGPLAY | toRes 20 = RT_VXD
75         |  toRes 21 = RT_ANICURSOR |  toRes 22 = RT_ANIICON
76         |  toRes _ = raise Fail "Unknown Resource Type"
77
78        fun fromRes RT_CURSOR = 1 | fromRes RT_BITMAP = 2 | fromRes RT_ICON = 3
79         |  fromRes RT_MENU = 4 | fromRes RT_DIALOG = 5 | fromRes RT_STRING = 6
80         |  fromRes RT_FONTDIR = 7 | fromRes RT_FONT = 8 | fromRes RT_ACCELERATOR = 9
81         |  fromRes RT_RCDATA = 10 | fromRes RT_MESSAGETABLE = 11 | fromRes RT_GROUP_CURSOR = 12
82         |  fromRes RT_GROUP_ICON = 14 | fromRes RT_VERSION = 16 | fromRes RT_DLGINCLUDE = 17
83         |  fromRes RT_PLUGPLAY = 19 | fromRes RT_VXD = 20 | fromRes RT_ANICURSOR = 21
84         |  fromRes RT_ANIICON = 22
85    in
86        val RESOURCETYPE =
87            absConversion {abs = toRes, rep = fromRes} cInt
88    end
89
90    local
91        datatype HRSRCGLOBAL = HRSRCGLOBAL of Memory.voidStar * int
92    in
93        type HRSRCGLOBAL = HRSRCGLOBAL
94
95        val LoadLibrary = checkHandle o winCall1 (kernel "LoadLibraryA") (cString) cHINSTANCE
96        and FreeLibrary = winCall1 (kernel "FreeLibrary") (cHINSTANCE) (successState "FreeLibrary")
97        and FindResource = checkHandle o
98            winCall3 (kernel "FindResourceA")
99                (cHINSTANCE, cRESID, RESOURCETYPE) cHRSRC
100        and SizeofResource = winCall2 (kernel "SizeofResource") (cHINSTANCE, cHRSRC) cDWORD
101        (* The name and type are in the reverse order in FindResource and FindResourceEx *)
102        and FindResourceEx = checkHandle o
103             winCall4 (kernel "FindResourceExA")
104                (cHINSTANCE, RESOURCETYPE, cRESID, LocaleBase.LANGID) cHRSRC
105
106        (* LoadResource - load a resource into memory and get a handle to it. *)
107        local
108            val loadResource = winCall2 (kernel  "LoadResource") (cHINSTANCE, cHRSRC)
109            and lockResource = winCall1 (kernel "LockResource") (cPointer) cPointer
110            and loadString = winCall4 (user "LoadStringA") (cHINSTANCE, cRESID, cPointer, cInt) cInt
111        in
112            fun LoadResource (hInst, hRsrc) =
113            let
114                val size = SizeofResource (hInst, hRsrc)
115                val load = loadResource cPointer
116                val rsrc = load(hInst, hRsrc)
117            in
118                HRSRCGLOBAL(rsrc, size)
119            end
120
121            (* LockResource - get the resource as a piece of binary store. *)
122            fun LockResource (HRSRCGLOBAL(hg, size)) =
123            let
124                val res = lockResource hg
125            in
126                Word8Vector.tabulate(size, fn i => Memory.get8(res, Word.fromInt i))
127            end
128
129            fun LoadString (hInst, resId): string =
130            let
131                (* The underlying call returns the number of bytes copied EXCLUDING the terminating null. *)
132                (* The easiest way to make sure we have enough store is to loop. *)
133                open Memory
134                fun tryLoad n =
135                let
136                    val store = malloc n
137                    val used = Word.fromInt(loadString(hInst, resId, store, Word.toInt n))
138                in
139                    (* We can't distinguish the empty string from a missing resource. *)
140                    if used = 0w0 then ""
141                    else if used < n-0w1
142                    then fromCstring store before free store
143                    else (free store; tryLoad(n*0w2))
144                end
145            in
146                tryLoad 0w100
147            end
148        end
149
150        val BeginUpdateResource =
151            (fn c => (checkResult(not(isHNull c)); c)) o
152            winCall2 (user "BeginUpdateResourceA") (cString, cBool) cHUPDATE
153
154        val EndUpdateResource =
155            winCall2 (user "EndUpdateResource") (cHUPDATE, cBool) (successState "EndUpdateResource")
156
157        local
158            val updateResource =
159                winCall6 (user "UpdateResource")
160                    (cHUPDATE, RESOURCETYPE, cRESID, LocaleBase.LANGID, cOptionPtr cByteArray, cInt)
161                    (successState "UpdateResource")
162        in
163            (* NONE here means delete the resource, SOME means a value to store.  *)
164            (* N.B. If updating a string the new value must be in Unicode. *)
165            fun UpdateResource(hup, rt, resid, lang, v as SOME vec) =
166                updateResource(hup, rt, resid, lang, v, Word8Vector.length vec)
167            |   UpdateResource(hup, rt, resid, lang, NONE) =
168                updateResource(hup, rt, resid, lang, NONE, 0)
169        end
170    end
171end;
172