BEEP IT

Algemene discussies en vragen omtrent Liberty BASIC programma's. Stuur zoveel mogelijk delen van listings (snippets) in als je hulp wilt.

Moderators: anthonio, Abcott

BEEP IT

Berichtdoor bluatigro » zo jan 31, 2016 4:27 pm

eerste poging tot muziek
Code: Selecteer alles

dim note( 80 )
for i = 0 to 80
  note( i ) = int( 55 * 2 ^ ( i / 16 ) )
next i
while n$ <> "end"
  read n$
  call tosound n$ , hz , ms
  call sound hz , ms
wend

data "e3 1/4","g3 1/4"
data "c3 1/4","e3 1/4"
data "e3 1/4","d3 1/4","f3 1/2"
data "f3 1"
data "d3 1/2","f3 1/4","f3 1/4"

data "b2 1/2","d3 1/2"
data "d3 1/4","c3 1/4","e3 1/2"
data "e3 1"
data "e3 1/4","e3 1/4","g3 1/4","g3 1/4"
data "c3 1/2","e3 1/4","e3 1/4"

data "e3 1/4","d3 1/4","f3 1/2"
data "f3 1"
data "d3 1/2","f3 1/4","f3 1/4"
data "b2 1/2","d3 1/2"
data "d3 1/4","c3 1/4","c3 1/4"
data "c3 1"
data "end"
end
sub tosound a$ , byref hz , byref ms
  note$ = "abcdefg"
  n$ = left$( a$ , 1 )
  welk = instr( note$ , n$  ) - 1
  if instr( a$ , "#" ) then
    octaaf = val( mid$( a$ , 3 , 1 ) )
    welk = welk + 0.5
  else
    octaaf = val( mid$( a$ , 2 , 1 ) )
  end if
  ms = int( val( word$( a$ , 2 ) ) * 512 )
  hz = note( welk * 2 + octaaf * 16 )
end sub
sub sound hz , ms
  calldll #kernel32 , "Beep" _
  , hz as long _
  , ms as long _
  , r as long
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: BEEP IT

Berichtdoor bluatigro » zo jan 31, 2016 4:29 pm

update :
- muziek edit programma
Code: Selecteer alles

dim note( 80 ), q$( 1000 )
for i = 0 to 80
  note( i ) = int( 55 * 2 ^ ( i / 16 ) )
next i
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global file$ , winx , winy , mode$ , speed , sharp$
winx = WindowWidth
winy = WindowHeight
speed = 1024
mode$ = "1/4"
sharp$ = ""
menu #m , "file" _
        , "new" , [new] _
        , "open" , [open] _
        , "save as" , [saveAs] _
        , "save" , [save] _
        , "play" , [play] _
        ,|, "exit" , [quit]
menu #m , "tools" _
        , "1" , [1] _
        , "1/2" , [2] _
        , "1/4" , [4] _
        , "#" , [sharp] _
        ,|,"speed" ,[speed] _
        ,|,"help" , [help]
nomainwin
open "BEEP IT 1.0" for graphics as #m
  #m "trapclose [quit]"
  #m "backcolor black"
  #m "when leftButtonDown [leftDown]"
  #m "when rightButtonDown [rightDown]"
wait
[1]
  mode$ = "1"
wait
[2]
  mode$ = "1/2"
wait
[4]
  mode$ = "1/4"
wait
[sharp]
  if sharp$ = "" then
    sharp$ = "#"
  else
    sharp$ = ""
  end if
wait
[help]
  notice "Help ." + chr$( 13 ) _
  + "Instructions :" + chr$( 13 ) _
  + "Use left mouse button to add notes ." + chr$( 13 ) _
  + "Use right mouse button to remove notes ."
wait
[speed]
  s$ = str$( speed )
  prompt "Speed = " ; s$
  speed = val( s$ )
wait
[leftDown]
  x = int( MouseX / 40 )
  y = int( ( 260 - MouseY ) / 20 )
  note$ = mid$( "abcdefg" , ( y mod 7 ) + 1 , 1 )
  octaaf = y / 8 + 3
  if y < 0 then note$ = "r"
  q$( x ) = note$ ; sharp$ ; octaaf ; " " ; mode$
  #m "goto ";x*40+20;" ";260-y*20
  #m "down"
  #m "size 3"
  select case mode$
      case "1"
        #m "ellipse 10 10"
      case "1/2"
        #m "ellipsefilled 10 10"
      case "1/4"
        #m "ellipsefilled 10 10"
        #m "line ";x*40+25;" ";260-20*y;" ";x*40+25;" ";200-20*y
      case else
  end select
  #m "up"
  if sharp$ = "#" then
    #m "goto ";x*40+30;" ";255-20*y
    #m "down"
    #m "box ";x*40+35;" ";265-20*y
    #m "up"
  end if
wait
[rightDown]
  x = int( MouseX / 40 )
  y = int( ( 260 - MouseY ) / 20 )
  #m "size 1"
  #m "goto ";x*40+2;" 40"
  #m "color white"
  #m "backcolor white"
  #m "down"
  #m "boxfilled ";x*40+39;" 265"
  #m "up"
  q$( x ) = "r ";mode$
  #m "color black"
  #m "backcolor black"
  for i = 0 to 4
    #m "down"
    #m "line ";x*40;" ";i*40+100;" ";x*40+40;" ";i*40+100
    #m "up"
  next i
wait
[quit]
  close #m
end
[play]
  i = 0
  while n$ <> "end"
    n$ = q$( i )
    call tosound n$ , hz , ms
    call sound hz , ms
    i = i + 1
  wend
wait
[new]
  for i = 0 to 1000
    q$( i ) ="end"
  next i
  file$ = DefaultDir$ + "noname.txt"
  #m "cls"
  for y = 0 to 4
    #m "down"
    #m "line 0 ";y*40+100;" ";winx;" ";y*40+100
    #m "up"
  next y
  for x = 0 to winx step 40
    #m "down"
    #m "line ";x;" 100 ";x;" 260"
    #m "up"
  next x
wait
[open]
  filedialog "load muzik" , "*.txt" , file$
  open file$ for input as #in
      txt$ = input$( #in , lof( #in ) )
  close #in
  i = 0
  while word$( txt$ , i ) <> ""
    q$( i ) = word$( txt$ , i , chr$( 13 ) )
    i = i + 1
  wend
  i = 0
  #m "size 1"
  for y = 0 to 4
    #m "line 0 ";y*40+100;" ";winx;" ";y*40+100
  next y
  for x = 0 to winx step 40
    #m "line ";x;" 100 ";x;" 260"
  next x
  note$ = "abcdefg"
  i = 0
  #m "size 3"
  while i < 1000 and q$( i ) = "end"
    n$ = left$( q$( i ) , 1 )
    if instr( q$( i ) , "#" ) then
      octaaf = val( mid$( q$( i ) , 3 , 1 ) )
    else
      octaaf = val( mid$( q$( i ) , 2 , 1 ) )
    end if
    x = 20 + i * 40
    y = instr( note$ , n$ ) - 1
    #m "goto ";x;" 260-";y*20
    #m "down"
    select case word$( q$( i ) , 2 )
      case "1"
        #m "ellipse 10 10"
      case "1/2"
        #m "ellipsefilled 10 10"
      case "1/4"
        #m "ellipsefilled 10 10"
        #m "line ";x+15;" ";260-20*y;" ";x+15;" ";200-20*y
      case else
    end select
    #m "up"
    if instr( q$( i ) , "#" ) then
      #m "goto ";x+30;" ";255-20*y
      #m "down"
      #m "box ";x+35;" ";265-20*y
      #m "up"
    end if
  wend
wait
[saveAs]
  filedialog "save muzik" , "*.txt" , file$
[save]
  open file$ for output as #o
    i = 0
    while q$( i ) <> "end"
      #o , q$( i )
      i = i + 1
    wend
  close #o
wait
sub tosound a$ , byref hz , byref ms
  note$ = "abcdefg"
  n$ = left$( a$ , 1 )
  welk = instr( note$ , n$  ) - 1
  if welk >= 0 then
    if instr( a$ , "#" ) then
      octaaf = val( mid$( a$ , 3 , 1 ) )
      welk = welk + 0.5
    else
      octaaf = val( mid$( a$ , 2 , 1 ) )
    end if
    hz = note( welk * 2 + octaaf * 16 )
  else
    hz = 0
  end if
  ms = int( val( word$( a$ , 2 ) ) * speed )
end sub
sub sound hz , ms
  calldll #kernel32 , "Beep" _
  , hz as long _
  , ms as long _
  , r as long
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm


Keer terug naar Liberty BASIC Code

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron