Ooops
October 29, 2020, 02:23:26 AM

Author Topic: [bb] music tracker by b32 [ 1+ years ago ]  (Read 1319 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] music tracker by b32 [ 1+ years ago ]
« on: June 29, 2017, 12:28:43 AM »
Title : music tracker
Author : b32
Posted : 1+ years ago

Description : Updated: once
This is a basic tracker program in Blitz (3D, but no 3d commands) It needs Ziltch's winmm.decls.
I've had two complaints that it gives no sound. So now I try autodetecting the device.
The midi exporting bug is gone now. I forgot to take in account the empty space before the first note of a track.


Code :
Code: BlitzBasic
  1. ; ID: 1865
  2. ; Author: b32
  3. ; Date: 2006-11-18 00:46:30
  4. ; Title: music tracker
  5. ; Description: tracker style music editor
  6.  
  7. ;-----------------------------------------------------------------------------------------------------
  8. ;                                                                  Userlib, extracted from winmm.decls by Ziltch
  9. ;-----------------------------------------------------------------------------------------------------
  10.  
  11. ;       .lib "winmm.dll"
  12. ;      
  13. ;       midiOutGetNumDevs%()
  14. ;       midiOutClose%(hMidiOut%)
  15. ;       midiOutOpen%(lphMidiOut*,uDeviceID%,dwCallback%,dwInstance%,dwFlags%); nul1*,nul2*,dwFlags%)
  16. ;       midiOutShortMsg%(hMidiOut%,dwMsg%)
  17. ;       midiOutGetDevCaps%( uDeviceID%, lpCaps*, uSize%):"midiOutGetDevCapsA"
  18. ;      
  19.  
  20. ;-----------------------------------------------------------------------------------------------------
  21. ;       usage: you need this in a .decls file in folder "c:program fileslitzuserlibs" to run
  22. ;-----------------------------------------------------------------------------------------------------
  23.  
  24.  
  25.         ;MIDI code by Ziltch
  26.         ;tracker/saving routine by bram32bit
  27.        
  28. ;-----------------------------------------------------------------------------------------------------
  29. ;                                                                                                       Globals
  30. ;-----------------------------------------------------------------------------------------------------
  31.  
  32.         Const   notes$ = "C-C#D-D#E-F-F#G-G#A-A#B-"
  33.         Const   keyb1$ = "ZSXDCVGBHNJM,L.;/'"
  34.         Const   keyb2$ = "ZSXDCVGBHNJMQ2W3ER5T6Y7UI9O0P[=]"
  35.         Const   dumpfile$ = "dump002.dat"
  36.        
  37.         Global  device
  38.         Global  setvolume = 127
  39.  
  40.         Global  maxnotes = 63
  41.         Global  maxchannels = 19
  42.  
  43.         ReadHeader(dumpfile$)
  44.        
  45.         Global  fmaxnotes = maxnotes
  46.         Global  fmaxchannels = maxchannels
  47.         Const   indexwidth = 35
  48.         Const   notewidth = 100
  49.         Const   noteheight = 15
  50.         Const   ofx = 180
  51.         Const   ofy = 50
  52.         Global  vis_maxnotes = 31
  53.         Global  vis_maxchannels = 3
  54.         Global  vis_ofx = 0
  55.         Global  vis_ofy = 0
  56.        
  57.         If vis_maxnotes > maxnotes Then vis_maxnotes = maxnotes
  58.         If vis_maxchannels > maxchannels Then vis_maxchannels = maxchannels
  59.  
  60.         Global  patternwidth = notewidth * 4 + indexwidth
  61.         Global  patternheight = (maxnotes + 1) * noteheight
  62.        
  63.         Global  octave = 3
  64.         Global  curX
  65.         Global  curY
  66.         Global  recmode = 1
  67.         Global  spd# = 125.0
  68.         Global  btel
  69.         Global  playing
  70.         Global  starttime
  71.         Global  nowtime
  72.         Global  oldtimenow
  73.  
  74.         Global MIDI_File
  75.         Dim     nxt(0)
  76.        
  77.         Dim             instrument(maxchannels)
  78.         Dim             lastnote(maxchannels)
  79.         Dim             instrumentname$(128)
  80.         Dim             mute(maxchannels)
  81.  
  82.         Dim     Pattern(maxchannels, maxnotes)
  83.         Dim     Vol(maxchannels, maxnotes)
  84.         Dim             Sel(maxchannels, maxnotes)
  85.  
  86.         Dim     BUF_Pattern(maxchannels, maxnotes)
  87.         Dim     BUF_Vol(maxchannels, maxnotes)
  88.         Dim     BUF_Sel(maxchannels, maxnotes)
  89.  
  90.         Dim             templen(maxnotes + 1)
  91.        
  92.         Dim             button$(10)
  93.                
  94.         ReadData()
  95.  
  96. ;-----------------------------------------------------------------------------------------------------
  97. ;                                                                                                       Initialize
  98. ;-----------------------------------------------------------------------------------------------------
  99.  
  100.         Graphics 800, 600, 0, 2
  101.         SetBuffer BackBuffer()
  102.                
  103.         font = LoadFont("FixedSys")
  104.         SetFont font
  105.         font2 = LoadFont("Arial", 12)
  106.        
  107.         ;if midi device gives trouble, try passing -1 as a parameter
  108.         numdevices = midiOutGetNumDevs()
  109.         Print numdevices
  110.        
  111.         For i = 0 To numdevices
  112.                 device = OpenMidiOut(i)
  113.                 If device <> 0 Then Print "Found device " + i + " .. ": tst = 1: Exit
  114.                 Print "Not found device " + i
  115.         Next
  116.         If tst <> 1 Then
  117.                 Print "Hmm .. no midi devices were found."
  118.                 Print "Please press any key to exit"
  119.                 WaitKey()
  120.                 End
  121.         End If
  122.        
  123.         Cls
  124.        
  125.         For i = 0 To maxchannels
  126.                 SelectInstrument(i, i * 2)
  127.         Next
  128.        
  129.         ReadPattern(dumpfile$)
  130.  
  131. ;-----------------------------------------------------------------------------------------------------
  132. ;                                                                                                       Main Loop
  133. ;-----------------------------------------------------------------------------------------------------
  134.        
  135.         Repeat
  136.        
  137.                 Cls
  138.  
  139.                 nowtime = MilliSecs()
  140.  
  141.                 ;enter=play
  142.                 If KeyHit(28) Then StartPlay()
  143.        
  144.                 ;handle playmode
  145.                 timenow = (Floor((nowtime - starttime) / spd)) Mod (maxnotes + 1)
  146.                 If playing Then
  147.                         ;check if a new line is played
  148.                         If timenow <> oldtimenow Then
  149.                                 ;play all notes
  150.                                 For chi = 0 To maxchannels
  151.                                         If pattern(chi, timenow) <> 0 Then PlayNote(chi, pattern(chi, timenow) - 1, vol(chi, timenow))
  152.                                 Next
  153.                         ;store played line
  154.                         oldtimenow = timenow
  155.                         End If
  156.                         ;draw red play cursor dot
  157.                         gnow = timenow - vis_ofy
  158.                         If gnow >= 0 Then If gnow <= vis_maxnotes Then
  159.                                 Color 255, 0, 0
  160.                                 Oval ofx - noteheight, ofy + noteheight * gnow + noteheight/2, noteheight/2, noteheight/2
  161.                         End If
  162.                 End If
  163.                        
  164.                 ;read key from pc keyboard             
  165.                 keynote = ReadNoteFromKeyboard()
  166.                 ;if a key is pressed
  167.                 If keynote > 0 Then
  168.                         keynote = keynote + octave * 12
  169.                         ;preview note
  170.                         playnote( curX, keynote - 1, setvolume )
  171.                         ;store note info
  172.                         If recmode Then
  173.                                 If curX >= 0 Then If curX <= maxchannels
  174.                                 If curY >= 0 Then If curY <= maxnotes
  175.                                         pattern(curX, curY) = keynote
  176.                                         vol(curX, curY) = setvolume
  177.                                         CurY = CurY + 1
  178.                                 End If
  179.                                 End If
  180.                         End If
  181.                 End If
  182.                
  183.                 ;F3=cut
  184.                 If KeyHit(61) Then CutFrame()
  185.                
  186.                 ;F4=copy
  187.                 If KeyHit(62) Then CopyFrame2()
  188.                
  189.                 ;F5=paste
  190.                 If KeyHit(63) Then PasteFrame(curX, curY)
  191.                
  192.                 ;TAB           
  193.                 If KeyHit(15) Then
  194.                         If recmode Then
  195.                                 If curX >= 0 Then If curX <= maxchannels
  196.                                 If curY >= 0 Then If curY <= maxnotes
  197.                                         pattern(curX, curY) = -1
  198.                                         vol(curX, curY) = 0
  199.                                         PlayNote(curX, -1, 0)
  200.                                         CurY = CurY + 1
  201.                                 End If
  202.                                 End If
  203.                         End If
  204.                 End If
  205.                
  206.                 ;DEL
  207.                 tst = False
  208.                 If KeyDown(211) Then
  209.                         tst = (nowtime - tms > 350)
  210.                 Else
  211.                         tms = nowtime
  212.                 End If                         
  213.                 If KeyHit(211) Or tst Then
  214.                         If recmode Then
  215.                                 If curX >= 0 Then If curX <= maxchannels
  216.                                 If curY >= 0 Then If curY <= maxnotes
  217.                                         pattern(curX, curY) = 0
  218.                                         vol(curX, curY) = 0
  219.                                         PlayNote(curX, -1, 0)
  220.                                         CurY = CurY + 1
  221.                                 End If
  222.                                 End If
  223.                         End If
  224.                 End If
  225.  
  226.                 ;cursor keys for moving cursor
  227.                 p = 0
  228.                 If KeyHit(200) Then TestSel: curY = curY - 1
  229.                 If KeyHit(208) Then TestSel: curY = curY + 1
  230.                 If KeyHit(203) Then TestSel: curX = curX - 1
  231.                 If KeyHit(205) Then TestSel: curX = curX + 1
  232.                
  233.                 ;pgup/pgdn
  234.                 If KeyHit(201) Then curY = curY - 16: TestSel(+16)
  235.                 If KeyHit(209) Then curY = curY + 16: TestSel(-16)
  236.                 If KeyHit(199) Then curY = 0
  237.                 If KeyHit(207) Then curY = maxnotes
  238.                
  239.                 ;limit cursor movement
  240.                 If curX < 0 Then curX = 0
  241.                 If curY < 0 Then curY = 0
  242.                 If curX > maxchannels Then curX = maxchannels
  243.                 If curY > maxnotes Then curY = maxnotes
  244.        
  245.                 ;scroll interface              
  246.                 If curX > vis_maxchannels + vis_ofx Then vis_ofx = curX - vis_maxchannels
  247.                 If curX < vis_ofx Then vis_ofx = curX
  248.                 If curY < vis_ofy Then vis_ofy = curY
  249.                 If curY > vis_maxnotes + vis_ofy Then vis_ofy = curY - vis_maxnotes
  250.                                
  251.                 ;draw instrument names
  252.                 Color 100, 100, 0
  253.                 SetFont font2
  254.                 For chi = 0 To vis_maxchannels
  255.                         If chi + vis_ofx > 4 Then
  256.                                 Text ofx + chi * notewidth + indexwidth, ofy - 15, InstrumentName$(instrument(chi + vis_ofx))
  257.                         Else
  258.                                 Text ofx + chi * notewidth + indexwidth, ofy - 15, "Drum" + (chi + vis_ofx)
  259.                         End If
  260.                         Text ofx + chi * notewidth + indexwidth, ofy + noteheight * (vis_maxnotes + 1), chi + vis_ofx
  261.                        
  262.                 Next
  263.                
  264.                 mx = MouseX()
  265.                 my = MouseY()
  266.                 mh = MouseHit(1)
  267.                                
  268.                 ;volumebar
  269.                 volx = 620
  270.                 voly = ofy
  271.                 Color 100, 100, 0
  272.                 Text volx, voly - 15, "volume"
  273.                 Rect volx, voly, 50, 100, 0
  274.                 Color 100, 100, 0
  275.                 Rect volx, voly + 90 - setvolume * 90 / 127, 50, 10
  276.                 If MouseDown(1) Then
  277.                         If RectsOverlap(mx, my, 1, 1, volx, voly - 10, 50, 120) Then
  278.                                 setvolume = ((voly + 90 - MouseY()) * 127 / 90)
  279.                                 If setvolume < 0 Then setvolume = 0
  280.                                 If setvolume > 127 Then setvolume = 127
  281.                                 For i = 0 To maxchannels
  282.                                 For j = 0 To maxnotes
  283.                                         If sel(i, j) Then vol(i, j) = setvolume
  284.                                 Next
  285.                                 Next                           
  286.                         End If
  287.                 End If
  288.                 SetFont font
  289.                
  290.                 ;buttons
  291.                 gui$ = ""
  292.                 For y = 0 To btel - 1
  293.                         overlap = RectsOverlap(mx, my, 1, 1, ofx - 80, ofy + y * noteheight * 10 / 4, 60, noteheight * 2)
  294.                         If mh Then
  295.                                 If overlap Then
  296.                                         gui$ = button$(y)
  297.                                 End If
  298.                         End If
  299.                         Color 100, 100, 0
  300.                         Rect ofx - 80, ofy + y * noteheight * 10 / 4, 60, noteheight * 2, 0
  301.                         If overlap Then Color 255, 255, 0 Else Color 100, 100, 0
  302.                         Text ofx - 50, ofy + y * noteheight * 10 / 4 + noteheight, button$(y), True, True
  303.                 Next   
  304.                                
  305.                 Select gui$
  306.                        
  307.                         Case "New"
  308.                                
  309.                                 For i = 0 To maxchannels
  310.                                 For j = 0 To maxnotes
  311.                                 pattern(i, j) = 0
  312.                                 vol(i, j) = 0
  313.                                 Next
  314.                                 Next
  315.                                 setvolume = 127
  316.                                
  317.                         Case "Load"
  318.                        
  319.                                 SetBuffer FrontBuffer()
  320.                                 Cls
  321.                                 Color 255, 255, 255
  322.                                 Locate 0, 0
  323.                                 dir = ReadDir(CurrentDir$())
  324.                                 Repeat
  325.                                         f$ = Lower$(NextFile$(dir))
  326.                                         If Right$(f$, 4) = ".pia" Then Print f$
  327.                                         If f$ = "" Then Exit
  328.                                 Forever
  329.                                 f$ = Lower$(iInput$("please enter filename>"))
  330.                                 If Right$(f$, 4) <> ".pia" Then f$ = f$ + ".pia"
  331.                                 ReadPattern(CurrentDir$() + f$)
  332.                                 SetBuffer BackBuffer()
  333.                                 Cls
  334.                                
  335.                         Case "Save"
  336.                        
  337.                                 SetBuffer FrontBuffer()
  338.                                 Cls
  339.                                 Color 255, 255, 255
  340.                                 Locate 0, 0
  341.                                 f$ = Lower$(iInput$("please enter filename>"))
  342.                                 If Right$(f$, 4) <> ".pia" Then f$ = f$ + ".pia"
  343.                                 ok = True
  344.                                 If FileType(f$) = 1 Then
  345.                                         Print "file exists!"
  346.                                         ok = Lower$(iInput$("overwrite? (y/n)")) = "y"
  347.                                         If ok Then DeleteFile f$
  348.                                 End If
  349.                                 If ok Then
  350.                                         WritePattern(f$)
  351.                                         Print "file saved!"
  352.                                         Print "press any key"
  353.                                         WaitKey()
  354.                                 End If
  355.                                 SetBuffer BackBuffer()
  356.                                 Cls
  357.                                
  358.                         Case "Export"
  359.                        
  360.                                 SetBuffer FrontBuffer()
  361.                                 Cls
  362.                                 Color 255, 255, 255
  363.                                 Locate 0, 0
  364.                                 f$ = Lower$(iInput$("please enter filename>"))
  365.                                 If Right$(f$, 4) <> ".mid" Then f$ = f$ + ".mid"
  366.                                 ok = True
  367.                                 If FileType(f$) = 1 Then
  368.                                         Print "file exists!"
  369.                                         ok = Lower$(iInput$("overwrite? (y/n)")) = "y"
  370.                                         If ok Then DeleteFile f$
  371.                                 End If
  372.                                 If ok Then SaveMidi(f$)
  373.                                 SetBuffer BackBuffer()
  374.                                 Cls
  375.                                
  376.                         Case "Play"
  377.                                
  378.                                 StartPlay()
  379.                                
  380.                         Case "Stop"
  381.                                
  382.                                 playing = False
  383.                                 button$(4) = "Play"
  384.                                
  385.                         Case "Speed"
  386.                                
  387.                                 SetSpeed()
  388.                                
  389.                         Case "All"                     
  390.  
  391.                                 For i = 0 To maxchannels
  392.                                 For j = 0 To maxnotes
  393.                                         sel(i, j) = 1
  394.                                 Next
  395.                                 Next
  396.                                
  397.                         Case "Track"
  398.  
  399.                                 For i = 0 To maxchannels
  400.                                 For j = 0 To maxnotes
  401.                                         sel(i, j) = (i = curX)
  402.                                 Next
  403.                                 Next
  404.                                
  405.                         Case "Length"
  406.                        
  407.                                 ChangeLength()
  408.                                
  409.                         Case "Deselect"
  410.                                
  411.                                 For i = 0 To maxchannels
  412.                                 For j = 0 To maxnotes
  413.                                         sel(i, j) = 0
  414.                                 Next
  415.                                 Next
  416.                                
  417.                         Case "Help"
  418.                        
  419.                                 Help()
  420.                                
  421.                 End Select     
  422.                
  423.                 ;loop through visible lines                    
  424.                 For lni = 0 To vis_maxnotes
  425.                         ;draw index rectangle
  426.                         Color 64, 64, 0
  427.                         Rect ofx, ofy + lni * noteheight, indexwidth + 1, noteheight + 1, 0
  428.                         ;draw line index
  429.                         col = 90 + ((lni + vis_ofy) Mod 4 = 0) * 45
  430.                         Color col, col, 0
  431.                         Text ofx + (indexwidth / 2), ofy + lni * noteheight, lni + vis_ofy, True
  432.                         ;loop through visible channels
  433.                         For chi = 0 To vis_maxchannels
  434.                                
  435.                                 ;get note data                 
  436.                                 note$ = ConvertNote$(pattern(vis_ofx + chi, vis_ofy + lni) - 1, vol(vis_ofx + chi, vis_ofy + lni))
  437.                                 ;check if this is the selected note
  438.                                 selected = ((lni + vis_ofy) = curY) And ((chi + vis_ofx) = curX)
  439.                                
  440.                                 If selected Then
  441.                                         col = 255
  442.                                         If note$ = "" Then note$ = "<-->"
  443.                                 Else
  444.                                         col = 90 + ((lni + vis_ofy) Mod 4 = 0) * 45
  445.                                 End If
  446.                                 ;draw pattern grid
  447.                                 If sel(vis_ofx + chi, vis_ofy + lni) Then
  448.                                         Color 45, 45, 0
  449.                                         Rect ofx + indexwidth + (chi * notewidth), ofy + (lni * noteheight), notewidth + 1, noteheight + 1, 1
  450.                                 Else
  451.                                         Color 64, 64, 0
  452.                                         Rect ofx + indexwidth + (chi * notewidth), ofy + (lni * noteheight), notewidth + 1, noteheight + 1, 0
  453.                                 End If
  454.                                 Color col, col, 0
  455.                                 Text ofx + chi * notewidth + indexwidth + (notewidth / 2), ofy + (lni * noteheight), note$, True
  456.                         Next
  457.                 Next
  458.                
  459.                 ;SPACE=change recmode
  460.                 If KeyHit(57) Then
  461.                         For i = 0 To maxchannels
  462.                                 PlayNote(i, -1, 0)
  463.                         Next
  464.                         recmode = Not(recmode)
  465.                 End If
  466.                                
  467.                 If KeyHit(59) Then Help()
  468.                
  469.                 ;F7/F8
  470.                 If KeyHit(65) Then If octave > 0 Then octave = octave - 1
  471.                 If KeyHit(66) Then If octave < 12 Then octave = octave + 1
  472.                 ;F9/F10
  473.                 If KeyHit(67) Then SelectInstrument(curX, instrument(curX) - 1)
  474.                 If KeyHit(68) Then SelectInstrument(curX, instrument(curX) + 1)                                
  475.                
  476.                 If MouseDown(1) Or MouseDown(2) Then
  477.                         If RectsOverlap(mx, my, 1, 1, ofx + indexwidth, ofy, patternwidth, patternheight) Then
  478.                                 xx = (mx - ofx - indexwidth) / notewidth + vis_ofx
  479.                                 yy = (my - ofy) / noteheight + vis_ofy
  480.                                 sel(xx, yy) = MouseDown(1)
  481.                         End If
  482.                 End If
  483.                
  484.                 ;show recmode flag             
  485.                 If recmode Then
  486.                         Color 255, 0, 0
  487.                         Text GraphicsWidth() / 2, 10, "RECORD", True
  488.                 End If
  489.                
  490.                 Color 64, 64, 64
  491.                 Text 0, 0, "Press F1 for help"
  492.                                
  493.                 Flip
  494.                 Delay 10
  495.                                        
  496.         Until KeyHit(1)
  497.  
  498.         WritePattern(dumpfile$)
  499.  
  500. ;-----------------------------------------------------------------------------------------------------
  501. ;                                                                                                   Finalize
  502. ;-----------------------------------------------------------------------------------------------------
  503.  
  504.         CloseMidiOut device
  505.        
  506.         End
  507.  
  508. ;-----------------------------------------------------------------------------------------------------
  509. ;                                                                                                       CloseMidiOut()
  510. ;-----------------------------------------------------------------------------------------------------
  511. ;close MIDI device
  512. Function CloseMidiOut(MidiOutHandle)
  513.  
  514.   midiOutClose(MidiOutHandle)
  515.  
  516. End Function
  517.  
  518. ;-----------------------------------------------------------------------------------------------------
  519. ;                                                                                                       OpenMidiOut()
  520. ;-----------------------------------------------------------------------------------------------------
  521. ;open MIDI device
  522. Function OpenMidiOut(OutDevID=0)
  523.  
  524.   OutHandleBank         = CreateBank(4)
  525.   ok                            = midiOutOpen(OutHandleBank,OutDevID,0,0, 0)
  526.   MidiOutHandle         = PeekInt(OutHandleBank,0)
  527.   FreeBank                      OutBankHandle
  528.   Return                        MidiOutHandle
  529.  
  530. End Function
  531.  
  532. ;-----------------------------------------------------------------------------------------------------
  533. ;                                                                                                       SendMidiOut()
  534. ;-----------------------------------------------------------------------------------------------------
  535. ;send MIDI message
  536. Function SendMidiOut(MidiOutHandle, MidiOutChannel, MidiOutStatus, MidiOutdata1 = 0, MidiOutData2 = 0)
  537.  
  538.    Return midiOutShortMsg(MidiOutHandle,( (MidiOutdata2 Shl 16) Or (MidiOutdata1 Shl 8 ) Or (MidiOutStatus Shl 4) Or MidiOutChannel))
  539.  
  540. End Function
  541.  
  542. ;-----------------------------------------------------------------------------------------------------
  543. ;                                                                                                       SelectInstrument()
  544. ;-----------------------------------------------------------------------------------------------------
  545. ;select MIDI instrument
  546. Function SelectInstrument( channel, program )
  547.  
  548.         If program < 0 Then Return
  549.         If program > 127 Then Return
  550.  
  551.         SendMidiOut(device, ConvertChannel(channel), $C, program, 4)
  552.         instrument(channel) = program
  553.        
  554. End Function
  555.  
  556. ;-----------------------------------------------------------------------------------------------------
  557. ;                                                                                                       ReadNoteFromKeyboard()
  558. ;-----------------------------------------------------------------------------------------------------
  559. ;convert pc keyboard keypress to MIDI note
  560. Function ReadNoteFromKeyboard()
  561.  
  562.                 w = GetKey()
  563.                 note = Instr(keyb1$, Upper$(Chr$(w)))
  564.                 If note = 0 Then note = Instr(keyb2$, Upper$(Chr$(w)))
  565.  
  566.                 Return note
  567.                
  568. End Function
  569.  
  570. Function Two$( num )
  571.  
  572.         r$ = Hex$(num)
  573.         Return Right$(r$, 2)
  574.        
  575. End Function
  576.        
  577.  
  578. Function ConvertNote$(index, vol)
  579.  
  580.         If index = -2 Then Return "====="
  581.         If index = -1 Then Return ""
  582.        
  583.         nti = index Mod 12     
  584.         note$ = Mid$(notes$, nti * 2 + 1, 2) + (index / 12) + " " + Two$(vol)
  585.        
  586.         Return note$
  587.        
  588. End Function
  589. ;"C#6 127"
  590.  
  591. Function PlayNote( channel, playnote, vol )
  592.         If channel < 0 Then Return
  593.         If channel > maxchannels Then Return
  594.         ;stop previous note
  595.         If lastnote(channel) > -1 Then SendMidiOut(device, ConvertChannel(channel), $8, lastnote(channel), 0)
  596.         ;play new note
  597.         If playnote > -1 Then SendMidiOut(device, ConvertChannel(channel), $9, playnote, vol)
  598.         ;store this note
  599.         lastnote(channel) = playnote
  600. End Function
  601.  
  602.  
  603. ;-------------------------------------------------------------------------------------------------
  604. ;                                                                               instrument data
  605. ;-------------------------------------------------------------------------------------------------
  606.  
  607. Data "Acoustic Grand Piano"
  608. Data "Bright Acoustic Piano"
  609. Data "Electric Grand Piano"
  610. Data "Honky-tonk Piano"
  611. Data "Rhodes Piano"
  612. Data "Chorused Piano"
  613. Data "Harpsichord"
  614. Data "Clavinet"
  615. Data "Celesta"
  616. Data "Glockenspiel"
  617. Data "Music box"
  618. Data "Vibraphone"
  619. Data "Marimba"
  620. Data "Xylophone"
  621. Data "Tubular Bells"
  622. Data "Dulcimer"
  623. Data "Hammond Organ"
  624. Data "Percussive Organ"
  625. Data "Rock Organ"
  626. Data "Church Organ"
  627. Data "Reed Organ"
  628. Data "Accordian"
  629. Data "Harmonica"
  630. Data "Tango Accordian"
  631. Data "Acoustic Guitar (nylon)"
  632. Data "Acoustic Guitar (steel)"
  633. Data "Electric Guitar (jazz)"
  634. Data "Electric Guitar (clean)"
  635. Data "Electric Guitar (muted)"
  636. Data "Overdriven Guitar"
  637. Data "Distortion Guitar"
  638. Data "Guitar Harmonics"
  639. Data "Acoustic Bass"
  640. Data "Electric Bass (finger)"
  641. Data "Electric Bass (pick)"
  642. Data "Fretless Bass"
  643. Data "Slap Bass 1"
  644. Data "Slap Bass 2"
  645. Data "Synth Bass 1"
  646. Data "Synth Bass 2"
  647. Data "Violin"
  648. Data "Viola"
  649. Data "Cello"
  650. Data "Contrabass"
  651. Data "Tremolo Strings"
  652. Data "Pizzicato Strings"
  653. Data "Orchestral Harp"
  654. Data "Timpani"
  655. Data "String Ensemble 1"
  656. Data "String Ensemble 2"
  657. Data "Synth Strings 1"
  658. Data "Synth Strings 2"
  659. Data "Choir Aahs"
  660. Data "Voice Oohs"
  661. Data "Synth Voice"
  662. Data "Orchestra Hit"
  663. Data "Trumpet"
  664. Data "Trombone"
  665. Data "Tuba"
  666. Data "Muted Trumpet"
  667. Data "French Horn"
  668. Data "Brass Section"
  669. Data "Synth Brass 1"
  670. Data "Synth Brass 2"
  671. Data "Soprano Sax"
  672. Data "Alto Sax"
  673. Data "Tenor Sax"
  674. Data "Baritone Sax"
  675. Data "Oboe"
  676. Data "English Horn"
  677. Data "Bassoon"
  678. Data "Clarinet"
  679. Data "Piccolo"
  680. Data "Flute"
  681. Data "Recorder"
  682. Data "Pan Flute"
  683. Data "Bottle Blow"
  684. Data "Shakuhachi"
  685. Data "Whistle"
  686. Data "Ocarina"
  687. Data "Lead 1 (square)"
  688. Data "Lead 2 (sawtooth)"
  689. Data "Lead 3 (caliope lead)"
  690. Data "Lead 4 (chiff lead)"
  691. Data "Lead 5 (charang)"
  692. Data "Lead 6 (voice)"
  693. Data "Lead 7 (fifths)"
  694. Data "Lead 8 (brass + lead)"
  695. Data "Pad 1 (new age)"
  696. Data "Pad 2 (warm)"
  697. Data "Pad 3 (polysynth)"
  698. Data "Pad 4 (choir)"
  699. Data "Pad 5 (bowed)"
  700. Data "Pad 6 (metallic)"
  701. Data "Pad 7 (halo)"
  702. Data "Pad 8 (sweep)"
  703. Data "FX 1 (rain)"
  704. Data "FX 2 (soundtrack)"
  705. Data "FX 3 (crystal)"
  706. Data "FX 4 (atmosphere)"
  707. Data "FX 5 (brightness)"
  708. Data "FX 6 (goblins)"
  709. Data "FX 7 (echoes)"
  710. Data "FX 8 (sci-fi)"
  711. Data "Sitar"
  712. Data "Banjo"
  713. Data "Shamisen"
  714. Data "Koto"
  715. Data "Kalimba"
  716. Data "Bagpipe"
  717. Data "Fiddle"
  718. Data "Shanai"
  719. Data "Tinkle Bell"
  720. Data "Agogo"
  721. Data "Steel Drums"
  722. Data "Woodblock"
  723. Data "Taiko Drum"
  724. Data "Melodic Tom"
  725. Data "Synth Drum"
  726. Data "Reverse Cymbal"
  727. Data "Guitar Fret Noise"
  728. Data "Breath Noise"
  729. Data "Seashore"
  730. Data "Bird Tweet"
  731. Data "Telephone Ring"
  732. Data "Helicopter"
  733. Data "Applause"
  734. Data "Gunshot"
  735.  
  736. Data "New"
  737. Data "Load"
  738. Data "Save"
  739. Data "Export"
  740. Data "Play"
  741. Data "Speed"
  742. ;Data "Copy"
  743. ;Data "Paste"
  744. ;Data "Exit"
  745. Data "All"
  746. Data "Deselect"
  747. Data "Track"
  748. Data "Length"
  749. Data "Help"
  750. Data "STOP"
  751. ;-----------------------------------------------------------------------------------------------------
  752. ;                                                                                                       ReadData()
  753. ;-----------------------------------------------------------------------------------------------------
  754. ;read instrument names
  755. Function ReadData()
  756.         Restore
  757.         For i = 0 To 127
  758.                 Read instrumentname$(i)
  759.         Next
  760.         btel = 0
  761.         Repeat
  762.                 Read b$
  763.                 If b$ = "STOP" Then Exit
  764.                 button$(btel) = b$
  765.                 btel = btel + 1
  766.         Forever
  767. End Function
  768.  
  769. ;-----------------------------------------------------------------------------------------------------
  770. ;                                                                                                ConvertChannel()
  771. ;-----------------------------------------------------------------------------------------------------
  772. ;this makes track 0-4 drumtracks, and shifts the rest
  773. Function ConvertChannel(chn)
  774.        
  775.         If chn > 4 Then
  776.                 chn = chn - 4
  777. ;               If chn > 8 Then chn = chn + 1
  778.         Else
  779.                 chn = 9
  780.         End If
  781.        
  782.         Return chn
  783.        
  784. End Function
  785.  
  786. ;-----------------------------------------------------------------------------------------------------
  787. ;                                                                                                       WritePattern()
  788. ;-----------------------------------------------------------------------------------------------------
  789. ;dump the pattern to disk
  790. Function WritePattern(f$)
  791.  
  792.         If f$ = "" Then Return
  793.  
  794.         ff = WriteFile(f$)
  795.        
  796.         If ff = 0 Then Return
  797.        
  798.         WriteInt ff, maxchannels
  799.         WriteInt ff, maxnotes
  800.        
  801.         For j = 0 To maxchannels
  802.                 WriteInt ff, instrument(j)
  803.         Next
  804.        
  805.         For i = 0 To maxnotes
  806.         For j = 0 To maxchannels
  807.                 WriteInt ff, pattern(j, i)
  808.                 WriteInt ff, vol(j, i)
  809.         Next
  810.         Next
  811.        
  812.         WriteInt ff, curX
  813.         WriteInt ff, curY
  814.        
  815.         CloseFile ff
  816.        
  817. End Function
  818.  
  819. ;-----------------------------------------------------------------------------------------------------
  820. ;                                                                                                       ReadPattern()
  821. ;-----------------------------------------------------------------------------------------------------
  822. ;read dumped pattern from disk
  823. Function ReadHeader(f$)
  824.                
  825.         If FileType(f$) <> 1 Then Return
  826.        
  827.         ff = ReadFile(f$)
  828.        
  829.         If ff = 0 Then Return
  830.        
  831.         maxchannels = ReadInt(ff)
  832.         maxnotes = ReadInt(ff)
  833.        
  834.         CloseFile ff
  835.        
  836. End Function
  837.  
  838. ;-----------------------------------------------------------------------------------------------------
  839. ;                                                                                                       ReadPattern()
  840. ;-----------------------------------------------------------------------------------------------------
  841. ;read dumped pattern from disk
  842. Function ReadPattern(f$)
  843.                
  844.         If FileType(f$) <> 1 Then Return
  845.        
  846.         ff = ReadFile(f$)
  847.        
  848.         imaxchannels = ReadInt(ff)
  849.         imaxnotes = ReadInt(ff)
  850.        
  851.         If imaxnotes <> maxnotes Then CloseFile ff: Return
  852.         If imaxchannels <> maxchannels Then CloseFile ff: Return
  853.  
  854.         For j = 0 To maxchannels
  855.                 instrument(j) = ReadInt(ff)
  856.                 SelectInstrument j, instrument(j)
  857.         Next
  858.        
  859.         For i = 0 To maxnotes
  860.         For j = 0 To maxchannels
  861.                 pattern(j, i) = ReadInt(ff)
  862.                 vol(j, i) = ReadInt(ff)
  863.         Next
  864.         Next
  865.        
  866.         If Not Eof(ff) Then
  867.                 curX = ReadInt(ff)
  868.                 curY = ReadInt(ff)
  869.         End If
  870.        
  871.         CloseFile ff
  872.        
  873. End Function
  874.  
  875. ;-----------------------------------------------------------------------------------------------------
  876. ;                                                                                                       SaveMidi()
  877. ;-----------------------------------------------------------------------------------------------------
  878. ;save MIDI file
  879. Function SaveMidi(name$)
  880.  
  881.         expand = 1 + 3 * (maxnotes < 16)
  882.         notelength = 96 * expand;$60
  883.        
  884.         SetBuffer FrontBuffer()
  885.         Color 255, 255, 255
  886.         Cls
  887.         Locate 0, 0
  888.        
  889.         Print "Saving MIDI file '" + name$ + "' .. "
  890.        
  891.         ;set drum instruments
  892.         For i = 0 To 4
  893.                 Instrument(i) = 0
  894.         Next
  895.        
  896.         ;general tempo
  897.         ;BPM# = 15000 / spd
  898.        
  899.         ;-------------------------------------------------------------------------------------------------
  900.         ;                                                                    calculate tempo
  901.         ;-------------------------------------------------------------------------------------------------
  902.        
  903.         tt = 4000 / expand * spd ;15000/BPM
  904.         t1 = (tt Shr 16)
  905.         t2 = (tt Shr 8) Mod 256
  906.         t3 = (tt Mod 256)
  907.        
  908.         ;opens file
  909.         MIDI_File = WriteFile(name$)
  910.        
  911.         If MIDI_File = 0 Then Return
  912.        
  913.         ;-------------------------------------------------------------------------------------------------
  914.         ;                                                                        write MIDI header
  915.         ;-------------------------------------------------------------------------------------------------
  916.        
  917.         ;[4] standard header
  918.         MIDI_WriteLine "MThd"
  919.        
  920.         ;[4] size header = 6 bytes
  921.         MIDI_WriteLine Chr$(0) + Chr$(0) + Chr$(0) + Chr$(6)
  922.        
  923.         ;[2] midi type 2
  924.         MIDI_WriteLine Chr$(0) + Chr$(2)
  925.        
  926.         ;[2] number of tracks
  927.         MIDI_WriteLine Chr$(0) + Chr$(maxchannels + 1)
  928.        
  929.         ;[2] time base
  930.         MIDI_WriteLine Chr$($01) + Chr$($80)
  931.        
  932.         ;-------------------------------------------------------------------------------------------------
  933.         ;                                                                               tempo track
  934.         ;-------------------------------------------------------------------------------------------------
  935.        
  936.         ;[4] track header
  937.         MIDI_WriteLine "MTrk"
  938.        
  939.         ;[4] track length in bytes = 10 bytes
  940.         MIDI_WriteLine Chr$(0) + Chr$(0) + Chr$(0) + Chr$($0A)
  941.        
  942.         ;[8] tempo in microseconds pro quarter note
  943.         MIDI_WriteLine Chr$(0) + Chr$(255) + Chr$(81) + Chr$(3) + Chr$(t1) + Chr$(t2) + Chr$(t3) + Chr$(0)
  944.        
  945.         ;[3] end of track
  946.         MIDI_WriteLine Chr$(255) + Chr$(47) + Chr$(0)
  947.        
  948.         Dim nxt(maxnotes)
  949.        
  950.         For iCurTrack = 0 To maxchannels
  951.        
  952.         For i = 0 To maxnotes
  953.                 If pattern(iCurTrack, i) > 0 Then Exit
  954.                 If i Mod 8 = 0 Then
  955.                         pattern(iCurTrack, i) = 3000
  956.                         vol(iCurTrack, i) = 01
  957.                 End If
  958.         Next
  959.         ;If pattern(iCurtrack, 0) = 0 Then pattern(iCurtrack, 0) = 13: vol(iCurTRack, 0) = 1
  960.        
  961.         CurTrack = ConvertChannel(iCurTrack)
  962.        
  963.         ;-------------------------------------------------------------------------------------------------
  964.         ;                                                                           track CurTrack
  965.         ;-------------------------------------------------------------------------------------------------
  966.        
  967.         ;[4] track header
  968.         MIDI_WriteLine "MTrk"
  969.        
  970.         For i = 0 To maxnotes
  971.                 templen(i) = 0
  972.         Next
  973.        
  974.         t = 0: prev = -1
  975.         For i = 0 To maxnotes
  976.                 note = pattern(iCurTrack, i) - 1
  977.                 If note > 0 Then
  978.                         t = t + 1
  979.                         If prev > -1 Then
  980.                                 templen(prev) = i - prev
  981.                         End If
  982.                         prev = i
  983.                         If i = maxnotes Then templen(i) = 1
  984.                 End If
  985.         Next
  986.         If prev > -1 Then templen(prev) = (maxnotes + 1) - prev
  987.        
  988.         p = 0
  989.         For i = 0 To maxnotes
  990.                 If pattern(iCurTrack, i) > 0 Then p = p + writevarlen(templen(i) * notelength, 0)
  991.         Next
  992.        
  993.         ;519
  994.         t = t * 7 + p + 7
  995.         t1 = t Shr 8
  996.         t2 = t Mod 256
  997.        
  998.         ;[4] track length in bytes
  999.         MIDI_WriteLine Chr$(0) + Chr$(0) + Chr$(t1) + Chr$(t2)
  1000.        
  1001.        
  1002.         ;[4] Channel: Program Change
  1003.         MIDI_WriteLine Chr$(0) + Chr$($C0 + CurTrack) + Chr$(Instrument(iCurTrack)) + Chr$(0)
  1004.        
  1005.         ;-------------------------------------------------------------------------------------------------
  1006.         ;                                                                               write notes
  1007.         ;-------------------------------------------------------------------------------------------------
  1008.                        
  1009.                         bb = 7
  1010.                         For i = 0 To maxnotes
  1011.                                 note = pattern(iCurTrack, i) - 1
  1012.                                 vou = vol(iCurTrack, i)
  1013.                                 If note = 2999 Then note = 13: pattern(iCurTrack, i) = 0
  1014.                                 If note > 0 Then
  1015.                                         ;[4] notes [status] [byte1] [byte2] [delta]
  1016.                                         ;     on                  note    volume       time
  1017.                                         Send $90 + CurTrack: Send note: Send vou: bb = bb + 3 + WriteVarLen(notelength * templen(i))
  1018.                                         ;    off                  note    volume       time
  1019.                                         Send $80 + CurTrack: Send note: Send $00: Send $00: bb = bb + 4
  1020.                                 End If
  1021.                         Next
  1022.                        
  1023.         ;-------------------------------------------------------------------------------------------------
  1024.         ;                                                                               end of track
  1025.         ;-------------------------------------------------------------------------------------------------
  1026.         ;[3] end of track
  1027.         MIDI_WriteLine Chr$(255) + Chr$(47) + Chr$(0)
  1028.        
  1029.         Next
  1030.        
  1031.         ;closes file
  1032.         CloseFile MIDI_File
  1033.  
  1034.         Dim nxt(0)
  1035.        
  1036.         Print "Done."
  1037.         Print "Opening file.."
  1038.         ;playback midi file
  1039.         chn = PlayMusic(name$)
  1040.         If chn = 0 Then
  1041.                 Print "Hmm, the channel returns an empty handle .. the file is probably not saved"
  1042.         Else
  1043.                 Print "Playing file .. press any key To Exit"
  1044.         End If
  1045.         FlushKeys()
  1046.         WaitKey()
  1047.         FlushKeys()
  1048.        
  1049.         StopChannel chn
  1050.        
  1051.         SetBuffer BackBuffer()
  1052.         Cls
  1053.        
  1054. End Function
  1055.  
  1056.  
  1057. ;--------------
  1058. ;MIDI_WRITELINE
  1059. ;--------------
  1060.  
  1061. ;sends a string to the file
  1062.  
  1063. Function MIDI_WriteLine( t$ )
  1064.         For i = 1 To Len( t$ )
  1065.                 WriteByte MIDI_File, Asc(Mid$(t$, i, 1))
  1066.         Next
  1067. End Function
  1068.  
  1069.  
  1070. ;-----
  1071. ;SEND
  1072. ;-----
  1073.  
  1074. ;sends a byte to the file
  1075.  
  1076. Function Send( p )
  1077.         WriteByte MIDI_File, p
  1078. End Function
  1079.  
  1080.  
  1081. ;-------------------------------------------------------------------------------------------------
  1082. ;                                                                                       WriteVarLen()
  1083. ;-------------------------------------------------------------------------------------------------
  1084. ;write strange midi formatted number
  1085. Function WriteVarLen(value, send = 1)
  1086.        
  1087.         buffer = value And $7F
  1088.        
  1089.         Repeat
  1090.        
  1091.                 value = value Shr 7
  1092.                 If Not value Then Exit
  1093.                
  1094.                 buffer = buffer Shl 8
  1095.                 buffer = buffer Or (value And $7F) Or $80
  1096.                
  1097.         Forever
  1098.        
  1099.         t = 0
  1100.         Repeat
  1101.        
  1102.                 If send Then Send (buffer And $FF)
  1103.                 t = t + 1
  1104.                 If buffer < $80 Then Exit
  1105.                 buffer = buffer Shr 8
  1106.                
  1107.         Forever
  1108.        
  1109.         Return t
  1110.        
  1111. End Function
  1112.        
  1113. ;-------------------------------------------------------------------------------------------------
  1114. ;                                                                                                       TestSel()
  1115. ;-------------------------------------------------------------------------------------------------
  1116. Function TestSel(i = 0)
  1117.         ;shift+move=select
  1118.         If curX < 0 Then Return
  1119.         If curY < 0 Then Return
  1120.         If curX > maxchannels Then Return
  1121.         If curY > maxnotes Then Return
  1122.         If KeyDown(42) Then
  1123.                 sel(curX, curY) = Not(sel(curX, curY))
  1124.                 If i <> 0 Then
  1125.                         For t = 0 To Abs(i)
  1126.                                 tt = t * Sgn(i) + curY
  1127.                                 If tt >= 0 Then If tt <= maxnotes Then
  1128.                                         sel(curX, tt) = Not(sel(curX, tt))
  1129.                                 End If                         
  1130.                         Next
  1131.                 End If
  1132.         End If
  1133.  
  1134. End Function
  1135.  
  1136. ;-------------------------------------------------------------------------------------------------
  1137. ;                                                                                                       StartPlay()
  1138. ;-------------------------------------------------------------------------------------------------
  1139. Function StartPlay()
  1140.                         playing = Not(playing)
  1141.                         If playing Then
  1142.                                 button$(4) = "Stop"
  1143.                         Else
  1144.                                 button$(4) = "Play"
  1145.                         End If
  1146.                         starttime = nowtime
  1147.                         oldtimenow = -1000
  1148.                         For i = 0 To maxchannels
  1149.                                 PlayNote(i, -1, 0)
  1150.                         Next                   
  1151. End Function
  1152.  
  1153. ;-------------------------------------------------------------------------------------------------
  1154. ;                                                                                                       iInput()
  1155. ;-------------------------------------------------------------------------------------------------
  1156. Function iInput$(r$)
  1157.         FlushKeys()
  1158.         r$ = Input$(r$)
  1159.         FlushKeys()
  1160.         Return r$
  1161. End Function
  1162.  
  1163. ;-------------------------------------------------------------------------------------------------
  1164. ;                                                                                               SetSpeed()
  1165. ;-------------------------------------------------------------------------------------------------
  1166. Function SetSpeed()
  1167.                         Cls
  1168.                         Color 255, 255, 255
  1169.                         Locate 0, 0
  1170.                         SetBuffer FrontBuffer()
  1171.                         Print "Current speed is: " + spd + "  (" + 15000 / spd + " BPM)"
  1172.                         spd = iInput ("new speed>")
  1173.                         If spd = 0 Then spd = 1
  1174.                         SetBuffer BackBuffer()
  1175. End Function
  1176.  
  1177. ;-------------------------------------------------------------------------------------------------
  1178. ;                                                                                               Help
  1179. ;-------------------------------------------------------------------------------------------------
  1180. Function Help()
  1181.                 Cls
  1182.                 Color 64, 64, 64
  1183.                 Locate 0, 0
  1184.                 Print "Use cursor keys to move around"
  1185.                 Print
  1186.                 Print "Q2W3E..etc for playing sounds"
  1187.                 Print "ZSXDC..etc for lower octave"
  1188.                 Print
  1189.                 Print "Change octave using F7/F8"
  1190.                 Print
  1191.                 Print "Change (non-drumtrack) instrument: F9/F10"
  1192.                 Print
  1193.                 Print "Enter to play"
  1194.                 Print "Space toggle recmode"
  1195.                 Print
  1196.                 Print "Esc to dump file and exit"
  1197.                 Print
  1198.                 Print "Del remove note"
  1199.                 Print "TAB make mark"
  1200.                 Print
  1201.                 Print
  1202.                 Print "F3-Cut"
  1203.                 Print "F4-Copy"
  1204.                 Print "F5-Paste"
  1205.                 Print
  1206.                 Print "Press any key to continue"
  1207.                 Flip
  1208.                 FlushKeys()
  1209.                 Repeat
  1210.                         r = GetKey()
  1211.                 Until r Or MouseHit(1)
  1212.                 FlushKeys()
  1213. End Function
  1214.  
  1215. ;-------------------------------------------------------------------------------------------------
  1216. ;                                                                                               CopyFrame()
  1217. ;-------------------------------------------------------------------------------------------------
  1218. Function CopyFrame()
  1219.         fmaxchannels = maxchannels
  1220.         fmaxnotes = maxnotes
  1221.        
  1222.         For i = 0 To maxchannels
  1223.         For j = 0 To maxnotes
  1224.                 BUF_Sel(i, j) = Sel(i, j)
  1225.                 BUF_Pattern(i, j) = Pattern(i, j)
  1226.                 BUF_Vol(i, j) = Vol(i, j)
  1227.         Next
  1228.         Next
  1229.  
  1230. End Function
  1231.  
  1232. ;-------------------------------------------------------------------------------------------------
  1233. ;                                                                                               CopyFrame()
  1234. ;-------------------------------------------------------------------------------------------------
  1235. Function CutFrame(del=0)
  1236.        
  1237.         If Not del Then CopyFrame()    
  1238.         For i = 0 To maxchannels
  1239.         For j = 0 To maxnotes
  1240.                 If del Or sel(i, j) Then
  1241.                         Pattern(i, j) = 0
  1242.                         Vol(i, j) = 0
  1243.                         Sel(i, j) = 0
  1244.                 End If
  1245.         Next
  1246.         Next
  1247.  
  1248. End Function
  1249.  
  1250. ;-------------------------------------------------------------------------------------------------
  1251. ;                                                                                               PasteFrame()
  1252. ;-------------------------------------------------------------------------------------------------
  1253. Function CopyFrame2()
  1254.        
  1255.         cx = 0
  1256.         cy = 0
  1257.         For j = 0 To maxnotes
  1258.         For i = 0 To maxchannels
  1259.                 If sel(i, j) Then
  1260.                         cx = i
  1261.                         cy = j
  1262.                         Exit
  1263.                 End If
  1264.         Next
  1265.         If sel(i, j) Then Exit
  1266.         Next
  1267.        
  1268.         For i = 0 To maxchannels
  1269.         For j = 0 To maxnotes
  1270.                 ii = i - cx
  1271.                 jj = j - cy
  1272.                 If ii <= maxchannels Then
  1273.                 If ii >= 0 Then
  1274.                         If jj <= maxnotes Then
  1275.                         If jj >= 0 Then
  1276.                                         BUF_Pattern(ii, jj) = Pattern(i, j)
  1277.                                         BUF_Vol(ii, jj) = Vol(i, j)
  1278.                                         BUF_Sel(ii, jj) = Sel(i, j)
  1279.                         End If
  1280.                         End If
  1281.                 End If
  1282.                 End If
  1283.         Next
  1284.         Next
  1285.  
  1286. End Function
  1287.  
  1288.  
  1289. ;-------------------------------------------------------------------------------------------------
  1290. ;                                                                                               PasteFrame()
  1291. ;-------------------------------------------------------------------------------------------------
  1292. Function PasteFrame(cx, cy, seld = 0)
  1293.        
  1294.         For i = 0 To fmaxchannels
  1295.         For j = 0 To fmaxnotes
  1296.                 ii = i + cx
  1297.                 If ii <= maxchannels Then
  1298.                 If ii >= 0 Then
  1299.                         jj = j + cy
  1300.                         If jj <= maxnotes Then
  1301.                         If jj >= 0 Then
  1302.                                 If seld Or BUF_sel(i, j) Then
  1303.                                         Pattern(ii, jj) = BUF_Pattern(i, j)
  1304.                                         Vol(ii, jj) = BUF_Vol(i, j)
  1305.                                         If seld Then Sel(ii, jj) = Buf_Sel(i, j)
  1306.                                 End If
  1307.                         End If
  1308.                         End If
  1309.                 End If
  1310.                 End If
  1311.         Next
  1312.         Next
  1313.  
  1314. End Function
  1315.  
  1316. ;-------------------------------------------------------------------------------------------------
  1317. ;                                                                                               ChangeLength()
  1318. ;-------------------------------------------------------------------------------------------------
  1319. Function ChangeLength(newlength = -1)
  1320.  
  1321.         If newlength = -1 Then
  1322.                 Cls
  1323.                 Color 255, 255, 255
  1324.                 Locate 0, 0
  1325.                 SetBuffer FrontBuffer()
  1326.                 Print "Current length is: " + (maxnotes+1)
  1327.                 Print "Exporting MIDI is now only supported for 16/32/64"
  1328.                 newlength = iInput ("new length>")
  1329.                 SetBuffer BackBuffer()
  1330.                 If newlength = 0 Then Return
  1331.                 newlength = Abs(newlength) - 1
  1332.         End If
  1333.                        
  1334.         CopyFrame()
  1335.        
  1336.         maxnotes = newlength
  1337.  
  1338.         Dim     Pattern(maxchannels, maxnotes)
  1339.         Dim     Vol(maxchannels, maxnotes)
  1340.         Dim             Sel(maxchannels, maxnotes)
  1341.        
  1342.         ;delete
  1343.         CutFrame(1)
  1344.  
  1345.         PasteFrame(0, 0, 1)    
  1346.  
  1347.         Dim     BUF_Vol(maxchannels, maxnotes)
  1348.         Dim             BUF_Pattern(maxchannels, maxnotes)
  1349.         Dim             BUF_Sel(maxchannels, maxnotes)
  1350.  
  1351.         vis_maxnotes = 31
  1352.         vis_maxchannels = 3
  1353.         If vis_maxnotes > maxnotes Then vis_maxnotes = maxnotes
  1354.         If vis_maxchannels > maxchannels Then vis_maxchannels = maxchannels
  1355.        
  1356.         CurX = 0
  1357.         CurY = 0
  1358.  
  1359. End Function


Comments :


Damien Sturdy(Posted 1+ years ago)

 Not a bad bit of code!Great work :)


Panno(Posted 1+ years ago)

 cool


Subirenihil(Posted 1+ years ago)

 nice :)


 

SimplePortal 2.3.6 © 2008-2014, SimplePortal