home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / musik / bytes / mid_incl.lst < prev    next >
Encoding:
File List  |  1989-04-05  |  9.4 KB  |  204 lines
  1. '
  2. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  3. '  Sequenzerprogramm mit Abspeichermöglichkeit als MIDI Standard File
  4. '  Unter-Routinen zum Einbinden in zukünftige KEYS-Listings zum Thema
  5. '  MIDI Standard Files
  6. '  geschrieben in GFA-BASIC 3.5E D, (C)1993 Stephan M. Sprenger
  7. '  PROSONIQ PRODUCTS SOFTWARE, Badenwerkstraße 9, 76137 Karlsruhe
  8. ' .............................................................................
  9. '
  10. '
  11. PROCEDURE convert_mid(abs_rel|,save_load|)
  12.   '
  13.   ' speichert/lädt Daten als MIDI Standard File:
  14.   ' MIDI-Events in dat$(), Zeit als Clicks in time%()
  15.   '
  16.   ' Wenn Sie abs_rel| auf 1 setzen, erwartet die Routine in time%() die
  17.   ' Zeitangabe als Absolutzeit (also als Zeit seit Spuranfang); ist
  18.   ' abs_rel| Null, dann erwartet die Routine in time%() die seit dem
  19.   ' vorhergehenden Event verstrichene Zeit.
  20.   '
  21.   ' In dat$() befinden sich die zu speichernden MIDI-Events; diese müssen
  22.   ' pro Eintrag vollständig sein (ein Note-On liegt hier z.B. als
  23.   ' dat$(2)=CHR$(144)+CHR$(60)+CHR$(64) vor).
  24.   '
  25.   ' Wenn save_load|=1 ist wird gespeichert, bei save_load|=0 wird geladen
  26.   '
  27.   @convert_init                         ! Konvertierungsroutine einrichten
  28.   dummy$=INKEY$
  29.   FILESELECT "A:\*.MID","MIDIFILE.MID",fn$
  30.   DEFMOUSE 2
  31.   IF fn$="" OR fn$="\"
  32.     GOTO cancel
  33.   ENDIF
  34.   IF save_load|=1
  35.     OPEN "O",#1,fn$
  36.     PRINT #1,"MThd";                      ! **** Header-Block-Kennung ****
  37.     PRINT #1,MKL$(6);                     ! Länge des Headers
  38.     PRINT #1,MKI$(0);                     ! File Format (0)
  39.     PRINT #1,MKI$(1);                     ! Anzahl der Spuren
  40.     PRINT #1,MKI$(&H18);                  ! 24 Clicks pro Viertelnote (MIDI Clock)
  41.     PRINT #1,"MTrk";                      ! ***** Spur-Block-Kennung *****
  42.     PRINT #1,MKL$(0);                     ! Platzhalter für Blocklänge
  43.     PRINT #1,CHR$(0);                     ! Delta-Time des ersten Events
  44.     PRINT #1,CHR$(&HFF);                  ! Meta-Event: Spurname
  45.     PRINT #1,MKI$(&H108);                 ! (01=Text, 08=Textlänge)
  46.     PRINT #1,"MIDIFILE";                  ! Spurname
  47.     c%=0
  48.     DO
  49.       INC c%
  50.       VOID FRE(0)
  51.       r%=V:r$
  52.       IF abs_rel|=1                         ! time%() enthält Absolutzeit
  53.         LPOKE r%+6,(time%(c%)-time%(c%-1))  ! Zeit zwischen zwei Events
  54.       ELSE
  55.         LPOKE r%+6,time%(c%)                ! time%() enthält Delta-Time
  56.       ENDIF
  57.       POKE r%+2,1                           ! Opcode: 1=DEZ-->VLN, 0=VLN-->DEZ
  58.       d0=C:r%()                             ! VLN-Routine aufrufen
  59.       FOR b|=0 TO 3                         ! Bytes in Datei schreiben...
  60.         IF PEEK(r%+6+b|)<>0
  61.           PRINT #1,CHR$(PEEK(r%+6+b|));
  62.         ENDIF
  63.       NEXT b|
  64.       PRINT #1,dat$(c%);                    ! MIDI-Daten in Datei ausgeben
  65.       EXIT IF c%=last%                      ! Abbrechen wenn Spurende
  66.     LOOP
  67.     PRINT #1,CHR$(0);                       ! Delta-time% zum Spurende
  68.     PRINT #1,CHR$(&HFF);MKI$(&H2F00);       ! Meta-Event: Spurende
  69.     CLOSE #1
  70.     OPEN "U",#1,fn$                         ! Datei nochmals öffnen
  71.     l%=LOF(#1)                              ! Länge ermitteln
  72.     SEEK #1,18                              ! Byte #18 anfahren
  73.     PRINT #1,MKL$(l%-18);                   ! Spurlänge eintragen
  74.   ELSE
  75.     c%=0                                   ! Zähler für Feldindex
  76.     z%=0                                   ! Zähler für Absolutzeit
  77.     b%=0                                   ! Zähler für gelesene Bytes
  78.     evt$=""
  79.     OPEN "I",#1,fn$                       ! Datei zum Lesen öffnen
  80.     id$=INPUT$(4,#1)                      ! Header-ID lesen
  81.     h_l%=CVL(INPUT$(4,#1))                ! Header-Länge lesen
  82.     ff&=CVI(INPUT$(2,#1))                 ! File-Typ lesen
  83.     anz&=CVI(INPUT$(2,#1))                ! Spuranzahl
  84.     res&=CVI(INPUT$(2,#1))                ! Auflösung
  85.     IF id$<>"MThd" OR ff%<>0              ! MIDI-File vom Typ 0?
  86.       ALERT 3,"Ungültiges Fileformat - |Fileheader",1," OK ",r
  87.       GOTO cancel                         ! Nein, dann Abbruch
  88.     ENDIF
  89.     id$=INPUT$(4,#1)                      ! Track-ID lesen
  90.     b_l%=CVL(INPUT$(4,#1))                ! Länge der Spur
  91.     IF id$<>"MTrk"                        ! Track-ID prüfen
  92.       ALERT 3,"Ungültiges Fileformat - |Trackstruktur",1," OK ",r
  93.       GOTO cancel                         ! Ungültig? dann raus
  94.     ENDIF
  95.     DO                                    ! Leseschleife
  96.       INC c%                              ! Zähler für Feld erhöhen
  97.       t$=""
  98.       DO                                  ! Leseschleife für Zeit
  99.         tim$=INPUT$(1,#1)                 ! Erstes Byte lesen
  100.         INC b%                            ! Bytezähler +1
  101.         t$=t$+tim$                        ! ersten Zeitwert bilden
  102.         EXIT IF ASC(tim$)<128             ! raus, wenn LSB gelesen
  103.       LOOP
  104.       VOID FRE(0)
  105.       t$=MID$(t$,1,4)
  106.       t$=STRING$(4-LEN(t$),0)+t$          ! Langwort bilden
  107.       r%=V:r$                             ! Adresse der Maschinenroutine
  108.       POKE r%+2,0                         ! Opcode: 0=VLN-->DEZ
  109.       LPOKE r%+6,CVL(t$)                  ! Wert übergeben
  110.       d0=C:r%()                           ! Maschinenprogramm aufrufen
  111.       IF abs_rel|=0                       ! Relative Zeit benötigt?
  112.         time%(c%)=LPEEK(r%+6)/(res&/24)   ! dann Delta-Time ablegen
  113.       ELSE                                ! Absolutzeit?
  114.         z%=z%+LPEEK(r%+6)                 ! dann Zeit bilden...
  115.         time%(c%)=z%/(res&/24)            ! ...und in interne Auflösung umrechnen
  116.       ENDIF
  117.       evt$=INPUT$(1,#1)                   ! Event, erstes Byte lesen
  118.       INC b%                              ! wieder ein Byte mehr...
  119.       rb|=(ASC(evt$)) AND &HF0            ! nur Hi-Nibble wird benötigt
  120.       IF d_len&(rb|)=0                    ! Event-Typ ist nicht bekannt?
  121.         ALERT 3,"ERROR:|Unbekanntes MIDI-Event",1,"CANCEL",r
  122.         EXIT IF r=1                       ! dann nix wie raus...
  123.       ENDIF
  124.       IF evt$=CHR$(&HFF)                  ! Event ist Meta-Event...
  125.         m_type&=ASC(INPUT$(1,#1))         ! ...dann Event-Typ feststellen
  126.         m_l&=ASC(INPUT$(1,#1))            ! Länge feststellen
  127.         RELSEEK #1,m_l&                   ! Meta-Event ignorieren...
  128.         b%=b%+m_l&+2                      ! ...und überspringen
  129.         EXIT IF m_type&=&H2F              ! raus wenn Meta-Event = Spurende
  130.       ELSE
  131.         dat$(c%)=evt$+INPUT$(d_len&(rb|)-1,#1) ! wenn normales MIDI-Event...
  132.         b%=b%+d_len&(rb|)                 ! ... dann lesen und speichern
  133.       ENDIF
  134.     LOOP
  135.     last%=c%                              ! Spurende
  136.   ENDIF
  137. cancel:
  138.   CLOSE #1                                ! Datei schließen
  139.   DEFMOUSE 0                              ! Biene wegzaubern
  140. RETURN
  141. '
  142. PROCEDURE convert_init
  143.   '
  144.   ' Initialisierung der VLN/Dezimal-Routine.
  145.   ' Die in r$ abgelegte Maschinenroutine erwartet in V:r$+2 als Byte den
  146.   ' Opcode der auszuführenden Berechnung (0=VLN in Dezimalwert umrechnen,
  147.   ' 1=Dezimalwert in VLN umrechnen) und in V:r$+6 den umzurechnenden Wert.
  148.   ' Nach Aufruf der Routine kann von dort auch der berechnete Wert gelesen
  149.   ' werden (Langwort). Die Wertübergabe über die Speicherstelle habe ich
  150.   ' gewählt, weil die Übergabe über den Stack bei meiner GFA-Version nicht
  151.   ' korrekt funktioniert.
  152.   '
  153.   r$=MKL$(&H60080000)+MKL$(0)+MKL$(&H41FA)+MKL$(&HFFF62228)
  154.   r$=r$+MKL$(&H44A10)+MKL$(&H6754B2BC)+MKL$(&HFFFFFFF)+MKL$(&H62407003)
  155.   r$=r$+MKL$(&HE389E209)+MKL$(&H8810007)+MKL$(&HB07C0003)+MKL$(&H67084A01)
  156.   r$=r$+MKL$(&H670408C1)+MKL$(&H71401)+MKL$(&HE09AE089)+MKL$(&H51C8FFE2)
  157.   r$=r$+MKL$(&H8020017)+MKL$(&H670408C2)+MKL$(&HF0802)+MKL$(&H1F6706)
  158.   r$=r$+MKL$(&H820080)+MKL$(&H80002142)+MKL$(&H47000)+MKL$(&H4E75217C)
  159.   r$=r$+MKL$(&HFFFFFFF7)+MKL$(&H470FF)+MKL$(&H4E75B2BC)+MKL$(&HFFFFFFF7)
  160.   r$=r$+MKL$(&H62167003)+MKL$(&H1401EE9A)+MKL$(&HE08951C8)+MKL$(&HFFF8E89A)
  161.   r$=r$+MKL$(&H2820FFF)+MKL$(&HFFFF60CE)+MKL$(&H217C0FFF)+MKL$(&HFFFF0004)
  162.   r$=r$+MKL$(&H70FF4E75)
  163.   '
  164.   '
  165.   d_len&(128)=3                         ! Note-Off,Befehlslänge 3 Bytes
  166.   d_len&(144)=3                         ! Note-On, Befehlslänge 3 Bytes
  167.   d_len&(160)=3                         ! Poly Pressure
  168.   d_len&(176)=3                         ! Control Change
  169.   d_len&(192)=2                         ! Program Change
  170.   d_len&(208)=2                         ! Channel Pressure
  171.   d_len&(224)=3                         ! Pitch Wheel Change
  172.   d_len&(&HF0)=&HFF                     ! Meta-Event darf keinen Fehler erzeugen
  173.   '
  174.   ' Es können hier weitere Befehlslängen für MIDI-Nachrichten eingetragen werden
  175.   '
  176. RETURN
  177. '
  178. PROCEDURE midi_buffer(neue_adresse%,laenge%)
  179.   adresse%=XBIOS(14,2)
  180.   alte_buffer_adresse%=LPEEK(adresse%)
  181.   SLPOKE adresse%+6,0
  182.   SLPOKE adresse%,neue_adresse%
  183.   SDPOKE adresse%+4,laenge%
  184. RETURN
  185. '
  186. PROCEDURE alter_buffer
  187.   adresse%=XBIOS(14,2)
  188.   SLPOKE adresse%,alte_buffer_adresse%
  189.   alte_buffer_adresse%=0
  190.   alter_buffer%=0
  191.   @ende                         ! Programm verlassen
  192. RETURN
  193. '
  194. PROCEDURE all_notes_off
  195.   FOR chan|=0 TO 15             ! Alle Kanäle durchgehen...
  196.     FOR note|=0 TO 127          ! Alle Noten durchgehen...
  197.       IF note|=0                ! Erstes Note-Off normal..
  198.         OUT 3,128+chan|
  199.       ENDIF
  200.       OUT 3,note|,0             ! ..den Rest im Running-Mode
  201.     NEXT note|                  ! senden (geht schneller)
  202.   NEXT chan|
  203. RETURN
  204.