MT Write Pict File : Source

Name:MT Write Pict File
Event Class:XUVJ
Event ID:wpic
Resource:AEVTXUVJwpic

Source

--- This source is written in HyperTalk for CompileIt!

global myType:OStype, mySize:longInt, myactSize:longInt
global theAEEvent:R,theReply:R, handerRefCon:LongInt
global myFcre:OSType, myFtype:OStype

codeResource "osax"

pascal function WriteToPictFile:I theAEEvent:R, theReply:R, handerRefCon:L

  put NewPtrClear(590) into myWorkPtr

  put myWorkPtr into myDescPtr
  put myWorkPtr + 8 into myFssPtr
  put myWorkPtr + 78 into DumPtr

  put AEGetParamDesc(theAEEvent@,"fcrt",typeType,myDescPtr@) into err
  if myDescPtr@.descriptorType = typeNull then
    put "ttxt" into myFcre
  else
    put myDescPtr@.dataHandle@@.OStype into myFcre
  end if
  put AEDisposeDesc(myDescPtr@) into err
  ---

  put AEGetParamPtr(theAEEvent@,"tgfl",typeFSS,typeCode,myFssPtr,70,myactSize) into err
  if err <> 0 then
    DisPosPtr myWorkPtr
    return err
  end if

  ---
  put AEGetParamDesc(theAEEvent@,keyDirectObject,"PICT",myDescPtr@) into err
  if err <> 0 then
    DisposPtr myWorkPtr
    return err
  end if
  if myDescPtr@.descriptorType = typeNull then
    DisposPtr myWorkPtr
    return -1708
  else
    put myDescPtr@.dataHandle into myPictHandle
    put GetHandleSize(myPictHandle) into myLen

  end if
  ---

  put 512 into dumLen
  put FSpOpenDF(myFssPtr@,fsRdWrPerm,myRefnum) into err

  if err<>0 and err<>-43 then
    DisPosPtr myFssPtr
    DisposHandle myPictHandle
    return err
  end if

  if err = -43 then
    put FSpCreate(myFssPtr@, myFcre, "PICT", 0) into err
    if err = 0 then
      put FSpOpenDF(myFssPtr@,fsRdWrPerm,myRefnum) into err
    end if
  end if

  if err = 0 then

    HLock myPictHandle
    put SetFPos(myrefNum,1,0) into ferr
    put FSWrite(myrefNum,dumLen,DumPtr) into err
    put FSWrite(myrefNum,myLen,myPictHandle@) into err
    put SetEOF(myrefNum,(myLen+512)) into ferr
    Hunlock myPictHandle

    put FSClose(myrefNum) into ferr
    put FlushVol(nil,(myFssPtr@.IntegerType)) into xerr
  end if

  put AEDisposeDesc(myDescPtr@) into err

  DisPosPtr myWorkPtr


  return err

end WriteToPictFile

Tanaka's osax : Source
Tanaka's osax