1/* 2 * Utils.c -- 3 * 4 * Various utilities. 5 * It is part of the QuickTimeTcl package which provides Tcl/Tk bindings for QuickTime. 6 * 7 * Copyright (c) 2003-2008 Mats Bengtsson 8 * 9 * $Id: Utils.c,v 1.20 2008/05/06 08:21:40 matben Exp $ 10 */ 11 12#ifdef _WIN32 13# include "QuickTimeTclWin.h" 14#endif 15 16#include "QuickTimeTcl.h" 17#include "tkFont.h" 18 19extern int gQTTclDebugLevel; 20extern int gQTTclDebugLog; 21extern Tcl_Channel gQTTclDebugChannel; 22 23#ifndef PATH_MAX 24# define PATH_MAX 1024 25#endif 26 27/* 28 * Mapping from an Apple Movie Toolbox error code, where -2000 corresponds to an index 0, 29 * and -2053 to an index 53 etc., to a text message. Perhaps this can be found 30 * in some Apple procedure? 31 */ 32 33char *MovieResultCodes[] = { 34 "Cannot use this data reference", 35 "Problem with this image description", 36 "Movie file corrupted", 37 "Cannot locate this handler", 38 "Cannot open this handler", 39 "Component cannot accomodate this data", 40 "Media has no media handler", 41 "Media has no data handler", 42 "This media is corrupted or invalid", 43 "This track is corrupted or invalid", 44 "This movie is corrupted or invalid", // -2010 45 "This sample table is corrupted or invalid", 46 "This data reference is invalid", 47 "This handler is invalid", 48 "This duration value is invalid", 49 "This time value is invalid", 50 "Cannot write to this movie file", 51 "The track's edit list is corrupted", 52 "These media don't match", 53 "Your progress procedure returned an error", 54 "You haven't initialized the movie toolbox", // -2020 55 "Cannot locate this file", 56 "Error trying to create a single-fork file. This occurs when the file already exists", 57 "This edit state is invalid", 58 "This edit state is not valid for this movie", 59 "Movie or track has been disposed", 60 "Cannot locate this user data item", 61 "Maximum size must be larger", 62 "This track index value is not valid", 63 "Cannot locate a track with this ID value", 64 "This track is not in this movie", // -2030 65 "This time value is outside of this track", 66 "This time value is outside of this media", 67 "This edit index value is not valid", 68 "Internal error", 69 "Cannot enable this track", 70 "Specified rectangle has invalid coordinates", 71 "There is no sample with this sample number", 72 "There is no chunk with this chunk number", 73 "Sample description index value invalid", 74 "The chunk cache is corrupted", // -2040 75 "This sample description is invalid or corrupted", 76 "Cannot read from this data source", 77 "Cannot write to this data source", 78 "Data source is already open for write", 79 "You have already closed this data source", 80 "End of data", 81 "No data reference value found", 82 "Toolbox cannot find a movie in the movie file", 83 "Invalid data reference", 84 "Data reference index value is invalid", // -2050 85 "Could not find a default data reference", 86 "Movie toolbox could not use a sample", 87 "Movie toolbox does not support this feature" 88}; 89 90/* 91 * Some network error codes. (-2129 - -2148) 92 */ 93 94char *URLDataErrorCodes [] = { 95 "urlDataHHTTPProtocolErr", // -2129 96 "urlDataHHTTPNoNetDriverErr", // -2130 97 "urlDataHHTTPURLErr", // -2131 98 "urlDataHHTTPRedirectErr", // -2132 99 "urlDataHFTPProtocolErr", // -2133 100 "urlDataHFTPShutdownErr", // -2134 101 "urlDataHFTPBadUserErr", // -2135 102 "urlDataHFTPBadPasswordErr", // -2136 103 "urlDataHFTPServerErr", // -2137 104 "urlDataHFTPDataConnectionErr", // -2138 105 "urlDataHFTPNoDirectoryErr", // -2139 106 "urlDataHFTPQuotaErr", // -2140 107 "urlDataHFTPPermissionsErr", // -2141 108 "urlDataHFTPFilenameErr", // -2142 109 "urlDataHFTPNoNetDriverErr", // -2143 110 "urlDataHFTPBadNameListErr", // -2144 111 "urlDataHFTPNeedPasswordErr", // -2145 112 "urlDataHFTPNoPasswordErr", // -2146 113 "urlDataHFTPServerDisconnectedErr", // -2147 114 "urlDataHFTPURLErr" // -2148 115}; 116 117/* 118 * Mapping from an Apple Image Compressor Manager error code, where -8960 corresponds 119 * to an index 0, and -8973 to an index 13 etc., to a text message. 120 */ 121 122char *ICMResultCodes[] = { 123 "General error condition", // -8960 124 "Image Compression Manager could not find the specified compressor", 125 "Feature not implemented by this compressor", 126 "Invalid buffer size specified", 127 "Could not allocate the screen buffer", 128 "Could not allocate the image buffer", 129 "Error loading or unloading data", 130 "Operation aborted by the progress function", 131 "Compressor would use screen buffer if it could", 132 "Compressor data contains inconsistences", 133 "Compressor does not support the compression version used to compress the image", // -8970 134 "Requested extension is not in the image description", 135 "Component cannot perform requested operation", 136 "Could not open the compressor or decompressor" 137}; 138 139 140/* 141 *---------------------------------------------------------------------- 142 * 143 * ConvertTkPhotoToPicture -- 144 * 145 * Convert a Tk image to a Mac Picture. 146 * 147 * Results: 148 * Normal TCL results 149 * 150 * Side effects: 151 * Creates a mac picture. 152 * 153 *---------------------------------------------------------------------- 154 */ 155 156int 157ConvertTkPhotoToPicture( 158 Tcl_Interp *interp, /* tcl interpreter */ 159 Tk_PhotoHandle tkPhoto, /* (in) tk photo handle */ 160 PicHandle *thePic ) /* (out) an Apple Pict */ 161{ 162 GWorldPtr gw = NULL; 163 GWorldPtr saveGW = NULL; 164 GDHandle saveGD = NULL; 165 PixMapHandle pixels = NULL; 166 Tk_PhotoImageBlock photoBlock; 167 unsigned char *pixelPtr; 168 unsigned char *photoPixels; 169 OSErr err; 170 Rect r; 171 int i, j; 172 int width, height; 173 174 /* 175 * Retrieve image data from 'tkPhoto' and put it into 'photoBlock'. 176 */ 177 178 Tk_PhotoGetImage( tkPhoto, &photoBlock ); 179 GetGWorld( &saveGW, &saveGD ); 180 181 Tk_PhotoGetSize( tkPhoto, &width, &height ); 182 r.top = 0; 183 r.left = 0; 184 r.right = width; 185 r.bottom = height; 186 187 /* Get a new GWorld to draw into */ 188 err = MySafeNewGWorld( &gw, 32, &r, NULL, NULL, 0 ); 189 SetGWorld( gw, NULL ); 190 pixels = GetGWorldPixMap( gw ); 191 192 /* 193 * Lock down the pixels so they don't move out from under us. 194 */ 195 196 LockPixels(pixels); 197 198 /* 199 * Copy the pixels to the gworld. 200 * The Mac pixmap stores them as "alpha, red, gree, blue", but tk 8.3 stores them 201 * as "red, green, blue, alpha (transparency)". 202 */ 203 204 for (i = 0; i < photoBlock.height; i++) { 205 pixelPtr = (unsigned char *) 206 (GetPixBaseAddr(pixels) + i * (0x3FFF & ((*pixels)->rowBytes))); 207 photoPixels = photoBlock.pixelPtr + i * photoBlock.pitch; 208 for (j = 0; j < photoBlock.width; j++) { 209#if TK_MINOR_VERSION <= 2 210 *pixelPtr = 0; pixelPtr++; 211#else 212 *pixelPtr = *(photoPixels + photoBlock.offset[3]); pixelPtr++; 213#endif 214 *pixelPtr = *(photoPixels + photoBlock.offset[0]); pixelPtr++; 215 *pixelPtr = *(photoPixels + photoBlock.offset[1]); pixelPtr++; 216 *pixelPtr = *(photoPixels + photoBlock.offset[2]); pixelPtr++; 217 photoPixels += photoBlock.pixelSize; 218 } 219 } 220 221 /* 222 * Capture the gworlds contents in a picture handle. 223 */ 224 225 *thePic = OpenPicture( &r ); 226#if TARGET_API_MAC_CARBON 227 CopyBits( GetPortBitMapForCopyBits( gw ), 228 GetPortBitMapForCopyBits( gw ), 229 &r, 230 &r, 231 srcCopy, 232 nil ); 233#else 234 CopyBits( &((GrafPtr) gw)->portBits, 235 &((GrafPtr) gw)->portBits, 236 &r, 237 &r, 238 srcCopy, 239 nil ); 240#endif 241 ClosePicture(); 242 243 UnlockPixels( pixels ); 244 if (gw) { 245 DisposeGWorld( gw ); 246 } 247 return TCL_OK; 248} 249 250/* 251 *---------------------------------------------------------------------- 252 * 253 * ConvertPictureToTkPhoto -- 254 * 255 * Convert a Pict to a Tk photo image. 256 * 257 * Results: 258 * Normal TCL results 259 * 260 * Side effects: 261 * Writes a tk image. 262 * 263 *---------------------------------------------------------------------- 264 */ 265 266int 267ConvertPictureToTkPhoto( 268 Tcl_Interp *interp, 269 PicHandle thePic, /* (in) the Pict to be translated */ 270 int width, /* (in) if 0 use natural width */ 271 int height, /* (in) if 0 use natural height */ 272 char *tkImage ) /* (in) name of image */ 273{ 274 Rect bounds; 275 PixMapHandle pixels = NULL; 276 CGrafPtr saveWorld = NULL; 277 GDHandle saveDevice = NULL; 278 GWorldPtr gWorld = NULL; 279 QDErr err = noErr; 280 int result = TCL_OK; 281 282 GetGWorld( &saveWorld, &saveDevice ); 283 284 /* 285 * Find the desired width and height of image. 286 * Note that for QTVR movies the track picture's dimension is not the 287 * same as the movies dimension! 288 * Endians: Thanks to Per Bergland and Tim Monroe Apple for this one! 289 */ 290 291 bounds.left = 0; 292 bounds.right = EndianS16_BtoN((**thePic).picFrame.right) - 293 EndianS16_BtoN((**thePic).picFrame.left); 294 bounds.top = 0; 295 bounds.bottom = EndianS16_BtoN((**thePic).picFrame.bottom) - 296 EndianS16_BtoN((**thePic).picFrame.top); 297 if (width > 0) { 298 bounds.right = width; 299 } 300 if (height > 0) { 301 bounds.bottom = height; 302 } 303 304 /* Get a new GWorld to draw into */ 305 err = MySafeNewGWorld( &gWorld, 32, &bounds, NULL, NULL, 0 ); 306 if (err != noErr) { 307 CheckAndSetErrorResult( interp, err ); 308 result = TCL_ERROR; 309 goto bail; 310 } 311 SetGWorld( gWorld, saveDevice ); 312 EraseRect( &bounds ); 313 DrawPicture( thePic, &bounds ); 314 pixels = GetGWorldPixMap( gWorld ); 315 if (MakeTkPhotoFromPixMap( interp, pixels, tkImage ) != TCL_OK) { 316 result = TCL_ERROR; 317 goto bail; 318 } 319 320bail: 321 SetGWorld( saveWorld, saveDevice ); 322 if (gWorld != NULL) { 323 DisposeGWorld( gWorld ); 324 } 325 return result; 326} 327 328/* 329 *---------------------------------------------------------------------- 330 * 331 * MakeTkPhotoFromPixMap -- 332 * 333 * Takes a PixMap handle and makes a Tk photo image. 334 * 335 * Results: 336 * Normal Tcl results 337 * 338 * Side effects: 339 * Writes a tk image. 340 * 341 *---------------------------------------------------------------------- 342 */ 343 344int 345MakeTkPhotoFromPixMap( 346 Tcl_Interp *interp, 347 PixMapHandle pixels, /* (in) pixmap handle */ 348 char *tkImage ) /* (in) name of image */ 349{ 350 int i, j; 351 Rect bounds; 352 unsigned char *photoPixels; 353 Tk_PhotoHandle tkPhoto = NULL; 354 Tk_PhotoImageBlock blockPtr; 355 Tcl_Obj *resultObjPtr; 356 int result = TCL_OK; 357 358 tkPhoto = Tk_FindPhoto( interp, tkImage ); 359 if (tkPhoto == NULL) { 360 resultObjPtr = Tcl_NewStringObj("Image not found \"", -1); 361 Tcl_AppendStringsToObj( resultObjPtr, tkImage, "\"", (char *) NULL); 362 Tcl_SetObjResult( interp, resultObjPtr ); 363 result = TCL_ERROR; 364 goto bail; 365 } 366 367 Tk_PhotoBlank( tkPhoto ); 368 369 /* 370 * Lock down the pixels so they don't move out from under us. 371 */ 372 373 LockPixels( pixels ); 374#if TARGET_API_MAC_CARBON 375 GetPixBounds( pixels, &bounds ); 376#else 377 bounds = (**pixels).bounds; 378#endif 379 /* 380 * The Mac pixmap stores them as "undefined, red, gree, blue", but tk 8.3 stores them 381 * as "red, green, blue, alpha (transparency)". 382 */ 383 384 blockPtr.pixelPtr = (unsigned char *) GetPixBaseAddr( pixels ); 385 blockPtr.width = bounds.right; 386 blockPtr.height = bounds.bottom; 387 blockPtr.pitch = 0x3FFF & ((*pixels)->rowBytes); 388 blockPtr.pixelSize = 4; 389 blockPtr.offset[0] = 1; 390 blockPtr.offset[1] = 2; 391 blockPtr.offset[2] = 3; 392#if TK_MINOR_VERSION >= 3 393 blockPtr.offset[3] = 0; 394#endif 395 396 /* 397 * Problem with transparency: the first 8 bits in the 32 bit offscreen GWorld 398 * doesn't correspond to an alpha channel, but is undefined. Since its content 399 * seems to be 0, which by tk is interpreted as completely transparent, we need 400 * to set it to 255, completely opaque. 401 */ 402 403#if TK_MINOR_VERSION >= 3 404 for (i = 0; i < blockPtr.height; i++) { 405 photoPixels = blockPtr.pixelPtr + i * blockPtr.pitch; 406 for (j = 0; j < blockPtr.width; j++) { 407 photoPixels[0] = 255; 408 photoPixels += blockPtr.pixelSize; 409 } 410 } 411#endif 412 413 Tk_PhotoPutBlock(tkPhoto, &blockPtr, 414 0, 0, bounds.right, bounds.bottom, TK_PHOTO_COMPOSITE_SET ); 415 416bail: 417 UnlockPixels( pixels ); 418 return result; 419} 420 421/* 422 *----------------------------------------------------------------------------- 423 * 424 * QTTclNewDataRefFromUTF8Obj -- 425 * 426 * Convert the file name into a Data Reference. 427 * Take care of any path normalization, resolve relative paths, and make 428 * the necessary utf translations. 429 * 430 * Results: 431 * Standard Tcl result. 432 * 433 * Side effects: 434 * None 435 * 436 *----------------------------------------------------------------------------- 437 */ 438 439int 440QTTclNewDataRefFromUTF8Obj( 441 Tcl_Interp *interp, 442 Tcl_Obj *fileNameObj, /* (in) utf8 */ 443 Handle *outDataRef, 444 OSType *outDataRefType) 445{ 446 char *file; 447 Tcl_Obj *normObj; 448 OSStatus err; 449 CFStringRef fileCF = NULL; 450 QTPathStyle pathStyle; 451 int result = TCL_OK; 452 453#if TARGET_API_MAC_CARBON 454 pathStyle = kQTNativeDefaultPathStyle; 455#endif 456#ifdef _WIN32 457 pathStyle = kQTPOSIXPathStyle; 458#endif 459 460 /* Get the file path with normal slashes etc. */ 461 normObj = Tcl_FSGetNormalizedPath(interp, fileNameObj); 462 if (normObj == NULL) { 463 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 464 "file \"", Tcl_GetString(fileNameObj), 465 "\" doesn't exist", NULL); 466 result = TCL_ERROR; 467 goto error; 468 } 469 file = Tcl_GetString(normObj); 470 fileCF = CFStringCreateWithCString(NULL, file, kCFStringEncodingUTF8); 471 err = QTNewDataReferenceFromFullPathCFString(fileCF, pathStyle, 472 0, outDataRef, outDataRefType); 473 if (err != noErr) { 474 *outDataRef = NULL; 475 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 476 "file \"", Tcl_GetString(fileNameObj), 477 "\" doesn't exist", NULL); 478 result = TCL_ERROR; 479 goto error; 480 } 481 482error: 483 if (fileCF) { 484 CFRelease(fileCF); 485 } 486 return result; 487} 488 489/* 490 *----------------------------------------------------------------------------- 491 * 492 * QTTclNewUTF8ObjFromDataRef -- 493 * 494 * Convert a Data Reference into a Tcl_Obj with utf8 file path. 495 * 496 * Results: 497 * Standard Tcl result. 498 * 499 * Side effects: 500 * None 501 * 502 *----------------------------------------------------------------------------- 503 */ 504 505int 506QTTclNewUTF8ObjFromDataRef( 507 Tcl_Interp *interp, 508 Handle inDataRef, 509 OSType inDataRefType, 510 Tcl_Obj **fileNameObjPtr) /* (out) utf8 */ 511{ 512 OSStatus err; 513 CFStringRef fileCF; 514 char file[PATH_MAX + 1]; 515 QTPathStyle pathStyle; 516 int result = TCL_OK; 517 518#if TARGET_API_MAC_CARBON 519 pathStyle = kQTNativeDefaultPathStyle; 520#endif 521#ifdef _WIN32 522 pathStyle = kQTWindowsPathStyle; 523#endif 524 525 err = QTGetDataReferenceFullPathCFString(inDataRef, inDataRefType, pathStyle, &fileCF); 526 if (err != noErr) { 527 Tcl_SetObjResult(interp, Tcl_NewStringObj("QTGetDataReferenceFullPathCFString failed", -1)); 528 result = TCL_ERROR; 529 goto error; 530 } 531 532 if (!CFStringGetCString(fileCF, file, PATH_MAX + 1, kCFStringEncodingUTF8)) { 533 Tcl_SetObjResult(interp, Tcl_NewStringObj("CFStringGetCString failed", -1)); 534 result = TCL_ERROR; 535 goto error; 536 } 537 Tcl_SetStringObj(*fileNameObjPtr, file, -1); 538 539error: 540 if (fileCF) { 541 CFRelease(fileCF); 542 } 543 return result; 544} 545 546/* 547 *----------------------------------------------------------------------------- 548 * 549 * QTTclNativePathNameToFSSpec -- 550 * 551 * Convert the file name into a 'FSSpec'. 552 * Take care of any path normalization, resolve relative paths, and make 553 * the necessary utf translations. 554 * 555 * Results: 556 * An OSErr 557 * 558 * Side effects: 559 * None 560 * 561 *----------------------------------------------------------------------------- 562 */ 563 564OSErr 565QTTclNativePathNameToFSSpec( 566 Tcl_Interp *interp, 567 const char *filename, /* (in) utf8 */ 568 FSSpec *fssPtr ) /* (out) */ 569{ 570 Tcl_Obj *translatedPathObjPtr = NULL; 571 CONST char *charPtr = NULL; 572 char normalizedPath[512] = ""; 573 Tcl_DString ds; 574 OSErr err = noErr; 575 576 /* 577 * Normalize path: 578 * 1) 'file nativename filename' 579 * (Convert forward slashes to backslashes in Windows paths) 580 * 2) make absolute path if relative 581 */ 582 583 filename = Tcl_TranslateFileName(interp, filename, &ds); 584 if (filename == NULL) { 585 return fnfErr; 586 } 587 translatedPathObjPtr = Tcl_NewStringObj( filename, -1 ); 588 Tcl_IncrRefCount( translatedPathObjPtr ); 589 Tcl_DStringFree(&ds); 590 591 if (TCL_PATH_RELATIVE == Tcl_FSGetPathType( translatedPathObjPtr )) { 592 Tcl_Obj *cwdPathObjPtr = NULL; 593 Tcl_Obj *absPathObjPtr = NULL; 594 Tcl_Obj *listObjPtr = NULL; 595 596 cwdPathObjPtr = Tcl_FSGetCwd( interp ); 597 if (cwdPathObjPtr == NULL) { 598 return fnfErr; 599 } 600 listObjPtr = Tcl_NewListObj( 0, (Tcl_Obj **) NULL ); 601 Tcl_ListObjAppendElement( interp, listObjPtr, cwdPathObjPtr ); 602 Tcl_ListObjAppendElement( interp, listObjPtr, translatedPathObjPtr ); 603 604 /* Tcl_FSJoinPath returns object with ref count 0 */ 605 Tcl_IncrRefCount(listObjPtr); 606 absPathObjPtr = Tcl_FSJoinPath( listObjPtr, -1 ); 607 Tcl_IncrRefCount( absPathObjPtr ); 608 Tcl_DecrRefCount( listObjPtr ); 609 Tcl_DecrRefCount( cwdPathObjPtr ); 610 Tcl_DecrRefCount( translatedPathObjPtr ); 611 translatedPathObjPtr = absPathObjPtr; 612 } 613 charPtr = Tcl_GetStringFromObj( translatedPathObjPtr, NULL ); 614 strncpy( normalizedPath, charPtr, 511 ); 615 Tcl_DecrRefCount( translatedPathObjPtr ); 616 617 /* 618 * Platform specific parts. 619 */ 620 621 622#if TARGET_API_MAC_CARBON // Mac OS X 623{ 624 CFStringRef cfString; 625 char classicFilename[512] = ""; 626 627 /* 628 * We must handle both composed and decomposed utf format. 629 * The Tcl encoding conversions and Tcl_UtfToExternalDString() don't 630 * automatically handle Unicode composition. 631 * Code snippet provided by Benjamin Riefenstahl. Many Thanks! 632 */ 633 634 cfString = CFStringCreateWithCStringNoCopy( 635 NULL, normalizedPath, kCFStringEncodingUTF8, kCFAllocatorNull ); 636 CFStringGetCString( 637 cfString, classicFilename, sizeof(classicFilename) - 1, 638 GetScriptManagerVariable(smSysScript) ); 639 err = FSpLocationFromPath( strlen(classicFilename), classicFilename, fssPtr ); 640 CFRelease( cfString ); 641} 642#endif // TARGET_OS_MAC 643 644#ifdef _WIN32 645{ 646 int srcRead, dstWrote; 647 char externalPath[512]; 648 649 Tcl_UtfToExternal( NULL, gQTTclTranslationEncoding, normalizedPath, 650 strlen(normalizedPath), 0, NULL, externalPath, 511, &srcRead, &dstWrote, NULL ); 651 err = NativePathNameToFSSpec( externalPath, fssPtr, 0 ); 652} 653#endif // _WIN32 654 655return err; 656} 657 658/* 659 *----------------------------------------------------------------------------- 660 * 661 * QTTclFSSpecToNativePathName -- 662 * 663 * Convert the 'FSSpec' into a file name. 664 * There are two things to consider: UTF translation and Mac vs. Windows. 665 * 666 * Results: 667 * An standard Tcl error code. File path in 'pathname'. Be sure to 668 * allocate it before calling! 669 * 670 * Side effects: 671 * Leaves file path in interp. 672 * 673 *----------------------------------------------------------------------------- 674 */ 675 676int 677QTTclFSSpecToNativePathName( 678 Tcl_Interp *interp, 679 char *pathname, 680 FSSpec *fssPtr ) 681{ 682 Tcl_DString ds; 683 684#if TARGET_OS_MAC && TARGET_API_MAC_CARBON // Mac OS X 685{ 686 Handle pathHandle = NULL; 687 int length; 688 689 if (FSpPathFromLocation( fssPtr, &length, &pathHandle ) != noErr) { 690 Tcl_SetObjResult( interp, Tcl_NewStringObj( 691 "Failed creating file pathname", -1 ) ); 692 return TCL_ERROR; 693 } 694 HLock(pathHandle); 695 sprintf( pathname, "%s", (char *) *pathHandle ); 696 HUnlock( pathHandle ); 697 Tcl_SetObjResult( interp, Tcl_NewStringObj( pathname, -1 ) ); 698 DisposeHandle( pathHandle ); 699} 700#endif 701 702#if TARGET_OS_MAC && !TARGET_API_MAC_CARBON // Mac Classic 703{ 704Handle pathHandle; 705int length; 706 707pathHandle = NULL; 708FSpPathFromLocation( fssPtr, &length, &pathHandle ); 709if (pathHandle == NULL) { 710 Tcl_SetObjResult( interp, Tcl_NewStringObj( 711 "Failed creating file pathname", -1 ) ); 712 return TCL_ERROR; 713} 714HLock(pathHandle); 715sprintf( pathname, "%s", (char *) *pathHandle ); 716HUnlock( pathHandle ); 717DisposeHandle( pathHandle ); 718} 719#endif 720 721#ifdef _WIN32 722if (noErr != FSSpecToNativePathName( fssPtr, pathname, 255, kFullNativePath )) { 723 Tcl_SetObjResult( interp, Tcl_NewStringObj( 724 "Failed creating file pathname", -1 ) ); 725 return TCL_ERROR; 726} 727#endif 728 729Tcl_ExternalToUtfDString( gQTTclTranslationEncoding, pathname, -1, &ds ); 730Tcl_SetObjResult( interp, 731 Tcl_NewStringObj( Tcl_DStringValue(&ds), -1 ) ); 732Tcl_DStringFree( &ds ); 733 734return TCL_OK; 735} 736 737/* 738 *---------------------------------------------------------------------- 739 * 740 * QTTclMacWinBounds -- 741 * 742 * Given a Tk window this function determines the windows 743 * bounds in relation to the Macintosh window's coordinate 744 * system. This is also the same coordinate system as the 745 * Tk toplevel window in which this window is contained. 746 * 747 * Results: 748 * None. 749 * 750 * Side effects: 751 * None. 752 * 753 *---------------------------------------------------------------------- 754 */ 755 756void 757QTTclMacWinBounds( 758 TkWindow *winPtr, 759 Rect *bounds) 760{ 761#if TARGET_API_MAC_CARBON 762 TkMacOSXWinBounds( winPtr, bounds ); 763#endif 764 765#ifdef _WIN32 766 bounds->left = 0; 767 bounds->top = 0; 768 bounds->right = (short) winPtr->changes.width; 769 bounds->bottom = (short) winPtr->changes.height; 770#endif 771} 772 773/* 774 *---------------------------------------------------------------------- 775 * 776 * QTTclMacGetDrawablePort -- 777 * 778 * This function returns the Graphics Port for a given X drawable. 779 * Beware, a very special routine to mimic Mac behaviour on Windows! 780 * 781 * Results: 782 * A GWorld pointer. Either an off screen pixmap or a Window. 783 * 784 * Side effects: 785 * None. 786 * 787 *---------------------------------------------------------------------- 788 */ 789 790 GWorldPtr 791 QTTclMacGetDrawablePort( 792 Drawable drawable) 793 { 794#if TARGET_API_MAC_CARBON 795 return TkMacOSXGetDrawablePort( drawable ); 796#endif 797 798#ifdef _WIN32 799 TkWinDrawable *winWin = (TkWinDrawable *) drawable; 800 CWindowPtr qtmlPtr; /* Macintosh window pointer */ 801 802 if (winWin == NULL) { 803 return NULL; 804 } 805 /* Convert to window pointer */ 806 qtmlPtr = (CGrafPtr) GetHWNDPort( TkWinGetHWND(winWin) ); 807 if (qtmlPtr != NULL) { 808 return qtmlPtr; 809 } 810 return NULL; 811#endif // _WIN32 812} 813 814 /* 815 *---------------------------------------------------------------------- 816 * 817 * QTTclMacVisableClipRgn -- 818 * 819 * This function returnd the Macintosh cliping region for the 820 * given window. A NULL Rgn means the window is not visable. 821 * 822 * Results: 823 * The region. 824 * 825 * Side effects: 826 * None. 827 * 828 *---------------------------------------------------------------------- 829 */ 830#if TARGET_OS_MAC 831 832 RgnHandle 833 QTTclMacVisableClipRgn( 834 TkWindow *winPtr) 835 { 836#if TARGET_API_MAC_CARBON 837 return TkMacOSXVisableClipRgn( winPtr ); 838#else 839 return TkMacVisableClipRgn( winPtr ); 840#endif 841 } 842#endif // TARGET_OS_MAC 843 844 845 /* 846 *----------------------------------------------------------------------------- 847 * 848 * QTTclGetMacFontAttributes -- 849 * 850 * Takes a Tk_Font and gets the Mac font attributes faceNum, size, and style. 851 * Note that the Mac font size is in pixels while the Tk_Font size is 852 * in points. 853 * 854 * Results: 855 * Sets tha Mac font attributes. 856 * 857 * Side effects: 858 * None. 859 * 860 *----------------------------------------------------------------------------- 861 */ 862 863 void 864 QTTclGetMacFontAttributes( 865 Tcl_Interp *interp, 866 Tk_Window tkwin, 867 Tk_Font tkFont, 868 short *faceNum, 869 short *macSize, 870 Style *style) 871 { 872 const TkFontAttributes *faPtr; 873 Str255 pstr; 874 int srcRead, dstWrote; 875 int size; 876 877 *faceNum = 0; 878 faPtr = GetFontAttributes(tkFont); 879 Tcl_UtfToExternal( interp, gQTTclTranslationEncoding, faPtr->family, strlen(faPtr->family), 880 0, NULL, StrBody(pstr), 255, &srcRead, &dstWrote, NULL ); 881 pstr[0] = dstWrote; 882#if TARGET_API_MAC_CARBON 883 *faceNum = FMGetFontFamilyFromName( pstr ); 884#else 885 GetFNum( pstr, faceNum ); 886#endif 887 if (faPtr->size == 0) { 888#if TARGET_OS_MAC 889 size = -GetDefFontSize(); 890#endif 891#ifdef _WIN32 892 893 /* 894 * Seems Apple didn't port this one. Make a reasonable guess. 895 */ 896 897 size = 10; 898#endif 899 } else { 900 size = faPtr->size; 901 } 902 // seems to be a problem with exported symbols from 8.3.2 903 //*macSize = (short) TkFontGetPixels( tkwin, size ); 904 *macSize = (size > 0) ? size : -size; 905 *style = 0; 906 if (faPtr->weight != TK_FW_NORMAL) { 907 *style |= bold; 908 } 909 if (faPtr->slant != TK_FS_ROMAN) { 910 *style |= italic; 911 } 912 if (faPtr->underline) { 913 *style |= underline; 914 } 915 } 916 917 /* 918 *---------------------------------------------------------------------- 919 * 920 * CheckAndSetErrorResult -- 921 * 922 * Is called when something unexpected happens a movie, and here 923 * we check if Apple can provide us with an error message. 924 * If found any we append this message to the Tcl interpreters 925 * result. If there is an error, we return an Apple OSErr error 926 * code. So far only Movie Toolbox errors are checked; add more 927 * later! If an nonzero myErr is given, then take this one since 928 * only Movie Toolbox errors are checked for in GetMoviesError. 929 * If have no error code put noErr in myErr. 930 * 931 * Results: 932 * OSErr, Apple error code. 933 * 934 * Side effects: 935 * May add message to the Tcl result. 936 * 937 *---------------------------------------------------------------------- 938 */ 939 940 OSStatus 941 CheckAndSetErrorResult( 942 Tcl_Interp *interp, 943 OSStatus myErr ) 944 { 945 OSStatus result = noErr; 946 947 if (myErr == noErr) { 948 if (noErr == (result = GetMoviesError())) { 949 return noErr; 950 } 951 } else { 952 result = myErr; 953 } 954 Tcl_SetObjResult( interp, GetErrorObj( result ) ); 955 return result; 956 } 957 958 /* 959 *---------------------------------------------------------------------- 960 * 961 * GetErrorObj -- 962 * 963 * Translates the Apple error code into a readable string object. 964 * 965 * Results: 966 * Tcl_Obj describing error code. 967 * 968 * Side effects: 969 * None. 970 * 971 *---------------------------------------------------------------------- 972 */ 973 974 Tcl_Obj * 975 GetErrorObj ( OSStatus err ) 976 { 977 long ind; 978 Tcl_Obj *errObj = NULL; 979 char tmp[STR255LEN]; 980 981 /* Movie Toolbox codes are from -2000 to -2053 ; 982 * translate to array index. */ 983 ind = -(err + 2000); 984 if ((ind >= 0) && (ind <= 53)) { 985 errObj = Tcl_NewStringObj(MovieResultCodes[ind], -1); 986 } 987 988 /* Image Compressor Manager codes are from -8960 to -8973 ; 989 * translate to array index. */ 990 ind = -(err + 8960); 991 if ((ind >= 0) && (ind <= 13)) { 992 errObj = Tcl_NewStringObj(ICMResultCodes[ind], -1); 993 } 994 995 /* Some url error codes. */ 996 if ((err <= -2129) && (err >= -2148)) { 997 ind = -(err + 2129); 998 errObj = Tcl_NewStringObj(URLDataErrorCodes[ind], -1); 999 } 1000 1001 /* Miscellaneous error codes. */ 1002 if (errObj == NULL) { 1003 if (err == -43) { 1004 errObj = Tcl_NewStringObj("File not found", -1); 1005 } else if (err == -50) { 1006 errObj = Tcl_NewStringObj("Error in user parameter list", -1); 1007 } else if (err == -100) { 1008 errObj = Tcl_NewStringObj("No scrap exists", -1); 1009 } else if (err == -102) { 1010 errObj = Tcl_NewStringObj( 1011 "Format not available [no object of that type in scrap]", -1); 1012 } else if (err == -108) { 1013 errObj = Tcl_NewStringObj("Not enough memory available", -1); 1014 } else if (err == 10061) { 1015 errObj = Tcl_NewStringObj("Could not connect to server", -1); 1016 } 1017 } 1018 if (errObj == NULL) { 1019 sprintf( tmp, "Apple error code %d", (int) err ); 1020 errObj = Tcl_NewStringObj(tmp, -1); 1021 } 1022 return errObj; 1023 } 1024 1025 /* 1026 *---------------------------------------------------------------------- 1027 * 1028 * MySafeNewHandle -- 1029 * 1030 * Allocate a new block of memory free from the System. 1031 * This is the safe way to use NewHandle; rip-off from tclMacAlloc.c 1032 * after a suggestion of Daniel Steffen. 1033 * 1034 * Results: 1035 * Returns same as NewHandle. 1036 * 1037 * Side effects: 1038 * May obtain memory from app or sys space. 1039 * 1040 *---------------------------------------------------------------------- 1041 */ 1042 1043 Handle 1044 MySafeNewHandle( long size, int clear ) 1045 { 1046 Handle hand = NULL; 1047 1048 hand = NewHandle( size ); 1049 if (clear) { 1050 HLock( hand ); 1051 memset( (char *) *hand, 0, size ); 1052 HUnlock( hand ); 1053 } 1054 return hand; 1055 } 1056 1057 /* 1058 *---------------------------------------------------------------------- 1059 * 1060 * MySafeNewGWorld -- 1061 * 1062 * Allocate a new GWorld. Keeps a toolbox space around; 1063 * rip-off from tclMacAlloc.c after a suggestion of Daniel Steffen. 1064 * 1065 * Results: 1066 * Returns same as NewGWorld. 1067 * 1068 * Side effects: 1069 * May obtain memory from app or temp space. 1070 * 1071 *---------------------------------------------------------------------- 1072 */ 1073 1074 OSErr 1075 MySafeNewGWorld( 1076 GWorldPtr *offscreenGWorldHand, 1077 short depth, 1078 const Rect *bounds, 1079 CTabHandle cTable, 1080 GDHandle device, 1081 GWorldFlags flags ) 1082 { 1083 OSErr err = noErr; 1084 1085 err = NewGWorld( offscreenGWorldHand, depth, bounds, cTable, device, 0 ); 1086 if (err != noErr) { 1087 err = NewGWorld( offscreenGWorldHand, depth, bounds, cTable, device, useTempMem ); 1088 } 1089 if (err != noErr) { 1090 panic( "Out of memory: NewGWorld failed" ); 1091 } 1092 return err; 1093 } 1094 1095 /* 1096 *----------------------------------------------------------------------------- 1097 * 1098 * SafeStrcmp -- 1099 * 1100 * Just a safe 'strcmp' that accepts NULL pointers. 1101 * A zero length string equals a NULL pointer. 1102 * 1103 * Results: 1104 * As 'strcmp' if no NULL pointers, 0 if both NULL, 0 if one NULL 1105 * and another zero length, else +1 or -1. 1106 * 1107 * Side effects: 1108 * None 1109 * 1110 *----------------------------------------------------------------------------- 1111 */ 1112 1113 int 1114 SafeStrcmp( const char *cs, const char *ct ) { 1115 1116 if ((cs == NULL) && (ct == NULL)) { 1117 return 0; 1118 } else if ((cs == NULL) && (ct[0] == '\0')) { 1119 return 0; 1120 } else if ((cs[0] == '\0') && (ct == NULL)) { 1121 return 0; 1122 } else if (cs == NULL) { 1123 return -1; // could use 'strlen' here... 1124 } else if (ct == NULL) { 1125 return 1; 1126 } else { 1127 return strcmp( cs, ct ); 1128 } 1129 } 1130 1131 /* 1132 *----------------------------------------------------------------------------- 1133 * 1134 * SafeStrcpy -- 1135 * 1136 * Just a safe 'strcpy' that accepts NULL pointers. 1137 * 1138 * Results: 1139 * As 'strcpy' if no NULL pointers, 1140 * 1141 * Side effects: 1142 * None 1143 * 1144 *----------------------------------------------------------------------------- 1145 */ 1146 1147 char * 1148 SafeStrcpy( char *s, const char *ct ) { 1149 1150 if ((s == NULL) && (ct == NULL)) { 1151 return NULL; 1152 } else if (ct == NULL) { 1153 s[0] = '\0'; 1154 return s; 1155 } else { 1156 return strcpy( s, ct ); 1157 } 1158 } 1159 1160 /* 1161 *---------------------------------------------------------------------- 1162 * 1163 * ConvertFloatToBigEndian -- 1164 * 1165 * Convert the specified floating-point number to big-endian format. 1166 * 1167 * Results: 1168 * None. 1169 * 1170 * Side effects: 1171 * None. 1172 * 1173 *---------------------------------------------------------------------- 1174 */ 1175 1176 void 1177 ConvertFloatToBigEndian (float *theFloat) 1178 { 1179 unsigned long *longPtr; 1180 1181 longPtr = (unsigned long *)theFloat; 1182 *longPtr = EndianU32_NtoB(*longPtr); 1183 } 1184 1185 void 1186 ConvertBigEndianFloatToNative( float *theFloat ) 1187 { 1188 unsigned long *myLongPtr; 1189 1190 myLongPtr = (unsigned long *)theFloat; 1191 *myLongPtr = EndianU32_BtoN(*myLongPtr); 1192 } 1193 1194 int 1195 GetMovieStartTimeFromObj( Tcl_Interp *interp, Movie movie, Tcl_Obj *obj, long *timeValuePtr ) 1196 { 1197 int result = TCL_OK; 1198 1199 if (strcmp(Tcl_GetString( obj ), "end") == 0) { 1200 *timeValuePtr = GetMovieDuration( movie ); 1201 } else if (Tcl_GetLongFromObj( interp, obj, timeValuePtr ) != TCL_OK) { 1202 Tcl_AddErrorInfo( interp, "\n (processing time value)" ); 1203 result = TCL_ERROR; 1204 } else { 1205 result = TCL_OK; 1206 } 1207 return result; 1208 } 1209 1210 int 1211 GetMovieDurationFromObj( Tcl_Interp *interp, Movie movie, Tcl_Obj *obj, long movTime, long *durValuePtr ) 1212 { 1213 int result = TCL_OK; 1214 1215 if (strcmp(Tcl_GetString( obj ), "end") == 0) { 1216 *durValuePtr = GetMovieDuration( movie ) - movTime; 1217 } else if (Tcl_GetLongFromObj( interp, obj, durValuePtr ) != TCL_OK) { 1218 Tcl_AddErrorInfo( interp, "\n (processing duration value)" ); 1219 result = TCL_ERROR; 1220 } else { 1221 result = TCL_OK; 1222 } 1223 return result; 1224 } 1225 1226 /* 1227 *---------------------------------------------------------------------- 1228 * 1229 * MyDebugStr, QTTclDebugPrintf -- 1230 * 1231 * Debugging aid. 1232 * 1233 * Results: 1234 * None. 1235 * 1236 * Side effects: 1237 * Printouts. 1238 * 1239 *---------------------------------------------------------------------- 1240 */ 1241 1242 void 1243 MyDebugStr( ConstStr255Param debuggerMsg ) 1244 { 1245#if TARGET_OS_MAC 1246 DebugStr( debuggerMsg ); 1247#else 1248 /* Do nothing */ 1249#endif 1250 } 1251 1252 void 1253 QTTclDebugPrintf( Tcl_Interp *interp, int level, char *fmt, ... ) 1254 { 1255 va_list args; 1256 char tmpstr[256]; 1257 1258 if (level > gQTTclDebugLevel) { 1259 return; 1260 } 1261 va_start( args, fmt ); 1262 vsprintf( tmpstr, fmt, args ); 1263 if (interp != NULL) { 1264 Tcl_VarEval( interp, "puts \"", tmpstr, "\"", (char *) NULL ); 1265 } 1266 va_end (args ); 1267 1268 if (gQTTclDebugLog) { 1269 if (gQTTclDebugChannel == NULL) { 1270 gQTTclDebugChannel = Tcl_FSOpenFileChannel(interp, 1271 Tcl_NewStringObj("_QTTclDebug.txt", -1), "w", 420); 1272 } 1273 Tcl_Write(gQTTclDebugChannel, tmpstr, strlen(tmpstr)); 1274 Tcl_Write(gQTTclDebugChannel, "\n", 1); 1275 Tcl_Flush(gQTTclDebugChannel); 1276 } 1277 } 1278 1279#if TARGET_OS_MAC 1280 /* 1281 *---------------------------------------------------------------------- 1282 * 1283 * GetMacSystemEncoding -- 1284 * 1285 * Gets the system encoding for Mac OS X/8/9. 1286 * Copied from TkpInit in tkMacOSXInit.c 1287 * 1288 * Results: 1289 * Tcl_Encoding. 1290 * 1291 * Side effects: 1292 * None. 1293 * 1294 *---------------------------------------------------------------------- 1295 */ 1296 1297 Tcl_Encoding 1298 GetMacSystemEncoding( void ) 1299 { 1300 CFStringEncoding encoding; 1301 char *encodingStr = NULL; 1302 int i; 1303 Tcl_Encoding tclEncoding; 1304 typedef struct Map { 1305 int numKey; 1306 char *strKey; 1307 } Map; 1308 1309 static Map scriptMap[] = { 1310 {smRoman, "macRoman"}, 1311 {smJapanese, "macJapan"}, 1312 {smTradChinese, "macChinese"}, 1313 {smKorean, "macKorean"}, 1314 {smArabic, "macArabic"}, 1315 {smHebrew, "macHebrew"}, 1316 {smGreek, "macGreek"}, 1317 {smCyrillic, "macCyrillic"}, 1318 {smRSymbol, "macRSymbol"}, 1319 {smDevanagari, "macDevanagari"}, 1320 {smGurmukhi, "macGurmukhi"}, 1321 {smGujarati, "macGujarati"}, 1322 {smOriya, "macOriya"}, 1323 {smBengali, "macBengali"}, 1324 {smTamil, "macTamil"}, 1325 {smTelugu, "macTelugu"}, 1326 {smKannada, "macKannada"}, 1327 {smMalayalam, "macMalayalam"}, 1328 {smSinhalese, "macSinhalese"}, 1329 {smBurmese, "macBurmese"}, 1330 {smKhmer, "macKhmer"}, 1331 {smThai, "macThailand"}, 1332 {smLaotian, "macLaos"}, 1333 {smGeorgian, "macGeorgia"}, 1334 {smArmenian, "macArmenia"}, 1335 {smSimpChinese, "macSimpChinese"}, 1336 {smTibetan, "macTIbet"}, 1337 {smMongolian, "macMongolia"}, 1338 {smGeez, "macEthiopia"}, 1339 {smEastEurRoman, "macCentEuro"}, 1340 {smVietnamese, "macVietnam"}, 1341 {smExtArabic, "macSindhi"}, 1342 {NULL, NULL} 1343 }; 1344 1345 encoding = CFStringGetSystemEncoding(); 1346 1347 for (i = 0; scriptMap[i].strKey != NULL; i++) { 1348 if (scriptMap[i].numKey == encoding) { 1349 encodingStr = scriptMap[i].strKey; 1350 break; 1351 } 1352 } 1353 if (encodingStr == NULL) { 1354 encodingStr = "macRoman"; 1355 } 1356 1357 tclEncoding = Tcl_GetEncoding (NULL, encodingStr); 1358 if (tclEncoding == NULL) { 1359 tclEncoding = Tcl_GetEncoding (NULL, NULL); 1360 } 1361 return tclEncoding; 1362 } 1363#endif 1364 1365 /*---------------------------------------------------------------------------*/ 1366