' copyright dan schaaf 1996
DECLARE FUNCTION t128% (a%)
DECLARE FUNCTION make.num$ (e#)
DECLARE FUNCTION neg% (a%)
DECLARE FUNCTION Chop.Name$ (name$)

'  drive$ = "g:"
' odrive$ = "g:"

'CONST key$ = "Inv *4Inv *2InvertInv1/2Inv1/4Fixed 1/4   1/2   Normal*2    *4    "
'CONST Mode$ = "Norm  1-ShotGlide Releas"
'CONST OutPut$ = "None  Left  Right Mono  Stereo"
'CONST Out$ = "Any   Left  Right Mono  StereoIndie "
'CONST dest$ = "Pitch VolumeFilterPan   AttackAEG/T Glide LFO1/ALFO2/ALFO1/RLFO2/RENV1  ENV2  "
'CONST source$ = "Vel   Vel/R Key   Key/R Wheel Pbend PB/H  Xctl1 Xctl2 Press ExtrenLFO1  LFO2  ENV1  ENV2  "
'CONST shape$ = "TriangSaw   SquareSine  Noise "
'CONST Sync$ = "None  Reset Group Voice "
'CONST Priority$ = "Low   Mid   High  "

CONST RangeLo% = 0, RangeHi% = 1, MinVol% = 2, MaxVol% = 3
CONST Oct% = 4, Cnts% = 5, KeyM% = 6, vol% = 7, PerVel% = 8, MaxVel% = 9
CONST Filter% = 10, d.axis% = 11, dyn% = 12, fix.ax% = 13
CONST Mode% = 14, poly% = 15, Glide1% = 16, Glide2% = 17
CONST OutP% = 18, pan% = 19, Ind.From% = 20, Ind.To% = 21
CONST Aeg% = 22, L1% = 22, L2% = 23, At% = 24, d1% = 25, d2% = 26, r1% = 27
CONST shape% = 0, LFOamp% = 1, Sync% = 2, Position% = 3, Rate1% = 4, Rate2% = 5
CONST lfo1% = 28, lfo2% = 34, Env1% = 40, Env2% = 52
CONST eL0% = 0, eL1% = 1, eL2% = 2, eL3% = 3
CONST t1.1% = 4, t1.2% = 5, t2.1% = 6, t2.2% = 7, t3.1% = 8, t3.2% = 9, Env.amp% = 10
CONST ModTable% = &H40

 CLS
  
  DIM wname$(64), vname$(32), timber%(32), wave%(32), lo%(32), hi%(32)
  DIM Aeg%(5)   '  , AEG%(5,32), Pb%(128), Vol%(128),Vel%(128)
  DIM perf.channel%(16), perf.voice%(16), perf.key.assign%(16)
  DIM perf.out%(16), perf.vol%(16), perf.key.shift%(16), perf.detune%(16)
  DIM HoldName$(32), old%(32)

  CONST perf.name% = &H88, perf.voice% = &H22, perf.key.assign% = &H32
  CONST perf.channel% = &H12, perf.out% = &H42, perf.vol% = &H52
  CONST perf.key.shift% = &H72, perf.detune% = &H62
  header$ = "FORMxxxxTYPxVInf"
  
  DATA 0   , 0   , 0   , &H10, &HA9, &H23, &HFD, &H3A
  DATA &HA8, &HC6, &HD1, &H86, &H07, &H3F, &HFD, &HC0

 FOR l% = 0 TO 15: READ a%: header$ = header$ + CHR$(a%): NEXT l%

  Setup$ = header$: MID$(Setup$, 12) = "S" ' Setup
  Setup$ = Setup$ + make.num$(0#) + "Parm" + make.num$(&H38)
  Setup$ = Setup$ + MKI$(&HFFFF) + MKI$(0#)
 
  DATA    0,    2,    4, &h7d, &h0f, &h0f, &h76, &h7e
  DATA &h79, &h7b, &h7f,    0, &hff,    0,    0,    0
  DATA    0,    0,    0,    0,    0, &h43, &h4f, &h4e
  DATA &h41, &h4d, &h45,    0,    0,    0,    1,    0
  DATA    1,    0,    2,    1, &h3d, &h69,    0,    0
  DATA &h44, &h55, &h4d, &h50,    0,    0,    0,    0
  DATA    0,    0,    0, &hff

  FOR l% = 0 TO 51: READ a%: Setup$ = Setup$ + CHR$(a%): NEXT l%
 
'ON ERROR GOTO 30000

DIM name$(100), ky%(100), id$(100)

swing:


'   ****************  Get valid file names  ****************

CLS : FILES "*.c??"

INPUT "File name limiter"; f$
CLS : FILES f$ + "*.c??"

 in% = -1: here% = CSRLIN - 2

'   **************   get name   ***************

 FOR r% = 2 TO here%
  FOR c% = 0 TO 3
    n$ = ""
     FOR n% = 1 TO 12
      n$ = n$ + CHR$(SCREEN(r%, c% * 18 + n%))
     NEXT n%
     IF RTRIM$(n$) = "" THEN GOTO fin.in
     in% = in% + 1: name$(in%) = n$
  NEXT c%
 NEXT r%

fin.in:

' CLS

  FOR n% = 0 TO in%:
    OPEN name$(n%) FOR RANDOM AS #1 LEN = 4: FIELD #1, 4 AS k$
    GET #1, 1

    IF k$ = "FORM" THEN
        GET #1, 35: m% = ASC(MID$(k$, 3)):
        PRINT name$(n%); " "; HEX$(m%), : ky%(n%) = m%
        GET #1, 14: id$(n%) = k$:  PRINT HEX$(CVL(k$)), LEN(k$)
    ELSE
        PRINT : ky%(n%) = 0
    END IF
   
    CLOSE #1
  NEXT n%


 ' sort
PRINT : PRINT : INPUT "OK"; n$: IF UCASE$(LEFT$(n$, 1)) <> "Y" GOTO swing

   GOSUB sort
   wave.base% = 0

   FOR l% = 0 TO in% + 1
     w% = VAL(RIGHT$(name$(l%), 2)): wave%(l%) = w%
     PRINT l%; "-"; HEX$(ky%(l%)); " - "; name$(l%)
     IF wave.base% = 0 THEN IF ky%(l%) THEN wave.base% = l%
   NEXT l%
  
   FOR l% = 0 TO in% + 1
    IF ky%(l%) = 0 THEN GOTO fin.rasp
    IF ky%(l% - 1) = 0 THEN ky%(l% - 1) = ky%(l%)
    PRINT l%; "-"; HEX$((ky%(l%) + ky%(l% - 1)) / 2)
fin.rasp:
   NEXT l%

 GOSUB make.form
 GOTO swing
 END


sort:
     FOR l% = 0 TO in%
       FOR m% = 0 TO in%:
         IF ky%(m%) > ky%(m% + 1) THEN
           SWAP ky%(m%), ky%(m% + 1)
           SWAP name$(m%), name$(m% + 1)
           SWAP id$(m%), id$(m% + 1)
         END IF
       NEXT m%
ham: NEXT l%

RETURN


' *************** Make Typhoon voice file *****
           ' n%=voive number to create
make.form:
 PRINT wave.base%, in%
 INPUT "Name of voice to use"; vname$
 IF vname$ = "" THEN RETURN
 INPUT "Number of voice"; nn%
 PRINT "Making "; vname$
 VOICE# = nn%
 form$ = header$
 MID$(form$, 12) = "V"  ' voice
 form$ = form$ + make.num$(VOICE# + 1) + "Grop    Parm" + make.num$(&H40) + STRING$(&H40, 0)
   
    FOR LL% = 0 TO 7
      form$ = form$ + "Mod " + make.num$(6#) + STRING$(6, 0)
    NEXT LL%

 form$ = form$ + "Splt" + make.num$(&H1C) + "Wave" + make.num$(&H14)



' *************** put in first (unsplit) wave data
' *************** Pointer to next parameter:


' *************** Put in wave name:
 form$ = form$ + LEFT$(RTRIM$(LEFT$(name$(wave.base%), 8)) + STRING$(7, 0), 8)

'PRINT LEFT$(RTRIM$(name$(wave.base%)) + STRING$(7, 0), 8),

 ' ************** Put in wave id number ***********
 form$ = form$ + id$(wave.base%) 'CHR$(0) + CHR$(0) + CHR$(0) + CHR$(wave%(wave.base%) + 1)

' *************** and blank disk name
 form$ = form$ + STRING$(8, &HFF)   ' disk name

 IF in% - wave.base% < 0 THEN GOTO fin.voice

' ****** do remaining timbers and waves **********

FOR l% = wave.base% + 1 TO in% + 1
' ************ put in split point lo%(l%) ******************
 form$ = form$ + "Splt" + CHR$(0) + CHR$(0) + CHR$(0) + "&Parm"
'form$ = form$ + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(2) + CHR$(lo%(l%))
 form$ = form$ + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(2) + CHR$((ky%(l%) + ky%(l% - 1)) / 2)
 'PRINT lo%(l%)

 ' ****************** and wave name, etc. as before ****************
 form$ = form$ + CHR$(0) + "Wave" + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(&H14)
 harm$ = LEFT$(RTRIM$(LEFT$(name$(l%), 8)) + STRING$(7, 0), 8)
 form$ = form$ + harm$
 PRINT harm$,
 form$ = form$ + id$(l%) 'CHR$(0) + CHR$(0) + CHR$(0) + CHR$(wave%(l%) + 1)
 form$ = form$ + STRING$(8, &HFF)   ' disk name

NEXT l%

fin.voice:
' ****************** set file length pointers in file ***********

 MID$(form$, 5) = make.num$(LEN(form$) - 8#)
 MID$(form$, &H29) = make.num$(LEN(form$) - &H2C)

' ******************** set max/min note and velocity range
 MID$(form$, &H35) = CHR$(0)  ' note range
 MID$(form$, &H36) = CHR$(&H60)  ' note range

 MID$(form$, &H37) = CHR$(0)  ' vol range
 MID$(form$, &H38) = CHR$(127)  ' vol range

vbase% = &H35

 MID$(form$, Oct% + vbase%) = CHR$(0 * (256 - 12)) ' octave down one (why?)
 MID$(form$, Mode% + vbase%) = CHR$(&HFE)' normal mode
 MID$(form$, poly% + vbase%) = CHR$(1)' poly on
 MID$(form$, OutP% + vbase%) = CHR$(&H3) ' output mono
 MID$(form$, Filter% + vbase%) = CHR$(&HFF)' no filter
 MID$(form$, KeyM% + vbase%) = CHR$(&H3)  ' keyboard normal
 MID$(form$, vol% + vbase%) = CHR$(((99 - vol.ave%) * 0) \ 99)' vol at max
 MID$(form$, PerVel% + vbase%) = CHR$(&HA)  ' percent start of vel curve
 MID$(form$, MaxVel% + vbase%) = CHR$(&H73) ' vel split
 MID$(form$, Mode% + vbase%) = CHR$(&HFE)   ' normal mode

' ***************** pitch wheel ***************************
 pb% = &H40 / 4
 ModT% = ModTable% + 14 * 0
 MID$(form$, 8 + ModT% + vbase%) = CHR$(&H5)  ' wheel source
 MID$(form$, 12 + ModT% + vbase%) = CHR$(pb%)  ' pitch wheel

' ***************** AEG/T ***************************
 ModT% = ModTable% + 14 * 1
 MID$(form$, 8 + ModT% + vbase%) = CHR$(&H2)  ' key source
 MID$(form$, 9 + ModT% + vbase%) = CHR$(&H5)   ' aeg/t dest
 MID$(form$, 10 + ModT% + vbase%) = CHR$(&H1)  ' freeze
 MID$(form$, 11 + ModT% + vbase%) = CHR$(&HF)  ' ?????? need ?
 MID$(form$, 12 + ModT% + vbase%) = CHR$(&HFF) ' amount
 MID$(form$, 13 + ModT% + vbase%) = CHR$(&HFF - 25)' amount

' *****************  ***************************
 ModT% = ModTable% + 14 * 2
 MID$(form$, 8 + ModT% + vbase%) = CHR$(&H7)   ' XCtl1 source
 MID$(form$, 9 + ModT% + vbase%) = CHR$(&H4)   ' Attack Dest
 MID$(form$, 10 + ModT% + vbase%) = CHR$(&H1)  ' freeze
 MID$(form$, 11 + ModT% + vbase%) = CHR$(&HF)  ' ?????? need ?
 MID$(form$, 13 + ModT% + vbase%) = CHR$(&H60) ' amount

'  ***********  AEG *****************************************

 MID$(form$, Aeg% + vbase% + 0) = CHR$(&H3F) 'CHR$(t128%(Aeg%(0)) \ 2)    ' L1
 MID$(form$, Aeg% + vbase% + 1) = CHR$(&H7F) 'CHR$(t128%(Aeg%(1)) \ 2)    ' L2
 MID$(form$, Aeg% + vbase% + 2) = CHR$(&H7F) 'CHR$((Aeg%(2) * 128) \ 100) ' AR
 MID$(form$, Aeg% + vbase% + 3) = CHR$(&H17) 'CHR$((Aeg%(3) * 128) \ 100) ' D1
 MID$(form$, Aeg% + vbase% + 4) = CHR$(&H33) 'CHR$((Aeg%(4) * 128) \ 100) ' D2
 MID$(form$, Aeg% + vbase% + 5) = CHR$(&H40) 'CHR$((Aeg%(5) * 128) \ 100) ' RR

' ********* Prepare voice name for use as MS-DOS file name

  m$ = Chop.Name$(vname$) + ".o" + RIGHT$("0" + LTRIM$(STR$(nn%)), 2)
  PRINT "Saving "; vname$
        
  OPEN odrive$ + m$ FOR OUTPUT AS #2: PRINT #2, form$; : CLOSE #2
  
RETURN




30000
'IF ERL = 10000 THEN drive$ = "": RESUME 10000
'IF ERL = 10020 THEN drive$ = "": RESUME 10000

FUNCTION Chop.Name$ (name$)
  mass$ = ""
  name$ = RTRIM$(LTRIM$(name$))
  IF LEN(name$) <= 8 THEN check$ = "+/\. " ELSE check$ = "+/\. aeiu"
  FOR l% = 1 TO LEN(name$)
   k$ = MID$(name$, l%, 1)
   IF INSTR(check$, k$) = 0 OR (l% = 1) THEN mass$ = mass$ + k$
   IF LEN(mass$) = 8 OR k$ = CHR$(0) THEN GOTO fin.name
  NEXT l%
fin.name:
 Chop.Name$ = UCASE$(mass$)
END FUNCTION

FUNCTION make.num$ (e#)
 
  a$ = ""
 
  FOR l% = 0 TO 3
   a$ = CHR$(e# AND 255#) + a$
   e# = e# \ 256#
  NEXT l%
make.num$ = a$

END FUNCTION

FUNCTION neg% (a%)
  IF a% > 128 THEN a% = a% - 256
  neg% = a%
END FUNCTION

FUNCTION t128% (a%)
  t128% = 128 - (a% * 128) \ 100
END FUNCTION