home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 28
/
amigaformatcd28.iso
/
-seriously_amiga-
/
programming
/
amos
/
lipsynclab
/
lipsynclab2.amos
/
lipsynclab2.amosSourceCode
< prev
next >
Wrap
AMOS Source Code
|
1998-04-23
|
17KB
|
585 lines
' LipSyncLab2, � 1998 Steve Tiffany
' It's a tool to assign mouth bobs & Wait times to sampled speech...
' Writes a file in RAM called SampleMouthData.asc in this format:
' _FILENAME: Data SampleLength,NUMMOUTHS,MouthBob,Wait,MouthBob,Wait, etc.
' You merge that file into your program.
'Important! Change value of CURRDIR$ to reflect actual location of this program.
' It's set at the top of the Globals... You may eventually want to
' change value of SAMDIR$, in Procedure SETUP, to reflect where you
' store your samples. Set PROJFREQ below if using raw samples.
Dim MOUTHBOB(200)
Dim XOVER(200)
Dim MN$(70)
Dim DIAL$(8)
Global CURRDIR$,PROJFREQ
CURRDIR$="work:LipSyncLab/"
PROJFREQ=13982 : Rem : (only need to change PROJFREQ if working with raw samples)
Global MOUTHBOB()
Global XOVER()
Global CUWAIT#,CUWAIT
Global SXINTERVAL#,SXINTERVAL
Global HIGHLIGHTEDX1,HIGHLIGHTEDX2
Global ICONCOLNUM
Global MN$(),NMN
Global YMN,MNDOWN,BPIC
Global DIAL$()
Global XINF,YINF,SXINF,SYINF
Global MX,MY,MZ,MK
Global C0,C1,C2,C3,C4,C5,C6,C7,CA,CNA,ACT
Global BLOC
Global ALERT
Global CHANGED
Global CUNAME$,CUFREQ,CULEN,CUSTART,CUEND
Global XWAVE,YWAVE,SXWAVE,SYWAVE
Global XSTART,XEND
Global BCU
Global CURRNAME$,SAMDIR$
Global SLOWFLAG,MOUTHWAIT
COM$=Command Line$
C0=6 : C1=6 : C2=2 : C3=7 : C4=3 : C5=4 : C6=4 : C7=1
BCU=65502
BPIC=65500 :
MNDOWN=39
N=20 : Repeat : N=N+1 : Read MN$(N) : Until MN$(N)="End" : NMN=N-1 :
Data " 02384016064052_GSAM"," 03384068064052_PSAM"
Data "/ 04624016000000_SL"," 05624104016008_DN"," 06624112016008_UP"
Data "/ 99000016000000_SSt","/ 99192016000000_SEnd"
Data "/ 99448032176088_BNAME"
Data "/ 07000120000000"
Data " 09000136128008_3plus"," 10000144128008_2Plus"," 32000152128008_1Plus"," 11000160000000"," 33000176128008_1Minus"," 1200018412808_2Minus"," 13000192128008_3Minus"
Data " 14128136016016_STM"," 15144136016016_STP"," 16160136000000"
Data " 34128152016016_ENM"," 35144152016016_ENP"," 36160152000000"
Data " 17128168128032_Hear"
Data " 18256136064032_SLoad"
Data " 19320136064032_SSave"
Data " 20256168064032_SName"
Data " 21320168064032_SClr"
Data " 22448136064032_BLoad"
Data " 23512136064032_BSave"
Data " 24576136064032_BSavas"
Data " 25448168064032_BClr"
Data " 26512168064032_BIns"
Data " 27576168064032_BDel"
Data " 28384136000000"
Data " 29000000000000"," 30384000064016_MNQUIT"," 31448000000000"
Data "End"
DIAL$(1)="Free chip:"
DIAL$(2)="Free fast:"
DIAL$(3)=">>> Loading IFF sample <<<"
DIAL$(4)=">>> Loading raw data <<<"
DIAL$(5)="Error while accessing disc."
DIAL$(6)="Warning, low memory state!"
DIAL$(7)="Out of memory."
DIAL$(8)=": cannot load more samples."
Global LMBANK
LMBANK=65501
Proc SETUP
Do
If Mouse Click=1 Then Proc CLICKHANDLER
Loop
Procedure CLICKHANDLER
XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
If XM<1 Then XM=1
If XM>640 Then XM=640
If XM>575 and YM>182 Then Proc QUITIT : Rem : User selected "QUIT"
If XM<448 and YM>115 : Rem : Clicked on Mouth #,pic,sounds column...
If SXINTERVAL#=0 : Pop Proc : End If
MOUTHNUM=((XM+1)/64)+1
MOUTHBOB(ICONCOLNUM)=MOUTHNUM
MN$=Str$(MOUTHNUM)-" "
Ink 2 : Text XOVER(ICONCOLNUM),110,MN$
If MOUTHNUM>0 : Paste Bob 158,0,MOUTHNUM : End If
End If
'Box 0,37 To 638,102 : Rem:65 is y centerline?
If YM>37 and YM<70 : SLOWFLAG=1 : _PLAYSAMPLE : End If
If YM>69 and YM<102 : _PLAYSAMPLE : End If
If YM<32
If XM<221
If YM<12 and XM<157 : SLOWFLAG=1 : End If
Proc _PLAYSAMPLE
End If
If XM>529 : Proc _LOADNEXTSAMPLE : End If
If XM>409 and XM<530 and YM<14 : SLOWFLAG=1 : Proc _PLAYSAMPLE : End If
End If
If YM>101 and YM<113 : Rem : It's on the Mouth Number bar...
If SXINTERVAL#=0 : Pop Proc : End If
Ink 1 : Box HIGHLIGHTEDX1,102 To HIGHLIGHTEDX2,113
YM#=YM : XM#=XM : SENSITIVITY=6 : Ink 2,3
ICONCOLNUM#=((XM#-2)/SXINTERVAL#)+1 : ICONCOLNUM=Int(ICONCOLNUM#)
If ICONCOLNUM<1 : ICONCOLNUM=1 : End If
HIGHLIGHTEDX1=XOVER(ICONCOLNUM) : HIGHLIGHTEDX2=XOVER(ICONCOLNUM+1)
If HIGHLIGHTEDX2=0 : HIGHLIGHTEDX2=639 : End If
Ink 5 : Box HIGHLIGHTEDX1,102 To HIGHLIGHTEDX2,113 : Ink 2
YM=YM+MOUTHBOB(ICONCOLNUM)*SENSITIVITY
While Mouse Key=1
NEWYM=Y Screen(Y Mouse)
MOUTHNUM=-(NEWYM-YM)/SENSITIVITY :
If MOUTHNUM>7 : MOUTHNUM=7 : End If
If MOUTHNUM<0 : MOUTHNUM=0 : End If
MN$=Str$(MOUTHNUM)-" "
If MN$="0" : MN$=" " : End If
Text XOVER(ICONCOLNUM),110,MN$
If MOUTHNUM>0 : Paste Bob 158,0,MOUTHNUM : End If
MOUTHBOB(ICONCOLNUM)=MOUTHNUM
Wend
End If
End Proc
Procedure _LOADNEXTSAMPLE
Proc ROUTINEAPPEND
For J=1 To 200 : MOUTHBOB(J)=0 : XOVER(J)=0 : Next J
Ink 1 : Box 0,102 To 639,113 : Ink 3 : Bar 1,103 To 638,112
' F$=Fsel$("work:misc/am3/phrases28000/*")
F$=Fsel$(SAMDIR$)
If F$<>""
_LOAD_CSAM[F$]
_DISPLAY_WAVE
End If
SAMDIR$=Dir$
SLOWFLAG=0
End Proc
Procedure _PLAYSAMPLE
If CUEND-CUSTART<513 Then Pop Proc
Gr Writing 3
If SLOWFLAG=1 Then CUFREQ=PROJFREQ/2 : MOUTHWAIT=2
Sam Raw 3,Start(BCU)+CUSTART,Max(512,CUEND-CUSTART),CUFREQ
For J=1 To CUWAIT
Draw XOVER(J),38 To XOVER(J),101
CURRBOB=MOUTHBOB(J)
If CURRBOB=0
Wait MOUTHWAIT
Else
Paste Bob 158,0,CURRBOB : Wait MOUTHWAIT
End If
Draw XOVER(J),38 To XOVER(J),101
Next J
Gr Writing 1 : CUFREQ=PROJFREQ : SLOWFLAG=0 : MOUTHWAIT=1
Paste Bob 158,0,1
End Proc
Procedure QUITIT
Proc ROUTINEAPPEND
Dir$="Ram:"
Erase BCU : Edit
End Proc
Procedure ROUTINEAPPEND
If CUWAIT=0 Then Pop Proc
If MOUTHBOB(1)=0 Then MOUTHBOB(1)=2
NUMMOUTHS=0
For J=1 To CUWAIT
CURRBOB=MOUTHBOB(J) : If CURRBOB>0 Then Inc NUMMOUTHS
Next J
'now Nummouths is set...
CURRBOBDATA$=","+Str$(MOUTHBOB(1))-" " : CURRBOBWAIT=1
For J=2 To CUWAIT
CURRBOB=MOUTHBOB(J)
If CURRBOB>0
CURRBOBDATA$=CURRBOBDATA$+","+Str$(CURRBOBWAIT)-" "+","+Str$(MOUTHBOB(J))-" "
CURRBOBWAIT=1
Else
Inc CURRBOBWAIT
End If
Next J
CURRBOBDATA$=CURRBOBDATA$+","+Str$(CURRBOBWAIT)-" "
NUMMOUTHS$=Str$(NUMMOUTHS)-" "
Append 1,"ram:SampleMouthData.asc"
FILENAME$="_"+CURRNAME$+": Data"+Str$(CULEN)+","
Print #1,FILENAME$;
Print #1,NUMMOUTHS$;
Print #1,CURRBOBDATA$
Close 1
End Proc
'**********
Procedure _LOAD_CSAM[N$]
On Error Proc _DISC_ERROR
Resume Label _ERR
_CSAM_CLR : CUNAME$=""
If Chip Free+Fast Free<32*1024
_INFO[">>> "+DIAL$(7)+DIAL$(8)+" <<<"] : ALERT=200 : E=-1
Else
A=1
Do
B=Instr(N$,":",A)
If B=0
B=Instr(N$,"/",A) : If B=0 : Exit : End If
End If
A=B+1
Loop
CURRNAME$=Mid$(N$,A)
Repeat
C$=Mid$(N$,A,1)
If(C$=".") or(C$="") : Exit : End If
CUNAME$=CUNAME$+C$
A=A+1
Until Len(CUNAME$)>=8
Open In 1,N$
A$=Input$(1,12)
If(Left$(A$,4)="FORM") and(Right$(A$,4)="8SVX")
' _INFO[DIAL$(3)]
Do
A$=Input$(1,8)
PCHUNK=Pof(1) : LCHUNK=Leek(Varptr(A$)+4)
If Left$(A$,4)="VHDR"
B$=Input$(1,LCHUNK) : A=Varptr(B$)
CULEN=Leek(A)+Leek(A+4)
CUFREQ=Deek(A+12)
LCHUNK=0
End If
If Left$(A$,4)="NAME"
B$=Input$(1,LCHUNK) : CUNAME$=""
For N=1 To 8
C$=Mid$(B$,N,1) : If(C$<" ") or(C$>Chr$(127)) : C$=" " : End If
CUNAME$=CUNAME$+C$
Next
LCHUNK=0
End If
If Left$(A$,4)="BODY"
Exit
End If
If LCHUNK : Pof(1)=PCHUNK+LCHUNK : End If
Loop
Else : Rem: it's Raw...
' _INFO[DIAL$(4)]
Pof(1)=0 : CULEN=Lof(1) : CUFREQ=PROJFREQ
End If
If CULEN
CULEN=CULEN and $FFFFFFFE
Reserve As Chip Work BCU,CULEN
SZ=CULEN : AC=Start(BCU) : P=0
While P<SZ
L=Min(1024,SZ-P)
A$=Input$(1,L)
Copy Varptr(A$),Varptr(A$)+L To AC+P
P=P+L
Wend
CUSTART=0 : CUEND=CULEN
E=0
End If
End If
Close : Goto _END
_ERR: E=-1 : _CSAM_CLR
_END:
End Proc[E]
Procedure _CSAM_CLR
Sam Stop : Erase BCU
CUNAME$="Empty "
CULEN=0 : CUFREQ=0 : CUSTART=0 : CUEND=0
XSTART=-1 : XEND=-1
CHANGED=0
End Proc
Procedure _DISPLAY_WAVE
CURRLEN=Len(CURRNAME$) : RAW$=Right$(CURRNAME$,3) : RAW$=Upper$(RAW$) :
If RAW$="RAW" Then CURRNAME$=Left$(CURRNAME$,CURRLEN-3)
Pen 2 : Paper 6 : Locate 29,3
Print Using "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~";CURRNAME$
Cls 0,XWAVE,YWAVE-SYWAVE To XWAVE+SXWAVE+1,YWAVE+SYWAVE
XSTART=-1 : XEND=-1
If CULEN
Ink C3,C3 : Draw XWAVE,YWAVE To XWAVE+SXWAVE,YWAVE
AD=Start(BCU)
S=(CULEN*64)/SXWAVE
Plot XWAVE,YWAVE : A=0
Repeat
P=Peek(AD+A/256)
X=XWAVE+((A/256)*SXWAVE)/CULEN
If P<128
Draw To X,YWAVE+(P*SYWAVE)/128
Else
Draw To X,YWAVE+((P-256)*SYWAVE)/128
End If
A=A+S
Until A>CULEN*256
End If
XWAITRESS=Timer
Sam Raw 3,Start(BCU)+CUSTART,Max(512,CUEND-CUSTART),CUFREQ
Repeat
A=Sam Swapped(1) : Multi Wait
Until A=1
NEWTIME=Timer : CUWAIT=NEWTIME-XWAITRESS
' Print : Print "bcu=";BCU,"custart=";CUSTART,"CUEND=";CUEND
' Print CURRNAME$,CULEN,CUFREQ
' Print "cuwait=";CUWAIT
Ink 1
CUWAIT#=CUWAIT
SXINTERVAL#=638/CUWAIT#
For J=1 To CUWAIT
J#=J-1
XOVER=SXINTERVAL#*J#
Draw XOVER,103 To XOVER,112
XOVER(J)=XOVER
Next J
'SXINTERVAL=Int(SXINTERVAL#)
HIGHLIGHTEDX1=XOVER(1) : HIGHLIGHTEDX2=XOVER(2)
Ink 5 : Box HIGHLIGHTEDX1,102 To HIGHLIGHTEDX2,113
Ink 2,3
ICONCOLNUM=1
End Proc
Procedure SETUP
Shared XOFFSET,YOFFSET,SCRNWIDTH,SCRNHEIGHT
Screen Open 0,640,200,8,Hires
SCRNWIDTH=640 : SCRNHEIGHT=200 : Curs Off : Flash Off
Proc SCRNCENTER[640,200,8]
Unpack 6 To 0
Screen Display 0,XOFFSET,YOFFSET,SCRNWIDTH,SCRNHEIGHT
' Curs Off : Flash Off
' Load Iff "work:picture/LSLnew1to7.pic"
' Spack 0 To 6 : End
' Load "work:Amos_Pro/bobs/mouths9_8colorNew.abk" :
No Mask
Open Out 1,"ram:SampleMouthData.asc" : Close 1
XINF=8 : YINF=124 : SXINF=624 : SYINF=8
XWAVE=1 : YWAVE=70 : SXWAVE=637 : SYWAVE=32
MOUTHWAIT=1
Reserve Zone NMN
_CSAM_CLR
' CURRDIR$=Dir$
SAMDIR$=CURRDIR$+"Samples/"
Ink C3,0
End Proc
Procedure _DISPLAY_MN[N,F]
If MN$(N)<>""
If F<0
F=0 : A$=Left$(MN$(N),1) : If(A$>="A") and(A$=<"Z") : F=1 : End If
End If
I=Val(Mid$(MN$(N),3,2))
X=Val(Mid$(MN$(N),5,3)) : Y=Val(Mid$(MN$(N),8,3))+YMN
TX=Val(Mid$(MN$(N),11,3)) : TY=Val(Mid$(MN$(N),14,3))
If I
If F=0
If I<90
_UNPACK[I,X,Y]
Else
G$="_D"+Mid$(Str$(I),2) : Gosub G$
End If
Else
If I<90
_UNPACK[I+MNDOWN,X,Y]
Else
Screen Copy 0,X+2,Y+1,X+TX,Y+TY To 0,X,Y
Cls 0,X+TX-2,Y To X+TX,Y+TY
Cls 0,X,Y+TY-1 To X+TX,Y+TY
End If
End If
If TX<>0 : Print "SetZone ";N,X,Y;"To";X+TX,Y+TY : End If
If TX<>0 : Set Zone N,X,Y To X+TX,Y+TY : End If
End If
End If
Pop Proc
_D99: Return
End Proc
Procedure _UNPACK[N,X,Y]
Global BPIC
A=Start(BPIC)+Deek(Start(BPIC)+2*(N-1))
Unpack A,X,Y
End Proc
Procedure _MOUSE
Multi Wait
MX=X Screen(X Mouse) : MY=Y Screen(Y Mouse) : MZ=Zone(MS,MX,MY)
MK=Mouse Key : If MK>3 : MK=3 : End If
End Proc
Procedure _WAIT_NOMK
If FWT
Wait FWT : FWT=0
Else
Wait Vbl : While Mouse Key : Wend
End If
End Proc
Procedure _WAIT_MK
While Inkey$<>"" : Wend
Repeat : _MOUSE : Until Inkey$<>"" or MK<>0
End Proc
Procedure _INFO[A$]
Cls C1,XINF,YINF To XINF+SXINF,YINF+SYINF
Ink C3,C1
If A$=""
A$=DIAL$(1)+Str$(Chip Free)+" - "+DIAL$(2)+Str$(Fast Free)
If Chip Free+Fast Free<32*1024
A$=A$+" - "+DIAL$(6)
End If
End If
Text 320-Len(A$)*4,YINF+6,A$
End Proc
Procedure _DIALOG[A1$,A2$,F]
YY=48 : _UNPACK_DIALOG[YY,4]
Ink C3,C1
If A2$=""
Text 48,YY+22,A1$
Else
Text 48,YY+18,A1$ : Text 48,YY+26,A2$
End If
If F
MN$(1)=" 39528052064032" : _DISPLAY_MN[1,0]
Else
MN$(1)=" 37464052064032" : MN$(2)=" 38528052064032" : _DISPLAY_MN[1,0] : _DISPLAY_MN[2,0]
End If
Wait 20 : _WAIT_NOMK
Do
_MOUSE
If MK=1 and MZ>0 and MZ<3
_DISPLAY_MN[MZ,1] : _WAIT_NOMK : _DISPLAY_MN[MZ,0] : R=2-MZ : Exit
End If
Loop
Reset Zone 1 : Reset Zone 2
_ERASE_DIALOG
End Proc[R]
Procedure _UNPACK_DIALOG[Y,N]
Get Block 1,16,Y-2,624,Y+N*8+9 : BLOC=1
Cls 0,30,Y-1 To 610,Y+N*8+9
_UNPACK[29,32,Y]
Screen Copy 0,48,Y,384+32,Y+16 To 0,240,Y
If N>1
Screen Copy 0,32,Y+12,608,Y+16 To 0,32,Y+4+N*8
For NN=1 To N
Screen Copy 0,32,Y+4,608,Y+12 To 0,32,Y-4+NN*8
Next
End If
Locate 3,Y/8+1
End Proc[Y]
Procedure _ERASE_DIALOG
If BLOC : Put Block 1 : Del Block 1 : BLOC=0 : End If
End Proc
Procedure _DISC_ERROR
Close : Bell : _DIALOG[DIAL$(5),"",1]
Resume Label
End Proc
Procedure SCRNCENTER[SCRNWIDTH,SCRNHEIGHT,NUMCOLORS]
Shared XOFFSET,YOFFSET
' NUMCOLORS=8
'If config file exists, read offsets and use them to center the screen.
'Otherwise, ask user to center the screen, take those offsets and write
'them to a new config file in the user's S: directory or ram:...
'Determine correct config file name...
If SCRNWIDTH=320 or SCRNWIDTH=640
If SCRNHEIGHT=200 or SCRNHEIGHT=400
FILE$="AmosXyOffsetNTSC.config"
Else If SCRNHEIGHT=256 or SCRNHEIGHT=512
FILE$="AmosXyOffsetPAL.config"
End If
Else If SCRNWIDTH=352 or SCRNWIDTH=704
If SCRNHEIGHT=240 or SCRNHEIGHT=480
FILE$="AmosXyOverscanNTSC.config"
Else If SCRNHEIGHT=290 or SCRNHEIGHT=566
FILE$="AmosXyOverscanPAL.config"
End If
End If
'Check for permanent config file...
SFILE$="S:"+FILE$
If Exist(SFILE$)
Open In 1,SFILE$
Input #1,XOFFSET,YOFFSET
Close 1 : Pop Proc
End If
'If no permanent config file, check Ram: for temporary one...
RFILE$="Ram:"+FILE$
If Exist(RFILE$)
Open In 1,RFILE$
Input #1,XOFFSET,YOFFSET
Close 1 : Pop Proc
End If
'If neither exists, ask user to center screen...
CENTERIT:
Pen 1 : Paper 0 : Cls 0 : Colour 1,$EEE : Hide
Box 0,0 To SCRNWIDTH-1,SCRNHEIGHT-1
Box 0,2 To SCRNWIDTH-1,SCRNHEIGHT-3
Box 0,4 To SCRNWIDTH-1,SCRNHEIGHT-5
Locate ,10 : Centre "Center screen with mouse. "
If SCRNWIDTH=352 or SCRNWIDTH=704
Print
Print : Centre "Try to show a single white line "
Print : Centre "around each edge of the screen. "
End If
Print
Print : Centre "Then click the left mouse button."
Paper 1 : Pen 2
CENTERIT2:
X Mouse=190 : Y Mouse=30 : Wait 10
While Mouse Click<>1 :
XOFFSET=X Mouse-88 : YOFFSET=Y Mouse-80
Gosub CUTXOFFSET
Screen Display 0,XOFFSET,YOFFSET,SCRNWIDTH,SCRNHEIGHT
Wend
'Ask user where to write config file...
Cls 0,1,5 To SCRNWIDTH-2,SCRNHEIGHT-6 : Ink 1 : Gr Writing 0
Text 19,22,"Save centering offsets permanently."
Text 45,36,"(Write 11-byte file to S:)"
Text 19,70,"Save centering offsets temporarily."
Text 40,84,"(Write 11-byte file to Ram:)"
Text 67,126,"Proceed without saving."
Text 90,173,"Re-center screen." : Box 0,0 To 319,50
Box 0,50 To 319,100 : Box 0,100 To 319,150 : Box 0,150 To 319,199
Show On : Gr Writing 1
'Get user's response...
PICKIT:
While Mouse Click=0 : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : Wend
If X>319 or Y>199
Goto PICKIT
End If
If Y<50
Open Out 1,SFILE$
Print #1,XOFFSET : Print #1,YOFFSET
Close 1 :
Screen Close 0 : Screen Open 0,SCRNWIDTH,SCRNHEIGHT,NUMCOLORS,Hires
Flash Off : Curs Off : Cls 0 : Pop Proc
End If
If Y<100
Open Out 1,RFILE$
Print #1,XOFFSET : Print #1,YOFFSET
Close 1 :
Cls 0 : Pop Proc
End If
If Y<150
Screen Close 0 : Screen Open 0,SCRNWIDTH,SCRNHEIGHT,NUMCOLORS,Hires
Flash Off : Curs Off : Cls 0 : Pop Proc
End If
Goto CENTERIT2
CUTXOFFSET:
If XOFFSET<80 Then XOFFSET=64 : Return
If XOFFSET<96 Then XOFFSET=80 : Return
If XOFFSET<112 Then XOFFSET=96 : Return
If XOFFSET<128 Then XOFFSET=112 : Return
If XOFFSET<144 Then XOFFSET=128
Return
End Proc