Sound, Music & MIDI Collection 2/SMMVOL2.bin/DEMO/PRG/CIRCLES.ZIP/CI_MAIN.DIX/00023_FUTIL.ls

Text File | 1995-05-01 | 10.7 KB | 453 lines

on filelist_get paths, ext
  global l_fold, l_file, mix_err, mix_fn1, mix_fnO, sndobj
  put "filelist_get paths>" & paths & " ext>" & ext
  if the machineType = 256 then
    repeat with i = 1 to the maxinteger
      if i = 1 then
        set mix_fn1 to paths
        sndobj(mGetfn)
        if (mix_fnO = EMPTY) or (mix_err = "ERROR") then
          exit repeat
        end if
        if mix_err = "FILE" then
          append(l_file, "S " & mix_fnO)
        end if
      end if
      sndobj(mNextfn)
      if (mix_fnO = EMPTY) or (mix_err = "ERROR") then
        exit repeat
      end if
      if mix_err = "FILE" then
        append(l_file, "S " & mix_fnO)
      end if
    end repeat
  else
    repeat with i = 1 to the maxinteger
      if ext = "TEXT" then
        set creat to "CIEL"
      else
        set creat to EMPTY
      end if
      set err to sndobj(mGetDirEntry, i - 1, trimdb(paths), ext, creat)
      set lfn to sndobj(mReadFName1)
      set ldir to sndobj(mReadVolume2)
      if err <> 0 then
        exit repeat
      end if
      if ldir = 0 then
        append(l_file, "S " & trim(lfn))
      end if
    end repeat
  end if
  sort(l_file)
end

on dirlist_get paths
  global l_fold, l_file, mix_err, mix_fn1, mix_fnO, sndobj, v_frompath, fl_search, up_load, up_cload, up_save, up_csave
  put "dir_list fl_search>" & fl_search
  if fl_search = "CIRCLE" then
    set up_l to up_cload
  else
    if fl_search = "SOUND" then
      set up_l to up_load
    else
      if fl_search = "PATH" then
        set up_l to up_save
      else
        if fl_search = "PATHC" then
          set up_l to up_csave
        end if
      end if
    end if
  end if
  if the machineType = 256 then
    repeat with i = 1 to the maxinteger
      if i = 1 then
        set mix_fn1 to paths
        sndobj(mGetfn)
        if (mix_fnO = EMPTY) or (mix_err = "ERROR") then
          exit repeat
        end if
        if mix_err = "DIR" then
          if not (mix_fnO = ".") and not (mix_fnO = "..") then
            append(l_fold, up_l & mix_fnO & "\")
          end if
        end if
      end if
      sndobj(mNextfn)
      if (mix_fnO = EMPTY) or (mix_err = "ERROR") then
        exit repeat
      end if
      if mix_err = "DIR" then
        if not (mix_fnO = ".") and not (mix_fnO = "..") then
          append(l_fold, up_l & mix_fnO & "\")
        end if
      end if
    end repeat
    sort(l_fold)
    set insat to count(l_fold)
    repeat with i = 1 to the maxinteger
      set tmppath to frompath(up_l, i + 1)
      if tmppath = EMPTY then
        exit repeat
        next repeat
      end if
      addAt(l_fold, insat + 1, tmppath)
    end repeat
  else
    repeat with i = 1 to the maxinteger
      set err to sndobj(mGetDirEntry, i - 1, trimdb(paths), "AIFF", EMPTY)
      set lfn to sndobj(mReadFName1)
      set ldir to sndobj(mReadVolume2)
      if err <> 0 then
        exit repeat
      end if
      if ldir <> 0 then
        if not (length(trim(lfn)) = 0) then
          append(l_fold, paths & trim(lfn) & ":")
        end if
      end if
    end repeat
    sort(l_fold)
    set insat to count(l_fold)
    repeat with i = 1 to the maxinteger
      set tmppath to frompath(up_l, i + 1)
      if tmppath = EMPTY then
        exit repeat
        next repeat
      end if
      addAt(l_fold, insat + 1, tmppath)
    end repeat
  end if
  set j to count(l_file)
  repeat with i = 1 to count(l_fold)
    set j to j + 1
    setAt(l_file, j, "D " & ex_dir(trim(getAt(l_fold, i))))
  end repeat
end

on drivelist_get paths
  global l_fold, l_file, l_drive, mix_err, mix_fn1, mix_fnO, sndobj, v_frompath, fl_search, up_lang
  if the machineType = 256 then
    set ac_drive to chars(paths, 1, 1)
    repeat with i = 26 down to 1
      set mix_fn1 to paths
      sndobj(mDrives, i)
      if not (value(word 2 of stripcrtlchars(mix_fnO)) = 11) then
        append(l_drive, numToChar(i + 64) & ":\")
      end if
    end repeat
  else
    set ac_drive to chars(paths, 1, 1)
    repeat with i = 1 to 10
      set tmpstr to EMPTY
      set tmpstr2 to EMPTY
      if i = 1 then
        set tmpstr2 to sndobj(mGetDrives, 1)
      else
        set tmpstr2 to sndobj(mGetDrives, 0)
      end if
      set tmpstr to macstripcrtlchars(tmpstr2)
      if chars(tmpstr, 1, 6) = ":EMPTY" then
        exit repeat
      end if
      append(l_drive, tmpstr & ":")
    end repeat
  end if
  set j to count(l_file)
  repeat with i = 1 to count(l_drive)
    set j to j + 1
    setAt(l_file, j, "F " & getAt(l_drive, i))
  end repeat
  if the machineType <> 256 then
    if check_CD() then
      if up_lang = 1 then
        setAt(l_file, j + 1, "C Eject CD-ROM")
      else
        setAt(l_file, j + 1, "C CD-ROM Auswerfen")
      end if
    end if
  end if
end

on f_list start
  global l_fold, l_file, l_disp, scrollstep, up_cload, up_load, up_save, up_csave, fl_search
  set l_disp to []
  put "f_list fl_search>" & fl_search
  if fl_search = "CIRCLE" then
    set up_l to up_cload
  else
    if fl_search = "SOUND" then
      set up_l to up_load
    else
      if fl_search = "PATH" then
        set up_l to up_save
      else
        if fl_search = "PATHC" then
          set up_l to up_csave
        end if
      end if
    end if
  end if
  put "f_list up_l>" & up_l
  set s to up_l & RETURN & RETURN
  set didx to 1
  set fl_mx to count(l_file)
  repeat with i = start + 1 to start + scrollstep
    if i > fl_mx then
      exit repeat
    end if
    set vname to chars(getAt(l_file, i), 3, length(getAt(l_file, i)))
    set s to s & vname & RETURN
    setAt(l_disp, didx, "S")
    set didx to didx + 1
  end repeat
  return s
end

on d_list start
  global l_fold, l_file, l_disp, scrollstep
  set l_disp to []
  set s to RETURN & RETURN
  set fl_mx to count(l_fold)
  set didx to 1
  repeat with i = start + 1 to start + scrollstep
    if i > fl_mx then
      exit repeat
    end if
    set s to s & ex_dir(trim(getAt(l_fold, i))) & RETURN
    setAt(l_disp, didx, "S")
    set didx to didx + 1
  end repeat
  return s
end

on trim s
  repeat with i = 1 to the maxinteger
    if (chars(s, i, i) = QUOTE) or (charToNum(chars(s, i, i)) < 32) then
      exit repeat
    end if
  end repeat
  return chars(s, 1, i - 1)
end

on trimdb s
  if chars(s, length(s), length(s)) = ":" then
    return chars(s, 1, length(s) - 1)
  else
    return s
  end if
end

on ex_dir s
  set vl to 0
  repeat with i = length(s) - 1 down to 1
    if the machineType = 256 then
      if chars(s, i, i) = "\" then
        set vl to i + 1
        exit repeat
      end if
      next repeat
    end if
    if chars(s, i, i) = ":" then
      set vl to i + 1
      exit repeat
    end if
  end repeat
  set ret_s to chars(s, vl, length(s))
  return ret_s
end

on getselname idx
  global up_load, up_cload, fl_search, l_file
  if fl_search = "CIRCLE" then
    set up_l to up_cload
  else
    set up_l to up_load
  end if
  set mode to chars(getAt(l_file, idx), 1, 1)
  set vname to chars(getAt(l_file, idx), 3, length(getAt(l_file, idx)))
  if mode = "S" then
    if the machineType = 256 then
      set sname to trimdb(trim(up_l))
    else
      set sname to trimdb(trim(up_l))
    end if
    if the machineType = 256 then
      set sname to sname & EMPTY
    else
      set sname to sname & ":"
    end if
    set sname to sname & vname
  else
    if mode = "D" then
      set sname to vname
    else
      if mode = "F" then
        set sname to vname
      else
        if mode = "C" then
          set sname to vname
        end if
      end if
    end if
  end if
  return sname
end

on todir s
  global up_load, up_cload, fl_search
  if fl_search = "CIRCLE" then
    set up_l to up_cload
  else
    set up_l to up_load
  end if
  if up_load contains s then
    set t to offset(s, up_l)
    if not (t = 0) then
      return chars(up_l, 1, t + length(s) - 1)
    end if
  else
    return up_l & s
  end if
  return EMPTY
end

on chk_dir paths, DIR
  global mix_err, mix_fn1, mix_fnO, sndobj
  set up_l to paths
  set exist to 0
  if the machineType = 256 then
    repeat with i = 1 to the maxinteger
      if i = 1 then
        set mix_fn1 to paths
        sndobj(mGetfn)
        if (mix_fnO = EMPTY) or (mix_err = "ERROR") then
          exit repeat
        end if
        if mix_err = "DIR" then
          if not (mix_fnO = ".") and not (mix_fnO = "..") then
            if mix_fnO = DIR then
              set exist to 1
              exit repeat
            end if
          end if
        end if
      end if
      sndobj(mNextfn)
      if (mix_fnO = EMPTY) or (mix_err = "ERROR") then
        exit repeat
      end if
      if mix_err = "DIR" then
        if not (mix_fnO = ".") and not (mix_fnO = "..") then
          if mix_fnO = DIR then
            set exist to 1
            exit repeat
          end if
        end if
      end if
    end repeat
  else
    repeat with i = 1 to the maxinteger
      set err to sndobj(mGetDirEntry, i - 1, trimdb(paths), "AIFF", EMPTY)
      set lfn to sndobj(mReadFName1)
      set ldir to sndobj(mReadVolume2)
      if err <> 0 then
        exit repeat
      end if
      if ldir <> 0 then
        if not (length(trim(lfn)) = 0) then
          if trim(lfn) = DIR then
            set exist to 1
            exit repeat
          end if
        end if
      end if
    end repeat
  end if
  return exist
end

on getffpath s
  global dir_sep
  if chars(s, length(s), length(s)) = RETURN then
    set s to chars(s, 1, length(s) - 1)
  end if
  if chars(s, length(s), length(s)) = dir_sep then
    set s to chars(s, 1, length(s) - 1)
  end if
  repeat with i = length(s) down to 1
    if chars(s, i, i) = dir_sep then
      return chars(s, i + 1, length(s))
    end if
  end repeat
  return EMPTY
end

on getipath s
  global dir_sep
  if chars(s, length(s), length(s)) = RETURN then
    set s to chars(s, 1, length(s) - 1)
  end if
  if chars(s, length(s), length(s)) = dir_sep then
    set s to chars(s, 1, length(s) - 1)
  end if
  repeat with i = length(s) down to 1
    if chars(s, i, i) = dir_sep then
      return chars(s, 1, i)
    end if
  end repeat
  return EMPTY
end

on eject_CD
  global CD
  openXLib("AppleCD")
  if objectp(CD) then
    CD(mdispose)
  end if
  set CD to AppleCD(mnew)
  if not objectp(CD) then
    exit
  end if
  set chkCD to CD(mGetFirstTrack)
  if chkCD <> -1 then
    CD(mEject)
    repeat while 1
      set chkCD to CD(mGetFirstTrack)
      if chkCD <> -1 then
        exit repeat
      end if
    end repeat
  end if
  if objectp(CD) then
    CD(mdispose)
  end if
  closeXLib("AppleCD")
  put "back insertet"
end

on check_CD
  global CD
  openXLib("AppleCD")
  if objectp(CD) then
    CD(mdispose)
  end if
  set CD to AppleCD(mnew)
  if not objectp(CD) then
    exit
  end if
  set chkCD to CD(mGetFirstTrack)
  if chkCD <> -1 then
    set retcd to 1
  else
    set retcd to 0
  end if
  if objectp(CD) then
    CD(mdispose)
  end if
  closeXLib("AppleCD")
  put "ceckCD>" & retcd
  return retcd
end