[futurebasic] Re: [FB] TIFF code to FB 3?

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

From: JoeAtTIME@...
Date: Tue, 5 Dec 2000 12:00:56 EST
In a message dated 12/1/2000 6:26:41 PM, artlythere@... writes:

>Merry Listmas.
>
>Can anyone give me any guidance as to how to port the below to FB 3? It
>is
>from Paul D. Bourke's site, and writes a TIFF file.
>
>I don't know how to do the hex stuff, and file pointer as well.
>
>Appreciate any help.
>
>Extra credit if it works. :)
>

Robert,

I dont know how to port the C code, but here is some code that I wrote that 
saves uncompressed tiff files. 

Here is how to use it. First open a file for output then call:
FN 
saveTiffHeader(fileId,ImageWidth&,ImageLength&,PhotometricInt&,StripByteCounts

&) 
to write the tiff header.

this fn needs 5 variables:
fileId = id of output file
ImageWidth& = width of image in pixels
ImageLength& = height of image in pixels
PhotometricInt& = possible values -> 1 greyscale (_BlackIsZero), 2 RGB 
(_PhotoRGB), 5 CMYK (_PhotoCMYK)
StripByteCounts& = actual number of bytes in raw image (ImageWidth& * 
ImageLength& * 3 bytes per pixel for RGB image. (1 byte for greyscale or 4 
bytes for CMYK))

You also need to define two globals in your globals file and set them:

gPixPerInch# = 72 (or any other resolution you want)

gOrder=_MacOrder to save a Mac tiff file
or
gOrder=_IbmOrder to save an IBM tiff

After saving the header write the actual pixel values to the file in 
interleaved order and close the file.

-Joe

'---------------------------Tiff Constants/Globals ------------------

'---Tags constants
_ImageWidth     = 256
_ImageLength    = 257
_BitsPerSample  = 258
_Compression    = 259
_Uncompressed = 1
_PhotometricInt = 262
_BlackIsZero  = 1
_PhotoRGB     = 2
_PhotoCMYK    = 5
_StripOffsets   = 273
_SamplesPerPixel= 277
_RowsPerStrip   = 278
_StripByteCounts= 279
_XResolution    = 282
_YResolution    = 283
_ResolutionUnit = 296
_ColorMap       = 320
_ExtraSamples   = 338

'---Types constants
_byte           = 1
_ascii          = 2
_short          = 3
_long           = 4
_rational       = 5

'---Byte order
_MacOrder       = 1
_IbmOrder       = 0


'••••••••••••••••••••• Save Functions •••••••••••••••••••••
LOCAL FN swap4Bytes(adr&)

i=PEEK(adr&)
j=PEEK(adr&+1)
k=PEEK(adr&+2)
l=PEEK(adr&+3)

POKE adr&, l
POKE adr&+1, k
POKE adr&+2, j
POKE adr&+3, i
END FN

'----------
LOCAL FN swapBytes(startAdr&,bytesToSwap&)
FOR y&=0 TO bytesToSwap&-1 STEP 2
adr&=startAdr&+y&
i=PEEK WORD(adr&)
i = PEEK(@i) +  (PEEK(@i+1) << 8)
POKE WORD adr&, i
NEXT y&
END FN

'----------
LOCAL FN makeTiffHeadStart(tiffHeaderPtr&,IFDcount)
LONG IF gOrder=_MacOrder
a$="M"
XELSE
a$="I"
END IF
POKE tiffHeaderPtr&, ASC(a$)
POKE tiffHeaderPtr&+1, ASC(a$)
a%=42
IF gOrder=_IbmOrder THEN FN swapBytes(@a%,2)
POKE WORD tiffHeaderPtr&+2, a%
a&=8
IF gOrder=_IbmOrder THEN FN swap4Bytes(@a&)
POKE LONG tiffHeaderPtr&+4, a&
IF gOrder=_IbmOrder THEN FN swapBytes(@IFDcount,2)
POKE WORD tiffHeaderPtr&+8, IFDcount
count=10
END FN=count
'----------
LOCAL FN makeTiffIFD(count,tiffHeaderPtr&,tag,type,valnum&,value&)
IF gOrder=_IbmOrder THEN FN swapBytes(@tag,2)
POKE WORD tiffHeaderPtr&+count, tag
IF gOrder=_IbmOrder THEN FN swapBytes(@type,2)
POKE WORD tiffHeaderPtr&+count+2, type
IF gOrder=_IbmOrder THEN FN swap4Bytes(@valnum&)
POKE LONG tiffHeaderPtr&+count+4, valnum&
LONG IF type =_short AND valnum&=1
value%=value&
IF gOrder=_IbmOrder THEN FN swapBytes(@value%,2)
POKE WORD tiffHeaderPtr&+count+8, value%
POKE WORD tiffHeaderPtr&+count+10, 0
XELSE
IF gOrder=_IbmOrder THEN FN swap4Bytes(@value&)
POKE LONG tiffHeaderPtr&+count+8, value&
END IF
count=count+12
END FN=count
'----------
LOCAL FN 
makeTiffBits(count,tiffHeaderPtr&,offCount&,offCountAdr&,PhotometricInt&)
SELECT PhotometricInt&
CASE _BlackIsZero'grey scale 
valnum&=1
count=FN makeTiffIFD(count,tiffHeaderPtr&,_BitsPerSample,_short,valnum&,8)
CASE _PhotoRGB'= 2
valnum&=3
count=FN 
makeTiffIFD(count,tiffHeaderPtr&,_BitsPerSample,_short,valnum&,offCount&)
a=8
IF gOrder=_IbmOrder THEN FN swapBytes(@a,2)
POKE WORD tiffHeaderPtr&+offCount&, a
POKE WORD tiffHeaderPtr&+offCount&+2, a
POKE WORD tiffHeaderPtr&+offCount&+4, a
offCount&=offCount&+6
CASE _PhotoCMYK'= 5
valnum&=4
count=FN 
makeTiffIFD(count,tiffHeaderPtr&,_BitsPerSample,_short,valnum&,offCount&)
a=8
IF gOrder=_IbmOrder THEN FN swapBytes(@a,2)
POKE WORD tiffHeaderPtr&+offCount&, a
POKE WORD tiffHeaderPtr&+offCount&+2, a
POKE WORD tiffHeaderPtr&+offCount&+4, a
POKE WORD tiffHeaderPtr&+offCount&+6, a
offCount&=offCount&+8
CASE ELSE'put error checking here
END SELECT
POKE LONG offCountAdr&,offCount&'return ofset counter
END FN=count
'----------
LOCAL FN makeTiffSamples(count,tiffHeaderPtr&,tag,type,PhotometricInt&)'put 
pixles right after header
SELECT PhotometricInt&
CASE _BlackIsZero'grey scale 
value&=1
CASE _PhotoRGB'= 2
value&=3
CASE _PhotoCMYK'= 5
value&=4
CASE ELSE'put error checking here
END SELECT
count=FN makeTiffIFD(count,tiffHeaderPtr&,tag,type,1,value&)'put pixles right 
after header
END FN=count
'----------
LOCAL FN makeTiffRes(count,tiffHeaderPtr&,tag,offCount&,offCountAdr&)
count=FN makeTiffIFD(count,tiffHeaderPtr&,tag,_long,2,offCount&)
a&=gPixPerInch#
IF gOrder=_IbmOrder THEN FN swap4Bytes(@a&)
POKE LONG tiffHeaderPtr&+offCount&, a&
a&=1
IF gOrder=_IbmOrder THEN FN swap4Bytes(@a&)
POKE LONG tiffHeaderPtr&+offCount&+4, a&
offCount&=offCount&+8
POKE LONG offCountAdr&,offCount&'return ofset counter
END FN=count
'-------------------- End Save Functions --------------------
'----------
'this fn needs 4 variables:
'ImageWidth&,ImageLength&
'PhotometricInt&: possible values -> 1 greyscale, 2 RGB, 5 CMYK
'the size of the image in bytes
LOCAL FN 
saveTiffHeader(fileId,ImageWidth&,ImageLength&,PhotometricInt&,StripByteCounts

&)
numIFDs=12
headerSize&=256
tiffHeaderPtr&=FN NEWPTR(headerSize&)
err=SYSERROR
LONG IF err<>_noErr 
Msg1$="Error: Could not save TIFF header in FN saveTiffHeader"
CALL PARAMTEXT (Msg1$,"","","")'Msg$ is what goes into alert
controlNum%=FN NOTEALERT(128,0)'controlNum is which but pressed

FN DISPOSPTR(tiffHeaderPtr&)'dispose of pointer
XELSE

count=FN makeTiffHeadStart(tiffHeaderPtr&,numIFDs)
offCount&=numIFDs*12+count
count=FN makeTiffIFD(count,tiffHeaderPtr&,_ImageWidth,_long,1,ImageWidth&)
count=FN makeTiffIFD(count,tiffHeaderPtr&,_ImageLength,_long,1,ImageLength&)
count=FN 
makeTiffBits(count,tiffHeaderPtr&,offCount&,@offCount&,PhotometricInt&)
count=FN makeTiffIFD(count,tiffHeaderPtr&,_Compression,_short,1,1)
count=FN 
makeTiffIFD(count,tiffHeaderPtr&,_PhotometricInt,_short,1,PhotometricInt&)
count=FN 
makeTiffIFD(count,tiffHeaderPtr&,_StripOffsets,_long,1,headerSize&)'put 
pixles right after header
count=FN 
makeTiffSamples(count,tiffHeaderPtr&,_SamplesPerPixel,_short,PhotometricInt&)'

put pixles right after header
count=FN 
makeTiffIFD(count,tiffHeaderPtr&,_RowsPerStrip,_long,1,ImageLength&)'put 
pixles right after header
count=FN 
makeTiffIFD(count,tiffHeaderPtr&,_StripByteCounts,_long,1,StripByteCounts&)'pu

t pixles right after header
count=FN makeTiffRes(count,tiffHeaderPtr&,_XResolution,offCount&,@offCount&)
count=FN makeTiffRes(count,tiffHeaderPtr&,_YResolution,offCount&,@offCount&)
count=FN makeTiffIFD(count,tiffHeaderPtr&,_ResolutionUnit,_short,1,2)

WRITE FILE fileId,tiffHeaderPtr&,headerSize&
FN DISPOSPTR(tiffHeaderPtr&)'dispose of pointer

END IF
END FN
'----------