1/* 2% NomicMUD: A MUD server written in Prolog 3% Maintainer: Douglas Miles 4% Dec 13, 2035 5% 6 7 Talk_DB is a bit less organized most lexicons! 8 9 But every once in a while there's a treasure in it 10 (so worth using) 11 12 13 If I remember correctly, I got it from 14 15 https://github.com/crossbowerbt/prolog-talk 16 17 and then wrote/used one of my S-expression translators 18 19*/ 20 21:- module(talk_db_iface, []). 22 23:- style_check(-(discontiguous)). 24 25decl_talk_db_data(F/A):- dynamic(F/A), multifile(F/A), export(F/A). 26 27:- decl_talk_db_data(talk_db/1). 28:- decl_talk_db_data(talk_db/2). 29:- decl_talk_db_data(talk_db/3). 30:- decl_talk_db_data(talk_db/4). 31:- decl_talk_db_data(talk_db/5). 32:- decl_talk_db_data(talk_db/6). 33:- decl_talk_db_data(talk_db/7). 34 35 /* 36 37 setof(F, talk_db([F|_]), O). 38 39 [prep, adj, adverb, noun2, pret, verb, interj, superl, conj, sing_only, fem, pronoun, pref, 40 p, ads, masc, noun, adb, b_t, noun_verb, m, apron, ncollect, pres_indic, comp, 41 et, aa, na, esp, personal, impersonal, possessive, inerj, indef, singular, auxiliary, 42 pl_pronoun, obssuperl, ppl, imperative, c, interrog, domain, verb_t, verb_i] 43 44 45 setof(F, talk_db([domain, _, D]), O). 46 47 48 bagof(P, (talk_db([F|X]), length(X, A), functor(P, F, A)), O), writeq(O). 49 50*/ 51 52talk_db([F, A|List]):- talk_db_argsIsa(F, N_Minus1, _), length(List, N_Minus1), apply(talk_db, [F, A|List]). 53 54talk_db_argsIsa(comp, 1, adjective(comparative)). 55talk_db_argsIsa(superl, 1, adjective(superlative)). 56talk_db_argsIsa(noun1, 1, singular(plural)). 57talk_db_argsIsa(intransitive, 4, base(pluralverb, imperfect, ingform, past_part)). 58talk_db_argsIsa(transitive, 4, base(pluralverb, imperfect, ingform, past_part)). 59talk_db_argsIsa(adj, 0, (adjective)). 60talk_db_argsIsa(auxiliary, 0, (verb)). % will shall wont 61talk_db_argsIsa(conj, 0, (conjuntion)). 62talk_db_argsIsa(fem, 0, (feminine)). 63talk_db_argsIsa(fem, 0, (noun)). 64talk_db_argsIsa(impersonal, 0, (meseems)). 65talk_db_argsIsa(indef, 0, (indefinate)). 66talk_db_argsIsa(indef, 0, (pronoun)). 67talk_db_argsIsa(interj, 0, (interjection)). 68talk_db_argsIsa(interrog, 0, (whpron)). % only instance 69talk_db_argsIsa(agentive, 0, (noun)). 70talk_db_argsIsa(masc, 0, (masculine)). 71talk_db_argsIsa(masc, 0, (noun)). 72talk_db_argsIsa(ncollect, 0, (massnoun)). 73talk_db_argsIsa(noun2, 0, (noun)). 74talk_db_argsIsa(noun2, 0, (plural)). 75talk_db_argsIsa(noun2, 0, (singular)). 76talk_db_argsIsa(noun_verb, 0, (verb)). 77talk_db_argsIsa(noun_verb, 0, (noun)). 78talk_db_argsIsa(p, 0, (adjective)). 79talk_db_argsIsa(personal, 0, (firstperson)). 80talk_db_argsIsa(pl_pronoun, 0, (plural)). 81talk_db_argsIsa(pl_pronoun, 0, (pronoun)). 82talk_db_argsIsa(possessive, 0, (pronoun)). 83talk_db_argsIsa(preposition, 0, (preposition)). 84talk_db_argsIsa(pres_indic, 0, (verb)). 85talk_db_argsIsa(sing_only, 0, (noun)). 86talk_db_argsIsa(sing_only, 0, (singular)). 87talk_db_argsIsa(verb, 0, (adj_verb)). % verb/nouns maybe 88talk_db_argsIsa(pronoun, 0, (pronoun)). 89talk_db_argsIsa(adverb, 0, (adverb)). 90 91 92talk_db_pos_trans(massnoun, noun). 93talk_db_pos_trans(superlative, adjective). 94talk_db_pos_trans(comparative, adjective). 95talk_db_pos_trans(superl, adj). 96talk_db_pos_trans(comp, adj). 97talk_db_pos_trans(intransitive, verb). 98talk_db_pos_trans(transitive, verb). 99talk_db_pos_trans(imperfect, verb). 100talk_db_pos_trans(imperfect, past). 101talk_db_pos_trans(past_part, verb). 102talk_db_pos_trans(past_part, past). 103talk_db_pos_trans(past_part, particple). 104talk_db_pos_trans(past_part, adjectival). 105talk_db_pos_trans(pluralverb, verb). 106talk_db_pos_trans(pluralverb, plural). 107talk_db_pos_trans(pluralverb, noun). 108talk_db_pos_trans(pluralverb, active). 109talk_db_pos_trans(ingform, verb). 110talk_db_pos_trans(ingform, active). 111talk_db_pos_trans(ingform, pres). 112talk_db_pos_trans(ingform, particple). 113talk_db_pos_trans(ingform, adjectival). 114talk_db_pos_trans(A, A). 115 116:- decl_talk_db_data(talk_db_pos/2). 117talk_db_pos(POS, String):- nonvar(POS), nonvar(String), !, talk_db_t_0(POS, String), !. 118talk_db_pos(POS, String):- talk_db_t_0(POS, String). 119 120talk_db_t_0(POS, String):- talk_db_argsIsa(F, N, POSVV), talk_db_pos(String, POSVV, PPOS, F, N), talk_db_pos_trans(PPOS, POS). 121 122talk_db_pos(String, POSVV, POS, F, 0):- !, talk_db(F, String), (F=POSVV -> POS=F ; (POS=POSVV;POS=F)). 123talk_db_pos(String, POSVV, POS, F, N):- nonvar(String), !, length(List, N), Search=[_|List], C=..[talk_db, F|Search], nth0(AT, Search, String, _), , getPos(AT, F, POSVV, POS). 124talk_db_pos(String, POSVV, POS, F, N):- length(List, N), Search=[_|List], C=..[talk_db, F|Search], , nth0(AT, Search, String, _), getPos(AT, F, POSVV, POS). 125 126getPos(_, FPOS, _, FPOS). 127getPos(0, _, POSVV, POS):- !, functor(POSVV, POS, _);POS=base. 128getPos(AT, _, POSVV, POS):- arg(AT, POSVV, POS), !. 129 130 131talk_db(noun1, Sing, Sing):- talk_db(noun2, Sing). 132 133 134%:- style_check(-discontiguous). 135%:- include(library('nldata/talk_db.pl.dat')). 136:- absolute_file_name( 137 library('nldata/talk_db.nldata'), 138 File, [access(read)]), 139 open(File, read, In), 140 set_stream(In, encoding(iso_latin_1)), 141 repeat, 142 read(In, P), 143 asserta(P), 144 P==end_of_file, !. 145 146% ================================= 147% some random talk_db/2-7s from the other file (to help see the meanings) 148% ================================= 149/* 150 151talk_db(adj, aaronic). 152talk_db(adj, aaronical). 153talk_db(adj, abactinal). 154talk_db(adj, abandoned). 155talk_db(adj, abased). 156talk_db(adj, abatable). 157talk_db(adj, abominable). 158talk_db(adj, absent). 159talk_db(adj, usurpatory). 160talk_db(adj, uterine). 161talk_db(adv, yesterday). 162talk_db(adv, yesternight). 163talk_db(adv, yet). 164talk_db(adv, youngly). 165talk_db(adv, ysame). 166talk_db(adv, yvel). 167talk_db(adv, ywis). 168talk_db(agentive, doer). 169talk_db(auxilary, wont). 170talk_db(auxiliary, shall). 171talk_db(auxiliary, will). 172talk_db(b_t, crimson). 173talk_db(b_t, crossbite). 174talk_db(b_t, lumber). 175talk_db(b_t, pulley). 176talk_db(comp, angry, angrier). 177talk_db(comp, wordy, wordier). 178talk_db(comp, wormy, wormier). 179talk_db(comp, worthy, worthier). 180talk_db(comp, wry, wrier). 181talk_db(comp, yellow, yellower). 182talk_db(comp, young, younger). 183talk_db(conj, albe). 184talk_db(conj, albee). 185talk_db(conj, albeit). 186talk_db(conj, all). 187talk_db(conj, also). 188talk_db(conj, altho). 189talk_db(conj, although). 190talk_db(conj, an). 191talk_db(conj, and). 192talk_db(conj, so). 193talk_db(conj, syne). 194talk_db(conj, than). 195talk_db(conj, then). 196talk_db(conj, therefore). 197talk_db(conj, tho). 198talk_db(conj, til). 199talk_db(conj, till). 200talk_db(conj, unless). 201talk_db(conj, until). 202talk_db(domain, abalone, zoology). 203talk_db(domain, abandonee, law). 204talk_db(domain, abator, law). 205talk_db(domain, abelian, "eccl., hist"). 206talk_db(domain, abelite, "eccl., hist"). 207talk_db(domain, abelonian, "eccl., hist"). 208talk_db(domain, abietite, chem). 209talk_db(domain, abirritation, med). 210talk_db(domain, ablegate, "r., c., ch"). 211talk_db(domain, aboma, zoology). 212talk_db(domain, absinthate, chem). 213talk_db(domain, absinthin, chem). 214talk_db(domain, absolute, geom). 215talk_db(fem, alumna). 216talk_db(fem, buffa). 217talk_db(fem, chiffonier). 218talk_db(fem, gitana). 219talk_db(fem, her). 220talk_db(fem, lanner). 221talk_db(fem, marseillaise). 222talk_db(fem, masseuse). 223talk_db(fem, poseuse). 224talk_db(fem, religieuse). 225talk_db(fem, she). 226talk_db(impersonal, meseems). 227talk_db(impersonal, methinks). 228talk_db(impersonal, tacet). 229talk_db(indef, one). 230talk_db(indef, whatso). 231talk_db(interj, adieu). 232talk_db(interj, so). 233talk_db(interj, soft). 234talk_db(interj, soho). 235talk_db(interj, tallyho). 236talk_db(interj, tush). 237talk_db(interj, walaway). 238talk_db(interj, waly). 239talk_db(interj, wayleway). 240talk_db(interj, welaway). 241talk_db(interj, welladay). 242talk_db(interj, weyleway). 243talk_db(interj, whist). 244talk_db(interj, whoa). 245talk_db(interj, yoicks). 246talk_db(interj, zounds). 247talk_db(interrog, what). 248talk_db(intransitive, abort, aborts, aborted, aborting, aborted). 249talk_db(intransitive, abound, abounds, abounded, abounding, abounded). 250talk_db(intransitive, abstain, abstains, abstained, abstaining, abstained). 251talk_db(intransitive, zighyr, zighyrs, zighyred, zighyring, zighyred). 252talk_db(intransitive, zigzag, zigzags, zigzaged, zigzaging, zigzaged). 253talk_db(intransitive, zip, zips, ziped, ziping, ziped). 254talk_db(m, kit). 255talk_db(m, sacerdotalism). 256talk_db(masc, buffo). 257talk_db(masc, he). 258talk_db(masc, his). 259talk_db(masc, lanneret). 260talk_db(masc, marseillais). 261talk_db(masc, masseur). 262talk_db(masc, poseur). 263talk_db(masc, religieux). 264talk_db(masc, solus). 265talk_db(ncollect, folk). 266talk_db(ncollect, folks). 267talk_db(noun1, aam, aams). 268talk_db(noun1, ab, abs). 269talk_db(noun1, abandon, abandons). % note verbs are snuck into here (and need to be filtered) 270talk_db(noun1, ability, abilities). 271talk_db(noun1, abolishment, abolishments). 272talk_db(noun2, abdominales). 273talk_db(noun2, abdominalia). 274talk_db(noun2, aborigines). 275talk_db(noun2, abranchiata). 276talk_db(noun2, fish). 277talk_db(noun2, zygobranchia). 278talk_db(noun2, zygodactyli). 279talk_db(noun_verb, deprave). 280talk_db(noun_verb, harlequin). 281talk_db(noun_verb, hobble). 282talk_db(noun_verb, hold). 283talk_db(noun_verb, kemb). 284talk_db(noun_verb, ken). 285talk_db(noun_verb, loan). 286talk_db(noun_verb, trip). 287talk_db(p, bounden). 288talk_db(p, collied). 289talk_db(p, dustman). 290talk_db(p, laden). 291talk_db(personal, me). 292talk_db(pl_pronoun, they). 293talk_db(pl_pronoun, tho). 294talk_db(preposition, a). % note articles are snuck into here (and need to be filtered 295talk_db(preposition, about). 296talk_db(preposition, above). 297talk_db(preposition, with). 298talk_db(preposition, withal). 299talk_db(preposition, within). 300talk_db(preposition, without). 301talk_db(preposition, withouten). 302talk_db(preposition, yer). 303talk_db(preposition, ymel). 304talk_db(pres_indic, forewot). 305talk_db(pronoun, another). 306talk_db(pronoun, any). 307talk_db(pronoun, echon). 308talk_db(pronoun, echoon). 309talk_db(pronoun, either). 310talk_db(pronoun, yours). 311talk_db(pronoun, yourself). 312talk_db(pronoun, yow). 313talk_db(sing_only, alms). 314talk_db(sing_only, amends). 315talk_db(sing_only, bellows). 316talk_db(sing_only, vermin). 317talk_db(sing_only, vers). 318talk_db(superl, aftermost). 319talk_db(superl, angry, angriest). 320talk_db(superl, bad, worst). 321talk_db(superl, blue, bluest). 322talk_db(superl, brave, bravest). 323talk_db(transitive, abandon, abandons, abandoned, abandoning, abandoned). 324talk_db(transitive, abduce, abduces, abduced, abducing, abduced). 325talk_db(transitive, able, ables, abled, abling, abled). 326talk_db(transitive, abolish, abolishes, abolished, abolishing, abolished). 327talk_db(transitive, abscond, absconds, absconded, absconding, absconded). 328talk_db(transitive, absent, absents, absented, absenting, absented). 329talk_db(transitive, absinthiate, absinthiates, absinthiated, absinthiating, absinthiated). 330talk_db(transitive, absorb, absorbs, absorbed, absorbing, absorbed). 331talk_db(transitive, twit, twits, twitted, twitting, twitted). 332talk_db(transitive, twitter, twitters, twittered, twittering, twittered). 333talk_db(verb, abray). 334 335*/