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

Text File | 1995-05-01 | 14.2 KB | 422 lines

on mixit gosegs
  global sndobj, mix_fn1, mix_fn2, mix_ofs1, mix_vol1, mix_vol2, mix_rate, mix_qua, mix_size, mix_mon, mix_err, mix_ofs2, mix_idx1, mix_idx2, mix_loop, mix_start, mix_end, up_sampm, fcommand, namepause_bs, LED_1, LED_2, t1_idxcnt, t1_segcnt, t2_idxcnt, t2_segcnt, p1_idx, p1_start, p1_stop, p1_vol, p1_name, p1_cast, p1_time, p2_idx, p2_start, p2_stop, p2_vol, p2_name, p2_cast, p2_time, acmixdest, freemaster, m1_start, m2_start
  set retvar to 1
  if (p1_name <> namepause_bs) and (p2_name <> namepause_bs) and (p2_start < p2_time) and (p1_start < p1_time) then
    set mix_idx1 to string(p1_cast)
    set mix_idx2 to string(p2_cast)
    set mix_vol1 to string(p1_vol)
    set mix_vol2 to string(p2_vol)
    set mix_start to string(integer(acmixdest))
    set mix_ofs1 to string(integer(p1_start))
    set mix_ofs2 to string(integer(p2_start))
    if p1_start = p2_start then
      set p_step to p1_stop
      repeat with i = 1 to gosegs
        if (value(ar1seg(mget, p1_idx)) > i) and (value(ar1seg(mget, p2_idx)) > i) then
          set retvar to retvar + 1
          set p1_stop to integer(p1_stop + p_step)
          set mix_end to string(p1_stop)
          next repeat
        end if
        exit repeat
      end repeat
    end if
    if mix_ofs1 >= p1_stop then
      alertrd("Error: ofs1 >stop on mix", "Fehler: ofs1 >stop on mix")
    end if
    if mix_ofs2 >= p2_stop then
      alertrd("Error: ofs2 >stop on mix", "Fehler: ofs2 >stop on mix")
    end if
    set mix_end to string(p1_stop)
    if p1_stop > p2_stop then
      set p_stop to p1_stop
    else
      set p_stop to p2_stop
    end if
    if (value(mix_start) + value(mix_end)) > up_sampm then
      err_mem()
      return 0
    else
      set freemaster to up_sampm - (value(mix_start) + value(mix_end))
      if the machineType = 256 then
        set mix_err to sndobj(mSndMix)
      else
        set mix_err to sndobj(mMix, value(mix_idx1), value(mix_idx2), value(mix_vol1), value(mix_vol2), value(mix_start), value(mix_end), value(mix_ofs1), value(mix_ofs2))
      end if
      if mix_err <> 0 then
        alertrd("SNDWORK: Error while mixing: " & string(mix_err), "SNDWORK: Fehler beim mixen: " & string(mix_err))
        return 0
      end if
      set acmixdest to acmixdest + (p1_stop - p1_start)
    end if
  else
    if (p1_name = namepause_bs) and (p2_name <> namepause_bs) then
      ins_t2()
    else
      if p1_name <> namepause_bs then
        ins_t1()
      else
        if (p1_name = namepause_bs) and (p2_name = namepause_bs) then
          alertrd("Empty ELEMENTS on both tracks not allowed.", "Leere ELEMENTE auf beiden Spuren sind nicht erlaubt.")
          return 0
        end if
      end if
    end if
  end if
  return retvar
end

on getpar1 led
  global p1_idx, p1_start, p1_stop, p1_vol, p1_name, p1_cast, p1_time, circle_qua
  set idx1 to getpos1idx(led)
  if idx1 = 0 then
    return 1
  end if
  set segcnt to 0
  set tmppos to ar1pos(mget, idx1)
  set segtime to integer(value(Ar1time(mget, idx1)) / value(ar1seg(mget, idx1)))
  if circle_qua = "16" then
    set segtime to integer(integer(segtime / 2) * 2)
  end if
  set p1_start to 0
  set p1_vol to Ar1Vol(mget, idx1)
  set p1_name to Ar1sound(mget, idx1)
  set p1_stop to segtime
  set p1_idx to idx1
  set p1_cast to Ar1play(mget, idx1)
  set p1_time to integer(value(Ar1time(mget, idx1)))
  repeat while 1
    if tmppos = led then
      exit repeat
    end if
    if tmppos > led then
      return 1
    end if
    set p1_start to integer(p1_start + segtime)
    set p1_stop to integer(p1_stop + segtime)
    set tmppos to tmppos + 1
  end repeat
  return 0
end

on getpar2 led
  global p2_idx, p2_start, p2_stop, p2_vol, p2_name, p2_cast, p2_time, t1_idxcnt, t2_idxcnt, circle_qua
  set idx1 to getpos1idx(led)
  set idx2 to getpos2idx(led)
  if idx2 = 0 then
    return 1
  end if
  set p2_time to integer(value(Ar1time(mget, idx2)))
  set segcnt to 0
  set tmppos to ar1pos(mget, idx2)
  if idx1 = 0 then
    set segtime to integer(value(Ar1time(mget, idx2)) / value(ar1seg(mget, idx2)))
  else
    set segtime to integer(value(Ar1time(mget, idx1)) / value(ar1seg(mget, idx1)))
  end if
  if circle_qua = "16" then
    set segtime to integer(integer(segtime / 2) * 2)
  end if
  set p2_start to 0
  set p2_vol to Ar1Vol(mget, idx2)
  set p2_name to Ar1sound(mget, idx2)
  set p2_stop to segtime
  set p2_idx to idx2
  set p2_cast to Ar1play(mget, idx2)
  repeat while 1
    if tmppos = led then
      exit repeat
    end if
    if tmppos > led then
      return 1
    end if
    set p2_start to integer(p2_start + segtime)
    set p2_stop to integer(p2_stop + segtime)
    set tmppos to tmppos + 1
  end repeat
  return 0
end

on ins_t1
  global sndobj, mix_fn1, mix_fn2, mix_ofs1, mix_vol1, mix_vol2, mix_rate, mix_qua, mix_size, mix_mon, mix_err, mix_idx1, mix_idx2, mix_loop, mix_start, mix_end, up_sampm, fcommand, namepause_bs, LED_1, LED_2, t1_idxcnt, t1_segcnt, t2_idxcnt, t2_segcnt, p1_idx, p1_start, p1_stop, p1_vol, p1_name, p1_cast, p2_idx, p2_start, p2_stop, p2_vol, p2_name, p2_cast, acmixdest, freemaster
  if p1_name = namepause_bs then
    alertrd("An empty ELEMENT only on one track is not allowed.", "Ein leeres ELEMENT nur auf einer Spur ist nicht erlaubt.")
    return 0
  end if
  set mix_idx1 to string(p1_cast)
  set mix_ofs1 to string(integer(acmixdest))
  set mix_start to string(integer(p1_start))
  set mix_end to string(integer(p1_stop - p1_start))
  put ">>insert at1>" & mix_ofs1 & " start>" & mix_start & " len>" & mix_end & " ofs>" & mix_ofs1
  if (value(mix_ofs1) + value(mix_end)) > up_sampm then
    err_mem()
    return 0
  else
    set freemaster to up_sampm - (value(mix_start) + value(mix_end))
    if the machineType = 256 then
      set mix_err to sndobj(msndinsert)
    else
      set mix_err to sndobj(mInsert, value(mix_idx1), value(mix_ofs1), value(mix_start), value(mix_end))
    end if
    if mix_err <> 0 then
      alertrd("SNDWORK: Error while insert T1: " & string(mix_err), "SNDWORK: Fehler Einfuegen T1: " & string(mix_err))
      return 0
    end if
    set acmixdest to integer(acmixdest + (p1_stop - p1_start))
    put ">>ins_t1 new acmixdest>" & acmixdest
    return 1
  end if
end

on ins_t2
  global sndobj, mix_fn1, mix_fn2, mix_ofs1, mix_vol1, mix_vol2, mix_rate, mix_qua, mix_size, mix_mon, mix_err, mix_idx1, mix_idx2, mix_loop, mix_start, mix_end, fcommand, namepause_bs, up_sampm, LED_1, LED_2, t1_idxcnt, t1_segcnt, t2_idxcnt, t2_segcnt, p1_idx, p1_start, p1_stop, p1_vol, p1_name, p1_cast, p2_idx, p2_start, p2_stop, p2_vol, p2_name, p2_cast, acmixdest, freemaster
  if p2_name = namepause_bs then
    alertrd("An empty Element only on one track is not allowed.", "Ein leeres ELEMENT nur auf einer Spur ist nicht erlaubt.")
    return 0
  end if
  set mix_idx1 to string(p2_cast)
  set mix_ofs1 to string(integer(acmixdest))
  set mix_start to string(integer(p2_start))
  set mix_end to string(integer(p2_stop - p2_start))
  put ">>insert at>" & mix_ofs1 & " start>" & mix_start & " stop>" & mix_end & " ofs>" & mix_ofs1
  if (value(mix_ofs1) + value(mix_end)) > up_sampm then
    err_mem()
    return 0
  else
    set freemaster to up_sampm - (value(mix_start) + value(mix_end))
    if the machineType = 256 then
      set mix_err to sndobj(msndinsert)
    else
      set mix_err to sndobj(mInsert, value(mix_idx1), value(mix_ofs1), value(mix_start), value(mix_end))
    end if
    if mix_err <> 0 then
      alertrd("SNDWORK: Error while insert T2: " & string(mix_err), "SNDWORK: Fehler Einfuegen T2: " & string(mix_err))
      return 0
    end if
    set acmixdest to integer(acmixdest + (p2_stop - p2_start))
    put ">>ins_t2 acmixdest>" & acmixdest
    return 1
  end if
end

on getpos1idx led
  global t1_idxcnt, t1_segcnt
  set retvar to 0
  repeat with i = t1_idxcnt down to 1
    if value(ar1pos(mget, i)) <= led then
      set retvar to i
      if (value(ar1pos(mget, i)) + value(ar1seg(mget, i)) - 1) < led then
        set retvar to 0
      end if
      exit repeat
    end if
  end repeat
  return retvar
end

on getpos2idx led
  global t2_idxcnt, t2_segcnt
  set retvar to 0
  repeat with i = t2_idxcnt down to 1
    if value(ar1pos(mget, i + 12)) <= led then
      set retvar to i + 12
      if (value(ar1pos(mget, i + 12)) + value(ar1seg(mget, i + 12)) - 1) < led then
        set retvar to 0
      end if
      exit repeat
    end if
  end repeat
  return retvar
end

on circlefire
  global junk, fcommand, MUTE, pastebuf, backcast, sample_rate, ticks_ps, circle_qua, loopidx, mix_idx1, mix_err, sndobj, last_play, mix_loop, cp_idx, up_mvol
  put "circlefire"
  set cidx to cp_idx
  if pastebuf = 0 then
    put "Before using FIRE , you have to copy a soundelemet"
    if not (fcommand = "LOOP") then
      set fcommand to EMPTY
    end if
    exit
  end if
  set junk to Ar1play(mget, cidx)
  if not (fcommand = "LOOP") then
    copywindow()
    set fcommand to EMPTY
  end if
  startTimer()
  snd_stop()
  set mix_idx1 to string(junk)
  set mix_vol1 to string(up_mvol)
  set mix_loop to "1"
  if the machineType = 256 then
    set mix_err to sndobj(mSndPlay)
  else
    set mix_err to sndobj(mPlay, value(mix_idx1), value(mix_loop), value(mix_vol1))
  end if
  if mix_err <> 0 then
    alertrd("SNDWORK Error while Playing Fire: " & mix_err, "SNDWORK beim FIRE abspielen: " & mix_err)
  else
    set last_play to string(pidx)
  end if
  waitforup()
  if the machineType = 256 then
    set mix_err to sndobj(mSndStop)
  else
    set mix_err to sndobj(mStop, value(mix_idx1))
  end if
  if not (fcommand = "LOOP") then
    if backcast <> 0 then
      setwindow(the name of cast backcast)
    end if
  end if
  updateStage()
end

on do_savemix
  global ltl_scast, up_save, fcommand, new_read, mixedloop, mix_fn1, mix_start, mix_end, mix_err, sndobj, sel_name, scommand
  set scommand to EMPTY
  if the machineType = 256 then
    set dest to up_save & sel_name
  else
    set dest to up_save & sel_name
  end if
  set startidx to getstartidx(0)
  set stopidx to getstopidx(0)
  set loopidx to startidx
  if not mixedloop then
    snd_mix(value(startidx))
  end if
  set startTime to tltimestart(startidx)
  set stopTime to tltimestop(stopidx - 1)
  cur_busy()
  set mix_fn1 to dest
  set mix_start to string(startTime)
  set mix_end to string(stopTime)
  if the machineType = 256 then
    set mix_err to sndobj(mSndSave)
  else
    set mix_err to sndobj(mSave, mix_fn1, value(mix_start), value(mix_end))
  end if
  cur_on()
  if mix_err <> 0 then
    alertrd("SNDWORK: Error while saving !" & string(mix_err), "SNDWORK: Fehler beim speichern !" & string(mix_err))
  end if
  set new_read to 1
end

on do_saveseg sidx, pidx, fn
  global ltl_scast, up_save, fcommand, new_read, mix_fn1, mix_start, mix_end, mix_err, sndobj
  set startidx to sidx
  set startTime to tltimestart(startidx)
  if the machineType = 256 then
    set stopTime to startTime + value(Ar1time(mget, pidx))
  else
    set stopTime to value(Ar1time(mget, pidx))
  end if
  put "saveseg time>" & startTime & " stop>" & stopTime
  set mix_fn1 to fn
  set mix_start to string(startTime)
  set mix_end to string(stopTime)
  if the machineType = 256 then
    set mix_err to sndobj(mSndSave)
  else
    set mix_err to sndobj(mSave, mix_fn1, value(mix_start), value(mix_end))
  end if
  if mix_err <> 0 then
    alertrd("SNDWORK: Error while saving !" & string(mix_err), "SNDWORK: Fehler beim speichern !" & string(mix_err))
  end if
  set new_read to 1
end

on do_savesegeff fn
  global ltl_scast, up_temp, fcommand, new_read, mix_fn1, mix_start, mix_end, mix_err, sndobj, p1_start, p1_stop
  set startTime to 0
  if the machineType = 256 then
    set stopTime to p1_stop
  else
    set stopTime to p1_stop
  end if
  put "savesegeff time>" & startTime & " stop>" & stopTime
  set mix_fn1 to fn
  set mix_start to string(startTime)
  set mix_end to string(stopTime)
  if the machineType = 256 then
    set mix_err to sndobj(mSndSave)
  else
    set mix_err to sndobj(mSave, mix_fn1, value(mix_start), value(mix_end))
  end if
  if mix_err <> 0 then
    alertrd("SNDWORK: Error while saving !" & string(mix_err), "SNDWORK: Fehler beim speichern !" & string(mix_err))
  end if
  set new_read to 1
end

on err_mem
  alertrd("Not enough memory !" & RETURN & "Increase the mastertrack memory", "Nicht genuegend Speicher fuer die Masterspur!" & RETURN & "Speicher fuer die Masterspur vergroessern.")
end

on err_memsnd
  alertrd("Not enough memory for this Sound !" & RETURN & "Decrease the mastertrack memory", "Nicht genuegend Speicher fuer diesen Sound!" & RETURN & "Speicher fuer die Masterspur verkleinern.")
end

on sndpar fileName
  global mix_rate, mix_qua, mix_mon, mix_size, mix_err, mix_fn1, sndobj
  set mix_err to 0
  set mix_fn1 to fileName
  set mix_rate to "0"
  set mix_qua to "0"
  set mix_size to "0"
  set mix_mon to "0"
  if the machineType = 256 then
    sndobj(msndcheck)
  else
    set macstr to sndobj(mSndPar, fileName)
    if chars(macstr, 1, 5) = "ERROR" then
      set mix_err to 1
    else
      set mix_err to 0
      set mix_qua to word 1 of macstr
      if word 2 of macstr = "1" then
        set mix_mon to "mono"
      end if
      if word 2 of macstr = "2" then
        set mix_mon to "stereo"
      end if
      set mix_size to word 3 of macstr
      set mix_rate to word 4 of macstr
    end if
  end if
  return value(mix_err)
end

on effectplay
  global p1_idx, p1_start, p1_stop, p1_vol, p1_name, p1_cast, p1_time, p2_idx, p2_start, p2_stop, p2_vol, p2_name, p2_cast, p2_time, fcommand, acmixdest, up_mvol, t1_idxcnt, t2_idxcnt, mixedloop, stopidx, startidx, loopidx, last_play, startTime, stopTime, ltl_time, wait_time, loop_time, sndobj, mix_vol1, mix_start, mix_end, mix_ofs1, mix_err, leff_name, leff_time1, leff_time2, eff_lidx, eff_vol, eff_idx
  set fcommand to EMPTY
  snd_stop()
  if not mixedloop then
    mkeffect()
  end if
  set startTime to p1_start
  set stopTime to p1_stop
  set loop_time to stopTime
  set last_play to string(0)
  set mix_start to string(startTime)
  set mix_end to string(stopTime - startTime)
  set mix_vol1 to string(up_mvol)
  set mix_ofs1 to "0"
  if the machineType = 256 then
    set mix_err to sndobj(mSndLoop)
  else
    if value(mix_vol1) > 15 then
      set mix_vol1 to "15"
    end if
    set mix_err to sndobj(mLoop, value(mix_start), value(mix_end), value(mix_ofs1), value(mix_vol1))
  end if
  if mix_err <> 0 then
    alertrd("SNDWORK Error while Effect Playing: " & mix_err, "SNDWORK Fehler beim Abspielen: " & mix_err)
    set fcommand to EMPTY
  end if
end