{Break up "speech stream" into words} {Does NOT guarantee that the pieces are well-formed. for example: valid medial consonants not checked. lujvo not checked for formation beyond 1st "y". and more.} {$V-} program BRKWORDS; Uses Dos,stringwk,filerr; {******** Main Routine Declarations *******************************} var {file stuff} {@@ SpeechIn : text; @@} EOFin : boolean; {strings to work with} IPlen : integer; IPstring : string[255]; {Input string, as entered} WKstring : string[255]; {Work string for changes to IPstring} CVstring : string[255]; {CV-form of work string} ResolveFlags : string[255]; {.=pause,space=unresolved} StressFlags : string[255]; {?} OPstring : string[255]; {result to be written} OPtype : string[255]; {letter of type of word (cmavo/brivla)} {other stuff} ValidInitials : string[200]; {******** Subroutines *********************************************} {------------------------------------------------------------------} {Like "copy", but give starting and ending positions rather than starting position and length} function SUBSTRING(FullString : string; SubStart : integer; SubEnd : integer) : string; begin SUBSTRING := copy(FullString,SubStart,(SubEnd - SubStart + 1)); end; {end substring function} {------------------------------------------------------------------} {Like "upcase"} function lowcase(InChar : char) : char; const UpperCase : string[26] = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; LowerCase : string[26] = 'abcdefghijklmnopqrstuvwxyz'; var CharPos : integer; begin CharPos := pos(InChar,UpperCase); if CharPos = 0 then lowcase := InChar else lowcase := LowerCase[CharPos]; end; {end lowcase function} {------------------------------------------------------------------} {Like "upcases"} function lowcases(strg : string) : string; var ll : integer; stchr : char; ststr : string[1]; stwk : string[255]; begin stwk := ''; if length(strg) = 0 then lowcases := '' else begin for ll := 1 to length(strg) do begin ststr := copy(strg,ll,1); stchr := ststr[1]; stchr := lowcase(stchr); stwk := stwk + stchr; end; lowcases := stwk; end; end; {end lowcases function} {------------------------------------------------------------------} {Find position of search string in portion of a source string. The resulting position is relative to the ORIGINAL source string, however.} function POS_IN(SearchArg : string; {string to find} FullString : string; {source string} SubStart : integer; {start looking here} SubEnd : integer) : integer; {stop looking after this} var WkSubStr : string[255]; WkFindPos : integer; begin WkSubStr := SUBSTRING(FullString,SubStart,SubEnd); WkFindPos := pos(SearchArg,WkSubStr); if WkFindPos > 0 then WkFindPos := WkFindPos + SubStart - 1; POS_IN := WkFindPos; end; {end substring function} {------------------------------------------------------------------} function VALID_INIT(WKstring : string; {in} CVstring : string; {in} StartPos : integer; {in} EndPos : integer) {in} : boolean; {Checks a consonant-cluster-initial string for all } { valid initial consonant pairs. } var WkPos : integer; WkValid : boolean; Wk2 : string[2]; begin WkPos := StartPos; WkValid := true; if (EndPos > StartPos) and (CVstring[StartPos] = 'C') and (CVstring[StartPos + 1] = 'C') then repeat Wk2 := upcases(copy(WKstring,WkPos,2)); if pos(Wk2,ValidInitials) = 0 then WkValid := false; WkPos := WkPos + 1; until (not WkValid) or (WkPos + 1 > Endpos) or (CVstring[WkPos + 1] <> 'C') else WkValid := false; VALID_INIT := WkValid; end; {end valid-init function} {------------------------------------------------------------------} {------------------------------------------------------------------} procedure RESOLVE_AS(StartPos : integer; {in} EndPos : integer; {in} TypeInd : string); {in} {modifies ResolveFlags with resolution info} var WkCtr : integer; begin {Resolve flags have a letter at beginning of each "word" that indicates} {the type of word, then "*" for all the subsequent letters of the word.} {The formatting (adding spaces between words) will be done later. } ResolveFlags[StartPos] := TypeInd[1]; for WkCtr := StartPos + 1 to EndPos do ResolveFlags[WkCtr] := '*'; end; {end resolve as} {------------------------------------------------------------------} procedure INIT_BRKWORDS; var WkCtr : integer; dummy : integer; begin {Initialization} EOFin := false; ValidInitials := upcases('.bl.br.cf.ck.cl.cm.cn.cp.cr.ct') + upcases('.dj.dr.dz.fl.fr.gl.gr') + upcases('.jb.jd.jg.jm.jv.kl.kr.ml.mr.pl.pr') + upcases('.sf.sk.sl.sm.sn.sp.sr.st') + upcases('.tc.tr.ts.vl.vr.xl.xr.zb.zd.zg.zm.zv.'); {ValidInitials := upcases(ValidInitials);} end; {------------------------------------------------------------------} procedure GET_LINE; { IPstring : string; out } { CVstring : string; out } { ResolvedFlags : string; out } { StressFlags : string; out } { IPlen : integer; out } { EOFin : boolean); out } {---------------------------------------------------------------} procedure INIT_LINE_STUFF; const {for CV, stress determination} Vowels : string[10] = 'aeiouAEIOU'; Consonants : string[34] = 'bcdfgjklmnprstvxzBCDFGJKLMNPRSTVXZ'; StressedVowels : string[5] = 'AEIOU'; Apostrophe : string[1] = ''''; var WkCtr : integer; IsVowel : boolean; IsConsonant : boolean; IsStressed : boolean; WkChar : string[1]; begin {init other strings based on IPstring} WKstring := IPstring; IPlen := length(IPstring); for WkCtr := 1 to IPlen do begin IsVowel := false; IsConsonant := false; IsStressed := false; WkChar := IPstring[WkCtr]; if pos(WkChar,Vowels) > 0 then IsVowel := true; if pos(WkChar,Consonants) > 0 then IsConsonant := true; if pos(WkChar,StressedVowels) > 0 then IsStressed := true; if WkChar = Apostrophe then begin CVstring := CVstring + 'h'; ResolveFlags := ResolveFlags + ' '; StressFlags := StressFlags + ' '; end else if (WkChar = '.') or {pause} (WkChar = ' ') then {alternate for pause} begin CVstring := CVstring + '.'; ResolveFlags := ResolveFlags + '.'; {a pause is already resolved} StressFlags := StressFlags + ' '; end else if WkChar = 'y' then begin CVstring := CVstring + 'y'; ResolveFlags := ResolveFlags + ' '; StressFlags := StressFlags + ' '; end else if IsVowel then if IsStressed then begin CVstring := CVstring + 'V'; ResolveFlags := ResolveFlags + ' '; StressFlags := StressFlags + 'Y'; end else begin CVstring := CVstring + 'V'; ResolveFlags := ResolveFlags + ' '; StressFlags := StressFlags + ' '; end else if IsConsonant then begin CVstring := CVstring + 'C'; ResolveFlags := ResolveFlags + ' '; StressFlags := StressFlags + ' '; end else begin CVstring := CVstring + '?'; ResolveFlags := ResolveFlags + '?'; {can't resolve anyway} StressFlags := StressFlags + ' '; end; end; {end loop through letters of IPstring} end; {end of subroutine init line stuff} {---------------------------------------------------------------} begin {Initialization} IPstring := ''; CVstring := ''; ResolveFlags := ''; StressFlags := ''; OPstring := ''; OPtype := ''; {read line} writeln; writeln(' just to end'); write('?: '); readln(IPstring); if (IPstring = '') then EOFin := true else INIT_LINE_STUFF; {subroutine under this routine} end; {end Get Line} {------------------------------------------------------------------} procedure RESOLVE_LINE; { IPstring : string; in } { WKstring : string; i/o } { CVstring : string; in } { ResolvedFlags : string; i/o } { StressFlags : string; i/o } { IPlen : integer; in } var AllResolved : boolean; PieceResolved : boolean; StartResolve : integer; EndResolve : integer; {---------------------------------------------------------------} procedure GET_1ST_UNRESOLVED; var WkPos : integer; begin StartResolve := pos(' ',ResolveFlags); if StartResolve = 0 then AllResolved := true else begin EndResolve := StartResolve; WkPos := StartResolve; repeat if ResolveFlags[WkPos] = ' ' then EndResolve := WkPos else WkPos := IPlen; WkPos := WkPos + 1; until (WkPos > IPlen); end; end; {---------------------------------------------------------------} procedure CHECK_NAME; var NameMarkStart : integer; NameMarkEnd : integer; {---------------------------------------------------------} procedure FIND_LAST_NAME_MARKER; var Wk2 : string[2]; Wk3 : string[3]; Wk4 : string[4]; WkPos : integer; begin NameMarkStart := 0; NameMarkEnd := 0; WkPos := EndResolve; Wk2 := ''; Wk3 := ''; Wk4 := ''; repeat Wk2 := WKstring[WkPos] + Wk2; Wk3 := WKstring[WkPos] + Wk3; Wk4 := WKstring[WkPos] + Wk4; if upcases(Wk4) = 'LA''I' then begin NameMarkStart := WkPos; NameMarkEnd := WkPos + 3; end else if (upcases(Wk3) = 'LAI') or (upcases(Wk3) = 'DOI') then begin NameMarkStart := WkPos; NameMarkEnd := WkPos + 2; end else if (upcases(Wk2) = 'LA') then begin NameMarkStart := WkPos; NameMarkEnd := WkPos + 1; end; {eliminate if name marker preceded by a consonant} if (NameMarkStart > 0) and (NameMarkStart > StartResolve) then if CVstring[NameMarkStart - 1] = 'C' then begin NameMarkStart := 0; NameMarkEnd := 0; end; WkPos := WkPos - 1; until (NameMarkStart > 0) or (WkPos < StartResolve); end; {end find last name marker} {---------------------------------------------------------} begin if CVstring[EndResolve] = 'C' then {ends in consonant} begin FIND_LAST_NAME_MARKER; if NameMarkStart > 0 then begin {resolve as marker (cmavo) + name} RESOLVE_AS(NameMarkStart, {start of resolved item} NameMarkEnd, {end of resolved item} 'C'); {type of resolved item = Cmavo} RESOLVE_AS(NameMarkEnd + 1, {start of resolved item} EndResolve, {end of resolved item} 'N'); {type of resolved item = Name } end else {resolve whole as name} RESOLVE_AS(StartResolve, {start of resolved item} EndResolve, {end of resolved item} 'N'); {type of resolved item = Name } PieceResolved := true; end; end; {end check name} {---------------------------------------------------------------} procedure CHECK_HESITATION; begin {whole thing = "y"} if upcases(SUBSTRING(WKstring,StartResolve,EndResolve)) = 'Y' then begin RESOLVE_AS(StartResolve, {start of resolved item} EndResolve, {end of resolved item} 'C'); {type of resolved item = Cmavo} PieceResolved := true; end; end; {end check hesitation} {---------------------------------------------------------------} procedure CHECK_LERFU_Y; var WkStart : integer; begin if upcases(WKstring[EndResolve]) = 'Y' then begin WkStart := EndResolve - 1; if WkStart >= StartResolve then if CVstring[WkStart] = 'C' then {e.g.: "cy"} begin RESOLVE_AS(WkStart, {start of resolved item} EndResolve, {end of resolved item} 'C'); {type of resolved item = Cmavo} PieceResolved := true; end else if CVstring[WkStart] = 'V' then {error} begin RESOLVE_AS(StartResolve, {start of resolved item} EndResolve, {end of resolved item} '?'); {type of resolved item = ERROR} PieceResolved := true; end; WkStart := EndResolve - 2; if (not PieceResolved) and (WkStart >= StartResolve) then if (SUBSTRING(CVstring,WkStart,EndResolve) = 'Vh') or {a'y} (SUBSTRING(CVstring,WkStart,EndResolve) = 'yh') then {y'y} begin RESOLVE_AS(WkStart, {start of resolved item} EndResolve, {end of resolved item} 'C'); {type of resolved item = Cmavo} PieceResolved := true; end; end; end; {end check lerfu y} {---------------------------------------------------------------} procedure CHECK_CMAVO_ONLY; var CmavoStart : integer; NextCmavo : integer; begin {check for no consonant clusters} if (POS_IN('CC',CVstring,StartResolve,EndResolve) = 0) and (POS_IN('CyC',CVstring,StartResolve,EndResolve) = 0) then begin CmavoStart := StartResolve; {resolve all by breaking at each consonant} repeat if CmavoStart >= EndResolve then {e.g.: "o"} NextCmavo := 0 else NextCmavo := POS_IN('C', CVstring, CmavoStart + 1, EndResolve); if NextCmavo > 0 then begin RESOLVE_AS(CmavoStart, {start of resolved item} NextCmavo - 1, {end of resolved item} 'C'); {type of resolved item = Cmavo} CmavoStart := NextCmavo; end else {last one} begin RESOLVE_AS(CmavoStart, {start of resolved item} EndResolve, {end of resolved item} 'C'); {type of resolved item = Cmavo} end; until (NextCmavo = 0); PieceResolved := true; end; end; {end check cmavo only} {---------------------------------------------------------------} procedure CHECK_BRIVLA; var WkStart : integer; {Work version of StartResolve} WkEnd : integer; {Work version of EndResolve} Wk2 : string[2]; {for checking valid initial} {---------------------------------------------------------} procedure FIX_STRESS; var NumSyllables : integer; WkPos : integer; HoldChar : string[1]; begin {go from end of piece toward beginning} {mark 2nd vowel back as stressed, skipping over diphthong glides} NumSyllables := 0; WkPos := WkEnd; HoldChar := ' '; repeat if CVstring[WkPos] = 'V' then if HoldChar <> 'V' then begin NumSyllables := NumSyllables + 1; if NumSyllables = 2 then begin StressFlags[WkPos] := 'Y'; {for safety, mark both vowels of stess diphthong} if CVstring[WkPos - 1] = 'V' then StressFlags[WkPos - 1] := 'Y'; end; end; HoldChar := CVstring[WkPos]; WkPos := WkPos - 1; until (NumSyllables = 2) or (WkPos = WkStart); end; {---------------------------------------------------------} procedure FIND_BRIVLA_END; var CCpos : integer; CyCpos : integer; StressPos : integer; GuessEnd : integer; begin {find 1st consonant cluster (CC or CyC)} CCpos := POS_IN('CC',CVstring,WkStart,WkEnd); CyCpos := POS_IN('CyC',CVstring,WkStart,WkEnd); if CCpos = 0 then CCpos := CyCpos else if (CyCpos > 0) and (CyCpos < CCpos) then CCpos := CyCpos; {loop to take care of fix for assumed secondary stress} repeat {find stressed vowel of brivla} if CCpos > WkStart then if (CVstring[CCpos - 1] = 'V') and (StressFlags[CCpos - 1] = 'Y') then StressPos := CCpos - 1 else {stress marked on 1st of vowel diphthong} if CCpos - 1 > WkStart then if (CVstring[CCpos - 1] = 'V') and (CVstring[CCpos - 2] = 'V') and (StressFlags[CCpos - 2] = 'Y') then StressPos := CCpos - 2 else {find 1st stress after consonant cluster} StressPos := POS_IN('Y',StressFlags,CCpos,WkEnd) else {find 1st stress after consonant cluster} StressPos := POS_IN('Y',StressFlags,CCpos,WkEnd) else {find 1st stress after consonant cluster} StressPos := POS_IN('Y',StressFlags,CCpos,WkEnd); {also stress diphthong vowel)} if (StressPos > 0) and (StressPos < WkEnd) then if CVstring[StressPos + 1] = 'V' then begin StressPos := StressPos + 1; StressFlags[StressPos] := 'Y'; end; {find next vowel after stress} if StressPos = 0 then GuessEnd := 0 else if StressPos < WkEnd then GuessEnd := POS_IN('V',CVstring,StressPos + 1,WkEnd) else GuessEnd := 0; {check for obvious error: no vowel after stress} if GuessEnd = 0 then begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} '?'); {type of resolved item = ERROR} PieceResolved := true; end; {fix error for assumed secondary stress} {next piece can't start with "hV", so after unstressing leave this section as "resolved" so we can come back again with the new guessed stress position(s)} if not PieceResolved then if copy(CVstring,GuessEnd + 1, 2) = 'hV' then begin {unstress to assume non-primary stress} StressFlags[StressPos] := ' '; {also unstress other part if diphthong} if StressFlags[StressPos - 1] = 'Y' then StressFlags[StressPos - 1] := ' '; PieceResolved := true; end; until PieceResolved or (StressFlags[StressPos] = 'Y'); {if next letter is vowel, assume diphthong & take} if not PieceResolved then if GuessEnd < WkEnd then if CVstring[GuessEnd + 1] = 'V' then GuessEnd := GuessEnd + 1; {end of piece is now defined} if not PieceResolved then WkEnd := GuessEnd; end; {---------------------------------------------------------} procedure BRK_FRONT_CMAVO; var CCpos : integer; CyCpos : integer; Cpos : integer; WkCnt : integer; WkPos : integer; Wk5 : string[5]; begin repeat {see if there's CC/CyC in the 1st 5 letters} CCpos := 0; WkCnt := 0; WkPos := WkStart; Wk5 := ''; repeat {accumulate "1st 5"} if CVstring[WkPos] <> 'h' then begin WkCnt := WkCnt + 1; Wk5 := Wk5 + CVstring[WkPos]; end; WkPos := WkPos + 1; until (WkCnt = 5) or (WkPos > WkEnd); CCpos := pos('CC',Wk5); if CCpos = 0 then CCpos := pos('CyC',Wk5); {if no CC/CyC in 1st 5, break cmavo before 1st consonant} if CCpos = 0 then begin Cpos := POS_IN('C',CVstring,WkStart + 1,WkEnd); RESOLVE_AS(WkStart, {start of resolved item} Cpos - 1, {end of resolved item} 'C'); {type of resolved item = Cmavo} WkStart := Cpos; end; until CCpos > 0; {i.e., until there is a CC in 1st 5} {Now, check for vowel-initial} if CVstring[WkStart] = 'V' then begin CCpos := POS_IN('CC',CVstring,WkStart,WkEnd); CyCpos := POS_IN('CyC',CVstring,WkStart,WkEnd); if (CyCpos > 0) and (CyCpos < CCpos) then CCpos := CyCpos; Cpos := POS_IN('C',CVstring,WkStart + 1,WkEnd); {if 1st C is in consonant cluster, check valid initial} if (not VALID_INIT(WkString,CVstring,CCpos,WkEnd)) and (CCpos = Cpos) then begin {le'avla if not valid initial CC} RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end else begin {break off cmavo before consonant} RESOLVE_AS(WkStart, {start of resolved item} Cpos - 1, {end of resolved item} 'C'); {type of resolved item = Cmavo} WkStart := Cpos; end; end; end; {end brk front cmavo} {---------------------------------------------------------} procedure TEST_CVCC_INIT; {in order of preference/priority, we will resolve as: CV + lujvo/gismu lujvo/gismu CV + le'avla le'avla, whichever is the 1st valid form.} var AllCvc : boolean; NumCVCs : integer; InvalidInit : boolean; TestEnd : integer; WkPos : integer; Wk2 : string[2]; Ypos : integer; {------------------------------------------------------} procedure CHECK_TOSMABRU(LujvoStart : integer; LujvoEnd : integer; Ypos : integer; var AllCvc : boolean; var NumCVCs : integer; var InvalidInit : boolean); var Wk2 : string[2]; Wk3 : string[3]; WkPos : integer; begin AllCvc := true; NumCVCs := 1; {CVCC..., so at least 1} InvalidInit := false; WkPos := LujvoStart + 3; {start after 1st CVC} repeat Wk3 := SUBSTRING(CVstring,WkPos,WkPos + 2); if (length(Wk3) = 2) and (Ypos = 0) and (Wk3 = 'CV') then {OK - final CV on CVCCV, but check valid init} begin Wk2 := WkString[WkPos - 1] + WkString[WkPos]; if (pos(upcases(Wk2),ValidInitials) = 0) then InvalidInit := true; end else if Wk3 = 'CVC' then begin NumCVCs := NumCVCs + 1; Wk2 := WkString[WkPos - 1] + WkString[WkPos]; if (pos(upcases(Wk2),ValidInitials) = 0) then InvalidInit := true; end else AllCVC := false; WkPos := WkPos + 3; until (not AllCVC) or InvalidInit or (WkPos > LujvoEnd); end; {end CHECK_TOSMABRU} {------------------------------------------------------} function IS_THIS_LUJVO(LujvoStart : integer; LujvoEnd : integer) : string; const {for valid combination forms} ValidFronts : string[18] = '.CVC.CVV.CVhV.CCV.'; ValidYEnds : string[15] = '.CVC.CCVC.CVCC.'; Valid0Ends : string[26] = '.CVV.CVhV.CCV.CCVCV.CVCCV.'; var TestString : string[255]; WkPos : integer; Result : string[1]; EndPos : integer; ValidRafsi : boolean; Wk2 : string[2]; Wk5 : string[5]; WkLen : integer; WkRafsi : string[5]; begin Result := ' '; WkPos := LujvoStart; {loop thru string checking for valid rafsi} repeat {loop thru valid rafsi types} WkLen := 5; ValidRafsi := false; repeat EndPos := WkPos + WkLen - 1; if EndPos > LujvoEnd then EndPos := LujvoEnd; Wk5 := SUBSTRING(CVString,WkPos,EndPos); {Final string} if EndPos = LujvoEnd then begin if Ypos = 0 then if pos('.' + Wk5 + '.', Valid0Ends) = 0 then Result := 'N' else Result := 'Y' else if pos('.' + Wk5 + '.', ValidYEnds) = 0 then Result := 'N' else Result := 'Y'; if Result = 'Y' then begin Wk2 := CVString[WkPos] + CVString[WkPos + 1]; if Wk2 = 'CC' then begin Wk2 := WkString[WkPos] + WkString[WkPos + 1]; if (pos(upcases(Wk2),ValidInitials) = 0) then Result := 'N' else Result := 'Y'; end; end; end; {Non-Final string} if EndPos < LujvoEnd then if pos('.' + Wk5 + '.', ValidFronts) > 0 then begin ValidRafsi := true; Wk2 := CVString[WkPos] + CVString[WkPos + 1]; if Wk2 = 'CC' then begin Wk2 := WkString[WkPos] + WkString[WkPos + 1]; if (pos(upcases(Wk2),ValidInitials) = 0) then Result := 'N'; end; end; WkLen := WkLen - 1; until (WkLen < 3) or (ValidRafsi) or (Result <> ' '); if ValidRafsi then WkPos := EndPos + 1 else if (Result = ' ') then Result := 'N'; until (Result <> ' '); if Result = ' ' then Result := 'N'; {should never happen} IS_THIS_LUJVO := Result; end; {end is this lujvo function} {------------------------------------------------------} begin if not VALID_INIT(WkString,CVstring,WkStart + 2,WkEnd) then begin {CV not cmavo if not valid initial CC} RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end else if StressFlags[WkStart + 1] = 'Y' then begin {CV not cmavo if stress on final vowel of CV} RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end; {test tosmabru/non-tosmabru for all leading CVC's} if not PieceResolved then begin {check up to 1st 'y', if any; otherwise whole thing} Ypos := POS_IN('y',CVstring,WkStart,WkEnd); if Ypos = 0 then TestEnd := WkEnd else TestEnd := Ypos - 1; CHECK_TOSMABRU(WkStart, TestEnd, Ypos, AllCvc, NumCVCs, InvalidInit); if (NumCVCs > 1) and AllCvc then if InvalidInit then begin {Whole is lujvo} RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of item = Brivla} PieceResolved := true; end else begin {CV + lujvo if rest is valid lujvo} RESOLVE_AS(WkStart, {start of resolved item} WkStart + 1, {end of resolved item} 'C'); {type of item = Cmavo} RESOLVE_AS(WkStart + 2, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of item = Brivla} PieceResolved := true; end; end; {Since TOSMABRU is only case of valid lujvo-form where } {front CV falls off, if this wasn't all CVC and is valid } {lujvo form, then it's a lujvo! } if not PieceResolved then {check whole to see if valid lujvo} if IS_THIS_LUJVO(WkStart, TestEnd) = 'Y' then begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end; {Otherwise, CV + lujvo/le'avla} if not PieceResolved then begin RESOLVE_AS(WkStart, {start of resolved item} WkStart + 1, {end of resolved item} 'C'); {type of resolved item = Cmavo} RESOLVE_AS(WkStart + 2, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end; end; {end test CVCC init} {---------------------------------------------------------} procedure TEST_OTHER; begin if SUBSTRING(CVstring,WkStart,WkStart + 1) = 'CC' then begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end else if SUBSTRING(CVstring,WkStart,WkStart + 2) = 'CyC' then begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} '?'); {type of resolved item = ERROR} PieceResolved := true; end else if SUBSTRING(CVstring,WkStart,WkStart + 4) = 'CVCyC' then begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end else if SUBSTRING(CVstring,WkStart, WkStart + 4) = 'CVVCC' then {stress on first VV, or CC not valid initial} if (not VALID_INIT(WkString,CVstring,WkStart + 3,WkEnd)) or (StressFlags[WkStart + 1] = 'Y') then begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end {no stress on first VV, and CC valid initial} else begin {break off front as cmavo to try again} RESOLVE_AS(WkStart, {start of resolved item} WkStart + 2, {end of resolved item} 'C'); {type of resolved item = Cmavo} WkStart := WkStart + 3; RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end else if SUBSTRING(CVstring,WkStart, WkStart + 5) = 'CVhVCC' then {stress on end of V'V, or CC not valid initial} if (not VALID_INIT(WkString,CVstring,WkStart + 4,WkEnd)) or (StressFlags[WkStart + 3] = 'Y') then begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end {no stress on end of V'V, and CC valid initial} else begin {break off front as cmavo to try again} RESOLVE_AS(WkStart, {start of resolved item} WkStart + 3, {end of resolved item} 'C'); {type of resolved item = Cmavo} WkStart := WkStart + 4; RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} 'B'); {type of resolved item = Brivla} PieceResolved := true; end else if SUBSTRING(CVstring,WkStart, WkStart + 5) = 'CVVCyC' then begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} '?'); {type of resolved item = ERROR} PieceResolved := true; end else if SUBSTRING(CVstring,WkStart, WkStart + 6) = 'CVhVCyC' then begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} '?'); {type of resolved item = ERROR} PieceResolved := true; end else begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} '?'); {type of resolved item = ERROR} PieceResolved := true; end; end; {end test other} {---------------------------------------------------------} begin WkStart := StartResolve; WkEnd := EndResolve; {Fix consonant cluster, but no stress} {assume word ends with piece and penultimate stress} if POS_IN('Y',StressFlags,WkStart,WkEnd) = 0 then begin FIX_STRESS; end; {still no stress} if POS_IN('Y',StressFlags,WkStart,WkEnd) = 0 then begin RESOLVE_AS(WkStart, {start of resolved item} WkEnd, {end of resolved item} '?'); {type of resolved item = ERROR} PieceResolved := true; end; if not PieceResolved then FIND_BRIVLA_END; {end in WkEnd; error will resolve} if not PieceResolved then BRK_FRONT_CMAVO; {break any obvious cmavo off front} if not PieceResolved then if copy(CVstring,WkStart,4) = 'CVCC' then TEST_CVCC_INIT {do messy tests on CVCC... words} else TEST_OTHER; {do other, simpler determinations} {reset start & end in case "mark error" needed after cmavo cut} StartResolve := WkStart; EndResolve := WkEnd; end; {end check brivla} {---------------------------------------------------------------} procedure MARK_ERROR; begin RESOLVE_AS(StartResolve, {start of resolved item} EndResolve, {end of resolved item} '?'); {type of resolved item = ERROR} end; {end mark error} {---------------------------------------------------------------} begin AllResolved := false; repeat PieceResolved := false; GET_1ST_UNRESOLVED; if not AllResolved then begin CHECK_NAME; if not PieceResolved then CHECK_HESITATION; if not PieceResolved then CHECK_LERFU_Y; if not PieceResolved then CHECK_CMAVO_ONLY; if not PieceResolved then if ( (POS_IN('CC',CVstring,StartResolve,EndResolve) > 0) or (POS_IN('CyC',CVstring,StartResolve,EndResolve) > 0) ) then CHECK_BRIVLA; if not PieceResolved then MARK_ERROR; end; until AllResolved; end; {end Resolve Line} {------------------------------------------------------------------} procedure WRITE_LINE; const ZOIs : string[26] = '.ZOI.LA''O.'; var WkCtr : integer; CurrWord : string[255]; TypeWord : string[255]; {len of CurrWord; ThisType + ' 's} CurrLine : string[255]; TypeLine : string[255]; ThisType : string[1]; PrevType : string[1]; {flags} AddSpace : boolean; {Add a space before the current word?} ChgLower : boolean; {Change word to lower case?} {zoi level based on curr word just finished when we start new word} ZoiLevel : integer; {0=no ZOI;1=ZOI found;2=Delim found;3=inside quote} ZoiDelim : string[255]; {delimiter for ZOI} {---------------------------------------------------------------} procedure ADD_CURR_WORD; begin {defaults} ChgLower := true; AddSpace := true; if ZoiLevel = 0 then {no ZOI in effect} if pos('.' + upcases(CurrWord) + '.',ZOIs) > 0 then ZoiLevel := 1 {now ZOI in effect} else else if ZoiLevel = 1 then {ZOI found, so this is delimiter} begin ZoiLevel := 2; {delimiter found} ZoiDelim := upcases(CurrWord); end else if (ZoiLevel = 2) or {1st inside ZOI unless this is closer} (ZoiLevel = 3) then {more inside ZOI unless this is closer} if upcases(CurrWord) = ZoiDelim then begin ZoiLevel := 0; ZoiDelim := ''; end else begin TypeWord[1] := 'Q'; {really a quoted string} ZoiLevel := 3; {next will be more inside ZOI, or closer} end; if (ZoiLevel = 3) and (PrevType <> '.') then begin AddSpace := false; TypeWord[1] := ' '; {not really a new word} end; if (ZoiLevel = 3) or (ThisType = 'N') then ChgLower := false; if ChgLower then CurrWord := lowcases(CurrWord); if AddSpace then begin CurrLine := CurrLine + ' ' + CurrWord; TypeLine := TypeLine + ' ' + TypeWord; end else begin CurrLine := CurrLine + CurrWord; TypeLine := TypeLine + TypeWord; end; CurrWord := ''; TypeWord := ''; end; {end add new word} {---------------------------------------------------------------} begin writeln('I: ', IPstring); writeln('F: ', CVstring); writeln('R: ', ResolveFlags); writeln('S: ', StressFlags); ZoiLevel := 0; CurrWord := ''; TypeWord := ''; CurrLine := ''; TypeLine := ''; ThisType := ''; PrevType := ''; for WkCtr := 1 to IPlen do begin {part of current word} if ResolveFlags[WkCtr] = '*' then begin CurrWord := CurrWord + IPstring[WkCtr]; TypeWord := TypeWord + ' '; end else {pause} if ResolveFlags[WkCtr] = '.' then begin if CurrWord > '' then ADD_CURR_WORD; PrevType := ThisType; ThisType := ResolveFlags[WkCtr]; end else {new word} begin if CurrWord > '' then ADD_CURR_WORD; CurrWord := IPstring[WkCtr]; TypeWord := ResolveFlags[WkCtr]; PrevType := ThisType; ThisType := ResolveFlags[WkCtr]; end; end; {loop through IP line} if CurrWord > '' then ADD_CURR_WORD; CurrLine := TRIM_FRONT(CurrLine); TypeLine := TRIM_FRONT(TypeLine); writeln('O: ',CurrLine); writeln('T: ',TypeLine); end; {------------------------------------------------------------------} {******* Main Routine *********************************************} begin; INIT_BRKWORDS; repeat GET_LINE; if not EOFin then begin RESOLVE_LINE; WRITE_LINE; end; until EOFin; end.