[futurebasic] Re: [FB] Tiff file advice needed

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : December 2007 : Group Archive : Group : All Groups

From: Joe Lertola <joefb@...>
Date: Thu, 13 Dec 2007 20:23:30 -0500
Robert,

Thanks again for the Tiff file code. I am trying to add the code that  
will make your Tiff saving functions work when running the program  
directly in FB. I am having trouble with one of the Toolboxes (marked  
AA---- in the code below). This Toolbox does not have an 'fn' in front  
of it. So I can not convert it by by following the example of the  
others.

Thanks,
-Joe


On Dec 9, 2007, at 8:50 PM, Robert Purves wrote:

>
> Joe Lertola wrote:
>
>> That works great. Below is the demo with your function  
>> incorporated. My only disappointment is that the only compression  
>> option is PackBits. I had hoped that LZW compression was available.
>
>
> Instead of using QuickTime export, you'll have to use the more  
> modern ImageIO API as shown below. LZW never made it into QuickTime,  
> even though the patent expired some years ago.
>
> Replace your original:
> err = fn WriteBitmapToFile( f, _"TIFF", bmCtx )
> by:
> err = fn WriteBitmapContextToTIFF( f, bmCtx,  
> _kTIFFCompressionTypeLZW )
> which gives a 172 KB image instead of 1.2 MB.
>
> Robert P.

'--------------------------------------
'Tiff Save functions from Robert Purves Dec 9, 2007
include "Tlbx CoreGraphics.incl"
#if ndef _DEFINEDINCARBON
#define CGImageDestinationRef as ptr
#endif
#if def _FBtoC
toolbox fn CGImageDestinationCreateWithURL( CFURLRef url, ¬
CFStringRef type, long count, CFDictionaryRef options ) =  
CGImageDestinationRef
'AA----I don't know to set up the toolbox below for use with FB
toolbox CGImageDestinationAddImage( CGImageDestinationRef idst, ¬
CGImageRef image, CFDictionaryRef properties )
toolbox fn CGImageDestinationFinalize( CGImageDestinationRef idst ) =  
long // true if succeeds
toolbox fn CGBitmapContextCreateImage( CGContextRef c ) = CGImageRef
Toolbox fn CGColorSpaceCreateWithName( CFStringRef  name ) =  
CGColorSpaceRef

#else
// FB duhh...
begin globals
dim as pointer gCGBitmapContextCreateImage
dim as pointer gCGImageDestinationCreateWithURL
dim as pointer gCGImageDestinationFinalize
dim as pointer gCGColorSpaceCreateWithName
end globals

local fn CGBitmapContextCreateImage( c as CGContextRef )
beginassem
  lwz    r12,^gCGBitmapContextCreateImage
  mtspr  ctr,r12
  mr     r31,r2
  bctrl
  mr     r2,r31
endassem
end fn // returns CGImageRef

gCGBitmapContextCreateImage = fn GetMachFunctionFromBundle¬
  ( gAppServicesBundle, "CGBitmapContextCreateImage" )


local fn CGImageDestinationCreateWithURL( url as CFURLRef, type as ¬
CFStringRef, count as long, options as CFDictionaryRef )
beginassem
  lwz    r12,^gCGImageDestinationCreateWithURL
  mtspr  ctr,r12
  mr     r31,r2
  bctrl
  mr     r2,r31
endassem
end fn // returns CGImageDestinationRef

gCGImageDestinationCreateWithURL = fn GetMachFunctionFromBundle¬
  ( gAppServicesBundle, "CGImageDestinationCreateWithURL" )


local fn CGImageDestinationFinalize( idst as CGImageDestinationRef )
beginassem
  lwz    r12,^gCGImageDestinationFinalize
  mtspr  ctr,r12
  mr     r31,r2
  bctrl
  mr     r2,r31
endassem
end fn // returns long

gCGImageDestinationFinalize = fn GetMachFunctionFromBundle¬
  ( gAppServicesBundle, "CGImageDestinationFinalize" )


local fn CGColorSpaceCreateWithName( name as CFStringRef )
beginassem
  lwz    r12,^gCGColorSpaceCreateWithName
  mtspr  ctr,r12
  mr     r31,r2
  bctrl
  mr     r2,r31
endassem
end fn // returns CGColorSpaceRef

gCGColorSpaceCreateWithName  = fn GetMachFunctionFromBundle¬
( gAppServicesBundle, "CGColorSpaceCreateWithName" )

#endif

toolbox fn CFBundleGetDataPointerForName¬
( CFBundleRef bundle, CFStringRef symbolName ) = ptr
toolbox fn CFDictionaryCreate( CFAllocatorRef allocator, ¬
ptr keys, ptr values, CFIndex numValues, ptr keyCallBacks, ¬
ptr valueCallBacks) = CFDictionaryRef
toolbox fn CFNumberCreate( CFAllocatorRef allocator, ¬
CFNumberType theType, ptr *valuePtr ) = CFNumberRef
_kCFNumberIntType = 9

begin enum
_kTIFFCompressionTypeNone = 1
_kTIFFCompressionTypeLZW = 5
_kTIFFCompressionTypePackBits = 32773
end enum

local fn ApplicationServicesBundle //as CFBundleRef
'~'1
begin globals
dim as CFBundleRef sApplicationServicesBundle // static
end globals
if ( sApplicationServicesBundle == 0 ) then sApplicationServicesBundle  
= ¬
fn CreateBundleForFramework( "ApplicationServices.framework" )
end fn = sApplicationServicesBundle

local fn CoreServicesBundle //as CFBundleRef
'~'1
begin globals
dim as CFBundleRef sCoreServicesBundle // static
end globals
if ( sCoreServicesBundle == 0 ) then sCoreServicesBundle = ¬
fn CreateBundleForFramework( "CoreServices.framework" )
end fn = sCoreServicesBundle

local mode
local fn CreateCFURLFromFSSpec( fs as ^FSSpec ) //as CFURLRef
'~'1
dim as FSRef folderFSRef
dim as FSSpec folderFSSpec
dim as CFURLRef baseCFURL, theCFURL
dim as CFStringRef fileName
dim as OSErr err

theCFURL = 0
err = fn FSMakeFSSpec( fs.vRefNum, fs.parID, "", @folderFSSpec )
long if ( err == _noErr )
err = fn FSpMakeFSRef( folderFSSpec, @folderFSRef )
long if ( err == _noErr )
baseCFURL = fn CFURLCreateFromFSRef¬
( _kCFAllocatorDefault, folderFSRef )
long if ( baseCFURL )
fileName = fn CFStringCreateWithPascalString¬
( _kCFAllocatorDefault, fs.name, _kCFStringEncodingMacRoman )
theCFURL = fn CFURLCreateCopyAppendingPathComponent¬
( _kCFAllocatorDefault, baseCFURL, fileName, _false )
CFRelease( fileName )
CFRelease( baseCFURL )
end if
end if
end if
end fn = theCFURL // caller must CFRelease

local fn CreateTIFFPropertiesDict( compressionType as long ) //as  
CFDictionaryRef
'~'1
dim as pointer keyCallBacks, valueCallBacks
dim as ptr dictKey
dim as CFNumberRef @ dictValue
dim as CFDictionaryRef dict, @ tiffOptionsDict
dim as long @ value

// CFDictionary boilerplate
keyCallBacks = fn CFBundleGetDataPointerForName¬
( fn CoreServicesBundle, fn  
CFSTR( "kCFCopyStringDictionaryKeyCallBacks" ) )
valueCallBacks = fn CFBundleGetDataPointerForName¬
( fn CoreServicesBundle, fn CFSTR( "kCFTypeDictionaryValueCallBacks" ) )

// create the tiffOptionsDict
dictKey = fn CFBundleGetDataPointerForName¬
( fn ApplicationServicesBundle, fn  
CFSTR( "kCGImagePropertyTIFFCompression" ) )
value = compressionType
dictValue = fn CFNumberCreate( _kCFAllocatorDefault,¬
  _kCFNumberIntType, @value )
tiffOptionsDict = fn CFDictionaryCreate( _kCFAllocatorDefault,¬
  dictKey, @dictValue, 1, keyCallBacks, valueCallBacks )
CFRelease ( dictValue )

// create the parent dictionary
dictKey = fn CFBundleGetDataPointerForName¬
( fn ApplicationServicesBundle, fn  
CFSTR( "kCGImagePropertyTIFFDictionary" ) )
dict = fn CFDictionaryCreate( _kCFAllocatorDefault, dictKey, ¬
@tiffOptionsDict, 1, keyCallBacks, valueCallBacks )
CFRelease( tiffOptionsDict )
CFShow( dict )
end fn = dict


local mode
local fn WriteBitmapContextToTIFF( fileSpec as ^FSSpec, ¬
bitmapCtx as CGContextRef, compressionType as long )
'~'1
dim as OSStatus err
dim as CFURLRef url
dim as CGImageRef image
dim as CFDictionaryRef properties
dim as CGImageDestinationRef imageDestination

err = 1
url = 0
image = 0
properties = 0
imageDestination = 0

url = fn CreateCFURLFromFSSpec( fileSpec )
if ( url == 0 ) then exit "WriteBitmapContextToTIFF"

imageDestination = fn CGImageDestinationCreateWithURL¬
( url, fn CFSTR( "public.tiff" ), 1, 0)
if ( imageDestination == 0 ) then exit "WriteBitmapContextToTIFF"

image = fn CGBitmapContextCreateImage( bitmapCtx )
if ( imageDestination == 0 ) then exit "WriteBitmapContextToTIFF"

properties = fn CreateTIFFPropertiesDict( compressionType )
if ( properties ) then CGImageDestinationAddImage¬
( imageDestination, image, properties )

if ( fn CGImageDestinationFinalize( imageDestination ) ) then err =  
_noErr

"WriteBitmapContextToTIFF" // bail here
if ( imageDestination ) then CFRelease( imageDestination )
if ( properties ) then CFRelease( properties )
if ( image ) then CFRelease( image )
if ( url ) then CFRelease( url )
end fn = err
'--------------------------------------

'----------------
local fn MyCreateCGBitmapContext( myWidth as long, height as long )
'~'1
dim as CGColorSpaceRef cs
dim as CGContextRef ctx
dim as long rowBytes
dim as pointer imageBuf
dim as long xBitsPerPixel, xBitsPerComponent, xPixelFormat

ctx = 0

xBitsPerPixel = 8   : xBitsPerComponent =  8 : xPixelFormat =  
_kCGImageAlphaNone

rowBytes = myWidth * ( xBitsPerPixel / 8 )
imageBuf = fn malloc( rowBytes * height )
long if ( imageBuf )

cs =  fn CGColorSpaceCreateWithName( fn  
CFSTR( "kCGColorSpaceGenericGray" ) )
if ( cs == 0 ) then shutdown "Could not create a color space in fn  
MyCreateCGBitmapContext"

ctx = fn CGBitmapContextCreate( imageBuf, myWidth, height,¬
xBitsPerComponent, rowBytes, cs, xPixelFormat )
fn CGColorSpaceRelease( cs )
end if
end fn = ctx
'----------------------------

local mode
local fn MyDisposeCGBitmapContext( ctx as CGContextRef )
'~'1
dim as pointer imageBuf

imageBuf = fn CGBitmapContextGetData( ctx )
fn CGContextRelease( ctx )
if ( imageBuf ) then free( imageBuf )
end fn
'----------------------------

local mode
'this fn pokes values into a CGBitmapContext to demonstrate direct  
pixel manipulation
local fn makePrettyGrayPicture( pixelWidth as long, pixelHeight as  
long,¬
myPointer as pointer)
dim as long bytesInRow, x, y, adr, value

bytesInRow = pixelWidth' * 4
for x = 0 to pixelWidth - 1'make a pretty picture
for y = 0 to pixelHeight - 1
'a value to poke
value = sqr(  (pixelWidth -  x) * (pixelWidth -  x) * 6 + ¬
(pixelHeight - y) *  (pixelHeight - y)  * 6 )  mod 256
value = value + ( sqr(  (pixelWidth -  x) * ¬
(pixelWidth -  x) * 6 + y *  y  * 6 )  mod 256 )
value = value + ( sqr(  x * x * 6 + ¬
(pixelHeight - y) *  (pixelHeight - y)  * 6 )  mod 256 )
value = value + ( sqr(  x * x * 6 + y *  y  * 6 )  mod 256 )
value = value / 4
'address of pixels
adr = myPointer + y * bytesInRow + x' * 4
poke adr, value'gray

next y
next x
end fn
'----------------------------

dim as long myWidth, myHeight
dim as CGContextRef  myBitmapContext
dim as pointer myPointer
dim as FSSpec  mySpec
dim as str255 myFileName
myWidth = 640
myHeight = 480

'create a CGBitmapContext
myBitmapContext = fn MyCreateCGBitmapContext( myWidth, myHeight )
if ( myBitmapContext == 0 ) then shutdown "MyCreateCGBitmapContext  
failed"

myPointer = fn CGBitmapContextGetData( myBitmapContext )
fn makePrettyGrayPicture( myWidth, myHeight, myPointer)

myFileName = files$( _FSSpecSave, "Save a Tiff  
file","PrettyGrayPicture.tif", mySpec )
long if len(myFileName) > 0

fn WriteBitmapContextToTIFF( mySpec, myBitmapContext,  
_kTIFFCompressionTypeLZW)

shutdown "Picture saved to disk"
end if

fn MyDisposeCGBitmapContext( myBitmapContext )