MT Read Clipping : Source

Name:MT Read Clipping
Event Class:XUVJ
Event ID:gclp
Resource:AEVTXUVJgclp

Source

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

global myDType:OStype, tgCre:OStype, mySize:longInt, myactSize:longInt
global theAEEvent:R,theReply:R, handerRefCon:LongInt, theDesList:R

codeResource "osax"

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

  put AESizeOfParam(theAEEvent@,keyDirectObject,myType,mySize) into err

  if err <> 0 then
    return err
  end if

  put NewPtrClear(422) into myWorkPtr

  put myWorkPtr into myFssPtr
  put myWorkPtr + 70 into myNmPtr
  put myWorkPtr + 326 into myPbPtr
  put myWorkPtr + 406 into theDescPtr
  Put myWorkPtr + 414 into theStylPtr

  if myType = "TEXT" then

    if mySize > 255 then
      DisposPtr myWorkPtr
      return -1708
    end if

    put myNmPtr+1 into aPtr
    put AEGetParamPtr(theAEEvent@,keyDirectObject,"TEXT",typeCode,aPtr,mySize,myactSize) into err
    if err <> 0 then
      DisposPtr myWorkPtr
      return err
    end if

    put NumToChar(mySize) into myNmPtr@.charType
    put myNmPtr@.Str255Type into myFname
    put FSMakeFSSpec(0, 0, myFname, myFssPtr@) into err
    if err <> 0 then
      DisPosPtr myWorkPtr
      return err
    end if

  else

    put AEGetParamPtr(theAEEvent@,keyDirectObject,typeFSS,typeCode,myFssPtr,70,myactSize) into err

    if err <> 0 then
      DisPosPtr myWorkPtr
      return err
    end if

  end if
  ----

  put AEGetParamDesc(theAEEvent@,"daty",typeType,theDescPtr@) into err
  if err <> 0 then
    put "TEXT" into myDtype
  else
    put theDescPtr@.dataHandle@@.OStype into myDtype
    put AEDisposeDesc(theDescPtr@) into err
  end if

  ----

  put myFssPtr@.IntegerType into myPbPtr@.ioVRefNum
  put myFssPtr+2 into aPtr
  put aPtr@.LongIntType into myPbPtr@.ioDrDirID
  put myFssPtr+6 into myPbPtr@.ioNamePtr

  put PBHGetFInfo(myPbPtr) into err
  if err <> 0 then
    DisposPtr myWorkPtr
    return err
  end if

  put myPbPtr + 32 into aPtr
  put aPtr@.fdCreator.OStype into tgCre
  if tgCre <> "drag" then
    DisposPtr myWorkPtr
    return -43
  end if

  put myPbPtr + 30 into aPtr
  if BitTst(aPtr,5) then
    DisposPtr myWorkPtr
    return -47
  end if

  ---

  put FSpOpenResFile(myFssPtr@, 0) into myRef
  if myRef < 0 then
    put ResError() into err
    DisPosPtr myWorkPtr
    return err
  end if

  ---
  if myDtype = "STXT" then

    put Get1Resource("drag",128) into myResHandle
    if myResHandle = NIL then
      CloseResFile myRef
      DisPosPtr myWorkPtr
      return -192
    end if

    put GetHandleSize(myResHandle) into mySize
    put (mySize div 16)-1 into dataNum

    put false into tFndFlg
    put false into sFndFlg
    put 0 into myTID
    put 0 into mySID
    --
    repeat with x = 1 to dataNum
      if myResHandle@@.OSType[x*4+1] = "TEXT" then
        put true into tFndFlg
        put myResHandle@@.integerType[(8*x)+4] into myTID
        exit repeat
      end if
    end repeat
    ---
    repeat with x = 1 to dataNum
      if myResHandle@@.OSType[x*4+1] = "styl" then
        put true into sFndFlg
        put myResHandle@@.integerType[(8*x)+4] into mySID
        exit repeat
      end if
    end repeat

    ReleaseResource myResHandle

    if not (tFndFlg and sFndFlg) then
      CloseResFile myRef
      DisPosPtr myWorkPtr
      return -192
    end if


    put AEcreateList(nil,0,true,theDescPtr@) into err
    ---
    put Get1Resource("TEXT",myTID) into myResHandle
    if myResHandle = NIL then
      put AEDisposeDesc(theDescPtr@) into err
      CloseResFile myRef
      DisPosPtr myWorkPtr
      return -192
    end if

    put GetHandleSize(myResHandle) into mySize
    HLock myResHandle
    put AePutKeyPtr(theDescPtr@,"ktxt","TEXT",myResHandle@,mySize) into xerr
    HUnlock myResHandle
    ReleaseResource myResHandle

    if xerr <> 0 then
      put AEDisposeDesc(theDescPtr@) into err
      CloseResFile myRef
      DisPosPtr myWorkPtr
      return xerr
    end if
    ----
    put Get1Resource("styl",mySID) into myResHandle
    if myResHandle = NIL then
      put AEDisposeDesc(theDescPtr@) into err
      CloseResFile myRef
      DisPosPtr myWorkPtr
      return -192
    end if

    put GetHandleSize(myResHandle) into mySize
    HLock myResHandle
    put AePutKeyPtr(theDescPtr@,"ksty","styl",myResHandle@,mySize) into xerr
    HUnlock myResHandle
    ReleaseResource myResHandle

    if xerr <> 0 then
      put AEDisposeDesc(theDescPtr@) into err
      CloseResFile myRef
      DisPosPtr myWorkPtr
      return xerr
    end if
    ---

    put AECoerceDesc(theDescPtr@,"STXT",theStylPtr@) into xerr
    CloseResFile myRef

    if xerr <> 0 then
      put AEDisposeDesc(theStylPtr@) into err
      put AEDisposeDesc(theDescPtr@) into err
      DisposPtr myWorkPtr
      return xerr
    end if

    if theReply@.descriptorType <> typeNull then
      put AEPutParamDesc(theReply@, keyDirectObject,theStylPtr@) into err
    end if

    put AEDisposeDesc(theStylPtr@) into err
    put AEDisposeDesc(theDescPtr@) into err
    DisposPtr myWorkPtr
    return 0

  else

    put Get1Resource("drag",128) into myResHandle

    if myResHandle = NIL then

      put Count1Resources(myDtype) into dataNum
      if dataNum = 0 then
        CloseResFile myRef
        DisPosPtr myWorkPtr
        return -192
      end if

      put true into fndFlg
      put Get1IndResource(myDType,1) into myResHandle

    else

      put GetHandleSize(myResHandle) into mySize
      put (mySize div 16)-1 into dataNum
      put 0 into myID
      put false into fndFlg

      repeat with x = 1 to dataNum
        if myResHandle@@.OSType[x*4+1] = myDType then
          put true into fndFlg
          put myResHandle@@.integerType[(8*x)+4] into myID
          exit repeat
        end if
      end repeat
      ---
      ReleaseResource myResHandle

      if not fndFlg then
        CloseResFile myRef
        DisPosPtr myWorkPtr
        return -192
      end if

      put Get1Resource(myDType,myID) into myResHandle
      if myResHandle = NIL then
        CloseResFile myRef
        DisPosPtr myWorkPtr
        return -192
      end if

    end if

    put GetHandleSize(myResHandle) into mySize

    if theReply@.descriptorType <> typeNull then
      HLock myResHandle
      put AEPutParamPtr(theReply@, keyDirectObject,myDType,myResHandle@,mySize) into err
      HUnlock myResHandle
    end if

    ReleaseResource myResHandle
    CloseResFile myRef
    DisposPtr myWorkPtr

    return err

  end if


  ---

end getClippingData


Tanaka's osax : Source
Tanaka's osax