'FIle name: 	4-V DSInit				
'Description:  SYSTEM Exclusive  MIDI handler to read data structures from 4-Voice Interface
'Original Date: 2/10/90  By: Joe Paradiso
'
'This program uses MIDIBASIC in the 	
'QuickBASIC  environment.

'MIDIBASIC is a trademark of ALTECH SYSTEMS		
'QuickBASIC is a trademark of MICROSOFT Corporation
'Joe Paradiso is his own trademark


'-----------------------------------------------------------------
' This program will read the 4-Voice Interface data structures, and optionally
' make a file which is needed for the 4-Voice Interface patch editor/librarian.
' Its only purpose is to make the data file which stores the data structures and 
' default patch settings; if this file exists, there should be no need to run this
' program.
'-----------------------------------------------------------------
'				Initialize BASIC
CLEAR ,90000!,5000

'set the compiled% variable to "1" before compiling

compiled% = 1
            'Toggle for compiled/interpreted versions (1 = compiler)
    FOR I%=1 TO PEEK(&H910)
        libname$=libname$+CHR$(PEEK(&H910+I%))
        NEXT
    IF compiled% THEN LIBRARY libname$ ELSE LIBRARY "MIDIBASIC"

DEFINT a-Z
OPTION BASE 1
'-----------------------------------------------------------------
'                                                     MIDIBASIC Variables
    halfMeg% = 0
    oneMeg% = 1
    twoMeg%= 2
    modem% = 3       
    printer% = 4
    ClearIn% = 5    
    ClearOut% = 6
    mode% = 0            
    count%= 0    
    result% = 0
    loHiMode% = 1
    maxBufferSize% = 10000
    checkon = 2
    checkoff = 1
    port% = modem%
    clockRate% = oneMeg%
    nsel2 = 1
    Dflpch% = 98        ' Default # for patch read for default settings
    MxL1 = 22            ' Max. patch items per level 0 heading...

    noDataFlag = 0
    dumpflag=noDataFlag


'-----------------------------------------------------------------
' SyxEx  DATA Formats

' string buffer variable used by GetMIDI  to retrieve singel bytes
    temp1$ = SPACE$(1)

'-----------------------------------------------------------------
'    Sysex dump request Formats

    DSRRequestSize% = 7               'size of DSR Dump SysEx request

 DIM DSRRequest(DSRRequestSize%)          'Array to hold 7 byte dump request message
    DSRRequest(1) = &HF0    'SysEx
    DSRRequest(2) = &H10   'Oberheim ID
    DSRRequest(3) = &H77   'JAP Interface code
    DSRRequest(4) = &H0     'Full dump request
    DSRRequest(5) = &H0     'Blank byte
    DSRRequest(6) = &H7F   'Dump data structures
    DSRRequest(7) = &HF7   'Last byte: EOX

'-----------------------------------------------------------------
'    initialization main window

'    get menu bar height, screen height and screen width for global use
screenW%=SYSTEM(5)
screenH%=SYSTEM(6)
menuBarH%=PEEKW(&HBAA)    'menu bar height Mac global variable

'    Open SysEx Lab's window.
TitleH%=20    'height of window type 1 title bar
height%=screenH%-(menuBarH%+TitleH%+10)
centerWindow 1,"4-Voice Structures",height%,screenW%-10,1,1/2

PRINT " This program will read the 4-Voice Interface data structures, and optionally"
PRINT " make a file which is needed for the 4-Voice Interface patch editor/librarian."
PRINT " Its only purpose is to make the data file which stores the data structures and"
PRINT " default patch settings; if this file already exists, (and is intact), there should"
PRINT " be no need to run this program."

GOSUB SetUpMenus
GOSUB INITMIDI

'-----------------------------------------------------------------
'-----------------------------------------------------------------
'    main loop
WHILE 1
ON MENU   GOSUB DoMenu   :MENU ON
ON BREAK GOSUB DoBreak   :BREAK ON
WEND
'-----------------------------------------------------------------
'-----------------------------------------------------------------
DoMenu:
    MenuID= MENU(0)
    menuitem= MENU(1)
    SELECT CASE MenuID
    CASE 1    :    GOSUB FileCmd          'File menu
    CASE 2    :    GOSUB PageCmd     'Page menu
    CASE 3    :    GOSUB    MIDICmd         'MIDI menu
    CASE ELSE         'ignore any other menu
        PRINT "Unknown menuID:" MenuID
    END SELECT
    MENU            'restore unhighlighted state
    RETURN
'-----------------------------------------------------------------
FileCmd:
        SELECT CASE menuitem
        CASE 1  :GOSUB DoSave
        CASE 2  :GOSUB DoUplink
        CASE 3   'quit
            CALL Libterm    'use this to close MIDIBASIC when compiled as a stand-alone application
            END
        CASE ELSE
            PRINT "Undefined menu item."
        END SELECT
RETURN

'-----------------------------------------------------------------
'
PageCmd:
'
    MENU 2,nsel2,checkoff        ' Reset checkmark
    MENU 2,menuitem,checkon
    nsel2 = menuitem
'
    CLS
    IF menuitem = 1 THEN        ' Generic title page
    PRINT "Default patch was:", Pnum%," Title:",Titp$
    PRINT "# Level 0 Items:",NL0%
    PRINT
    FOR n = 1 TO NL0%
    PRINT "Heading#",n," Title:",L0T$(n),"  # Items:",NL1%(n)
    NEXT n
    PRINT
    PRINT
    PRINT "# Options in List:",Nopt%
    PRINT
    O1% = Nopt%/10
    IF O1% * 10 < Nopt% THEN O1% = O1% + 1
    FOR n = 1 TO O1%
    O2% = (n - 1)*10 + 1
    O3% = O2% + 9
    IF (O3% > Nopt%) THEN O3% = Nopt%
    FOR m = O2% TO O3%
    CALL TEXTFACE(1)
    PRINT Opt$(m);
    CALL TEXTFACE(0)
    PRINT " | ";
    NEXT m
    PRINT
    NEXT n
'
    ELSE    ' Print specific data page
    K = menuitem - 1
    PRINT "Level 0 Title:       ";
    CALL TEXTFACE(1)
    PRINT L0T$(K);
    CALL TEXTFACE(0)
    PRINT  "         # Items:",NL1%(K)
    PRINT "----------------------------------------------------------------"
    PRINT
    FOR n = 1 TO NL1%(K)
    PRINT L1T$(n,K) TAB(12) "   Type: ";L1F%(n,K),"   Bound: ";L1L%(n,K),"   Dfl. Val: ";Ndata%(n,K);
    IF (L1F%(n,K) > 0) THEN
    IP% = L1F%(n,K) + Ndata%(n,K)
    CALL TEXTFACE(1)
    PRINT "    ";Opt$(IP%)
    CALL TEXTFACE(0)
   ELSE
    PRINT
    END IF
    NEXT n
'
    END IF
'
RETURN

'-----------------------------------------------------------------
'
MIDICmd:
        SELECT CASE menuitem
        CASE 1    :GOSUB DoModem
        CASE 2   :GOSUB DoPrinter
        CASE 4  : GOSUB DoHalfMeg
        CASE 5   :GOSUB DoOneMeg
        CASE 6   :GOSUB DoTwoMeg
        CASE ELSE
            PRINT "Undefined menu item."
        END SELECT
        PRINT "Reseting Interface"
        CALL MIDIPort(clockRate%)        'reset the MIDI clock rate
        CALL MIDIPort(port%)                   'reset the MIDI port
RETURN

'-----------------------------------------------------------------
DoBreak:
    PRINT "Leaving Data structure dump...."
        CALL Libterm    'use this to close MIDIBASIC when compiled as a stand-alone application
    END

'-----------------------------------------------------------------
DoSave:
    IF dumpflag = noData THEN
        PRINT "There is no data in the buffer to save."
        RETURN
    END IF
     filename$=FILES$(0,"File to save:")
    IF filename$="" THEN
        RETURN 'Cancel was selected
    END IF
    OPEN filename$ FOR OUTPUT AS #1
'
    PRINT "Saving...."
    NSS% = 0
    FOR J = 1 TO NL0%
    IF (NL1%(J) > NSS%) THEN NSS% = NL1%(J)
    NEXT J
    PRINT "MAX. L1 ITEMS:",NSS%
'
    WRITE #1,Npch%,NL0%,NSS%                        '  Patch Data Structures
    FOR J = 1 TO NL0%
    WRITE #1,L0T$(J)
    WRITE #1,NL1%(J)
    FOR K = 1 TO NL1%(J)
    WRITE #1,L1T$(K,J)
    WRITE #1,L1F(K,J)
    WRITE #1, L1L(K,J)
    NEXT K
    NEXT J
'
    WRITE #1,Nopt%                ' Option table
    FOR J = 1 TO Nopt%
    WRITE #1,Opt$(J)
    NEXT J
'
    FOR J = 1 TO NL0%                ' Default data vaules
    FOR K = 1 TO NL1%(J)
    WRITE #1,Ndata%(K,J)
    NEXT K
    NEXT J
'
    CLOSE #1
    PRINT
    NAME filename$ AS filename$,"TEXT" 'types file as one way data
RETURN

'---------------------------------------------------------------
'
SetUpMenus:
    GOSUB SetupFileMenu
    GOSUB SetupPageMenu
    GOSUB SetUpMIDIMenu
RETURN

'---------------------------------------------------------------
'
SetupFileMenu:
    MENU 1,0,1,"File"
    MENU 1,1,1,"Save"   :cmdkey 1,1,"S"
    MENU 1,2,1,"Upload" :cmdkey 1,2,"U"
    MENU 1,3,1,"Quit"    :cmdkey 1,3,"Q"
RETURN

'---------------------------------------------------------------
'
SetupPageMenu:
    MENU 2,0,1,"Page"        ' Other items inserted after upload
RETURN

'---------------------------------------------------------------
'
SetUpMIDIMenu:
    ModemCheck = 2
    PrinterCheck = 1
    halfMegCheck = 1
    oneMegCheck =2
    twoMegCheck = 3
    MENU 3,0,1, "MIDI"
    MENU 3,1,2,"Modem"    :cmdkey 3,1,"M"
    MENU 3,2,1,   "Printer"    :cmdkey 3,2,"R"
    MENU 3,3,0,"-"
    MENU 3,4,1, ".5 MHz"    :cmdkey 3,4,"5"
    MENU 3,5,2,"1 MHz"    :cmdkey 3,5,"1"
    MENU 3,6,1, "2 MHz"    :cmdkey 3,6,"2"
RETURN

'-----------------------------------------------------------------
DoUplink:    'Upload Interface data
    Inn% = 0 : N1% = 0 : N2% = 0 : N3% = 0 : No% = 0 : en% = 0 : NL0% = 0 : Npch% = 0
    CLS
    GOSUB DmpRqst
    result% =-1
    click% = 0
    count% = 0
      PRINT "Hit mouse to stop transfer"
      NX$ = SPACE$(1)
      GOSUB Sysexh
        ON MOUSE GOSUB EndIt
        CALL MIDIin&(Npch%)
    IF Npch% = -1 GOTO Abort
    Npch% = Npch% + 1
'
        CALL MIDIin&(NL0%)
    IF NL0% = -1 GOTO Abort
'
    IF dumpflag <> 0 THEN ERASE L0T$,NL1%,L1T$,L1F%,L1L%,Opt$,Ndata%
    PRINT "# Patches: ";Npch%,"# Level 0 Items Expected: ";NL0%
    DIM L0T$(NL0%),NL1%(NL0%),L1T$(MxL1,NL0%),L1F%(MxL1,NL0%),L1L%(MxL1,NL0%)
'
    FOR n = 1 TO NL0%
    CALL MIDIin&(Inn%)
    IF Inn% = -1 GOTO Abort:
    NY$ = SPACE$(Inn%)
    count% = 0
    CALL getMIDI(NY$,0,count%,result%)
    IF result% = 1 GOTO Tout:
    L0T$(n) = NY$
    PRINT "LvL0 Title: ",L0T$(n)
    CALL MIDIin&(N1%)
    IF N1% = -1 GOTO Abort:
    PRINT "# LvL1 Items:",N1%
    NL1%(n) = N1%
    FOR m = 1 TO N1%
    CALL MIDIin&(N2%)
        IF N2% = -1 GOTO Abort:
        N2% = N2% - 1    ' Correct for the colon
    NY$ = SPACE$(N2%)
    count% = 0
    CALL getMIDI(NY$,0,count%,result%)
    IF result% = 1 GOTO Tout:
    L1T$(m,n) = NY$
    CALL MIDIin&(N2%)    ' This is the colon
    CALL MIDIin&(N3%)
        IF N3% = -1 GOTO Abort:
        IF N3% = 127 THEN N3% = -1
    L1F%(m,n) = N3%
    count% = 0
    CALL getMIDI(NX$,1,count%,result%)
    IF result% = 1 GOTO Tout:
    L1L%(m,n) = ASC(NX$)
    NEXT m
    NEXT n
'
    CALL MIDIin&(N3%)
        IF N3% = -1 GOTO Abort:
    Nopt% = N3%
    DIM Opt$(Nopt%)
    PRINT
    PRINT "Total # Options:",Nopt%
    FOR n = 1 TO Nopt%
    CALL MIDIin&(No%)
        IF No% = -1 GOTO Abort:
    IF  No% > 1 THEN
    NY$ = SPACE$(No%)
    count% = 0
    CALL getMIDI(NY$,0,count%,result%)
    IF result% = 1 GOTO Tout:
    Opt$(n) = NY$
    ELSE
        CALL MIDIin&(N3%)
        IF N3% = -1 GOTO Abort:
    Opt$(n) = CHR$(N3%)
    END IF
    NEXT n
'
    GOSUB MakePage          ' set up page menu
    CALL MIDIin&(en%)        ' clear up last F7 in sysex message
    PRINT "Last Byte read in structure dump:",HEX$(en%)
    GOSUB LoadDflt            ' load up default patch
    dumpflag = 1
    RETURN
'
EndIt:
    result% = 1
RETURN
'
Tout:        PRINT "Time out error.  Edit buffer data not received."
                dumpflag = noData 'reset dump flag on error
        RETURN
'
Abort:        PRINT "Buffer empty error.  Edit buffer data not received."
                dumpflag = noData 'reset dump flag on error
        RETURN

'
'---------------------------------------------------------------
MakePage:                        '  Set up page menu
    MENU 2,1,1,"Summary"
    FOR n = 1 TO NL0%
    MENU 2,1+n,1,L0T$(n)
    NEXT n
    RETURN
'
'---------------------------------------------------------------
Sysexh:                            '  Read sysex dump header from Interface
    Nxh$ = SPACE$(13)      '  Total bytes read in echo of old cmd. (7) plus new header (6)
    count% = 0
    CALL getMIDI(Nxh$,0,count%,result%)
    IF result% = 1     GOTO Tout:
    PRINT "Header Return:  ";
    FOR n = 1 TO 13
    a$ = MID$(Nxh$,n,1)
    PRINT HEX$(ASC(a$));"  ";
    NEXT n
    PRINT
    RETURN
'
'---------------------------------------------------------------
LoadDflt:                        '  Load default values
    Pbuf% = DSRRequest(6)
    DSRRequest(6) = Dflpch%
    GOSUB DmpRqst
    DSRRequest(6) = Pbuf%
    PRINT
    GOSUB Sysexh
    Ntpc% = 0
    FOR n = 1 TO NL0%
    Ntpc% = Ntpc% + NL1%(n)
    NEXT n
    Ntpc% = Ntpc% + 10
    PRINT
    PRINT "Expected Patch Length:",Ntpc%
    Nrcr$ = SPACE$(Ntpc%)
    count% = 0
    CALL getMIDI(Nrcr$,1,count%,result%)
    IF result% = 1     GOTO Tout:
    PRINT "# Bytes actually read:",count%
    DIM Ndata%(MxL1,NL0%)
    L% = 10
    Pnum% = ASC(Nrcr$)
    Titp$ = MID$(Nrcr$,2,9)
    PRINT "Default patch number read:",Pnum%,"  Title:  ",Titp$
    FOR n = 1 TO NL0%
    FOR m = 1 TO NL1%(n)
    L% = L% + 1
    a$ = MID$(Nrcr$,L%,1)
    Ndata%(m,n) = ASC(a$)
    NEXT m
    NEXT n
    CALL MIDIin&(en%)        ' clear up last F7 in sysex message
    PRINT "Last Byte read in default dump:",HEX$(en%)
    RETURN
'
'---------------------------------------------------------------
DmpRqst:
    PRINT ,"Sending Dump Request   ";
    GOSUB ClearMIDI
    ByteCount = DSRRequestSize%
    FOR J = 1 TO ByteCount
        X% = DSRRequest(J)
        MIDIout X%
        PRINT " " HEX$(X%);
    NEXT J
    PRINT
    RETURN
'---------------------------------------------------------------
'MIDI MENU Item Subroutines

'---------------------------------------------------------------
'
DoModem:
   'PRINT "Modem is not implemented"
   MENU 3,1,checkon    'reset modem item check mark
   MENU 3,2, checkoff    'reset printer item checmark
   port% = modem%
RETURN

'---------------------------------------------------------------
'
DoPrinter:
   'PRINT "Printer is not implemented"
   MENU 3,1,checkoff    'reset modem item check mark
   MENU 3,2, checkon    'reset printer item checmark
   port% = printer%
RETURN
'---------------------------------------------------------------
'
DoHalfMeg:
    'PRINT ".5 mHz is not implemented"
   MENU 3,4,checkon    'reset .5 mHz item check mark
   MENU 3,5, checkoff    'reset 1 mHz item checmark
   MENU 3,6, checkoff    'reset 2 mHz item checmark
   clockRate% = halfMeg%
RETURN
'---------------------------------------------------------------
'
DoOneMeg:
  ' PRINT "1 mHz is not implemented"
   MENU 3,4,checkoff    'reset .5 mHz item check mark
   MENU 3,5, checkon    'reset 1 mHz item checmark
   MENU 3,6, checkoff    'reset 2 mHz item checmark
   clockRate% = oneMeg%
RETURN
'---------------------------------------------------------------
'
DoTwoMeg:
   ' PRINT "2 mHz is not implemented"
   MENU 3,4,checkoff    'reset .5 mHz item check mark
   MENU 3,5, checkoff    'reset 1 mHz item checmark
   MENU 3,6, checkon    'reset 2 mHz item checmark
   clockRate% = twoMeg%
RETURN

INITMIDI:
    CALL MIDIopen(maxBufferSize%,maxBufferSize%)
    CALL MIDIFilter(1,254,254,0)    'Filter out active sensing !!
    CALL MIDIPort(clockRate%)
    CALL MIDIPort(port%)
    GOSUB ClearMIDI
RETURN

ClearMIDI:
    CALL MIDI(ClearIn%)
    CALL MIDI(ClearOut%)
RETURN

'----------------------------------------------------------------------
' window routine
SUB centerWindow(id%,title$,high%,wide%,type%,fract!)STATIC
    SELECT CASE ABS(type%)
    CASE 1 :overt%=18 :overb%=2
    CASE 2 :overt%=8 :overb%=8
    CASE ELSE :overt%=0 :overb%=0
    END SELECT
    left%=(SYSTEM(5)-(wide%))/2
    top%=PEEKW(&HBAA)+overt%*fract!+(SYSTEM(6)-(PEEKW(&HBAA)+high%+overb%))*fract!
    WINDOW id%,title$,(left%,top%)-(left%+wide%,top%+high%),type%
END SUB