'From Squeak3.2alpha of 30 October 2001 [latest update: #4632] on 21 December 2001 at 8:18:27 pm'! "Change Set: JPEGUpdates-jmv Date: 21 December 2001 Author: Juan Manuel Vuletich Note: These changes include a change to the primitive interface. You will need to update your JPEGReadWriter2Plugin after filing in these changes. This changeset combines several sets of updates to JPEGReadWriter2 and it's plugin. In addition to changes from Juan Manuel Vuletich, it includes some fixes from Yoshiki Ohshima, some tweaks to make the C compiler happy from John McIntosh, and entry points allowing one to specify the quality and progression flag parameters when creating a JPEG from Robert Hirschfeld. New plugin features from Juan Manuel: Avoids generating Color transparent instead of Color black. Adds optional dithering when decompressing into a 16bit form. Includes the C support code files needed in addition to JPEG Lib. Includes several minor fixes and enhancements."! !JPEGReadWriter2Plugin commentStamp: '' prior: 0! This work is a Squeak VM Plugin version of LibJPEG. The following sentence applies to this class: "This software is based in part on the work of the Independent JPEG Group". You can read more about it at www.ijg.org In addition to the code generated from this class, the plugin uses the following files (from LibJPEG ver. 6b): jerror.c jcmarker.c jdmarker.c jctrans.c jcparam.c jdapimin.c jcapimin.c jidctred.c jidctflt.c jidctfst.c jidctint.c jccoefct.c jdinput.c jdmaster.c jdcoefct.c jdhuff.c jdphuff.c jcphuff.c jchuff.c jcomapi.c jcinit.c jcmaster.c jdcolor.c jdtrans.c jmemmgr.c jutils.c jddctmgr.c jcdctmgr.c jquant2.c jquant1.c jmemnobs.c jfdctint.c jfdctfst.c jfdctflt.c jdsample.c jdpostct.c jdmerge.c jdmainct.c jdapistd.c jcsample.c jcprepct.c jcmainct.c jccolor.c jcapistd.c jversion.h jpeglib.h jdhuff.h jchuff.h jerror.h jmorecfg.h jmemsys.h jpegint.h jdct.h jinclude.h ! !JPEGReadWriter2 methodsFor: 'public access' stamp: 'jmv 12/7/2001 17:13'! nextImageSuggestedDepth: depth "Decode and answer a Form of the given depth from my stream. Close the stream if it is a file stream. Possible depths are 16-bit and 32-bit." | bytes width height form jpegDecompressStruct jpegErrorMgr2Struct depthToUse | bytes _ stream upToEnd. (stream respondsTo: #close) ifTrue: [stream close]. jpegDecompressStruct _ ByteArray new: self primJPEGDecompressStructSize. jpegErrorMgr2Struct _ ByteArray new: self primJPEGErrorMgr2StructSize. self primJPEGReadHeader: jpegDecompressStruct fromByteArray: bytes errorMgr: jpegErrorMgr2Struct. width _ self primImageWidth: jpegDecompressStruct. height _ self primImageHeight: jpegDecompressStruct. "Odd width images of depth 16 gave problems. Avoid them (or check carefully!!)" depthToUse _ ((depth = 32) | width odd) ifTrue: [32] ifFalse: [16]. form _ Form extent: width@height depth: depthToUse. (width = 0 or: [height = 0]) ifTrue: [^ form]. self primJPEGReadImage: jpegDecompressStruct fromByteArray: bytes onForm: form doDithering: true errorMgr: jpegErrorMgr2Struct. ^ form ! ! !JPEGReadWriter2 methodsFor: 'public access' stamp: 'jmv 12/7/2001 13:49'! uncompress: aByteArray into: aForm "Uncompress an image from the given ByteArray into the given Form. Fails if the given Form has the wrong dimensions or depth. If aForm has depth 16, do ordered dithering." | jpegDecompressStruct jpegErrorMgr2Struct w h | aForm unhibernate. jpegDecompressStruct _ ByteArray new: self primJPEGDecompressStructSize. jpegErrorMgr2Struct _ ByteArray new: self primJPEGErrorMgr2StructSize. self primJPEGReadHeader: jpegDecompressStruct fromByteArray: aByteArray errorMgr: jpegErrorMgr2Struct. w _ self primImageWidth: jpegDecompressStruct. h _ self primImageHeight: jpegDecompressStruct. ((aForm width = w) & (aForm height = h)) ifFalse: [ ^ self error: 'form dimensions do not match']. "odd width images of depth 16 give problems; avoid them" w odd ifTrue: [ aForm depth = 32 ifFalse: [^ self error: 'must use depth 32 with odd width']] ifFalse: [ ((aForm depth = 16) | (aForm depth = 32)) ifFalse: [^ self error: 'must use depth 16 or 32']]. self primJPEGReadImage: jpegDecompressStruct fromByteArray: aByteArray onForm: aForm doDithering: true errorMgr: jpegErrorMgr2Struct. ! ! !JPEGReadWriter2 methodsFor: 'public access' stamp: 'jmv 12/7/2001 13:48'! uncompress: aByteArray into: aForm doDithering: ditherFlag "Uncompress an image from the given ByteArray into the given Form. Fails if the given Form has the wrong dimensions or depth. If aForm has depth 16 and ditherFlag = true, do ordered dithering." | jpegDecompressStruct jpegErrorMgr2Struct w h | aForm unhibernate. jpegDecompressStruct _ ByteArray new: self primJPEGDecompressStructSize. jpegErrorMgr2Struct _ ByteArray new: self primJPEGErrorMgr2StructSize. self primJPEGReadHeader: jpegDecompressStruct fromByteArray: aByteArray errorMgr: jpegErrorMgr2Struct. w _ self primImageWidth: jpegDecompressStruct. h _ self primImageHeight: jpegDecompressStruct. ((aForm width = w) & (aForm height = h)) ifFalse: [ ^ self error: 'form dimensions do not match']. "odd width images of depth 16 give problems; avoid them" w odd ifTrue: [ aForm depth = 32 ifFalse: [^ self error: 'must use depth 32 with odd width']] ifFalse: [ ((aForm depth = 16) | (aForm depth = 32)) ifFalse: [^ self error: 'must use depth 16 or 32']]. self primJPEGReadImage: jpegDecompressStruct fromByteArray: aByteArray onForm: aForm doDithering: ditherFlag errorMgr: jpegErrorMgr2Struct. ! ! !JPEGReadWriter2 methodsFor: 'primitives' stamp: 'jmv 12/7/2001 13:45'! primJPEGReadImage: aJPEGDecompressStruct fromByteArray: source onForm: form doDithering: ditherFlag errorMgr: aJPEGErrorMgr2Struct self primitiveFailed ! ! !JPEGReadWriter2 class methodsFor: 'image reading/writing' stamp: 'rhi 12/4/2001 21:25'! putForm: aForm quality: quality progressiveJPEG: progressiveFlag onFileNamed2: fileName "Store the given form on a file of the given name. Quality goes from 0 (low) to 100 (high), where -1 means default. If progressiveFlag is true, encode as a progressive JPEG. An existing file will be replaced by the new one." self flag: #rhi. "Somehow I can't replace an existing file?!!? (truncate...)" FileDirectory deleteFilePath: fileName. self putForm: aForm quality: quality progressiveJPEG: progressiveFlag onFileNamed: fileName.! ! !JPEGReadWriter2 class methodsFor: 'image reading/writing' stamp: 'rhi 11/30/2001 20:20'! putForm: aForm quality: quality progressiveJPEG: progressiveFlag onFileNamed: fileName "Store the given form on a file of the given name. Quality goes from 0 (low) to 100 (high), where -1 means default. If progressiveFlag is true, encode as a progressive JPEG." | writer | writer _ self on: (FileStream newFileNamed: fileName) binary. Cursor write showWhile: [ writer nextPutImage: aForm quality: quality progressiveJPEG: progressiveFlag]. writer close.! ! !JPEGReadWriter2Plugin methodsFor: 'initialize-release' stamp: 'jmv 11/30/2001 00:18'! initialiseModule self export: true! ! !JPEGReadWriter2Plugin methodsFor: 'initialize-release' stamp: 'jmv 11/30/2001 00:18'! shutdownModule self export: true! ! !JPEGReadWriter2Plugin methodsFor: 'primitives' stamp: 'jmv 11/30/2001 00:17'! primImageHeight: aJPEGDecompressStruct self export: true. self primitive: 'primImageHeight' parameters: #(ByteArray). "Various parameter checks" self cCode: ' interpreterProxy->success ((interpreterProxy->stSizeOf(interpreterProxy->stackValue(0))) >= (sizeof(struct jpeg_decompress_struct))); if (interpreterProxy->failed()) return null; ' inSmalltalk: []. ^(self cCode: '((j_decompress_ptr)aJPEGDecompressStruct)->image_height' inSmalltalk: [0]) asOop: SmallInteger! ! !JPEGReadWriter2Plugin methodsFor: 'primitives' stamp: 'jmv 11/30/2001 00:17'! primImageWidth: aJPEGDecompressStruct self export: true. self primitive: 'primImageWidth' parameters: #(ByteArray). "Various parameter checks" self cCode: ' interpreterProxy->success ((interpreterProxy->stSizeOf(interpreterProxy->stackValue(0))) >= (sizeof(struct jpeg_decompress_struct))); if (interpreterProxy->failed()) return null; ' inSmalltalk: []. ^(self cCode: '((j_decompress_ptr)aJPEGDecompressStruct)->image_width' inSmalltalk: [0]) asOop: SmallInteger! ! !JPEGReadWriter2Plugin methodsFor: 'primitives' stamp: 'jmv 11/30/2001 00:17'! primJPEGCompressStructSize self export: true. self primitive: 'primJPEGCompressStructSize' parameters: #(). ^(self cCode: 'sizeof(struct jpeg_compress_struct)' inSmalltalk: [0]) asOop: SmallInteger! ! !JPEGReadWriter2Plugin methodsFor: 'primitives' stamp: 'jmv 11/30/2001 00:17'! primJPEGDecompressStructSize self export: true. self primitive: 'primJPEGDecompressStructSize' parameters: #(). ^(self cCode: 'sizeof(struct jpeg_decompress_struct)' inSmalltalk: [0]) asOop: SmallInteger! ! !JPEGReadWriter2Plugin methodsFor: 'primitives' stamp: 'jmv 11/30/2001 00:17'! primJPEGErrorMgr2StructSize self export: true. self primitive: 'primJPEGErrorMgr2StructSize' parameters: #(). ^(self cCode: 'sizeof(struct error_mgr2)' inSmalltalk: [0]) asOop: SmallInteger! ! !JPEGReadWriter2Plugin methodsFor: 'primitives' stamp: 'jmv 11/30/2001 00:17'! primJPEGReadHeader: aJPEGDecompressStruct fromByteArray: source errorMgr: aJPEGErrorMgr2Struct | pcinfo pjerr sourceSize | self export: true. self primitive: 'primJPEGReadHeaderfromByteArrayerrorMgr' parameters: #(ByteArray ByteArray ByteArray). self var: #pcinfo declareC: 'j_decompress_ptr pcinfo'. self var: #pjerr declareC: 'error_ptr2 pjerr'. "Avoid warnings when saving method" self cCode: '' inSmalltalk: [ pcinfo _ nil. pjerr _ nil. sourceSize _ nil. pcinfo. pjerr. sourceSize. ]. "Various parameter checks" self cCode: ' interpreterProxy->success ((interpreterProxy->stSizeOf(interpreterProxy->stackValue(2))) >= (sizeof(struct jpeg_decompress_struct))); interpreterProxy->success ((interpreterProxy->stSizeOf(interpreterProxy->stackValue(0))) >= (sizeof(struct error_mgr2))); if (interpreterProxy->failed()) return null; ' inSmalltalk: []. self cCode: ' sourceSize = interpreterProxy->stSizeOf(interpreterProxy->stackValue(1)); pcinfo = (j_decompress_ptr)aJPEGDecompressStruct; pjerr = (error_ptr2)aJPEGErrorMgr2Struct; if (sourceSize) { pcinfo->err = jpeg_std_error(&pjerr->pub); pjerr->pub.error_exit = error_exit; if (setjmp(pjerr->setjmp_buffer)) { jpeg_destroy_decompress(pcinfo); sourceSize = 0; } if (sourceSize) { jpeg_create_decompress(pcinfo); jpeg_mem_src(pcinfo, source, sourceSize); jpeg_read_header(pcinfo, TRUE); } } ' inSmalltalk: [].! ! !JPEGReadWriter2Plugin methodsFor: 'primitives' stamp: 'jmv 12/7/2001 17:06'! primJPEGReadImage: aJPEGDecompressStruct fromByteArray: source onForm: form doDithering: ditherFlag errorMgr: aJPEGErrorMgr2Struct | pcinfo pjerr buffer rowStride formBits formDepth i j formPix ok rOff gOff bOff rOff2 gOff2 bOff2 formWidth formHeight pixPerWord formPitch formBitsSize sourceSize r1 r2 g1 g2 b1 b2 formBitsAsInt dmv1 dmv2 di dmi dmo | self export: true. self primitive: 'primJPEGReadImagefromByteArrayonFormdoDitheringerrorMgr' parameters: #(ByteArray ByteArray Form Boolean ByteArray). self var: #pcinfo declareC: 'j_decompress_ptr pcinfo'. self var: #pjerr declareC: 'error_ptr2 pjerr'. self var: #buffer declareC: 'JSAMPARRAY buffer'. self var: #formBits declareC: 'unsigned * formBits'. "Avoid warnings when saving method" self cCode: '' inSmalltalk: [ pcinfo _ nil. pjerr _ nil. buffer _ nil. rowStride _ nil. formDepth _ nil. formBits _ nil. i _ nil. j _ nil. formPix _ nil. ok _ nil. rOff _ nil. gOff _ nil. bOff _ nil. rOff2 _ nil. gOff2 _ nil. bOff2 _ nil. sourceSize _ nil. r1 _ nil. r2 _ nil. g1 _ nil. g2 _ nil. b1 _ nil. b2 _ nil. dmv1 _ nil. dmv2 _ nil. di _ nil. dmi _ nil. dmo _ nil. pcinfo. pjerr. buffer. rowStride. formBits. formDepth. i. j. formPix. ok. rOff. gOff. bOff. rOff2. gOff2. bOff2. sourceSize. r1. r2. g1.g2. b1. b2. dmv1. dmv2. di. dmi. dmo. ]. formBits _self cCoerce: (interpreterProxy fetchPointer: 0 ofObject: form) to: 'unsigned *'. formBitsAsInt _ interpreterProxy fetchPointer: 0 ofObject: form. formDepth _ interpreterProxy fetchInteger: 3 ofObject: form. "Various parameter checks" self cCode: ' interpreterProxy->success ((interpreterProxy->stSizeOf(interpreterProxy->stackValue(4))) >= (sizeof(struct jpeg_decompress_struct))); interpreterProxy->success ((interpreterProxy->stSizeOf(interpreterProxy->stackValue(0))) >= (sizeof(struct error_mgr2))); if (interpreterProxy->failed()) return null; ' inSmalltalk: []. formWidth _ (self cCode: '((j_decompress_ptr)aJPEGDecompressStruct)->image_width' inSmalltalk: [0]). formHeight _ (self cCode: '((j_decompress_ptr)aJPEGDecompressStruct)->image_height' inSmalltalk: [0]). pixPerWord _ 32 // formDepth. formPitch _ formWidth + (pixPerWord-1) // pixPerWord * 4. formBitsSize _ interpreterProxy byteSizeOf: formBitsAsInt. interpreterProxy success: ((interpreterProxy isWordsOrBytes: formBitsAsInt) and: [formBitsSize = (formPitch * formHeight)]). interpreterProxy failed ifTrue: [^ nil]. self cCode: ' sourceSize = interpreterProxy->stSizeOf(interpreterProxy->stackValue(3)); if (sourceSize == 0) { interpreterProxy->success(false); return null; } pcinfo = (j_decompress_ptr)aJPEGDecompressStruct; pjerr = (error_ptr2)aJPEGErrorMgr2Struct; pcinfo->err = jpeg_std_error(&pjerr->pub); pjerr->pub.error_exit = error_exit; ok = 1; if (setjmp(pjerr->setjmp_buffer)) { jpeg_destroy_decompress(pcinfo); ok = 0; } if (ok) { ok = jpeg_mem_src_newLocationOfData(pcinfo, source, sourceSize); if (ok) { /* Dither Matrix taken from Form>>orderedDither32To16, but rewritten for this method. */ int ditherMatrix1[] = { 2, 0, 14, 12, 1, 3, 13, 15 }; int ditherMatrix2[] = { 10, 8, 6, 4, 9, 11, 5, 7 }; jpeg_start_decompress(pcinfo); rowStride = pcinfo->output_width * pcinfo->output_components; if (pcinfo->out_color_components == 3) { rOff = 0; gOff = 1; bOff = 2; rOff2 = 3; gOff2 = 4; bOff2 = 5; } else { rOff = 0; gOff = 0; bOff = 0; rOff2 = 1; gOff2 = 1; bOff2 = 1; } /* Make a one-row-high sample array that will go away when done with image */ buffer = (*(pcinfo->mem)->alloc_sarray) ((j_common_ptr) pcinfo, JPOOL_IMAGE, rowStride, 1); /* Step 6: while (scan lines remain to be read) */ /* jpeg_read_scanlines(...); */ /* Here we use the library state variable cinfo.output_scanline as the * loop counter, so that we dont have to keep track ourselves. */ while (pcinfo->output_scanline < pcinfo->output_height) { /* jpeg_read_scanlines expects an array of pointers to scanlines. * Here the array is only one element long, but you could ask for * more than one scanline at a time if thats more convenient. */ (void) jpeg_read_scanlines(pcinfo, buffer, 1); switch (formDepth) { case 32: for(i = 0, j = 1; i < rowStride; i +=(pcinfo->out_color_components), j++) { formPix = (255 << 24) | (buffer[0][i+rOff] << 16) | (buffer[0][i+gOff] << 8) | buffer[0][i+bOff]; if (formPix == 0) formPix = 1; formBits [ ((pcinfo->output_scanline - 1) * (pcinfo->image_width)) + j ] = formPix; } break; case 16: for(i = 0, j = 1; i < rowStride; i +=(pcinfo->out_color_components*2), j++) { r1 = buffer[0][i+rOff]; r2 = buffer[0][i+rOff2]; g1 = buffer[0][i+gOff]; g2 = buffer[0][i+gOff2]; b1 = buffer[0][i+bOff]; b2 = buffer[0][i+bOff2]; if (!!ditherFlag) { r1 = r1 >> 3; r2 = r2 >> 3; g1 = g1 >> 3; g2 = g2 >> 3; b1 = b1 >> 3; b2 = b2 >> 3; } else { /* Do 4x4 ordered dithering. Taken from Form>>orderedDither32To16 */ dmv1 = ditherMatrix1[ ((pcinfo->output_scanline & 3 )<< 1) | (j&1) ]; dmv2 = ditherMatrix2[ ((pcinfo->output_scanline & 3 )<< 1) | (j&1) ]; di = (r1 * 496) >> 8; dmi = di & 15; dmo = di >> 4; if(dmv1 < dmi) { r1 = dmo+1; } else { r1 = dmo; }; di = (g1 * 496) >> 8; dmi = di & 15; dmo = di >> 4; if(dmv1 < dmi) { g1 = dmo+1; } else { g1 = dmo; }; di = (b1 * 496) >> 8; dmi = di & 15; dmo = di >> 4; if(dmv1 < dmi) { b1 = dmo+1; } else { b1 = dmo; }; di = (r2 * 496) >> 8; dmi = di & 15; dmo = di >> 4; if(dmv2 < dmi) { r2 = dmo+1; } else { r2 = dmo; }; di = (g2 * 496) >> 8; dmi = di & 15; dmo = di >> 4; if(dmv2 < dmi) { g2 = dmo+1; } else { g2 = dmo; }; di = (b2 * 496) >> 8; dmi = di & 15; dmo = di >> 4; if(dmv2 < dmi) { b2 = dmo+1; } else { b2 = dmo; }; } formPix = (r1 << 10) | (g1 << 5) | b1; if (!!formPix) formPix = 1; formPix = (formPix << 16) | (r2 << 10) | (g2 << 5) | b2; if (!!(formPix & 65535)) formPix = formPix | 1; formBits [ ((pcinfo->output_scanline - 1) * (pcinfo->image_width)) / 2 + j ] = formPix; } break; } } jpeg_finish_decompress(pcinfo); } jpeg_destroy_decompress(pcinfo); } ' inSmalltalk: [].! ! !JPEGReadWriter2Plugin methodsFor: 'primitives' stamp: 'jmv 12/6/2001 20:59'! primJPEGWriteImage: aJPEGCompressStruct onByteArray: destination form: form quality: quality progressiveJPEG: progressiveFlag errorMgr: aJPEGErrorMgr2Struct | pcinfo pjerr buffer rowStride formBits formWidth formHeight formDepth i j formPix destinationSize pixPerWord formPitch formBitsSize formBitsAsInt | self export: true. self primitive: 'primJPEGWriteImageonByteArrayformqualityprogressiveJPEGerrorMgr' parameters: #(ByteArray ByteArray Form SmallInteger Boolean ByteArray). self var: #pcinfo declareC: 'j_compress_ptr pcinfo'. self var: #pjerr declareC: 'error_ptr2 pjerr'. self var: #buffer declareC: 'JSAMPARRAY buffer'. self var: #formBits declareC: 'unsigned * formBits'. "Avoid warnings when saving method" self cCode: '' inSmalltalk: [ pcinfo _ nil. pjerr _ nil. buffer _nil. rowStride _ nil. formBits _ nil. formWidth _ nil. formHeight _ nil. formDepth _ nil. i _ nil. j _ nil. formPix _ nil. destinationSize _ nil. pcinfo. pjerr. buffer. rowStride. formBits. formWidth. formHeight. formDepth. i. j. formPix. destinationSize. ]. formBits _self cCoerce: (interpreterProxy fetchPointer: 0 ofObject: form) to: 'unsigned *'. formBitsAsInt _ interpreterProxy fetchInteger: 0 ofObject: form. formWidth _ interpreterProxy fetchInteger: 1 ofObject: form. formHeight _ interpreterProxy fetchInteger: 2 ofObject: form. formDepth _ interpreterProxy fetchInteger: 3 ofObject: form. "Various parameter checks" self cCode: ' interpreterProxy->success ((interpreterProxy->stSizeOf(interpreterProxy->stackValue(5))) >= (sizeof(struct jpeg_compress_struct))); interpreterProxy->success ((interpreterProxy->stSizeOf(interpreterProxy->stackValue(0))) >= (sizeof(struct error_mgr2))); if (interpreterProxy->failed()) return null; ' inSmalltalk: []. pixPerWord _ 32 // formDepth. formPitch _ formWidth + (pixPerWord-1) // pixPerWord * 4. formBitsSize _ interpreterProxy byteSizeOf: formBitsAsInt. interpreterProxy success: ((interpreterProxy isWordsOrBytes: formBitsAsInt) and: [formBitsSize = (formPitch * formHeight)]). interpreterProxy failed ifTrue: [^ nil]. self cCode: ' destinationSize = interpreterProxy->stSizeOf(interpreterProxy->stackValue(4)); pcinfo = (j_compress_ptr)aJPEGCompressStruct; pjerr = (error_ptr2)aJPEGErrorMgr2Struct; if (destinationSize) { pcinfo->err = jpeg_std_error(&pjerr->pub); pjerr->pub.error_exit = error_exit; if (setjmp(pjerr->setjmp_buffer)) { jpeg_destroy_compress(pcinfo); destinationSize = 0; } if (destinationSize) { jpeg_create_compress(pcinfo); jpeg_mem_dest(pcinfo, destination, &destinationSize); pcinfo->image_width = formWidth; pcinfo->image_height = formHeight; pcinfo->input_components = 3; pcinfo->in_color_space = JCS_RGB; jpeg_set_defaults(pcinfo); if (quality > 0) jpeg_set_quality (pcinfo, quality, 1); if (progressiveFlag) jpeg_simple_progression(pcinfo); jpeg_start_compress(pcinfo, TRUE); rowStride = formWidth * 3; /* Make a one-row-high sample array that will go away when done with image */ buffer = (*(pcinfo->mem)->alloc_sarray) ((j_common_ptr) pcinfo, JPOOL_IMAGE, rowStride, 1); while (pcinfo->next_scanline < pcinfo->image_height) { switch (formDepth) { case 32: for(i = 0, j = 1; i < rowStride; i +=3, j++) { formPix = formBits [ ((pcinfo->next_scanline) * formWidth) + j ]; buffer[0][i] = (formPix >> 16) & 255; buffer[0][i+1] = (formPix >> 8) & 255; buffer[0][i+2] = formPix & 255; } break; case 16: for(i = 0, j = 1; i < rowStride; i +=6, j++) { formPix = formBits [ ((pcinfo->next_scanline) * formWidth) / 2 + j ]; buffer[0][i] = (formPix >> 23) & 248; buffer[0][i+1] = (formPix >> 18) & 248; buffer[0][i+2] = (formPix >> 13) & 248; buffer[0][i+3] = (formPix >> 7) & 248; buffer[0][i+4] = (formPix >> 2) & 248; buffer[0][i+5] = (formPix << 3) & 248; } break; } (void) jpeg_write_scanlines(pcinfo, buffer, 1); } jpeg_finish_compress(pcinfo); jpeg_destroy_compress(pcinfo); } } ' inSmalltalk: []. ^(self cCode: 'destinationSize' inSmalltalk: [0]) asOop: SmallInteger! ! !JPEGReadWriter2Plugin class methodsFor: 'translation' stamp: 'jmv 11/30/2001 00:18'! headerFile ^ '/*#include */ /* Interface to JPEG code */ #include "jpeglib.h" #include struct error_mgr2 { struct jpeg_error_mgr pub; /* "public" fields */ jmp_buf setjmp_buffer; /* for return to caller */ }; typedef struct error_mgr2* error_ptr2; void error_exit (j_common_ptr cinfo); '! ! !JPEGReadWriter2Plugin class methodsFor: 'C support code' stamp: 'jmv 12/7/2001 10:27'! errorFile ^'#include #include "jpeglib.h" #include struct error_mgr2 { struct jpeg_error_mgr pub; /* "public" fields */ jmp_buf setjmp_buffer; /* for return to caller */ }; typedef struct error_mgr2 * error_ptr2; /* * Here''s the routine that will replace the standard error_exit method: */ void error_exit (j_common_ptr cinfo) { /* cinfo->err really points to a error_mgr2 struct, so coerce pointer */ error_ptr2 myerr = (error_ptr2) cinfo->err; /* Return control to the setjmp point */ longjmp(myerr->setjmp_buffer, 1); }'! ! !JPEGReadWriter2Plugin class methodsFor: 'C support code' stamp: 'jmv 12/6/2001 21:29'! jConfigFile ^'/* * jconfig.doc Modified by jmv * * Copyright (C) 1991-1994, Thomas G. Lane. * This file is part of the Independent JPEG Group''s software. * For conditions of distribution and use, see the accompanying README file. * * This file documents the configuration options that are required to * customize the JPEG software for a particular system. * * The actual configuration options for a particular installation are stored * in jconfig.h. On many machines, jconfig.h can be generated automatically * or copied from one of the "canned" jconfig files that we supply. But if * you need to generate a jconfig.h file by hand, this file tells you how. * * DO NOT EDIT THIS FILE --- IT WON''T ACCOMPLISH ANYTHING. * EDIT A COPY NAMED JCONFIG.H. */ /* * These symbols indicate the properties of your machine or compiler. * #define the symbol if yes, #undef it if no. */ /* Does your compiler support function prototypes? * (If not, you also need to use ansi2knr, see install.doc) */ #define HAVE_PROTOTYPES /* Does your compiler support the declaration "unsigned char" ? * How about "unsigned short" ? */ #define HAVE_UNSIGNED_CHAR #define HAVE_UNSIGNED_SHORT /* Define "void" as "char" if your compiler doesn''t know about type void. * NOTE: be sure to define void such that "void *" represents the most general * pointer type, e.g., that returned by malloc(). */ /* #define void char */ /* Define "const" as empty if your compiler doesn''t know the "const" keyword. */ /* #define const */ /* Define this if an ordinary "char" type is unsigned. * If you''re not sure, leaving it undefined will work at some cost in speed. * If you defined HAVE_UNSIGNED_CHAR then the speed difference is minimal. */ #undef CHAR_IS_UNSIGNED /* Define this if your system has an ANSI-conforming file. */ #define HAVE_STDDEF_H /* Define this if your system has an ANSI-conforming file. */ #define HAVE_STDLIB_H /* Define this if your system does not have an ANSI/SysV , * but does have a BSD-style . */ #undef NEED_BSD_STRINGS /* Define this if your system does not provide typedef size_t in any of the * ANSI-standard places (stddef.h, stdlib.h, or stdio.h), but places it in * instead. */ #undef NEED_SYS_TYPES_H /* For 80x86 machines, you need to define NEED_FAR_POINTERS, * unless you are using a large-data memory model or 80386 flat-memory mode. * On less brain-damaged CPUs this symbol must not be defined. * (Defining this symbol causes large data structures to be referenced through * "far" pointers and to be allocated with a special version of malloc.) */ #undef NEED_FAR_POINTERS /* Define this if your linker needs global names to be unique in less * than the first 15 characters. */ #undef NEED_SHORT_EXTERNAL_NAMES /* Although a real ANSI C compiler can deal perfectly well with pointers to * unspecified structures (see "incomplete types" in the spec), a few pre-ANSI * and pseudo-ANSI compilers get confused. To keep one of these bozos happy, * define INCOMPLETE_TYPES_BROKEN. This is not recommended unless you * actually get "missing structure definition" warnings or errors while * compiling the JPEG code. */ #undef INCOMPLETE_TYPES_BROKEN /* * The following options affect code selection within the JPEG library, * but they don''t need to be visible to applications using the library. * To minimize application namespace pollution, the symbols won''t be * defined unless JPEG_INTERNALS has been defined. */ #ifdef JPEG_INTERNALS /* Define this if your compiler implements ">>" on signed values as a logical * (unsigned) shift; leave it undefined if ">>" is a signed (arithmetic) shift, * which is the normal and rational definition. */ #undef RIGHT_SHIFT_IS_UNSIGNED #endif /* JPEG_INTERNALS */ /* * The remaining options do not affect the JPEG library proper, * but only the sample applications cjpeg/djpeg (see cjpeg.c, djpeg.c). * Other applications can ignore these. */ #ifdef JPEG_CJPEG_DJPEG /* These defines indicate which image (non-JPEG) file formats are allowed. */ #define BMP_SUPPORTED /* BMP image file format */ #define GIF_SUPPORTED /* GIF image file format */ #define PPM_SUPPORTED /* PBMPLUS PPM/PGM image file format */ #undef RLE_SUPPORTED /* Utah RLE image file format */ #define TARGA_SUPPORTED /* Targa image file format */ /* Define this if you want to name both input and output files on the command * line, rather than using stdout and optionally stdin. You MUST do this if * your system can''t cope with binary I/O to stdin/stdout. See comments at * head of cjpeg.c or djpeg.c. */ #undef TWO_FILE_COMMANDLINE /* Define this if your system needs explicit cleanup of temporary files. * This is crucial under MS-DOS, where the temporary "files" may be areas * of extended memory; on most other systems it''s not as important. */ #undef NEED_SIGNAL_CATCHER /* By default, we open image files with fopen(...,"rb") or fopen(...,"wb"). * This is necessary on systems that distinguish text files from binary files, * and is harmless on most systems that don''t. If you have one of the rare * systems that complains about the "b" spec, define this symbol. */ #undef DONT_USE_B_MODE /* Define this if you want percent-done progress reports from cjpeg/djpeg. */ #undef PROGRESS_REPORT #endif /* JPEG_CJPEG_DJPEG */ #ifdef macintosh #define USE_MAC_MEMMGR #endif /* Uncomment the following line to enable Float arithmethic (faster only on fast systems) */ /*#define JDCT_DEFAULT JDCT_FLOAT*/'! ! !JPEGReadWriter2Plugin class methodsFor: 'C support code' stamp: 'jmv 11/30/2001 12:36'! jmemdatadstFile ^'/* Modified by jmv to work on memory rather than files. Based on: * * jdatadst.c * * Copyright (C) 1994-1996, Thomas G. Lane. * This file is part of the Independent JPEG Group''s software. * For conditions of distribution and use, see the accompanying README file. * * This file contains compression data destination routines for the case of * emitting JPEG data to a file (or any stdio stream). While these routines * are sufficient for most applications, some will want to use a different * destination manager. * IMPORTANT: we assume that fwrite() will correctly transcribe an array of * JOCTETs into 8-bit-wide elements on external storage. If char is wider * than 8 bits on your machine, you may need to do some tweaking. */ /* this is not a core library module, so it doesn''t define JPEG_INTERNALS */ #include "jinclude.h" #include "jpeglib.h" #include "jerror.h" /* Expanded data destination object for stdio output */ typedef struct { struct jpeg_destination_mgr pub; /* public fields */ char * actualPos; /* points to first byte not yet filled */ unsigned spaceLeft; /* bytes still not filled in destination */ unsigned *pSpaceUsed; /* to answer actual compressed size */ JOCTET * buffer; /* start of buffer */ } my_destination_mgr; typedef my_destination_mgr * my_dest_ptr; #define OUTPUT_BUF_SIZE 4096 /* choose an efficiently fwrite''able size */ /* * Initialize destination --- called by jpeg_start_compress * before any data is actually written. */ METHODDEF(void) init_destination (j_compress_ptr cinfo) { my_dest_ptr dest = (my_dest_ptr) cinfo->dest; /* Allocate the output buffer --- it will be released when done with image */ dest->buffer = (JOCTET *) (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_IMAGE, OUTPUT_BUF_SIZE * SIZEOF(JOCTET)); dest->pub.next_output_byte = dest->buffer; dest->pub.free_in_buffer = OUTPUT_BUF_SIZE; } /* * Empty the output buffer --- called whenever buffer fills up. * * In typical applications, this should write the entire output buffer * (ignoring the current state of next_output_byte & free_in_buffer), * reset the pointer & count to the start of the buffer, and return TRUE * indicating that the buffer has been dumped. * * In applications that need to be able to suspend compression due to output * overrun, a FALSE return indicates that the buffer cannot be emptied now. * In this situation, the compressor will return to its caller (possibly with * an indication that it has not accepted all the supplied scanlines). The * application should resume compression after it has made more room in the * output buffer. Note that there are substantial restrictions on the use of * suspension --- see the documentation. * * When suspending, the compressor will back up to a convenient restart point * (typically the start of the current MCU). next_output_byte & free_in_buffer * indicate where the restart point will be if the current call returns FALSE. * Data beyond this point will be regenerated after resumption, so do not * write it out when emptying the buffer externally. */ METHODDEF(boolean) empty_output_buffer (j_compress_ptr cinfo) { my_dest_ptr dest = (my_dest_ptr) cinfo->dest; size_t nbytes; nbytes = (OUTPUT_BUF_SIZE < dest->spaceLeft) ? OUTPUT_BUF_SIZE : dest->spaceLeft; memcpy(dest->actualPos, dest->buffer, nbytes); dest->actualPos = (dest->actualPos) + nbytes; dest->spaceLeft = (dest->spaceLeft) - nbytes; *(dest->pSpaceUsed) = *(dest->pSpaceUsed) + nbytes; if (nbytes !!= (size_t) OUTPUT_BUF_SIZE) ERREXIT(cinfo, JERR_FILE_WRITE); dest->pub.next_output_byte = dest->buffer; dest->pub.free_in_buffer = OUTPUT_BUF_SIZE; return TRUE; } /* * Terminate destination --- called by jpeg_finish_compress * after all data has been written. Usually needs to flush buffer. * * NB: *not* called by jpeg_abort or jpeg_destroy; surrounding * application must deal with any cleanup that should happen even * for error exit. */ METHODDEF(void) term_destination (j_compress_ptr cinfo) { my_dest_ptr dest = (my_dest_ptr) cinfo->dest; size_t datacount = OUTPUT_BUF_SIZE - dest->pub.free_in_buffer; size_t nbytes; /* Write any data remaining in the buffer */ if (datacount > 0) { nbytes = (datacount < dest->spaceLeft) ? datacount : dest->spaceLeft; memcpy(dest->actualPos, dest->buffer, nbytes); dest->actualPos = dest->actualPos + nbytes; dest->spaceLeft = dest->spaceLeft - nbytes; *(dest->pSpaceUsed) = *(dest->pSpaceUsed) + nbytes; if (nbytes !!= datacount) ERREXIT(cinfo, JERR_FILE_WRITE); } } /* * Prepare for output to a stdio stream. * The caller must have already opened the stream, and is responsible * for closing it after finishing compression. */ GLOBAL(void) jpeg_mem_dest (j_compress_ptr cinfo, char * pDestination, unsigned *pDestinationSize) { my_dest_ptr dest; /* The destination object is made permanent so that multiple JPEG images * can be written to the same file without re-executing jpeg_stdio_dest. * This makes it dangerous to use this manager and a different destination * manager serially with the same JPEG object, because their private object * sizes may be different. Caveat programmer. */ if (cinfo->dest == NULL) { /* first time for this JPEG object? */ cinfo->dest = (struct jpeg_destination_mgr *) (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT, SIZEOF(my_destination_mgr)); } dest = (my_dest_ptr) cinfo->dest; dest->pub.init_destination = init_destination; dest->pub.empty_output_buffer = empty_output_buffer; dest->pub.term_destination = term_destination; dest->actualPos = pDestination; dest->spaceLeft = *pDestinationSize; dest->pSpaceUsed = pDestinationSize; *(dest->pSpaceUsed) = 0; }'! ! !JPEGReadWriter2Plugin class methodsFor: 'C support code' stamp: 'jmv 11/30/2001 12:36'! jmemdatasrcFile ^'/* Modified by jmv to work on memory rather than files. Based on: * * jdatasrc.c * * Copyright (C) 1994-1996, Thomas G. Lane. * This file is part of the Independent JPEG Group''s software. * For conditions of distribution and use, see the accompanying README file. * * This file contains decompression data source routines for the case of * reading JPEG data from a file (or any stdio stream). While these routines * are sufficient for most applications, some will want to use a different * source manager. * IMPORTANT: we assume that fread() will correctly transcribe an array of * JOCTETs from 8-bit-wide elements on external storage. If char is wider * than 8 bits on your machine, you may need to do some tweaking. */ /* this is not a core library module, so it doesn''t define JPEG_INTERNALS */ #include "jinclude.h" #include "jpeglib.h" #include "jerror.h" /* Expanded data source object for stdio input */ typedef struct { struct jpeg_source_mgr pub; /* public fields */ char * pSourceData; /* source data start */ char * actualPos; /* points to first byte not yet delivered */ unsigned bytesLeft; /* bytes still not read in data source */ JOCTET * buffer; /* start of buffer */ } my_source_mgr; typedef my_source_mgr * my_src_ptr; #define INPUT_BUF_SIZE 4096 /* choose an efficiently fread''able size */ /* * Initialize source --- called by jpeg_read_header * before any data is actually read. */ METHODDEF(void) init_source (j_decompress_ptr cinfo) { my_src_ptr src = (my_src_ptr) cinfo->src; /* We don''t clear the input buffer. * This is correct behavior for reading a series of images from one source. */ } /* * Fill the input buffer --- called whenever buffer is emptied. * * In typical applications, this should read fresh data into the buffer * (ignoring the current state of next_input_byte & bytes_in_buffer), * reset the pointer & count to the start of the buffer, and return TRUE * indicating that the buffer has been reloaded. It is not necessary to * fill the buffer entirely, only to obtain at least one more byte. * * There is no such thing as an EOF return. If the end of the file has been * reached, the routine has a choice of ERREXIT() or inserting fake data into * the buffer. In most cases, generating a warning message and inserting a * fake EOI marker is the best course of action --- this will allow the * decompressor to output however much of the image is there. However, * the resulting error message is misleading if the real problem is an empty * input file, so we handle that case specially. * * In applications that need to be able to suspend compression due to input * not being available yet, a FALSE return indicates that no more data can be * obtained right now, but more may be forthcoming later. In this situation, * the decompressor will return to its caller (with an indication of the * number of scanlines it has read, if any). The application should resume * decompression after it has loaded more data into the input buffer. Note * that there are substantial restrictions on the use of suspension --- see * the documentation. * * When suspending, the decompressor will back up to a convenient restart point * (typically the start of the current MCU). next_input_byte & bytes_in_buffer * indicate where the restart point will be if the current call returns FALSE. * Data beyond this point must be rescanned after resumption, so move it to * the front of the buffer rather than discarding it. */ METHODDEF(boolean) fill_input_buffer (j_decompress_ptr cinfo) { my_src_ptr src = (my_src_ptr) cinfo->src; size_t nbytes; nbytes = (INPUT_BUF_SIZE < src->bytesLeft) ? INPUT_BUF_SIZE : src->bytesLeft; memcpy(src->buffer, src->actualPos, nbytes); src->actualPos = src->actualPos + nbytes; src->bytesLeft = src->bytesLeft - nbytes; if (nbytes <= 0) { WARNMS(cinfo, JWRN_JPEG_EOF); /* Insert a fake EOI marker */ src->buffer[0] = (JOCTET) 0xFF; src->buffer[1] = (JOCTET) JPEG_EOI; nbytes = 2; } src->pub.next_input_byte = src->buffer; src->pub.bytes_in_buffer = nbytes; return TRUE; } /* * Skip data --- used to skip over a potentially large amount of * uninteresting data (such as an APPn marker). * * Writers of suspendable-input applications must note that skip_input_data * is not granted the right to give a suspension return. If the skip extends * beyond the data currently in the buffer, the buffer can be marked empty so * that the next read will cause a fill_input_buffer call that can suspend. * Arranging for additional bytes to be discarded before reloading the input * buffer is the application writer''s problem. */ METHODDEF(void) skip_input_data (j_decompress_ptr cinfo, long num_bytes) { my_src_ptr src = (my_src_ptr) cinfo->src; /* Just a dumb implementation for now. Could use fseek() except * it doesn''t work on pipes. Not clear that being smart is worth * any trouble anyway --- large skips are infrequent. */ if (num_bytes > 0) { while (num_bytes > (long) src->pub.bytes_in_buffer) { num_bytes -= (long) src->pub.bytes_in_buffer; (void) fill_input_buffer(cinfo); /* note we assume that fill_input_buffer will never return FALSE, * so suspension need not be handled. */ } src->pub.next_input_byte += (size_t) num_bytes; src->pub.bytes_in_buffer -= (size_t) num_bytes; } } /* * An additional method that can be provided by data source modules is the * resync_to_restart method for error recovery in the presence of RST markers. * For the moment, this source module just uses the default resync method * provided by the JPEG library. That method assumes that no backtracking * is possible. */ /* * Terminate source --- called by jpeg_finish_decompress * after all data has been read. Often a no-op. * * NB: *not* called by jpeg_abort or jpeg_destroy; surrounding * application must deal with any cleanup that should happen even * for error exit. */ METHODDEF(void) term_source (j_decompress_ptr cinfo) { /* no work necessary here */ } /* * Prepare for input from a stdio stream. * The caller must have already opened the stream, and is responsible * for closing it after finishing decompression. */ GLOBAL(void) jpeg_mem_src (j_decompress_ptr cinfo, char * pSourceData, unsigned sourceDataSize) { my_src_ptr src; /* The source object and input buffer are made permanent so that a series * of JPEG images can be read from the same file by calling jpeg_stdio_src * only before the first one. (If we discarded the buffer at the end of * one image, we''d likely lose the start of the next one.) * This makes it unsafe to use this manager and a different source * manager serially with the same JPEG object. Caveat programmer. */ if (cinfo->src == NULL) { /* first time for this JPEG object? */ cinfo->src = (struct jpeg_source_mgr *) (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT, SIZEOF(my_source_mgr)); src = (my_src_ptr) cinfo->src; src->buffer = (JOCTET *) (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT, INPUT_BUF_SIZE * SIZEOF(JOCTET)); } src = (my_src_ptr) cinfo->src; src->pub.init_source = init_source; src->pub.fill_input_buffer = fill_input_buffer; src->pub.skip_input_data = skip_input_data; src->pub.resync_to_restart = jpeg_resync_to_restart; /* use default method */ src->pub.term_source = term_source; src->pSourceData = pSourceData; src->actualPos = pSourceData; src->bytesLeft = sourceDataSize; src->pub.bytes_in_buffer = 0; /* forces fill_input_buffer on first read */ src->pub.next_input_byte = NULL; /* until buffer loaded */ } /* This function allows data to be moved if necessary */ GLOBAL(int) jpeg_mem_src_newLocationOfData (j_decompress_ptr cinfo, char * pSourceData, unsigned sourceDataSize) { my_src_ptr src; unsigned offset; src = (my_src_ptr) cinfo->src; offset = (src->actualPos) - (src->pSourceData); src->pSourceData = pSourceData; src->actualPos = pSourceData + offset; return((src->actualPos + src->bytesLeft) == (pSourceData + sourceDataSize)); }'! ! !JPEGReadWriter2Plugin class methodsFor: 'C support code' stamp: 'jmv 12/7/2001 10:28'! writeSupportFiles "JPEGReadWriter2Plugin writeSupportFiles" InterpreterSupportCode storeString: self jConfigFile onFileNamed:'jConfig.h'; storeString: self jmemdatasrcFile onFileNamed:'jmemdatasrc.c'; storeString: self jmemdatadstFile onFileNamed:'jmemdatadst.c'; storeString: self errorFile onFileNamed:'error.c'.! ! !JPEGReadWriter2Plugin class reorganize! ('translation' hasHeaderFile headerFile requiresPlatformFiles) ('C support code' errorFile jConfigFile jmemdatadstFile jmemdatasrcFile writeSupportFiles) ! JPEGReadWriter2Plugin removeSelector: #primJPEGReadImage:fromByteArray:onForm:errorMgr:! JPEGReadWriter2 removeSelector: #primJPEGReadImage:fromByteArray:onForm:errorMgr:!