Star Trek Starfleet Academy Mini Omnipedia/MINI_OMNI.ISO/pc/omni_v2.dxr/00380_utilities.ls

Text File | 1996-04-15 | 8.0 KB | 276 lines

global gNopeSND

on hVerifyCastTable
  put "Lefferts algorithms compiling..." into field "Status"
  set Ltemplist to [:]
  set Ltemplist to value(the text of cast "CastTable500")
  set Lmax to count(Ltemplist)
  repeat with i = 1 to Lmax
    set Lcstnum to getPropAt(Ltemplist, i)
    set Lcstname to getAt(Ltemplist, i)
    if the name of cast Lcstnum <> Lcstname then
      beep(2)
      return
    end if
  end repeat
  put "Lefferts algorithms compiling (level 2 of 3)..." into field "Status"
  set Ltemplist to [:]
  set Ltemplist to value(the text of cast "CastTable1000")
  set Lmax to count(Ltemplist)
  repeat with i = 1 to Lmax
    set Lcstnum to getPropAt(Ltemplist, i)
    set Lcstname to getAt(Ltemplist, i)
    if the name of cast Lcstnum <> Lcstname then
      beep(2)
      return
    end if
  end repeat
  put "Lefferts algorithms compiling (level 3 of 3)..." into field "Status"
  set Ltemplist to [:]
  set Ltemplist to value(the text of cast "CastTable2000")
  set Lmax to count(Ltemplist)
  repeat with i = 1 to Lmax
    set Lcstnum to getPropAt(Ltemplist, i)
    set Lcstname to getAt(Ltemplist, i)
    if the name of cast Lcstnum <> Lcstname then
      beep(2)
      return
    end if
  end repeat
  put "Lefferts algorithms verified!" into field "Status"
end

on hMouseEventReport
  return RETURN & "CLICK! on cast" && the name of cast the castNum of sprite the clickOn
end

on hGenGlobCntLst pWhatMode
  if pWhatMode = #CHRO then
    set Lpntrlist to [18, 19, 20, 21, 22, 23, 24]
  end if
  set Lgc to 1
  repeat with i in Lpntrlist
    set Lfldname to "ATTRIB_" & string(i) & "_" & pWhatMode
    put "In field " & Lfldname
    set Lthisgroup to value(field Lfldname)
    set Lthissize to count(Lthisgroup)
    repeat with x = 1 to Lthissize
      put Lgc & ":" & getPropAt(Lthisgroup, x)
      set Lgc to Lgc + 1
    end repeat
  end repeat
end

on stall
  put "--STALL ACTIVE: hit shift to proceed--+ command to abort"
  repeat while not (the shiftDown)
    nothing()
  end repeat
  if the commandDown then
    beep(2)
    abort()
  end if
end

on tellerror fileName, Ltheproblem
  if Ltheproblem = -43 then
    set errmsg to " File" && fileName && "not found"
    put errmsg
    exit
  end if
  if Ltheproblem = -33 then
    set errmsg to " File directory full"
  end if
  if Ltheproblem = -34 then
    set errmsg to " Volume full"
  end if
  if Ltheproblem = -35 then
    set errmsg to " Volume not found"
  end if
  if Ltheproblem = -36 then
    set errmsg to " I/O Error"
  end if
  if Ltheproblem = -37 then
    set errmsg to " Bad file name"
  end if
  if Ltheproblem = -38 then
    set errmsg to " File not open"
  end if
  if Ltheproblem = -42 then
    set errmsg to " Too many files open"
  end if
  if Ltheproblem = -56 then
    set errmsg to " No such drive"
  end if
  if Ltheproblem = -65 then
    set errmsg to " No disk in drive"
  end if
  if Ltheproblem = -120 then
    set errmsg to " Directory not found for" && fileName
    put errmsg && "at frame #" & the frame
    exit
  end if
  hReportStatus("Text file read/write not sucessful." & RETURN & "Code: " & errmsg && Ltheproblem)
  hearit(gNopeSND)
end

on hputmsg what
  put what
end

on confirmpathset castNum, yePath
  preLoadCast(castNum)
  if the result <> castNum then
    hReportStatus("Cast" && castNum && "not successfully preloaded.")
    hearit(gNopeSND)
  end if
  if the fileName of cast castNum <> yePath then
    hReportStatus("The file you wanted to load into cast" && castNum && "could not be found at path" && yePath)
    hearit(gNopeSND)
  end if
end

on hExportEntries begin, end
  global gWriteObject
  repeat with x = begin to end
    set gWriteObject to FileIO(mnew, "write", the pathName & "OldAttribs-" & x)
    set vMyList to [:]
    sort(vMyList)
    set vMyList to value(the text of cast x)
    set y to count(vMyList)
    set vTextHolder to EMPTY
    repeat with i = 1 to y
      put getPropAt(vMyList, i) after vTextHolder
      put RETURN after vTextHolder
    end repeat
    set thetext to vTextHolder
    gWriteObject(mWriteString, thetext)
    gWriteObject(mdispose)
    put x & " is Done"
  end repeat
end

on hSortAttrib begin, end
  repeat with i = begin to end
    set vTempText to [:]
    sort(vTempText)
    set vTempText to value(the text of cast i)
    sort(vTempText)
    set the text of cast i to string(vTempText)
    put "cast " && i && "done. next..."
  end repeat
end

on hAttribHunter pSourceCast, pLookeeheah
  global gFirstChar, vSourceList, vInfoList
  set gFirstChar to "A"
  set vSourceList to [:]
  set vSourceList to value(the text of cast pSourceCast)
  set vInfoList to [:]
  set vInfoList to value(the text of cast pLookeeheah)
  set vMax to count(vSourceList)
  repeat with i = 1 to vMax
    put gFirstChar
    if char 1 of string(getPropAt(vSourceList, i)) <> gFirstChar then
      set gFirstChar to char 1 of string(getPropAt(vSourceList, i))
      set vInfoList to value(the text of cast ("ATTRIB_" & gFirstChar & "_ENCY"))
    end if
    set x to getPropAt(vSourceList, i)
    set vtempList to []
    set vtempList to getProp(vInfoList, x)
    set vTempListTwo to []
    repeat with m = 9 to 10
      append(vTempListTwo, getAt(vtempList, m))
    end repeat
    setAt(vSourceList, i, vTempListTwo)
  end repeat
  set the text of field pSourceCast to string(vSourceList)
end

on hFixThis pThisCast
  set vFromThis to the text of cast pThisCast
  set vFromThis to value(vFromThis)
  set vholdletter to 0
  repeat with x = 1 to count(vFromThis)
    set vNewValue to getAt(vFromThis, x)
    set vtheNinth to getAt(vNewValue, 9)
    set vtheTenth to getAt(vNewValue, 10)
    set vtheProperty to getPropAt(vFromThis, x)
    set vtheLetter to char 1 of vtheProperty
    if vtheLetter <> vholdletter then
      set vExistingAttrib to the text of cast ("ATTRIB_" & vtheLetter & "_ENCY")
    end if
    set vExistingAttrib to value(vExistingAttrib)
    set vOldValue to getProp(vExistingAttrib, vtheProperty)
    set vthePosition to getPos(vExistingAttrib, vOldValue)
    setAt(vOldValue, 9, vtheNinth)
    setAt(vOldValue, 10, vtheTenth)
    set vNewValue to vOldValue
    setAt(vExistingAttrib, vthePosition, vNewValue)
    set the text of cast ("ATTRIB_" & vtheLetter & "_ENCY") to string(vExistingAttrib)
    set vholdletter to vtheLetter
  end repeat
end

on hNukeOldText prevlist
  set the itemDelimiter to "~"
  set vtheProp to 0
  set vtheNukeCast to 0
  set vtheNukeItem to 0
  set vEditHere to 0
  set vEntriesToGo to prevlist
  set vGuideList to the text of cast vEntriesToGo
  set vGuideList to value(vGuideList)
  repeat with i = 1 to count(vGuideList)
    set vtheProp to getAt(vGuideList, i)
    set vtheNukeCast to getAt(vtheProp, 1)
    set vtheNukeItem to getAt(vtheProp, 2)
    set vEditHere to the text of cast vtheNukeCast
    put "~" & RETURN & RETURN after item vtheNukeItem of vEditHere
    delete item vtheNukeItem of vEditHere
    set the text of cast vtheNukeCast to vEditHere
  end repeat
  set the itemDelimiter to ","
end

on hExtractEntries pFromTextCast
  set vTempCast to the text of cast pFromTextCast
  set vEntriesList to []
  set itemDelimiter to "~"
  set n to 1
  repeat with i = 2 to the number of items in vTempCast
    set n to string(count(vEntriesList) + 1)
    set vItemHolder to item i of vTempCast
    set the itemDelimiter to "@"
    delete char 1 of vItemHolder
    add(vEntriesList, RETURN & pFromTextCast & ":" & n && vItemHolder)
    set itemDelimiter to "~"
    set i to i + 1
  end repeat
  put vEntriesList
end

on hScanForXChar aFieldNum, b
  repeat with mm = aFieldNum to b
    set vSize to the number of chars in field mm
    put "Scanning" && vSize & " chars in field " & the name of cast mm
    put "Hit SHIFT to abort"
    set i to 1
    repeat while not (the shiftDown)
      if i > vSize then
        exit repeat
      end if
      set vCode to charToNum(char i of field mm)
      if vCode < 32 then
        put "CHAR" && i && "is >" & char i of field mm & "< ascii:" & vCode
      else
        if vCode > 127 then
          put "CHAR" && i && "is >" & char i of field mm & "< ascii:" & vCode
        end if
      end if
      set i to i + 1
    end repeat
  end repeat
  put "THAT'S IT"
end