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