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

Text File | 1995-05-01 | 15.8 KB | 722 lines

on filenameMAC s
  global dir_sep
  set slen to length(string(s))
  repeat while slen >= 1
    if chars(s, slen, slen) = dir_sep then
      set szstr to chars(s, slen + 1, length(string(s)))
      exit repeat
    end if
    set slen to slen - 1
  end repeat
  return szstr
end

on frompath s, cnt
  global up_load, fl_search, up_cload, dir_sep
  set slen to length(string(s))
  set ac_cnt to 0
  set szstr to EMPTY
  repeat with i = 1 to slen
    if chars(s, i, i) = dir_sep then
      set ac_cnt to ac_cnt + 1
      if ac_cnt = cnt then
        set szstr to chars(s, 1, i)
        set v_frompath to chars(s, i + 1, length(s))
        exit repeat
      end if
    end if
  end repeat
  if fl_search = "CIRCLE" then
    set up_l to up_cload
  else
    set up_l to up_load
  end if
  if szstr = up_l then
    return EMPTY
  else
    return szstr
  end if
end

on calccolold calcsound
  global namepause
  set tmpstr to filenameMAC(calcsound)
  if tmpstr <> namepause then
    set cic to charToNum(chars(tmpstr, 1, 1))
    if cic >= 96 then
      set cic to cic - 32
    end if
    set TCol to 0
    if (cic >= 65) and (cic <= (65 + 2)) then
      set TCol to 138
    end if
    if (cic >= 68) and (cic <= (68 + 2)) then
      set TCol to 131
    end if
    if (cic >= 71) and (cic <= (71 + 2)) then
      set TCol to 32
    end if
    if (cic >= 74) and (cic <= (74 + 2)) then
      set TCol to 27
    end if
    if (cic >= 77) and (cic <= (77 + 2)) then
      set TCol to 124
    end if
    if (cic >= 80) and (cic <= (80 + 2)) then
      set TCol to 125
    end if
    if (cic >= 83) and (cic <= (83 + 2)) then
      set TCol to 217
    end if
    if (cic >= 85) and (cic <= (85 + 2)) then
      set TCol to 214
    end if
    if (cic >= 88) and (cic <= (88 + 2)) then
      set TCol to 234
    end if
    if (cic >= 91) and (cic <= (91 + 2)) then
      set TCol to 3
    end if
    if (cic >= 94) and (cic <= (94 + 2)) then
      set TCol to 65
    end if
  else
    set TCol to 255
  end if
  return TCol
end

on calccol calcsound
  global namepause
  set tmpstr to filenameMAC(calcsound)
  if tmpstr <> namepause then
    set found to 0
    repeat while 1
      set cic to random(24)
      if cic = 1 then
        set TCol to 27
      end if
      if cic = 2 then
        set TCol to 35
      end if
      if cic = 3 then
        set TCol to 48
      end if
      if cic = 4 then
        set TCol to 65
      end if
      if cic = 5 then
        set TCol to 94
      end if
      if cic = 6 then
        set TCol to 98
      end if
      if cic = 7 then
        set TCol to 123
      end if
      if cic = 8 then
        set TCol to 118
      end if
      if cic = 9 then
        set TCol to 128
      end if
      if cic = 10 then
        set TCol to 138
      end if
      if cic = 11 then
        set TCol to 149
      end if
      if cic = 12 then
        set TCol to 131
      end if
      if cic = 13 then
        set TCol to 155
      end if
      if cic = 14 then
        set TCol to 162
      end if
      if cic = 15 then
        set TCol to 167
      end if
      if cic = 16 then
        set TCol to 184
      end if
      if cic = 17 then
        set TCol to 205
      end if
      if cic = 18 then
        set TCol to 217
      end if
      if cic = 19 then
        set TCol to 239
      end if
      if cic = 20 then
        set TCol to 246
      end if
      if cic = 21 then
        set TCol to 251
      end if
      if cic = 22 then
        set TCol to 125
      end if
      if cic = 23 then
        set TCol to 18
      end if
      if cic = 24 then
        set TCol to 56
      end if
      repeat with i = 1 to 24
        set vcol to value(Ar1col(mget, i))
        if vcol = TCol then
          set found to 0
          exit repeat
        end if
        if i = 24 then
          set found to 1
        end if
      end repeat
      if found = 1 then
        exit repeat
      end if
    end repeat
  else
    set TCol to 255
  end if
  return TCol
end

on calcsize psize, tmp_qua
  global circle_qua
  if the paramCount < 2 then
    if circle_qua = "16" then
      set psize to psize
      set s_rat to 44100
    else
      set s_rat to 22050
    end if
  else
    if tmp_qua = "16" then
      set psize to psize
      set s_rat to 44100
    else
      set s_rat to 22050
    end if
  end if
  set tmpsize to psize
  set minsize to tmpsize / (s_rat * 60)
  set m to lzero(minsize)
  set deltasize to tmpsize mod (s_rat * 60)
  set secsize to deltasize / s_rat
  if the paramCount < 2 then
    set s to lzero(secsize)
  else
    set s to string(secsize)
  end if
  set deltasize to tmpsize mod s_rat
  set msecsize to deltasize / float(s_rat)
  set ms to string(msecsize)
  if chars(ms, 1, 2) = "0." then
    set ms to chars(ms, 3, 5)
  end if
  if length(ms) = 1 then
    set ms to ms & "0"
  end if
  if length(ms) = 2 then
    set ms to ms & "0"
  end if
  if the paramCount < 2 then
    return m & ":" & s & ":" & ms
  else
    return s & ":" & chars(ms, 1, 2)
  end if
end

on alertrd texte, textg, wait
  global fcommand, spritecount, up_lang
  sprite_save(47)
  sprite_save(48)
  set the castNum of sprite 47 to the number of cast "WINMSG"
  set the ink of sprite 47 to 0
  sprite_show(47, 235, 250)
  puppetTransition(9, 1, 5)
  if up_lang = 1 then
    put texte into field "MSGTXT"
  else
    put textg into field "MSGTXT"
  end if
  setfont("MSGTXT")
  set the castNum of sprite 48 to the number of cast "MSGTXT"
  set the ink of sprite 48 to 1
  set the editableText of sprite 48 to 0
  setfont("MSGTXT")
  sprite_show(48, 110, 220)
  updateStage()
  if wait <> 1 then
    repeat while the mouseDown
      nothing()
    end repeat
    repeat while 1
      if the mouseDown then
        exit repeat
      end if
    end repeat
    alertrdremove()
  end if
end

on alertrdremove
  global spritecount
  puppetTransition(10, 1, 5)
  sprite_blank(47)
  sprite_blank(48)
  updateStage()
  sprite_rest()
  sprite_rest()
end

on lzero val
  set ts to string(val)
  if length(ts) < 2 then
    set ts to "0" & ts
  end if
  return ts
end

on lzero2 val
  set ts to string(val)
  if length(ts) < 2 then
    set ts to "0" & ts
  end if
  if length(ts) < 3 then
    set ts to "0" & ts
  end if
  return ts
end

on isdemo
  global demo
  if demo then
    alertrd(" This demo version does not support this function.", " Diese Funktion ist in dieser Demoversion nicht implementiert.")
    return 1
  else
    return 0
  end if
end

on isdemosegs demoval
  global demo, demosegs
  if demoval <= demosegs then
    return 0
  else
    alertrd(" This Demoversion supports only 12 elements.", "Diese Demoversion verarbeitet nur 12 Elemente")
    return 1
  end if
end

on demobit
  global demo
  if not demo then
    return 0
  else
    cur_on()
    alertrd(" This Demoversion supports only 8 Bit Sounds.", "Diese Demoversion verarbeitet nur 8 Bit Sounds")
    return 1
  end if
end

on demowin qsw
  global fcommand, spritecount, up_lang, idsw
  sprite_save(47)
  sprite_save(48)
  cur_on()
  set text to "This is a DEMO version of Circle Elements."
  set the castNum of sprite 47 to the number of cast "DEMOWINR"
  set the ink of sprite 47 to 32
  sprite_show(47, 235, 243)
  if qsw <> 1 then
    if up_lang = 1 then
      set wincast to "DEMOE"
    else
      set wincast to "DEMOG"
      if idsw then
        set wincast to "DEMOID"
      end if
    end if
  else
    if up_lang = 1 then
      set wincast to "QUITTXE"
    else
      set wincast to "QUITTXG"
    end if
  end if
  puppetTransition(9, 1, 5)
  put text into field "MSGTXT"
  set the castNum of sprite 48 to the number of cast wincast
  set the ink of sprite 48 to 1
  setfont(wincast)
  set the editableText of sprite 48 to 0
  if qsw = 0 then
    if the machineType = 256 then
      set the textSize of field wincast to 12
      set the textHeight of field wincast to 14
    else
      set the textSize of field wincast to 12
      set the textHeight of field wincast to 14
    end if
  else
    if the machineType = 256 then
      set the textSize of field wincast to 12
      set the textHeight of field wincast to 14
    else
      set the textSize of field wincast to 12
      set the textHeight of field wincast to 14
    end if
  end if
  sprite_show(48, 30, 80)
  updateStage()
  if qsw = 1 then
    set showwalk to 1
    repeat while 1
      if the mouseDown then
        exit repeat
      end if
      WALK(mnew, showwalk)
      updateStage()
      set showwalk to showwalk + 1
      if showwalk = 13 then
        set showwalk to 1
      end if
    end repeat
    WALK(mrelease)
  end if
  repeat while the mouseDown
    nothing()
  end repeat
  if qsw = 0 then
    repeat while 1
      if the mouseDown then
        exit repeat
      end if
    end repeat
  end if
  alertrdremove()
end

on getmix_area dummy
  global getmix_inst, ltl_len, ltl_time, ltl_scast, ltl_mix
  set mixstart to 0
  set slash to 0
  repeat with i = getmix_inst to 12
    if slash > 0 then
      if getAt(ltl_mix, i) = "-" then
        set slash to slash + 1
      else
        set s to string(mixstart) & "-" & string(mixstart + (slash - 1))
        return s
      end if
    end if
    if getAt(ltl_mix, i) = "M" then
      set mixstart to i
      set slash to slash + 1
    end if
  end repeat
  return EMPTY
end

on getmix_idx ac_inst
  global getmix_inst, ltl_len, ltl_time, ltl_scast, ltl_mix
  repeat with i = ac_inst to 12
    if getAt(ltl_mix, i) = "M" then
      set getmix_inst to i + 1
      return i
    end if
  end repeat
  return 0
end

on chkmix_idx ac_inst
  global getmix_inst, ltl_len, ltl_time, ltl_scast, ltl_mix
  repeat with i = ac_inst to 12
    if getAt(ltl_mix, i) = "M" then
      return i
    end if
  end repeat
  return 0
end

on chkfn s
  set sz to trim(s)
  if the machineType = 256 then
    repeat with i = 1 to 10
      if i > 9 then
        return 0
      end if
      if not (chars(sz, i, i) = EMPTY) then
        set cn to charToNum(chars(sz, i, i))
        if cn < 48 then
          return 0
        end if
        if not (cn < 58) then
          if cn < 65 then
            return 0
          end if
          if not (cn < 91) then
            if cn < 95 then
              return 0
            end if
            if not (cn < 96) then
              if cn < 97 then
                return 0
              end if
              if not (cn < 123) then
                return 0
              end if
            end if
          end if
        end if
        next repeat
      end if
      if i = 1 then
        return 0
      end if
      return 1
    end repeat
  else
    repeat with i = 1 to 21
      if i > 20 then
        return 0
      end if
      if not (chars(sz, i, i) = EMPTY) then
        next repeat
      end if
      if i = 1 then
        return 0
      end if
      return 1
    end repeat
  end if
end

on chkfexist s
  global up_save, up_csave, fl_search
  if fl_search = "CIRCLE" then
    set up_s to up_csave
  else
    set up_s to up_save
  end if
  set fn to up_s & s
  set file to FileIO(mnew, "read", fn)
  if not objectp(file) then
    return 1
  else
    file(mdispose)
    return 0
  end if
end

on doesfexist s
  global FileIO
  set file to FileIO(mnew, "read", s)
  if not objectp(file) then
    return 0
  else
    file(mdispose)
    return 1
  end if
end

on chkfis s
  set file to FileIO(mnew, "read", s)
  if not objectp(file) then
    return 0
  else
    file(mdispose)
    return 1
  end if
end

on sprite_save no
  global nn_sprite, Sp_idx, Sp_cast, Sp_locH, Sp_locV, Sp_ink, Sp_visib, Sp_name, Sp_fore, Sp_back, Sp_stch, Sp_stcv
  set testcast to the castNum of sprite no
  if testcast > 0 then
    setAt(Sp_idx, nn_sprite, no)
    setAt(Sp_cast, nn_sprite, the castNum of sprite no)
    setAt(Sp_name, nn_sprite, the name of cast the castNum of sprite no)
    setAt(Sp_locH, nn_sprite, the locH of sprite no)
    setAt(Sp_locV, nn_sprite, the locV of sprite no)
    setAt(Sp_ink, nn_sprite, the ink of sprite no)
    setAt(Sp_visib, nn_sprite, the visible of sprite no)
    setAt(Sp_fore, nn_sprite, the foreColor of sprite no)
    setAt(Sp_back, nn_sprite, the backColor of sprite no)
    set nn_sprite to nn_sprite + 1
    sprite_blank(no)
  else
  end if
end

on sprite_rest
  global nn_sprite, Sp_idx, Sp_cast, Sp_locH, Sp_locV, Sp_ink, Sp_visib, Sp_name, Sp_fore, Sp_back, Sp_stch, Sp_stcv
  if (nn_sprite - 1) > 0 then
    set nn_sprite to nn_sprite - 1
    set nn to getAt(Sp_idx, nn_sprite)
    set the castNum of sprite nn to the number of cast getAt(Sp_name, nn_sprite)
    set the locH of sprite nn to getAt(Sp_locH, nn_sprite)
    set the locV of sprite nn to getAt(Sp_locV, nn_sprite)
    set the ink of sprite nn to getAt(Sp_ink, nn_sprite)
    set the visible of sprite nn to getAt(Sp_visib, nn_sprite)
    set the foreColor of sprite nn to getAt(Sp_fore, nn_sprite)
    set the backColor of sprite nn to getAt(Sp_back, nn_sprite)
    puppetSprite(nn, 1)
  end if
end

on sprite_allsave
  repeat with i = 1 to 48
    sprite_save(i)
  end repeat
end

on sprite_allrest
  repeat with i = 1 to 48
    sprite_rest()
  end repeat
end

on sprite_blank no
  set the locH of sprite no to 1500
  set the locV of sprite no to 1500
  set the visible of sprite no to 0
end

on sprite_show no, x, y
  set the locH of sprite no to x
  set the locV of sprite no to y
  set the visible of sprite no to 1
end

on macstripcrtlchars varpsound
  set psound to string(varpsound)
  set retstr to EMPTY
  set sndlen to length(psound)
  repeat with i = sndlen down to 1
    set cnum to charToNum(chars(psound, i, i))
    if cnum > 32 then
      if cnum < 200 then
        if cnum <> 58 then
          exit repeat
        end if
      end if
    end if
  end repeat
  repeat with j = 1 to sndlen
    set cnum to charToNum(chars(psound, j, j))
    if cnum > 32 then
      if cnum < 200 then
        exit repeat
      end if
    end if
  end repeat
  repeat with k = 1 to sndlen
    set cnum to charToNum(chars(psound, k, k))
    if cnum < 32 then
      exit repeat
      next repeat
    end if
    if cnum > 200 then
      exit repeat
    end if
  end repeat
  set retstr to chars(psound, j, k - 1)
  put "macstrip>" & string(length(retstr)) & "< >" & retstr & "<"
  return retstr
end

on stripcrtlchars psound
  set sndlen to length(psound)
  if chars(psound, sndlen, sndlen) < " " then
    set psound to chars(psound, 1, sndlen - 1)
  end if
  return psound
end

on cur_on
  global my_cursor, my_cursor_on, my_cursor_busy
  if not (my_cursor = my_cursor_on) then
    cursor(my_cursor_on)
    set my_cursor to my_cursor_on
  end if
end

on cur_busy
  global my_cursor, my_cursor_on, my_cursor_busy
  if not (my_cursor = my_cursor_busy) then
    cursor(my_cursor_busy)
    set my_cursor to my_cursor_busy
  end if
end

on calcticks time
  global circle_qua, ticks_ps
  set the floatPrecision to 16
  set ss to float(time)
  if circle_qua = "16" then
    set sample_rate to 44100
  else
    set sample_rate to 22050
  end if
  set waittime to float(ss / sample_rate * ticks_ps)
  return waittime
end

on get_randfnmx leadname
  global up_save, up_temp
  repeat while 1
    set fn to leadname & fncnt()
    if the machineType = 256 then
      set dest to up_temp & fn & ".WAV"
    else
      set dest to up_temp & fn & ".AIF"
    end if
    if chkfexist(dest) then
      exit repeat
    end if
  end repeat
  return dest
end

on fncnt
  global up_svcnt, up_rncnt
  set up_svcnt to up_svcnt + 1
  if up_svcnt > 999 then
    set up_svcnt to 0
  end if
  set name to lzero2(up_rncnt) & lzero2(up_svcnt)
  set up_svcnt to up_svcnt + 1
  if up_svcnt > 999 then
    set up_svcnt to 0
  end if
  return name
end

on backpath s
  global dir_sep
  set slen to length(string(s))
  set chkchar to dir_sep
  repeat with i = slen - 1 down to 1
    if chars(s, i, i) = chkchar then
      return chars(s, 1, i)
    end if
  end repeat
  return EMPTY
end

on setfont fnfield
  if the machineType = 256 then
    set the textFont of field fnfield to "ARIAL"
    set the textStyle of field fnfield to "bold"
  else
    set the textFont of field fnfield to "CHICAGO"
    set the textStyle of field fnfield to "plain"
  end if
end