home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AMOS PD CD
/
amospdcd.iso
/
076-100
/
apd076
/
gmc_to_amos.amos
/
gmc_to_amos.amosSourceCode
Wrap
AMOS Source Code
|
1990-11-07
|
7KB
|
222 lines
'--------------------------------------------
'- GMC Music file converter -
'- By Francois Lionet & A. Fothergill -
'- -
'- SOUNDTRACKER & SONIX USERS !!! -
'- -
'- We wanted to fit converters for both -
'- of these other music systems but simply -
'- ran out of disc space! You can get these -
'- files from the AMOS PD library NOW. -
'- The disc refernce is APD8. This disc -
'- also contains many tunes for use within -
'- AMOS. Sorry we could not fit them all -
'- on, but it's just too crammed - only -
'- just enough room for this last byte! -
'--------------------------------------------
'Opens a very small screen to save memory!
Screen Open 0,640,48,2,Hires : Colour 1,$FFF
Global TST,AMAX,ABASE
IMAX=14 : Dim APAT(5)
SONGDATA=4
I$="Not named "
MU$="GMC music!"
I_END=$8000
I_SLUP=$8100
I_SLDOWN=$8200
I_SVOL=$8300
I_REP=$8500
I_LEDM=$8600
I_LEDA=$8700
I_TEMPO=$8800
I_INST=$8900
'
AGAIN:
GMC$=Fsel$("","","Please enter file to convert","You MUST choose a GMC binary file!")
'GMC$="Gmc1.bin"
If GMC$="" Then Default : End
Open In 1,GMC$ : BMAX=Lof(1) : Close
Erase 10 : Reserve As Work 10,BMAX
Bload GMC$,Start(10)
'---> Gets size of instruments and song
TST=True : Gosub I_CONV
TST=True : Gosub S_CONV
'---> Converts patterns
LWORK=((BMAX-LINST-LSONG)/3+1) and $FFFFFFFE
N=0
Repeat
If N=0
Print "Converting song..."
Else
Print : Print "One more try: my buffer estimation was too small!"
End If
Gosub 3000 : Print
LWORK=LWORK+4000
Inc N
Until LPATTERN
'---> Converts song
Print : Print "Converting song..."
TST=0 : Gosub S_CONV
'---> Converts instruments
Print : Print "Converting instruments..."
TST=0 : Gosub I_CONV
' Creates header
AD=Start(10) : A$="AmBk" : Gosub 10100 : Doke AD,3 : Doke AD+2,0 : AD=AD+4
TL=8+16+LINST+LSONG+LPATTERN : Loke AD,$80000000 or TL : AD=AD+4
A$="Music " : Gosub 10100
Loke AD,16 : Loke AD+4,16+LINST : Loke AD+8,16+LINST+LSONG : Loke AD+12,0 : AD=AD+16
' Copy instrument
SAMCOPY[SCOPY,ECOPY,AD+NI*32+2+4]
Copy Start(11),Start(11)+NI*32+2 To AD
Loke AD+2+NI*32,0
' Copy Song
Copy Start(12),Start(12)+LSONG To AD+LINST
' Copy Patterns
Copy Start(13),Start(13)+LPATTERN To AD+LINST+LSONG
'
Clw : ABK$=Fsel$("*.abk","","Save as Amos Music Bank .abk") : If ABK$="" Then Goto AGAIN
Print : Print "Saving AMOS music bank..."
Bsave ABK$,Start(10) To AD+LINST+LSONG+LPATTERN
Print : Print "Job done! Press a key..."
Wait Key : Clw : Goto AGAIN
' Instrument conversion
I_CONV:
AD=Start(10)
NPAT=Leek(AD+240)
LMAX=0
For A=AD+244 To AD+244+NPAT*2 Step 2
LMAX=Max(LMAX,Deek(A))
Next A
LMAX=LMAX+1024 : IOFF=444+LMAX
ADI=AD+IOFF
NI=0
For A=AD To AD+IMAX*16 Step 16
If Leek(A) Then Inc NI
Next
Erase 11 : Reserve As Work 11,NI*32+2+4 : APOK=Start(11)
AOFF=APOK : SDOKE[AOFF,NI] : AOFF=AOFF+2 : AINST=AOFF+NI*32
INUL=AINST : SLOKE[AINST,0] : AINST=AINST+4 : SCOPY=ADI
For AA=AD To AD+IMAX*16 Step 16
A1=Leek(AA) : If A1=0 Then Goto L1155
SLOKE[AOFF,AINST-APOK] : L1=Deek(AA+4) : SDOKE[AOFF+8,L1]
A2=Leek(AA+8)-A1 : L2=Deek(AA+12) : SDOKE[AOFF+10,L2]
If L2=2 Then SLOKE[AOFF+4,INUL-APOK] Else SLOKE[AOFF+4,AINST+A2-APOK]
SDOKE[AOFF+12,Deek(AA+6)]
L=L1*2 : ECOPY=ADI+L
ADI=ADI+L : AINST=AINST+L : A=AOFF+16 : A$=I$ : Gosub 10000 : AOFF=AOFF+32
L1155: Inc N
Next AA
If Btst(0,AINST) Then Inc AINST
LINST=AINST-APOK
Return
' Song conversion
S_CONV:
APOK=0
If TST=0
Erase 12 : Reserve As Work 12,LSONG : APOK=Start(12)
Input "Please enter TEMPO value (1-100, default is 15):";T
End If
AD=Start(10) : AMU=APOK
SDOKE[AMU,1] : AMU=AMU+2
SLOKE[AMU,6] : AMU=AMU+4
If T<=0 or T>100 Then T=15
SDOKE[AMU+8,T]
NPAT=Deek(AD+242) : LPAT=(NPAT+2)*2 : APAT=8+SONGDATA+16
For N=0 To 3 : APAT(N)=AMU+APAT : SDOKE[AMU+N*2,APAT] : APAT=APAT+LPAT : Next N
AMU=AMU+8+SONGDATA
A$=Space$(16) : A=AMU : Gosub 10000 : A$=MU$ : Gosub 10000 : AMU=AMU+16
AMU=AMU+LPAT*4
For A=AD+244 To AD+244+(NPAT-1)*2 Step 2
P=Deek(A)/1024
For V=0 To 3
SDOKE[APAT(V),P] : APAT(V)=APAT(V)+2
Next V
Next A
For V=0 To 3
SDOKE[APAT(V),-2]
Next V
If Btst(0,AMU) Then Inc AMU
LSONG=AMU-APOK
Return
' Pattern conversion
3000 Erase 13 : Reserve As Work 13,LWORK : AMAX=Start(13)+LWORK-512 : Fill Start(13) To Start(13)+Length(13),0
3005 AD=Start(10) : AOFF=Start(13) : NPAT=Deek(AD+242)
3006 MPAT=0 : For A=AD+244 To AD+244+(NPAT-1)*2 Step 2 : MPAT=Max(Deek(A)/1024,MPAT) : Next A : Inc MPAT
3007 Print "Number of different patterns:";MPAT
3010 APAT=AOFF+2+MPAT*8
3015 Doke AOFF,MPAT
3020 For NP=0 To MPAT-1 : PATMAX=64 : NBESS=0 : AAPAT=APAT
3025 For V=0 To 3 : Locate 0,Y Curs : Print "Computing pattern";NP;" - voice";V;
3030 AP=AD+444+NP*1024
3035 Doke AOFF+2+NP*8+V*2,APAT-AOFF
3040 Gosub 3100 : If APAT>AMAX Then LPATTERN=0 : Return
3045 Next V : If PATMAX<>64 and NBESS=0 Then NBESS=1 : APAT=AAPAT : Print : Print "Once again!";PATMAX : Goto 3025
3050 Next NP
3055 LPATTERN=APAT-Start(13)
3060 Return
3100 OI=-1 : VIT=1 : NN=0 : DEL=0 : ADN=0 : VOL=-1
3200 Inc NN : If NN>PATMAX Then 3250
3205 D1=Deek(AP+V*4) : D2=Deek(AP+V*4+2) : AP=AP+16 : Rem print hex$(D1,4);hex$(D2,4)
3210 If(D2 and $F000)=0 Then If DEL+VIT<256 Then FLAG=1 : Gosub 3300 : DEL=DEL+VIT : Goto 3200 Else Stop
3215 Gosub 3400 : DEL=DEL+VIT
3220 I=(D2/$1000)-1 : If OI<>I Then OI=I : Doke APAT,I_INST+I : APAT=APAT+2 : VOL=-1
3225 FLAG=0 : Gosub 3300
3230 Doke APAT,$7F00 : Doke APAT+2,D1 : ADN=APAT : APAT=APAT+4
3235 Goto 3200
3250 Gosub 3400
3255 Doke APAT,I_END : APAT=APAT+2 : Return
3300 EFFECT=(D2 and $F00)/$100 : PRAM=D2 and $FF
3305 If EFFECT>0 and EFFECT<9 Then Gosub 3450+EFFECT*50 : APAT=APAT+2
3310 Return
3400 If DEL=0 Then Return
3405 If ADN=0 and DEL<>0 Then Doke APAT,$7F00+DEL : Doke APAT+2,0 : APAT=APAT+4
3410 If ADN<>0 Then Poke ADN+1,DEL
3415 ADN=0 : DEL=0 : Return
3500 If FLAG Then Gosub 3400
3505 Doke APAT,I_SLUP+PRAM : Return
3550 If FLAG Then Gosub 3400
3555 Doke APAT,I_SLDOWN+PRAM : Return
3600 If FLAG Then Gosub 3400
3605 If VOL<>PRAM Then If OI>=0 Then Doke APAT,I_SVOL+PRAM : VOL=PRAM : Return
3610 APAT=APAT-2 : Return
3650 Stop : PATMAX=NN : Return
3700 Stop : Return
3750 Doke APAT,I_LEDM : Return
3800 Doke APAT,I_LEDA : Return
3850 Doke APAT,I_TEMPO+(100/PRAM) : Return
'
10000 For X=0 To Len(A$)-1
10005 SPOKE[A+X,Asc(Mid$(A$,X+1,1))]
10010 Next
10015 Return
10100 A=AD : Gosub 10000 : AD=AD+Len(A$) : Return
Procedure SPOKE[A,B]
If TST=0
Poke A,B
End If
End Proc
Procedure SDOKE[A,B]
If TST=0
Doke A,B
End If
End Proc
Procedure SLOKE[A,B]
If TST=0
Loke A,B
End If
End Proc
Procedure SAMCOPY[S,E,D]
If TST=0
If S mod 2=0 and E mod 2=0 and D mod 2=0
Copy S,E To D
Else
Print "Slow Copying Sample"
A=0
While A+S<E
Poke D+A,Peek(S+A)
Inc A
Wend
Print "Done."
End If
End If
End Proc