(load-library 'TOE "TOE.dylib")

(use lolevel)
(use srfi-1)

(define GetSysexBulkDump
  (lambda (device requestSysex lengthExpected)
    (Send device requestSysex)
    (let loop ()
      (if (>= (NumOfBytesReceived device) lengthExpected) (Receive device)
	  (loop)))))

(define ExtractNameList
  (lambda (sysexData numNames startOffset interval nameLen)
    (let loop
	((i 0)
	 (sysexDataList
	  (take
	   (byte-vector->list sysexData)
	   (+ startOffset (* interval numNames))))
	 (nameList '()))
      (if (>= i numNames) nameList
	  (loop
	   (+ i 1)
	   (drop-right sysexDataList interval)
	   (cons
	    (list->string
	     (map integer->char
		  (take (take-right sysexDataList interval) nameLen)))
	    nameList))))))

(define GeneratePatchNameList
  (lambda (nameList)
    (let loop ((i 0) (patchNameList "") (nameList nameList))
      (if (null? nameList) patchNameList
	  (loop
	   (+ i 1)
	   (string-append
	    patchNameList
	    "      <Patch Number=\"P-"
	    (number->string i)
	    "\" Name=\""
	    (car nameList)
	    "\" ProgramChange=\""
	    (number->string i)
	    "\" />\n")
	   (cdr nameList))))))

(define PatchNameList
  (lambda (nameListName nameList)
    (string-append
     "    <PatchNameList Name=\"" nameListName "\">\n"
     (GeneratePatchNameList nameList)
     "    </PatchNameList>\n")))

(Initialize)

(define d (make <Sysex> "Morpheus"))

(define ramRomSysex
  (GetSysexBulkDump d (byte-vector #xf0 #x18 #x0c #x00 #x12 #xf7) 3336))

(define ramPresets (ExtractNameList ramRomSysex 128 7 13 12))
(define romPresets (ExtractNameList ramRomSysex 128 (+ 7 (* 13 128)) 13 12))

(define hyperSysex
  (GetSysexBulkDump d (byte-vector #xf0 #x18 #x0c #x00 #x50 #xf7) 1672))

(define hyperPresets (ExtractNameList hyperSysex 128 7 13 12))

(define patchNameList (string-append
		       (PatchNameList "RAM Presets" ramPresets)
		       (PatchNameList "ROM Presets" romPresets)
		       (PatchNameList "HyperPresets" hyperPresets)))

(display (string-append #<<EOF
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE MIDINameDocument PUBLIC "-//MIDI Manufacturers Association//DTD MIDINameDocument 1.0//EN" "http://www.midi.org/dtds/MIDINameDocument10.dtd">
<MIDINameDocument>
  <Author>TOE Morpheus.py</Author>
  <MasterDeviceNames>
    <Manufacturer>E-mu</Manufacturer>
    <Model>Morpheus</Model>
    <CustomDeviceMode Name="Mode 1">
      <ChannelNameSetAssignments>
        <ChannelNameSetAssign Channel="1" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="2" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="3" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="4" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="5" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="6" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="7" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="8" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="9" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="10" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="11" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="12" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="13" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="14" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="15" NameSet="Name Set 1"/>
        <ChannelNameSetAssign Channel="16" NameSet="Name Set 1"/>
      </ChannelNameSetAssignments>
    </CustomDeviceMode>
    <ChannelNameSet Name="Name Set 1">
      <AvailableForChannels>
        <AvailableChannel Channel="1" Available="true"/>
        <AvailableChannel Channel="2" Available="true"/>
        <AvailableChannel Channel="3" Available="true"/>
        <AvailableChannel Channel="4" Available="true"/>
        <AvailableChannel Channel="5" Available="true"/>
        <AvailableChannel Channel="6" Available="true"/>
        <AvailableChannel Channel="7" Available="true"/>
        <AvailableChannel Channel="8" Available="true"/>
        <AvailableChannel Channel="9" Available="true"/>
        <AvailableChannel Channel="10" Available="true"/>
        <AvailableChannel Channel="11" Available="true"/>
        <AvailableChannel Channel="12" Available="true"/>
        <AvailableChannel Channel="13" Available="true"/>
        <AvailableChannel Channel="14" Available="true"/>
        <AvailableChannel Channel="15" Available="true"/>
        <AvailableChannel Channel="16" Available="true"/>
      </AvailableForChannels>
      <PatchBank Name="RAM Presets" ROM="false">
        <MIDICommands>
          <ControlChange Control="0" Value="0"/>
          <ControlChange Control="32" Value="0"/>
        </MIDICommands>
        <UsesPatchNameList Name="RAM Presets"/>
      </PatchBank>
      <PatchBank Name="ROM Presets" ROM="true">
        <MIDICommands>
          <ControlChange Control="0" Value="0"/>
          <ControlChange Control="32" Value="1"/>
        </MIDICommands>
        <UsesPatchNameList Name="ROM Presets"/>
      </PatchBank>
      <PatchBank Name="HyperPresets" ROM="false">
        <MIDICommands>
          <ControlChange Control="0" Value="0"/>
          <ControlChange Control="32" Value="2"/>
        </MIDICommands>
        <UsesPatchNameList Name="HyperPresets"/>
      </PatchBank>
    </ChannelNameSet>

EOF
patchNameList
#<<EOF
  </MasterDeviceNames>
</MIDINameDocument>

EOF
))

(Terminate)

(exit)