home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 28 / amigaformatcd28.iso / -seriously_amiga- / programming / amos / lipsynclab / lsl1.amos / lsl1.amosSourceCode < prev    next >
AMOS Source Code  |  1998-04-23  |  25KB  |  661 lines
  1. ' Lip Sync Lab 1, ï¿½1992 Steve Tiffany
  2. ' a disastrous attempt at building speech out of sampled phonemes  
  3. ' (but kinda cool)     
  4.  
  5. Set Buffer 13
  6. Proc SETUP
  7.  
  8. Do 
  9.    If Mouse Click=1 Then Proc CLICKHANDLER
  10.    K$=Inkey$ : If Key State(76)=True Then Proc ARROWUP
  11.    If Key State(77)=True Then Proc ARROWDOWN
  12. Loop 
  13.  
  14. Procedure SETUP
  15.    Shared SPEECHMARK,OFFSET,ACTIVELINE,FILELENGTH,WORD$,VOL$,PHON$,PHCODE$,PITCH$,MOUTH$,WATE$
  16.    Screen Open 0,640,200,8,Hires
  17.    Flash Off 
  18. '   Load Iff "df0:LipSyncLab.pic" : Curs Off 
  19. '   Spack 0 To 7 : Wait 200 : Edit 
  20.    Unpack 7 To 0 : Curs Off : Wind Save 
  21. '   Load "work:amos/TinyLips6.Abk" : ' 
  22.    No Mask 
  23. '   Load "work:amos/samples/ArpaST24.Abk"
  24.    Open Random 1,"ram:phonData.LSL"
  25.    Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
  26.    FILELENGTH=Lof(1)/35 : OFFSET=1 : SPEECHMARK=1
  27.    Limit Mouse 129,50 To 448,155
  28.    If FILELENGTH=0
  29.       Restore WELCOME
  30.       For J=1 To 18
  31.          Read WORD$,VOL,PHON$,PHCODE,PITCH,MOUTH,WATE
  32.          VOL$=Str$(VOL)-" " : PHCODE$=Str$(PHCODE)-" " : PITCH$=Str$(PITCH)-" "
  33.          MOUTH$=Str$(MOUTH)-" " : WATE$=Str$(WATE)-" "
  34.          Put 1,J
  35.       Next J
  36.       FILELENGTH=Lof(1)/35
  37.       Proc GRIDUPDATE
  38.       For J=1 To FILELENGTH
  39.          Get 1,J : MOUTH=Val(MOUTH$) : PHCODE=Val(PHCODE$)
  40.          PITCH=Val(PITCH$) : WATE=Val(WATE$)
  41.          Paste Bob 557,2,MOUTH
  42.          Sam Play 3,PHCODE,PITCH : Wait WATE
  43.       Next J
  44.       Pop Proc
  45.    End If 
  46.    Proc GRIDUPDATE
  47.    Pop Proc
  48. WELCOME:
  49. Data "Welcome",63,"W",15,24000,3,8,"",63,"EH",27,25750,2,8,"",45,"L",8,24000,1,9
  50. Data "",45,"K",3,24000,1,5,"",45,"UH",42,24000,1,8,"",39,"M",13,24000,4,11
  51. Data "to",42,"T",29,24000,1,5,"",35,"UW",41,23150,3,9,"Lip",63,"L",8,24000,1,9
  52. Data "",63,"IH",32,24000,2,12,"",22,"P",9,24000,4,5,"Sync",41,"S",19,24000,1,5
  53. Data "",59,"IH",32,24000,2,5,"",37,"NG",4,24000,1,7,"",41,"K",3,24000,1,5
  54. Data "Lab",63,"L",8,24000,1,7,"",43,"AE",22,24000,2,16,"",21,"B",1,24000,4,9
  55. End Proc
  56. Procedure CLICKHANDLER
  57.    Shared SPEECHMARK,OFFSET,ACTIVELINE,FILELENGTH,WORD$,VOL$,PHON$,PHCODE$,PITCH$,MOUTH$,WATE$
  58.    XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  59.    If XM>415 Then Gosub SBOXESRIGHT : Pop Proc
  60.    If YM>55 and YM<63 Then Gosub ACTIVEBAR
  61.    If YM>73 Then Proc ARROWDOWN : Wait 10 : While Mouse Key=1 : Proc ARROWDOWN : Wend : Pop Proc
  62.    If YM>15 and YM<45 Then Proc ARROWUP : Wait 10 : While Mouse Key=1 : Proc ARROWUP : Wend 
  63.    Pop Proc
  64. SBOXESRIGHT:
  65.    If XM>625 Then Pop Proc
  66.    If YM<55 Then Gosub SBOXTOP : Pop Proc
  67.    If YM<65 Then Gosub DELETELINE : Pop Proc
  68.    If XM<537 Then Pop Proc : Rem: LipSyncLab logo selected
  69.    If YM<75 Then Gosub ENTERTEXT : Pop Proc
  70.    If YM<85 Then Gosub FILELOAD : Pop Proc
  71.    If YM<95 Then Gosub FILESAVE : Pop Proc
  72. QUITIT:
  73. '   EX=Exist("ram:phonData.LSL2") : If EX Then Kill "ram:phonData.LSL2"
  74.    Close 1 : Edit : Rem: quit box selected 
  75. SBOXTOP:
  76.    If XM<457 Then Gosub ARROWSTOP : Pop Proc
  77.    If YM<20 Then Gosub SPLAYALL : Pop Proc
  78.    If YM<34 Then Gosub SPLAYFROMHERE : Pop Proc
  79.    If YM<45 Then Gosub WORDPLAY : Pop Proc
  80.    Gosub INSERTLINE : Pop Proc
  81. SPLAYALL:
  82.    For SPEECHMARK=1 To FILELENGTH
  83.       Get 1,SPEECHMARK
  84.       VOL=Val(VOL$) : PHCODE=Val(PHCODE$) : PITCH=Val(PITCH$) : 
  85.       MOUTH=Val(MOUTH$) : WATE=Val(WATE$)
  86.       Paste Bob 557,2,MOUTH
  87.       Volume VOL : Sam Play 3,PHCODE,PITCH : Wait WATE
  88.       If Mouse Click=1 Then OFFSET=-(SPEECHMARK-7) : Proc GRIDUPDATE : Pop Proc
  89.    Next SPEECHMARK
  90.    Paste Bob 557,2,4
  91.    Pop Proc
  92. SPLAYFROMHERE:
  93.    If SPEECHMARK<FILELENGTH Then Inc SPEECHMARK
  94.    If SPEECHMARK>FILELENGTH Then Dec SPEECHMARK
  95.    If SPEECHMARK=0 Then Inc SPEECHMARK
  96.    For SPEECHMARK2=ACTIVELINE To FILELENGTH
  97.       Get 1,SPEECHMARK2
  98.       VOL=Val(VOL$) : PHCODE=Val(PHCODE$) : PITCH=Val(PITCH$) : 
  99.       MOUTH=Val(MOUTH$) : WATE=Val(WATE$)
  100.       Paste Bob 557,2,MOUTH
  101.       Volume VOL : Sam Play 3,PHCODE,PITCH : Wait WATE
  102.       If Mouse Click=1 Then OFFSET=-(SPEECHMARK2-7) : SPEECHMARK=SPEECHMARK2 : Proc GRIDUPDATE : Pop Proc
  103.    Next SPEECHMARK2
  104.    Paste Bob 557,2,4
  105.    Pop Proc
  106. INSERTLINE:
  107.    For J=FILELENGTH To ACTIVELINE Step -1
  108.       Get 1,J
  109.       Put 1,J+1
  110.    Next J
  111.    WORD$="" : VOL$="45" : PHON$="QX" : PHCODE$="45" : PITCH$="24000" : MOUTH$="4" : WATE$="6"
  112.    Put 1,ACTIVELINE : 
  113.    If ACTIVELINE=FILELENGTH Then Dec OFFSET
  114.    FILELENGTH=Lof(1)/35 : Proc GRIDUPDATE
  115.    Pop Proc
  116. ARROWSTOP:
  117.    If YM<20 Then Gosub SSTOP : Pop Proc
  118.    If YM<37 Then Proc ARROWUP : Wait 10 : While Mouse Key=1 : Proc ARROWUP : Wend : Pop Proc
  119.   Proc ARROWDOWN : Wait 10 : While Mouse Key=1 : Proc ARROWDOWN : Wend : Pop Proc
  120. SSTOP:
  121.    Pop Proc
  122. DELETELINE:
  123.    If ACTIVELINE=FILELENGTH
  124.       WORD$="" : VOL$="" : PHON$="" : PITCH$="" : MOUTH$="" : WATE$=""
  125.       Put 1,ACTIVELINE : Gosub RAMSWITCHEROO
  126.       Proc GRIDUPDATE : Pop Proc
  127.    End If 
  128.    For J=ACTIVELINE To(FILELENGTH-1)
  129.       Get 1,J+1
  130.       Put 1,J
  131.    Next J
  132.    WORD$="" : VOL$="" : PHON$="" : PITCH$="" : MOUTH$="" : WATE$=""
  133.    Put 1,J : Gosub RAMSWITCHEROO
  134.    Proc GRIDUPDATE
  135.    Pop Proc
  136. RAMSWITCHEROO:
  137.    Open Random 2,"ram:phonData.LSL2"
  138.    Field 2,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
  139.    For J=1 To(FILELENGTH-1)
  140.       Get 1,J
  141.       Put 2,J
  142.    Next J
  143.    Close 2 : Close 1 : Kill "ram:phonData.LSL" : 
  144.    Rename "ram:phonData.LSL2" To "ram:phonData.LSL"
  145.    Open Random 1,"ram:phonData.LSL"
  146.    Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
  147.    FILELENGTH=Lof(1)/35
  148.    Return 
  149. ENTERTEXT:
  150. '  give them a way out if they want to keep what they were working on... 
  151.    Pen 7 : Paper 2
  152.    Locate 2,2 : Print "Enter text in box   ";
  153.    Locate 2,3 : Print "below.  When you hit";
  154.    Locate 2,4 : Print "`Return' it will    ";
  155.    Locate 2,5 : Print "attempt to translate";
  156.    Locate 2,6 : Print "your text into a    ";
  157.    Locate 2,7 : Print "bank of phonemes.   ";
  158.    Locate 2,8 : Print "                    ";
  159.    Locate 2,9 : Print "If you're here by   ";
  160.    Locate 2,10 : Print "mistake, hit the    ";
  161.    Locate 2,11 : Print "`Return' key without";
  162.    Locate 2,12 : Print "typing anything.    ";
  163.    Wind Open 1,0,107,78,11,2 : Border 2,7,3
  164.    Pen 0 : Paper 7 : Clw : 
  165.    Line Input "";SENT$
  166.    If SENT$="" Then Wind Close : Proc GRIDUPDATE : Pop Proc
  167.    Proc TRANSLATE[SENT$]
  168.    Open Random 1,"ram:phonData.LSL"
  169.    Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
  170.    FILELENGTH=Lof(1)/35 : OFFSET=1
  171.    Wind Close : Proc GRIDUPDATE
  172.    Return 
  173. FILELOAD:
  174.    F$=Fsel$("*.asc","","Load ASCII Data statement file.")
  175.    If F$="" Then Pop Proc
  176.    EX=Exist("ram:phonData.LSL2") : If EX Then Kill "ram:phonData.LSL2"
  177. '  the Rename is so you can restore the data if the load fails...
  178.    Close 1 : Rename "ram:phonData.LSL" To "ram:phonData.LSL2"
  179.    Open Random 1,"ram:phonData.LSL"
  180.    Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
  181.    Open In 2,F$ : COUNT=1 : OFFSET=1
  182.    On Error Goto PROBLEMO
  183.    Repeat 
  184.       Input #2,WORD$,VOL,PHCODE,PITCH,MOUTH,WATE
  185.       If Left$(WORD$,5)="Data "
  186.          WORDLENGTH=Len(WORD$)-7 : WORD$=Mid$(WORD$,7,WORDLENGTH)
  187.       Else 
  188.          WORDLENGTH=Len(WORD$)-2 : WORD$=Mid$(WORD$,2,WORDLENGTH)
  189.       End If 
  190.       VOL$=Str$(VOL)-" "
  191.       Restore FILELOADDATA
  192.       For J=1 To PHCODE
  193.          Read PHON$
  194.       Next J
  195.       PHCODE$=Str$(PHCODE)-" "
  196.       PITCH$=Str$(PITCH)-" " : MOUTH$=Str$(MOUTH)-" " : WATE$=Str$(WATE)-" "
  197.       Put 1,COUNT : Inc COUNT
  198.    Until Eof(2)
  199.    Close 2 : FILELENGTH=Lof(1)/35 : Proc GRIDUPDATE
  200.    EX=Exist("ram:phonData.LSL2") : If EX Then Kill "ram:phonData.LSL2"
  201.    On Error 
  202.    Pop Proc
  203. FILELOADDATA:
  204. Data "B","F","K","NG","DH","BL","G","L","P","V","CH","H","M","R"
  205. Data "W","D","J","N","S","WH","EY","AE","AX","SH","Y"
  206. Data "IY","EH","ER ","T ","ZH ","AY ","IH ","IX ","TH","Z"
  207. Data "OW","AA","OH","AW","OY","UW","AH","UH","AO","QX"
  208. PROBLEMO:
  209.    Close 2
  210.    Close 1 : Kill "ram:phonData.LSL" : 
  211.    Rename "ram:phonData.LSL2" To "ram:phonData.LSL"
  212.    Open Random 1,"ram:phonData.LSL"
  213.    Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
  214.    Boom : Pen 1 : Paper 2
  215.    Locate 2,3 : Print "Can't load file!    ";
  216.    Locate 2,4 : Print "Try a different one."; : Wait 200
  217.    Proc GRIDUPDATE
  218.    Resume FILELOAD
  219. FILESAVE:
  220.    F$=Fsel$("*.asc","","Save as Data statements","in mergeable ASCII.")
  221.    If F$="" Then Pop Proc
  222.    Open Out 2,F$
  223.    Print #2,"Data "; : RETFLAG=0
  224.    Gosub COMPACTPRINT
  225.    Close 2
  226.    Pop Proc
  227. COMPACTPRINT:
  228.    For J=1 To FILELENGTH
  229.       Get 1,J : WORDLENGTH=20
  230.       While Mid$(WORD$,WORDLENGTH,1)=" " and WORDLENGTH>0 : Dec WORDLENGTH : Wend 
  231.       WORD$=Left$(WORD$,WORDLENGTH)
  232.       WORDLENGTH=3
  233.       While Mid$(PHON$,WORDLENGTH,1)=" " and WORDLENGTH>0 : Dec WORDLENGTH : Wend 
  234.       PHON$=Left$(PHON$,WORDLENGTH)
  235.       Print #2,Chr$(34);WORD$;Chr$(34);",";
  236.       Print #2,Val(VOL$);",";
  237.       Print #2,Val(PHCODE$);",";Val(PITCH$);",";Val(MOUTH$);",";Val(WATE$);
  238.       If J=FILELENGTH Then Print #2,"" : Return 
  239.       If RETFLAG<2 Then Print #2,","; : Inc RETFLAG : Else Print #2,"" : Print #2,"Data "; : RETFLAG=0
  240.    Next J
  241.    Return 
  242. ACTIVEBAR:
  243.    If XM<178 Then Gosub WORDBAR : Pop Proc
  244.    If XM<240 Then Gosub VOLBAR : Pop Proc
  245.    If XM<308 Then Gosub PHONBAR : Pop Proc
  246.    If XM<365 Then Gosub PITCHBAR : Pop Proc
  247.    Gosub WATEBAR : Pop Proc
  248. WORDBAR:
  249.    Get 1,ACTIVELINE
  250.    Pen 1 : Paper 2 : Locate 2,3 : Print "Type word to replace";
  251.    Pen 7 : Locate 2,4 : Print WORD$; : 
  252.    Pen 1 : Locate 2,5 : Print "in box below:       ";
  253.    Pen 7 : Paper 3 : Locate 2,7 : Print "                    ";
  254.    Ink 1 : Box 16,54 To 175,65 : 
  255.    Locate 2,7 : Input "";WORD$
  256.    Put 1,ACTIVELINE
  257.    Proc GRIDUPDATE
  258.    Pop Proc
  259. VOLBAR:
  260.    Pen 1 : Paper 3
  261.    Get 1,ACTIVELINE : OLDVOL=Val(VOL$)
  262.    While Mouse Key=1
  263.       NEWYM=Y Screen(Y Mouse)
  264.       VOL=OLDVOL-((NEWYM-YM)/2) : If VOL>63 Then VOL=63
  265.       If VOL<0 Then VOL=0
  266.       Locate 25,7 : Print Using "##";VOL;
  267.    Wend 
  268.    VOL$=Str$(VOL)-" "
  269.    Put 1,ACTIVELINE
  270.    Gosub WORDPLAY
  271.    Pop Proc
  272. PHONBAR:
  273.    Get 1,ACTIVELINE : 
  274.    Locate 2,3 : Print "Pick a phoneme!     "
  275.    Limit Mouse 129,155 To 448,249
  276.    Wait 10
  277.    While Mouse Click=0 : Wend 
  278.    XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : 
  279.    ICONCOLNUM=Int((XM-2)/128)+1
  280.    ICONROWNUM=Int((YM-106)/10)
  281.    ICONID=ICONCOLNUM+(ICONROWNUM*5)
  282.    Restore PHONBAR2
  283.    For J=1 To ICONID
  284.       Read PHON$,MOUTH,WATE
  285.    Next J
  286.    PHCODE$=Str$(ICONID)-" " : MOUTH$=Str$(MOUTH)-" " : WATE$=Str$(WATE)-" "
  287.    If Val(VOL$)<2 Then VOL$="45" : PITCH$="24000" : MOUTH$="1" : WATE$=" 6"
  288.    Put 1,ACTIVELINE : If ACTIVELINE=FILELENGTH Then Dec OFFSET
  289.    Proc GRIDUPDATE
  290.    Limit Mouse 129,50 To 448,155
  291.    Gosub WORDPLAY
  292.    Pop Proc
  293. 'note: wate$ and mouth$ should be custom.  Add to the Data statements
  294. PHONBAR2:
  295. Data "B",4,5,"F",6,5,"K",1,5,"NG",2,5,"DH",1,5,"BL",4,5
  296. Data "G",1,5,"L",1,5,"P",4,5,"V",6,5,"CH",5,5,"H",3,5
  297. Data "M",4,5,"R",3,5,"W",3,5,"D",5,5,"J",5,5,"N",1,5
  298. Data "S",1,5,"WH",3,5,"EY",2,5,"AE",2,5,"AX",2,5
  299. Data "SH",5,5,"Y",5,5,"IY",2,5,"EH",2,5,"ER",3,5
  300. Data "T",1,5,"ZH",1,5,"AY",2,5,"IH",2,5,"IX",2,5
  301. Data "TH",5,5,"Z",1,5,"OW",3,5,"AA",3,5,"OH",3,5
  302. Data "AW",3,5,"OY",3,5,"UW",3,5,"AH",2,5,"UH",3,5
  303. Data "AO",3,5,"QX",5,5
  304.  
  305. PITCHBAR:
  306.    Pen 1 : Paper 3
  307.    Get 1,ACTIVELINE : OLDPITCH=Val(PITCH$)
  308.    While Mouse Key=1
  309.       NEWYM=Y Screen(Y Mouse)
  310.       PITCH=OLDPITCH-((NEWYM-YM)*50) : If PITCH>28000 Then PITCH=28000
  311.       If PITCH<10000 Then PITCH=10000
  312.       Locate 40,7 : Print Using "#####";PITCH;
  313.    Wend 
  314.    PITCH$=Str$(PITCH)-" "
  315.    Put 1,ACTIVELINE
  316.    Gosub WORDPLAY
  317. '    maybe play the word w/phoneme at the new pitch. 
  318. '    note: oughta figure out the acceptable pitches and limit it to them.  
  319.    Pop Proc
  320. WATEBAR:
  321.    Pen 1 : Paper 3
  322.    Get 1,ACTIVELINE : OLDWATE=Val(WATE$)
  323.    While Mouse Key=1
  324.       NEWYM=Y Screen(Y Mouse)
  325.       WATE=OLDWATE-((NEWYM-YM)/4) : If WATE>99 Then WATE=99
  326.       If WATE<1 Then WATE=1
  327.       Locate 47,7 : Print Using "##";WATE;
  328.    Wend 
  329.    WATE$=Str$(WATE)-" "
  330.    Put 1,ACTIVELINE
  331.    Gosub WORDPLAY : 
  332.    If ACTIVELINE<FILELENGTH Then Get 1,(ACTIVELINE+1) : If Left$(WORD$,1)<>" " Then Gosub RECITEWORD
  333.    Return 
  334. '   Plays the word.  If it's the last phoneme in the word, plays the next  
  335. '   word also. 
  336. WORDPLAY:
  337.    CURRLOC=ACTIVELINE : Gosub WPBACKUP : Gosub RECITEWORD
  338.    Return 
  339. WPBACKUP:
  340.    While CURRLOC>0
  341.       Get 1,CURRLOC : 
  342.       If Left$(WORD$,1)<>" " Then Return 
  343.       Dec CURRLOC
  344.    Wend 
  345.    Return 
  346. RECITEWORD:
  347.    Get 1,CURRLOC
  348.    While(CURRLOC<=FILELENGTH) or(Left$(WORD$,1)<>" ")
  349.       VOL=Val(VOL$) : PHCODE=Val(PHCODE$) : PITCH=Val(PITCH$) : 
  350.       MOUTH=Val(MOUTH$) : WATE=Val(WATE$)
  351.       Paste Bob 557,2,MOUTH
  352.       Volume VOL : Sam Play 3,PHCODE,PITCH : 
  353.       Wait WATE
  354.       Inc CURRLOC : 
  355.       If CURRLOC>FILELENGTH Then Paste Bob 557,2,4 : Return 
  356.       Get 1,CURRLOC
  357.       If(Left$(WORD$,1)<>" ") Then Paste Bob 557,2,4 : Return 
  358.    Wend 
  359.    Paste Bob 557,2,4
  360.    Return 
  361. End Proc
  362. Procedure ARROWUP
  363.    Shared OFFSET,BFLAG
  364.    If BFLAG=1 Then Dec OFFSET : Dec BFLAG
  365.    Inc OFFSET : If OFFSET>6 Then OFFSET=6
  366.    Proc GRIDUPDATE
  367.    End Proc
  368. Procedure ARROWDOWN
  369.    Shared OFFSET
  370.    Dec OFFSET
  371.    Proc GRIDUPDATE
  372.    End Proc
  373. Procedure GRIDUPDATE
  374.    Shared SPEECHMARK,OFFSET,ACTIVELINE,FILELENGTH,WORD$,VOL$,PHON$,PITCH$,WATE$,BFLAG
  375.    Curs Off 
  376.    For LOC=2 To 12 : Gosub WRITEACROSS : Next LOC
  377.    Pop Proc
  378. WRITEACROSS:
  379.    LASTLINE=(LOC-OFFSET) : If LASTLINE<-4 Then Pop Proc : Rem:value to start 
  380.    ACTIVELINE=LASTLINE-5 : 
  381.    If LASTLINE=-5 Then Dec OFFSET : ACTIVELINE=1 : LASTLINE=6 : Pop Proc
  382.    If LASTLINE>-5 Then WORD$="" : VOL$="" : PHON$="" : PITCH$="" : WATE$=""
  383.    If LASTLINE>0 and LASTLINE<=FILELENGTH Then Get 1,LASTLINE
  384.    If LASTLINE=FILELENGTH+5 Then BFLAG=1 : Inc OFFSET
  385.    Pen 7 : Paper 2 : If LOC=7 Then Pen 1 : Paper 3
  386.    Locate 2,LOC : Print Using "~~~~~~~~~~~~~~~~~~~~";WORD$;
  387.    Locate 33,LOC : Print Using "~~~";PHON$;
  388.    Locate 40,LOC : Print Using "~~~~~";PITCH$;
  389.    If VOL$="" : Rem: if it's above or below the actual data lines... 
  390.       Locate 25,LOC : Print "  "; : Locate 47,LOC : Print "  ";
  391.    Else 
  392.       Locate 25,LOC : Print Using "##";Val(VOL$);
  393.       Locate 47,LOC : Print Using "##";Val(WATE$);
  394.    End If 
  395.    Return 
  396. End Proc
  397. Procedure TRANSLATE[SENT$]
  398.    SENT$=Lower$(SENT$) : SENTLENGTH=Len(SENT$) : PHLIST$="" : BIG$=""
  399.    For POSITION=1 To SENTLENGTH
  400.       TESTLET$=Mid$(SENT$,POSITION,1)
  401.       If TESTLET$><" " and Asc(TESTLET$)<97 or Asc(TESTLET$)>123 Then TESTLET$=""
  402.       If TESTLET$=" " Then Gosub WORDTRANS Else WORD$=WORD$+TESTLET$
  403.    Next POSITION
  404.    Gosub WORDTRANS
  405.    NEWLENGTH=Len(BIG$)-1 : BIG$=Left$(BIG$,NEWLENGTH)
  406.    Open Out 3,"ram:trans.seq"
  407.    Print #3,BIG$
  408.    Close 3
  409.    Open In 3,"ram:trans.seq"
  410. 'this was added once it was in LSL...
  411. Close 1
  412.    EX=Exist("ram:phonData.LSL") : If EX Then Kill "ram:phonData.LSL"
  413.    Open Random 1,"ram:phonData.LSL"
  414.    Field 1,20 As WORD$,2 As VOL$,3 As PHON$,2 As PHCODE$,5 As PITCH$,1 As MOUTH$,2 As WATE$
  415.    COUNT=1
  416.    Repeat 
  417.       Input #3,TEST$ : FIRSTLET=Asc(Left$(TEST$,1)) : 
  418.       If FIRSTLET<91 : Rem: it's a phoneme
  419.          Gosub PHONCOMPARE
  420.          PHCODE$=Str$(PHCODE)-" " : MOUTH$=Str$(MOUTH)-" "
  421.          WATE$=Str$(WATE)-" " : VOL$="45" : PITCH$="24000"
  422.          Put 1,COUNT : Inc COUNT : WORD$=""
  423.       Else 
  424.          WORD$=TEST$
  425.       End If 
  426.    Until Eof(3)
  427.    Close 3 : Kill "ram:trans.seq"
  428.    Close 1
  429.    Pop Proc
  430. PHONCOMPARE:
  431.    Restore COMPARE
  432.    For J=1 To 45
  433.       Read PHON$,PHCODE,MOUTH,WATE
  434.       If PHON$=TEST$ Then Return 
  435.    Next J
  436.    Return 
  437. COMPARE:
  438. 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
  439. 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
  440. 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
  441. Data "S",19,1,2,"WH",20,3,2,"EY",21,2,13,"AE",22,2,5,"AX",23,2,3
  442. Data "SH",24,5,3,"Y",25,5,2,"IY",26,2,9,"EH",27,2,5,"ER",28,3,5
  443. Data "T",29,1,1,"ZH",30,1,3,"AY",31,2,9,"IH",32,2,5,"IX",33,2,2
  444. Data "TH",34,5,3,"Z",35,1,3,"OW",36,3,9,"AA",37,3,5,"OH",38,3,4
  445. Data "AW",39,3,9,"OY",40,3,10,"UW",41,3,8,"AH",42,2,5,"UH",43,3,3
  446. Data "AO",44,3,5,"QX",45,5,5
  447. Data "B",1,
  448. WORDTRANS:
  449.    WORDLENGTH=Len(WORD$) : HOLDWORD$=WORD$ : PH$=""
  450.    Gosub WHOLEWORD
  451.       If PH$<>""
  452.          PHLIST$=PH$+","+PHLIST$
  453.          Goto WORDEND
  454.       End If 
  455.    Gosub LAST4
  456.       If PH$<>""
  457.          Add WORDLENGTH,-4 : WORD$=Left$(WORD$,WORDLENGTH)
  458.          PHLIST$=PH$+","+PHLIST$ : Goto SKIPSUF
  459.       End If 
  460.    Gosub LAST3
  461.       If PH$<>""
  462.          Add WORDLENGTH,-3 : WORD$=Left$(WORD$,WORDLENGTH)
  463.          PHLIST$=PH$+","+PHLIST$ : Goto SKIPSUF
  464.       End If 
  465.    Gosub SUFFIX
  466.       If PH$<>""
  467.          Add WORDLENGTH,-(SUFFLENGTH) : WORD$=Left$(WORD$,WORDLENGTH)
  468.          PHLIST$=PH$+","+PHLIST$
  469.       End If 
  470.  
  471. SKIPSUF:
  472. While WORD$<>""
  473. RESET:
  474.       Gosub LAST5
  475.          If PH$<>""
  476.             Add WORDLENGTH,-5 : WORD$=Left$(WORD$,WORDLENGTH)
  477.             PHLIST$=PH$+","+PHLIST$ : Goto RESET
  478.          End If 
  479.       Gosub LAST4
  480.          If PH$<>""
  481.             Add WORDLENGTH,-4 : WORD$=Left$(WORD$,WORDLENGTH)
  482.             PHLIST$=PH$+","+PHLIST$ : Goto RESET
  483.          End If 
  484.       Gosub LAST3
  485.          If PH$<>""
  486.             Add WORDLENGTH,-3 : WORD$=Left$(WORD$,WORDLENGTH)
  487.             PHLIST$=PH$+","+PHLIST$ : Goto RESET
  488.          End If 
  489.       Gosub LAST2
  490.          If PH$<>""
  491.             Add WORDLENGTH,-2 : WORD$=Left$(WORD$,WORDLENGTH)
  492.             PHLIST$=PH$+","+PHLIST$ : Goto RESET
  493.          End If 
  494.       Gosub LAST1
  495.          If PH$<>""
  496.             Dec WORDLENGTH : WORD$=Left$(WORD$,WORDLENGTH)
  497.             PHLIST$=PH$+","+PHLIST$
  498.          End If 
  499. Wend 
  500.  
  501. WORDEND: Rem: Fall-through intended.
  502.    If PHLIST$="" Then PHLIST$=PH$
  503.    BIG$=BIG$+HOLDWORD$+","+PHLIST$
  504.    WORD$="" : PHLIST$=""
  505.    Return 
  506. WHOLEWORD:
  507.    Restore WORDDATA
  508.    For J=1 To 68
  509.       Read TEST$ : Read PH$
  510.       If TEST$=WORD$ Then Return 
  511.    Next J
  512.    PH$="" : Rem: Gosub WORDEND 
  513.    Return 
  514. WORDDATA:
  515. Data "a","AH","although","AO,L,DH,OW","am","EH,M","are","AA,R","be","B,IY"
  516. Data "go","G,OW","have","H,AE,V","he","H,IY","his","H,IH,Z","i","AY"
  517. Data "is","IH,Z","me","M,IY","my","M,AY","of","AH,V","one","W,AH,N"
  518. Data "our","AW,R","said","S,EH,D","the","DH,AH","though","DH,OW","to","T,UW"
  519. Data "was","W,AH,Z","we","W,IY","were","W,ER","you","Y,UW","yours","Y,OH,R,Z"
  520. Data "by","B,AY","she","SH,IY","sky","S,K,AY","red","R,EH,D","bed","B,EH,D"
  521. Data "led","L,EH,D","fed","F,EH,D","wed","W,EH,D","through","TH,R,UW"
  522. Data "now","N,AW","two","T,UW","once","W,AH,N,S","this","DH,IH,S"
  523. Data "dough","D,OW","cries","K,R,AY,Z","dies","D,AY,Z","fries","F,R,AY,Z"
  524. Data "lies","L,AY,Z","pies","P,AY,Z","replies","R,IY,P,L,AY,Z","ties","T,AY,Z"
  525. Data "flies","F,L,AY,Z","eye","AY","eyes","AY,Z","dont","D,OW,N,T"
  526. Data "wont","W,OW,N,T","as","EH,Z","few","F,Y,UW","going","G,OW,IH,NG"
  527. Data "down","D,AW,N","put","P,UH,T","says","S,EH,Z","also","AO,L,S,OW"
  528. Data "why","WH,AY","gone","G,AO,N","has","H,AE,Z","been","B,IH,N"
  529. Data "using","Y,UW,Z,IH,NG","who","H,UW","whos","H,UW,Z","whose","H,UW,Z"
  530. Data "here","H,IY,R","theres","DH,EH,R,Z"
  531. SUFFIX:
  532.    PH$="" : WORDLENGTH=Len(WORD$)
  533.    Restore SUFFIXDATA
  534.    For J=1 To 40
  535.       Read SUFFLENGTH : Read SUFFIX$ : Read PH$
  536.       If WORDLENGTH<SUFFLENGTH Then SUFFLENGTH=0 : PH$="" : SUFFIX$="-1"
  537.       WORDSUFF$=Right$(WORD$,SUFFLENGTH)
  538.       If SUFFIX$=WORDSUFF$ Then Return 
  539.    Next J
  540.    PH$=""
  541.    Return 
  542. 'Rem: Note suffix's different format than all the others, with a number    
  543. '     that stands for the number of letters in SUFFIX$ 
  544. SUFFIXDATA:
  545. Data 4,"ates","EY,T,S",3,"eed","IY,D",3,"ded","D,IX,D",2,"oo","UW"
  546. Data 5,"zines","Z,IY,N,Z",4,"zine","Z,IY,N",5,"tives","T,IH,V,Z"
  547. Data 4,"tive","T,IH,V",5,"tures","CH,ER,Z",4,"ture","CH,ER",2,"ay","EY"
  548. Data 4,"aces","EY,S,IX,Z",4,"iles","AY,L,Z",4,"urry","ER,IY"
  549. Data 4,"able","EY,B,IX,L",5,"ables","EY,B,IX,L,Z",4,"cies","S,IY,Z"
  550. Data 3,"ies","IY,Z",2,"le","IX,L",3,"les","IX,L,Z",4,"ines","AY,N,Z"
  551. Data 3,"ces","S,IX,Z",5,"tions","SH,AH,N,Z",5,"sions","SH,AH,N,Z"
  552. Data 4,"akes","EY,K,S",4,"aced","EY,S,T",3,"nge","N,J",4,"nges","N,J,IX,Z"
  553. Data 2,"ey","IY"
  554. Data 2,"ed","D",2,"es","IX,Z"
  555. Data 5,"ought","AO,T",2,"to","T,UW",4,"iest","IY,EH,S,T",2,"uy","AY"
  556. Data 1,"o","OW",2,"cy","S,IY",1,"y","IY",3,"all","AO,L",3,"dge","D,J"
  557. LAST5:
  558.    PH$="" : WORDLENGTH=Len(WORD$) : If WORDLENGTH<5 Then Return 
  559.    FIVE$=Right$(WORD$,5)
  560.    Restore LAST5DATA
  561.    For J=1 To 4
  562.       Read FIVELET$ : Read PH$
  563.       If FIVELET$=FIVE$ Then Return 
  564.    Next J
  565.    PH$=""
  566.    Return 
  567. LAST5DATA:
  568. Data "psych","S,AY,K","ation","EY,SH,AH,N","llion","L,Y,AH,N"
  569. Data "aught","AO,T"
  570. LAST4:
  571.    PH$="" : WORDLENGTH=Len(WORD$) : If WORDLENGTH<4 Then Return 
  572.    FOUR$=Right$(WORD$,4)
  573.    Restore LAST4DATA
  574.    For J=1 To 34
  575.       Read FOURLET$ : Read PH$
  576.       If FOURLET$=FOUR$ Then Return 
  577.    Next J
  578.    PH$=""
  579.    Return 
  580. LAST4DATA:
  581. Data "ould","UH,D","ough","AH,F","tion","SH,AH,N","sion","SH,AH,N"
  582. Data "ique","IY,K","full","F,UH,L","tech","T,EH,K","head","H,EH,D"
  583. Data "earn","ER,N","some","S,AH,M","ouse","AW,S","iece","IY,S"
  584. Data "aise","EY,Z","cial","SH,IX,L","augh","AE,F","roll","R,OW,L"
  585. Data "eaut","Y,UW,T","cess","S,EH,S","cuit","K,IH,T","your","Y,OH,R"
  586. Data "agon","EY,G,IX,N","uise","UW,Z","rown","R,AW,N","ruis","R,UW,Z"
  587. Data "uice","UW,S","bear","B,EH,R","ideo","IH,D,IY,OW","cean","SH,AH,N"
  588. Data "eigh","EY","uper","UW,P,ER","tead","T,EH,D","ange","EY,N,J"
  589. Data "tour","T,UW,R","ooze","UW,Z"
  590. LAST3:
  591.    PH$="" : WORDLENGTH=Len(WORD$) : If WORDLENGTH<3 Then Return 
  592.    THREE$=Right$(WORD$,3)
  593.    Restore LAST3DATA
  594.    For J=1 To 105
  595.       Read THREELET$ : Read PH$
  596.       If THREELET$=THREE$ Then Return 
  597.    Next J
  598.    PH$=""
  599.    Return 
  600. LAST3DATA:
  601. Data "abe","EY,B","ace","EY,S","ade","EY,D","afe","EY,F","age","EY,J"
  602. Data "ake","EY,K","ale","EY,L","ame","EY,M","ane","EY,N","ape","EY,P"
  603. Data "are","EY,R","ase","EY,S","ate","EY,T","ave","EY,V","awe","AO"
  604. Data "aze","EY,Z","ffy","F,IY","ggy","G,IY","ppy","P,IY","ssy","S,IY"
  605. Data "ebe","IY,B","eke","IY,K","eme","IY,M","ere","EH,R","ese","IY,Z"
  606. Data "ibe","AY,B","ice","AY,S","ide","AY,D","ife","AY,F","ige","AY,J"
  607. Data "ike","AY,K","ile","AY,L","ime","AY,M","ine","AY,N","ipe","AY,P"
  608. Data "ire","AY,R","ise","AY,S","ite","AY,T","ive","AY,V","ize","AY,Z"
  609. Data "igh","AY","tty","T,IY","zzy","Z,IY","rry","R,IY","cry","K,R,AY"
  610. Data "obe","OW,B","ode","OW,D","oke","OW,K","ole","OW,L","ome","OW,M"
  611. Data "one","OW,N","ope","OW,P","ore","OH,R","ose","OW,Z","ote","OW,T"
  612. Data "ove","AH,V","owe","OW","oze","OW,Z","ful","F,UH,L","old","OW,L,D"
  613. Data "ube","UW,B","uce","UW,S","ude","UW,D","uge","Y,UW,J","uke","Y,UW,K"
  614. Data "ule","UW,L","ume","UW,M","une","UW,N","ure","ER","use","UW,S"
  615. Data "ute","UW,T","eve","IY,V","ald","AO,L,D","eye","AY","any","EH,N,IY"
  616. Data "ook","UH,K","ood","UH,D","ble","B,IX,L","est","EH,S,T","pow","P,AW"
  617. Data "yle","AY,L","nce","N,S","eer","IY,R","oar","OH,R","cer","S,ER"
  618. Data "alk","AO,K","art","AA,R,T","ies","AY,Z","men","M,EH,N","cyc","S,AY,K"
  619. Data "cyb","S,AY,B","cya","S,AY,AE","cir","S,ER","lly","L,IY","ong","AO,NG"
  620. Data "alt","AO,L,T","ear","IY,R","syn","S,IH,N","chr","K,R","ent","EH,N,T"
  621. Data "nse","N,S","son","S,AH,N","ull","UH,L","air","EY,R","ign","AY,N"
  622. LAST2:
  623.    PH$="" : WORDLENGTH=Len(WORD$) : If WORDLENGTH<2 Then Return 
  624.    If WORDLENGTH<2 Then Return 
  625.    TWO$=Right$(WORD$,2)
  626.    Restore LAST2DATA
  627.    For J=1 To 67
  628.       Read TWOLET$ : Read PH$
  629.       If TWOLET$=TWO$ Then Return 
  630.    Next J
  631.    PH$=""
  632.    Return 
  633. LAST2DATA:
  634. Data "sh","SH","ch","CH","th","TH","ng","NG","ea","IY","er","ER","ir","ER"
  635. Data "ur","ER","oa","OW","wh","WH","ee","IY","oi","OY","oo","UW","ou","AW"
  636. Data "bb","B","cc","K,S","dd","D","ff","F","gg","G","ll","L","mm","M"
  637. Data "nn","N","pp","P","qu","K,W","rr","R","ss","S","tt","T","vv","V"
  638. Data "ww","W","xx","K,S","zz","Z","ck","K","ai","EY","ie","IY","io","IY,OW"
  639. Data "or","OH,R","ew","UW","au","AO","aw","AO","ow","OW","xc","K,S"
  640. Data "dy","D,IY","ky","K,IY","my","M,IY","ny","N,IY","ly","L,IY","sy","Z,IY"
  641. Data "ty","T,IY","vy","V,IY","zy","Z,IY","ry","R,IY","ay","EY","ia","IY,AE"
  642. Data "ey","IY","fy","F,AY","ei","IY","ue","UW","ce","S,EH","cy","S,IH"
  643. Data "ar","AA,R","ci","S,IH","wr","R","ph","F","en","EH,N","uy","AY"
  644. Data "dg","D,J"
  645. LAST1:
  646.    PH$="" : WORDLENGTH=Len(WORD$) : If WORDLENGTH<1 Then Return 
  647.    If WORDLENGTH<1 Then Return 
  648.    MONO$=Right$(WORD$,1)
  649.    Restore LAST1DATA
  650.    For J=1 To 26
  651.       Read MONOLET$ : Read PH$
  652.       If MONOLET$=MONO$ Then Return 
  653.    Next J
  654.    PH$=""
  655.    Return 
  656. LAST1DATA:
  657. Data "a","AE","b","B","c","K","d","D","e","EH","f","F","g","G","h","H"
  658. Data "i","IH","j","J","k","K","l","L","m","M","n","N","o","AA","p","P"
  659. Data "q","K","r","R","s","S","t","T","u","AH","v","V","w","W","x","K,S"
  660. Data "y","Y","z","Z"
  661. End Proc