PC Home 49/PC_Home_Issue_49.iso/winprogs/playsk/dohintro.dxr/00001.ls

Text File | 1996-06-30 | 18.3 KB | 570 lines

on ExportScript
  ExportPrologue()
  set artList to []
  set spriteList to []
  AnalyzeTheScript(artList, spriteList)
  ReallyExportScript(artList, spriteList)
  put "...done"
end

on ExportArt
  ExportPrologue()
  set artList to []
  set spriteList to []
  AnalyzeTheScript(artList, spriteList)
  ReallyExportArt(artList)
  put "...done"
end

on ExportBoth
  ExportPrologue()
  set artList to []
  set spriteList to []
  AnalyzeTheScript(artList, spriteList)
  ReallyExportScript(artList, spriteList)
  ReallyExportArt(artList)
  put "...done"
end

on ExportPrologue
  global gTheLastAnimationChannel, gStartFrameLabel, gEndFrameLabel, gCommandScript, gCommandScriptLines
  set gTheLastAnimationChannel to 40
  set gStartFrameLabel to "theStart"
  set gEndFrameLabel to "theEnd"
  set gCommandScript to EMPTY
  set gCommandScriptLines to 0
end

on AnalyzeTheScript usefulArtList, usefulSpriteList
  global gTheLastAnimationChannel, gStartFrameLabel, gEndFrameLabel
  put "Analyzing the script for art and sprites...."
  set startFrame to label(gStartFrameLabel)
  set endFrame to label(gEndFrameLabel)
  if (startFrame = 0) or (endFrame = 0) then
    put "Hey: missing label '" & gStartFrameLabel, "' or '" & gEndFrameLabel & "'"
    abort()
  end if
  if startFrame > endFrame then
    put "Hey: label '" & gStartFrameLabel & "' needs to come before label '" & gEndFrameLabel & "'"
    abort()
  end if
  repeat with aFrame = startFrame to endFrame
    go(aFrame)
    repeat with aSprite = 2 to gTheLastAnimationChannel
      set aCast to the castNum of sprite aSprite
      if aCast = 0 then
        set usefulPicture to 0
      else
        if the castType of cast aCast = #bitmap then
          set usefulPicture to 1
        else
          if the castType of cast aCast = #picture then
            set usefulPicture to 1
          else
            set usefulPicture to 0
          end if
        end if
      end if
      if usefulPicture then
        set currentWidth to the right of sprite aSprite - the left of sprite aSprite
        set currentHeight to the bottom of sprite aSprite - the top of sprite aSprite
        set pictureEntry to [aCast, currentWidth, currentHeight]
        if not ListContains(usefulArtList, pictureEntry) then
          add(usefulArtList, pictureEntry)
        end if
        if not ListContains(usefulSpriteList, aSprite) then
          add(usefulSpriteList, aSprite)
        end if
      end if
    end repeat
  end repeat
  if (count(usefulArtList) = 0) or (count(usefulSpriteList) = 0) then
    put "Hmm, no art found in scripts..."
  end if
  sort(usefulSpriteList)
end

on PickCastMemberFileName itemIndex, addExtension
  set baseName to the movie
  if itemIndex < 10 then
    set padding to "000"
  else
    if itemIndex < 100 then
      set padding to "00"
    else
      if itemIndex < 1000 then
        set padding to "0"
      else
        set padding to EMPTY
      end if
    end if
  end if
  if addExtension then
    set extension to ".PICT"
  else
    set extension to EMPTY
  end if
  return baseName & "_" & padding & string(itemIndex) & extension
end

on ListContains aList, anEntry
  return ListIndex(aList, anEntry) > 0
end

on ListIndex aList, anEntry
  repeat with index = 1 to count(aList)
    if SafeEquals(getAt(aList, index), anEntry) then
      return index
    end if
  end repeat
  return 0
end

on SafeEquals thing1, thing2
  set isList1 to listp(thing1)
  set isList2 to listp(thing2)
  if isList1 and isList2 then
    set size1 to count(thing1)
    set size2 to count(thing2)
    if size1 <> size2 then
      return 0
    end if
    repeat with index = 1 to size1
      if not SafeEquals(getAt(thing1, index), getAt(thing2, index)) then
        return 0
      end if
    end repeat
    return 1
  else
    return thing1 = thing2
  end if
end

on ReadNumericText spriteNumber, defaultValue, numberName
  set thisCastNumber to the castNum of sprite spriteNumber
  if thisCastNumber <> 0 then
    if the castType of cast thisCastNumber <> #empty then
      if the castType of cast thisCastNumber <> #text then
        put "Hey: bad " & numberName
        abort()
      end if
      if not integerp(value(the text of cast thisCastNumber)) then
        put "Hey: bad " & numberName
        abort()
      end if
      return value(the text of cast thisCastNumber)
    end if
  end if
  return defaultValue
end

on GetNumericText theString, numberName
  if integerp(value(theString)) then
    return value(theString)
  else
    put "Hey: bad " & numberName
    abort()
  end if
end

on ReadCommandScript headerScript
  global gCommandScript, gCommandScriptLines
  set gCommandScript to EMPTY
  set gCommandScriptLines to 0
  if the frameScript = 0 then
    exit
  end if
  if headerScript then
    set usefulCommands to ["NumberOfCommands:", "DropFrame:", "ActorLayer:"]
  else
    set usefulCommands to ["Loop:", "KeyFrame:", "Pause:", "Sound:", "Command:", "Goto:", "JumpIfQuiet:"]
  end if
  set lineCount to the number of lines in the scriptText of cast the frameScript
  repeat with i = 1 to lineCount
    set theLine to line i of the scriptText of cast the frameScript
    if theLine starts "-- " then
      if i = 1 then
        set gCommandScript to theLine
      else
        set gCommandScript to gCommandScript & RETURN & theLine
      end if
      set gCommandScriptLines to gCommandScriptLines + 1
      set theWord to word 2 of theLine
      if not ListContains(usefulCommands, theWord) then
        put "Hey: unknown directive '" & theWord & "'"
        abort()
      end if
      next repeat
    end if
    if theLine = EMPTY then
      exit repeat
      next repeat
    end if
    put "Hey: bad command script"
    abort()
  end repeat
end

on ReallyExportScript artList, usefulSpriteList
  global gStartFrameLabel, gEndFrameLabel
  if count(usefulSpriteList) = 0 then
    set numOfChannels to 1
  else
    set numOfChannels to max(usefulSpriteList)
  end if
  set spriteInfoList to []
  repeat with index = 1 to numOfChannels
    add(spriteInfoList, [0, 0, 0, 0, index - 1])
  end repeat
  set frameInfoList to [0, [-1], []]
  set animationInfoList to [0, 0, 2, 1]
  AnalyzeHeaderInfo(animationInfoList, spriteInfoList)
  WriteHeader(numOfChannels, animationInfoList)
  set startFrame to label(gStartFrameLabel)
  set endFrame to label(gEndFrameLabel)
  repeat with aFrame = startFrame to endFrame
    go(aFrame)
    put "processing frame: " & the frame
    ReadCommandScript(0)
    WriteNewFrame(the frame, frameInfoList)
    CheckForSounds(animationInfoList)
    repeat with spriteSlot = 2 to numOfChannels
      WritePictureInfo(spriteSlot, spriteInfoList, getAt(frameInfoList, 1), artList)
    end repeat
    CheckForCommands(animationInfoList)
    CheckForGoto(frameInfoList)
  end repeat
  CleanUp()
  set declaredLabels to getAt(frameInfoList, 2)
  set gotoLabels to getAt(frameInfoList, 3)
  repeat with theLabel in gotoLabels
    if getOne(declaredLabels, theLabel) = 0 then
      put "Hey: said goto " & theLabel & ", but label not declared"
      abort()
    end if
  end repeat
end

on AnalyzeHeaderInfo animationInfoList, spriteInfoList
  global gCommandScript, gCommandScriptLines
  go(1)
  ReadCommandScript(1)
  repeat with lineNumber = 1 to gCommandScriptLines
    set theLine to line lineNumber of gCommandScript
    set theWord to word 2 of theLine
    if theWord = "NumberOfCommands:" then
      setAt(animationInfoList, 1, GetNumericText(word 3 of theLine, "Number of commands"))
      next repeat
    end if
    if theWord = "DropFrame:" then
      setAt(animationInfoList, 2, GetNumericText(word 3 of theLine, "Drop frame"))
      next repeat
    end if
    if theWord = "ActorLayer:" then
      set theActor to GetNumericText(word 3 of theLine, "Actor layer")
      set theLayer to GetNumericText(word 4 of theLine, "Actor layer")
      set spriteInfo to getAt(spriteInfoList, theActor)
      setAt(spriteInfo, 5, theLayer)
    end if
  end repeat
end

on WriteHeader numberOfActors, animationInfoList
  global FileIO, fileObj
  if objectp(fileObj) then
    fileObj(mdispose)
  end if
  set scriptName to the movie & ".scr"
  set fileObj to FileIO(mnew, "write", the pathName & scriptName)
  set numberOfCommands to getAt(animationInfoList, 1)
  set dropFrames to getAt(animationInfoList, 2)
  if fileObj(mStatus) <> 0 then
    put "Hey: could not create: ", scriptName & "!"
    abort()
  end if
  fileObj(mWriteString, "Animation " & the movie & RETURN)
  fileObj(mWriteString, "BEGIN" & RETURN)
  fileObj(mWriteString, TAB & "f_NumberOfActors " & numberOfActors - 1 & RETURN)
  fileObj(mWriteString, TAB & "f_NumberOfSoundChannels " & 2 & RETURN)
  fileObj(mWriteString, TAB & "f_NumberOfCommands " & numberOfCommands & RETURN)
  fileObj(mWriteString, TAB & "f_DropFrame " & dropFrames & RETURN)
end

on WriteNewFrame whichFrame, frameInfoList
  global fileObj, gStartFrameLabel, gCommandScript, gCommandScriptLines
  set hasSomeLabel to 0
  if the frameLabel = gStartFrameLabel then
    set currentFrameLabel to 1
    set hasSomeLabel to 1
  else
    if the frameLabel <> EMPTY then
      if integerp(value(the frameLabel)) then
        set currentFrameLabel to value(the frameLabel)
        set hasSomeLabel to 1
      end if
    end if
  end if
  if hasSomeLabel then
    set currentListOfLabels to getAt(frameInfoList, 2)
    if ListContains(getAt(frameInfoList, 2), currentFrameLabel) then
      put "Hey: duplicate label " & string(currentFrameLabel)
      abort()
    end if
  end if
  if hasSomeLabel then
    setAt(frameInfoList, 1, 1)
    add(getAt(frameInfoList, 2), currentFrameLabel)
  else
    setAt(frameInfoList, 1, 0)
    set currentFrameLabel to 0
  end if
  set currentFrameTempo to 1000 / the frameTempo
  set loopFrames to 0
  set loopCount to 0
  set keyFrame to 0
  repeat with lineNumber = 1 to gCommandScriptLines
    set theLine to line lineNumber of gCommandScript
    set theWord to word 2 of theLine
    if theWord = "Loop:" then
      set loopFrames to GetNumericText(word 3 of theLine, "Loop frame")
      if word 4 of theLine = "sound" then
        set loopCount to GetNumericText(word 5 of theLine, "Loop sound")
        if (loopCount <> 1) and (loopCount <> 2) then
          put "Hey: we only support two sound channels"
          abort()
        end if
        set loopCount to -loopCount
      else
        set loopCount to GetNumericText(word 4 of theLine, "Loop count")
      end if
      setAt(frameInfoList, 1, 1)
      next repeat
    end if
    if theWord = "KeyFrame:" then
      set keyFrame to GetNumericText(word 3 of theLine, "Key frame")
      next repeat
    end if
    if theWord = "Pause:" then
      set pauseTime to GetNumericText(word 3 of theLine, "Pause amount")
      if pauseTime < 0 then
        put "Hey: bad pause amount"
        abort()
        next repeat
      end if
      if pauseTime = 0 then
        set currentFrameTempo to -1
        next repeat
      end if
      set currentFrameTempo to pauseTime
    end if
  end repeat
  fileObj(mWriteString, TAB & "f_Frame (" & currentFrameLabel & ", " & currentFrameTempo & ", " & loopFrames & ", " & loopCount & ")" & RETURN)
  if keyFrame <> 0 then
    fileObj(mWriteString, TAB & TAB & "f_KeyFrame " & keyFrame & RETURN)
  end if
end

on CleanUp
  global fileObj
  fileObj(mWriteString, "END" & RETURN)
  fileObj(mdispose)
end

on CheckForSounds animationInfoList
  global fileObj, gCommandScript, gCommandScriptLines
  repeat with lineNumber = 1 to gCommandScriptLines
    set theLine to line lineNumber of gCommandScript
    set theWord to word 2 of theLine
    if theWord = "Sound:" then
      set whichChannel to GetNumericText(word 3 of theLine, "Channel number")
      set soundName to word 4 of theLine
      if soundName = "STOP" then
        fileObj(mWriteString, TAB & TAB & "f_SoundChannel (" & whichChannel - 1 & ", 0, 0, 0)" & RETURN)
        next repeat
      end if
      set loopIt to 0
      set ourPriority to getAt(animationInfoList, whichChannel + 2)
      if word 5 of theLine = "Loop" then
        set loopIt to 1
        if word 6 of theLine <> EMPTY then
          set ourPriority to GetNumericText(word 6 of theLine, "Sound priority")
        end if
      else
        if word 5 of theLine <> EMPTY then
          set ourPriority to GetNumericText(word 5 of theLine, "Sound priority")
        end if
      end if
      setAt(animationInfoList, whichChannel + 2, ourPriority)
      fileObj(mWriteString, TAB & TAB & "f_SoundChannel (" & whichChannel - 1 & ", 1, " & loopIt & ", " & ourPriority & ")" & RETURN)
      fileObj(mWriteString, TAB & TAB & "f_SoundEffect '" & soundName & "'" & RETURN)
    end if
  end repeat
end

on WritePictureInfo currentSpriteSlot, spriteInfoList, forceWrite, artList
  global fileObj
  set theCastMember to the castNum of sprite currentSpriteSlot
  if theCastMember = 0 then
    set usefulPicture to 0
  else
    if the castType of cast theCastMember = #bitmap then
      set usefulPicture to 1
    else
      if the castType of cast theCastMember = #picture then
        set usefulPicture to 1
      else
        set usefulPicture to 0
      end if
    end if
  end if
  set previousSpriteInfo to getAt(spriteInfoList, currentSpriteSlot)
  set previousLayer to getAt(previousSpriteInfo, 5)
  if usefulPicture then
    set currentLeft to the left of sprite currentSpriteSlot
    set currentTop to the top of sprite currentSpriteSlot
    set currentWidth to the right of sprite currentSpriteSlot - currentLeft
    set currentHeight to the bottom of sprite currentSpriteSlot - currentTop
    set pictureEntry to ListIndex(artList, [theCastMember, currentWidth, currentHeight])
    if pictureEntry = 0 then
      put "Hey: couldn't find an entry for [ " & theCastMember && currentWidth && currentHeight & " ]!!"
      abort()
    end if
    set currentSpriteThing to [pictureEntry, 1, currentLeft, currentTop, previousLayer]
  else
    if forceWrite then
      set currentSpriteThing to [0, 0, 0, 0, previousLayer]
    else
      set currentSpriteThing to [getAt(previousSpriteInfo, 1), 0, 0, 0, previousLayer]
    end if
  end if
  if not SafeEquals(currentSpriteThing, previousSpriteInfo) or forceWrite then
    set actorNumber to currentSpriteSlot - 2
    set currentLeft to getAt(currentSpriteThing, 3)
    set currentTop to getAt(currentSpriteThing, 4)
    if getAt(currentSpriteThing, 2) then
      set currentLayer to getAt(currentSpriteThing, 5)
    else
      set currentLayer to -1
    end if
    fileObj(mWriteString, TAB & TAB & "f_Actor (" & actorNumber & ", " & currentLayer & ", " & currentLeft & ", " & currentTop & ")" & RETURN)
    set oldArtItem to getAt(previousSpriteInfo, 1)
    set newArtItem to getAt(currentSpriteThing, 1)
    if (newArtItem <> 0) and (forceWrite or (newArtItem <> oldArtItem)) then
      set thisCastName to PickCastMemberFileName(newArtItem, 0)
      fileObj(mWriteString, TAB & TAB & "f_ActorPicture " & "'" & thisCastName & "'" & RETURN)
    end if
  end if
  setAt(spriteInfoList, currentSpriteSlot, currentSpriteThing)
end

on CheckForCommands animationInfoList
  global fileObj, gCommandScript, gCommandScriptLines
  repeat with lineNumber = 1 to gCommandScriptLines
    set theLine to line lineNumber of gCommandScript
    set theWord to word 2 of theLine
    if theWord = "Command:" then
      set theCommand to GetNumericText(word 3 of theLine, "Command number")
      if (theCommand < 0) or (theCommand >= getAt(animationInfoList, 1)) then
        put "Hey: command value out of range"
        abort()
      end if
      fileObj(mWriteString, TAB & TAB & "f_ExecuteCommand " & theCommand & RETURN)
    end if
  end repeat
end

on CheckForGoto frameInfoList
  global fileObj, gCommandScript, gCommandScriptLines
  set foundGoto to 0
  repeat with lineNumber = 1 to gCommandScriptLines
    set theLine to line lineNumber of gCommandScript
    set theWord to word 2 of theLine
    if theWord = "Goto:" then
      if foundGoto then
        put "Hey: more than one goto in script!"
        abort()
      end if
      set theLabel to GetNumericText(word 3 of theLine, "Label number")
      fileObj(mWriteString, TAB & TAB & "f_GotoFrame " & theLabel & RETURN)
      set gotoList to getAt(frameInfoList, 3)
      add(gotoList, theLabel)
      set foundGoto to 1
      next repeat
    end if
    if theWord = "JumpIfQuiet:" then
      if foundGoto then
        put "Hey: JumpIfQuiet needs to go before Goto!"
        abort()
      end if
      set theChannel to GetNumericText(word 3 of theLine, "Sound channel")
      set theLabel to GetNumericText(word 4 of theLine, "Label number")
      fileObj(mWriteString, TAB & TAB & "f_MaybeGotoFrame (" & theChannel - 1 & ", " & theLabel & ")" & RETURN)
      set gotoList to getAt(frameInfoList, 3)
      add(gotoList, theLabel)
    end if
  end repeat
end

on ReallyExportArt artList
  set oldColorDepth to the colorDepth
  set the colorDepth to 8
  OpenPictureExporter()
  ExportPictures(artList)
  ClosePictureExporter()
  set the colorDepth to oldColorDepth
end

on OpenPictureExporter
  global copyObj
  if objectp(copyObj) then
    copyObj(mdispose)
  end if
  set copyObj to StageToPICT(mnew)
end

on ClosePictureExporter
  global copyObj
  if objectp(copyObj) then
    copyObj(mdispose)
  end if
end

on ExportPictures artList
  go(label(gEndFrameLabel) + 1)
  if the castNum of sprite 1 = 0 then
    put "Hey: missing sprite in channel 1 in frame after 'theEnd'"
    abort()
  end if
  repeat with index = 1 to count(artList)
    set subItem to getAt(artList, index)
    ExportOnePicture(index, getAt(subItem, 1), getAt(subItem, 2), getAt(subItem, 3))
  end repeat
end

on ExportOnePicture artIndex, theCastMember, itsWidth, itsHeight
  global copyObj, oldFile
  put "exporting cast" && theCastMember && "at" && itsWidth && "x" && itsHeight
  set the ink of sprite 1 to 0
  set the castNum of sprite 1 to theCastMember
  updateStage()
  set newLeft to ((the stageRight - the stageLeft) / 2) - (itsWidth / 2)
  set newTop to ((the stageBottom - the stageTop) / 2) - (itsHeight / 2)
  set newRight to newLeft + itsWidth
  set newBottom to newTop + itsHeight
  spriteBox(1, newLeft, newTop, newRight, newBottom)
  updateStage()
  set fileName to the pathName & PickCastMemberFileName(artIndex, 1)
  if objectp(oldFile) then
    oldFile(mdispose)
  end if
  set oldFile to FileIO(mnew, "read", fileName)
  if objectp(oldFile) then
    set theErr to oldFile(mDelete)
  end if
  set theErr to copyObj(mSaveAsPICT, the top of sprite 1, the left of sprite 1, the bottom of sprite 1, the right of sprite 1, fileName)
  if theErr <> 0 then
    put "Hey: cast member" && theCastMember && "failed to export!"
    abort()
  end if
end