1 /*
2
3 *****************************************************************************
4 * Author: *
5 * ------ *
6 * Anton Kokalj Email: Tone.Kokalj@ijs.si *
7 * Department of Physical and Organic Chemistry Phone: x 386 1 477 3523 *
8 * Jozef Stefan Institute Fax: x 386 1 477 3811 *
9 * Jamova 39, SI-1000 Ljubljana *
10 * SLOVENIA *
11 * *
12 * Source: $XCRYSDEN_TOPDIR/C/ppmPrintTogl.c
13 * ------ *
14 * Copyright (c) 1996-2003 by Anton Kokalj *
15 *****************************************************************************
16
17 */
18 #include <stdio.h>
19 #include <stdlib.h>
20 #include <string.h>
21 #include <togl.h>
22 #include "struct.h"
23 #include "xcfunc.h"
24
25 extern struct Togl *mesa_togl;
26 extern const char *printImage;
27 static int FileWritePPM(Tcl_Interp *interp, const char *fileName, Tk_PhotoImageBlock *blockPtr);
28
29 /* --- xcDisplayFunc.c --- */
30 extern void (*xcDisplay)(struct Togl *togl);
31
32 /*
33 * this function takes care of PPM
34 *
35 * Usage: xc_dump2ppm toglName filename
36 */
37 int
CRY_Dump2PpmCb(ClientData clientData,Tcl_Interp * interp,int argc,const char * argv[])38 CRY_Dump2PpmCb(ClientData clientData, Tcl_Interp *interp, int argc, const char *argv[])
39 {
40 Togl *togl;
41
42 if ( Togl_GetToglFromName(interp, argv[1], &togl) == TCL_ERROR ) {
43 char rss[1024];
44 snprintf(rss, sizeof(rss),
45 "couldn't find %s togl widget", argv[3]);
46 Tcl_SetResult(interp, rss, TCL_VOLATILE);
47 return TCL_ERROR;
48 }
49
50 if ( argc != 3 ) {
51 Tcl_SetResult(interp, "Usage: xc_dump2ppm toglName filename", TCL_STATIC);
52 return TCL_ERROR;
53 }
54
55 /* /\* check if togl is .mesa or something else ... *\/ */
56 /* if ( togl == mesa_togl ) { */
57 /* Togl_DumpToPpmFile( togl, argv[2] ); */
58 /* } else { */
59 /* /\*NEW_WIN_CONTEXT *wc; */
60 /* wc = FindWinContextByTogl( togl );*\/ */
61 /* Togl_DumpToPpmFile( togl, argv[2] ); */
62 /* } */
63
64 Togl_DumpToPpmFile( togl, argv[2] );
65
66 return TCL_OK;
67 }
68
69
Togl_DumpToPpmFile(Togl * togl,const char * filename)70 int Togl_DumpToPpmFile(Togl *togl, const char *filename)
71 {
72 Tcl_Interp *interp = Togl_Interp(togl);
73 /*ClientData clientData = Togl_GetClientData(togl);*/
74 Tk_PhotoHandle photo;
75 Tk_PhotoImageBlock blockPtr;
76
77 photo = Tk_FindPhoto(interp, printImage);
78
79 if (photo == NULL) {
80 Tcl_AppendResult(interp, "image \"", printImage,
81 "\" doesn't exist or is not a photo image", NULL);
82 return TCL_ERROR;
83 }
84
85 Togl_TakePhoto(togl, photo);
86 Tk_PhotoGetImage(photo, &blockPtr);
87 FileWritePPM(interp, filename, &blockPtr);
88
89 return TCL_OK;
90 }
91
92
93 /*************************************************************************
94
95 The below "FileWritePPM" routine is taken from tk8.6 sources, in
96 particular from file "tk8.6.9/generic/tkImgPPM.c"
97
98 *************************************************************************/
99
100 /*
101 *----------------------------------------------------------------------
102 *
103 * FileWritePPM --
104 *
105 * This function is invoked to write image data to a file in PPM format
106 * (although we can read PGM files, we never write them).
107 *
108 * Results:
109 * A standard TCL completion code. If TCL_ERROR is returned then an error
110 * message is left in the interp's result.
111 *
112 * Side effects:
113 * Data is written to the file given by "fileName".
114 *
115 * Copyright (c) 1994 The Australian National University.
116 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
117 *
118 * See the file "$XCRYSDEN_TOPDIR/otherLICENSES/TclTk:LICENSE" for
119 * information on usage and redistribution of this file, and for a
120 * DISCLAIMER OF ALL WARRANTIES.
121 *
122 * Author: Paul Mackerras (paulus@cs.anu.edu.au),
123 * Department of Computer Science,
124 * Australian National University.
125 */
126
127 static int
FileWritePPM(Tcl_Interp * interp,const char * fileName,Tk_PhotoImageBlock * blockPtr)128 FileWritePPM(Tcl_Interp *interp,
129 const char *fileName,
130 Tk_PhotoImageBlock *blockPtr)
131 {
132 Tcl_Channel chan;
133 int w, h, greenOffset, blueOffset, nBytes;
134 unsigned char *pixelPtr, *pixLinePtr;
135 char header[16 + TCL_INTEGER_SPACE * 2];
136
137 chan = Tcl_OpenFileChannel(interp, fileName, "w", 0666);
138 if (chan == NULL) {
139 return TCL_ERROR;
140 }
141
142 if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
143 != TCL_OK) {
144 Tcl_Close(NULL, chan);
145 return TCL_ERROR;
146 }
147 if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
148 != TCL_OK) {
149 Tcl_Close(NULL, chan);
150 return TCL_ERROR;
151 }
152
153 sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);
154 Tcl_Write(chan, header, -1);
155
156 pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
157 greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
158 blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
159
160 if ((greenOffset == 1) && (blueOffset == 2) && (blockPtr->pixelSize == 3)
161 && (blockPtr->pitch == (blockPtr->width * 3))) {
162 nBytes = blockPtr->height * blockPtr->pitch;
163 if (Tcl_Write(chan, (char *) pixLinePtr, nBytes) != nBytes) {
164 goto writeerror;
165 }
166 } else {
167 for (h = blockPtr->height; h > 0; h--) {
168 pixelPtr = pixLinePtr;
169 for (w = blockPtr->width; w > 0; w--) {
170 if ( Tcl_Write(chan,(char *)&pixelPtr[0], 1) == -1 ||
171 Tcl_Write(chan,(char *)&pixelPtr[greenOffset],1)==-1 ||
172 Tcl_Write(chan,(char *)&pixelPtr[blueOffset],1) ==-1) {
173 goto writeerror;
174 }
175 pixelPtr += blockPtr->pixelSize;
176 }
177 pixLinePtr += blockPtr->pitch;
178 }
179 }
180
181 if (Tcl_Close(NULL, chan) == 0) {
182 return TCL_OK;
183 }
184 chan = NULL;
185
186 writeerror:
187 Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
188 fileName, Tcl_PosixError(interp)));
189 if (chan != NULL) {
190 Tcl_Close(NULL, chan);
191 }
192 return TCL_ERROR;
193 }
194