home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 28
/
amigaformatcd28.iso
/
-seriously_amiga-
/
programming
/
amos
/
lipsynclab
/
lsl1.amos
/
lsl1.amosSourceCode
< prev
next >
Wrap
AMOS Source Code
|
1998-04-23
|
25KB
|
661 lines
' Lip Sync Lab 1, �1992 Steve Tiffany
' a disastrous attempt at building speech out of sampled phonemes
' (but kinda cool)
Set Buffer 13
Proc SETUP
Do
If Mouse Click=1 Then Proc CLICKHANDLER
K$=Inkey$ : If Key State(76)=True Then Proc ARROWUP
If Key State(77)=True Then Proc ARROWDOWN
Loop
Procedure SETUP
Shared SPEECHMARK,OFFSET,ACTIVELINE,FILELENGTH,WORD$,VOL$,PHON$,PHCODE$,PITCH$,MOUTH$,WATE$
Screen Open 0,640,200,8,Hires
Flash Off
' Load Iff "df0:LipSyncLab.pic" : Curs Off
' Spack 0 To 7 : Wait 200 : Edit
Unpack 7 To 0 : Curs Off : Wind Save
' Load "work:amos/TinyLips6.Abk" : '
No Mask
' Load "work:amos/samples/ArpaST24.Abk"
Open Random 1,"ram:phonData.LSL"
Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
FILELENGTH=Lof(1)/35 : OFFSET=1 : SPEECHMARK=1
Limit Mouse 129,50 To 448,155
If FILELENGTH=0
Restore WELCOME
For J=1 To 18
Read WORD$,VOL,PHON$,PHCODE,PITCH,MOUTH,WATE
VOL$=Str$(VOL)-" " : PHCODE$=Str$(PHCODE)-" " : PITCH$=Str$(PITCH)-" "
MOUTH$=Str$(MOUTH)-" " : WATE$=Str$(WATE)-" "
Put 1,J
Next J
FILELENGTH=Lof(1)/35
Proc GRIDUPDATE
For J=1 To FILELENGTH
Get 1,J : MOUTH=Val(MOUTH$) : PHCODE=Val(PHCODE$)
PITCH=Val(PITCH$) : WATE=Val(WATE$)
Paste Bob 557,2,MOUTH
Sam Play 3,PHCODE,PITCH : Wait WATE
Next J
Pop Proc
End If
Proc GRIDUPDATE
Pop Proc
WELCOME:
Data "Welcome",63,"W",15,24000,3,8,"",63,"EH",27,25750,2,8,"",45,"L",8,24000,1,9
Data "",45,"K",3,24000,1,5,"",45,"UH",42,24000,1,8,"",39,"M",13,24000,4,11
Data "to",42,"T",29,24000,1,5,"",35,"UW",41,23150,3,9,"Lip",63,"L",8,24000,1,9
Data "",63,"IH",32,24000,2,12,"",22,"P",9,24000,4,5,"Sync",41,"S",19,24000,1,5
Data "",59,"IH",32,24000,2,5,"",37,"NG",4,24000,1,7,"",41,"K",3,24000,1,5
Data "Lab",63,"L",8,24000,1,7,"",43,"AE",22,24000,2,16,"",21,"B",1,24000,4,9
End Proc
Procedure CLICKHANDLER
Shared SPEECHMARK,OFFSET,ACTIVELINE,FILELENGTH,WORD$,VOL$,PHON$,PHCODE$,PITCH$,MOUTH$,WATE$
XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
If XM>415 Then Gosub SBOXESRIGHT : Pop Proc
If YM>55 and YM<63 Then Gosub ACTIVEBAR
If YM>73 Then Proc ARROWDOWN : Wait 10 : While Mouse Key=1 : Proc ARROWDOWN : Wend : Pop Proc
If YM>15 and YM<45 Then Proc ARROWUP : Wait 10 : While Mouse Key=1 : Proc ARROWUP : Wend
Pop Proc
SBOXESRIGHT:
If XM>625 Then Pop Proc
If YM<55 Then Gosub SBOXTOP : Pop Proc
If YM<65 Then Gosub DELETELINE : Pop Proc
If XM<537 Then Pop Proc : Rem: LipSyncLab logo selected
If YM<75 Then Gosub ENTERTEXT : Pop Proc
If YM<85 Then Gosub FILELOAD : Pop Proc
If YM<95 Then Gosub FILESAVE : Pop Proc
QUITIT:
' EX=Exist("ram:phonData.LSL2") : If EX Then Kill "ram:phonData.LSL2"
Close 1 : Edit : Rem: quit box selected
SBOXTOP:
If XM<457 Then Gosub ARROWSTOP : Pop Proc
If YM<20 Then Gosub SPLAYALL : Pop Proc
If YM<34 Then Gosub SPLAYFROMHERE : Pop Proc
If YM<45 Then Gosub WORDPLAY : Pop Proc
Gosub INSERTLINE : Pop Proc
SPLAYALL:
For SPEECHMARK=1 To FILELENGTH
Get 1,SPEECHMARK
VOL=Val(VOL$) : PHCODE=Val(PHCODE$) : PITCH=Val(PITCH$) :
MOUTH=Val(MOUTH$) : WATE=Val(WATE$)
Paste Bob 557,2,MOUTH
Volume VOL : Sam Play 3,PHCODE,PITCH : Wait WATE
If Mouse Click=1 Then OFFSET=-(SPEECHMARK-7) : Proc GRIDUPDATE : Pop Proc
Next SPEECHMARK
Paste Bob 557,2,4
Pop Proc
SPLAYFROMHERE:
If SPEECHMARK<FILELENGTH Then Inc SPEECHMARK
If SPEECHMARK>FILELENGTH Then Dec SPEECHMARK
If SPEECHMARK=0 Then Inc SPEECHMARK
For SPEECHMARK2=ACTIVELINE To FILELENGTH
Get 1,SPEECHMARK2
VOL=Val(VOL$) : PHCODE=Val(PHCODE$) : PITCH=Val(PITCH$) :
MOUTH=Val(MOUTH$) : WATE=Val(WATE$)
Paste Bob 557,2,MOUTH
Volume VOL : Sam Play 3,PHCODE,PITCH : Wait WATE
If Mouse Click=1 Then OFFSET=-(SPEECHMARK2-7) : SPEECHMARK=SPEECHMARK2 : Proc GRIDUPDATE : Pop Proc
Next SPEECHMARK2
Paste Bob 557,2,4
Pop Proc
INSERTLINE:
For J=FILELENGTH To ACTIVELINE Step -1
Get 1,J
Put 1,J+1
Next J
WORD$="" : VOL$="45" : PHON$="QX" : PHCODE$="45" : PITCH$="24000" : MOUTH$="4" : WATE$="6"
Put 1,ACTIVELINE :
If ACTIVELINE=FILELENGTH Then Dec OFFSET
FILELENGTH=Lof(1)/35 : Proc GRIDUPDATE
Pop Proc
ARROWSTOP:
If YM<20 Then Gosub SSTOP : Pop Proc
If YM<37 Then Proc ARROWUP : Wait 10 : While Mouse Key=1 : Proc ARROWUP : Wend : Pop Proc
Proc ARROWDOWN : Wait 10 : While Mouse Key=1 : Proc ARROWDOWN : Wend : Pop Proc
SSTOP:
Pop Proc
DELETELINE:
If ACTIVELINE=FILELENGTH
WORD$="" : VOL$="" : PHON$="" : PITCH$="" : MOUTH$="" : WATE$=""
Put 1,ACTIVELINE : Gosub RAMSWITCHEROO
Proc GRIDUPDATE : Pop Proc
End If
For J=ACTIVELINE To(FILELENGTH-1)
Get 1,J+1
Put 1,J
Next J
WORD$="" : VOL$="" : PHON$="" : PITCH$="" : MOUTH$="" : WATE$=""
Put 1,J : Gosub RAMSWITCHEROO
Proc GRIDUPDATE
Pop Proc
RAMSWITCHEROO:
Open Random 2,"ram:phonData.LSL2"
Field 2,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
For J=1 To(FILELENGTH-1)
Get 1,J
Put 2,J
Next J
Close 2 : Close 1 : Kill "ram:phonData.LSL" :
Rename "ram:phonData.LSL2" To "ram:phonData.LSL"
Open Random 1,"ram:phonData.LSL"
Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
FILELENGTH=Lof(1)/35
Return
ENTERTEXT:
' give them a way out if they want to keep what they were working on...
Pen 7 : Paper 2
Locate 2,2 : Print "Enter text in box ";
Locate 2,3 : Print "below. When you hit";
Locate 2,4 : Print "`Return' it will ";
Locate 2,5 : Print "attempt to translate";
Locate 2,6 : Print "your text into a ";
Locate 2,7 : Print "bank of phonemes. ";
Locate 2,8 : Print " ";
Locate 2,9 : Print "If you're here by ";
Locate 2,10 : Print "mistake, hit the ";
Locate 2,11 : Print "`Return' key without";
Locate 2,12 : Print "typing anything. ";
Wind Open 1,0,107,78,11,2 : Border 2,7,3
Pen 0 : Paper 7 : Clw :
Line Input "";SENT$
If SENT$="" Then Wind Close : Proc GRIDUPDATE : Pop Proc
Proc TRANSLATE[SENT$]
Open Random 1,"ram:phonData.LSL"
Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
FILELENGTH=Lof(1)/35 : OFFSET=1
Wind Close : Proc GRIDUPDATE
Return
FILELOAD:
F$=Fsel$("*.asc","","Load ASCII Data statement file.")
If F$="" Then Pop Proc
EX=Exist("ram:phonData.LSL2") : If EX Then Kill "ram:phonData.LSL2"
' the Rename is so you can restore the data if the load fails...
Close 1 : Rename "ram:phonData.LSL" To "ram:phonData.LSL2"
Open Random 1,"ram:phonData.LSL"
Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
Open In 2,F$ : COUNT=1 : OFFSET=1
On Error Goto PROBLEMO
Repeat
Input #2,WORD$,VOL,PHCODE,PITCH,MOUTH,WATE
If Left$(WORD$,5)="Data "
WORDLENGTH=Len(WORD$)-7 : WORD$=Mid$(WORD$,7,WORDLENGTH)
Else
WORDLENGTH=Len(WORD$)-2 : WORD$=Mid$(WORD$,2,WORDLENGTH)
End If
VOL$=Str$(VOL)-" "
Restore FILELOADDATA
For J=1 To PHCODE
Read PHON$
Next J
PHCODE$=Str$(PHCODE)-" "
PITCH$=Str$(PITCH)-" " : MOUTH$=Str$(MOUTH)-" " : WATE$=Str$(WATE)-" "
Put 1,COUNT : Inc COUNT
Until Eof(2)
Close 2 : FILELENGTH=Lof(1)/35 : Proc GRIDUPDATE
EX=Exist("ram:phonData.LSL2") : If EX Then Kill "ram:phonData.LSL2"
On Error
Pop Proc
FILELOADDATA:
Data "B","F","K","NG","DH","BL","G","L","P","V","CH","H","M","R"
Data "W","D","J","N","S","WH","EY","AE","AX","SH","Y"
Data "IY","EH","ER ","T ","ZH ","AY ","IH ","IX ","TH","Z"
Data "OW","AA","OH","AW","OY","UW","AH","UH","AO","QX"
PROBLEMO:
Close 2
Close 1 : Kill "ram:phonData.LSL" :
Rename "ram:phonData.LSL2" To "ram:phonData.LSL"
Open Random 1,"ram:phonData.LSL"
Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
Boom : Pen 1 : Paper 2
Locate 2,3 : Print "Can't load file! ";
Locate 2,4 : Print "Try a different one."; : Wait 200
Proc GRIDUPDATE
Resume FILELOAD
FILESAVE:
F$=Fsel$("*.asc","","Save as Data statements","in mergeable ASCII.")
If F$="" Then Pop Proc
Open Out 2,F$
Print #2,"Data "; : RETFLAG=0
Gosub COMPACTPRINT
Close 2
Pop Proc
COMPACTPRINT:
For J=1 To FILELENGTH
Get 1,J : WORDLENGTH=20
While Mid$(WORD$,WORDLENGTH,1)=" " and WORDLENGTH>0 : Dec WORDLENGTH : Wend
WORD$=Left$(WORD$,WORDLENGTH)
WORDLENGTH=3
While Mid$(PHON$,WORDLENGTH,1)=" " and WORDLENGTH>0 : Dec WORDLENGTH : Wend
PHON$=Left$(PHON$,WORDLENGTH)
Print #2,Chr$(34);WORD$;Chr$(34);",";
Print #2,Val(VOL$);",";
Print #2,Val(PHCODE$);",";Val(PITCH$);",";Val(MOUTH$);",";Val(WATE$);
If J=FILELENGTH Then Print #2,"" : Return
If RETFLAG<2 Then Print #2,","; : Inc RETFLAG : Else Print #2,"" : Print #2,"Data "; : RETFLAG=0
Next J
Return
ACTIVEBAR:
If XM<178 Then Gosub WORDBAR : Pop Proc
If XM<240 Then Gosub VOLBAR : Pop Proc
If XM<308 Then Gosub PHONBAR : Pop Proc
If XM<365 Then Gosub PITCHBAR : Pop Proc
Gosub WATEBAR : Pop Proc
WORDBAR:
Get 1,ACTIVELINE
Pen 1 : Paper 2 : Locate 2,3 : Print "Type word to replace";
Pen 7 : Locate 2,4 : Print WORD$; :
Pen 1 : Locate 2,5 : Print "in box below: ";
Pen 7 : Paper 3 : Locate 2,7 : Print " ";
Ink 1 : Box 16,54 To 175,65 :
Locate 2,7 : Input "";WORD$
Put 1,ACTIVELINE
Proc GRIDUPDATE
Pop Proc
VOLBAR:
Pen 1 : Paper 3
Get 1,ACTIVELINE : OLDVOL=Val(VOL$)
While Mouse Key=1
NEWYM=Y Screen(Y Mouse)
VOL=OLDVOL-((NEWYM-YM)/2) : If VOL>63 Then VOL=63
If VOL<0 Then VOL=0
Locate 25,7 : Print Using "##";VOL;
Wend
VOL$=Str$(VOL)-" "
Put 1,ACTIVELINE
Gosub WORDPLAY
Pop Proc
PHONBAR:
Get 1,ACTIVELINE :
Locate 2,3 : Print "Pick a phoneme! "
Limit Mouse 129,155 To 448,249
Wait 10
While Mouse Click=0 : Wend
XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) :
ICONCOLNUM=Int((XM-2)/128)+1
ICONROWNUM=Int((YM-106)/10)
ICONID=ICONCOLNUM+(ICONROWNUM*5)
Restore PHONBAR2
For J=1 To ICONID
Read PHON$,MOUTH,WATE
Next J
PHCODE$=Str$(ICONID)-" " : MOUTH$=Str$(MOUTH)-" " : WATE$=Str$(WATE)-" "
If Val(VOL$)<2 Then VOL$="45" : PITCH$="24000" : MOUTH$="1" : WATE$=" 6"
Put 1,ACTIVELINE : If ACTIVELINE=FILELENGTH Then Dec OFFSET
Proc GRIDUPDATE
Limit Mouse 129,50 To 448,155
Gosub WORDPLAY
Pop Proc
'note: wate$ and mouth$ should be custom. Add to the Data statements
PHONBAR2:
Data "B",4,5,"F",6,5,"K",1,5,"NG",2,5,"DH",1,5,"BL",4,5
Data "G",1,5,"L",1,5,"P",4,5,"V",6,5,"CH",5,5,"H",3,5
Data "M",4,5,"R",3,5,"W",3,5,"D",5,5,"J",5,5,"N",1,5
Data "S",1,5,"WH",3,5,"EY",2,5,"AE",2,5,"AX",2,5
Data "SH",5,5,"Y",5,5,"IY",2,5,"EH",2,5,"ER",3,5
Data "T",1,5,"ZH",1,5,"AY",2,5,"IH",2,5,"IX",2,5
Data "TH",5,5,"Z",1,5,"OW",3,5,"AA",3,5,"OH",3,5
Data "AW",3,5,"OY",3,5,"UW",3,5,"AH",2,5,"UH",3,5
Data "AO",3,5,"QX",5,5
PITCHBAR:
Pen 1 : Paper 3
Get 1,ACTIVELINE : OLDPITCH=Val(PITCH$)
While Mouse Key=1
NEWYM=Y Screen(Y Mouse)
PITCH=OLDPITCH-((NEWYM-YM)*50) : If PITCH>28000 Then PITCH=28000
If PITCH<10000 Then PITCH=10000
Locate 40,7 : Print Using "#####";PITCH;
Wend
PITCH$=Str$(PITCH)-" "
Put 1,ACTIVELINE
Gosub WORDPLAY
' maybe play the word w/phoneme at the new pitch.
' note: oughta figure out the acceptable pitches and limit it to them.
Pop Proc
WATEBAR:
Pen 1 : Paper 3
Get 1,ACTIVELINE : OLDWATE=Val(WATE$)
While Mouse Key=1
NEWYM=Y Screen(Y Mouse)
WATE=OLDWATE-((NEWYM-YM)/4) : If WATE>99 Then WATE=99
If WATE<1 Then WATE=1
Locate 47,7 : Print Using "##";WATE;
Wend
WATE$=Str$(WATE)-" "
Put 1,ACTIVELINE
Gosub WORDPLAY :
If ACTIVELINE<FILELENGTH Then Get 1,(ACTIVELINE+1) : If Left$(WORD$,1)<>" " Then Gosub RECITEWORD
Return
' Plays the word. If it's the last phoneme in the word, plays the next
' word also.
WORDPLAY:
CURRLOC=ACTIVELINE : Gosub WPBACKUP : Gosub RECITEWORD
Return
WPBACKUP:
While CURRLOC>0
Get 1,CURRLOC :
If Left$(WORD$,1)<>" " Then Return
Dec CURRLOC
Wend
Return
RECITEWORD:
Get 1,CURRLOC
While(CURRLOC<=FILELENGTH) or(Left$(WORD$,1)<>" ")
VOL=Val(VOL$) : PHCODE=Val(PHCODE$) : PITCH=Val(PITCH$) :
MOUTH=Val(MOUTH$) : WATE=Val(WATE$)
Paste Bob 557,2,MOUTH
Volume VOL : Sam Play 3,PHCODE,PITCH :
Wait WATE
Inc CURRLOC :
If CURRLOC>FILELENGTH Then Paste Bob 557,2,4 : Return
Get 1,CURRLOC
If(Left$(WORD$,1)<>" ") Then Paste Bob 557,2,4 : Return
Wend
Paste Bob 557,2,4
Return
End Proc
Procedure ARROWUP
Shared OFFSET,BFLAG
If BFLAG=1 Then Dec OFFSET : Dec BFLAG
Inc OFFSET : If OFFSET>6 Then OFFSET=6
Proc GRIDUPDATE
End Proc
Procedure ARROWDOWN
Shared OFFSET
Dec OFFSET
Proc GRIDUPDATE
End Proc
Procedure GRIDUPDATE
Shared SPEECHMARK,OFFSET,ACTIVELINE,FILELENGTH,WORD$,VOL$,PHON$,PITCH$,WATE$,BFLAG
Curs Off
For LOC=2 To 12 : Gosub WRITEACROSS : Next LOC
Pop Proc
WRITEACROSS:
LASTLINE=(LOC-OFFSET) : If LASTLINE<-4 Then Pop Proc : Rem:value to start
ACTIVELINE=LASTLINE-5 :
If LASTLINE=-5 Then Dec OFFSET : ACTIVELINE=1 : LASTLINE=6 : Pop Proc
If LASTLINE>-5 Then WORD$="" : VOL$="" : PHON$="" : PITCH$="" : WATE$=""
If LASTLINE>0 and LASTLINE<=FILELENGTH Then Get 1,LASTLINE
If LASTLINE=FILELENGTH+5 Then BFLAG=1 : Inc OFFSET
Pen 7 : Paper 2 : If LOC=7 Then Pen 1 : Paper 3
Locate 2,LOC : Print Using "~~~~~~~~~~~~~~~~~~~~";WORD$;
Locate 33,LOC : Print Using "~~~";PHON$;
Locate 40,LOC : Print Using "~~~~~";PITCH$;
If VOL$="" : Rem: if it's above or below the actual data lines...
Locate 25,LOC : Print " "; : Locate 47,LOC : Print " ";
Else
Locate 25,LOC : Print Using "##";Val(VOL$);
Locate 47,LOC : Print Using "##";Val(WATE$);
End If
Return
End Proc
Procedure TRANSLATE[SENT$]
SENT$=Lower$(SENT$) : SENTLENGTH=Len(SENT$) : PHLIST$="" : BIG$=""
For POSITION=1 To SENTLENGTH
TESTLET$=Mid$(SENT$,POSITION,1)
If TESTLET$><" " and Asc(TESTLET$)<97 or Asc(TESTLET$)>123 Then TESTLET$=""
If TESTLET$=" " Then Gosub WORDTRANS Else WORD$=WORD$+TESTLET$
Next POSITION
Gosub WORDTRANS
NEWLENGTH=Len(BIG$)-1 : BIG$=Left$(BIG$,NEWLENGTH)
Open Out 3,"ram:trans.seq"
Print #3,BIG$
Close 3
Open In 3,"ram:trans.seq"
'this was added once it was in LSL...
Close 1
EX=Exist("ram:phonData.LSL") : If EX Then Kill "ram:phonData.LSL"
Open Random 1,"ram:phonData.LSL"
Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
COUNT=1
Repeat
Input #3,TEST$ : FIRSTLET=Asc(Left$(TEST$,1)) :
If FIRSTLET<91 : Rem: it's a phoneme
Gosub PHONCOMPARE
PHCODE$=Str$(PHCODE)-" " : MOUTH$=Str$(MOUTH)-" "
WATE$=Str$(WATE)-" " : VOL$="45" : PITCH$="24000"
Put 1,COUNT : Inc COUNT : WORD$=""
Else
WORD$=TEST$
End If
Until Eof(3)
Close 3 : Kill "ram:trans.seq"
Close 1
Pop Proc
PHONCOMPARE:
Restore COMPARE
For J=1 To 45
Read PHON$,PHCODE,MOUTH,WATE
If PHON$=TEST$ Then Return
Next J
Return
COMPARE:
Data "B",1,4,1,"F",2,6,2,"K",3,1,1,"NG",4,2,5,"DH",5,1,3,"BL",6,4,5
Data "G",7,1,2,"L",8,1,6,"P",9,4,1,"V",10,6,3,"CH",11,5,2,"H",12,3,2
Data "M",13,4,4,"R",14,3,3,"W",15,3,2,"D",16,5,1,"J",17,5,2,"N",18,1,4
Data "S",19,1,2,"WH",20,3,2,"EY",21,2,13,"AE",22,2,5,"AX",23,2,3
Data "SH",24,5,3,"Y",25,5,2,"IY",26,2,9,"EH",27,2,5,"ER",28,3,5
Data "T",29,1,1,"ZH",30,1,3,"AY",31,2,9,"IH",32,2,5,"IX",33,2,2
Data "TH",34,5,3,"Z",35,1,3,"OW",36,3,9,"AA",37,3,5,"OH",38,3,4
Data "AW",39,3,9,"OY",40,3,10,"UW",41,3,8,"AH",42,2,5,"UH",43,3,3
Data "AO",44,3,5,"QX",45,5,5
Data "B",1,
WORDTRANS:
WORDLENGTH=Len(WORD$) : HOLDWORD$=WORD$ : PH$=""
Gosub WHOLEWORD
If PH$<>""
PHLIST$=PH$+","+PHLIST$
Goto WORDEND
End If
Gosub LAST4
If PH$<>""
Add WORDLENGTH,-4 : WORD$=Left$(WORD$,WORDLENGTH)
PHLIST$=PH$+","+PHLIST$ : Goto SKIPSUF
End If
Gosub LAST3
If PH$<>""
Add WORDLENGTH,-3 : WORD$=Left$(WORD$,WORDLENGTH)
PHLIST$=PH$+","+PHLIST$ : Goto SKIPSUF
End If
Gosub SUFFIX
If PH$<>""
Add WORDLENGTH,-(SUFFLENGTH) : WORD$=Left$(WORD$,WORDLENGTH)
PHLIST$=PH$+","+PHLIST$
End If
SKIPSUF:
While WORD$<>""
RESET:
Gosub LAST5
If PH$<>""
Add WORDLENGTH,-5 : WORD$=Left$(WORD$,WORDLENGTH)
PHLIST$=PH$+","+PHLIST$ : Goto RESET
End If
Gosub LAST4
If PH$<>""
Add WORDLENGTH,-4 : WORD$=Left$(WORD$,WORDLENGTH)
PHLIST$=PH$+","+PHLIST$ : Goto RESET
End If
Gosub LAST3
If PH$<>""
Add WORDLENGTH,-3 : WORD$=Left$(WORD$,WORDLENGTH)
PHLIST$=PH$+","+PHLIST$ : Goto RESET
End If
Gosub LAST2
If PH$<>""
Add WORDLENGTH,-2 : WORD$=Left$(WORD$,WORDLENGTH)
PHLIST$=PH$+","+PHLIST$ : Goto RESET
End If
Gosub LAST1
If PH$<>""
Dec WORDLENGTH : WORD$=Left$(WORD$,WORDLENGTH)
PHLIST$=PH$+","+PHLIST$
End If
Wend
WORDEND: Rem: Fall-through intended.
If PHLIST$="" Then PHLIST$=PH$
BIG$=BIG$+HOLDWORD$+","+PHLIST$
WORD$="" : PHLIST$=""
Return
WHOLEWORD:
Restore WORDDATA
For J=1 To 68
Read TEST$ : Read PH$
If TEST$=WORD$ Then Return
Next J
PH$="" : Rem: Gosub WORDEND
Return
WORDDATA:
Data "a","AH","although","AO,L,DH,OW","am","EH,M","are","AA,R","be","B,IY"
Data "go","G,OW","have","H,AE,V","he","H,IY","his","H,IH,Z","i","AY"
Data "is","IH,Z","me","M,IY","my","M,AY","of","AH,V","one","W,AH,N"
Data "our","AW,R","said","S,EH,D","the","DH,AH","though","DH,OW","to","T,UW"
Data "was","W,AH,Z","we","W,IY","were","W,ER","you","Y,UW","yours","Y,OH,R,Z"
Data "by","B,AY","she","SH,IY","sky","S,K,AY","red","R,EH,D","bed","B,EH,D"
Data "led","L,EH,D","fed","F,EH,D","wed","W,EH,D","through","TH,R,UW"
Data "now","N,AW","two","T,UW","once","W,AH,N,S","this","DH,IH,S"
Data "dough","D,OW","cries","K,R,AY,Z","dies","D,AY,Z","fries","F,R,AY,Z"
Data "lies","L,AY,Z","pies","P,AY,Z","replies","R,IY,P,L,AY,Z","ties","T,AY,Z"
Data "flies","F,L,AY,Z","eye","AY","eyes","AY,Z","dont","D,OW,N,T"
Data "wont","W,OW,N,T","as","EH,Z","few","F,Y,UW","going","G,OW,IH,NG"
Data "down","D,AW,N","put","P,UH,T","says","S,EH,Z","also","AO,L,S,OW"
Data "why","WH,AY","gone","G,AO,N","has","H,AE,Z","been","B,IH,N"
Data "using","Y,UW,Z,IH,NG","who","H,UW","whos","H,UW,Z","whose","H,UW,Z"
Data "here","H,IY,R","theres","DH,EH,R,Z"
SUFFIX:
PH$="" : WORDLENGTH=Len(WORD$)
Restore SUFFIXDATA
For J=1 To 40
Read SUFFLENGTH : Read SUFFIX$ : Read PH$
If WORDLENGTH<SUFFLENGTH Then SUFFLENGTH=0 : PH$="" : SUFFIX$="-1"
WORDSUFF$=Right$(WORD$,SUFFLENGTH)
If SUFFIX$=WORDSUFF$ Then Return
Next J
PH$=""
Return
'Rem: Note suffix's different format than all the others, with a number
' that stands for the number of letters in SUFFIX$
SUFFIXDATA:
Data 4,"ates","EY,T,S",3,"eed","IY,D",3,"ded","D,IX,D",2,"oo","UW"
Data 5,"zines","Z,IY,N,Z",4,"zine","Z,IY,N",5,"tives","T,IH,V,Z"
Data 4,"tive","T,IH,V",5,"tures","CH,ER,Z",4,"ture","CH,ER",2,"ay","EY"
Data 4,"aces","EY,S,IX,Z",4,"iles","AY,L,Z",4,"urry","ER,IY"
Data 4,"able","EY,B,IX,L",5,"ables","EY,B,IX,L,Z",4,"cies","S,IY,Z"
Data 3,"ies","IY,Z",2,"le","IX,L",3,"les","IX,L,Z",4,"ines","AY,N,Z"
Data 3,"ces","S,IX,Z",5,"tions","SH,AH,N,Z",5,"sions","SH,AH,N,Z"
Data 4,"akes","EY,K,S",4,"aced","EY,S,T",3,"nge","N,J",4,"nges","N,J,IX,Z"
Data 2,"ey","IY"
Data 2,"ed","D",2,"es","IX,Z"
Data 5,"ought","AO,T",2,"to","T,UW",4,"iest","IY,EH,S,T",2,"uy","AY"
Data 1,"o","OW",2,"cy","S,IY",1,"y","IY",3,"all","AO,L",3,"dge","D,J"
LAST5:
PH$="" : WORDLENGTH=Len(WORD$) : If WORDLENGTH<5 Then Return
FIVE$=Right$(WORD$,5)
Restore LAST5DATA
For J=1 To 4
Read FIVELET$ : Read PH$
If FIVELET$=FIVE$ Then Return
Next J
PH$=""
Return
LAST5DATA:
Data "psych","S,AY,K","ation","EY,SH,AH,N","llion","L,Y,AH,N"
Data "aught","AO,T"
LAST4:
PH$="" : WORDLENGTH=Len(WORD$) : If WORDLENGTH<4 Then Return
FOUR$=Right$(WORD$,4)
Restore LAST4DATA
For J=1 To 34
Read FOURLET$ : Read PH$
If FOURLET$=FOUR$ Then Return
Next J
PH$=""
Return
LAST4DATA:
Data "ould","UH,D","ough","AH,F","tion","SH,AH,N","sion","SH,AH,N"
Data "ique","IY,K","full","F,UH,L","tech","T,EH,K","head","H,EH,D"
Data "earn","ER,N","some","S,AH,M","ouse","AW,S","iece","IY,S"
Data "aise","EY,Z","cial","SH,IX,L","augh","AE,F","roll","R,OW,L"
Data "eaut","Y,UW,T","cess","S,EH,S","cuit","K,IH,T","your","Y,OH,R"
Data "agon","EY,G,IX,N","uise","UW,Z","rown","R,AW,N","ruis","R,UW,Z"
Data "uice","UW,S","bear","B,EH,R","ideo","IH,D,IY,OW","cean","SH,AH,N"
Data "eigh","EY","uper","UW,P,ER","tead","T,EH,D","ange","EY,N,J"
Data "tour","T,UW,R","ooze","UW,Z"
LAST3:
PH$="" : WORDLENGTH=Len(WORD$) : If WORDLENGTH<3 Then Return
THREE$=Right$(WORD$,3)
Restore LAST3DATA
For J=1 To 105
Read THREELET$ : Read PH$
If THREELET$=THREE$ Then Return
Next J
PH$=""
Return
LAST3DATA:
Data "abe","EY,B","ace","EY,S","ade","EY,D","afe","EY,F","age","EY,J"
Data "ake","EY,K","ale","EY,L","ame","EY,M","ane","EY,N","ape","EY,P"
Data "are","EY,R","ase","EY,S","ate","EY,T","ave","EY,V","awe","AO"
Data "aze","EY,Z","ffy","F,IY","ggy","G,IY","ppy","P,IY","ssy","S,IY"
Data "ebe","IY,B","eke","IY,K","eme","IY,M","ere","EH,R","ese","IY,Z"
Data "ibe","AY,B","ice","AY,S","ide","AY,D","ife","AY,F","ige","AY,J"
Data "ike","AY,K","ile","AY,L","ime","AY,M","ine","AY,N","ipe","AY,P"
Data "ire","AY,R","ise","AY,S","ite","AY,T","ive","AY,V","ize","AY,Z"
Data "igh","AY","tty","T,IY","zzy","Z,IY","rry","R,IY","cry","K,R,AY"
Data "obe","OW,B","ode","OW,D","oke","OW,K","ole","OW,L","ome","OW,M"
Data "one","OW,N","ope","OW,P","ore","OH,R","ose","OW,Z","ote","OW,T"
Data "ove","AH,V","owe","OW","oze","OW,Z","ful","F,UH,L","old","OW,L,D"
Data "ube","UW,B","uce","UW,S","ude","UW,D","uge","Y,UW,J","uke","Y,UW,K"
Data "ule","UW,L","ume","UW,M","une","UW,N","ure","ER","use","UW,S"
Data "ute","UW,T","eve","IY,V","ald","AO,L,D","eye","AY","any","EH,N,IY"
Data "ook","UH,K","ood","UH,D","ble","B,IX,L","est","EH,S,T","pow","P,AW"
Data "yle","AY,L","nce","N,S","eer","IY,R","oar","OH,R","cer","S,ER"
Data "alk","AO,K","art","AA,R,T","ies","AY,Z","men","M,EH,N","cyc","S,AY,K"
Data "cyb","S,AY,B","cya","S,AY,AE","cir","S,ER","lly","L,IY","ong","AO,NG"
Data "alt","AO,L,T","ear","IY,R","syn","S,IH,N","chr","K,R","ent","EH,N,T"
Data "nse","N,S","son","S,AH,N","ull","UH,L","air","EY,R","ign","AY,N"
LAST2:
PH$="" : WORDLENGTH=Len(WORD$) : If WORDLENGTH<2 Then Return
If WORDLENGTH<2 Then Return
TWO$=Right$(WORD$,2)
Restore LAST2DATA
For J=1 To 67
Read TWOLET$ : Read PH$
If TWOLET$=TWO$ Then Return
Next J
PH$=""
Return
LAST2DATA:
Data "sh","SH","ch","CH","th","TH","ng","NG","ea","IY","er","ER","ir","ER"
Data "ur","ER","oa","OW","wh","WH","ee","IY","oi","OY","oo","UW","ou","AW"
Data "bb","B","cc","K,S","dd","D","ff","F","gg","G","ll","L","mm","M"
Data "nn","N","pp","P","qu","K,W","rr","R","ss","S","tt","T","vv","V"
Data "ww","W","xx","K,S","zz","Z","ck","K","ai","EY","ie","IY","io","IY,OW"
Data "or","OH,R","ew","UW","au","AO","aw","AO","ow","OW","xc","K,S"
Data "dy","D,IY","ky","K,IY","my","M,IY","ny","N,IY","ly","L,IY","sy","Z,IY"
Data "ty","T,IY","vy","V,IY","zy","Z,IY","ry","R,IY","ay","EY","ia","IY,AE"
Data "ey","IY","fy","F,AY","ei","IY","ue","UW","ce","S,EH","cy","S,IH"
Data "ar","AA,R","ci","S,IH","wr","R","ph","F","en","EH,N","uy","AY"
Data "dg","D,J"
LAST1:
PH$="" : WORDLENGTH=Len(WORD$) : If WORDLENGTH<1 Then Return
If WORDLENGTH<1 Then Return
MONO$=Right$(WORD$,1)
Restore LAST1DATA
For J=1 To 26
Read MONOLET$ : Read PH$
If MONOLET$=MONO$ Then Return
Next J
PH$=""
Return
LAST1DATA:
Data "a","AE","b","B","c","K","d","D","e","EH","f","F","g","G","h","H"
Data "i","IH","j","J","k","K","l","L","m","M","n","N","o","AA","p","P"
Data "q","K","r","R","s","S","t","T","u","AH","v","V","w","W","x","K,S"
Data "y","Y","z","Z"
End Proc