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

Text File | 1995-05-01 | 11.1 KB | 385 lines

on find_slot
  repeat with i = 1 to 24
    repeat with c = 1 to 24
      set chk to Ar1play(mget, c)
      if value(chk) = i then
        exit repeat
      end if
      if c = 24 then
        return i
      end if
    end repeat
  end repeat
end

on chk_slot
  repeat with i = 1 to 24
  end repeat
end

on snd_init
  global sndobj, mix_err, mix_vol1, mix_ofs1, up_mem
  set mix_ofs1 to string(integer(up_mem * 100000))
  set mix_vol1 to "1"
  if the machineType = 256 then
    set mix_err to sndobj(mSndInit)
  else
    set mix_err to sndobj(mInit, value(mix_ofs1))
  end if
  if mix_err <> 0 then
    alert("SNDWORK Error while Init: " & mix_err)
    return 0
  end if
  return 1
end

on snd_stop
  global sndobj, last_play, mix_idx1, mix_err, playing
  set mix_idx1 to string(last_play)
  if the machineType = 256 then
    set mix_err to sndobj(mSndStop)
  else
    set mix_err to sndobj(mStop, value(mix_idx1))
  end if
  if mix_err <> 0 then
  end if
  set playing to 0
end

on snd_close idx
  global sndobj, mix_err, mix_idx1
  set mix_idx1 to string(idx)
  if the machineType = 256 then
    set mix_err to sndobj(mSndClose)
  else
    set mix_err to sndobj(mClose, value(mix_idx1))
  end if
  if mix_err <> 0 then
    put "SNDWORK Error while Close: " & string(mix_err)
  end if
end

on snd_done
  global sndobj, mix_err
  if the machineType = 256 then
    if objectp(sndobj) then
      set mix_err to sndobj(mSndDone)
    end if
  else
    if objectp(sndobj) then
      set mix_err to sndobj(mDone)
    end if
  end if
  if mix_err <> 0 then
    alert("SNDWORK Error while Done: " & mix_err)
  end if
end

on readsound psound, scast, msg
  global fcommand, scommand, sel_scast, sel_size, acwin, fl_msg, enterFrame, firstsound, sample_rate, sample_offset, circle_qua, enterFrame, enterFrame, enterFrame, sndobj, mix_fn1, mix_fn2, mix_ofs1, mix_vol1, mix_vol2, mix_err, mix_rate, mix_qua, mix_size, mix_mon, mix_idx1, mix_idx2, mix_loop, mix_start, mix_end
  set psound to stripcrtlchars(psound)
  put "readsound>" & psound & "< scast>" & scast & "< msg>" & msg & "<"
  if not (sndpar(psound) = 0) then
    if value(msg) = 0 then
      cur_on()
      alertrd("Can`t identify soundfile type while reading !" & RETURN & psound & "<>", "Soundformatfehler beim Laden !" & RETURN & psound & "<>")
      cur_busy()
    end if
    return 0
  end if
  if ((mix_size * (value(circle_qua) / 8)) + 200) >= the freeBytes then
    cur_on()
    err_memsnd()
    cur_busy()
    return 0
  end if
  if not firstsound then
    if not (mix_qua = circle_qua) then
      cur_on()
      alertrd("This Cirle was not set for this" & RETURN & "soundparameters ! (Bits/Rate/Mode)", "Dieser CIRCLE arbeitet mit einem anderen" & RETURN & "Soundformat ! (Bits/Rate/Mode)")
      return 0
    end if
  else
    mem_update()
  end if
  if circle_qua = "16" then
    if demobit() then
      return 0
    end if
  end if
  set mix_idx1 to string(scast)
  set mix_fn1 to psound
  put "load scast>" & scast & "< sel_c>" & sel_scast & " mix_idx1>" & mix_idx1
  if the machineType = 256 then
    set mix_err to sndobj(mSndClose)
    set mix_err to sndobj(mSndLoad)
  else
    set mix_err to sndobj(mClose, value(mix_idx1))
    set mix_err to sndobj(mLoad, value(mix_idx1), mix_fn1)
  end if
  if mix_err <> 0 then
    if value(msg) = 0 then
      alertrd("SNDWORK Error while loading: " & mix_err, "SNDWORK Fehler beim Laden: " & mix_err)
    end if
  else
    set tmp_size to value(mix_size)
    if firstsound then
      set sample_rate to mix_rate
      set circle_qua to mix_qua
      set firstsound to 0
    end if
  end if
  if circle_qua = "16" then
    set tmp_size to integer(integer(tmp_size / 2) * 2)
  end if
  set sel_size to tmp_size
  put "loaded>>>" & tmp_size
  return tmp_size
end

on circleplay
  global fcommand, sel_idx, sel_track, namepause_bs, sndobj, mix_vol1, mix_err, mix_idx1, mix_loop, last_play
  set fcommand to EMPTY
  if sel_track <> 0 then
    set pidx to Ar1play(mget, sel_idx)
    set pvol to Ar1Vol(mget, sel_idx)
    if Ar1sound(mget, sel_idx) = namepause_bs then
      exit
    end if
    snd_stop()
    set mix_idx1 to string(pidx)
    set mix_vol1 to string(pvol)
    set mix_loop to "0"
    if the machineType = 256 then
      set mix_err to sndobj(mSndPlay)
    else
      if value(mix_vol1) > 15 then
        set mix_vol1 to "15"
      end if
      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: " & mix_err, "SNDWORK Fehler beim Abspielen: " & mix_err)
    else
      set last_play to string(pidx)
    end if
    waitforup()
  end if
end

on circleloopinit
  global fcommand, t1_idxcnt, t2_idxcnt, mixedloop, starttimeticks, stopidx, startidx, loopidx, last_play, startTime, stopTime, ltl_time, wait_time, loop_time, sndobj, mix_vol1, mix_start, mix_end, mix_ofs1, mix_err, up_mvol
  set the floatPrecision to 16
  set fcommand to EMPTY
  snd_stop()
  if (t1_idxcnt = 0) and (t2_idxcnt = 0) then
    return
  end if
  set startidx to getstartidx(0)
  set stopidx to getstopidx(0)
  set loopidx to startidx
  if not mixedloop then
    if snd_mix(value(startidx)) then
      set mixedloop to 1
    else
      exit
    end if
  end if
  set startTime to integer(tltimestart(startidx))
  set stopTime to integer(tltimestop(stopidx - 1))
  set loop_time to stopTime
  WALK(mnew, loopidx)
  startTimer()
  set wait_time to float(calcticks(getAt(ltl_time, loopidx)))
  set sp to getspritenum("LOP")
  set the castNum of sprite sp to the number of cast "LOP_do"
  set the ink of sprite sp to 8
  sprite_show(sp, 235, 292)
  set last_play to string(0)
  set fcommand to "LOOP"
  set mix_start to string(integer(startTime))
  set mix_end to string(integer(stopTime - startTime))
  set mix_vol1 to string(up_mvol)
  set mix_ofs1 to "1"
  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
    put "initloop err"
    alertrd("SNDWORK Error while Playing: " & mix_err, "SNDWORK Fehler beim Abspielen: " & mix_err)
    set sp to getspritenum("LOP")
    set the castNum of sprite sp to the number of cast "LOP"
    set the ink of sprite sp to 8
    sprite_show(sp, 235, 292)
    set fcommand to EMPTY
  end if
end

on circleloopplay
  global fcommand, t_add, MUTE, pastebuf, t1_idxcnt, t2_idxcnt, ARLEDs, s_ticks, e_ticks, junkvol, areon, stopidx, startidx, loopidx, enterFrame, junk_cst, junk_vol, junk_time, LED_1, enterFrame, up_override, ltl_time, wait_time, loop_time, last_play, startTime, stopTime, up_mvol, starttimeticks
  if the mouseDown and (the mouseCast = the number of cast "fire") and (pastebuf <> 0) then
    circlefire()
    set loopidx to startidx
    WALK(mnew, loopidx)
    startTimer()
    set wait_time to calcticks(getAt(ltl_time, loopidx))
    set last_play to string(0)
    set fcommand to "LOOP"
    set mix_start to string(integer(startTime))
    set mix_end to string(integer(stopTime - startTime))
    set mix_vol1 to string(up_mvol)
    set mix_ofs1 to "1"
    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 Playing: " & mix_err, "SNDWORK Fehler beim Abspielen: " & mix_err)
      set fcommand to EMPTY
    end if
  end if
  set the floatPrecision to 16
  if the machineType = 256 then
    set tmptimer to the timer * up_override
  else
    set tmptimer to the timer
  end if
  if tmptimer >= integer(wait_time) then
    if loopidx >= (stopidx - 1) then
      set loopidx to startidx
      WALK(mmove, loopidx)
      set wait_time to float(wait_time + calcticks(getAt(ltl_time, loopidx)))
    else
      set loopidx to loopidx + 1
      WALK(mmove, loopidx)
      set wait_time to float(wait_time + calcticks(getAt(ltl_time, loopidx)))
    end if
  end if
end

on circleloopstop
  global fcommand, sndobj, last_play, mix_idx1, mix_err
  set mix_idx1 to string(0)
  if the machineType = 256 then
    set mix_err to sndobj(mSndStop)
  else
    set mix_err to sndobj(mStop, value(mix_idx1))
  end if
  if mix_err <> 0 then
  end if
  set fcommand to EMPTY
  WALK(mrelease)
  set sp to getspritenum("LOP")
  set the castNum of sprite sp to the number of cast "LOP"
  set the ink of sprite sp to 8
  sprite_show(sp, 235, 292)
end

on snd_mix lidx
  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, areon, 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
  set fcommnad to EMPTY
  if lidx > 0 then
    set led to value(LED_1)
  else
    set led to 1
  end if
  if (t1_idxcnt = 0) and (t2_idxcnt = 0) then
    return
  end if
  if t1_idxcnt > t2_idxcnt then
    set tmx to t1_idxcnt
  else
    set tmx to t2_idxcnt
  end if
  if t1_segcnt > t2_segcnt then
    set tms to t1_segcnt
  else
    set tms to t2_segcnt
  end if
  if led > tms then
    return
  end if
  cur_busy()
  set sp to getspritenum("MIX")
  set the castNum of sprite sp to the number of cast "MIX_DO"
  set the ink of sprite sp to 8
  sprite_show(sp, 282, 199)
  updateStage()
  if areon = 2 then
    if LED_2 > (tms + 1) then
      set hl to "LD" & lzero(tms)
      ledklick(hl)
    else
      set tms to LED_2 - 1
    end if
  end if
  set acmixdest to tltimestart(led)
  set t1ok to 1
  set t2ok to 1
  set i to led
  repeat while 1
    set t1ok to getpar1(i)
    set t2ok to getpar2(i)
    if (t1ok = 0) and (t2ok = 0) then
      set mxret to mixit(tms - led)
      if mxret = 0 then
        exit repeat
      end if
      set i to i + mxret
    else
      if (t1ok = 0) and (t2ok <> 0) then
        set mxret to ins_t1()
        if mxret = 0 then
          exit repeat
        end if
        set i to i + mxret
      else
        if (t1ok <> 0) and (t2ok = 0) then
          set mxret to ins_t2()
          if mxret = 0 then
            exit repeat
          end if
          set i to i + mxret
        else
          if (t1ok <> 0) and (t2ok <> 0) then
            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()
            return
          end if
        end if
      end if
    end if
    if i = (tms + 1) then
      exit repeat
    end if
  end repeat
  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()
  if mxret = 0 then
    alertrd("Mixing Error !", "Fehler beim mixen !")
    WALK(mrelease)
    set sp to getspritenum("LOP")
    set the castNum of sprite sp to the number of cast "LOP"
    set the ink of sprite sp to 8
    sprite_show(sp, 235, 292)
    return 0
  else
    return 1
  end if
end