HP Idea Kits: Let's Celebrate/PHOTODLX.ISO/extras/diamar/photo.dxr/00035.ls

Text File | 1996-04-22 | 3.4 KB | 131 lines

on relink start, finish, size
  if voidp(size) then
    set size to 10000
  end if
  repeat with i = start to finish
    if the castType of cast i = #bitmap then
      set fname to the fileName of cast i
      if (the size of cast i < size) and (fname > EMPTY) then
        put fname
        importFileInto(cast i, fname)
      end if
    end if
  end repeat
  put "done"
end

on marchcast start, finish
  if voidp(size) then
    set size to 10000
  end if
  repeat with i = start to finish
    if the castType of cast i = #bitmap then
      set fname to the fileName of cast i
      if fname > EMPTY then
        put fname
      end if
    end if
  end repeat
  put "done"
end

on castlist start, finish
  if the paramCount = 1 then
    set finish to start
  end if
  set fileObj to FileIO(mnew, "?write", "castlist.txt")
  put the result
  set delim to the itemDelimiter
  set the itemDelimiter to ":"
  repeat with i = start to finish
    if (the castType of cast i = #bitmap) or (the castType of cast i = #digitalVideo) then
      set fname to the last item in the fileName of cast i
      if char 1 to 2 of fname = "SQ" then
        set fname to char 1 to 5 of fname & "." & char 7 to 8 of fname
      else
        set fname to char 1 to offset(".", fname & ".") - 1 of fname
      end if
      if the width of cast i < the height of cast i then
        set Orientation to "Portrait"
      else
        set Orientation to "Landscape"
      end if
      set theline to i & "," & fname & "," & Orientation
      fileObj(mWriteString, theline & RETURN)
    end if
  end repeat
  fileObj(mdispose)
  set the itemDelimiter to delim
end

on prefixpalette start, finish, prefix
  repeat with i = start to finish
    if the castType of cast i = #palette then
      set the name of cast i to prefix & the name of cast i
    end if
  end repeat
  put "done"
end

on renamepalette start, finish, prefix
  if voidp(prefix) then
    set prefix to EMPTY
  end if
  repeat with i = finish to start
    if the castType of cast i = #bitmap then
      set p to the palette of cast i
      set pname to the name of cast i
      set the name of cast p to prefix & char 1 to 5 of pname
    end if
  end repeat
  put "done"
end

on parsefile startcast
  global gFileIn, gFileOut
  set fname to "TEXT"
  set gFileIn to FileIO(mnew, "?read", fname)
  if gFileIn < 0 then
    exit
  end if
  set L to gFileIn(mGetLength)
  set textcast to startcast
  set castline to 26
  set castline to 0
  repeat while gFileIn(mGetPosition) <> L
    set LineIn to gFileIn(mReadLine)
    if LineIn = EMPTY then
      exit repeat
    end if
    if castline = 0 then
      set castline to integer(char 6 to 7 of item 1 of LineIn) + 1
      put "starting at line " & castline
    end if
    set LineOut to parseLine(LineIn)
    put LineOut into line castline of field textcast
    set castline to castline + 1
    if castline > 100 then
      set castline to 1
      set textcast to textcast + 1
      put "Starting on cast" && textcast
    end if
  end repeat
  gFileIn(mdispose)
end

on parseLine theline
  set save to the itemDelimiter
  set the itemDelimiter to TAB
  set n to the number of items in theline
  set newLine to item 1 of theline
  repeat with i = 2 to n
    set aChunk to item i of theline
    if (aChunk > EMPTY) and (aChunk <> RETURN) then
      set newLine to newLine & "," & aChunk
    end if
  end repeat
  set newLine to newLine & RETURN
  set the itemDelimiter to save
  return newLine
end