(FILECREATED "10-Aug-84 19:39:06" {ERIS}<SPEECH>LEXICON>EXTRA-FOOT.;4 23622
changes to: (FNS ANAPEST-FOOT)
(VARS EXTRA-FOOTCOMS)
previous date: "10-Aug-84 19:18:39" {ERIS}<SPEECH>LEXICON>EXTRA-FOOT.;1)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT EXTRA-FOOTCOMS)
(RPAQQ EXTRA-FOOTCOMS ((FNS ANAPEST-FOOT ANTEPENULTSYLLABLE CATEGORIZE EDGEMARKER FIND-1-STRESS
FOOT-PARSER LASTSYLLABLE LOADFOOT MAINSTRESS ONSET PACKFEET PARSE-TEST
FOOT.DOMAINS PENULTRULE PENULTSYLLABLE PRETTYFOOT PRINTFOOT
LEFT.WEAK.BRACKET RIGHT.STRONG.BRACKET LEFT.STRONG.BRACKET
RIGHT.WEAK.BRACKET PRINTSTRONGFOOT PRUNE PRUNE1 REAL-LONG-VOWEL? RUNFEET
SECONDARY-STRESS STRESS STRESS&STRIP STRESS-SYLLABLE STRESS-VOWEL
MAINSTRESS.FOOT STRIPFOOT SYLLABLE-STACKER TERTIARY-STRESS TEST-FUNCTION
TEST-STRESSER TRANSFORMFOOT)
(FNS DEBUG FOOTSUBSCRIPT MARKED.STRONG SETUP.FOOTWINDOW FOOTFONTS)))
(DEFINEQ
(ANAPEST-FOOT
[LAMBDA (SYLLABLES) (* kh: " 5-APR-83 14:24")
(for SYLLABLE-TAIL on old SYLLABLES collect (COND
[(AND (NOT (FOOT? (CAR SYLLABLE-TAIL)))
(NOT (FOOT? (CADR SYLLABLE-TAIL)))
(NOT (FOOT? (CADDR SYLLABLE-TAIL)))
(STRESS? (CAR SYLLABLE-TAIL)
1)
(STRESS? (CADR SYLLABLE-TAIL)
0)
(STRESS? (CADDR SYLLABLE-TAIL)
0))
(SETQ SYLLABLES (CDDR SYLLABLES))
(* SYLLABLES will be decremented when we iterate as
well, therefore no ADD1)
(MAKE-FOOT (LIST (CAR SYLLABLE-TAIL)
(CADR SYLLABLE-TAIL)
(CADDR SYLLABLE-TAIL]
(T (CAR SYLLABLE-TAIL)))
finally $$VAL])
(ANTEPENULTSYLLABLE
[LAMBDA (SYLLABLES) (* kh: "29-Mar-82 21:21" posted: "29-Mar-82 21:47")
(* Returns the antepenultimate syllable of a word given
the syllables as input)
(CADDR SYLLABLES])
(CATEGORIZE
[LAMBDA (W) (* pkh: " 8-Aug-84 11:59" posted: "29-Mar-82 00:22")
(* Finds the / which indicates the morphological info in
a word, and puts it on the porperty list of the word)
(* / Indicates beginning of morphological information.
If WORD has it, POS will be the character-position
following /)
(COND
[(SETQ POS (STRPOS (QUOTE "/")
(fetch INPUT of W)
NIL NIL NIL T))
[replace CATEGORY of W with (MKATOM (U-CASE (SUBSTRING (fetch INPUT of W)
POS]
(* The category is that part of the word which follows
/)
(* The word itself is the substring preceding /)
(replace TRANSCRIPTION of W with (MKATOM (SUBSTRING (fetch INPUT of W)
1
(IDIFFERENCE POS 2]
(T (replace TRANSCRIPTION of W with (fetch INPUT of W])
(EDGEMARKER
[LAMBDA (SYLLABLES) (* edited: " 8-Apr-82 21:21")
(* Stresses the edge of a word with 1 if it isn't
already stressed)
(PROG [(FIRST (CAR SYLLABLES))
(LAST (CAR (LAST SYLLABLES]
(COND
((STRESS? FIRST 0)
(STRESS-SYLLABLE FIRST 1)))
(COND
((STRESS? LAST 0)
(STRESS-SYLLABLE LAST 1])
(FIND-1-STRESS
[LAMBDA (SYLLABLES) (* edited: "10-Apr-82 18:15")
(* Walks down a list of with 0 stress syllables until a 1 stress is found. Returns the list of the unstressed
syllables and the 1 stress, if failure NIL is returned)
(for SYLLABLE in old SYLLABLES while (STRESS? SYLLABLE 0) collect SYLLABLE
finally (COND
[(STRESS? SYLLABLE 1)
(RETURN (APPEND $$VAL (LIST SYLLABLE]
(T (RETURN NIL])
(FOOT-PARSER
[LAMBDA (WREC) (* pkh: " 7-Aug-84 17:37")
(* Takes a word as input, focusses on the STRUCTURE field of the WORD, i.e. where the the syllables sit, and
parses the STRUCTURE into feet; finally we replace the parentheses with foot-boundary markers)
(PROG (FEET (SYLLABLES (fetch STRUCTURE of WREC)))
(SETQ FEET (FALLING-FOOT SYLLABLES))
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout T (QUOTE "Falling-foot ===> ")
T FEET T)))
(SETQ FEET (SECONDARY-FOOT FEET))
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout T (QUOTE "Secondary-foot ===> ")
T FEET T)))
(SETQ FEET (HEAVY-SYLLABLE-FOOT FEET))
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout T (QUOTE "Heavy-syllable-foot ===> ")
T FEET T)))
(SETQ FEET (ANAPEST-FOOT FEET))
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout T (QUOTE "Anapest-foot ===> ")
T FEET T)))
(SETQ FEET (DEFAULT.FOOT FEET))
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout T (QUOTE "Default-foot ===> ")
T FEET T)))
(SETQ FEET (LEFT.SYLLABLE.INCORPORATION FEET))
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout T (QUOTE "Left Syllable Incorporation ===> ")
T FEET T)))
(RETURN (replace STRUCTURE of WREC with FEET])
(LASTSYLLABLE
[LAMBDA (SYLLABLES) (* kh: "29-Mar-82 18:31" posted: "29-Mar-82 18:41")
(CAR SYLLABLES])
(LOADFOOT
[LAMBDA (FLG) (* pkh: " 1-Aug-84 20:39")
(* Loads the files necessary to run the foot parser)
(* I use DLAMBDAs so this file from <lisp>library> needs
to be loaded)
(LOAD? (QUOTE DECL.DCOM))
(COND
[FLG (PROGN (LOAD (QUOTE {PHYLUM}<HALVORSEN>LISP>DFOOT.DCOM))
(LOAD (QUOTE {PHYLUM}<HALVORSEN>LISP>SYLLABLE.DCOM))
(LOAD (QUOTE {PHYLUM}<HALVORSEN>LISP>METRICS.DCOM))
(LOAD (QUOTE {PHYLUM}<HALVORSEN>LISP>METRICSPATCH]
(T (PROGN (LOAD? (QUOTE {PHYLUM}<HALVORSEN>LISP>DFOOT.DCOM))
(LOAD? (QUOTE {PHYLUM}<HALVORSEN>LISP>SYLLABLE.DCOM))
(LOAD? (QUOTE {PHYLUM}<HALVORSEN>LISP>METRICS.DCOM])
(MAINSTRESS
[LAMBDA (SYLLABLE) (* pkh: " 7-Aug-84 16:55" posted: "29-Mar-82 16:44")
(* Takes a syllable and inserts main stress indication
(3) after the first vowel; SHOULDNT if there is no
vowel)
(STRESS-VOWEL SYLLABLE 1])
(ONSET
[LAMBDA (SYLLABLE) (* kh: "31-Mar-82 20:33" posted: "31-Mar-82 20:37")
(CAR SYLLABLE])
(PACKFEET
[LAMBDA (FEET) (* edited: "11-Apr-82 18:16")
(for ELT in old FEET bind PACKEDFEET first (SETQ ELT# (LENGTH FEET))
do [COND
((FOOT? ELT)
(SETQ ELT (TRANSFORMFOOT ELT]
[COND
[(IGREATERP (LENGTH FEET)
1)
(SETQ PACKEDFEET (APPEND PACKEDFEET ELT (LIST (QUOTE -]
(T (SETQ PACKEDFEET (APPEND PACKEDFEET ELT]
finally (RETURN PACKEDFEET])
(PARSE-TEST
[LAMBDA (WREC) (* pkh: " 7-Aug-84 15:39")
(PROGN (SYLLABLE-STACKER WREC) (* Takes word with syllables indicated by -, explodes
the strings and puts them in reverse order under the
property SYLLABLES)
(STRESS WREC) (* Replace with English stress rule)
(EDGEMARKER (fetch STRUCTURE of WREC)) (* Put the stress-indications on the list under the
SYLLABLES property; ready to do a parse of feet)
(replace STRUCTURE of WREC with (REVERSE (fetch STRUCTURE of WREC)))
(* Get the syllables in the correct order
(left-to-right))
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout FOOTOUTPUTFILE WREC T)))
(FOOT-PARSER WREC)
(FOOT.DOMAINS WREC])
(FOOT.DOMAINS
[LAMBDA (WREC) (* pkh: " 3-Aug-84 22:21")
(PROG ((FEET (fetch STRUCTURE of WREC)))
(create DOMAINS
STRONG ← FEET])
(PENULTRULE
[LAMBDA (SYLLABLE) (* pkh: " 7-Aug-84 16:55" posted: "30-Mar-82 21:38")
(* Stresses a syllable if it is long, i.e. if it has a
long vowel, or is closed (finnsonant))
(PROG [(LONG-VOWEL (SOME SYLLABLE (QUOTE LONG-VOWEL?]
(COND
([OR (CONSONANT? (CAR (LAST SYLLABLE)))
(REAL-LONG-VOWEL? LONG-VOWEL (ONSET (LASTSYLLABLE SYLLABLES]
(* Stress the penult if it is closed or if it has a long-vowel provided it is not immediately succeeded by an
initial-vowel in the next syllable)
(RETURN (STRESS-SYLLABLE SYLLABLE 1)))
(T NIL])
(PENULTSYLLABLE
[LAMBDA (SYLLABLES) (* kh: "29-Mar-82 21:20" posted: "29-Mar-82 21:48")
(* Returns the penultimate syllable of a word given the
syllables of the word as input)
(CADR SYLLABLES])
(PRETTYFOOT
[LAMBDA (LONGFOOT) (* kh: "23-MAR-83 20:30")
(for ELT in (COND
((type? DOMAINS LONGFOOT)
(APPEND (fetch WEAK of LONGFOOT)
(fetch STRONG of LONGFOOT)))
(T LONGFOOT))
join [COND
((FOOT? ELT)
(STRIPFOOT ELT))
((LISTP (CAR ELT))
(PRETTYFOOT FOOT))
(T (CONS (QUOTE -)
(APPEND ELT (LIST (QUOTE -]
finally $$VAL])
(PRINTFOOT
[LAMBDA (F) (* pkh: " 7-Aug-84 16:55")
(COND
[(type? DOMAINS F) (* We are at the first pass through PRINTFOOT;
there is only one domain in a word)
(COND
((fetch WEAK of F)
(LEFT.WEAK.BRACKET)
(PRINTFOOT (fetch WEAK of F))
(RIGHT.WEAK.BRACKET)))
(COND
((fetch STRONG of F)
(PRINTSTRONGFOOT (fetch STRONG of F]
((type? FOOT (CAR F))
(* Input must be a WEAK or a STRONG from a DOMAIN; There will be one or more feet, print them with vertical bars
"\" in between)
(for F FLG in F
do (printout FOOTOUTPUTFILE "\")
(PRINTFOOT F)))
[(type? FOOT F)
(for SYLLABLE FLG in (fetch SYLLABLES of F) do (COND
(FLG (printout FOOTOUTPUTFILE (QUOTE -))
(PRINTFOOT SYLLABLE))
(T (SETQ FLG T)
(PRINTFOOT SYLLABLE]
(T (for ELT in F do (COND
[(LISTP ELT)
(for SOUND in ELT do (printout FOOTOUTPUTFILE (COND
((EQ SOUND 1)
1)
(T SOUND]
(T (printout FOOTOUTPUTFILE (COND
((EQ ELT 1)
1)
(T ELT])
(LEFT.WEAK.BRACKET
[LAMBDA NIL (* pkh: " 7-Aug-84 15:39")
(FOOTSUBSCRIPT "a")
(printout FOOTOUTPUTFILE # (DSPFONT FOOTFONT (TTYDISPLAYSTREAM))
"[")
(DSPFONT FOOTFONT (TTYDISPLAYSTREAM])
(RIGHT.STRONG.BRACKET
[LAMBDA NIL (* pkh: " 7-Aug-84 15:39")
(printout FOOTOUTPUTFILE "]"])
(LEFT.STRONG.BRACKET
[LAMBDA NIL (* pkh: " 7-Aug-84 15:39")
(FOOTSUBSCRIPT "b")
(printout FOOTOUTPUTFILE # (DSPFONT FOOTFONT (TTYDISPLAYSTREAM))
"[")
(DSPFONT FOOTFONT (TTYDISPLAYSTREAM])
(RIGHT.WEAK.BRACKET
[LAMBDA NIL (* pkh: " 7-Aug-84 15:39")
(printout FOOTOUTPUTFILE "]"])
(PRINTSTRONGFOOT
[LAMBDA (STRONGFOOT) (* kh: "24-MAR-83 12:35")
(LEFT.STRONG.BRACKET)
(PRINTFOOT (fetch STRONG of FOOT))
(RIGHT.STRONG.BRACKET])
(PRUNE
[LAMBDA (FOOT) (* edited: "12-Apr-82 02:21")
(PRUNE1 (LEAVES FOOT])
(PRUNE1
[LAMBDA (TREE) (* edited: "13-Apr-82 23:57")
(for LEAF in old TREE join (COND
((AND (EQUAL LEAF (QUOTE -))
(NOT $$VAL))
NIL)
([AND (EQUAL LEAF (QUOTE -))
(MEMBER (CADR TREE)
(QUOTE (- %] %[]
NIL)
((AND (OR (EQUAL LEAF (QUOTE %[))
(EQUAL LEAF (QUOTE %])))
(EQUAL (CADR TREE)
(QUOTE -)))
(SETQ TREE (CDR TREE))
(LIST LEAF))
((AND (EQUAL LEAF (QUOTE -))
(NULL (CDR TREE)))
NIL)
(T (LIST LEAF)))
finally $$VAL])
(REAL-LONG-VOWEL?
[LAMBDA (SYLLABLETAIL NEXTONSET) (* kh: "31-Mar-82 20:27" posted: "31-Mar-82 20:37")
(* Checks that the long-vowel isn't followed by a
vowel-onset in the next syllable)
(COND
((OR (IGREATERP (LENGTH SYLLABLETAIL)
1)
(NOT (VOWEL? NEXTONSET)))
SYLLABLETAIL)
(T NIL])
(RUNFEET
[LAMBDA NIL (* kh: "23-MAR-83 16:38")
(LOAD (QUOTE {PHYLUM}<HALVORSEN>FOOT>DFOOT.DCOM))
(LOAD (QUOTE {PHYLUM}<HALVORSEN>FOOT>SYLLABLE.DCOM])
(SECONDARY-STRESS
[LAMBDA (SYLLABLE) (* kh: "29-Mar-82 16:40" posted: "29-Mar-82 16:43")
(STRESS-VOWEL SYLLABLE 2])
(STRESS
[LAMBDA (WREC) (* pkh: " 7-Aug-84 16:57" posted: "29-Mar-82 16:46")
(* Top-level function for stress-assignment. Takes a word (with the morphological information stripped off) and
assigns stress to the syllables of the word according to the stress-rules. Outputs the word on the terminal and
stores the stress-indication (PRINT-STRESSED-WORD))
(PROG ((SYLLABLES (fetch STRUCTURE of WREC))
(SYLLABLE# (fetch SYLLABLE# of WREC)))
(COND
((EQ SYLLABLE# 1)
(STRESS-SYLLABLE (LASTSYLLABLE SYLLABLES)
1)
(RETURN WREC))
((VVAS.RULE (LASTSYLLABLE SYLLABLES))
(RETURN WREC))) (* If it is a monosyllable, stress it and quit, else see
if there is a long vowel in the last syllable)
(COND
((EQ SYLLABLE# 2)
(STRESS-SYLLABLE (PENULTSYLLABLE SYLLABLES)
1)
(RETURN WREC))
((PENULTRULE (PENULTSYLLABLE SYLLABLES))
(RETURN WREC)))
(* If it is a diasyllable (which didn't match the VVAS.RULE) stress the penult, for longer words see if the
PENTULTRULE (long V or closed syllable) is matched)
(STRESS-SYLLABLE (ANTEPENULTSYLLABLE SYLLABLES)
1)
(for SYLL in SYLLABLES do (COND
((MARKED.STRONG SYLL)
(* REMOVE.MARK SYLL)
(STRESS-SYLLABLE SYLL 1)))
finally (RETURN WREC)) (* If everything else fails the antepenult gets the
stress)
(RETURN WREC])
(STRESS&STRIP
[LAMBDA (WORD) (* kh: " 7-Apr-82 00:35" posted: " 7-Apr-82 00:40")
(* Takes a word, strips off the category indication and puts it on the property-list of the word
(minus the /<cat>) under the property name CAT)
(PROG ((STRIPPED-WORD (CATEGORIZE WORD)))
(SYLLABLE-STACKER STRIPPED-WORD)
(STRESS STRIPPED-WORD)
(PUTPROP STRIPPED-WORD 'SYLLABLES (REVERSE (GETP STRIPPED-WORD 'SYLLABLES)))
(RETURN STRIPPED-WORD])
(STRESS-SYLLABLE
[LAMBDA (SYLLABLE STRESS) (* kh: " 4-APR-83 21:00" posted: "30-Mar-82 20:52")
(* Smashes STRESS, which should be an integer (3 for main stress, 2 for secondary and 1 for tertiary), onto the
end of the list of characters which represents the syllable)
(NCONC SYLLABLE (LIST STRESS])
(STRESS-VOWEL
[LAMBDA (SYLLABLE STRESS) (* kh: "29-Mar-82 16:37" posted: "29-Mar-82 16:44")
(* Iterate down the segments in the syllable, if it isn't a vowel put it at the end of the list TEMP, and set REST
to the remainder of the syllable; if it is a vowel splice in the stress (an integer) in a list inbetween TEMP
(the front) and (CDR REST))
(for SEGMENT in SYLLABLE bind (TEMP (REST ← SYLLABLE))
do [COND
((NOT (VOWEL? SEGMENT))
(SETQ TEMP (APPEND TEMP (LIST SEGMENT)))
(SETQ REST (CDR REST)))
(T (RETURN (APPEND TEMP (CONS SEGMENT (CONS STRESS (CDR REST]
finally (COND
((NULL $$VAL)
(SHOULDNT])
(MAINSTRESS.FOOT
[LAMBDA (FOOT) (* pkh: " 7-Aug-84 16:57")
(for SYLLABLE in (CADR FOOT) thereis (STRESS? SYLLABLE 1])
(STRIPFOOT
[LAMBDA (FOOT) (* kh: "23-MAR-83 19:16")
<
(QUOTE %[) ! (PRETTYFOOT FOOT:2)
(QUOTE %])
>])
(SYLLABLE-STACKER
[LAMBDA (WREC) (* kh: " 4-APR-83 20:43" posted: "29-Mar-82 15:09")
(* edited: "10-Apr-82 03:47")
(* Finds the syllables in a word (no morphological info (/-info) allowed) and puts them (represented as a list of
characters) last syllable first on a stack on the the property list of the word under the property-name SYLLABLES.
The property-name SYLLABLE# gives the number of syllables in the word)
(PROG (SYLLABLE-STACK SYLLABLE# (BPOS 0)
EPOS
(SYLLABIFIEDWORD (fetch STRUCTURE of WREC)))
(* The STRUCTURE of the word is at this point simply the
syllabified version of the word
(hyphens indicating syllabification))
(while BPOS count (COND
((SETQ EPOS (STRPOS (QUOTE -)
SYLLABIFIEDWORD
(ADD1 BPOS)))
(* if -
is found put the material from the beginning of the word or the last -
on the syllable stack, and set BPOS to the character-position where the search is to resume)
[push SYLLABLE-STACK (UNPACK (SUBSTRING SYLLABIFIEDWORD (ADD1 BPOS)
(SUB1 EPOS]
(SETQ BPOS EPOS))
(T (* -
hasn't been found; put whole word or rest of word on the
syllable-stack and set BPOS to NIL so we quit)
(push SYLLABLE-STACK (UNPACK (SUBSTRING SYLLABIFIEDWORD
(ADD1 BPOS)
NIL)))
(SETQ BPOS EPOS)))
finally ((replace STRUCTURE of WREC with SYLLABLE-STACK)
(replace SYLLABLE# of WREC with (ADD1 $$VAL])
(TERTIARY-STRESS
[LAMBDA (SYLLABLE) (* kh: "29-Mar-82 16:40" posted: "29-Mar-82 16:43")
(STRESS-VOWEL SYLLABLE 1])
(TEST-FUNCTION
[LAMBDA (WORDLIST) (* pkh: " 7-Aug-84 15:39" posted: " 7-Apr-82 00:08")
(for WORD in WORDLIST do (PROG ((TEMP (CATEGORIZE WORD)))
(TEST-STRESSER TEMP)
(EDGEMARKER TEMP)
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout FOOTOUTPUTFILE T (REVERSE (GETP TEMP (QUOTE
SYLLABLES)))
T])
(TEST-STRESSER
[LAMBDA (WORD) (* pkh: " 7-Aug-84 15:39" posted: "30-Mar-82 21:40")
(* Test-function for the foot-parser, extendable)
(CATEGORIZE WORD)
(SYLLABLE-STACKER WORD)
(STRESS WORD)
(COND
((AND (NEQ (QUOTE NOBIND)
(EVALV (QUOTE DEBUG)))
DEBUG)
(printout FOOTOUTPUTFILE , WORD (QUOTE " has the stress pattern")
, , , , (REVERSE (GETP WORD (QUOTE SYLLABLES)))
T])
(TRANSFORMFOOT
[LAMBDA (FOOT) (* edited: "10-Apr-82 19:02")
(PROG (TEMP)
(RETURN (COND
((EQ ELT# 1)
(PACKFEET (CADR FOOT)))
(T (SETQ TEMP (CONS (QUOTE %[)
(APPEND (PACKFEET (CADR FOOT))
(LIST (QUOTE %]])
)
(DEFINEQ
(DEBUG
[LAMBDA (FLG)
(GLOBALVARS DEBUG)
DEBUG←FLG])
(FOOTSUBSCRIPT
[LAMBDA (X) (* kh: " 6-APR-83 21:09")
(* Prints X as a subscript in the LFGSMALLFONT)
(DECLARE (GLOBALVARS FOOTSUBFONT FOOTSUBOFFSET))
(RELMOVETO 0 (IMINUS FOOTSUBOFFSET)
(TTYDISPLAYSTREAM))
(RESETFORM (DSPFONT FOOTSUBFONT (TTYDISPLAYSTREAM))
(PRIN1 X))
(RELMOVETO 0 FOOTSUBOFFSET (TTYDISPLAYSTREAM])
(MARKED.STRONG
[LAMBDA (SYLLABLE) (* pkh: " 3-Aug-84 18:10" posted: "29-Mar-82 21:33")
(* COND ((MEMBER NIL) (for SOUND in SYLLABLE collect
SOUND unless (EQ (QUOTE (QUOTE NIL) SOUND)))))
(DREMOVE NIL SYLLABLE])
(SETUP.FOOTWINDOW
[LAMBDA NIL (* kh: " 6-APR-83 21:18")
(PROG ((W (CREATEW (create REGION
LEFT ← 10
BOTTOM ← 15
WIDTH ← 560
HEIGHT ← 370)
"Prosodic Structure")))
(DSPRIGHTMARGIN 32000 W)
(RETURN W])
(FOOTFONTS
[LAMBDA (FONT) (* pkh: " 9-Aug-84 11:22")
(DECLARE (GLOBALVARS FOOTFONT FOOTSUBFONT FOOTSUBOFFSET))
(SELECTQ FONT
(LARGE FONT← (QUOTE (GACHA 12)))
((SMALL NIL)
FONT←
(QUOTE (GACHA 10)))
NIL)
FOOTFONT←
(FONTCREATE FONT)
FOOTSUBFONT←
(FONTCREATE (QUOTE (HIPPO 10)))
FOOTSUBOFFSET←
(FONTPROP FOOTFONT (QUOTE SIZE))/2
(DSPFONT FONT (TTYDISPLAYSTREAM])
)
(PUTPROPS EXTRA-FOOT COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (987 21818 (ANAPEST-FOOT 997 . 1835) (ANTEPENULTSYLLABLE 1837 . 2162) (CATEGORIZE 2164
. 3390) (EDGEMARKER 3392 . 3878) (FIND-1-STRESS 3880 . 4396) (FOOT-PARSER 4398 . 5902) (LASTSYLLABLE
5904 . 6059) (LOADFOOT 6061 . 6890) (MAINSTRESS 6892 . 7272) (ONSET 7274 . 7421) (PACKFEET 7423 . 7901
) (PARSE-TEST 7903 . 8913) (FOOT.DOMAINS 8915 . 9127) (PENULTRULE 9129 . 9868) (PENULTSYLLABLE 9870 .
10198) (PRETTYFOOT 10200 . 10685) (PRINTFOOT 10687 . 12037) (LEFT.WEAK.BRACKET 12039 . 12308) (
RIGHT.STRONG.BRACKET 12310 . 12466) (LEFT.STRONG.BRACKET 12468 . 12739) (RIGHT.WEAK.BRACKET 12741 .
12895) (PRINTSTRONGFOOT 12897 . 13121) (PRUNE 13123 . 13259) (PRUNE1 13261 . 13896) (REAL-LONG-VOWEL?
13898 . 14327) (RUNFEET 14329 . 14543) (SECONDARY-STRESS 14545 . 14718) (STRESS 14720 . 16468) (
STRESS&STRIP 16470 . 17029) (STRESS-SYLLABLE 17031 . 17401) (STRESS-VOWEL 17403 . 18147) (
MAINSTRESS.FOOT 18149 . 18336) (STRIPFOOT 18338 . 18513) (SYLLABLE-STACKER 18515 . 20325) (
TERTIARY-STRESS 20327 . 20499) (TEST-FUNCTION 20501 . 20960) (TEST-STRESSER 20962 . 21504) (
TRANSFORMFOOT 21506 . 21816)) (21819 23541 (DEBUG 21829 . 21894) (FOOTSUBSCRIPT 21896 . 22369) (
MARKED.STRONG 22371 . 22717) (SETUP.FOOTWINDOW 22719 . 23051) (FOOTFONTS 23053 . 23539)))))
STOP