1/*
2 * QuickTimeTcl.c --
3 *
4 *		Main routine for the QuickTimeTcl package.
5 *		It is part of the QuickTimeTcl package which provides Tcl/Tk bindings for QuickTime.
6 *      Some parts from the Tkimg package.
7 *
8 * Copyright (c) 1998       Bruce O'Neel
9 * Copyright (c) 2000-2005  Mats Bengtsson
10 *
11 * version: 3.1.0
12 *
13 * $Id: QuickTimeTcl.c,v 1.21 2008/02/26 13:40:47 matben Exp $
14 */
15
16#ifdef _WIN32
17#   include "QuickTimeTclWin.h"
18#endif
19
20#include "QuickTimeTcl.h"
21
22Tcl_Encoding 	gQTTclTranslationEncoding;
23
24/*
25 * For dispatching canopen options.
26 */
27
28static char *allCanOpenOptions[] = {
29	"-allowall", "-allownewfile", "-type",
30    (char *) NULL
31};
32
33enum {
34    kCanOpenOptionAllowAll                  = 0L,
35    kCanOpenOptionAllowNewFile,
36    kCanOpenOptionType
37};
38
39/*
40 * Sets the debug level for printouts via QTTclDebugPrintf().
41 * 0 : no printouts, > 0 depends in level in call.
42 */
43
44int gQTTclDebugLevel = 0;
45int gQTTclDebugLog   = 0;
46
47Tcl_Channel gQTTclDebugChannel = NULL;
48
49/*
50 * Various code from Tkimg used for base64 reading.
51 */
52
53typedef struct {
54    Tcl_DString *buffer;/* pointer to dynamical string */
55    char *data;			/* mmencoded source string */
56    int c;				/* bits left over from previous char */
57    int state;			/* decoder state (0-4 or IMG_DONE) */
58    int length;			/* length of physical line already written */
59} MFile;
60
61static char base64_table[64] = {
62    'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
63    'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
64    'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
65    'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
66    'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
67    'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
68    'w', 'x', 'y', 'z', '0', '1', '2', '3',
69    '4', '5', '6', '7', '8', '9', '+', '/'
70};
71
72#define IMG_SPECIAL	 (1<<8)
73#define IMG_PAD		(IMG_SPECIAL+1)
74#define IMG_SPACE	(IMG_SPECIAL+2)
75#define IMG_BAD		(IMG_SPECIAL+3)
76#define IMG_DONE	(IMG_SPECIAL+4)
77#define IMG_CHAN    (IMG_SPECIAL+5)
78#define IMG_STRING	(IMG_SPECIAL+6)
79
80
81static int      FileMatchQuickTime( Tcl_Channel chan, const char *fileName,
82		                Tcl_Obj *format, int *widthPtr, int *heightPtr, Tcl_Interp *interp );
83static int 		StringMatchQuickTime( Tcl_Obj *data, Tcl_Obj *format, int *widthPtr,
84                        int *heightPtr, Tcl_Interp *interp );
85static int      FileReadQuickTime( Tcl_Interp *interp,
86		                Tcl_Channel chan, const char *fileName, Tcl_Obj *format,
87		                Tk_PhotoHandle imageHandle, int destX, int destY,
88		                int width, int height, int srcX, int srcY );
89static int 		StringReadQuickTime( Tcl_Interp *interp, Tcl_Obj *dataObj, Tcl_Obj *format,
90                        Tk_PhotoHandle imageHandle, int destX, int destY,
91                        int width, int height, int srcX, int srcY );
92static int      FileWriteQuickTime( Tcl_Interp *interp,
93		                const char *fileName, Tcl_Obj *format,
94		                Tk_PhotoImageBlock *blockPtr );
95
96static int      GetOpenFilePreviewObjCmd( ClientData clientData,
97                        Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[] );
98static pascal Boolean   EventFilter( DialogPtr dialogPtr,
99                                EventRecord *eventStrucPtr, SInt16 *itemHit, void *doNotKnow );
100#if TARGET_OS_MAC
101extern OSErr    GetOneFileWithPreview( AEDesc *defaultLocation, short theNumTypes,
102                        OSTypePtr theTypeList, StringPtr title,
103                        FSSpecPtr theFSSpecPtr, void *theFilterProc );
104static int      HandleInitialDirectory( Tcl_Interp *interp, char *initialDir,
105                        FSSpec *dirSpec, AEDesc *dirDescPtr );
106#endif
107
108static int      CanOpenObjCmd( ClientData clientData, Tcl_Interp *interp,
109                        int objc, Tcl_Obj *CONST objv[] );
110static int      DebugLevelObjCmd( ClientData clientData, Tcl_Interp *interp,
111                        int objc, Tcl_Obj *CONST objv[] );
112static int		ImgReadInit( Tcl_Obj *data, int	c,  MFile *handle );
113static int		ImgRead( MFile *handle, char *dst, int count );
114static int		ImgGetc( MFile *handle );
115static int 		char64( int c );
116
117
118Tk_PhotoImageFormat tkImgFmtQuickTime = {
119	"quicktime",			    						/* name of handler  */
120	(Tk_ImageFileMatchProc *) FileMatchQuickTime,    	/* fileMatchProc    */
121	(Tk_ImageStringMatchProc *) StringMatchQuickTime,	/* stringMatchProc  */
122	(Tk_ImageFileReadProc *) FileReadQuickTime,        	/* fileReadProc     */
123	/*(Tk_ImageStringReadProc *) StringReadQuickTime,*/		/* stringReadProc   */
124	(Tk_ImageStringReadProc *) NULL,		/* stringReadProc   */
125	(Tk_ImageFileWriteProc *) FileWriteQuickTime,      	/* fileWriteProc    */
126	(Tk_ImageStringWriteProc *) NULL,                 	/* stringWriteProc  */
127};
128
129/*
130 * "export" is a MetroWerks specific pragma.  It flags the linker that
131 * any symbols that are defined when this pragma is on will be exported
132 * to shared libraries that link with this library.
133 */
134
135
136#if TARGET_OS_MAC
137#   pragma export on
138    int Quicktimetcl_Init( Tcl_Interp *interp );
139    int Quicktimetcl_SafeInit( Tcl_Interp *interp );
140#   pragma export reset
141#endif
142
143#ifdef _WIN32
144    BOOL APIENTRY
145    DllMain( hInst, reason, reserved )
146        HINSTANCE   hInst;		/* Library instance handle. */
147        DWORD       reason;		/* Reason this function is being called. */
148        LPVOID      reserved;	/* Not used. */
149    {
150        return TRUE;
151    }
152#endif
153
154
155#if (TCL_MAJOR_VERSION <= 8) && (TCL_MINOR_VERSION <= 3)
156#   error "Sorry, no support for 8.3 or earlier anymore"
157#endif
158
159/*
160 *----------------------------------------------------------------------
161 *
162 * Quicktimetcl_Init --
163 *
164 *		Initializer for the QuickTimeTcl package.
165 *
166 * Results:
167 *		A standard Tcl result.
168 *
169 * Side Effects:
170 *   	Tcl commands created
171 *
172 *----------------------------------------------------------------------
173 */
174#ifdef _WIN32
175    __declspec(dllexport)
176#endif
177
178int
179Quicktimetcl_Init(
180    Tcl_Interp *interp )		/* Tcl interpreter. */
181{
182 	long    version;
183 	char	*tclRunVersion;
184 	double	dtclRunVersion;
185 	double	dtclBuildVersion;
186
187#ifdef USE_TCL_STUBS
188    if (Tcl_InitStubs( interp, "8.4", 0 ) == NULL) {
189	    return TCL_ERROR;
190    }
191#endif
192#ifdef USE_TK_STUBS
193    if (Tk_InitStubs( interp, "8.4", 0 ) == NULL) {
194		return TCL_ERROR;
195    }
196#endif
197
198	/*
199     * We now require version 8.4 since we use some Tcl_FS* functions.
200	 */
201
202	tclRunVersion = Tcl_GetVar( interp, "tcl_version",
203			(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) );
204	dtclRunVersion = atof( tclRunVersion );
205	dtclBuildVersion = atof( TCL_VERSION );
206    if (dtclRunVersion < 8.4) {
207		Tcl_SetObjResult( interp, Tcl_NewStringObj(
208				"QuickTimeTcl requires tcl version 8.4 or later", -1 ));
209		return TCL_ERROR;
210	}
211
212	/*
213	 * QuickTime Installed? Version?
214	 */
215
216#ifdef _WIN32
217
218	/*
219	 * An issue: the problem with movie region not following window if moved seems
220	 * to be specific for 'InitializeQTML(0)'.
221	 * If problems with this use 'InitializeQTML( kInitializeQTMLUseGDIFlag )' instead.
222	 */
223
224    if (noErr != InitializeQTML( 0 )) {
225		Tcl_SetObjResult( interp,
226			    Tcl_NewStringObj( "Failed initialize the QuickTime Media Layer", -1 ));
227		return TCL_ERROR;
228	}
229    if (noErr != InitializeQTVR()) {
230		Tcl_SetObjResult( interp,
231			    Tcl_NewStringObj( "Failed initialize the QuickTime VR manager", -1 ));
232		return TCL_ERROR;
233	}
234#endif
235	if (noErr != Gestalt( gestaltQuickTimeVersion, &version )) {
236		Tcl_SetObjResult( interp,
237			    Tcl_NewStringObj( "QuickTime is not installed", -1 ));
238		return TCL_ERROR;
239	}
240	if (((version >> 16) & 0xffff) < MIN_QUICKTIME_VERSION) {
241		char         	cvers[30];
242
243		/*
244		 * We are running QuickTime prior to MIN_QUICKTIME_VERSION. (0x0500)
245		 */
246
247	    sprintf(cvers, "%5.2f", (double) MIN_QUICKTIME_VERSION/ (double) 0x0100);
248		Tcl_AppendStringsToObj( Tcl_GetObjResult( interp ),
249				"We require at least version ", cvers, " of QuickTime", (char *) NULL);
250		return TCL_ERROR;
251	}
252
253#if TARGET_OS_MAC
254#	if TARGET_API_MAC_CARBON
255        gQTTclTranslationEncoding = GetMacSystemEncoding();
256#   else
257        gQTTclTranslationEncoding = NULL;
258#   endif
259#else
260    gQTTclTranslationEncoding = NULL;
261#endif
262
263	/*
264	 * Create namespace and add variables.
265	 */
266
267    Tcl_Eval( interp, "namespace eval ::quicktimetcl:: {}" );
268    Tcl_SetVar( interp, "quicktimetcl::patchlevel", QTTCL_PATCH_LEVEL, TCL_GLOBAL_ONLY );
269    Tcl_SetVar( interp, "quicktimetcl::version", QTTCL_VERSION, TCL_GLOBAL_ONLY );
270    Tcl_CreateObjCommand( interp, "quicktimetcl::info", QuickTimeStat,
271    		(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
272    Tcl_CreateObjCommand( interp, "quicktimetcl::canopen", CanOpenObjCmd,
273    		(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
274    Tcl_CreateObjCommand( interp, "quicktimetcl::debuglevel", DebugLevelObjCmd,
275    		(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
276
277#if TARGET_API_MAC_CARBON
278	Tcl_CreateObjCommand( interp, "quicktimetcl::systemui", MacControlUICmd,
279			(ClientData) NULL, NULL );
280#endif
281
282    Tcl_CreateObjCommand( interp, "QuickTimeStat", QuickTimeStat, (ClientData) NULL,
283	        (Tcl_CmdDeleteProc *) NULL );
284    Tcl_CreateObjCommand( interp, "Movie", MoviePlayerObjCmd, (ClientData) NULL,
285	    	(Tcl_CmdDeleteProc *) NULL );
286    Tcl_CreateObjCommand( interp, "movie", MoviePlayerObjCmd, (ClientData) NULL,
287	    	(Tcl_CmdDeleteProc *) NULL );
288
289	/*
290	 * Preview open dialog.
291	 */
292
293    Tcl_CreateObjCommand( interp, "tk_getOpenFilePreview", GetOpenFilePreviewObjCmd,
294    	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL );
295
296	/*
297	 * Sequence grabber widget.
298	 */
299
300    Tcl_CreateObjCommand( interp, "seqgrabber", SeqGrabberObjCmd,
301	    (ClientData) NULL, NULL );
302
303#if TARGET_OS_MAC
304    Tcl_CreateObjCommand( interp, "qtbroadcast", BroadcastObjCmd,
305	    (ClientData) NULL, NULL );
306#endif
307
308    Tk_CreatePhotoImageFormat( &tkImgFmtQuickTime );
309
310    /*
311     * Link the ::quicktimetcl::debuglog variable to control debug log file.
312     */
313    Tcl_EvalEx( interp, "namespace eval ::quicktimetcl {}", -1, TCL_EVAL_GLOBAL );
314    if (Tcl_LinkVar( interp, "::quicktimetcl::debuglog",
315            (char *) &gQTTclDebugLog, TCL_LINK_BOOLEAN ) != TCL_OK) {
316        Tcl_ResetResult(interp);
317    }
318
319    return Tcl_PkgProvide( interp, "QuickTimeTcl", QTTCL_VERSION );
320}
321
322/*
323 *----------------------------------------------------------------------
324 *
325 * Quicktimetcl_SafeInit --
326 *
327 *		This is just to provide a "safe" entry point (that is not safe!).
328 *
329 * Results:
330 *		A standard Tcl result.
331 *
332 * Side Effects:
333 *   	Tcl commands created
334 *
335 *----------------------------------------------------------------------
336 */
337#ifdef _WIN32
338    __declspec(dllexport)
339#endif
340
341int
342Quicktimetcl_SafeInit(
343    Tcl_Interp *interp )		/* Tcl interpreter. */
344{
345    return Quicktimetcl_Init( interp );
346}
347
348/*
349 *----------------------------------------------------------------------
350 *
351 * QuickTimeStat
352 *
353 *		Implements the 'QuickTimeStat' command.
354 * Results:
355 *  	A standard Tcl result.
356 *
357 * Side effects:
358 *  	Depends on the subcommand, see the user documentation
359 *		for more details.
360 *
361 *----------------------------------------------------------------------
362 */
363
364int
365QuickTimeStat(
366    ClientData clientData,
367    Tcl_Interp *interp,
368    int objc,
369    Tcl_Obj *CONST objv[])
370{
371	OSErr                   err;
372	long                    response;
373	int                     iresponse;
374	int                     i;
375	char                    cvers[32];
376	CodecNameSpecListPtr    codecs = NULL;
377	Tcl_Obj                 *listObjPtr;
378	Tcl_Obj                 *codecObjPtr;
379	char      				tmpstr[STR255LEN];
380	Component               videoCodec;
381	ComponentDescription    videoCodecDesc;
382	Handle                  compName = NULL;
383	ComponentDescription    videoCodecInfo;
384    QTAtomContainer         prefs = NULL;
385    QTAtom                  prefsAtom;
386    Ptr                     atomData = NULL;
387    long                    dataSize;
388    long                    connectSpeed;
389	unsigned long			lType;
390	Tcl_DString             ds;
391
392	if ((objc <= 1) || (objc >= 4)) {
393		Tcl_WrongNumArgs( interp, 1, objv,
394				"qtversion | icversion | iccodecs | components ?type? | connectspeed" );
395	    return TCL_ERROR;
396	}
397    if ((strcmp(Tcl_GetStringFromObj( objv[1], (int *) NULL), "QTversion" ) == 0) ||
398            (strcmp(Tcl_GetStringFromObj( objv[1], (int *) NULL), "qtversion" ) == 0)) {
399
400		if (objc >= 3) {
401			Tcl_WrongNumArgs( interp, 2, objv, NULL );
402		    return TCL_ERROR;
403		}
404		err = Gestalt( gestaltQuickTimeVersion, &response );
405		if (err == noErr) {
406			iresponse = response;
407	    	sprintf(cvers, "%x", iresponse);
408	    	Tcl_SetObjResult( interp, Tcl_NewStringObj(cvers, -1) );
409	    } else {
410			Tcl_SetObjResult( interp, Tcl_NewStringObj("QuickTime is not installed", -1) );
411			return TCL_ERROR;
412		}
413	} else if ((strcmp(Tcl_GetStringFromObj( objv[1], (int *) NULL), "ICversion") == 0) ||
414            (strcmp(Tcl_GetStringFromObj( objv[1], (int *) NULL), "icversion") == 0)) {
415
416		if (objc >= 3) {
417			Tcl_WrongNumArgs( interp, 2, objv, NULL );
418		    return TCL_ERROR;
419		}
420		err = Gestalt( gestaltCompressionMgr, &response );
421		if (err == noErr) {
422			iresponse = response;
423	    	sprintf(cvers, "%x",iresponse);
424	    	Tcl_SetObjResult( interp, Tcl_NewStringObj(cvers, -1) );
425	    } else {
426			Tcl_SetObjResult( interp, Tcl_NewStringObj("Image Compressor is not installed", -1) );
427			return TCL_ERROR;
428		}
429	} else if ((strcmp(Tcl_GetStringFromObj( objv[1], (int *) NULL), "ICcodecs" ) == 0) ||
430            (strcmp(Tcl_GetStringFromObj( objv[1], (int *) NULL), "iccodecs" ) == 0)) {
431
432		if (objc >= 3) {
433			Tcl_WrongNumArgs( interp, 2, objv, NULL );
434		    return TCL_ERROR;
435		}
436		err = Gestalt( gestaltCompressionMgr, &response );
437		if (err == noErr) {
438			err = GetCodecNameList( &codecs, 1 );
439			if (err != noErr) {
440				Tcl_SetObjResult(interp, Tcl_NewStringObj("Can't get list of codecs", -1) );
441				return TCL_ERROR;
442			}
443	    	listObjPtr = Tcl_NewListObj( 0, (Tcl_Obj **) NULL );
444			for (i = 0; i < codecs->count; i++) {
445		    	codecObjPtr = Tcl_NewListObj( 0, (Tcl_Obj **) NULL );
446				memset( tmpstr, 0, STR255LEN );
447		    	Tcl_ListObjAppendElement( interp, codecObjPtr, Tcl_NewStringObj("-subtype", -1) );
448				lType = EndianU32_BtoN( codecs->list[i].cType );
449				memcpy( tmpstr, &lType, 4 );
450		    	Tcl_ListObjAppendElement( interp, codecObjPtr, Tcl_NewStringObj(tmpstr, -1) );
451				memcpy( tmpstr, &codecs->list[i].typeName, 4 );
452#if TARGET_API_MAC_CARBON
453				CopyPascalStringToC( (ConstStr255Param) tmpstr, tmpstr );
454#else
455				p2cstr( (unsigned char *) tmpstr );
456#endif
457				Tcl_ListObjAppendElement( interp, codecObjPtr, Tcl_NewStringObj("-name", -1) );
458				Tcl_ListObjAppendElement( interp, codecObjPtr, Tcl_NewStringObj(tmpstr, -1) );
459		    	Tcl_ListObjAppendElement( interp, listObjPtr, codecObjPtr );
460			}
461		    Tcl_SetObjResult( interp, listObjPtr );
462			DisposeCodecNameList(codecs);
463	    } else {
464			Tcl_SetObjResult(interp,
465				Tcl_NewStringObj("Image Compressor is not installed", -1) );
466			return TCL_ERROR;
467		}
468	} else if ((strcmp(Tcl_GetStringFromObj( objv[1], (int *) NULL ), "Components") == 0) ||
469            (strcmp(Tcl_GetStringFromObj( objv[1], (int *) NULL ), "components") == 0)) {
470
471	    listObjPtr = Tcl_NewListObj( 0, (Tcl_Obj **) NULL );
472		videoCodecDesc.componentType = 0;
473	    if (objc == 3) {
474			memcpy( &lType, Tcl_GetString( objv[2] ), 4 );
475			videoCodecDesc.componentType = EndianU32_NtoB( lType );
476		}
477		videoCodecDesc.componentSubType = 0;
478		videoCodecDesc.componentManufacturer = 0;
479		videoCodecDesc.componentFlags = 0;
480		videoCodecDesc.componentFlagsMask = 0;
481		videoCodec = FindNextComponent(NULL, &videoCodecDesc);
482		compName = NewHandle(255);
483
484		while (videoCodec != NULL) {
485			err = GetComponentInfo( videoCodec, &videoCodecInfo, compName, NULL, NULL );
486
487			if (err == noErr) {
488		    	codecObjPtr = Tcl_NewListObj( 0, (Tcl_Obj **) NULL );
489				memset( tmpstr, 0, STR255LEN );
490
491				Tcl_ListObjAppendElement( interp, codecObjPtr,
492				        Tcl_NewStringObj("-type", -1) );
493				lType = EndianU32_BtoN( videoCodecInfo.componentType );
494				memcpy( tmpstr, &lType, 4 );
495				Tcl_ListObjAppendElement( interp, codecObjPtr, Tcl_NewStringObj(tmpstr, -1) );
496
497				Tcl_ListObjAppendElement( interp, codecObjPtr,
498				        Tcl_NewStringObj("-subtype", -1) );
499				lType = EndianU32_BtoN( videoCodecInfo.componentSubType );
500				memcpy( tmpstr, &lType, 4 );
501				Tcl_ListObjAppendElement( interp, codecObjPtr, Tcl_NewStringObj(tmpstr, -1) );
502
503				Tcl_ListObjAppendElement( interp, codecObjPtr,
504				        Tcl_NewStringObj("-manufacture", -1) );
505				lType = EndianU32_BtoN( videoCodecInfo.componentManufacturer );
506				memcpy(tmpstr, &lType, 4);
507				Tcl_ListObjAppendElement( interp, codecObjPtr, Tcl_NewStringObj(tmpstr, -1) );
508
509				if (*compName) {
510
511					/* If pointer NULL then there is no name for this thing. */
512
513					HLock(compName);
514					memset( tmpstr, 0, STR255LEN );
515	    			Tcl_ListObjAppendElement( interp, codecObjPtr,
516	    			        Tcl_NewStringObj("-name", -1) );
517					memcpy( tmpstr, *compName, *compName[0] + 1 );
518#if TARGET_API_MAC_CARBON
519    				CopyPascalStringToC( (ConstStr255Param) tmpstr, tmpstr );
520#else
521    				p2cstr( (unsigned char *) tmpstr );
522#endif
523            	    Tcl_ExternalToUtfDString( gQTTclTranslationEncoding, tmpstr, -1, &ds );
524					Tcl_ListObjAppendElement( interp, codecObjPtr,
525							Tcl_NewStringObj(Tcl_DStringValue(&ds), -1) );
526            	    Tcl_DStringFree(&ds);
527					HUnlock(compName);
528				}
529		    	Tcl_ListObjAppendElement( interp, listObjPtr, codecObjPtr );
530			}
531			videoCodec = FindNextComponent( videoCodec, &videoCodecDesc );
532		}
533	    Tcl_SetObjResult( interp, listObjPtr );
534	    DisposeHandle(compName);
535
536	} else if ((strcmp(Tcl_GetStringFromObj( objv[1], (int *) NULL ), "ConnectSpeed") == 0) ||
537            (strcmp(Tcl_GetStringFromObj( objv[1], (int *) NULL ), "connectspeed") == 0)) {
538
539	    /*
540	     * Get the preferred connection speed. Note no Endian swapping needed!
541	     */
542
543		if (objc >= 3) {
544			Tcl_WrongNumArgs( interp, 2, objv, NULL );
545		    return TCL_ERROR;
546		}
547	    err = GetQuickTimePreference( 'cspd', &prefs );
548	    if (err == noErr) {
549	        prefsAtom = QTFindChildByID( prefs, kParentAtomIsContainer,
550	                'cspd', 1, NULL );
551	        if (!prefsAtom) {
552	            // Set default to 28.8
553	            connectSpeed = kDataRate288ModemRate;
554	        } else {
555	            err = QTGetAtomDataPtr( prefs, prefsAtom, &dataSize, &atomData );
556	            if (dataSize != 4) {
557	                // Wrong size; corrupt?
558	                connectSpeed = kDataRate288ModemRate;
559	            } else {
560	                connectSpeed = *(long *) atomData;
561	            }
562	        }
563	    	sprintf( tmpstr, "%ld", connectSpeed );
564	    	Tcl_SetObjResult( interp, Tcl_NewStringObj(tmpstr, -1) );
565	        QTDisposeAtomContainer( prefs );
566	    } else {
567			Tcl_SetObjResult( interp,
568				    Tcl_NewStringObj( "Failed retrieving the connection speed", -1 ) );
569			return TCL_ERROR;
570	    }
571	} else {
572    	Tcl_AppendStringsToObj( Tcl_GetObjResult(interp),
573    		    "Unrecognized option: ",
574    		    Tcl_GetStringFromObj(objv[1], (int *) NULL), (char *) NULL );
575        return TCL_ERROR;
576    }
577
578    return TCL_OK;
579}
580
581/*
582 *----------------------------------------------------------------------
583 *
584 * DebugLevelObjCmd
585 *
586 *		Gets or sets the debug level.
587 *
588 * Results:
589 *  	A standard Tcl result.
590 *
591 * Side effects:
592 *  	Switches print outs on/off.
593 *
594 *----------------------------------------------------------------------
595 */
596
597static int
598DebugLevelObjCmd(
599    ClientData clientData,
600    Tcl_Interp *interp,
601    int objc,
602    Tcl_Obj *CONST objv[])
603{
604	int		result = TCL_OK;
605
606	if (objc == 1) {
607		Tcl_SetObjResult( interp, Tcl_NewIntObj( gQTTclDebugLevel ));
608	} else if (objc == 2) {
609		if (Tcl_GetIntFromObj( interp, objv[1], &gQTTclDebugLevel ) != TCL_OK) {
610			result = TCL_ERROR;
611		}
612	} else {
613		Tcl_WrongNumArgs( interp, 1, objv, "?debugLevel?" );
614		result = TCL_ERROR;
615	}
616	return result;
617}
618/*
619 *----------------------------------------------------------------------
620 *
621 * FileMatchQuickTime
622 *
623 * Results:
624 *  	0 if the filename isn't going to be readable by QuickTime
625 * 		1 if it is, in which case widhtPtr and heightPtr are set to
626 *		the image width and height
627 *
628 * Side effects:
629 *		Image is opened
630 *
631 *----------------------------------------------------------------------
632 */
633
634int
635FileMatchQuickTime(
636        Tcl_Channel 	chan,
637        const char 		*fileName,
638        Tcl_Obj 		*format,
639        int 			*widthPtr,
640        int 			*heightPtr,
641        Tcl_Interp 		*interp )
642{
643	GraphicsImportComponent     gi;
644	Rect                        bounds;
645	FSSpec                      fss;
646
647	/*
648	 * Translate file name to FSSpec.
649	 */
650
651	if (noErr != QTTclNativePathNameToFSSpec( interp, fileName, &fss )) {
652		return 0;
653	}
654
655	/* See if QuickTime can import the file */
656	if (noErr != GetGraphicsImporterForFile( &fss, &gi)) {
657		return 0;
658	}
659
660	/* Now get it's bounds */
661	if (noErr != GraphicsImportGetNaturalBounds( gi, &bounds )) {
662		CloseComponent( gi );
663		return 0;
664	}
665	*widthPtr = bounds.right - bounds.left;
666	*heightPtr = bounds.bottom - bounds.top;
667	CloseComponent(gi);
668	return 1;
669}
670
671/*
672 *----------------------------------------------------------------------
673 *
674 * StringMatchQuickTime
675 *
676 * Results:
677 *  	0 if the data isn't going to be readable by QuickTime
678 * 		1 if it is, in which case widhtPtr and heightPtr are set to
679 *		the image width and height
680 *
681 * Side effects:
682 *		None
683 *
684 *----------------------------------------------------------------------
685 */
686
687int
688StringMatchQuickTime(
689        Tcl_Obj 	*data,
690        Tcl_Obj 	*format,
691        int 		*widthPtr,
692        int 		*heightPtr,
693        Tcl_Interp 	*interp )
694{
695    MFile handle;
696
697    /* unfinished! */
698    return 0;
699    if (!ImgReadInit( data, '\211', &handle )) {
700        return 0;
701    }
702
703    return 0;
704}
705
706/*
707 *----------------------------------------------------------------------
708 *
709 * FileReadQuickTime
710 *
711 * Results:
712 *  	A standard Tcl result.  If TCL_OK then image was sucessfuly read in
713 *		and put into imageHandle
714 *
715 * Side effects:
716 *		Image read in
717 *
718 *----------------------------------------------------------------------
719 */
720
721int
722FileReadQuickTime( Tcl_Interp *interp,
723	    Tcl_Channel chan, const char *fileName, Tcl_Obj *format,
724	    Tk_PhotoHandle imageHandle, int destX, int destY,
725	    int width, int height, int srcX, int srcY )
726{
727	GraphicsImportComponent     gi = NULL;
728	Rect                        bounds;
729    Bool						hasAlpha = false;
730	FSSpec                      fss;
731    GWorldPtr                   gWorld = NULL;
732	CGrafPtr 					saveWorld = NULL;
733	GDHandle 					saveDevice = NULL;
734    QDErr                       err = noErr;
735    PixMapHandle                pm = NULL;
736    ComponentResult				compRes = noErr;
737    RGBColor					rgbOpColor;
738    ImageDescriptionHandle		imageDesc = NULL;
739    Tk_PhotoImageBlock          imageBlock;
740	unsigned char 				*pixelPtr = NULL;
741	unsigned char 				*photoPixelsPtr = NULL;
742	short						drawsAllPixels = graphicsImporterDrawsAllPixels;
743    long						graphicsMode;
744    int							i, j;
745    int                         result = TCL_OK;
746
747	/*
748	 * Translate file name to FSSpec.
749	 */
750
751	if (noErr != QTTclNativePathNameToFSSpec( interp, fileName, &fss )) {
752		Tcl_SetObjResult( interp,
753			Tcl_NewStringObj( "Can't make a FSSpec from filename", -1 ) );
754		return TCL_ERROR;
755	}
756
757	/*
758	 * Get the proper importer.
759	 */
760
761	if (noErr != GetGraphicsImporterForFile( &fss, &gi )) {
762		Tcl_SetObjResult( interp,
763			    Tcl_NewStringObj( "No image importer found", -1 ) );
764		result = TCL_ERROR;
765		goto bail;
766	}
767
768	/* Set the bounds. */
769	bounds.top = srcY;
770	bounds.bottom = srcY + height;
771	bounds.left = srcX;
772	bounds.right = srcX + width;
773
774	/* Defines the rectangle in which to draw an image, the dest rect. */
775
776	if (noErr != GraphicsImportSetBoundsRect( gi, &bounds )) {
777		Tcl_SetObjResult( interp,
778		    	Tcl_NewStringObj( "Can't set image bounds", -1 ) );
779		result = TCL_ERROR;
780		goto bail;
781	}
782
783	/* Defines the source rectangle of the image identical to dest rect. */
784
785	if (noErr != GraphicsImportSetSourceRect( gi, &bounds )) {
786		Tcl_SetObjResult( interp,
787		    	Tcl_NewStringObj( "Can't set image bounds", -1 ) );
788		result = TCL_ERROR;
789		goto bail;
790	}
791
792	/*
793	 * Get a new GWorld to draw into.
794	 */
795
796    err = MySafeNewGWorld( &gWorld, 32, &bounds, NULL, NULL, 0 );
797    if (err != noErr) {
798        CheckAndSetErrorResult( interp, err );
799		result = TCL_ERROR;
800		goto bail;
801    }
802	GetGWorld( &saveWorld, &saveDevice );
803	SetGWorld( gWorld, NULL );
804
805	if (noErr != GraphicsImportSetGWorld( gi, gWorld, nil )) {
806		Tcl_SetObjResult( interp,
807    			Tcl_NewStringObj("Can't set GWorld", -1) );
808		result = TCL_ERROR;
809		goto bail;
810	}
811
812    /*
813     * Lock down the pixels so they don't move out from under us.
814     */
815
816    pm = GetGWorldPixMap( gWorld );
817    LockPixels( pm );
818
819    imageBlock.pixelPtr = (unsigned char *) GetPixBaseAddr( pm );
820    if (imageBlock.pixelPtr == NULL) {
821		Tcl_SetObjResult( interp,
822    			Tcl_NewStringObj( "GetPixBaseAddr failed. Likely out of memory.", -1 ) );
823  		result = TCL_ERROR;
824		goto bail;
825    }
826    imageBlock.width = width;
827    imageBlock.height = height;
828#if TARGET_API_MAC_CARBON
829    imageBlock.pitch = GetPixRowBytes( pm );
830#else
831    imageBlock.pitch = 0x3FFF & ((*pm)->rowBytes);
832#endif
833    imageBlock.pixelSize = 4;
834
835    /*
836     * Erase should fill each pixel with 00FFFFFF, which has the wrong 1st byte since
837     * 00 means completely transparent (FF is opaque).
838     */
839
840#if TARGET_API_MAC_CARBON
841    EraseRect( &bounds );
842#else
843    EraseRect( &gWorld->portRect );
844#endif
845    if (noErr != GraphicsImportGetGraphicsMode( gi, &graphicsMode, &rgbOpColor )) {
846		result = TCL_ERROR;
847    	goto bail;
848    }
849
850    /*
851     * Try to figure out if there is an original alpha channel.
852     */
853
854    if (noErr != GraphicsImportGetImageDescription( gi, &imageDesc )) {
855		result = TCL_ERROR;
856    	goto bail;
857    }
858    // We need something else for Carbon here...
859    if ((**imageDesc).depth == 32) {
860    	hasAlpha = true;
861    } else {
862        compRes = GraphicsImportDoesDrawAllPixels( gi, &drawsAllPixels );
863        if ((noErr == compRes) && (drawsAllPixels == graphicsImporterDoesntDrawAllPixels)) {
864        	hasAlpha = true;
865        }
866    }
867
868    /*
869     * The Mac pixmap stores them as "undefined (0), red, gree, blue",
870     * but tk 8.3 stores them as "red, green, blue, alpha (transparency)".
871     * If we have an alpha channel in the original image, this is written
872     * in the first byte.
873     */
874
875    imageBlock.offset[0] = 1;
876    imageBlock.offset[1] = 2;
877    imageBlock.offset[2] = 3;
878  	imageBlock.offset[3] = 0;
879
880	/* Import the file. */
881
882	if (noErr != GraphicsImportDraw( gi )) {
883		Tcl_SetObjResult( interp, Tcl_NewStringObj( "Can't import image", -1 ) );
884		result = TCL_ERROR;
885        goto bail;
886	}
887
888    if (!hasAlpha) {
889
890	    /*
891	     * Problem with transparency: the upper 8 bits in the 32 bit offscreen GWorld
892	     * doesn't correspond to an alpha channel, but is undefined. Since its content
893	     * seems to be 0, which by tk is interpreted as completely transparent, we need
894	     * to set it to 255, completely opaque.
895	     */
896
897	    for (i = 0; i < height; i++) {
898			photoPixelsPtr = imageBlock.pixelPtr + i * imageBlock.pitch;
899			pixelPtr = photoPixelsPtr;
900			for (j = 0; j < width; j++) {
901				photoPixelsPtr[0] = 0xFF;
902				photoPixelsPtr += imageBlock.pixelSize;
903	    	}
904	    }
905	}
906
907    /* The image is constructed from the photo block. */
908    Tk_PhotoPutBlock(imageHandle, &imageBlock,
909	    destX, destY, width, height, TK_PHOTO_COMPOSITE_SET );
910
911bail:
912
913	SetGWorld( saveWorld, saveDevice );
914    UnlockPixels( pm );
915	if (gWorld != NULL) {
916		DisposeGWorld( gWorld );
917	}
918	if (gi != NULL) {
919		CloseComponent( gi );
920	}
921	return result;
922}
923
924/*
925 *----------------------------------------------------------------------
926 *
927 * StringReadQuickTime
928 *
929 * Results:
930 *  	A standard Tcl result.  If TCL_OK then image was sucessfuly read in
931 *		and put into imageHandle
932 *
933 * Side effects:
934 *		Image read in
935 *
936 *----------------------------------------------------------------------
937 */
938
939int
940StringReadQuickTime(
941        Tcl_Interp 		*interp,
942        Tcl_Obj 		*dataObj,
943        Tcl_Obj 		*format,
944        Tk_PhotoHandle 	imageHandle,
945        int destX, int destY,
946        int width, int height,
947        int srcX, int srcY)
948{
949    MFile 					handle;
950    DataReferenceRecord     dataRef;
951    Handle					myHandle = NULL;
952    Handle					myDataRef = NULL;
953    ComponentInstance 		gi;
954    OSErr					err = noErr;
955    int						result = TCL_ERROR;
956
957    return TCL_ERROR;
958
959    /* Prepare reading */ /* We could use the code from Img to identify handlers */
960    ImgReadInit( dataObj, '\211', &handle );
961
962    /* Read base64 data and decode into binary */
963
964
965    /* Create a data handle reference. */
966    myHandle = NewHandleClear(0);
967    PtrToHand( &myHandle, &myDataRef, sizeof(Handle) );
968    dataRef.dataRefType = HandleDataHandlerSubType;
969    dataRef.dataRef = myDataRef;
970
971    err = GetGraphicsImporterForDataRef( myDataRef, HandleDataHandlerSubType, &gi );
972    if (err == noErr) {
973        result = TCL_OK;
974    }
975    return result;
976}
977
978/*
979 *----------------------------------------------------------------------
980 *
981 * FileWriteQuickTime
982 *
983 * 		Uses QuickTime graphics exporter to write image to file.
984 *		In case no explicit format specified uses a graphics importer
985 *		to export vis dialog.
986 *
987 * Results:
988 *  	A standard Tcl result.  If TCL_OK then image was sucessfuly written
989 *
990 * Side effects:
991 *		Image written
992 *
993 *----------------------------------------------------------------------
994 */
995
996int
997FileWriteQuickTime( Tcl_Interp *interp,
998		    const char *fileName, 			/* File name where to store image. */
999            Tcl_Obj *formatObj,				/* Any -format option, or NULL! */
1000	        Tk_PhotoImageBlock *blockPtr )
1001{
1002    int					numSubFormats = 0;
1003	int                 showDialog = 0;
1004    int					useGImporterWithDialog = 0;
1005    int 				argc;
1006	int         	    i;
1007	int         	    j;
1008	int                 pitch;
1009    Handle      	    h = NULL;
1010    PicHandle   	    thePicture = NULL;
1011	GWorldPtr   	    gw = NULL;
1012	Rect        	    r;
1013	OSType      	    fileType = 0;
1014	FSSpec      	    fss;
1015	CGrafPtr    	    saveGW = NULL;
1016	GDHandle    	    saveGD = NULL;
1017    GraphicsExportComponent ge = 0;
1018	GraphicsImportComponent gi = 0;
1019	PixMapHandle 	    pm = NULL;
1020	ModalFilterYDUPP    eventFilterProcUPP = NULL;
1021	const char          unrecognizedFormat[] = "Unrecognized format: try \
1022quicktimepict, quicktimequicktimeimage, quicktimebmp, quicktimejpeg, \
1023quicktimephotoshop, quicktimepng, quicktimetiff, quicktimesgiimage \
1024quicktimejfif, quicktimemacpaint, quicktimetargaimage ?-dialog?, or {quicktime -dialog}";
1025    typedef struct {
1026        char     	*subFormatName;
1027        OSType      osType;
1028    } MapperNameToOSType;
1029    /* Not sure that all of these actually have exporters. */
1030    MapperNameToOSType nameToOSType[] = {
1031        {"pict",               kQTFileTypePicture},
1032        {"quicktimeimage",     kQTFileTypeQuickTimeImage},
1033        {"bmp",                kQTFileTypeBMP},
1034        {"jpeg",               kQTFileTypeJPEG},
1035        {"photoshop",          kQTFileTypePhotoShop},
1036        {"dvc",                kQTFileTypeDVC},
1037        {"movie",              kQTFileTypeMovie},
1038        {"pics",               kQTFileTypePICS},
1039        {"png",                kQTFileTypePNG},
1040        {"tiff",               kQTFileTypeTIFF},
1041        {"sgiimage",           kQTFileTypeSGIImage},
1042        {"jfif",               kQTFileTypeJFIF},
1043        {"macpaint",           kQTFileTypeMacPaint},
1044        {"targaimage",         kQTFileTypeTargaImage},
1045        {"quickdrawgxpicture", kQTFileTypeQuickDrawGXPicture},
1046        {"3dmf",               kQTFileType3DMF},
1047        {"flc",                kQTFileTypeFLC},
1048        {"flash",              kQTFileTypeFlash},
1049        {"flashpix",           kQTFileTypeFlashPix},
1050        {NULL, 0}};
1051	unsigned char       *pixBaseAddr;
1052	unsigned char 	    *pixelPtr;
1053	unsigned char 	    *photoPixelsPtr;
1054	char        	    *formatPtr;
1055    char 				**argv = NULL;
1056	OSErr       	    err = noErr;
1057	ComponentResult     compErr = noErr;
1058	int                 result = TCL_OK;
1059
1060    if (Tcl_IsSafe( interp )) {
1061		Tcl_SetObjResult( interp, Tcl_NewStringObj(
1062				"imageName \"write\" not allowed in a safe interpreter", -1 ) );
1063		return TCL_ERROR;
1064    }
1065
1066    if (formatObj == NULL) {
1067        return TCL_ERROR;
1068    } else {
1069        formatPtr = Tcl_GetStringFromObj( formatObj, (int *) NULL );
1070    }
1071    if (strncmp("quicktime", formatPtr, strlen("quicktime")) != 0) {
1072		Tcl_SetObjResult( interp,
1073			Tcl_NewStringObj( unrecognizedFormat, -1 ) );
1074		return TCL_ERROR;
1075	}
1076    if (TCL_OK != Tcl_SplitList( interp, formatPtr, &argc, &argv )) {
1077		return TCL_ERROR;
1078	}
1079    if (argc > 2) {
1080		Tcl_SetObjResult( interp,
1081			Tcl_NewStringObj( unrecognizedFormat, -1 ) );
1082		return TCL_ERROR;
1083	}
1084
1085    /*
1086     * The first format argument must match the format specifier,
1087     * or "quicktime" which implies that we must have -dialog as well.
1088     */
1089
1090    if (strcmp("quicktime", argv[0]) == 0) {
1091        if (strcmp("-dialog", argv[1]) == 0) {
1092            useGImporterWithDialog = 1;
1093        } else {
1094            Tcl_SetObjResult( interp,
1095                Tcl_NewStringObj( unrecognizedFormat, -1 ) );
1096            result = TCL_ERROR;
1097            goto bail;
1098        }
1099    } else {
1100        formatPtr = argv[0];
1101        formatPtr += strlen("quicktime");
1102        numSubFormats = sizeof(nameToOSType) / sizeof(MapperNameToOSType);
1103        i = 0;
1104        while (nameToOSType[i].subFormatName != NULL) {
1105            if (strcmp(nameToOSType[i].subFormatName, formatPtr) == 0) {
1106                fileType = nameToOSType[i].osType;
1107                break;
1108            }
1109            i++;
1110        }
1111        if (i >= numSubFormats - 1) {
1112            Tcl_SetObjResult( interp,
1113                    Tcl_NewStringObj( unrecognizedFormat, -1 ) );
1114            result = TCL_ERROR;
1115            goto bail;
1116        }
1117        if (argc == 2) {
1118            if (strcmp("-dialog", argv[1]) == 0) {
1119                showDialog = 1;
1120            } else {
1121                Tcl_SetObjResult( interp,
1122                    Tcl_NewStringObj( unrecognizedFormat, -1 ) );
1123                result = TCL_ERROR;
1124                goto bail;
1125            }
1126        }
1127    }
1128
1129	/*
1130	 * Translate file name to FSSpec.
1131	 */
1132
1133    err = QTTclNativePathNameToFSSpec( interp, fileName, &fss );
1134    if ((err != fnfErr) && (err != noErr)) {
1135		Tcl_SetObjResult( interp,
1136				Tcl_NewStringObj( "Can't make a FSSpec from filename", -1 ) );
1137        result = TCL_ERROR;
1138        goto bail;
1139	}
1140	GetGWorld( &saveGW, &saveGD );
1141
1142	r.top = 0;
1143	r.left = 0;
1144	r.right = blockPtr->width;
1145	r.bottom = blockPtr->height;
1146
1147	/* Get a new GWorld to draw into. */
1148    err = MySafeNewGWorld( &gw, 32, &r, NULL, NULL, 0 );
1149	if (err != noErr) {
1150        CheckAndSetErrorResult( interp, err );
1151    	result = TCL_ERROR;
1152   		goto bail;
1153    }
1154	SetGWorld( gw, nil );
1155
1156    /*
1157     * Lock down the pixels so they don't move out from under us.
1158     */
1159
1160    pm = GetGWorldPixMap(gw);
1161    LockPixels( pm );
1162    pixBaseAddr = (unsigned char *) GetPixBaseAddr( pm );
1163#if TARGET_API_MAC_CARBON
1164    pitch = GetPixRowBytes( pm );
1165#else
1166    pitch = 0x3FFF & ((*pm)->rowBytes);
1167#endif
1168
1169    /*
1170     * Copy the pixels to the GWorld.
1171     * The Mac pixmap stores them as "dummy, red, gree, blue", but tk 8.3 stores them
1172     * as "red, green, blue, alpha (transparency)". Alpha not working.
1173     */
1174
1175	for (i = 0; i < blockPtr->height; i++) {
1176		pixelPtr = pixBaseAddr + i * pitch;
1177		photoPixelsPtr = blockPtr->pixelPtr + i * blockPtr->pitch;
1178		for (j = 0; j < blockPtr->width; j++) {
1179			*pixelPtr = *(photoPixelsPtr + blockPtr->offset[3]); pixelPtr++;
1180			*pixelPtr = *(photoPixelsPtr + blockPtr->offset[0]); pixelPtr++;
1181			*pixelPtr = *(photoPixelsPtr + blockPtr->offset[1]); pixelPtr++;
1182			*pixelPtr = *(photoPixelsPtr + blockPtr->offset[2]); pixelPtr++;
1183			photoPixelsPtr += blockPtr->pixelSize;
1184		}
1185	}
1186
1187    /*
1188     * Now is the question, a direct graphics exporter or using an
1189     * importer with dialog if no explicit format given to us.
1190     */
1191
1192    if (useGImporterWithDialog) {
1193        Tcl_Obj				*listObjPtr;
1194        ScriptCode  	    filescriptcode = smSystemScript;
1195        FSSpec      	    fssOut;
1196
1197        /* Capture the gworlds contents in a picture handle. Alpha not handled. */
1198
1199        thePicture = OpenPicture( &r );
1200#if TARGET_API_MAC_CARBON
1201        CopyBits( GetPortBitMapForCopyBits( gw ),
1202                GetPortBitMapForCopyBits( gw ),
1203                &r, &r, srcCopy, nil );
1204#else
1205        CopyBits( &((GrafPtr)gw)->portBits,
1206                &((GrafPtr)gw)->portBits,
1207                &r, &r, srcCopy, nil );
1208#endif
1209        ClosePicture();
1210
1211        /*
1212         * Convert the picture handle into a PICT file (still in a handle )
1213         * by adding a 512-byte header to the start.
1214         */
1215
1216        h = NewHandleClear(512);
1217        err = MemError();
1218        if (err) {
1219            result = TCL_ERROR;
1220            goto bail;
1221        }
1222        err = HandAndHand( (Handle) thePicture, h );
1223        err = OpenADefaultComponent( GraphicsImporterComponentType,
1224                kQTFileTypePicture, &gi );
1225        if (err) {
1226            Tcl_SetObjResult( interp,
1227                    Tcl_NewStringObj( "No image importer found for PICT files", -1 ) );
1228            result = TCL_ERROR;
1229            goto bail;
1230        }
1231        compErr = GraphicsImportSetDataHandle( gi, h );
1232        if (compErr) {
1233            Tcl_SetObjResult( interp,
1234                    Tcl_NewStringObj( "Error setting import handler", -1 ) );
1235            result = TCL_ERROR;
1236            goto bail;
1237        }
1238
1239        /* Important! */
1240        SetGWorld( saveGW, saveGD );
1241
1242#if TARGET_API_MAC_CARBON
1243        eventFilterProcUPP = NewModalFilterYDUPP( EventFilter );
1244#else
1245        eventFilterProcUPP = NewModalFilterYDProc( EventFilter );
1246#endif
1247        compErr = GraphicsImportDoExportImageFileDialog(
1248                gi,                     // component instance
1249                &fss,                   // suggesting name of file
1250                NULL,                   // use default prompt "Save As"
1251                eventFilterProcUPP,     // event filter function; not working; 2nd dialog?
1252                &fileType,              // exported file type
1253                &fssOut,                // user selected file specifier
1254                &filescriptcode );      // script system
1255#if TARGET_API_MAC_CARBON
1256        DisposeModalFilterYDUPP( eventFilterProcUPP );
1257#else
1258        DisposeRoutineDescriptor( eventFilterProcUPP );
1259#endif
1260        if (compErr == userCanceledErr) {
1261
1262            /* User canceled. */
1263            listObjPtr = Tcl_NewListObj( 0, (Tcl_Obj **) NULL );
1264            Tcl_ListObjAppendElement( interp, listObjPtr,
1265                    Tcl_NewStringObj("0", -1) );
1266            Tcl_ListObjAppendElement( interp, listObjPtr,
1267                    Tcl_NewStringObj("User canceled", -1) );
1268            Tcl_SetObjResult( interp, listObjPtr );
1269        } else if (compErr != noErr) {
1270            CheckAndSetErrorResult( interp, compErr );
1271    	    result = TCL_ERROR;
1272       		goto bail;
1273        } else {
1274            char		pathName[255];
1275
1276            result = QTTclFSSpecToNativePathName( interp, pathName, &fssOut );
1277
1278            /* User picked another file. Should we signal this by throwing an error? */
1279            Tcl_SetObjResult( interp, Tcl_NewStringObj( pathName, -1 ) );
1280        }
1281    } else {
1282
1283        /*
1284        * Find appropriate graphics export component.
1285        */
1286
1287        err = OpenADefaultComponent( GraphicsExporterComponentType, fileType, &ge );
1288        if (err != noErr) {
1289            CheckAndSetErrorResult( interp, err );
1290            result = TCL_ERROR;
1291            goto bail;
1292        }
1293        if (0 && showDialog) {
1294            /* Seems not to work... */
1295            compErr = CallComponentCanDo( ge, kGraphicsExportRequestSettingsSelect );
1296            if (compErr != noErr) {
1297                Tcl_SetObjResult( interp, Tcl_NewStringObj(
1298                        "The chosen export format does not support dialogs", -1 ) );
1299                result = TCL_ERROR;
1300                goto bail;
1301            }
1302        }
1303
1304        /* Export options. Ignore errors. */
1305        GraphicsExportSetCompressionQuality( ge, codecMaxQuality );
1306
1307        compErr = GraphicsExportSetInputPixmap( ge, pm );
1308        if (compErr != noErr) {
1309            CheckAndSetErrorResult( interp, compErr );
1310            result = TCL_ERROR;
1311            goto bail;
1312        }
1313
1314        /* Defines the output file for a graphics export operation. */
1315        compErr = GraphicsExportSetOutputFile( ge, &fss );
1316        if (compErr != noErr) {
1317            CheckAndSetErrorResult( interp, compErr );
1318            result = TCL_ERROR;
1319            goto bail;
1320        }
1321
1322        /*
1323         * Be very careful to reset the GWorld before calling the dialog,
1324         * else it will be completely blank!
1325         * Thanks to Tom Dowdy at Apple for this one!
1326         */
1327
1328        SetGWorld( saveGW, saveGD );
1329
1330        if (showDialog) {
1331#if TARGET_API_MAC_CARBON
1332            eventFilterProcUPP = NewModalFilterYDUPP( EventFilter );
1333#else
1334            eventFilterProcUPP = NewModalFilterYDProc( EventFilter );
1335#endif
1336            compErr = GraphicsExportRequestSettings( ge, eventFilterProcUPP, NULL );
1337#if TARGET_API_MAC_CARBON
1338            DisposeModalFilterYDUPP( eventFilterProcUPP );
1339#else
1340            DisposeRoutineDescriptor( eventFilterProcUPP );
1341#endif
1342            if (compErr != noErr) {
1343                CheckAndSetErrorResult( interp, compErr );
1344                result = TCL_ERROR;
1345                goto bail;
1346            }
1347        }
1348        compErr = GraphicsExportDoExport( ge, nil );
1349        if (compErr != noErr) {
1350            CheckAndSetErrorResult( interp, compErr );
1351            result = TCL_ERROR;
1352            goto bail;
1353        }
1354    }
1355
1356bail:
1357    UnlockPixels( pm );
1358	SetGWorld( saveGW, saveGD );
1359    if (argv != NULL) {
1360        Tcl_Free( (char *) argv );
1361    }
1362	if (ge != NULL) {
1363		CloseComponent( ge );
1364	}
1365	if (gi != NULL) {
1366		CloseComponent( gi );
1367	}
1368	if (thePicture != NULL) {
1369		KillPicture( thePicture );
1370	}
1371	if (h != NULL) {
1372		DisposeHandle( h );
1373	}
1374	if (gw != NULL) {
1375		DisposeGWorld( gw );
1376	}
1377	return result;
1378}
1379
1380/*
1381 *----------------------------------------------------------------------
1382 *
1383 * GetOpenFilePreviewObjCmd --
1384 *
1385 *		Calls the QuickTime file open dialog for the user to choose a
1386 *		movie file to open.
1387 *
1388 * Results:
1389 *		A standard Tcl result.
1390 *
1391 * Side effects:
1392 *		If the user selects a file, the native pathname of the file
1393 *		is returned in the interp's result. Otherwise an empty string
1394 *		is returned in the interp's result.
1395 *
1396 *----------------------------------------------------------------------
1397 */
1398
1399int
1400GetOpenFilePreviewObjCmd(
1401    ClientData clientData,	/* Main window associated with interpreter. */
1402    Tcl_Interp *interp,		/* Current interpreter. */
1403    int objc,				/* Number of arguments. */
1404    Tcl_Obj *CONST objv[])	/* Argument objects. */
1405{
1406    OSType                      typeList = kQTFileTypeMovie;
1407    FSSpec                      theFSSpec;
1408    Boolean						sfGood = false;
1409	OSErr                       err = noErr;
1410#if TARGET_OS_MAC
1411    AEDesc                      initialDesc = {typeNull, NULL};
1412    Str255 						title = "\p";
1413#endif
1414	char						pathname[256];
1415	Tcl_Obj						*resultObjPtr = NULL;
1416	int                         result = TCL_OK;
1417
1418	/* A few of the file types QuickTime can open. */
1419	OSType          typeListPtr[] = {FOUR_CHAR_CODE('MooV'), FOUR_CHAR_CODE('TEXT'),
1420	                                FOUR_CHAR_CODE('PICT'), FOUR_CHAR_CODE('JPEG'),
1421	                                FOUR_CHAR_CODE('PNGf'), FOUR_CHAR_CODE('PNG '),
1422	                                FOUR_CHAR_CODE('TIFF'), FOUR_CHAR_CODE('GIFf'),
1423	                                FOUR_CHAR_CODE('PLAY'), FOUR_CHAR_CODE('WAVE'),
1424	                                FOUR_CHAR_CODE('SWFL'), FOUR_CHAR_CODE('SWF '),
1425	                                FOUR_CHAR_CODE('MPEG'), FOUR_CHAR_CODE('MP3 '),
1426	                                FOUR_CHAR_CODE('ULAW'), FOUR_CHAR_CODE('WAV '),
1427	                                FOUR_CHAR_CODE('AIFF'), FOUR_CHAR_CODE('AIFC'),
1428	                                FOUR_CHAR_CODE('Midi'), FOUR_CHAR_CODE('BMP ')
1429	                                };
1430
1431	/*
1432	 * Just adds the usual options for a possible future implementation.
1433	 */
1434
1435    static char *openOptionStrings[] = {
1436	    "-defaultextension", "-filetypes",
1437	    "-initialdir", "-initialfile", "-title", NULL
1438    };
1439    enum openOptions {
1440	    OPEN_DEFAULT, OPEN_TYPES,
1441	    OPEN_INITDIR, OPEN_INITFILE, OPEN_TITLE
1442    };
1443
1444#if TARGET_OS_MAC
1445    {
1446        int     i;
1447
1448        for (i = 1; i < objc; i += 2) {
1449            char    *choice;
1450        	int     index, choiceLen;
1451            int 	srcRead, dstWrote;
1452            FSSpec  dirSpec;
1453
1454        	if (Tcl_GetIndexFromObj( interp, objv[i], openOptionStrings, "option",
1455        		    TCL_EXACT, &index ) != TCL_OK) {
1456        	    result = TCL_ERROR;
1457        	    goto end;
1458        	}
1459        	if (i + 1 == objc) {
1460        		resultObjPtr = Tcl_GetObjResult( interp );
1461        		Tcl_AppendStringsToObj( resultObjPtr, "value for \"",
1462        				Tcl_GetString(objv[i]), "\"missing", (char *) NULL );
1463        	    result = TCL_ERROR;
1464        	    goto end;
1465        	}
1466
1467        	switch (index) {
1468#if !TARGET_API_MAC_CARBON		// Classic
1469        	    case OPEN_INITDIR:
1470                    choice = Tcl_GetStringFromObj(objv[i + 1], NULL);
1471                    if (HandleInitialDirectory( interp, choice, &dirSpec, &initialDesc )
1472                            != TCL_OK) {
1473                        result = TCL_ERROR;
1474                        goto end;
1475                    }
1476        	        break;
1477#endif
1478                case OPEN_TITLE:
1479                    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
1480                    Tcl_UtfToExternal(NULL, gQTTclTranslationEncoding, choice, choiceLen,
1481                            0, NULL, StrBody(title), 255,
1482                            &srcRead, &dstWrote, NULL);
1483                    title[0] = dstWrote;
1484                    break;
1485            }
1486        }
1487    }
1488#endif
1489
1490	/*
1491	 * Open standard preview dialog for movies and other QT files. -1 lists all!
1492	 */
1493
1494#if TARGET_OS_MAC
1495#if TARGET_API_MAC_CARBON	// Mac OS X
1496    err = GetOneFileWithPreview( &initialDesc, 20, typeListPtr, title, &theFSSpec, NULL );
1497    if (err == noErr) {
1498        sfGood = true;
1499    }
1500#else	// Classic
1501	if (TkMacHaveAppearance() && NavServicesAvailable()) {
1502    	err = GetOneFileWithPreview( &initialDesc, 20, typeListPtr, title, &theFSSpec, NULL );
1503    	if (err == noErr) {
1504            sfGood = true;
1505    	}
1506    } else {
1507        SFTypeList 					types = {MovieFileType, 0, 0, 0};
1508        StandardFileReply			reply;
1509
1510	    StandardGetFilePreview( NULL, -1, types, &reply );
1511	    theFSSpec = reply.sfFile;
1512	}
1513#endif
1514#endif  // TARGET_OS_MAC
1515
1516#ifdef _WIN32
1517    {
1518        SFTypeList 					types = {MovieFileType, 0, 0, 0};
1519        StandardFileReply			reply;
1520
1521        StandardGetFilePreview( NULL, -1, types, &reply );
1522        theFSSpec = reply.sfFile;
1523        sfGood = reply.sfGood;
1524    }
1525#endif  // _WIN32
1526
1527    if ((err == noErr) && sfGood) {
1528
1529		/*
1530		 * Translate mac file system specification to path name.
1531		 */
1532
1533		result = QTTclFSSpecToNativePathName( interp, pathname, &theFSSpec );
1534	} else {
1535
1536	    /* Cancel button pressed. */
1537	    Tcl_SetObjResult( interp, Tcl_NewStringObj("", -1) );
1538	}
1539
1540#if TARGET_OS_MAC
1541
1542end:
1543    AEDisposeDesc( &initialDesc );
1544#endif
1545	return result;
1546}
1547
1548/*
1549 *-----------------------------------------------------------------------------
1550 *
1551 * EventFilter --
1552 *
1553 *		Callback for movable alert dialog.
1554 *
1555 * Results:
1556 *		A standard Tcl result.
1557 *
1558 * Side effects:
1559 *		Update events to background windows handled.
1560 *
1561 *-----------------------------------------------------------------------------
1562 */
1563
1564pascal Boolean
1565EventFilter(
1566        DialogPtr       dialogPtr,
1567        EventRecord     *eventStructPtr,
1568        SInt16          *itemHit,
1569        void            *doNotKnow )
1570{
1571#if TARGET_OS_MAC
1572    Boolean         handledEvent = false;
1573    GrafPtr         oldPort;
1574
1575#if TARGET_API_MAC_CARBON
1576    if((eventStructPtr->what == updateEvt) &&
1577            ((WindowPtr) eventStructPtr->message != NULL) &&
1578            ((WindowPtr) eventStructPtr->message != GetDialogWindow( dialogPtr ))) {
1579#else
1580    if((eventStructPtr->what == updateEvt) &&
1581            ((WindowPtr) eventStructPtr->message != NULL) &&
1582            ((WindowPtr) eventStructPtr->message != dialogPtr)) {
1583
1584		/*
1585		 * Handle update events to background windows here.
1586		 * First, translate mac event to a number of tcl events.
1587		 * If any tcl events generated, execute them until empty, and don't wait.
1588		 */
1589
1590		if (TkMacConvertEvent( eventStructPtr )) {
1591			while ( Tcl_DoOneEvent( TCL_IDLE_EVENTS | TCL_DONT_WAIT | TCL_WINDOW_EVENTS ) )
1592				/* empty */
1593				;
1594		}
1595#endif
1596
1597    } else {
1598        GetPort( &oldPort );
1599#if TARGET_API_MAC_CARBON
1600        SetPortDialogPort( dialogPtr );
1601#else
1602        SetPort( dialogPtr );
1603#endif
1604        handledEvent = StdFilterProc( dialogPtr, eventStructPtr, itemHit );
1605        SetPort( oldPort );
1606    }
1607    return( handledEvent );
1608#endif  // TARGET_OS_MAC
1609
1610#ifdef _WIN32
1611    return false;
1612#endif  // _WIN32
1613}
1614
1615#if TARGET_OS_MAC && !TARGET_API_MAC_CARBON	// Classic
1616
1617int
1618HandleInitialDirectory(
1619    Tcl_Interp *interp,
1620    char *initialDir,
1621    FSSpec *dirSpec,
1622    AEDesc *dirDescPtr)
1623{
1624	Tcl_DString     ds;
1625	long            dirID;
1626	OSErr           err;
1627	Boolean         isDirectory;
1628	Str255          dir;
1629	int             srcRead, dstWrote;
1630
1631	if (Tcl_TranslateFileName( interp, initialDir, &ds ) == NULL) {
1632	    return TCL_ERROR;
1633	}
1634	Tcl_UtfToExternal( NULL, gQTTclTranslationEncoding, Tcl_DStringValue(&ds),
1635    		Tcl_DStringLength(&ds), 0, NULL, StrBody(dir), 255,
1636    		&srcRead, &dstWrote, NULL );
1637        StrLength(dir) = (unsigned char) dstWrote;
1638	Tcl_DStringFree(&ds);
1639
1640	err = FSpLocationFromPath( StrLength(dir), StrBody(dir), dirSpec );
1641	if (err != noErr) {
1642	    Tcl_AppendResult( interp, "bad directory \"", initialDir, "\"", NULL );
1643	    return TCL_ERROR;
1644	}
1645	err = FSpGetDirectoryIDTcl( dirSpec, &dirID, &isDirectory );
1646	if ((err != noErr) || !isDirectory) {
1647	    Tcl_AppendResult( interp, "bad directory \"", initialDir, "\"", NULL );
1648	    return TCL_ERROR;
1649	}
1650    AECreateDesc( typeFSS, dirSpec, sizeof(*dirSpec), dirDescPtr );
1651    return TCL_OK;
1652}
1653#endif  // Classic
1654
1655/*
1656 *----------------------------------------------------------------------
1657 *
1658 * CanOpenObjCmd --
1659 *
1660 *		Investigates if file may be opened by QuickTime.
1661 *      '::quicktimetcl::canopen fileName ?-type graphics|movie -allownewfile 0|1
1662 *              -allowall 0|1?'
1663 *
1664 * Results:
1665 *		A standard Tcl result.
1666 *
1667 * Side effects:
1668 *		None.
1669 *
1670 *----------------------------------------------------------------------
1671 */
1672
1673int
1674CanOpenObjCmd(
1675    ClientData  clientData,
1676    Tcl_Interp  *interp,		/* Current interpreter. */
1677    int         objc,		    /* Number of arguments. */
1678    Tcl_Obj     *CONST objv[])	/* Argument objects. */
1679{
1680    int             result = TCL_OK;
1681	OSStatus	    err;
1682	FSSpec 			fss;
1683	Boolean         withGrahicsImporter = false;
1684	Boolean         *withGrahicsImporterPtr;
1685	Boolean         asMovie = false;
1686	Boolean         *asMoviePtr;
1687	Boolean         preferGraphicsImporter;
1688	UInt32          flags = 0;
1689	int             canOpen = 0;
1690	int             iarg;
1691	int             optIndex;
1692	int             oneInt;
1693	char            *type;
1694	Tcl_Obj			*resultObjPtr;
1695	char            usage[] = "fileName ?-type graphics|movie -allownewfile 0|1 -allowall 0|1?";
1696
1697    if (objc < 2) {
1698		Tcl_WrongNumArgs( interp, 1, objv, usage );
1699	    return TCL_ERROR;
1700    }
1701	err = QTTclNativePathNameToFSSpec( interp, Tcl_GetString(objv[1]), &fss );
1702	if (err == fnfErr) {
1703        Tcl_SetObjResult( interp, Tcl_NewStringObj("File not found ", -1) );
1704		return TCL_ERROR;
1705	} else if (err != noErr) {
1706        Tcl_SetObjResult( interp, Tcl_NewStringObj("Unable to make a FSSpec from file", -1) );
1707		return TCL_ERROR;
1708	}
1709	withGrahicsImporterPtr = &withGrahicsImporter;
1710	asMoviePtr = &asMovie;
1711
1712    for (iarg = 2; iarg < objc; iarg += 2) {
1713
1714    	if (Tcl_GetIndexFromObj( interp, objv[iarg], allCanOpenOptions,
1715    	        "canopen option", TCL_EXACT, &optIndex ) != TCL_OK ) {
1716    	    result = TCL_ERROR;
1717    	    goto done;
1718    	}
1719    	if (iarg + 1 == objc) {
1720    		resultObjPtr = Tcl_GetObjResult( interp );
1721    		Tcl_AppendStringsToObj( resultObjPtr, "value for \"",
1722    				Tcl_GetString(objv[iarg]), "\"missing", (char *) NULL );
1723    	    result = TCL_ERROR;
1724    	    goto done;
1725    	}
1726
1727        /*
1728         * Dispatch the option to the right branch.
1729         */
1730
1731        switch(optIndex) {
1732
1733            case kCanOpenOptionAllowAll: {
1734                if (TCL_OK != Tcl_GetBooleanFromObj( interp, objv[iarg+1], &oneInt )) {
1735					Tcl_AddErrorInfo( interp,
1736							"\n	(processing -allowall option)" );
1737            	    result = TCL_ERROR;
1738            	    goto done;
1739                }
1740                if (oneInt) {
1741                    flags |= kQTAllowAggressiveImporters;
1742                }
1743                break;
1744            }
1745
1746            case kCanOpenOptionAllowNewFile: {
1747                if (TCL_OK != Tcl_GetBooleanFromObj( interp, objv[iarg+1], &oneInt )) {
1748					Tcl_AddErrorInfo( interp,
1749							"\n	(processing -allownewfile option)" );
1750            	    result = TCL_ERROR;
1751            	    goto done;
1752                }
1753                if (oneInt) {
1754                    flags |= kQTAllowImportersThatWouldCreateNewFile;
1755                }
1756                break;
1757            }
1758
1759            case kCanOpenOptionType: {
1760                type = Tcl_GetStringFromObj( objv[iarg+1], (int *) NULL);
1761            	if (strcmp(type, "graphics" ) == 0) {
1762            	    asMoviePtr = NULL;
1763                } else if (strcmp( type, "movie" ) == 0) {
1764                    withGrahicsImporterPtr = NULL;
1765                } else {
1766                    Tcl_SetObjResult( interp,
1767                            Tcl_NewStringObj("Error: use -type graphics|movie", -1) );
1768            	    result = TCL_ERROR;
1769            	    goto done;
1770                }
1771                break;
1772            }
1773        }
1774    }
1775
1776    err = CanQuickTimeOpenFile( &fss, 0, 0, withGrahicsImporterPtr, asMoviePtr,
1777            &preferGraphicsImporter, flags );
1778    if (err != noErr) {
1779        Tcl_SetObjResult( interp, Tcl_NewStringObj("CanQuickTimeOpenFile failed", -1) );
1780		return TCL_ERROR;
1781	}
1782
1783	if (withGrahicsImporter || asMovie) {
1784	    canOpen = 1;
1785	}
1786    Tcl_SetObjResult( interp, Tcl_NewIntObj(canOpen) );
1787
1788done:
1789
1790	return result;
1791}
1792
1793/*
1794 *-------------------------------------------------------------------------
1795 * ImgReadInit --
1796 *  This procedure initializes a base64 decoder handle for reading.
1797 *
1798 * Results:
1799 *  none
1800 *
1801 * Side effects:
1802 *  the base64 handle is initialized
1803 *
1804 *-------------------------------------------------------------------------
1805 */
1806
1807int
1808ImgReadInit( Tcl_Obj *data,		/* string containing initial mmencoded data */
1809        int	c,
1810        MFile *handle )			/* mmdecode "file" handle */
1811{
1812    handle->data = Tcl_GetByteArrayFromObj( data, &handle->length );
1813    if (*handle->data == c) {
1814        handle->state = IMG_STRING;
1815        return 1;
1816    }
1817    c = base64_table[(c>>2)&63];
1818
1819    while( (handle->length) && (char64(*handle->data) == IMG_SPACE) ) {
1820        handle->data++;
1821        handle->length--;
1822    }
1823    if (c != *handle->data) {
1824        handle->state = IMG_DONE;
1825        return 0;
1826    }
1827    handle->state = 0;
1828    return 1;
1829}
1830
1831/*
1832 *--------------------------------------------------------------------------
1833 * ImgRead --
1834 *
1835 *  This procedure returns a buffer from the stream input. This stream
1836 *  could be anything from a base-64 encoded string to a Channel.
1837 *
1838 * Results:
1839 *  The number of characters successfully read from the input
1840 *
1841 * Side effects:
1842 *  The MFile state could change.
1843 *--------------------------------------------------------------------------
1844 */
1845
1846int
1847ImgRead(handle, dst, count)
1848    MFile *handle;	/* mmdecode "file" handle */
1849    char *dst;		/* where to put the result */
1850    int count;		/* number of bytes */
1851{
1852    register int i, c;
1853
1854    switch (handle->state) {
1855        case IMG_STRING:
1856            if (count > handle->length) {
1857                count = handle->length;
1858            }
1859            if (count) {
1860                memcpy(dst, handle->data, count);
1861                handle->length -= count;
1862                handle->data += count;
1863            }
1864            return count;
1865        case IMG_CHAN:
1866            return Tcl_Read((Tcl_Channel) handle->data, dst, count);
1867    }
1868
1869    for (i = 0; i < count && (c = ImgGetc(handle)) != IMG_DONE; i++) {
1870        *dst++ = c;
1871    }
1872    return i;
1873}
1874
1875/*
1876 *--------------------------------------------------------------------------
1877 *
1878 * ImgGetc --
1879 *
1880 *  This procedure returns the next input byte from a stream. This stream
1881 *  could be anything from a base-64 encoded string to a Channel.
1882 *
1883 * Results:
1884 *  The next byte (or IMG_DONE) is returned.
1885 *
1886 * Side effects:
1887 *  The MFile state could change.
1888 *
1889 *--------------------------------------------------------------------------
1890 */
1891
1892int
1893ImgGetc( MFile *handle )	/* Input stream handle */
1894{
1895    int c;
1896    int result = 0;			/* Initialization needed only to prevent
1897                             * gcc compiler warning */
1898    if (handle->state == IMG_DONE) {
1899        return IMG_DONE;
1900    }
1901
1902    if (handle->state == IMG_STRING) {
1903        if (!handle->length--) {
1904            handle->state = IMG_DONE;
1905            return IMG_DONE;
1906        }
1907        return *handle->data++;
1908    }
1909
1910    do {
1911        if (!handle->length--) {
1912            handle->state = IMG_DONE;
1913            return IMG_DONE;
1914        }
1915        c = char64(*handle->data++);
1916    } while (c == IMG_SPACE);
1917
1918    if (c > IMG_SPECIAL) {
1919        handle->state = IMG_DONE;
1920        return IMG_DONE;
1921    }
1922
1923    switch (handle->state++) {
1924        case 0:
1925            handle->c = c<<2;
1926            result = ImgGetc(handle);
1927            break;
1928        case 1:
1929            result = handle->c | (c>>4);
1930            handle->c = (c&0xF)<<4;
1931            break;
1932        case 2:
1933            result = handle->c | (c>>2);
1934            handle->c = (c&0x3)<<6;
1935            break;
1936        case 3:
1937            result = handle->c | c;
1938            handle->state = 0;
1939            break;
1940    }
1941    return result;
1942}
1943
1944/*
1945 *--------------------------------------------------------------------------
1946 * char64 --
1947 *
1948 *	This procedure converts a base64 ascii character into its binary
1949 *	equivalent. This code is a slightly modified version of the
1950 *	char64 proc in N. Borenstein's metamail decoder.
1951 *
1952 * Results:
1953 *	The binary value, or an error code.
1954 *
1955 * Side effects:
1956 *	None.
1957 *--------------------------------------------------------------------------
1958 */
1959
1960static int
1961char64(c)
1962    int c;
1963{
1964    switch(c) {
1965	case 'A': return 0;	case 'B': return 1;	case 'C': return 2;
1966	case 'D': return 3;	case 'E': return 4;	case 'F': return 5;
1967	case 'G': return 6;	case 'H': return 7;	case 'I': return 8;
1968	case 'J': return 9;	case 'K': return 10;	case 'L': return 11;
1969	case 'M': return 12;	case 'N': return 13;	case 'O': return 14;
1970	case 'P': return 15;	case 'Q': return 16;	case 'R': return 17;
1971	case 'S': return 18;	case 'T': return 19;	case 'U': return 20;
1972	case 'V': return 21;	case 'W': return 22;	case 'X': return 23;
1973	case 'Y': return 24;	case 'Z': return 25;	case 'a': return 26;
1974	case 'b': return 27;	case 'c': return 28;	case 'd': return 29;
1975	case 'e': return 30;	case 'f': return 31;	case 'g': return 32;
1976	case 'h': return 33;	case 'i': return 34;	case 'j': return 35;
1977	case 'k': return 36;	case 'l': return 37;	case 'm': return 38;
1978	case 'n': return 39;	case 'o': return 40;	case 'p': return 41;
1979	case 'q': return 42;	case 'r': return 43;	case 's': return 44;
1980	case 't': return 45;	case 'u': return 46;	case 'v': return 47;
1981	case 'w': return 48;	case 'x': return 49;	case 'y': return 50;
1982	case 'z': return 51;	case '0': return 52;	case '1': return 53;
1983	case '2': return 54;	case '3': return 55;	case '4': return 56;
1984	case '5': return 57;	case '6': return 58;	case '7': return 59;
1985	case '8': return 60;	case '9': return 61;	case '+': return 62;
1986	case '/': return 63;
1987
1988	case ' ': case '\t': case '\n': case '\r': case '\f': return IMG_SPACE;
1989	case '=': return IMG_PAD;
1990	case '\0': return IMG_DONE;
1991	default: return IMG_BAD;
1992    }
1993}
1994
1995/*--------------------------------------------------------------------------------*/
1996