home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AMOS PD CD
/
amospdcd.iso
/
sourcecode
/
subroutines
/
sample-editor.amos
/
sample-editor.amosSourceCode
< prev
Wrap
AMOS Source Code
|
1991-05-14
|
15KB
|
498 lines
Unpack 1 To 0
Paper 0 : Flash Off : Curs Off : Pen 2 : Led Off
Print " "
Global F$,T$,CSTART,CLENGTH,CFREQ,OSTART,OLENGTH,OFREQ,BUFSTART,BUFLENGTH,FLOOP
NZONES=47 : Reserve Zone NZONES
Writing 1
DEFZONES
Repeat
FILELOAD
Until F$<>""
STATS
Limit Mouse
Do
Repeat
Repeat
If(Inkey$<>"") and(F$<>"") Then Sam Raw 15,CSTART,CLENGTH,CFREQ
Until Mouse Key=1
ZN=Mouse Zone
Until ZN>0 and ZN<=NZONES
If ZN=1 and BUFLENGTH<>0 Then Sam Raw 15,BUFSTART,BUFLENGTH,CFREQ
If ZN=2 Then ALTLOOP
If ZN=3 Then NEWSTART
If ZN=4 Then NEWEND
If ZN=5 Then DATMERGE
If ZN=6 Then CUT
If ZN=7 Then TIDY[Dfree]
If ZN=8 Then CSTART=OSTART : CLENGTH=OLENGTH : DISPLAY
If ZN=16 Then FILELOAD
If ZN=17 Then FILESAVE
If ZN=18 Then QUIT
If ZN=19 Then Add CSTART,2,OSTART To(OSTART+OLENGTH)
If ZN=20 Then Add CSTART,-2,OSTART To(OSTART+OLENGTH)
If ZN=21 Then Add CFREQ,1,1000 To 32000
If ZN=22 Then Add CFREQ,100,1000 To 32000
If ZN=23 Then Add CFREQ,-1,1000 To 32000
If ZN=24 Then Add CFREQ,-100,1000 To 32000
If ZN=25 Then DFAULT
If ZN=26 Then Add CSTART,100,OSTART To(OSTART+CLENGTH)
If ZN=27 Then Add CSTART,-100,OSTART To(OSTART+CLENGTH)
If ZN=28 Then DISPLAY
If ZN=29 Then Add CLENGTH,1,257 To OLENGTH
If ZN=30 Then Add CLENGTH,-1,257 To OLENGTH
If ZN=31 Then Add CLENGTH,100,257 To OLENGTH
If ZN=32 Then Add CLENGTH,-100,257 To OLENGTH
If ZN=33 Then COMPRESS
If ZN=34 Then XPAND
If ZN=35 Then DIODE
If ZN=36 Then DATCOPY
If ZN=37 Then VOLPLUS
If ZN=38 Then DISTORT
If ZN=39 Then VCLIP
If ZN=41 Then INSERT
If ZN=43 Then PASTE
If ZN=44 Then VOLMINUS
If ZN=45 Then RVERSE
If ZN=46 Then RING
STATS
Loop
'
Procedure STATS
Wait Vbl : Paper 0 : Ink 2
Locate 4,13 : Print "Sample name: ";Left$(F$+" ",30)
Locate 4, : Print "Type ";T$;" Length ";CLENGTH;" Freq";CFREQ;" Start";CSTART-OSTART;
If BUFLENGTH<>0 Then Print " Buffer";BUFLENGTH;" " Else Print " "
End Proc
'
Procedure FILELOAD
A$=Fsel$("") : If A$="" Then Pop Proc
Open In 1,A$
FLEN=Lof(1)
Close
Erase 2 : Erase 3
Reserve As Chip Data 2,FLEN
Reserve As Chip Data 3,FLEN
Bload A$,Start(2) : Copy Start(2),Start(2)+Length(2) To Start(3)
BODY=Hunt(Start(2) To Start(2)+Length(2),"8SVX")
If BODY<>0 Then BODY=Hunt(Start(2) To Start(2)+Length(2),"BODY")
If BODY=0
CSTART=Start(2)
CLENGTH=FLEN
CFREQ=16000 : OFREQ=16000
Else
CSTART=BODY+8 : OSTART=CSTART
CLENGTH=Leek(BODY+4)
CFREQ=Deek(Start(2)+32) : OFREQ=CFREQ
End If
OLENGTH=CLENGTH
F$=A$
If CSTART=Start(2) Then T$="Raw" Else T$="IFF"
DISPLAY
End Proc
'
Procedure FILESAVE
Bsave Fsel$("",F$,"Save sample in","RAW format"),Start(2) To Start(2)+Length(2)
End Proc
'
Procedure QUIT
For A=2 To 5
Erase A
Next
End
End Proc
'
Procedure DFAULT
CFREQ=OFREQ
Erase 2 : Reserve As Chip Data 2,Length(3)
Copy Start(3),Start(3)+Length(3) To Start(2)
CSTART=Start(2) : CLENGTH=Length(2) : OSTART=CSTART : OLENGTH=CLENGTH
DISPLAY
End Proc
'
Procedure DISPLAY
Cls 0,1,135 To 639,254
ST=CLENGTH/640 : If ST=0 Then Pop Proc
Ink 3,0 : Plot 0,180
For A=CSTART To CSTART+CLENGTH Step ST
P=Peek(A) : If P>127 Then P=P-256
P=P/2
Draw To(A-CSTART)/ST,(P*120)/128+194
Next
End Proc
'
Procedure DEFZONES
Paper 0
Print : Print
Print Zone$(" Load",16);" ";Zone$("Save",17);" ";Zone$("Quit",18);" ";Zone$("Display",28);
Print Zone$(" Freq+",21);" ";Zone$("Freq++",22);" ";Zone$("Freq-",23);" ";Zone$("Freq--",24);" ";Zone$("Reset",25)
Print
Print Zone$(" Start+",19);" ";Zone$("Start-",20);" ";Zone$("Start++",26);" ";Zone$("Start--",27);" ";
Print Zone$("End+",29);" ";Zone$("End-",30);" ";Zone$("End++",31);" ";Zone$("End--",32)
Print
Print " ";Zone$("Compress",33);" ";Zone$("Expand",34);" ";Zone$("Diode",35);" ";Zone$("Copy",36);" ";Zone$("+dB",37);" ";Zone$("Distort",38);" ";Zone$("Clip",39);" ";Zone$("Full",8)
Print
Print " ";Zone$("Reverse",45);" ";Zone$("Insert",41);" ";Zone$("Echo",42);" ";Zone$("Paste",43);" ";Zone$("-dB",44);" ";Zone$("Buffer ",1);" ";Zone$("Ring",46);" ";Zone$("Loop",2)
Print
Print " ";Zone$("Start",3);" ";Zone$("End",4);" ";Zone$("Merge",5);" ";Zone$("Cut",6);" ";Zone$("Tidy",7)
End Proc
'
Procedure COMPRESS
Locate 0,0 : Print "Compress"
Reserve As Data 5,Length(2)/2
For A=0 To Length(2) Step 8
Loke Start(5)+A/2,Leek(A+Start(2))
Next
Erase 2 : Reserve As Chip Data 2,Length(5)
Copy Start(5),Start(5)+Length(5) To Start(2) : Erase 5
CSTART=Start(2) : OSTART=CSTART : CLENGTH=Length(2) : OLENGTH=CLENGTH
Locate 0,0 : Print " "
DISPLAY: CFREQ=CFREQ/2
End Proc
'
Procedure XPAND
If Length(2)>32760
Screen Open 1,320,48,4,Lowres
Paper 1 : Print : Print
Print "Length of expanded sample will be"
Print "too great to play back in one."
Print "Shall I convert anyway? (Y / N)"
Repeat
A$=Upper$(Inkey$)
Until(A$="Y") or(A$="N")
If A$="N"
Pop Proc
End If
End If
Locate 0,0 : Print "Expand"
Reserve As Data 5,Length(2)*2
For A=0 To Length(2) Step 4
Loke Start(5)+A*2,Leek(Start(2)+A)
Loke Start(5)+A*2+4,Leek(Start(2)+A)
Next
Erase 2 : Reserve As Chip Data 2,Length(5)
Copy Start(5),Start(5)+Length(5) To Start(2) : Erase 5
CSTART=Start(2) : OSTART=CSTART : CLENGTH=Length(2) : OLENGTH=CLENGTH
CFREQ=CFREQ*2 : If CFREQ>32000 Then CFREQ=32000
Locate 0,0 : Print " "
End Proc
'
Procedure DIODE
Locate 0,0 : Print "Diode";
For A=CSTART To CSTART+CLENGTH
If Peek(A)>127 Then Poke A,127-(Peek(A) and $7F)
Next
Locate 0,0 : Print " "
End Proc
'
Procedure DATCOPY
If Length(4)<>0
Screen Open 1,320,48,4,Lowres
Paper 1 : Ink 2 : Print : Print
Print "Erase old buffer? (Y / N)"
Repeat
A$=Upper$(Inkey$)
Until(A$="Y") or(A$="N")
If A$="N"
Pop Proc
End If
Erase 4
End If
If Screen=1 Then Screen Close 1
Reserve As Chip Data 4,CLENGTH : BUFSTART=Start(4)
Copy CSTART,CSTART+CLENGTH To BUFSTART
BUFLENGTH=Length(4)
End Proc
'
Procedure VOLPLUS
Locate 0,0 : Print "Vol+"
For A=CSTART To CSTART+CLENGTH
X#=Peek(A)
If X#>127 Then X#=X#-256
X#=X#*1.2 : Y=Int(X#)
If Y<-127 Then Y=-127
If Y>127 Then Y=127
If Y<0 Then Y=Y+256
Poke A,Y
Next
Locate 0,0 : Print " "
End Proc
'
Procedure DISTORT
Limit Mouse X Hard(1),Y Hard(135) To X Hard(319),Y Hard(195)
Screen Open 1,320,48,4,Lowres
Paper 1 : Pen 2 : Repeat : Until Mouse Key=0
Print : Print : Print "Set threshold limits with mouse"
Print "and click either key to fix"
Screen 0 : Gr Writing 2
Ink 1
Repeat
CLEV=195-Y Screen(0,Y Mouse)
Wait Vbl
Draw 1,195-CLEV To 639,195-CLEV
Draw 1,195+CLEV To 639,195+CLEV
Wait Vbl
Draw 1,195-CLEV To 639,195-CLEV
Draw 1,195+CLEV To 639,195+CLEV
Until Mouse Key<>0 : Screen Close 1 : Locate 0,0 : Print "Distort" : Limit Mouse
TH=(CLEV*127)/60
For A=CSTART To CSTART+CLENGTH
NFLAG=False
BYTE=Peek(A) : If BYTE>127 Then BYTE=Abs(BYTE-256) : NFLAG=True
If(BYTE>=TH) and(BYTE<128)
TSTART=A
Repeat
A=A+2
BYTE2=Peek(A)
If BYTE2>127
BYTE2=Abs(BYTE2-256)
End If
Until(BYTE2<TH) or(A>=CSTART+CLENGTH)
If A>=(CSTART+CLENGTH)
Exit
End If
DLENGTH#=A-TSTART : THV#=TH : MP#=DLENGTH#/2 : IC#=127-TH : GR#=IC#/MP#
For B=0 To DLENGTH#/2
THV#=THV#+GR#
If THV#>127
Poke TSTART+B,127
Poke A-B,127
Else
Poke TSTART+B,Int(THV#)
Poke A-B,Int(THV#)
End If
If NFLAG
Poke TSTART+B,256-Peek(TSTART+B)
Poke A-B,256-Peek(A-B)
End If
Next
End If
Next
Locate 0,0 : Print " " : DISPLAY
End Proc
'
Procedure VCLIP
Limit Mouse X Hard(1),Y Hard(135) To X Hard(319),Y Hard(195)
Screen Open 1,320,48,4,Lowres
Paper 1 : Pen 2 : Repeat : Until Mouse Key=0
Print : Print : Print "Set clipping limits with mouse"
Print "and click either key to fix"
Screen 0 : Gr Writing 2
Ink 1
Repeat
CLEV=195-Y Screen(0,Y Mouse)
Wait Vbl
Draw 1,195-CLEV To 639,195-CLEV
Draw 1,195+CLEV To 639,195+CLEV
Wait Vbl
Draw 1,195-CLEV To 639,195-CLEV
Draw 1,195+CLEV To 639,195+CLEV
Until Mouse Key<>0 : Screen Close 1 : Locate 0,0 : Print "Clip"
For A=CSTART To CSTART+CLENGTH
BYTE=Peek(A) : LEV=(CLEV*127)/60
If BYTE<128
If BYTE>LEV
BYTE=LEV
End If
Else
Z=Abs(BYTE-256)
If Z>LEV
Z=-LEV+256
BYTE=Z
End If
End If
Poke A,BYTE
Next : Screen 0 : Limit Mouse
Locate 0,0 : Print " " : Gr Writing 1
DISPLAY
End Proc
'
Procedure INSERT
Reserve As Data 5,OLENGTH+BUFLENGTH
If CSTART=OSTART
Copy BUFSTART,BUFSTART+BUFLENGTH To Start(5)
Copy OSTART,OSTART+OLENGTH To Start(5)+BUFLENGTH
Else
Copy OSTART,CSTART To Start(5)
Copy BUFSTART,BUFSTART+BUFLENGTH To Start(5)+(CSTART-OSTART)
Copy CSTART,CSTART+OLENGTH-(CSTART-OSTART) To Start(5)+BUFLENGTH+(CSTART-OSTART)
End If
Erase 2 : Reserve As Chip Data 2,Length(5)
Copy Start(5),Start(5)+Length(5) To Start(2)
Erase 5 : CSTART=Start(2) : CLENGTH=Length(2) : OSTART=CSTART : OLENGTH=CLENGTH
End Proc
'
Procedure PASTE
If(CSTART+BUFLENGTH)>(OSTART+OLENGTH)
Reserve As Data 5,CSTART+BUFLENGTH-OSTART
Copy OSTART,OSTART+OLENGTH To Start(5)
Copy BUFSTART,BUFSTART+BUFLENGTH To Start(5)+CSTART-OSTART
Erase 2 : Reserve As Chip Data 2,Length(5)
CSTART=Start(2) : OSTART=CSTART : CLENGTH=Length(2) : OLENGTH=CLENGTH
Copy Start(5),Start(5)+Length(5) To Start(2) : Erase 5
Else
Copy BUFSTART,BUFSTART+BUFLENGTH To CSTART
' CSTART=Start(2) : OSTART=CSTART : CLENGTH=Length(2) : OLENGTH=CLENGTH
End If
End Proc
'
Procedure VOLMINUS
Locate 0,0 : Print "Vol-"
For A=CSTART To CSTART+CLENGTH
X#=Peek(A)
If X#>127 Then X#=X#-256
X#=X#*0.8 : Y=Int(X#)
If Y<0 Then Y=Y+256
Poke A,Y
Next
Locate 0,0 : Print " "
End Proc
'
Procedure RVERSE
Locate 0,0 : Print "Reverse"
For A=0 To CLENGTH/2
BYTE1=Peek(CSTART+A)
BYTE2=Peek(CSTART+CLENGTH-A)
Poke CSTART+A,BYTE2
Poke CSTART+CLENGTH-A,BYTE1
Next
Locate 0,0 : Print " " : DISPLAY
End Proc
'
Procedure RING
Screen Open 1,320,48,4,Lowres
Screen Display 1,,210,,
Pen 2 : Paper 0 : Flash Off : Colour 3,$6F2
Repeat
Cls 1 : NEG=0 : Paper 1
Print : Print "Enter modulation frequency in 1 - 100Hz"
Pen 3 : Input ":";FR
Until FR>=1 and FR<=100
Screen Close 1 : Locate 0,0 : Print "Ring"
INF=CFREQ/FR/2 : Rem i.f. frequency!
COUNTER=0 : FLAG=True
For A=CSTART To CSTART+CLENGTH Step 4
If COUNTER>INF Then COUNTER=0 : FLAG= Not(FLAG)
If Not(FLAG) Then Loke A,0
Add COUNTER,4
Next : Locate 0,0 : Print " "
DISPLAY
End Proc
'
Procedure ALTLOOP
If FLOOP Then Sam Loop Off : Ink 1 : Paint 532,71 Else Sam Loop On : Ink 5 : Paint 532,71
FLOOP= Not(FLOOP)
End Proc
'
Procedure NEWSTART
Limit Mouse X Hard(1),Y Hard(135) To X Hard(638),Y Hard(195)
Screen Open 1,320,48,4,Lowres
Paper 1 : Pen 2 : Repeat : Until Mouse Key=0
Print : Print : Print "Set new start point with mouse"
Print "and click either key to fix"
Screen 0 : Gr Writing 2
Ink 1
Repeat
X#=X Screen(0,X Mouse)
Wait Vbl
Draw X#,136 To X#,253
Wait Vbl
Draw X#,136 To X#,253
Until Mouse Key<>0 : Screen Close 1
Screen 0 : Limit Mouse
Gr Writing 1
N=CSTART+CLENGTH
FR#=X#/640 : CL#=CLENGTH : CL#=CL#*FR# : C=Int(CL#) : CSTART=CSTART+C
CLENGTH=N-CSTART
DISPLAY
End Proc
'
Procedure NEWEND
Limit Mouse X Hard(1),Y Hard(135) To X Hard(638),Y Hard(195)
Screen Open 1,320,48,4,Lowres
Paper 1 : Pen 2 : Repeat : Until Mouse Key=0
Print : Print : Print "Set new end point with mouse"
Print "and click either key to fix"
Screen 0 : Gr Writing 2
Ink 1
Repeat
X#=X Screen(0,X Mouse)
Wait Vbl
Draw X#,136 To X#,253
Wait Vbl
Draw X#,136 To X#,253
Until Mouse Key<>0 : Screen Close 1
Screen 0 : Limit Mouse
Gr Writing 1
FR#=X#/640 : CL#=CLENGTH : CL#=CL#*FR# : CLENGTH=Int(CL#)
DISPLAY
End Proc
'
Procedure DATMERGE
Locate 0,0 : Print "Merge"
If(CSTART+BUFLENGTH)>(OSTART+OLENGTH)
Reserve As Data 5,CSTART+BUFLENGTH-OSTART
Copy OSTART,OSTART+OLENGTH To Start(5) : RSTART=CSTART-OSTART
For A=0 To BUFLENGTH
BYTE1=Peek(Start(5)+A+RSTART)
If BYTE1>127
Add BYTE1,-256
End If
BYTE2=Peek(BUFSTART+A)
If BYTE2>127
Add BYTE2,-256
End If
Add BYTE3,BYTE1/2+BYTE2/2
If BYTE3<0
Add BYTE3,256
End If
Poke Start(5)+RSTART+A,BYTE3
Next
Erase 2 : Reserve As Chip Data 2,Length(5)
CSTART=Start(2) : OSTART=CSTART : CLENGTH=Length(2) : OLENGTH=CLENGTH
Copy Start(5),Start(5)+Length(5) To Start(2) : Erase 5
Else
For A=0 To BUFLENGTH
BYTE1=Peek(CSTART+A)
If BYTE1>127
Add BYTE1,-256
End If
BYTE2=Peek(BUFSTART+A)
If BYTE2>127
Add BYTE2,-256
End If
BYTE3=BYTE1/2+BYTE2/2
If BYTE3<0
Add BYTE3,256
End If
Poke CSTART+A,BYTE3
Next
End If
Locate 0,0 : Print " "
End Proc
'
Procedure CUT
If(OSTART+OLENGTH)=(CSTART+CLENGTH) Then Pop Proc
NSTART=CSTART+CLENGTH
Copy NSTART,OLENGTH+OSTART To CSTART
CSTART=OSTART
End Proc
'
Procedure TIDY[A]
T=Length(2)+Length(3)+Length(4)
If T>A
Screen Open 1,320,48,4,Lowres
Paper 1 : Print : Print
Print "Not enough scratch space available"
Print "on current disk. Insert another"
Print "and try again!!!" : Wait 150
Pop Proc
End If
Bsave "b2",Start(2) To Start(2)+Length(2)
Bsave "b3",Start(3) To Start(3)+Length(3)
Bsave "b4",Start(4) To Start(4)+Length(4)
For A=2 To 5 : Erase A : Next
Bload "b2",2
Bload "b3",3
Bload "b4",4
Kill "b2" : Kill "b3" : Kill "b4"
End Proc