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

Text File | 1995-05-01 | 13.2 KB | 507 lines

on sounddelete
  global sel_pos, namepause_bs, backcast, fcommand, sel_track, sel_idx, segsprite, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt
  set fcommand to EMPTY
  set tmpi to 0
  set tmp_idxcnt to 0
  set sp to getspritenum("DEL")
  set the castNum of sprite sp to the number of cast "DEL_PR"
  set the ink of sprite sp to 8
  sprite_show(sp, 189, 199)
  updateStage()
  if sel_track = 0 then
    if selwin("Delete the whole CIRCLE ?", "Den gesamten CIRCLE loeschen ?") then
      clear_circle()
    end if
    set sp to getspritenum("DEL")
    set the castNum of sprite sp to the number of cast "DEL"
    set the ink of sprite sp to 8
    sprite_show(sp, 189, 199)
    return
  end if
  cur_busy()
  if sel_track = 1 then
    set t1_segcnt to integer(t1_segcnt - value(ar1seg(mget, sel_idx)))
    set t1_idxcnt to t1_idxcnt - 1
    set tmp_idxcnt to t1_idxcnt
    set tmpi to sel_idx
    set t_add to 0
  else
    set t2_segcnt to integer(t2_segcnt - value(ar1seg(mget, sel_idx)))
    set t2_idxcnt to t2_idxcnt - 1
    set tmp_idxcnt to t2_idxcnt
    set tmpi to sel_idx - 12
    set t_add to 12
  end if
  set delseg to ar1seg(mget, sel_idx)
  set copyidx to sel_idx
  if Ar1sound(mget, sel_idx) <> namepause_bs then
    if Ar1play(mget, sel_idx) > 0 then
      snd_close(value(Ar1play(mget, sel_idx)))
    end if
  end if
  repeat while tmpi <= tmp_idxcnt
    set vpos0 to integer(value(ar1pos(mget, copyidx + 1)) - delseg)
    set vpos1 to lzero(vpos0)
    ar1pos(mput, copyidx, string(vpos1))
    AR1idx(mput, copyidx, AR1idx(mget, copyidx + 1) - 1)
    ar1seg(mput, copyidx, ar1seg(mget, copyidx + 1))
    Ar1Vol(mput, copyidx, Ar1Vol(mget, copyidx + 1))
    Ar1col(mput, copyidx, Ar1col(mget, copyidx + 1))
    Ar1time(mput, copyidx, Ar1time(mget, copyidx + 1))
    Ar1sound(mput, copyidx, Ar1sound(mget, copyidx + 1))
    Ar1play(mput, copyidx, Ar1play(mget, copyidx + 1))
    ar1cast(mput, copyidx, ar1cast(mget, copyidx + 1))
    Ar1time(mput, copyidx, Ar1time(mget, copyidx + 1))
    Ar1Sprite(mput, copyidx, Ar1Sprite(mget, copyidx + 1))
    set copyidx to copyidx + 1
    set tmpi to tmpi + 1
  end repeat
  AR1idx(mput, copyidx, 0)
  ar1pos(mput, copyidx, 0)
  ar1seg(mput, copyidx, 0)
  Ar1play(mput, copyidx, 0)
  displaysegs()
  set segsprite to 0
  circlemaster()
  set sp to getspritenum("DEL")
  set the castNum of sprite sp to the number of cast "DEL"
  set the ink of sprite sp to 8
  sprite_show(sp, 189, 199)
  cur_on()
end

on circleinsert
  global fcommand, t1pos, t2pos, MUTE, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt, AR_nnsc, sel_track, sel_pos, segsprite, sel_name, sel_txpos, sel_ttrak, tmp_segcnt
  set fcommand to EMPTY
  if sel_track = 0 then
    if MUTE = 1 then
      set tmp_segcnt to t1_segcnt
      set sel_ttrak to "1"
    else
      set tmp_segcnt to t2_segcnt
      set sel_ttrak to "2"
    end if
    set txpos to tmp_segcnt + 1
  else
    if sel_track = 1 then
      set tmp_segcnt to t1_segcnt
      set sel_ttrak to "1"
      set txpos to sel_pos
    else
      if sel_track = 2 then
        set tmp_segcnt to t2_segcnt
        set sel_ttrak to "2"
        set txpos to sel_pos
      end if
    end if
  end if
  if (tmp_segcnt + 1) > 12 then
    alertrd("No more free soundelements on this track !", "Keine freien ELEMENTE auf dieser Spur !")
    exit
  end if
  if isdemosegs(t1_idxcnt + t2_idxcnt) then
    exit
  end if
  fsel("SOUND")
end

on setseglen ttrak, txpos, tsize, tsndcast
  global up_override, Citotaltime
  set w_reqidx to value(txpos)
  set w_rdidx to w_reqidx
  set totaltime to 0
  set totalseg to 0
  set retval to 0
  set tmpsize to tsize
  if ttrak = 1 then
    set offset to 12
  else
    set offset to 0
  end if
  repeat with i = 1 to 12
    if ar1pos(mget, i) = txpos then
      exit repeat
    end if
    if ar1pos(mget, i + 12) = txpos then
      exit repeat
    end if
  end repeat
  set st_idx to i
  if i <= 12 then
    repeat while 1
      if AR1idx(mget, st_idx + offset) <= 0 then
        if tsize > (totaltime + up_override) then
          set retval to retval + 1
        end if
        exit repeat
      end if
      set totaltime to totaltime + Ar1time(mget, st_idx + offset)
      set totalseg to totalseg
      set retval to retval + ar1seg(mget, st_idx + offset)
      if tsize <= (totaltime + up_override) then
        exit repeat
      end if
      set st_idx to st_idx + 1
    end repeat
  end if
  if retval < 1 then
    set retval to 1
  end if
  if retval = 7 then
    set retval to 8
  end if
  if retval = 10 then
    set retval to 12
  end if
  if retval = 11 then
    set retval to 12
  end if
  if retval > 12 then
    set retval to 0
  end if
  return integer(retval)
end

on dispsound ptrack, psound, ppos, plen, pvol, copyflag
  global maxsegs, fcommand, gcast, firstsound, sample_offset, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt, AR_nnsc, sel_track, sel_idx, sel_pos, sel_size, pastebuf, newidx
  set ppos to lzero(ppos)
  set psize to 0
  if sel_track = 0 then
    if ptrack = "1" then
      set sel_idx to t1_idxcnt + 1
    else
      set sel_idx to t2_idxcnt + 1 + 12
    end if
  else
    set tmpidx to sel_idx
    set tmpi to sel_idx
    if sel_track = 1 then
      set tmp_idxcnt to t1_idxcnt
      set copyidx to tmp_idxcnt + 1
      set ptrack to "1"
    else
      set tmp_idxcnt to t2_idxcnt + 12
      set copyidx to tmp_idxcnt + 1
      set ptrack to "2"
    end if
    repeat while tmpi <= tmp_idxcnt
      set vpos0 to integer(value(ar1pos(mget, copyidx - 1)) + value(plen))
      set vpos1 to string(vpos0)
      if length(vpos1) < 2 then
        set vpos1 to "0" & vpos1
      end if
      AR1idx(mput, copyidx, AR1idx(mget, copyidx - 1) + 1)
      ar1pos(mput, copyidx, vpos1)
      ar1seg(mput, copyidx, ar1seg(mget, copyidx - 1))
      Ar1Vol(mput, copyidx, Ar1Vol(mget, copyidx - 1))
      Ar1col(mput, copyidx, Ar1col(mget, copyidx - 1))
      Ar1time(mput, copyidx, Ar1time(mget, copyidx - 1))
      Ar1sound(mput, copyidx, Ar1sound(mget, copyidx - 1))
      Ar1play(mput, copyidx, Ar1play(mget, copyidx - 1))
      ar1cast(mput, copyidx, ar1cast(mget, copyidx - 1))
      Ar1time(mput, copyidx, Ar1time(mget, copyidx - 1))
      Ar1Sprite(mput, copyidx, Ar1Sprite(mget, copyidx - 1))
      set copyidx to copyidx - 1
      set tmpi to tmpi + 1
    end repeat
  end if
  if copyflag = 0 then
    set tmpcastno to newidx
    set AR_nnsc to newidx
    set pcol to calccol(psound)
    set psize to sel_size
  else
    set tmpcastno to newidx
    set AR_nnsc to AR_nnsc + 1
    set pcol to Ar1col(mget, copyflag)
    set psize to sel_size
  end if
  if ptrack = "1" then
    set t1_segcnt to t1_segcnt + value(plen)
    set t1_idxcnt to t1_idxcnt + 1
  else
    set t2_segcnt to t2_segcnt + value(plen)
    set t2_idxcnt to t2_idxcnt + 1
  end if
  AR1idx(mput, sel_idx, sel_idx)
  ar1pos(mput, sel_idx, ppos)
  ar1seg(mput, sel_idx, plen)
  Ar1Vol(mput, sel_idx, pvol)
  Ar1col(mput, sel_idx, pcol)
  Ar1sound(mput, sel_idx, psound)
  Ar1time(mput, sel_idx, psize)
  Ar1play(mput, sel_idx, tmpcastno)
end

on getsoundname dummy
  global fcommand, t1_segcnt, t2_segcnt, MUTE
  set fcommand to EMPTY
  set file to FileIO(mnew, "?read", "AIFF")
  if not objectp(file) then
    return EMPTY
    exit
  end if
  set psound to file(mFileName)
  file(mdispose)
  return psound
end

on soundcopy
  global fcommand, gcast, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt, AR_nnsc, sel_track, sel_idx, sel_pos, pastebuf, demo, sample_offset, namepause_bs, cp_idx
  set fcommand to EMPTY
  if sel_track = 0 then
    alertrd("Select a ELEMENT for copying", "Zum Kopieren ein ELEMENT auswaehlen !")
    return 0
  else
    set copyidx to sel_idx
    set destidx to cp_idx
    Ar1Vol(mput, destidx, Ar1Vol(mget, copyidx))
    Ar1col(mput, destidx, Ar1col(mget, copyidx))
    Ar1time(mput, destidx, Ar1time(mget, copyidx))
    set cps to Ar1sound(mget, copyidx)
    if cps = namepause_bs then
      exit
      return 0
    else
      Ar1sound(mput, destidx, cps)
    end if
    if pastebuf = 0 then
      set tmpsprite to getspritenum("FIRE")
      set the visible of sprite tmpsprite to 1
    end if
    ar1cast(mput, destidx, ar1cast(mget, copyidx))
    if charToNum(chars(cps, length(cps), length(cps))) < 33 then
      set tmpsound to chars(cps, 1, length(cps) - 1)
    else
      set tmpsound to cps
    end if
    cur_busy()
    set tsize to readsound(tmpsound, destidx)
    Ar1play(mput, destidx, destidx)
    set pastebuf to pastebuf + 1
    copywindow()
    cur_on()
    return 1
  end if
end

on soundpaste
  global fcommand, MUTE, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt, AR_nnsc, sel_track, sel_pos, segsprite, pastebuf, newidx, demo, cp_idx
  set fcommand to EMPTY
  set cidx to cp_idx
  if pastebuf = 0 then
    alertrd("No ELEMENT in the Copybuffer !", "Kein ELEMENT im Kopierpuffer !")
    return 0
  end if
  if demo then
    if isdemosegs(t1_idxcnt + t2_idxcnt) then
      return 0
    end if
  end if
  set tmpname to Ar1sound(mget, cidx)
  if tmpname = EMPTY then
    exit
  end if
  if sel_track = 0 then
    if MUTE = 1 then
      set tmp_segcnt to t1_segcnt
      set ttrak to "1"
      set t_add to 0
    else
      set tmp_segcnt to t2_segcnt
      set ttrak to "2"
      set t_add to 12
    end if
    set txpos to tmp_segcnt + 1
  else
    if sel_track = 1 then
      set tmp_segcnt to t1_segcnt
      set ttrak to "1"
      set t_add to 0
      set txpos to sel_pos
    else
      if sel_track = 2 then
        set tmp_segcnt to t2_segcnt
        set ttrak to "2"
        set t_add to 12
        set txpos to sel_pos
      end if
    end if
  end if
  put "paste1 t1_segcnt>" & t1_segcnt & "t2_segcnt>" & t2_segcnt & "tmp_segcnt>" & tmp_segcnt
  if (tmp_segcnt + 1) > 12 then
    alertrd("No more free soundelements on this track !", "Keine freien ELEMENTE auf dieser Spur !")
    return 0
  end if
  cur_busy()
  set newidx to find_slot()
  if demo then
    set tsize to readsound(tmpname, newidx)
  else
    set tsize to readsound(tmpname, newidx)
  end if
  dispsound(ttrak, tmpname, txpos, "1", "16", cidx)
  displaysegs()
  set segsprite to 0
  setmastervol()
  cur_on()
  return 1
end

on circlepause
  global fcommand, t1pos, t2pos, MUTE, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt, AR_nnsc, sel_track, sel_pos, segsprite, namepause_bs, newidx
  set fcommand to EMPTY
  set tmpname to namepause_bs
  if sel_track = 0 then
    if MUTE = 1 then
      set tmp_segcnt to t1_segcnt
      set ttrak to "1"
      set t_add to 0
    else
      set tmp_segcnt to t2_segcnt
      set ttrak to "2"
      set t_add to 12
    end if
    set txpos to tmp_segcnt + 1
  else
    if sel_track = 1 then
      set tmp_segcnt to t1_segcnt
      set ttrak to "1"
      set t_add to 0
      set txpos to sel_pos
    else
      if sel_track = 2 then
        set tmp_segcnt to t2_segcnt
        set ttrak to "2"
        set t_add to 12
        set txpos to sel_pos
      end if
    end if
  end if
  if (tmp_segcnt + 1) > 12 then
    alertrd("No more free ELEMENTS on this track !", "Keine freien ELEMENTE auf dieser Spur !")
    exit
  end if
  cur_busy()
  set tsize to get_pausesize(value(txpos), sel_track)
  if tsize <> 0 then
    set newidx to find_slot()
    set st_seglen to "01"
    dispsound(ttrak, tmpname, txpos, st_seglen, 16, 0)
    displaysegs()
    set segsprite to 0
    setmastervol()
  end if
  cur_on()
end

on get_pausesize pos, track
  global ltl_len, ltl_mix, ltl_scast, ltl_time
  set opptrack to value(getAt(ltl_mix, pos))
  if pos > tl_maxpos(1) then
    return 0
  else
    return getAt(ltl_time, pos)
  end if
end

on d_copy sw
  global cp_idx, cp_1, cp_2
  if sw = 1 then
    set cp_idx to 25
    if soundcopy() then
      cp1set(1)
    end if
  else
    set cp_idx to 26
    if soundcopy() then
      cp2set(1)
    end if
  end if
end

on d_paste sw
  global cp_idx, cp_1, cp_2, pastebuf
  if sw = 1 then
    set cp_idx to 25
    if soundpaste() then
      if not (the shiftDown) then
        cp1set(0)
        set pastebuf to pastebuf - 1
      end if
    end if
  else
    set cp_idx to 26
    if soundpaste() then
      if not (the shiftDown) then
        cp2set(0)
        set pastebuf to pastebuf - 1
      end if
    end if
  end if
  if pastebuf = 0 then
    set tmpsprite to getspritenum("FIRE")
    set the visible of sprite tmpsprite to 0
  end if
end

on cp1set sw
  global cp_1, cp_idx
  set tmpsprite to getspritenum("BF_CP1")
  if sw = 1 then
    set the foreColor of sprite tmpsprite to Ar1col(mget, cp_idx)
    sprite_show(tmpsprite, 557, 79)
    set cp_1 to 1
  else
    sprite_blank(tmpsprite)
    set cp_1 to 0
  end if
end

on cp2set sw
  global cp_2, cp_idx
  set tmpsprite to getspritenum("BF_CP2")
  if sw = 1 then
    set the foreColor of sprite tmpsprite to Ar1col(mget, cp_idx)
    sprite_show(tmpsprite, 609, 79)
    set cp_2 to 1
  else
    sprite_blank(tmpsprite)
    set cp_2 to 0
  end if
end

on circlemaster
  global fcommand, backcast, segsprite, segcol, last_mute
  set backcast to 0
  setmastervol()
  if segsprite <> 0 then
    flashback(segsprite, segcol)
  end if
  if last_mute > 0 then
    if last_mute = 2 then
      mute0off()
      mute2On()
    else
      mute0off()
      mute1On()
    end if
    set last_mute to 0
  end if
  segszklick()
end

on clear_circle
  global backcast, freemaster, up_sampm, MUTE
  cur_busy()
  set backcast to 0
  set freemaster to up_sampm
  setmastervol()
  cleanup()
  cleanUpArrs()
  cleanupsounds()
  set MUTE to 2
  muteklick()
  cur_on()
end