Star Trek Starfleet Academy Mini Omnipedia/MINI_OMNI.ISO/pc/omni_v2.dxr/00421_ImportParent.ls

Text File | 1996-04-15 | 13.0 KB | 455 lines

property iAttribListCast, iAttribList, iFirstDumpCast, iLastDumpCast, iFolderPath, iTopicAddList, iTopicDeleteList, iKeyScriptHolder, iNameChangeType, iLastTopicName, iFieldWindow, iSkipSave
global oFile, oIndexMediator, gTopicNameField, oTextScroller, gScrollIncrK, oImportSlider, gDirectOrFolderK, gAddField, gDeleteField, oVidCD

on birth me
  set iKeyScriptHolder to EMPTY
  set iFieldWindow to 234
  set iAttribListCast to the number of cast "ATTRIB_A_TOPICS"
  set iAttribList to value(the text of cast iAttribListCast)
  set iFirstDumpCast to 3900
  set iLastDumpCast to 3998
  set iFolderPath to the pathName & "USERARTS" & mGetFileDelimiter(oFile)
  set oImportSlider to birth(script "SliderManagerTall", 0, 1, "mImportScroll(oTextScroller,mShowVal(oImportSlider))", 21, 146, 150, 20, 144, 335, 0, 0)
  set gTopicNameField to the number of cast "TopicFileName"
  set iNameChangeType to #none
  sort(iAttribList)
  return me
end

on mStripChars me, pText, psearchitem
  set vFound to 1
  repeat while vFound
    set vFound to offset(psearchitem, pText)
    if vFound then
      delete char vFound of pText
    end if
  end repeat
end

on mReport me, pWhat
  put pWhat into field "article_status"
end

on mFormatText me, pText
  mStripChars(me, pText, "~")
  put "•" before pText
  set vTitle to line 1 of pText
  set vWordsinTitle to the number of words in vTitle
  delete line 1 of pText
  set vMarkerList to [:]
  set vTextLen to the number of words in pText
  set vWordNum to 1
  set vFound to 0
  repeat while vWordNum <= vTextLen
    if word vWordNum of pText starts "@" then
      set vStart to vWordNum
      set vDone to 0
      put EMPTY into char 1 of word vWordNum of pText
      repeat while not vDone
        if word vWordNum of pText contains "@" then
          if the last char in word vWordNum of pText = "@" then
            put EMPTY into char length(word vWordNum of pText) of word vWordNum of pText
            set vend to vWordNum
            set vDone to 1
          else
            put " " into char offset("@", word vWordNum of pText) of word vWordNum of pText
            set vTextLen to vTextLen + 1
            set vend to vWordNum
            set vDone to 1
          end if
          next repeat
        end if
        set vWordNum to vWordNum + 1
      end repeat
      addProp(vMarkerList, vStart + vWordsinTitle, list(vend - vStart + 1, #b))
      next repeat
    end if
    set vWordNum to vWordNum + 1
  end repeat
  set vMarkerList to string(vMarkerList)
  delete char 1 of vMarkerList
  delete char length(vMarkerList) of vMarkerList
  mStripChars(me, pText, "@")
  put "~" & vMarkerList & "@1" & vTitle & "@2" before line 1 of pText
  put RETURN & RETURN after pText
  return pText
end

on mFindCastSpace me, pTextSize
  set vFound to 0
  set vCastLoc to iFirstDumpCast - 1
  repeat while (vFound = 0) and (vCastLoc <= iLastDumpCast)
    set vCastLoc to vCastLoc + 1
    set vFound to the castType of cast vCastLoc = #empty
  end repeat
  if vFound then
    return vCastLoc
  else
    return 0
  end if
end

on mStoreText me, pText
  set vCastLoc to mFindCastSpace(me, the number of chars in pText)
  set vItem to 0
  if vCastLoc = 0 then
    alert("You have filled the available space for custom articles.")
  else
    put pText into field vCastLoc
    set vNumItems to the number of items in field vCastLoc
  end if
  return vCastLoc
end

on mProcessNewText me, pText
  set pText to mFormatText(me, pText)
  set vOldDelim to the itemDelimiter
  set the itemDelimiter to "@"
  set vTitle to item 2 of pText
  set the itemDelimiter to vOldDelim
  set vCompletionCode to 0
  if (length(vTitle) <= 40) and (length(vTitle) > 0) then
    set vOldDelim to the itemDelimiter
    set the itemDelimiter to "@"
    set vTitle to item 2 of pText
    delete char 1 of vTitle
    set the itemDelimiter to vOldDelim
    set vNewLoc to mStoreText(me, pText)
    if not voidp(getaProp(iAttribList, vTitle)) then
      set vCompletionCode to 4
      set iNameChangeType to #replace
      erase(cast vNewLoc)
    else
      if vNewLoc > 0 then
        addProp(iAttribList, vTitle, [0, 0, [0], -1, 0, 0, 0, 1, vNewLoc, 2])
        set vCompletionCode to 1
        set iNameChangeType to #none
        set the text of cast vNewLoc to mMakeCurlies(me, vNewLoc)
      else
        set vCompletionCode to 3
        set iNameChangeType to #none
        erase(cast vNewLoc)
      end if
    end if
  else
    set vCompletionCode to 2
    set iNameChangeType to #append
  end if
  set iLastTopicName to char 1 to 40 of vTitle
  return vCompletionCode
end

on mGetUserAddList me
  set iTopicAddList to [:]
  set vLInes to the number of lines in field gAddField
  repeat with x = 1 to vLInes
    if the textStyle of line x of field gAddField = "Bold" then
      if line x of field gAddField <> EMPTY then
        addProp(iTopicAddList, line x of field gAddField, x)
      end if
    end if
  end repeat
end

on mGetUserDeleteList me
  set iTopicDeleteList to [:]
  set vLInes to the number of lines in field gDeleteField
  repeat with x = 1 to vLInes
    if the textStyle of line x of field gDeleteField = "Bold" then
      if line x of field gDeleteField <> EMPTY then
        addProp(iTopicDeleteList, line x of field gDeleteField, x)
        next repeat
      end if
    end if
  end repeat
end

on mPrepToGetUserAdds me
  set iAttribList to value(the text of cast iAttribListCast)
  sort(iAttribList)
  mGetUserAddList(me)
end

on mStartUserImport me
  mGetUserAddList(me)
  if count(iTopicAddList) > 0 then
    mPrepToGetUserAdds(me)
    mUnPuppetSlider(oImportSlider)
    go("addLoop")
  end if
end

on mFinishUserImport me
  put string(iAttribList) into field iAttribListCast
  mUpdateTopicIndex(oIndexMediator)
  if not iSkipSave then
    if mRunningFromHD(oVidCD) then
      mReport(me, "Now Saving. Takes about one minute. Please wait.")
      saveMovie()
    end if
  end if
  set iSkipSave to 0
  mReport(me, "Available files from" && gDirectOrFolderK && "USERARTS")
  go("TopicAdd")
  mCheckImportScroll(me, gAddField)
end

on mStartUserDelete me
  global gIndexSND
  mGetUserDeleteList(me)
  if count(iTopicDeleteList) then
    mReport(me, "Deleting files one moment please...")
    mUnPuppetSlider(oImportSlider)
    go("DeleteLoop")
    mDeleteEntryList(me)
    go("TopicDelete")
    mCheckImportScroll(me, gDeleteField)
    if mRunningFromHD(oVidCD) then
      mReport(me, "Now Saving. Takes about one minute. Please wait.")
      saveMovie()
    else
    end if
  end if
  hearit(gIndexSND)
  mReport(me, "Delete complete.")
end

on mUserAddLoop me, pX
  if count(iTopicAddList) > 0 then
    mGetNextFile(me)
    go(the frame)
    if voidp(pX) then
      mReport("Adding Files, one moment please...")
    end if
  else
    mFinishUserImport(me)
  end if
end

on mGetNextFile me
  set vFileName to getPropAt(iTopicAddList, 1)
  set vNewText to mGetFile(oFile, iFolderPath & vFileName)
  if iNameChangeType = #replace then
    put the text of field gTopicNameField into line 1 of vNewText
    if char 1 of vNewText = "•" then
      delete char 1 of vNewText
    end if
  else
    if iNameChangeType = #append then
      put the text of field gTopicNameField & RETURN before vNewText
      if char 1 of vNewText = "•" then
        delete char 1 of vNewText
      end if
    end if
  end if
  set vImportResult to mProcessNewText(me, vNewText)
  if vImportResult = 1 then
    set vLine to getAt(iTopicAddList, 1)
    if the number of lines in field gAddField = 1 then
      put "." into line 1 of field gAddField
    else
      delete line vLine of field gAddField
    end if
    set iTopicAddList to iTopicAddList - 1
    deleteAt(iTopicAddList, 1)
  else
    if vImportResult = 2 then
      mGoToBadName(me)
      set vLastName to iLastTopicName
      if vLastName starts "•" then
        delete char 1 of vLastName
      end if
      put vLastName into field gTopicNameField
    else
      if vImportResult = 3 then
        alert("This file is full.  There is no more storage available for custom articles.")
        set iTopicAddList to [:]
        set the textStyle of field gAddField to "Plain"
      else
        set vLastName to iLastTopicName
        if vLastName starts "•" then
          delete char 1 of vLastName
        end if
        put vLastName into field gTopicNameField
        go("same")
      end if
    end if
  end if
end

on mSkipNewEntry me
  set iSkipSave to 1
  set vLine to getAt(iTopicAddList, 1)
  set the textStyle of line vLine of field gAddField to "plain"
  deleteAt(iTopicAddList, 1)
  go("SKIPLoop")
end

on mReplaceSameName me
  mDeleteSingleEntry(me, iLastTopicName)
  go("AddLoop")
end

on mReNameNewTopic me
  mGetNewName(me)
end

on mGoToBadName me
  go("Bad")
end

on mGetNewName me
  go("New")
  puppetSprite(30, 1)
  set the editableText of sprite 30 to 1
  set vLastName to iLastTopicName
  if vLastName starts "•" then
    delete char 1 of vLastName
  end if
  put vLastName into field gTopicNameField
  set the selStart to 0
  set the selEnd to 41
  mStoreKeyDown(me)
  set the keyDownScript to "hTopicKeys"
end

on mCancelNewName me
  puppetSprite(30, 0)
  set the editableText of sprite 30 to 0
  set vLineNum to getAt(iTopicAddList, 1)
  set the textStyle of line vLineNum of field gAddField to "Plain"
  deleteAt(iTopicAddList, 1)
  mRestoreKeydown(me)
  go("AddLoop")
end

on mStoreKeyDown me
  if the keyDownScript <> "hTopicKeys" then
    set iKeyScriptHolder to the keyDownScript
  end if
end

on mRestoreKeydown me
  set the keyDownScript to "iKeyScriptHolder"
end

on mEnterNewName me
  set the editableText of sprite 30 to 0
  puppetSprite(30, 0)
  put line 1 of field gTopicNameField into field gTopicNameField
  mGetNextFile(me)
  go("AddLoop")
  mRestoreKeydown(me)
end

on mDeleteSingleEntry me, pLineNum
  if not stringp(pLineNum) then
    set vEntryName to line pLineNum of field gDeleteField
  else
    set vEntryName to pLineNum
  end if
  set iAttribList to value(the text of cast iAttribListCast)
  set x to findPos(iAttribList, vEntryName)
  if not voidp(x) then
    set vListData to getAt(iAttribList, x)
    set vcastNum to getAt(vListData, 9)
    erase(cast vcastNum)
    deleteAt(iAttribList, x)
    put string(iAttribList) into field iAttribListCast
  end if
  if not stringp(pLineNum) then
    if the number of lines in field gDeleteField = 1 then
      put "." into line pLineNum of field gDeleteField
    else
      delete line pLineNum of field gDeleteField
    end if
  end if
  mUpdateTopicIndex(oIndexMediator)
  mCheckImportScroll(me, gDeleteField)
end

on mDeleteEntryList me
  set iAttribList to value(the text of cast iAttribListCast)
  repeat while count(iTopicDeleteList) > 0
    set vEntryName to getPropAt(iTopicDeleteList, 1)
    set x to findPos(iAttribList, vEntryName)
    if not voidp(x) then
      set vListData to getAt(iAttribList, x)
      set vcastNum to getAt(vListData, 9)
      erase(cast vcastNum)
      deleteAt(iAttribList, x)
    end if
    set vLineToKill to getAt(iTopicDeleteList, 1)
    if the number of lines in field gDeleteField = 1 then
      put "." into line vLineToKill of field gDeleteField
    else
      delete line vLineToKill of field gDeleteField
    end if
    set iTopicDeleteList to iTopicDeleteList - 1
    deleteAt(iTopicDeleteList, 1)
  end repeat
  put string(iAttribList) into field iAttribListCast
  mUpdateTopicIndex(oIndexMediator)
  mCheckImportScroll(me, gDeleteField)
end

on mCheckImportScroll me, pTextField
  if the height of cast pTextField > iFieldWindow then
    repeat with x = 20 to 23
      set the visible of sprite x to 1
    end repeat
    set vNewHeight to (the height of cast the castNum of sprite 4 - iFieldWindow) / gScrollIncrK
    mReDefineSlider(oImportSlider, 0, vNewHeight, 0)
    mNudgeSlider(oImportSlider, 0)
  else
    repeat with x = 20 to 23
      set the visible of sprite x to 0
    end repeat
  end if
  updateStage()
end

on mMakeCurlies me, pFieldNum
  global gBeginCurlyQ, gEndCurlyQ
  set vEps to ["TOS", "TNG", "DS9", "VGR"]
  set vChar1 to 1
  set vtext to field pFieldNum
  set vLastChar to length(vtext)
  set vNewText to EMPTY
  set vTextChunk to vtext
  mReport(me, "Interpreting the article text...")
  repeat with vEpName in vEps
    set vPtr to offset(vEpName, vTextChunk)
    repeat while vPtr > 0
      if (vPtr - 54) <= 0 then
        set vStart to 1
      else
        set vStart to vPtr - 54
      end if
      repeat with x = vPtr - 1 down to vStart
        if char x of vTextChunk = QUOTE then
          put gEndCurlyQ into char x of vTextChunk
          repeat with y = x - 1 down to vStart
            if char y of vTextChunk = QUOTE then
              put gBeginCurlyQ into char y of vTextChunk
              exit repeat
            end if
          end repeat
          set x to vStart + 1
          next repeat
        end if
      end repeat
      set vNewText to vNewText & char vChar1 to vPtr + 2 of vTextChunk
      set vChar1 to vPtr + 3
      set vTextChunk to char vChar1 to length(vTextChunk) of vTextChunk
      set vPtr to offset(vEpName, vTextChunk)
      if vPtr = 0 then
        set vTextChunk to vNewText & vTextChunk
        set vNewText to EMPTY
        set vChar1 to 1
      end if
    end repeat
  end repeat
  return vTextChunk
end