/*
* Copyright (c) 2021 Ross Cunniff
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to deal
* in the Software without restriction, including without limitation the rights
* to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
* copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
* THE SOFTWARE.
*/
/******************************************************************************
* Interface
******************************************************************************/
#include "libstd.oah" /* Uses standard library routines */
#include "libterm.oah" /* And possibly uses libterm */
namespace adv {
var
ShowStatus, // True iff we have a status line
Verb, // The current verb in the current actor's sentence
Conj, // The current conjunction in the current actor's sentence
Dobj, // The current direct object in the current actor's sentence
Prep, // The current preposition in the current actor's sentence
Iobj, // The current indirect object in the current actor's sentence
Numd, // The current direct obj count in the current actor's sentence
$ME, // The current actor
Phase, // The current phase of execution (see dox)
Prompt, // Routine used to prompt the user for input
echoInput, // True iff we want to echo the input. Useful for scripting.
dirVec; // Vector of verbs used for hit / miss
public
loc, cont, // Graph of Things/Locations
addCont, delCont, // Graph maint. procs
preact, // Property of verb - called before other sentence procs
action, // Verb or noun or location - action proc
ldesc, // Proc which prints a long description of something
sdesc, // Proc which prints a short description of something
noun, // Noun of a Thing (could be a List)
adjec, // Adjec of a thing (could be a List)
name, // Name of a word / thing / location
activate, // Activates an actor
setfuse, // Sets a fuse to execute in given number of turns
delfuse, // Deletes a fuse
move; // Method to move an object to another location
proc
Exit, // End current phase of execution, continue to another phase
Miss, // Compare dirVec to current verb, execute corresponding proc
Hit, // Compare dirVec to curr. verb, move obj to corresp. loc
Quit, // Quits OADL/adv
Restart, // Restarts the game
Setdaemon, // Sets a daemon to execute every turn
Incturn; // Increments the turn counter (by optional number)
class
ObjBase, // Base class of all locations/things/etc
Actor, // A self-actualizing Thing
Thing, // A movable Thing
Location, // A place where things happen
VerbClass, // Action word, of course
PrepClass, // "under", "into", etc.
AdjecClass, // "red", "green", etc.
NounClass, // "ball", etc. - note: this is *not* a Thing
ArtClass, // "the", "a", "an"...
ConjClass, // "and", "but", "or", ...
SepClass, // ".", "then", etc.
Synonym; // Declare a single-word synonym to a word or thing
ObjBase
$ALL(); // Root of the object tree
proc
START, // User-defined start procedure
DWIMD, // User-defined indirect object dwimmer
DWIMI; // User-defined direct object dwimmer
VerbClass
NOVERB; // Verb to use if no verb was given in input sentence
VerbClass
TELLER; // Verb to use in a "actor, do this" construction
Thing
NONOUN, // Thing to use if no noun in a prepositional phrase
STRING; // Thing to use if a string is used as an object
/******************************************************************************
* Phases of execution and possible ExitPhase args
******************************************************************************/
const
PHASE_START = 0,
PHASE_DAEMONS = 1,
PHASE_ACTOR = 2,
PHASE_VERBPRE = 3,
PHASE_IOBJ = 4,
PHASE_DOBJ = 5,
PHASE_VERBACT = 6,
PHASE_ROOM = 7;
const
PHX_CURRENT = 0,
PHX_ACTOR = 1,
PHX_DOBJS = 2,
PHX_SENTENCE = 3;
/******************************************************************************
* Implementation
******************************************************************************/
const INIT_STATUS_LINE = 1; // Will be using libterm / status line stuff
extern Tokenize, Initadv, Width, Getstr;
extern Insert, Lookup;
public
GetToken, prevAct, nextAct, detokenize, finishTokens,
ObjList; // List of objects that share this noun/adjec
var
ScreenRows, ScreenCols, ScreenWidth,
actList,
lastAct,
exitLocs,
exitOK,
Dictionary,
Daemons = {},
Turns = 0;
#define SET_EXIT(r, n) {
exitOK[n] = 1;
r = oadl::setjmp(exitLocs[n]);
}
proc $ClrExit(n)
{
exitOK[n] = 0;
}
/******************************************************************************
* Our dictionary class. We use this instead of OADL dict because it
* supports abbreviations.
******************************************************************************/
class $TrieClass {
var conts;
const STRIDE = 4; // The conts are an array of [n*STRIDE] quads
// These are the offsets of the subcomponents of each triple.
const CHAR = 0, CHILD = 1, NEXT = 2, VAL = 3;
const INITSIZE = 128; // Pick a reasonable size
// Allocate the initial conts array with an optional first argument size
public proc create() {
var size = INITSIZE;
if (oadl::nargs()) size = oadl::arg(0);
conts = new Array(size, STRIDE);
conts[0,CHAR] = "TRIE"; // Just for debugging
conts[0,NEXT] = 1; // Allocate first slot to track # used
}
// Overload array index assignment as "insert", just like a Dict
operator [=] (key, val) {
conts = Insert(conts, key, val);
}
// Overload array index fetch as "lookup", just like a dict
operator [] (key) {
return Lookup(conts, key);
}
#if (0) // For debugging
public proc print() {
var used = conts[0,NEXT];
// SL - left adjust; / - advance to next line after format
::print("SL,4V6,V,/",
// The header row
{"#", "CH","CHLD","NEXT","VAL"},
// The number column
[used,1].iterate(),
// The chars
WideChar(conts[0:used-1,0]),
// The contents
conts[0:used-1,1:]);
}
#endif
}
/* Token types for the dictionary */
const
T_PREP = 0,
T_VERB = 1,
T_STRING = 2,
T_ADJEC = 3,
T_NOUN = 4,
T_NOUN_SYN = 5,
T_ARTICLE = 6,
T_CONJUNCTION = 7,
T_COMMA = 8,
T_SEPARATOR = 9;
/* Temporary class used for intermediate sentences */
class $DirObj {
protected var
adjec, noun, conj;
public proc create(aa,nn,cc) {
adjec = aa;
noun = nn;
conj = cc;
}
}
/* The parser - stolen from ADL */
class ParseClass {
const
ERR = -100,
XXX = -100,
FIN = 100;
public var
pVerb, /* Single value - the verb */
pConj, /* List of conjunctions */
pDobj, /* List of direct objects */
pPrep, /* Single value - the prep creating the Iobj */
pIobj; /* The indirect object */
var
dobjList, /* Array of {mod, noun, conj} tuples */
Imod, /* Single value */
Inoun, /* Single value */
NumImod, /* Active size of Imod array */
parseDict,
C1, P1, P2,
PP_List,
VP_List,
s_str,
tokType,
tokVal,
currTok,
readTok = 1,
Tmod,
Tnoun,
Tconj,
state,
parseErrJmp,
parseTransitions = {
/*
* Transit table for state machine
*
* NOUN
* PREP VERB STR ADJ NOUN SYN ART CONJ "," SEP
*/
/* 0 */ { 4, 1, 2, 12, 12, 12, 12, ERR, ERR, FIN },
/* 1 */ { 4, 2, 2, 2, 2, 2, 2, ERR, ERR, FIN },
/* 2 */ { 4, 3, 3, 3, 3, 3, 3, 5, 5, FIN },
/* 3 */ { 11, ERR, ERR, ERR, ERR, ERR, ERR, 6, 6, FIN },
/* 4 */ { 9, 7, 7, 7, 7, 7, 7, ERR, ERR, FIN },
/* 5 */ { ERR, 8, 8, 8, 8, 8, 8, 5, 5, ERR },
/* 6 */ { ERR, 3, 3, 3, 3, 3, 3, 6, 6, ERR },
/* 7 */ { 9, ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, FIN },
/* 8 */ { 4, ERR, ERR, ERR, ERR, ERR, ERR, 5, 5, FIN },
/* 9 */ { ERR, 10, 10, 10, 10, 10, 10, ERR, ERR, FIN },
/*10 */ { 11, ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, FIN },
/*11 */ { ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, FIN },
/*12 */ { 4, 3, 3, 3, 3, 3, 3, 5, 13, FIN },
/*13 */ { ERR, 14, 14, 8, 8, 8, 8, ERR, ERR, ERR },
/*14 */ { ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, ERR, FIN }
},
parseActions = {
/*
* Action table for state machine
* NOUN
* PREP VERB STR ADJ NOUN SYN ART CONJ "," SEP
*/
/* 0 */ { 2, 0, 1, 1, 1, 1, 1, 500, 500, XXX },
/* 1 */ { 3, 1, 1, 1, 1, 1, 1, 501, 501, XXX },
/* 2 */ { 7, 5, 5, 5, 5, 5, 5, 6, 6, 4 },
/* 3 */ { 2, 502, 502, 502, 502, 502, 502, 8, 8, XXX },
/* 4 */ { 9, 1, 1, 1, 1, 1, 1, 501, 501, 10 },
/* 5 */ { 501, 11, 11, 11, 11, 11, 11, 8, 8, 501 },
/* 6 */ { 501, 11, 11, 11, 11, 11, 11, 8, 8, 501 },
/* 7 */ { 13, 502, 502, 502, 502, 502, 502, 502, 502, 12 },
/* 8 */ { 2, 502, 502, 502, 502, 502, 502, 8, 8, XXX },
/* 9 */ { 501, 15, 15, 15, 15, 15, 15, 501, 501, 14 },
/*10 */ { 2, 502, 502, 502, 502, 502, 502, 502, 502, XXX },
/*11 */ { 503, 503, 503, 503, 503, 503, 503, 503, 503, 10 },
/*12 */ { 7, 5, 5, 5, 5, 5, 5, 6, 16, 4 },
/*13 */ { 501, 19, 18, 17, 17, 17, 17, 501, 501, 501 },
/*14 */ { 503, 503, 503, 503, 503, 503, 503, 503, 503, XXX }
};
proc GetToken()
{
var
i, n, str, ch, tok;
if( !readTok ) {
readTok = 1;
return;
}
tok = $ME.GetToken();
if( !tok ) {
oadl::longjmp(parseErrJmp, 1);
//return nil;
}
switch( tok[0] ) {
case '.' :
tokType = T_SEPARATOR;
tokVal = '.';
case ',' :
tokType = T_COMMA;
tokVal = ',';
case '"', '\'' :
tokType = T_STRING;
ch = tok[0];
tokVal = tok[1:];
n = tokVal.length();
if( (n > 0) && (tokVal[n-1] == ch) ) {
/* Remove trailing quote */
tokVal = tokVal.subr(0,n-2);
}
default :
if( std::isdigit(tok[0]) ) {
tokType = T_STRING;
tokVal = tok;
}
else {
n = parseDict[std::tolower(tok)];
if( n == nil ) {
tokType = -1;
tokVal = -1;
}
else {
tokType = n[0];
tokVal = n[1];
}
}
}
currTok = tok;
return tok;
}
proc parseError( which )
{
switch( which ) {
case -1 : "I don't know the word \"", currTok, "\"\n";
case 500 : "\"", currTok, "\" is not a verb.\n";
case 501 : "\"", currTok, "\" is not part of a noun phrase.\n";
case 502 : "\"", currTok, "\" is not a preposition.\n";
case 503 : "End of sentence expected.\n";
case 504 : "Illegal multiple word verb phrase\n";
case 506 : "Illegal multiple word preposition\n";
default : "I don't understand that\n";
}
state = ERR;
}
proc getNoun()
{
Tmod = nil;
Tnoun = nil;
if( tokType == T_STRING ) {
Tnoun = tokVal;
return 1;
}
if( tokType == T_ARTICLE ) {
GetToken();
}
if( tokType == T_NOUN_SYN ) {
assert tokVal ?= Thing;
Tmod = tokVal.adjec;
Tnoun = tokVal.noun;
return 1;
}
if( (tokType == T_ADJEC) || (tokType == T_VERB) ) {
Tmod = tokVal;
GetToken();
}
if( tokType == T_NOUN ) {
Tnoun = tokVal;
return 1;
}
if( tokType < 0 ) {
parseError( tokType ); /* Dictionary error */
return nil;
}
else if( (!Tmod) && (!Tnoun) ) {
parseError( 501 ); /* S is not a noun */
return nil;
}
else {
readTok = 0; /* Skip next token */
return 1; /* Found adjecs but no noun; DWIM later */
}
}
proc findNoun(modObj, nounObj) {
var others = nounObj.ObjList;
if (!others) return nil;
forall (others[i]) {
var obj = others[i];
var aa = obj.adjec;
var af = false;
if (aa.isarray()) {
forall(aa[j]) {
af |= (modObj == aa[j]);
}
}
else {
af |= (modObj == aa);
}
if (!af) continue;
var nn = obj.noun;
var nf = false;
if (nn.isarray()) {
forall(nn[j]) {
nf |= (nounObj == nn[j]);
}
}
else {
nf |= (nounObj == nn);
}
if (nf) return obj;
}
return nil;
}
proc findVP( vrb, prp ) {
var i, n;
n = VP_List.length();
for( i = 0; i < n; i++ ) {
if( (VP_List[i][0] == vrb) && (VP_List[i][1] == prp) ) {
return VP_List[i][2];
}
}
return nil;
}
proc findPP( prep1, mod, noun, prep2 ) {
var
i, n, obj;
if( mod || noun ) {
obj = findNoun(mod, noun);
if( !obj ) return nil;
}
else {
obj = nil;
}
n = PP_List.length();
for( i = 0; i < n; i++ ) {
if( (PP_List[i][0] == prep1) &&
(PP_List[i][1] == obj) &&
(PP_List[i][2] == prep2) )
{
return PP_List[i][3];
}
}
return nil;
}
proc performAction( which )
{
var
x; /* Temporary used for lookups */
switch( which ) {
case 0 :
pVerb = tokVal;
case 1 :
getNoun();
case 2 :
P1 = tokVal;
case 3 :
x = findVP( pVerb, tokVal );
if( x == nil ) {
P1 = tokVal;
}
else {
pVerb = x;
state = 1;
}
case 4 :
dobjList = {new $DirObj(Tmod, Tnoun, nil)};
case 5 :
Imod = Tmod; Inoun = Tnoun;
getNoun();
dobjList = {new $DirObj(Tmod, Tnoun, nil)};
case 6 :
Tconj = tokVal;
dobjList = {new $DirObj(Tmod, Tnoun, nil)};
case 7 :
dobjList = {new $DirObj(Tmod, Tnoun, nil)};
P1 = tokVal;
case 8 :
Tconj = tokVal;
case 9 :
P2 = tokVal; Tmod = nil; Tnoun = nil;
case 10 :
x = findVP( pVerb, P1 );
if( x == nil ) {
pPrep = P1;
Imod = nil;
Inoun = nil;
}
else {
pVerb = x;
}
case 11 :
getNoun();
dobjList = dobjList ## new $DirObj(Tmod, Tnoun, Tconj);
case 12 :
Imod = Tmod; Inoun = Tnoun;
pPrep = P1;
case 13 :
P2 = tokVal;
case 14 :
if( (Tnoun != nil) || (Tmod != nil) ) {
Imod = Tmod; Inoun = Tnoun; pPrep = P1;
x = findVP( pVerb, P2 );
if( x == nil ) {
parseError( 504 ); /* Illegal verb phrase */
}
else {
pVerb = x;
}
}
else {
x = findPP( P1, Tmod, Tnoun, P2 );
if( x == nil ) {
parseError( 506 ); /* Illegal prep phrase */
}
else {
P1 = x;
x = findVP( pVerb, P1 );
if( x == nil ) {
parseError( 504 ); /* Illegal verb phrase */
}
else {
pVerb = x;
}
}
}
case 15 :
x = findPP( P1, Tmod, Tnoun, P2);
if( x == nil ) {
parseError( 506 ); /* Illegal prep phrase */
}
else {
pPrep = x;
getNoun();
Imod = Tmod; Inoun = Tnoun;
}
case 16 :
C1 = tokVal;
s_str = $ME.detokenize();
case 17 :
var prevMod = Tmod, prevNoun = Tnoun, currConj = C1;
getNoun();
dobjList = {new $DirObj(prevMod, prevNoun, nil),
new $DirObj(Tmod, Tnoun, currConj)};
case 18 :
Imod = Tmod; Inoun = Tnoun;
dobjList = {new $DirObj(nil, tokVal, nil)};
pVerb = TELLER;
case 19 :
Imod = Tmod; Inoun = Tnoun;
dobjList = {new $DirObj(nil, s_str, nil)};
pVerb = TELLER;
$ME.finishTokens();
}
}
proc dwimmer( dwimProc, modObj, nounObj )
{
var
msg = nil,
ex,
obj,
others,
result;
SET_EXIT(ex, PHX_CURRENT)
if( ex ) {
return nil;
}
result = nil;
if( nounObj == nil ) {
/* We must DWIM for the noun */
others = modObj.ObjList;
if (others) {
forall (others[i]) {
obj = others[i];
if( dwimProc( self, obj ) ) {
if( result != nil ) {
msg = "You will have to be more specific\n";
result = nil;
}
else {
result = obj;
}
}
}
}
}
else if( typeof(nounObj) == String ) {
/* No DWIMming for strings (???) */
result = nounObj;
}
else if( modObj == nil ) {
/* We may have to dwim for the adjec */
others = nounObj.ObjList;
if (others) {
forall (others[i]) {
obj = others[i];
if( obj.adjec == nil ) {
/* Aha! This is the one. */
if( result != nil ) {
msg = "You will have to be more specific\n";
result = nil;
}
else {
result = obj;
}
}
else if( dwimProc( self, obj ) ) {
if( result != nil ) {
result = nil;
}
else {
result = obj;
}
}
}
}
}
else {
/* No DWIMming needed */
result = findNoun(modObj, nounObj);
}
if( result == nil ) {
if( msg ) {
say(msg);
}
else {
"You don't see anything like that.\n";
}
}
$ClrExit(PHX_CURRENT);
return result;
}
public proc initvars()
{
var
i;
dobjList = {};
Imod = nil;
Inoun = nil;
pVerb = NOVERB;
pPrep = nil;
pIobj = nil;
}
public proc parse()
{
var
done, act;
readTok = 1;
state = 0;
Tmod = nil; Tnoun = nil; Tconj = nil;
P1 = 0; P2 = 0; C1 = 0;
if( oadl::setjmp(parseErrJmp) ) {
return -1;
}
done = 0;
while( !done ) {
GetToken();
if( tokType < 0 ) {
parseError( tokType ); /* Dictionary error */
}
else {
act = parseActions[state][tokType];
state = parseTransitions[state][tokType];
if( state == ERR ) {
parseError( act );
}
else {
performAction( act );
}
}
if( state == FIN ) {
done = 2;
}
else if( state == ERR ) {
done = 1;
}
}
/* OK, now do the DWIMMING */
if( done == 2 ) {
var pNumDobj = dobjList.length();
pDobj = new List(pNumDobj);
pConj = new List(pNumDobj);
forall (dobjList[i]) {
var dobj = dobjList[i], conj = dobj.conj;
dobj = dwimmer(DWIMD, dobj.adjec, dobj.noun);
if (!dobj) return 0;
pConj[i] = conj;
pDobj[i] = dobj;
}
if (Imod || Inoun) {
pIobj = dwimmer(DWIMI, Imod, Inoun);
if (!pIobj) return 0;
}
else if (pPrep) {
pIobj = NONOUN;
}
}
return done - 1;
}
public proc definePP(w1,w2,w3,syn) {
PP_List = PP_List ## {{w1,w2,w3,syn}};
}
public proc defineVP(w1,w2,syn) {
VP_List = VP_List ## {{w1,w2,syn}};
}
public proc create()
{
var
i;
if (Dictionary == nil) {
Dictionary = new $TrieClass();
}
parseDict = Dictionary;
parseErrJmp = new Array(oadl::JMP_SIZE);
PP_List = {};
VP_List = {};
dobjList = {};
}
} /* End of class ParseClass */
ParseClass parser();
/* A thing is an object or a location */
class ObjBase {
protected var
loc, cont = {}; // Graph of objs
// Add given object to contents. Note that the object is only
// present once on this list.
public proc addCont(obj) {
if (cont.position(obj) < 0) {
cont = obj ## cont;
}
}
// Remove given object from contents. It assumes that the object
// is only present once on the list.
public proc delCont(obj) {
cont = cont.without(obj);
}
public proc move(newLoc) {
// Remove myself from location's list of contents
// TBD: Should we remove it from *all* of the other locations?
if (!loc.isarray()) loc.delCont(self);
// Add myself to new location
loc = newLoc;
newLoc.addCont(self);
}
public proc create() {
// Insert into location(s) (if not AllObjs)
if (self != $ALL) {
switch (oadl::nargs()) {
case 0 : loc = $ALL;
case 1 : loc = oadl::arg(0);
default : loc = @oadl::argvec();
}
var tmpLoc = loc.isarray() ? loc : {loc};
forall (tmpLoc[i]) {
tmpLoc[i].addCont(self);
}
}
}
}
proc Status(rname, score, moves)
{
var cursRow, cursCol;
var spaces;
if (!ShowStatus) return;
term::ScrollRegion(1,ScreenRows-1);
cursRow = term::Query(term::CURS_ROW);
cursCol = term::Query(term::CURS_COL);
score = "Score: " ## String(score) ## " Moves: " ## String(moves);
spaces = ScreenWidth - (rname.length() + score.length()) - 1;
spaces = ' '.reshape(spaces);
term::GotoRC(0,0);
term::EEOL();
term::Reverse(1);
"", rname, spaces, score;
term::Reverse(0);
term::GotoRC(cursRow,cursCol);
}
proc Quit()
{
if (ShowStatus) {
"Hit return to continue...";
Getstr();
term::Stop();
}
oadl::halt();
}
proc Restart()
{
if (ShowStatus) {
"Hit return to continue...";
Getstr();
term::Stop();
}
oadl::restart();
}
proc GetObjName(obj)
{
var name, i, n;
name = oadl::objname(obj);
n = name.length();
for( i = 0; i < n; i++ ) {
if( name[i] == ':' ) return name[i+2: ];
}
return name;
}
/* This is a non-location thing */
class Thing(ObjBase) {
public var
noun, /* The one-word noun describing this thing */
adjec, /* Modifier to this thing */
name; /* The full string name of this object */
operator {} (complete) // Completion operator
{
var
aa, nn;
if (!complete) return;
/* Create the default noun, if not present */
if (!noun) {
noun = new NounClass(GetObjName(self)) {};
}
if (!name) {
/* Create the default composite name from the first adjec/noun */
aa = adjec.isarray() ? adjec[0] : adjec;
nn = noun.isarray() ? noun[0] : noun;
if( aa && nn ) {
name = aa.name ## " " ## nn.name;
}
else {
name = nn.name;
}
}
/* Now, add ourselves to "list of objects" for all of the nouns
* and adjectives
*/
if (adjec.isarray()) {
forall (adjec[i]) {
adjec[i].ObjList = adjec[i].ObjList ## self;
}
}
else if (adjec) {
adjec.ObjList = adjec.ObjList ## self;
}
if (noun.isarray()) {
forall (noun[i]) {
noun[i].ObjList = noun[i].ObjList ## self;
}
}
else {
noun.ObjList = noun.ObjList ## self;
}
}
/* Inherit create routine */
public var
ldesc,
sdesc,
action;
}
/* This is a location thing */
class Location(ObjBase) {
public proc create()
{
/* Pass nil to the parent so this location is placed in $ALL */
(parent.create)( nil );
}
public var ldesc;
public var sdesc;
public var action;
}
/* We need the word class so that dictionary lookup stuff can
* go well. Basically, you never directly declare instances
* of the word class. Rather, you subclass it as below,
* changing the tokType in each subclass to correspond with
* how you want it parsed.
*/
class WordClass {
public var name;
public var otherNames = {};
var tokType;
public proc GetType() { return tokType; }
public proc create()
{
var
i, n;
n = oadl::nargs();
if (n == 0) {
name = GetObjName(self);
// Don't insert names that have non-lowercase letters
if ((name == nil) || !name.islower().reduce(`&)) name = "";
}
else {
name = oadl::arg(0);
}
if (n > 1) {
otherNames = oadl::argvec()[1:];
}
}
operator {} () // Completion operator
{
var
i, n, val;
val = {tokType, self};
Dictionary[name] = val;
n = otherNames.length();
for( i = 0; i < n; i += 1 ) {
Dictionary[otherNames[i]] = val;
}
}
}
/* A class to create single-word synonyms */
class Synonym {
public proc create(orig)
{
var
syn, typ, obj,
i, n;
n = oadl::nargs();
if( orig.isarray() ) {
typ = nil;
}
else if( orig ?= WordClass ) {
typ = orig.GetType();
}
else if( orig ?= Thing ) {
typ = T_NOUN_SYN;
}
if( n <= 1 ) {
syn = GetObjName(self); // Default to what program named it
if( orig.isarray() ) {
if( orig.length() == 2 ) {
parser.defineVP(orig[0], orig[1], syn);
}
else {
parser.definePP(orig[0], orig[1], orig[2], syn);
}
}
else {
Dictionary[syn] = {typ, orig};
}
}
else {
for( i = 1; i < n; i++ ) {
syn = oadl::arg(i); // As requested by program
if( orig.isarray() ) {
if( orig.length() == 2 ) {
parser.defineVP(orig[0], orig[1], syn);
}
else {
parser.definePP(orig[0], orig[1], orig[2], syn);
}
}
else {
Dictionary[syn] = {typ, orig};
}
}
}
}
}
class PrepClass(WordClass) { var tokType = T_PREP; }
class VerbClass(WordClass) {
var tokType = T_VERB;
public var ObjList = {};
public var preact;
public var action;
}
class AdjecClass(WordClass) {
var tokType = T_ADJEC;
public var ObjList = {};
}
class NounClass(WordClass) {
var tokType = T_NOUN;
public var ObjList = {};
}
class ArtClass(WordClass) { var tokType = T_ARTICLE; }
class ConjClass(WordClass) { var tokType = T_CONJUNCTION; }
class SepClass(WordClass) { var tokType = T_SEPARATOR; }
class $Fuse {
protected var fuseProc, fuseTime;
public proc create(pp, tt) { fuseProc = pp; fuseTime = tt; }
public operator == (pp) { return fuseProc == pp; }
public operator #= (pp) { return fuseProc == pp; }
public operator <= (tt) { return fuseTime <= tt; }
}
class Actor(Thing) {
public var prevAct, nextAct; // Linked list of actors
var fuses = {};
var tokList, numTokens, tokIndex;
var interactive;
public proc setfuse( fuse, nTurns ) {
fuses = fuses ## new $Fuse(fuse, nTurns+Turns);
}
public proc delfuse(fuse) {
var cmp = fuses #= fuse;
fuses = fuses.replicate(Int(cmp));
}
public proc checkFuses() {
var cmp = fuses <= Turns;
var n = 0;
forall (cmp[i]) {
if (cmp[i]) {
fuses[i].fuseProc();
}
else {
fuses[n] = fuses[i];
n++;
}
}
fuses = fuses[:n-1];
}
public proc activate(str, flag) {
if( prevAct || nextAct ) {
// Already active
return;
}
prevAct = nil;
nextAct = actList;
if( actList ) {
actList.prevAct = self;
}
else {
lastAct = self;
}
actList = self;
fuses = {};
interactive = flag;
if( str ) {
tokList = Tokenize(str);
numTokens = tokList.length();
}
else {
numTokens = 0;
}
tokIndex = 0;
}
public proc deactivate() {
if( !(prevAct || nextAct) ) {
// Not active
return;
}
if( prevAct )
prevAct.nextAct = nextAct;
else
actList = nextAct;
if( nextAct )
nextAct.prevAct = prevAct;
else
lastAct = prevAct;
prevAct = nil;
nextAct = nil;
}
public proc GetToken() {
var str, i, n;
if( tokIndex == numTokens ) {
/* If we're at the end and we haven't encountered a
* separator yet, return a separator to close out
* the sentence.
*/
tokIndex++;
if( numTokens > 0 ) {
if( tokList[numTokens-1][0] != '.' ) {
return ".";
}
}
}
if( tokIndex > numTokens ) {
if( !interactive ) {
/* All done! */
deactivate();
return nil;
}
/* If we get here, we need to read a new line of input */
do {
Prompt();
str = Getstr();
if (echoInput) {
say(str, "\n");
}
tokList = Tokenize( str );
numTokens = tokList.length();
if( numTokens == 0 ) {
"I beg your pardon?\n";
}
} while( numTokens == 0 );
tokIndex = 0;
}
tokIndex++;
return tokList[tokIndex-1];
}
public proc detokenize()
{
var i, s;
s = "";
for( i = tokIndex; i < numTokens; i++ ) {
if( s ) {
s = s ## " " ## tokList[i];
}
else {
s = tokList[i];
}
}
return s;
}
public proc finishTokens()
{
tokIndex = numTokens;
}
}
proc Setdaemon( daemon )
{
Daemons = Daemons ## { daemon };
}
proc Incturn( nTurns )
{
var
i, j, n;
if( oadl::nargs() > 0 ) {
Turns += nTurns;
}
else {
Turns++;
}
}
proc ExitPhase( num )
{
if( !exitOK[num] ) {
"Invalid exit(",num,")\n";
throw oadl::RangeCheck;
}
exitOK[num] = 0;
oadl::longjmp( exitLocs[num], 1 );
}
// miss - Scans dirVec for the current Verb. If found, the corresponding
// rout in the (variable) arglist is called. Nothing happens if no match
// is found. An attempt to call a nil routine does nothing.
proc Miss()
{
for( var i = 0; i < oadl::nargs(); i++ ) {
if( Verb == dirVec[i] ) {
if( oadl::arg(i) ) {
(oadl::arg(i))();
}
break;
}
}
}
// hit - Scans dirVec for the current Verb. If found, 'obj' is moved to
// the corresponding loc in the (variable) arglist. Nothing happens if no
// match is found. An attempt to move an object to nil is ignored.
proc Hit(obj)
{
for( var i = 1; i < oadl::nargs(); i++ ) {
if( Verb == dirVec[i-1] ) {
if( oadl::arg(i) ) {
obj.move(oadl::arg(i));
}
break;
}
}
}
proc ::main(args)
{
var
ex, currAct, nextAct, lastTurn,
startArgs = {},
initFlags = 0,
i, n;
// See if we want a status line
args = args[1:];
forall (args[a]) {
if (args[a] == "-status") {
ShowStatus = 1;
initFlags |= INIT_STATUS_LINE;
}
else if (args[a] == "-echo") {
echoInput = true;
}
else {
startArgs = startArgs ## args[a];
}
}
if (ShowStatus) {
term::Start(term::CAN_SCROLL, term::IS_RAW_IN);
ScreenRows = term::Query(term::HEIGHT);
ScreenCols = term::Query(term::WIDTH);
ScreenWidth = ScreenCols - 8;
Width(ScreenWidth);
"\n"; // Need a space for the status line
}
// Call the initialization routine
Initadv(initFlags);
exitLocs = { new Array(oadl::JMP_SIZE), new Array(oadl::JMP_SIZE),
new Array(oadl::JMP_SIZE), new Array(oadl::JMP_SIZE) };
exitOK = {0, 0, 0, 0};
lastTurn = 0;
Phase = PHASE_START;
START(startArgs);
// This double-loop structure is so things can continue
// if we get an unanticipated exception. And so we can
// use continue in the inner loop (you cannot continue
// out of a try/except)
while( 1 ) {
try {
while( 1 ) {
Phase = PHASE_DAEMONS;
SET_EXIT(ex, PHX_CURRENT)
if( !ex ) {
// Exec fuses if the turn counter has changed
if( Turns != lastTurn ) {
for( currAct = actList; currAct; currAct = nextAct ) {
nextAct = currAct.nextAct;
$ME = currAct;
currAct.checkFuses();
}
lastTurn = Turns;
}
// Exec daemons. Set ME to the last actor on the
// list (which would be the first one activated)
$ME = lastAct;
n = Daemons.length();
for( i = 0; i < n; i += 1 ) {
Daemons[i]();
}
}
for( currAct = actList; currAct; currAct = nextAct ) {
nextAct = currAct.nextAct;
$ME = currAct;
SET_EXIT(ex, PHX_ACTOR)
if( ex ) {
continue;
}
parser.initvars();
while( 1 ) {
SET_EXIT(ex, PHX_SENTENCE)
if( !ex ) {
break;
}
}
do {
n = parser.parse();
} while( n == 0 );
if( n < 0 ) continue;
Numd = parser.pDobj.length();
n = Numd;
if (!n) n = 1;
for( i = 0; i < n; i += 1 ) {
SET_EXIT(ex, PHX_DOBJS)
if( ex ) {
continue;
}
Verb = parser.pVerb;
Conj = Numd ? parser.pConj[i] : nil;
Dobj = Numd ? parser.pDobj[i] : nil;
Prep = parser.pPrep;
Iobj = parser.pIobj;
Phase = PHASE_ACTOR;
SET_EXIT(ex, PHX_CURRENT)
if( !ex ) {
$ME.action();
}
Phase = PHASE_VERBPRE;
SET_EXIT(ex, PHX_CURRENT)
if( Verb && !ex ) {
Verb.preact();
}
Phase = PHASE_IOBJ;
SET_EXIT(ex, PHX_CURRENT)
if( Iobj && !ex ) {
if (typeof( Iobj ) == String) {
STRING.action();
}
else {
Iobj.action();
}
}
Phase = PHASE_DOBJ;
SET_EXIT(ex, PHX_CURRENT)
if( Dobj && !ex ) {
if (typeof( Dobj ) == String) {
STRING.action();
}
else {
Dobj.action();
}
}
Phase = PHASE_VERBACT;
SET_EXIT(ex, PHX_CURRENT)
if( Verb && !ex ) {
Verb.action();
}
$ClrExit(PHX_DOBJS);
}
Phase = PHASE_ROOM;
SET_EXIT(ex, PHX_CURRENT)
if( !ex ) {
$ME.loc.action();
}
$ClrExit(PHX_CURRENT);
$ClrExit(PHX_ACTOR);
$ClrExit(PHX_SENTENCE);
}
}
}
catch (e,f,l) {
"Caught exception: ", e, " from file ", f, " line ", l, "\n";
$ClrExit(PHX_CURRENT);
$ClrExit(PHX_ACTOR);
$ClrExit(PHX_DOBJS);
$ClrExit(PHX_SENTENCE);
if (e == oadl::InterruptCheck) break;
if (e == oadl::EndOfFile) break;
}
}
if (ShowStatus) {
term::Stop();
}
}
}
/* Redfines say and read, ultimately does header line */
using extern "libadv";