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 DeviceBase = 20struct 21 local 22 open Foreign Base 23 in 24 (* Paper sizes. *) 25 (* Colours. Retain the American spelling for compatibility. *) 26 datatype DMColor = DMCOLOR_MONOCHROME | DMCOLOR_COLOR 27 local 28 val tab = [ 29 (DMCOLOR_MONOCHROME, 1), 30 (DMCOLOR_COLOR, 2)] 31 in 32 val (fromDMC, toDMC) = tableLookup(tab, NONE) 33 end 34 35 (* Default source. *) 36 datatype DMSource = DMBIN_UPPER | DMBIN_ONLYONE | DMBIN_LOWER | DMBIN_MIDDLE | DMBIN_MANUAL | 37 DMBIN_ENVELOPE | DMBIN_ENVMANUAL | DMBIN_AUTO | DMBIN_TRACTOR | 38 DMBIN_SMALLFMT | DMBIN_LARGEFMT | DMBIN_LARGECAPACITY | DMBIN_CASSETTE | 39 DMBIN_FORMSOURCE | DMSOURCE_OTHER of int 40 local 41 val tab = [ 42 (DMBIN_ONLYONE, 1), 43 (DMBIN_UPPER, 1), 44 (DMBIN_LOWER, 2), 45 (DMBIN_MIDDLE, 3), 46 (DMBIN_MANUAL, 4), 47 (DMBIN_ENVELOPE, 5), 48 (DMBIN_ENVMANUAL, 6), 49 (DMBIN_AUTO, 7), 50 (DMBIN_TRACTOR, 8), 51 (DMBIN_SMALLFMT, 9), 52 (DMBIN_LARGEFMT, 10), 53 (DMBIN_LARGECAPACITY, 11), 54 (DMBIN_CASSETTE, 14), 55 (DMBIN_FORMSOURCE, 15)] 56 in 57 fun doConv (DMSOURCE_OTHER i) = i | doConv _ = raise Match 58 val (fromDMS, toDMS) = tableLookup(tab, SOME(DMSOURCE_OTHER, doConv)) 59 end 60 (* Print quality. Positive numbers represent dots per inch. *) 61 datatype DMResolution = DMRES_DRAFT | DMRES_LOW | DMRES_MEDIUM | DMRES_HIGH | DMRES_DPI of int 62 local 63 val tab = [ 64 (DMRES_DRAFT, ~1), 65 (DMRES_LOW, ~2), 66 (DMRES_MEDIUM, ~3), 67 (DMRES_HIGH, ~4)] 68 in 69 fun doConv (DMRES_DPI i) = i | doConv _ = raise Match 70 val (fromDMR, toDMR) = tableLookup(tab, SOME(DMRES_DPI, doConv)) 71 end 72 73 datatype DMDuplex = DMDUP_SIMPLEX | DMDUP_VERTICAL | DMDUP_HORIZONTAL 74 local 75 val tab = [ 76 (DMDUP_SIMPLEX, 1), 77 (DMDUP_VERTICAL, 2), 78 (DMDUP_HORIZONTAL, 3)] 79 in 80 val (fromDMD, toDMD) = tableLookup(tab, NONE) 81 end 82 83 datatype DMTrueType = DMTT_BITMAP | DMTT_DOWNLOAD | DMTT_SUBDEV | DMTT_DOWNLOAD_OUTLINE 84 local 85 val tab = [ 86 (DMTT_BITMAP, 1), 87 (DMTT_DOWNLOAD, 2), 88 (DMTT_SUBDEV, 3), 89 (DMTT_DOWNLOAD_OUTLINE, 4)] 90 in 91 val (fromDMTT, toDMTT) = tableLookup(tab, NONE) 92 end 93 94 datatype DMICMMethod = DMICMMETHOD_NONE | DMICMMETHOD_SYSTEM | DMICMMETHOD_DRIVER | 95 DMICMMETHOD_DEVICE | DMICMMETHOD_OTHER of int 96 local 97 val tab = [ 98 (DMICMMETHOD_NONE, 1), 99 (DMICMMETHOD_SYSTEM, 2), 100 (DMICMMETHOD_DRIVER, 3), 101 (DMICMMETHOD_DEVICE, 4)] 102 in 103 fun doConv (DMICMMETHOD_OTHER i) = i | doConv _ = raise Match 104 val (fromDMICMM, toDMICMM) = tableLookup(tab, SOME(DMICMMETHOD_OTHER, doConv)) 105 end 106 107 datatype DMICMIntent = DMICM_SATURATE | DMICM_CONTRAST | DMICM_COLORMETRIC | 108 DMICMINTENT_OTHER of int 109 local 110 val tab = [ 111 (DMICM_SATURATE, 1), 112 (DMICM_CONTRAST, 2), 113 (DMICM_COLORMETRIC, 3)] 114 in 115 fun doConv (DMICMINTENT_OTHER i) = i | doConv _ = raise Match 116 val (fromDMICMI, toDMICMI) = tableLookup(tab, SOME(DMICMINTENT_OTHER, doConv)) 117 end 118 119 datatype DMMedia = DMMEDIA_STANDARD | DMMEDIA_TRANSPARENCY | DMMEDIA_GLOSSY | DMICMMEDIA_OTHER of int 120 local 121 val tab = [ 122 (DMMEDIA_STANDARD, 1), 123 (DMMEDIA_TRANSPARENCY, 2), 124 (DMMEDIA_GLOSSY, 3)] 125 in 126 fun doConv (DMICMMEDIA_OTHER i) = i | doConv _ = raise Match 127 val (fromDMM, toDMM) = tableLookup(tab, SOME(DMICMMEDIA_OTHER, doConv)) 128 end 129 130 datatype DMDither = DMDITHER_NONE | DMDITHER_COARSE | DMDITHER_FINE | DMDITHER_LINEART | 131 DMDITHER_GRAYSCALE | DMDITHER_OTHER of int 132 local 133 val tab = [ 134 (DMDITHER_NONE, 1), 135 (DMDITHER_COARSE, 2), 136 (DMDITHER_FINE, 3), 137 (DMDITHER_LINEART, 4), 138 (DMDITHER_GRAYSCALE, 5)] 139 in 140 fun doConv (DMDITHER_OTHER i) = i | doConv _ = raise Match 141 val (fromDMDi, toDMDi) = tableLookup(tab, SOME(DMDITHER_OTHER, doConv)) 142 end 143 144 (* Paper orientation. *) 145 datatype DMOrientation = DMORIENT_PORTRAIT | DMORIENT_LANDSCAPE 146 local 147 val tab = [ 148 (DMORIENT_PORTRAIT, 1), 149 (DMORIENT_LANDSCAPE, 2)] 150 in 151 (* Because we use getShort to get the values we don't need a Conversion. *) 152 val (fromDMO, toDMO) = tableLookup(tab, NONE) 153 end 154 155 datatype DMPaperSize = DMPAPER_LETTER | DMPAPER_LETTERSMALL | DMPAPER_TABLOID | DMPAPER_LEDGER | 156 DMPAPER_LEGAL | DMPAPER_STATEMENT | DMPAPER_EXECUTIVE | DMPAPER_A3 | DMPAPER_A4 | 157 DMPAPER_A4SMALL | DMPAPER_A5 | DMPAPER_B4 | DMPAPER_B5 | DMPAPER_FOLIO | DMPAPER_QUARTO | 158 DMPAPER_10X14 | DMPAPER_11X17 | DMPAPER_NOTE | DMPAPER_ENV_9 | DMPAPER_ENV_10 | DMPAPER_ENV_11 | 159 DMPAPER_ENV_12 | DMPAPER_ENV_14 | DMPAPER_CSHEET | DMPAPER_DSHEET | DMPAPER_ESHEET | 160 DMPAPER_ENV_DL | DMPAPER_ENV_C5 | DMPAPER_ENV_C3 | DMPAPER_ENV_C4 | DMPAPER_ENV_C6 | 161 DMPAPER_ENV_C65 | DMPAPER_ENV_B4 | DMPAPER_ENV_B5 | DMPAPER_ENV_B6 | DMPAPER_ENV_ITALY | 162 DMPAPER_ENV_MONARCH | DMPAPER_ENV_PERSONAL | DMPAPER_FANFOLD_US | DMPAPER_FANFOLD_STD_GERMAN | 163 DMPAPER_FANFOLD_LGL_GERMAN | DMPAPER_ISO_B4 | DMPAPER_JAPANESE_POSTCARD | DMPAPER_9X11 | 164 DMPAPER_10X11 | DMPAPER_15X11 | DMPAPER_ENV_INVITE | DMPAPER_RESERVED_48 | DMPAPER_RESERVED_49 | 165 DMPAPER_LETTER_EXTRA | DMPAPER_LEGAL_EXTRA | DMPAPER_TABLOID_EXTRA | DMPAPER_A4_EXTRA | 166 DMPAPER_LETTER_TRANSVERSE | DMPAPER_A4_TRANSVERSE | DMPAPER_LETTER_EXTRA_TRANSVERSE | 167 DMPAPER_A_PLUS | DMPAPER_B_PLUS | DMPAPER_LETTER_PLUS | DMPAPER_A4_PLUS | 168 DMPAPER_A5_TRANSVERSE | DMPAPER_B5_TRANSVERSE | DMPAPER_A3_EXTRA | DMPAPER_A5_EXTRA | 169 DMPAPER_B5_EXTRA | DMPAPER_A2 | DMPAPER_A3_TRANSVERSE | DMPAPER_A3_EXTRA_TRANSVERSE | 170 DMPAPER_OTHER of int 171 172 local 173 val tab = [ 174 (DMPAPER_LETTER, 1), 175 (DMPAPER_LETTERSMALL, 2), 176 (DMPAPER_TABLOID, 3), 177 (DMPAPER_LEDGER, 4), 178 (DMPAPER_LEGAL, 5), 179 (DMPAPER_STATEMENT, 6), 180 (DMPAPER_EXECUTIVE, 7), 181 (DMPAPER_A3, 8), 182 (DMPAPER_A4, 9), 183 (DMPAPER_A4SMALL, 10), 184 (DMPAPER_A5, 11), 185 (DMPAPER_B4, 12), 186 (DMPAPER_B5, 13), 187 (DMPAPER_FOLIO, 14), 188 (DMPAPER_QUARTO, 15), 189 (DMPAPER_10X14, 16), 190 (DMPAPER_11X17, 17), 191 (DMPAPER_NOTE, 18), 192 (DMPAPER_ENV_9, 19), 193 (DMPAPER_ENV_10, 20), 194 (DMPAPER_ENV_11, 21), 195 (DMPAPER_ENV_12, 22), 196 (DMPAPER_ENV_14, 23), 197 (DMPAPER_CSHEET, 24), 198 (DMPAPER_DSHEET, 25), 199 (DMPAPER_ESHEET, 26), 200 (DMPAPER_ENV_DL, 27), 201 (DMPAPER_ENV_C5, 28), 202 (DMPAPER_ENV_C3, 29), 203 (DMPAPER_ENV_C4, 30), 204 (DMPAPER_ENV_C6, 31), 205 (DMPAPER_ENV_C65, 32), 206 (DMPAPER_ENV_B4, 33), 207 (DMPAPER_ENV_B5, 34), 208 (DMPAPER_ENV_B6, 35), 209 (DMPAPER_ENV_ITALY, 36), 210 (DMPAPER_ENV_MONARCH, 37), 211 (DMPAPER_ENV_PERSONAL, 38), 212 (DMPAPER_FANFOLD_US, 39), 213 (DMPAPER_FANFOLD_STD_GERMAN, 40), 214 (DMPAPER_FANFOLD_LGL_GERMAN, 41), 215 (DMPAPER_ISO_B4, 42), 216 (DMPAPER_JAPANESE_POSTCARD, 43), 217 (DMPAPER_9X11, 44), 218 (DMPAPER_10X11, 45), 219 (DMPAPER_15X11, 46), 220 (DMPAPER_ENV_INVITE, 47), 221 (DMPAPER_RESERVED_48, 48), 222 (DMPAPER_RESERVED_49, 49), 223 (DMPAPER_LETTER_EXTRA, 50), 224 (DMPAPER_LEGAL_EXTRA, 51), 225 (DMPAPER_TABLOID_EXTRA, 52), 226 (DMPAPER_A4_EXTRA, 53), 227 (DMPAPER_LETTER_TRANSVERSE, 54), 228 (DMPAPER_A4_TRANSVERSE, 55), 229 (DMPAPER_LETTER_EXTRA_TRANSVERSE, 56), 230 (DMPAPER_A_PLUS, 57), 231 (DMPAPER_B_PLUS, 58), 232 (DMPAPER_LETTER_PLUS, 59), 233 (DMPAPER_A4_PLUS, 60), 234 (DMPAPER_A5_TRANSVERSE, 61), 235 (DMPAPER_B5_TRANSVERSE, 62), 236 (DMPAPER_A3_EXTRA, 63), 237 (DMPAPER_A5_EXTRA, 64), 238 (DMPAPER_B5_EXTRA, 65), 239 (DMPAPER_A2, 66), 240 (DMPAPER_A3_TRANSVERSE, 67), 241 (DMPAPER_A3_EXTRA_TRANSVERSE, 68) ] 242 in 243 (* Because we use getShort to get the values we don't need a Conversion. *) 244 fun doConv (DMPAPER_OTHER i) = i | doConv _ = raise Match 245 val (fromDMPS, toDMPS) = tableLookup(tab, SOME(DMPAPER_OTHER, doConv)) 246 end 247 248 type DEVMODE = { 249 deviceName: string, 250 driverVersion: int, 251 orientation: DMOrientation option, 252 paperSize: DMPaperSize option, 253 paperLength: int option, 254 paperWidth: int option, 255 scale: int option, 256 copies: int option, 257 defaultSource: DMSource option, 258 printQuality: DMResolution option, 259 color: DMColor option, 260 duplex: DMDuplex option, 261 yResolution: int option, 262 ttOption: DMTrueType option, 263 collate: bool option, 264 formName: string option, 265 logPixels: int option, 266 bitsPerPixel: int option, 267 pelsWidth: int option, 268 pelsHeight: int option, 269 displayFlags: int option, (* Apparently no longer used. *) 270 displayFrequency: int option, 271 icmMethod: DMICMMethod option, 272 icmIntent: DMICMIntent option, 273 mediaType: DMMedia option, 274 ditherType: DMDither option, 275 panningWidth: int option, 276 panningHeight: int option, 277 driverPrivate: Word8Vector.vector 278 } 279 280 local 281 val DM_SPECVERSION = 0x0401 282 (* The size of the structure is the same in both 32-bit and 64-bit modes 283 but is larger in Unicode (220 bytes). *) 284 val DMBaseSize = 0w156 (* Size of structure without any user data. *) 285 286 (* These bits indicate the valid fields in the structure. *) 287 val DM_ORIENTATION = 0x00000001 288 val DM_PAPERSIZE = 0x00000002 289 val DM_PAPERLENGTH = 0x00000004 290 val DM_PAPERWIDTH = 0x00000008 291 val DM_SCALE = 0x00000010 292 val DM_COPIES = 0x00000100 293 val DM_DEFAULTSOURCE = 0x00000200 294 val DM_PRINTQUALITY = 0x00000400 295 val DM_COLOR = 0x00000800 296 val DM_DUPLEX = 0x00001000 297 val DM_YRESOLUTION = 0x00002000 298 val DM_TTOPTION = 0x00004000 299 val DM_COLLATE = 0x00008000 300 val DM_FORMNAME = 0x00010000 301 val DM_LOGPIXELS = 0x00020000 302 val DM_BITSPERPEL = 0x00040000 303 val DM_PELSWIDTH = 0x00080000 304 val DM_PELSHEIGHT = 0x00100000 305 val DM_DISPLAYFLAGS = 0x00200000 306 val DM_DISPLAYFREQUENCY = 0x00400000 307 val DM_PANNINGWIDTH = 0x00800000 308 val DM_PANNINGHEIGHT = 0x01000000 309 val DM_ICMMETHOD = 0x02000000 310 val DM_ICMINTENT = 0x04000000 311 val DM_MEDIATYPE = 0x08000000 312 val DM_DITHERTYPE = 0x10000000 313 314 open Memory 315 infix 6 ++ 316 317 val {load=loadShort, store=storeShort, ctype={size=sizeShort, ...}} = 318 breakConversion cShort 319 val {load=loadDWord, store=storeDWord, ctype={size=sizeDWord, ...}} = 320 breakConversion cDWORD 321 322 (* We need separate versions of this for local and global storage. PageSetupDlg 323 requires a HGLOBAL handle to the memory. *) 324 fun getCDevMode(v: voidStar) : DEVMODE = 325 let 326 val ptr = ref v 327 328 fun getShort() = loadShort(!ptr) before ptr := !ptr ++ sizeShort 329 and getDWord() = loadDWord(!ptr) before ptr := !ptr ++ sizeDWord 330 331 val deviceName = fromCstring (!ptr) 332 val () = ptr := !ptr ++ 0w32 333 val _ = getShort() 334 val driverVersion = getShort() 335 val _ = getShort() 336 val driverExtra = getShort() 337 (* The "fields" value determines which of the fields are valid. *) 338 val fields = getDWord() 339 fun getOpt opt conv v = 340 if IntInf.andb(fields, opt) = 0 then NONE else SOME(conv v) 341 fun I x = x 342 343 val orientation = (getOpt DM_ORIENTATION toDMO o getShort) () 344 val paperSize = (getOpt DM_PAPERSIZE toDMPS o getShort) () 345 val paperLength = getOpt DM_PAPERLENGTH I (getShort()) 346 val paperWidth = getOpt DM_PAPERWIDTH I (getShort()) 347 val scale = getOpt DM_SCALE I (getShort()) 348 val copies = getOpt DM_COPIES I (getShort()) 349 val defaultSource = (getOpt DM_DEFAULTSOURCE toDMS o getShort) () 350 val printQuality = (getOpt DM_PRINTQUALITY toDMR o getShort) () 351 val colour = (getOpt DM_COLOR toDMC o getShort) () 352 val duplex = (getOpt DM_DUPLEX toDMD o getShort) () 353 val yResolution = getOpt DM_YRESOLUTION I (getShort()) 354 val ttOption = (getOpt DM_TTOPTION toDMTT o getShort) () 355 val collate = getOpt DM_COLLATE I (getShort()) 356 val formName = getOpt DM_FORMNAME I (fromCstring(!ptr)) 357 val () = ptr := !ptr ++ 0w32 358 val logPixels = getOpt DM_LOGPIXELS I (getShort()) 359 val bitsPerPixel = getOpt DM_BITSPERPEL I (getDWord()) 360 val pelsWidth = getOpt DM_PELSWIDTH I (getDWord()) 361 val pelsHeight = getOpt DM_PELSHEIGHT I (getDWord()) 362 val displayFlags = getOpt DM_DISPLAYFLAGS I (getDWord()) (* Or dmNup *) 363 val displayFrequency = getOpt DM_DISPLAYFREQUENCY I (getDWord()) 364 val icmMethod = (getOpt DM_ICMMETHOD toDMICMM o getDWord) () 365 val icmIntent = (getOpt DM_ICMINTENT toDMICMI o getDWord) () 366 val mediaType = (getOpt DM_MEDIATYPE toDMM o getDWord) () 367 val ditherType = (getOpt DM_DITHERTYPE toDMDi o getDWord) () 368 val (*iccManufacturer*)_ = getDWord() 369 val (*iccModel*)_ = getDWord() 370 val panningWidth = getOpt DM_PANNINGWIDTH I (getDWord()) 371 val panningHeight = getOpt DM_PANNINGHEIGHT I (getDWord()) 372 val _ = 373 voidStar2Sysword(!ptr) - voidStar2Sysword v = Word.toLargeWord DMBaseSize orelse raise Fail "loadCDevMode: length wrong" 374 (* There may be private data at the end. *) 375 fun loadByte _ = Memory.get8(!ptr, 0w0) before ptr := !ptr ++ 0w1 376 val driverPrivate = Word8Vector.tabulate(driverExtra, loadByte) 377 in 378 { 379 deviceName = deviceName, 380 driverVersion = driverVersion, 381 orientation = orientation, 382 paperSize = paperSize, 383 paperLength = paperLength, 384 paperWidth = paperWidth, 385 scale = scale, 386 copies = copies, 387 defaultSource = defaultSource, 388 printQuality = printQuality, 389 color = colour, 390 duplex = duplex, 391 yResolution = yResolution, 392 ttOption = ttOption, 393 collate = case collate of NONE => NONE | SOME 0 => SOME false | SOME _ => SOME true, 394 formName = formName, 395 logPixels = logPixels, 396 bitsPerPixel = bitsPerPixel, 397 pelsWidth = pelsWidth, 398 pelsHeight = pelsHeight, 399 displayFlags = displayFlags, 400 displayFrequency = displayFrequency, 401 icmMethod = icmMethod, 402 icmIntent = icmIntent, 403 mediaType = mediaType, 404 ditherType = ditherType, 405 panningWidth = panningWidth, 406 panningHeight = panningHeight, 407 driverPrivate = driverPrivate 408 } 409 end 410 411 fun setCDevMode(v: voidStar, (* This is the address of the data *) 412 { 413 deviceName: string, 414 driverVersion: int, 415 orientation: DMOrientation option, 416 paperSize: DMPaperSize option, 417 paperLength: int option, 418 paperWidth: int option, 419 scale: int option, 420 copies: int option, 421 defaultSource: DMSource option, 422 printQuality: DMResolution option, 423 color: DMColor option, 424 duplex: DMDuplex option, 425 yResolution: int option, 426 ttOption: DMTrueType option, 427 collate: bool option, 428 formName: string option, 429 logPixels: int option, 430 bitsPerPixel: int option, 431 pelsWidth: int option, 432 pelsHeight: int option, 433 displayFlags: int option, (* Apparently no longer used. *) 434 displayFrequency: int option, 435 icmMethod: DMICMMethod option, 436 icmIntent: DMICMIntent option, 437 mediaType: DMMedia option, 438 ditherType: DMDither option, 439 panningWidth: int option, 440 panningHeight: int option, 441 driverPrivate: Word8Vector.vector 442 }: DEVMODE) : unit = 443 let 444 val ptr = ref v 445 (* The name can be at most 31 characters. *) 446 val devName = 447 if size deviceName > 31 then String.substring(deviceName, 0, 31) else deviceName 448 (* setShort and setLong set the appropriate field and advance the pointer. *) 449 fun setShort i = ignore(storeShort(!ptr, i)) before ptr := !ptr ++ sizeShort 450 and setDWord i = ignore(storeDWord(!ptr, i)) before ptr := !ptr ++ sizeDWord 451 452 (* Optional values default to zero. If the option is SOME v we set the 453 appropriate bit in "fields". *) 454 val fields = ref 0 455 fun setOpt _ _ NONE = 0 456 | setOpt opt conv (SOME v) = (fields := IntInf.orb(!fields, opt); conv v) 457 fun I x = x 458 fun fromCollate true = 1 | fromCollate false = 0 459 val form = 460 case formName of NONE => "" 461 | SOME s => if size s > 31 then String.substring(s, 0, 31) else s 462 in 463 CharVector.appi(fn (i, c) => set8(!ptr, Word.fromInt i, Word8.fromInt(ord c))) devName; 464 set8(!ptr, Word.fromInt(size devName), 0w0); 465 ptr := !ptr ++ 0w32; 466 setShort DM_SPECVERSION; 467 setShort driverVersion; 468 setShort (Word.toInt DMBaseSize); 469 setShort (Word8Vector.length driverPrivate); 470 setDWord 0; (* Fields - set this later. *) 471 setShort(setOpt DM_ORIENTATION fromDMO orientation); 472 setShort(setOpt DM_PAPERSIZE fromDMPS paperSize); 473 setShort(setOpt DM_PAPERLENGTH I paperLength); 474 setShort(setOpt DM_PAPERWIDTH I paperWidth); 475 setShort(setOpt DM_SCALE I scale); 476 setShort(setOpt DM_COPIES I copies); 477 setShort(setOpt DM_DEFAULTSOURCE fromDMS defaultSource); 478 setShort(setOpt DM_PRINTQUALITY fromDMR printQuality); 479 setShort(setOpt DM_COLOR fromDMC color); 480 setShort(setOpt DM_DUPLEX fromDMD duplex); 481 setShort(setOpt DM_YRESOLUTION I yResolution); 482 setShort(setOpt DM_TTOPTION fromDMTT ttOption); 483 setShort(setOpt DM_COLLATE fromCollate collate); 484 CharVector.appi(fn (i, c) => set8(!ptr, Word.fromInt i, Word8.fromInt(ord c))) form; 485 set8(!ptr, Word.fromInt(size form), 0w0); 486 ptr := !ptr ++ 0w32; 487 setShort(setOpt DM_LOGPIXELS I logPixels); 488 setDWord(setOpt DM_BITSPERPEL I bitsPerPixel); 489 setDWord(setOpt DM_PELSWIDTH I pelsWidth); 490 setDWord(setOpt DM_PELSHEIGHT I pelsHeight); 491 setDWord(setOpt DM_DISPLAYFLAGS I displayFlags); 492 setDWord(setOpt DM_DISPLAYFREQUENCY I displayFrequency); 493 setDWord(setOpt DM_ICMMETHOD fromDMICMM icmMethod); 494 setDWord(setOpt DM_ICMINTENT fromDMICMI icmIntent); 495 setDWord(setOpt DM_MEDIATYPE fromDMM mediaType); 496 setDWord(setOpt DM_DITHERTYPE fromDMDi ditherType); 497 setDWord 0; 498 setDWord 0; 499 setDWord(setOpt DM_PANNINGWIDTH I panningWidth); 500 setDWord(setOpt DM_PANNINGHEIGHT I panningHeight); 501 502 (* Set the fields now. *) 503 ignore(storeDWord(v ++ 0w40, !fields)); 504 505 let 506 fun copyToBuf (_, c) = set8(!ptr, 0w0, c) before ptr := !ptr ++ 0w1 507 in 508 Word8Vector.appi copyToBuf driverPrivate 509 end 510 end 511 512 fun devModeSize({driverPrivate: Word8Vector.vector, ...}: DEVMODE): word = 513 DMBaseSize + Word.fromInt (Word8Vector.length driverPrivate) 514 515 fun storeCDevMode(vaddr: voidStar, devmode) = 516 let 517 val v = malloc (devModeSize devmode) 518 val () = setAddress(vaddr, 0w0, v) 519 in 520 setCDevMode(v, devmode); 521 fn () => free v 522 end 523 524 fun loadCDevMode(vaddr: voidStar) : DEVMODE = getCDevMode(getAddress(vaddr, 0w0)) 525 in 526 val LPDEVMODE = 527 makeConversion{load=loadCDevMode, store=storeCDevMode, ctype=LowLevel.cTypePointer } 528 val getCDevMode = getCDevMode 529 and setCDevMode = setCDevMode 530 and devModeSize = devModeSize 531 end 532 end 533end; 534