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

Text File | 1995-05-01 | 14.7 KB | 463 lines

on mkrandom
  global fcommand, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt
  set fcommand to EMPTY
  set cpy1buf to 27
  set cpy2buf to 60
  set srcidx to 0
  set destidx to cpy1buf
  set cpidx to 0
  set maxtrys to 100
  set t1_idxcntsv to t1_idxcnt
  set t2_idxcntsv to t2_idxcnt
  cur_busy()
  repeat with i = 1 to 24
    if AR1idx(mget, srcidx) <> 0 then
      if i > 12 then
        Ar1track(mput, destidx, 2)
      else
        Ar1track(mput, destidx, 1)
      end if
      AR1idx(mput, destidx, AR1idx(mget, srcidx))
      move_ar1(destidx, srcidx)
      set cpidx to cpidx + 1
      set destidx to destidx + 1
    end if
    set srcidx to srcidx + 1
  end repeat
  AR1idx(mput, destidx + 1, 0)
  set srcidx to 0
  set destidx to cpy2buf
  repeat with i = 1 to 24
    if AR1idx(mget, srcidx) <> 0 then
      if i > 13 then
        Ar1track(mput, destidx, 2)
      else
        Ar1track(mput, destidx, 1)
      end if
      AR1idx(mput, destidx, AR1idx(mget, srcidx))
      move_ar1(destidx, srcidx)
      set destidx to destidx + 1
    end if
    set srcidx to srcidx + 1
  end repeat
  AR1idx(mput, destidx + 1, 0)
  set t1_pos to 1
  set t2_pos to 1
  set t_pos to 1
  cleanup()
  cleanUpArrs()
  updateStage()
  set full to 0
  set trackmove to 1
  repeat while 1
    if cpidx = 0 then
      exit repeat
    end if
    repeat while 1
      if t2_idxcntsv > 0 then
        if trackmove > t1_idxcntsv then
          set srcidx to random(cpidx) + cpy1buf - 1
          set t_pos to t2_pos
          if (t_pos + ar1seg(mget, srcidx)) <= 13 then
            set t_add to 12
            set destidx to t2_idxcnt + 1
            exit repeat
          end if
        else
          set srcidx to cpy1buf
          set trackmove to trackmove + 1
          set t_pos to t1_pos
          if (t_pos + ar1seg(mget, srcidx)) <= 13 then
            set t_add to 0
            set destidx to t1_idxcnt + 1
            exit repeat
          end if
        end if
      else
        set srcidx to random(cpidx) + cpy1buf - 1
        set t_pos to t1_pos
        if (t_pos + ar1seg(mget, srcidx)) <= 13 then
          set t_add to 0
          set destidx to t1_idxcnt + 1
          exit repeat
        end if
      end if
      set full to full + 1
      if full > maxtrys then
        cur_on()
        alertrd(" Random can not be finished because " & "the tracks are too full." & RETURN & "Restoring circle.", " REMIX kann nicht beendet werden weil " & "die Spuren zu voll sind." & RETURN & "Wiederherstellung.")
        cur_busy()
        restorecircle(cpy2buf)
        displaysegs()
        cleanUpArrs(cpy1buf)
        cleanUpArrs(cpy2buf)
        cur_on()
        exit repeat
      end if
    end repeat
    if full > maxtrys then
      exit
    end if
    AR1idx(mput, destidx + t_add, destidx + t_add)
    move_ar1(destidx + t_add, srcidx)
    ar1pos(mput, destidx + t_add, t_pos)
    displaysegs()
    if t_add = 0 then
      set t1_pos to t1_pos + ar1seg(mget, srcidx)
      set t1_segcnt to t1_segcnt + ar1seg(mget, srcidx)
      set t1_idxcnt to t1_idxcnt + 1
    else
      set t2_pos to t2_pos + ar1seg(mget, srcidx)
      set t2_segcnt to t2_segcnt + ar1seg(mget, srcidx)
      set t2_idxcnt to t2_idxcnt + 1
    end if
    set tmp_idx to srcidx
    repeat while 1
      if AR1idx(mget, tmp_idx + 1) = 0 then
        exit repeat
      end if
      AR1idx(mput, tmp_idx, AR1idx(mget, tmp_idx + 1))
      move_ar1(tmp_idx, tmp_idx + 1)
      set tmp_idx to tmp_idx + 1
    end repeat
    set cpidx to cpidx - 1
  end repeat
  cleanUpArrs(cpy1buf)
  cleanUpArrs(cpy2buf)
  cur_on()
end

on restorecircle cpy2buf
  global t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt
  set srcidx to cpy2buf
  set dest1idx to 0
  set dest2idx to 0
  set t1_segcnt to 0
  set t2_segcnt to 0
  set t1_idxcnt to 0
  set t2_idxcnt to 0
  cleanup()
  cleanUpArrs()
  updateStage()
  repeat with i = 1 to 24
    if AR1idx(mget, srcidx) <> 0 then
      if Ar1track(mget, srcidx) = 2 then
        set t_add to 12
        set dest2idx to dest2idx + 1
        set t2_idxcnt to t2_idxcnt + 1
        set t2_segcnt to t2_segcnt + 1
        set tidx to dest2idx
      else
        set t_add to 0
        set dest1idx to dest1idx + 1
        set t1_idxcnt to t1_idxcnt + 1
        set t1_segcnt to t1_segcnt + 1
        set tidx to dest1idx
      end if
      AR1idx(mput, tidx + t_add, tidx)
      move_ar1(tidx + t_add, srcidx)
      displaysegs()
    end if
    set srcidx to srcidx + 1
  end repeat
end

on move_ar1 destidx, srcidx
  ar1pos(mput, destidx, ar1pos(mget, srcidx))
  ar1seg(mput, destidx, ar1seg(mget, srcidx))
  Ar1Vol(mput, destidx, Ar1Vol(mget, srcidx))
  Ar1col(mput, destidx, Ar1col(mget, srcidx))
  Ar1time(mput, destidx, Ar1time(mget, srcidx))
  Ar1sound(mput, destidx, Ar1sound(mget, srcidx))
  Ar1play(mput, destidx, Ar1play(mget, srcidx))
  ar1cast(mput, destidx, ar1cast(mget, srcidx))
  Ar1time(mput, destidx, Ar1time(mget, srcidx))
  Ar1Sprite(mput, destidx, Ar1Sprite(mget, srcidx))
end

on mixseg
  global mix_vol1, mix_vol2, mix_ofs1, mix_fn1, mix_fn2, mix_fnO, mix_rate, mix_qua, mix_mon, mix_size, mix_err, sndobj
  put "Mixing ...." & RETURN & " " & filenameMAC(mix_fn1) & " <> " & filenameMAC(mix_fn2) & "  " & RETURN & " Please wait ..." & mix_qua & RETURN, 1
  set save2name to mix_fn2
  set mix_err to 0
  if the machineType <> 256 then
    set src to mix_fn1
    set dest to the pathName & "mixtmp.AIF"
    if the machineType = 256 then
      set mix_fn1 to src
      set mix_fn2 to dest
      set mix_err to sndobj(mFcopy)
    else
      sndobj(mfname1, src)
      sndobj(mfname2, dest)
      set mix_err to sndobj(mFcopy)
    end if
    if mix_err <> 0 then
      alertrd("Error " & string(mix_err) & " while copying !", "Fehler " & string(mix_err) & " beim kopieren !")
    end if
    set mix_fn1 to the pathName & "mixtmp.AIF"
    set mix_fn2 to save2name
  end if
  if the machineType <> 256 then
    sndobj(mfname1, mix_fn1)
    sndobj(mfname2, mix_fn2)
    sndobj(mfnameo, mix_fnO)
    sndobj(mvolume1, value(mix_vol1))
    sndobj(mVolume2, value(mix_vol2))
    sndobj(mOffset, integer(value(mix_ofs1)))
    set mix_err to sndobj(mMixit)
  else
    sndobj(mMixit)
  end if
  alertrdremove()
  if mix_err <> 0 then
    alertrd("Error while mixing." & RETURN & "Code:>" & mix_err, "Fehler beim mixen." & RETURN & "Code:>" & mix_err)
  end if
end

on segsum start, stop
  set retval to 0
  if start > 12 then
    set add to 12
  else
    set add to 0
  end if
  repeat with i = start to stop
    if value(ar1seg(mget, i)) = 0 then
      exit repeat
    end if
    set retval to retval + value(ar1seg(mget, i))
  end repeat
  return retval
end

on circlemix
  global mix_vol1, mix_vol2, mix_ofs1, mix_fn1, mix_fn2, mix_fnO, mix_seg, mix_pos, mix_segtime, mix_sl, mix_err, LED_1, LED_2, t1_idxcnt, t2_idxcnt, nn_mixcast, namepause_bs, areon, t1_segcnt, t2_segcnt, tret, ltl_len, ltl_time, ltl_scast, ltl_mix, fcommand
  set fcommand to EMPTY
  if (t1_segcnt = 0) and (t2_segcnt = 0) then
    return
  end if
  if areon = 1 then
    set fcommand to "REMX"
    return
  end if
  set start1idx to ar_pos2idx(0, getstartidx(0))
  set start2idx to ar_pos2idx(12, getstartidx(12))
  set stop1idx to ar_pos2idxstop(0, getstopidx(0) - 1)
  set stop2idx to ar_pos2idxstop(12, getstopidx(12) - 1)
  set seg1 to segsum(start1idx, stop1idx)
  set seg2 to segsum(start2idx, stop2idx)
  if not (ar1pos(mget, start1idx) = ar1pos(mget, start2idx)) then
    alertrd("Set valid Looppoints for mixing 2 tracks." & RETURN & "Start Looppoints must fit the element start.", "Looppunkte entsprechen nicht den geladenen ELEMENTEN." & RETURN & "Startlooppunkte muessen am ELEMENT Anfang stehen.")
    exit
  end if
  if stop1idx > (value(ar1pos(mget, start1idx)) + value(ar1seg(mget, start1idx))) then
    alertrd("Set valid Looppoints for mixing 2 tracks." & RETURN & "Stop Looppoints must fit the element length on track 1.", "Looppunkte entsprechen nicht den geladenen ELEMENTEN." & RETURN & "Stoplooppunkte muessen am ELEMENT Ende stehen.")
    exit
  end if
  if (start1idx > stop1idx) or (start2idx > stop2idx) then
    alertrd("Set valid Looppoints for mixing 2 tracks.", "Zum mixen gueltige Looppunte setzen.")
    exit
  end if
  if not (seg1 = seg2) then
    alertrd("Set valid Looppoints for mixing 2 tracks." & RETURN & "Insert Empty Elements or adjust size", "Zum mixen gueltige Looppunte setzen oder Laenge aendern.")
    exit
  end if
  if (ar1pos(mget, start1idx) + ar1seg(mget, start1idx)) > LED_2 then
    put "1 > LED_2  >" & value(ar1pos(mget, start1idx)) & "<>" & value(ar1seg(mget, start1idx)) & "<>" & LED_2 & "<>" & stop1idx
    alertrd("Set valid Looppoints for mixing 2 tracks." & RETURN & "Loopoints must fit smalest elelemtsize.", "Zum mixen gueltige Looppunte setzen." & RETURN & "Stoplooppunkte muessen am ELEMENT Ende stehen.")
    put "mixerr 5"
    exit
  end if
  if (ar1pos(mget, start2idx + 12) + ar1seg(mget, start2idx + 12)) > (LED_2 + 12) then
    put "2 > LED_2  >" & value(ar1pos(mget, start2idx + 12)) & "<>" & value(ar1seg(mget, start2idx + 12)) & "<>" & LED_2 & "<>" & stop2idx
    alertrd("Set valid Looppoints for mixing 2 tracks." & RETURN & "Loopoints must fit smalest elelemtsize.", "Zum mixen gueltige Looppunte setzen." & RETURN & "Stoplooppunkte muessen am ELEMENT Ende stehen.")
    put "mixerr 6"
    exit
  end if
  if (LED_2 - 1) > t1_segcnt then
    put "end 1 >" & value(ar1pos(mget, stop1idx)) & "<>" & value(ar1seg(mget, stop1idx)) & "<>" & LED_2 & "<>" & stop1idx
    alertrd("Set valid Looppoints for mixing 2 tracks." & RETURN & "Loopoints must fit smalest elelemtsize.", "Zum mixen gueltige Looppunte setzen." & RETURN & "Stoplooppunkte muessen am ELEMENT Ende stehen.")
    put "mixerr 7"
    exit
  end if
  set mix_err to "1"
  set mix_ofs1 to "0"
  set mix_idx to set_globmix(start1idx, start2idx, stop1idx, stop2idx)
  put "mix_idx>" & mix_idx & " mixsegtime>" & string(mix_segtime) & " mixseg>" & mix_seg
  if mix_idx = 0 then
    exit
  else
    cur_busy()
    mixseg()
    set nn_mixcast to nn_mixcast + 1
    set loopsl to mix_seg - mix_sl - 1
  end if
  repeat with i = 1 to loopsl
    put "i >" & i & " loop>" & loopsl & " mix_sl>" & mix_sl
    if mix_idx > 12 then
      if (mix_idx + i) > stop2idx then
        exit repeat
      end if
    else
      if (mix_idx + i) > stop1idx then
        exit repeat
      end if
    end if
    set_globmixsl(mix_idx + i)
    set mix_ofs1 to string(value(mix_ofs1) + (mix_segtime * ar1seg(mget, mix_idx + i)))
    if not ((mix_fn1 = namepause_bs) or (mix_fn2 = namepause_bs) or (mix_fn1 = EMPTY) or (mix_fn2 = EMPTY)) then
      put "mix_ofs1 >" & mix_ofs1 & " mix_segtime>" & mix_segtime & " i>" & i
      mixseg()
      set nn_mixcast to nn_mixcast + 1
      put "SLSETOK" & "<>" & mix_fn1 & "<>" & mix_fn2
      next repeat
    end if
    if mix_fn2 = namepause_bs then
    end if
    put "SLPAUSE" & "<>" & mix_fn1 & "<>" & mix_fn2
  end repeat
  put "sl_end"
  if mix_err = 0 then
    set tmpsize to readsound(the pathName & string(nn_mixcast - 1) & ".AIF", nn_mixcast - 1)
    if tmpsize <> 0 then
      set segtime to tmpsize / mix_seg
      tl_insert(mix_pos, mix_seg, integer(segtime), nn_mixcast - 1, "M")
      repeat with i = mix_pos + 1 to mix_pos + mix_seg - 1
        put "tl_SL-------------"
        tl_insert(i, "-", segtime, 0, "-")
      end repeat
      mixneed_off()
    end if
  end if
  cur_on()
end

on set_globmix start1idx, start2idx, stop1idx, stop2idx
  global mix_vol1, mix_vol2, mix_ofs1, mix_fn1, mix_fn2, mix_fnO, mix_seg, mix_pos, nn_mixcast, namepause_bs, mix_segtime, tret, mix_sl
  set mix_sl to 0
  set mix_seg to value(ar1seg(mget, start1idx))
  set mix_pos to value(ar1pos(mget, start1idx))
  set mix_segtime to Ar1time(mget, start1idx) / mix_seg
  set tret to 1
  repeat while 1
    set mix_fn1 to Ar1sound(mget, start1idx)
    if mix_fn1 <> namepause_bs then
      exit repeat
    end if
    set mix_ofs1 to string(value(mix_ofs1) + (ar1seg(mget, start1idx) * mix_segtime))
    set mix_sl to mix_sl + ar1seg(mget, start1idx)
    set start1idx to start1idx + 1
    if start1idx > stop1idx then
      put "start1idx > stop1idx"
      return 0
    end if
  end repeat
  repeat while 1
    set mix_fn2 to Ar1sound(mget, start2idx)
    if mix_fn2 <> namepause_bs then
      if mix_fn2 <> mix_fn1 then
        exit repeat
      end if
    end if
    set mix_ofs1 to string(value(mix_ofs1) + (ar1seg(mget, start2idx) * mix_segtime))
    set mix_sl to mix_sl + ar1seg(mget, start2idx)
    set start2idx to start2idx + 1
    if start2idx > stop2idx then
      put "start2idx > stop2idx"
      return 0
    end if
  end repeat
  if (mix_fn1 = mix_fn2) and (value(mix_ofs1) = 0) then
    put "mix_fn1 = mix_fn2"
    return 0
  else
    set mix_vol1 to string(Ar1Vol(mget, start1idx) - 1)
    set mix_vol2 to string(Ar1Vol(mget, start2idx) - 1)
    set mix_fnO to the pathName & string(nn_mixcast) & ".aif"
    if tret = 1 then
      return start2idx
    else
      return start1idx
    end if
  end if
end

on set_globmixsl startidx
  global mix_vol1, mix_vol2, mix_ofs1, mix_fn1, mix_fn2, mix_fnO, mix_seg, mix_pos, nn_mixcast
  set mix_fn1 to the pathName & string(nn_mixcast - 1) & ".aif"
  set mix_fn2 to Ar1sound(mget, startidx)
  set mix_vol1 to "15"
  set mix_vol2 to string(Ar1Vol(mget, startidx) - 1)
  set mix_fnO to the pathName & string(nn_mixcast) & ".aif"
end

on mixneed_on
  global mixneed
  set mixneed to 1
end

on mixneed_off
  global mixneed
  set mixneed to 0
end

on fpos2idx pos, track
  set reti to 0
  set tmp to 0
  repeat with i = track to 11 + track
    set tmp to tmp + value(ar1seg(mget, i))
    if tmp >= pos then
      set reti to i
      exit repeat
    end if
  end repeat
  return reti
end

on circleshrink
  global fcommand, t1_idxcnt, t2_idxcnt, up_save, mixedloop, startidx, t1_segcnt, t2_segcnt, mix_idx1, sel_idx, demo
  set fcommand to EMPTY
  if demo then
    demomixwin()
    exit
  end if
  if t2_idxcnt = 0 then
    return
  end if
  if not mixedloop then
    snd_mix(value(startidx))
  end if
  circlemaster()
  cur_busy()
  set sp to getspritenum("MIX")
  set the castNum of sprite sp to the number of cast "MIX_PR"
  set the ink of sprite sp to 8
  sprite_show(sp, 282, 199)
  updateStage()
  set virtled to 1
  repeat with idxlpcnt = 1 to t1_idxcnt
    set dest to get_randfnmx("MX")
    put "shrink idxlpcnt>" & idxlpcnt & " virtled>" & virtled & " dest >" & dest
    do_saveseg(virtled, idxlpcnt, dest)
    if Ar1play(mget, idxlpcnt) > 0 then
      snd_close(value(Ar1play(mget, idxlpcnt)))
    end if
    set newidx to find_slot()
    set sel_size to readsound(dest, newidx)
    Ar1time(mput, idxlpcnt, sel_size)
    Ar1sound(mput, idxlpcnt, dest)
    Ar1play(mput, idxlpcnt, newidx)
    set virtled to virtled + value(ar1seg(mget, idxlpcnt))
  end repeat
  cleanUpt2()
  set sel_idx to 1
  displaysegs()
  circlemaster()
  set sp to getspritenum("MIX")
  set the castNum of sprite sp to the number of cast "MIX"
  set the ink of sprite sp to 8
  sprite_show(sp, 282, 199)
  cur_on()
end