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

Text File | 1995-05-01 | 11.2 KB | 395 lines

on circleload
  global fcommand, scommand, sel_name
  set sel_name to EMPTY
  set scommand to "CIlo"
  set fcommand to EMPTY
  fsel("CIRCLE")
end

on circleloadrun
  global fcommand, scommand, sel_name, AR_nnsc, sample_offset, namepause_bs, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt, ver_cfile, l_notload, newidx, demo
  set fcommand to EMPTY
  set scommand to EMPTY
  set tmp_size to float(0)
  set version_OK to 0
  set l_notload to []
  if sel_name = EMPTY then
    exit
  end if
  if the machineType = 256 then
    set file to FileIO(mnew, "read", sel_name)
  else
    set file to FileIO(mnew, "read", sel_name)
  end if
  if not objectp(file) then
    updateStage()
    exit
  end if
  cur_busy()
  ledclear()
  updateStage()
  cleanup()
  cleanUpArrs()
  cleanupsounds()
  set s to "Start"
  set AR_nnsc to 1
  set tmp1idx to 0
  set tmp2idx to 12
  clear_ARidx()
  cur_busy()
  repeat while 1
    set s to file(mReadLine)
    if s <> EMPTY then
      if s <> RETURN then
        set s to correct_s(s)
        set lncmd to chars(s, 1, 1)
        if lncmd = "-" then
          if (s & RETURN) = ver_cfile then
            set version_OK to 1
          end if
        else
          if version_OK then
            if (lncmd = "1") or (lncmd = "2") then
              set tmpsound to chars(s, 11, length(s))
              set newidx to find_slot()
              if tmpsound <> namepause_bs then
                if demo then
                  set tmp_size to readsound(the pathName & tmpsound, newidx, 1)
                else
                  set tmp_size to readsound(tmpsound, newidx, 1)
                end if
              else
                set tmp_size to 1
              end if
              if lncmd = "1" then
                set tmp1idx to tmp1idx + 1
                set tmpidx to tmp1idx
                set t1_segcnt to t1_segcnt + value(chars(s, 4, 5))
                set t1_idxcnt to t1_idxcnt + 1
              else
                set tmp2idx to tmp2idx + 1
                set tmpidx to tmp2idx
                set t2_segcnt to t2_segcnt + value(chars(s, 4, 5))
                set t2_idxcnt to t2_idxcnt + 1
              end if
              if tmp_size < 1 then
                append(l_notload, tmpidx)
              end if
              if demo then
                if tmpsound <> namepause_bs then
                  Ar1sound(mput, tmpidx, the pathName & tmpsound)
                else
                  Ar1sound(mput, tmpidx, tmpsound)
                end if
              else
                Ar1sound(mput, tmpidx, tmpsound)
              end if
              AR1idx(mput, tmpidx, tmpidx)
              ar1pos(mput, tmpidx, value(chars(s, 2, 3)))
              ar1seg(mput, tmpidx, value(chars(s, 4, 5)))
              Ar1Vol(mput, tmpidx, value(chars(s, 6, 7)))
              set TCol to value(chars(s, 8, 10))
              if TCol = 0 then
                set TCol to calccol(tmpsound)
              end if
              Ar1col(mput, tmpidx, TCol)
              Ar1play(mput, tmpidx, newidx)
              Ar1time(mput, tmpidx, tmp_size)
              set AR_nnsc to AR_nnsc + 1
            else
              if lncmd = "F" then
                if value(chars(s, 2, 3)) <> 13 then
                  set hl to "LD" & chars(s, 2, 3)
                  ledklick(hl)
                end if
              else
                if lncmd = "T" then
                  if value(chars(s, 2, 3)) <> 13 then
                    set hl to "LD" & chars(s, 2, 3)
                    ledklick(hl)
                  end if
                end if
              end if
            end if
          end if
        end if
      end if
      next repeat
    end if
    exit repeat
  end repeat
  file(mdispose)
  cur_on()
  if not version_OK then
    alertrd(" This file is not a CIRCLE elements datafile, or the file" & " was created by a previsious version of CIRCLE elements.", " Keine CIRCLE ELEMENTS Datei oder die Datei wurde von" & " einer aelteren CIRCLE ELEMENTS Version erzeugt.")
  end if
  circlemaster()
  if isdemosegs(t1_idxcnt + t2_idxcnt) then
    clear_circle()
    exit
  end if
  if count(l_notload) > 0 then
    set sel_name to EMPTY
    set scommand to "LOST"
    set fcommand to EMPTY
  else
    displaysegs()
  end if
end

on circlesave
  global fcommand, scommand, sel_name, fl_search, idsw, demo
  set sel_name to EMPTY
  set fcommand to EMPTY
  if demo then
    if not idsw then
      if isdemo() then
        exit
      end if
    end if
  end if
  set scommand to "CISa"
  if AR1idx(mget, 1) = 0 then
    alertrd("Nothing to save !", "Nichts zum Speichern !")
    set scommand to EMPTY
    exit
  end if
  set fl_search to "CIRCLE"
  selfname("CIRCLE")
end

on circlesaverun
  global file, fileName, fcommand, scommand, ver_cfile, tmp1idx, tmp2idx, selsegsize, selseglen, LED_1, LED_2, sel_name, up_csave, new_read, idsw
  set fcommand to EMPTY
  set scommand to EMPTY
  set s to "Start"
  if the machineType = 256 then
    if idsw then
      set file to FileIO(mnew, "write", sel_name)
    else
      set file to FileIO(mnew, "write", up_csave & sel_name)
    end if
  else
    if idsw then
      set file to FileIO(mnew, "write", sel_name)
    else
      set file to FileIO(mnew, "write", up_csave & sel_name)
    end if
  end if
  if not objectp(file) then
    alertrd("Error writing file !", "Fehler beim schreiben !")
    updateStage()
    exit
  end if
  cur_busy()
  updateStage()
  set s to ver_cfile
  if the machineType = 256 then
    set s to s & numToChar(10)
  end if
  file(mWriteString, s)
  set hl to lzero(LED_1)
  set s to "F" & hl & RETURN
  if the machineType = 256 then
    set s to s & numToChar(10)
  end if
  file(mWriteString, s)
  set hl to lzero(LED_2)
  set s to "T" & hl & RETURN
  if the machineType = 256 then
    set s to s & numToChar(10)
  end if
  file(mWriteString, s)
  set tmp1idx to 1
  set tmp2idx to 1
  repeat with i = 1 to 24
    if AR1idx(mget, i) <> 0 then
      set s to "1"
      if i > 12 then
        set s to "2"
      end if
      set s to s & lzero(ar1pos(mget, i)) & lzero(ar1seg(mget, i)) & lzero(Ar1Vol(mget, i)) & lzero2(Ar1col(mget, i)) & string(Ar1sound(mget, i)) & RETURN
      if the machineType = 256 then
        set s to s & numToChar(10)
      end if
      file(mWriteString, s)
    end if
  end repeat
  file(mWriteString, "--END" & RETURN & RETURN)
  file(mSetFinderInfo, "TEXT", "CIEL")
  file(mdispose)
  cur_on()
  set new_read to 1
  if not idsw then
    save_mix(1)
  end if
end

on copywindow
  global cp_idx
  put "COPY" into field "title"
  put Ar1sound(mget, cp_idx) & RETURN & RETURN & "LENGTH :   " & chars(calcsize(Ar1time(mget, cp_idx)), 2, 8) & RETURN & RETURN & "VOLUME :           " & lzero(Ar1Vol(mget, cp_idx)) & RETURN into field "sndwin"
end

on setwindow cname
  global maxsegs, minsegs, vTSprite, sel_track, sel_idx, sel_pos, sel_seg, sel_cast, mixedloop
  put "SOUND" into field "title"
  set t_idx to ar_get("CAST", cname)
  set mdebug to 0
  if mdebug = 0 then
    set s to Ar1sound(mget, t_idx) & RETURN & RETURN & "LENGTH :   " & chars(calcsize(Ar1time(mget, t_idx)), 2, 8) & RETURN & RETURN & "VOLUME :           " & lzero(Ar1Vol(mget, t_idx)) & RETURN
    put s into field "sndwin"
  end if
  if mdebug = 1 then
    set s to Ar1sound(mget, t_idx) & RETURN & "cst " & string(ar1cast(mget, t_idx)) & " idx " & string(t_idx) & RETURN & " p " & string(ar1pos(mget, t_idx)) & " s " & string(ar1seg(mget, t_idx)) & RETURN & string(Ar1time(mget, t_idx)) & RETURN & "TL: " & string(t_idx) & " l:>" & string(getAt(ltl_len, t_idx)) & "<>" & string(getAt(ltl_time, t_idx)) & RETURN & "<cast>" & string(getAt(ltl_scast, t_idx))
    put s into field "sndwin"
  end if
  if t_idx > 12 then
    set sel_track to 2
  end if
  if t_idx <= 12 then
    set sel_track to 1
  end if
  set sel_idx to t_idx
  set sel_pos to ar1pos(mget, t_idx)
  set sel_seg to ar1seg(mget, t_idx)
  set sel_cast to ar1cast(mget, t_idx)
  segszdisp("SG" & sel_seg)
  setslider(Ar1Vol(mget, t_idx))
  set mixedloop to 0
end

on setmastervol
  global backcast, fcommand, segsprite, segcol, sel_track, sel_idx, sel_pos, sel_seg, last_mute, up_mvol, freemaster
  set fcommand to EMPTY
  set sel_track to 0
  set backcast to 0
  put "MASTER" into field "title"
  put "VOLUME :           " & up_mvol & RETURN & RETURN & "MEMORY :      " & string(the freeBytes) & RETURN & RETURN & "MASTER :      " & string(freemaster) & RETURN & RETURN into field "sndwin"
  setslider(up_mvol)
  set the volume of sound 1 to 255 / 15 * up_mvol
  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
end

on save_mix yesno
  global nn_mixcast, nn_mixcastinit, fcommand, scommand, fl_search
  set mixsave to 0
  if yesno then
    set mixsave to selwin("Save the hole CIRCLE as one" & " ELEMENT ?", "Den gesamten CIRCLE in einem" & " ELEMENT speichern ?")
  end if
  waitforup()
  if mixsave then
    set scommand to "MXSa"
    set fl_search to "SOUND"
    selfname("SOUND")
  end if
end

on forceleading
  global fcommand, LED_1, LED_2, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt
  set fcommand to EMPTY
  if AR1idx(mget, 1) = 0 then
    return
  end if
  cur_busy()
  set p1idx to 1
  set p2idx to 13
  repeat with i = 1 to t1_idxcnt
    set t1s to value(ar1seg(mget, i))
    set t2ssum to 0
    set p2idxsave to p2idx
    set p3idxsave to p2idx
    repeat with j = 1 to t1s
      if p2idx <= (t2_idxcnt + 12) then
        set nex2seg to value(ar1seg(mget, p2idx))
        set t2ssum to t2ssum + value(ar1seg(mget, p2idx))
        set p2idx to p2idx + 1
        if t2ssum >= t1s then
          exit repeat
        end if
      end if
    end repeat
    if t2ssum > t1s then
      set deltat to t2ssum - t1s
      repeat while 1
        set ht2 to value(ar1seg(mget, p2idxsave))
        if ht2 > 1 then
          ar1seg(mput, p2idxsave, lzero(ht2 - 1))
          set deltat to deltat - 1
          set t2_segcnt to t2_segcnt - 1
          t2jerusalem(p2idxsave + 1, 1)
        else
          set p2idxsave to p2idxsave + 1
        end if
        if deltat < 1 then
          set p2idx to p2idxsave + 1
          exit repeat
        end if
      end repeat
    end if
  end repeat
  displaysegs()
  cur_on()
end

on t2jerusalem idx, sub
  global t2_idxcnt
  repeat with i = idx to t2_idxcnt + 12
    set vhelp to value(ar1pos(mget, i))
    set vhelp to vhelp - sub
    ar1pos(mput, i, lzero(vhelp))
  end repeat
end

on remix ask
  global t1_idxcnt, t2_segcnt, fcommand
  if t2_segcnt < 1 then
    set fcommand to EMPTY
    return
  end if
  if ask > 0 then
    set mixmix to selwin("Do you want to remix the hole" & " CIRCLE ?", "Den gesamten CIRCLE remixen ?")
    if mixmix = 0 then
      return
    end if
    ledclear()
    ledklick("LD01")
  end if
  forceleading()
  set mixmax to t1_idxcnt
  set mixstart to ar_pos2idx(0, getstartidx(0))
  repeat with i = mixstart to mixmax
    set mixstart to value(ar1pos(mget, i))
    set mixende to value(ar1seg(mget, i)) + mixstart
    if mixstart > t2_segcnt then
      exit repeat
    end if
    ledclear()
    set hl to "LD" & lzero(mixstart)
    ledklick(hl)
    set hl to "LD" & lzero(mixende)
    ledklick(hl)
    circlemix()
  end repeat
  ledclear()
  ledklick("LD01")
end

on setdisk_col
  global disk
  if disk = "PLANET" then
  end if
end