QB64 Phoenix Edition v3.8.0 Released!

Code: (Select All)
-- by mnrvovrfc, verified 17-Jun-2023



function table_create(atable)

  function local_table_copy(t)

    local tret



    function local_copy(t)

      local tret = { }

      for i = 1, #t do

        tret[i] = t[i]

      end

      for k, v in pairs(t) do

        if type(v) == "table" then

          tret[k] = local_copy(v)

        elseif type(k) ~= "number" then

          tret[k] = v

        end

      end

      return tret

    end



    tret = local_copy(t)

    return tret

  end



  local tret = {

    insert = function (s, ...)

               local rest = { ... }

               if rest == nil or #rest == 0 then return end

               local lrest = #rest

               for i = 1, lrest do

                 table.insert(s, rest[i])

               end

             end,

    first =  function (s, t)

               if t == nil then return end

               table.insert(s, 1, t)

             end,

    enter =  function (s, t)

               if type(t) ~= "table" or #t == 0 then return end

               local ts = local_table_copy(t)

               table.insert(s, ts)

             end,

    concat = function (s, delim, pfrom, pto)

               return table.concat(s, delim, pfrom, pto)

             end,

    copy =   function (s, ts, append)

               if type(ts) ~= "table" then return end

               if next(ts) == nil then return end

               if append == nil then s:delete() end

               local n = #ts

               for i = 1, n do

                 table.insert(s, ts[i])

               end

             end,

    remove = function (s, spos)

               table.remove(s, spos)

             end,

    delete = function (s)

               local n = #s

               while n > 0 do

                 table.remove(s)

                 n = n - 1

               end

             end,

    clear  = function (s)

               s:delete()

             end,

    is_empty = function (s)

                -- not a good way, but the alternative is to search all elements for one with numeric index

                -- the assumption is that if table_create() is used to create a table then

                --   "insert" method would be used to add elements, like an array in BASIC

                return (#s == 0)

             end,

    find =   function (s, aval)

               if aval == nil then return nil end

               if type(aval) ~= "number" and type(aval) ~= "string" then return nil end

               if type(aval) == "number" then aval = tostring(aval) end

               local laval = string.lower(aval)

               local akey, ve

               for kk, vv in pairs(s) do

                 if type(vv) == "number" then ve = tostring(vv) end

                 if type(vv) == "string" then ve = string.lower(vv) end

                 if ve == laval then

                   akey = kk

                   break

                 end

               end

               return akey

             end

  }

  if type(atable) == "table" and next(atable) ~= nil then

    local t = tret

    tret = local_table_copy(atable)

    if not tret.insert then

      tret.insert = t.insert

      tret.clear = t.clear

      tret.concat = t.concat

      tret.copy = t.copy

      tret.delete = t.delete

      tret.enter = t.enter

      tret.find = t.find

      tret.first = t.first

      tret.is_empty = t.is_empty

      tret.remove = t.remove

    end

  end

  return tret

end



function sformat(aformat, arg1, ...)

  if arg1 == nil then

    return aformat

  end

  return string.format(aformat, arg1, ...)

end



function ran(a, b)

  if type(a) ~= "number" then return nil end

  if math.floor(a) == math.floor(b) then return a end

  if a < 0 and b < 0 then

    a = a * -1

    b = b * -1

    if a > b then a, b = b, a end

    return math.random(a, b) * -1

  end

  if a > b then a, b = b, a end

  if a < 0 or b < 0 then

    local x = a * -1

    if b < 0 then x = b * -1 end

    return math.random(a + x, b + x) - x

  end

  return math.random(a, b)

end



function choicet(tbl)

  if type(tbl) ~= "table" then

    return ""

  end

  local x

  local numele = #tbl

  if numele == 0 then return "" end

  if numele == 1 then return tbl[1] end

  repeat

    x = math.random(1, numele)

  until x ~= choicetprev

  choicetprev = x

  return tbl[x]

end



function findstr(txt, lookfor)

  return string.find(txt, lookfor, 1, true)

end





-- main program



tn = table_create()

tc = { "C-", "C#", "D-", "D#", "E-", "F-", "F#", "G-", "G#", "A-", "A#", "B-" }



for j = 3, 7 do

    for i = 1, 12 do

        tn:insert(sformat("%s%d", tc[i], j))

    end

end

tc = nil



nprog = {

    { 3, 4, 3, 4 },

    { 3, 4, 3, 5 },

    { 3, 4, 5, 6 },

    { 3, 5, 5, 6 },

    { 5, 6, 5, 7 },

    { 5, 5, 5, 7 },

    { 4, 5, 5, 5 },

    { 4, 5, 5, 7 },

    { 4, 7, 5, 5 },

    { 4, 7, 5, 7 },

    { 3, 7, 5, 5 },

    { 3, 7, 5, 7 },

    { 3, 7, 7, 6 },

    { 3, 7, 7, 7 },

    { 4, 7, 7, 6 },

    { 4, 7, 5, 5 },

    { 4, 5, 7, 7 },

    { 5, 5, 7, 7 },

    { 6, 7, 7, 7 },

    { 6, 5, 5, 5 },

    { 6, 3, 7, 5 },

    { 4, 7, 3, 5 },

    { 3, 7, 4, 5 },

    { 7, 7, 7, 7 }

}

lnprog = #nprog



popsong = {

    { 4, 4, 2, 4, 4, 2, 2, 2, 4, 4, 2, 2, 2, 4, 4, 2, 4, 4, 2, 2, 2, 1 },

    { 4, 4, 2, 4, 4, 2, 2, 2, 8, 8, 4, 2, 2, 2, 4, 4, 2, 4, 8, 8, 2, 2, 2, 1 },

    { 4, 4, 8, 8, 8, 8, 4, 4, 2, 8, 8, 8, 8, 2, 8, 8, 4, 2, 8, 8, 8, 8, 2, 4, 4, 2, 8, 8, 4, 8, 8, 8, 8, 2, 2, 1 },

    { 2, 8, 8, 2, 4, 8, 8, 8, 8, 2, 4, 2, 4, 8, 8, 2, 8, 8, 8, 8, 2, 4, 4, 4, 8, 8, 8, 8, 4, 2, 4, 8, 8, 8, 8, 1 },

    { 4, 4, 2, 8, 8, 8, 8, 4, 2, 2, 8, 8, 8, 1 },

    { 4, 2, 4, 2, 2, 8, 8, 8, 8, 2, 2 },

    { 2, 8, 8, 2, 4, 2, 2, 2, 8, 8, 2, 4, 2, 4, 4 },

    { 4, 2, 4, 8, 8, 8, 8, 4, 2, 2, 2 },

    { 8, 8, 8, 8, 2, 8, 8, 8, 8, 4, 4, 4, 4, 4 },

    { 8, 8, 2, 8, 8, 8, 8, 2, 8, 8, 4, 4, 4, 4 },

    { 2, 8, 8, 2, 4, 2, 2, 2, 8, 8, 2, 4, 2, 8, 3 },

    { 8, 8, 2, 8, 8, 4, 2, 8, 8, 8, 8, 4, 8, 3 },

    { 0 }

}

lpopsong = #popsong



popline = { 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 6 }

raise = { -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2 }



for o = 10, 59 do

repeat

    goahead = true

    u = ran(64, 125) * 2

    t = table_create{ u }

    for i = 1, 3 do

        t:insert(t[i] / 2)

    end

    for i = 1, #t do

        sg = tostring(t[i])

        if findstr(sg, '.') then

            if not findstr(sg, ".0") then

                -- print("Warning: dividing the note length doesn't produce a whole value.")

                goahead = false

            end

        end

    end

until goahead



notelen = { t[1], t[2], 0, t[3], 0, 0, 0, t[4] }

t = nil

notelen[3] = notelen[4] + notelen[8]

-- notelen[6] = notelen[8] + math.floor(notelen[8] / 2)



noat, nute = table_create(), table_create()

u = ran(1, 18)

uu = u

m = ran(3, 7)

t = choicet(nprog)

for i = 1, #t do

    noat:insert(u)

    if i == m then noat:insert(0) end

    u = u + t[i]

end

noat:insert(u)

u = uu

m = ran(3, 7)

t = choicet(nprog)

for i = 1, #t do

    nute:insert(u)

    if i == m then nute:insert(0) end

    u = u + t[i]

end

nute:insert(u)



fo = io.open(sformat(os.getenv("HOME") .. "/Documents/z1bitr/musak%02d", o - 9), "w")

if fo then fo:write("; 0\n") end

song = choicet(popsong)

if song[1] == 0 then

    local t = { 4, 4, 8, 8, 2, 8, 8, 4, 4, 2, 8, 8, 8, 8, 2, 8, 8, 4, 2, 8, 8, 8, 8, 2, 4, 4, 2, 8, 8, 4, 8, 8, 8, 8, 2, 1 }

    local l = #t

    local w = ran(1, l)

    local x = w - 1

    local r = 0

    local g = ran(2, 4)

    local c = 1

    local d

    song = table_create()

    repeat

        if t[w] == 2 then

            r = r + 1

            if r == g then

                song:insert(3, 8)

            else

                song:insert(t[w])

            end

        else

            song:insert(t[w])

        end

        w = w + 1

        if w > l then break end

        c = c + 1

    until c > l

    if c <= l then

        if x == 0 then

            print("SOMETHING IS WRONG!")

            os.exit()

        end

        if ran(1, 2) == 1 then

            w = x

            d = -1

        else

            w = 1

            d = 1

        end

        repeat

            if t[w] == 2 then

                r = r + 1

                if r == g then

                    song:insert(3, 8)

                else

                    song:insert(t[w])

                end

            else

                song:insert(t[w])

            end

            w = w + d

            c = c + 1

        until c > l

    end

end

lsong = #song

pass =  math.ceil(math.sqrt(o))

y = ran(1, pass)

for j = 1, pass do

    kount = 1

    newpopline = table_create()

    for i = 1, lsong do

        newpopline:insert(choicet(popline))

    end

    repeat

        u = song[kount]

        -- restrict the pause to the two shortest note lengths

        trig = newpopline[kount]

        if j == y then

            if nute[trig] then

                if u < 4 and nute[trig] == 0 then

                    trig = 1

                end

            else

                trig = 1

            end

        else

            if noat[trig] then

                if u < 4 and noat[trig] == 0 then

                    trig = 1

                end

            else

                trig = 1

            end

        end

        -- the lowest two notes in the sequence never vary

        if (j == y and trig > 2) then

            w = choicet(raise)

            if w == -1 then w = 3 end

        elseif (trig > 3) or (trig == 3 and ran(1, 3) == 1) then

            w = choicet(raise)

        else

            w = 0

        end

        if j == y then

            if nute[trig] == 0 then

                -- out-of-range on purpose so it's later considered a pause

                v = 1e+6

            else

                v = nute[trig] + w

            end

        else

            if noat[trig] == 0 then

                v = 1e+6

            else

                v = noat[trig] + w

            end

        end

        if v > #tn then

            st = "---"

        else

            st = tn[v]

        end

        print(sformat("%s%c%02x", st, 32, notelen[u]))

        if fo then

            fo:write(sformat("%s%c%02x\n", st, 32, notelen[u]))

            fo:write(sformat("%s%c%02x\n", st, 32, notelen[u]))

        end

        kount = kount + 1

    until kount > lsong

end

if fo then fo:close() end

print("===")

end  -- for o