static /* orchestra{} section */
void readorch(Inst **insttopp)
{
char s[128];
Inst *p, *q = NULL;
#ifdef DEBUG
printf("Reading orchestra section\n");
#endif
gmac = NULL;
if (expectchar('{'))
scotferror(Str("Syntax error: no {"));
p = (*insttopp) = (Inst *) malloc(sizeof(Inst));
p->lmac = NULL;
for (;;) {
efindword(s);
if (s[0] == (char) '}')
break;
if (s[0] == (char) '[') {
if (p == (*insttopp))
readmacros(&gmac);
else
readmacros(&q->lmac);
continue;
}
p->name = (char *) malloc(strlen(s) + 1);
strcpy(p->name, s);
#ifdef DEBUG
printf("Instrument name: %s ", p->name);
#endif
if (expectchar('='))
scoterror(Str("Syntax error: no ="));
if (findint((int *) &p->number))
scoterror(Str("Syntax error: no number"));
#ifdef DEBUG
printf(" number: %d\n", p->number);
#endif
p->next = (Inst *) malloc(sizeof(Inst));
q = p;
p = p->next;
p->lmac = NULL;
}
if (p == *insttopp)
scotferror(Str("No instruments declared"));
free((char *) p);
q->next = NULL;
}
///////////////////////////////////////////////
// i_inherit(i_name*) (+)
// store references to inherited interfaces
//
BtFImpl(i_inherit, t, p)
{
ArgIdArityList i(t.getarg(0), p, "i_inherit");
while (i.next()) {
DbIntlog *dbi = findint(p->get_db(), i.funct);
if (!dbi || !p->get_db()->InheritInterface(dbi)) {
p->BtErr(BTERR_CANT_INHERIT, CCP(i.funct));
break;
}
}
return i.status;
}
//////////////////////////////////////////
// i_create(i_name, HandleEngine)
// create a new running interface (+, -)
//
BtFImpl(i_create, t, p)
{
ASSERT(all_engines);
ArgIdArityList i(t.getarg(0), p, "i_create");
if (!p->eval_term(t.getarg(1)).type(f_NOTERM)) {
p->BtErr(BTERR_INVALID_ARG_TYPE);
return 0;
}
EngHandle h = GetEngines()->create(p->get_db());
if (h == EH_NULL) {
p->BtErr(BTERR_CANT_CREATE_ENG);
return 0;
}
IntlogExec *pExec = GetEngines()->HtoD(h);
DbIntlog *engdb = pExec->get_db(), *dbi;
// scan all interfaces names
int errc = 0;
while (i.next()) {
// search for declared interface (from current to root)
if ((dbi = findint(p->get_db(), i.funct)) == 0)
errc = BTERR_CANT_FIND_DB;
else if (!engdb->InheritInterface(dbi))
errc = BTERR_CANT_INHERIT;
if (errc) {
// on error signal and reset
p->BtErr(errc, CCP(i.funct));
all_engines->destroy(h);
return 0;
}
}
return p->unify(p->save(Term(new EngineObj(h))), t.getarg(1));
}
static /* reads from one $instrument to the next */
void readinstsec(Inst *inst,
Nextp **nextlist,
Rat *grpmul,
Rat *timesig,
Rat *curtime,
Rat *lastbar,
Rat *lastnote,
Note **notetop,
Note **ln,
Tempo **tempop,
int *accidentals,
int *octaves,
int *vertical,
int *key, int *barkey, int *transpose, char *endchar)
{
static Rat durdiv = { 4L, 1L };
int c, z, lastpitchclass;
char s[128], *sp;
Rat ratstack, rattmp;
Note *pn, *nn, *pn2 = NULL;
Strlist *ps;
Nextp *nextpp;
#ifdef DEBUG
printf("Reading instrument section: %s\n", inst->name);
#endif
pn = (*notetop);
for (;;) {
findchar(&c);
if (strchr(endchar, c))
break;
#ifdef DEBUG
printf("Processing char: %c\n", c);
#endif
switch (c) {
case 't':
if (findint(&c)) {
scoterror(Str("Tempo must be specified"));
break;
}
if ((*tempop)->next) {
scoterror(Str("Redefinition of tempo"));
break;
}
(*tempop)->next = (Tempo *) malloc(sizeof(Tempo));
*tempop = (*tempop)->next;
(*tempop)->next = NULL;
ratass(&((*tempop)->time), curtime);
(*tempop)->val = c;
break;
case '!':
efindword(s);
if ((c = strlen(s)) < 2)
scoterror(Str("Must specify 2 or more letters of keyword"));
if (!strncmp(s, "accidentals", c)) {
if (findonoff(accidentals))
scoterror(Str("Must be \"on\" or \"off\""));
#ifdef DEBUG
printf(" accidentals %s\n", accidentals ? "on" : "off");
#endif
}
else if (!strncmp(s, "octaves", c)) {
if (findonoff(octaves))
scoterror(Str("Must be \"on\" or \"off\""));
#ifdef DEBUG
printf(" ocatves %s\n", *octaves ? "on" : "off");
#endif
}
else if (!strncmp(s, "vertical", c)) {
if (findonoff(vertical))
scoterror(Str("Must be \"on\" or \"off\""));
#ifdef DEBUG
printf(" vertical %s\n", *vertical ? "on" : "off");
#endif
}
else if (!strncmp(s, "timesignature", c)) {
efindword(s);
if ((sscanf(s, "%lu/%lu", ×ig->num, ×ig->denom) != 2)
||
(&(timesig->denom) == 0) ) {
scoterror(Str("Invalid time signature"));
timesig->num = 0;
timesig->denom = 1;
}
#ifdef DEBUG
printf(" time sig=%lu/%lu\n", timesig->num, timesig->denom);
#endif
ratstack.num = 4;
ratstack.denom = 1;
ratmul(timesig, timesig, &ratstack);
#ifdef DEBUG
printf(" measure length=%f\n", ratval(timesig));
#endif
}
else if (!strncmp(s, "key", c)) {
int y;
efindword(s);
for (z = 0; z < PITCHCLASSES; z++)
key[z] = 0;
c = y = 0;
for (z = 0; s[z] != (char) 0; z++)
switch ((int) s[z]) {
case '#':
c = y + 1;
y++;
break;
case '-':
c = y - 1;
y--;
break;
default:
if (!isalpha(s[z]))
scoterror(Str("Bad key signature"));
key[letterval((int) s[z])] = c;
y = 0;
}
for (z = 0; z < PITCHCLASSES; z++)
barkey[z] = key[z];
}
else if (!strncmp(s, "transpose", c)) {
efindword(s);
*transpose = 0;
for (z = 0; s[z]; z++) {
switch (s[z]) {
case ',':
(*transpose) -= NOTESPEROCT;
break;
case '\'':
(*transpose) += NOTESPEROCT;
break;
case '=':
(*transpose) = 0;
break;
case '#':
(*transpose)++;
break;
case '-':
(*transpose)--;
break;
default:
(*transpose) += naturals[letterval((int) s[z])];
}
}
}
else if (!strncmp(s, "next", c)) {
efindword(s);
if (sscanf(s, "p%d", &c) != 1) {
scoterror(Str("Invalid field"));
efindword(s);
break;
}
efindword(s);
if (sscanf(s, "p%d", &z) != 1) {
scoterror(Str("Invalid field"));
break;
}
if (*nextlist == NULL) {
*nextlist = (Nextp *) malloc(sizeof(Nextp));
nextpp = (*nextlist);
nextpp->next = NULL;
}
else {
nextpp = (*nextlist);
if ((c == nextpp->dst) || (z == nextpp->src))
scoterror(Str("Nested next-parameter passing"));
while (nextpp->next) {
nextpp = nextpp->next;
if ((c == nextpp->dst) || (z == nextpp->src))
scoterror(Str("Nested next-parameter passing"));
}
nextpp->next = (Nextp *) malloc(sizeof(Nextp));
nextpp = nextpp->next;
nextpp->next = NULL;
}
nextpp->src = c;
nextpp->dst = z;
}
else
scoterror(Str("Unrecognised keyword"));
break;
case '{':
findint(&c);
expectchar(':');
if (!c) {
ratstack.num = 2L;
ratstack.denom = 3L;
}
else {
ratstack.denom = (unsigned long) c;
findint(&c);
if (!c) {
for (z = 1; (unsigned long) z < ratstack.denom; z *= 2);
z /= 2;
ratstack.num = (unsigned long) z;
}
else
ratstack.num = (unsigned long) c;
expectchar(':');
}
ratmul(grpmul, grpmul, &ratstack);
readinstsec(inst, nextlist, grpmul, timesig, curtime,
lastbar, lastnote, notetop, ln, tempop, accidentals,
octaves, vertical, key, barkey, transpose, ":");
ratdiv(grpmul, grpmul, &ratstack);
expectchar(':');
expectchar('}');
break;
case '(':
ratass(&ratstack, curtime);
if (pn == (*notetop)) {
readinstsec(inst, nextlist, grpmul, timesig, curtime,
lastbar, lastnote, notetop, ln, tempop, accidentals,
octaves, vertical, key, barkey, transpose, ")");
pn = (*notetop);
}
else {
readinstsec(inst, nextlist, grpmul, timesig, curtime,
lastbar, lastnote, &pn2->next, ln, tempop, accidentals,
octaves, vertical, key, barkey, transpose, ")");
pn = pn2->next;
}
expectchar(')');
ratass(lastnote, &ratstack);
break;
case '/':
ratadd(lastbar, lastbar, timesig);
if ((timesig->num) && (ratcmp(lastbar, curtime))) {
scoterror(Str("Wrong number of beats in bar"));
ratass(lastbar, curtime);
}
for (z = 0; z < PITCHCLASSES; z++)
barkey[z] = key[z];
break;
case '<':
if (pn == NULL) {
scoterror(Str("Syntax error: cannot back up"));
break;
}
if (pn->next == NULL) {
pn->next = (Note *) malloc(sizeof(Note));
initnote(pn->next);
pn->next->instrum = pn->instrum + 0.01;
}
pn2 = pn;
pn = pn->next;
ratass(curtime, lastnote);
break;
default:
#ifdef DEBUG
printf("Reading note\n");
printf(" time=%lu/%lu\n", curtime->num, curtime->denom);
printf(" =%f\n", ratval(curtime));
#endif
scotungetc();
nn = (Note *) malloc(sizeof(Note));
nn->p = NULL;
nn->written = FALSE;
if (*notetop == NULL) {
pn = (*ln) = (*notetop) = (Note *) malloc(sizeof(Note));
initnote(*notetop);
(*notetop)->instrum = (double) inst->number + 0.01;
}
else if (ratcmp(curtime, lastnote))
pn = (*notetop);
nn->instrum = pn->instrum;
#ifdef DEBUG
printf(" instrument #%f\n", nn->instrum);
#endif
if (*vertical)
strlistcopy(&nn->carryp, &(*ln)->carryp);
else
strlistcopy(&nn->carryp, &pn->carryp);
for (nextpp = (*nextlist); nextpp; nextpp = nextpp->next) {
sp = findparam(nextpp->dst, &nn->carryp);
if (!strcmp(sp, "."))
strcpy(sp, NEXTP);
}
ratass(&nn->start, curtime);
if (!findint(&c)) {
ratstack.num = (unsigned long) c;
ratstack.denom = 1L;
ratdiv(&nn->dur, &durdiv, &ratstack);
ratass(&ratstack, &nn->dur);
rattmp.num = 1L;
rattmp.denom = 2L;
for (;;) {
findchar(&c);
if (c != '.')
break;
ratmul(&ratstack, &ratstack, &rattmp);
ratadd(&nn->dur, &nn->dur, &ratstack);
}
}
else {
if (*vertical)
ratass(&nn->dur, &((*ln)->lastdur));
else
ratass(&nn->dur, &pn->lastdur);
findchar(&c);
}
ratass(&nn->lastdur, &nn->dur);
ratmul(&nn->dur, &nn->dur, grpmul);
#ifdef DEBUG
printf(" duration=%f\n", ratval(&nn->dur));
printf(" c=%c\n", c);
#endif
if (c == '=') {
nn->octave = 8;
lastpitchclass = 0;
}
else {
nn->octave = pn->octave;
lastpitchclass = pn->pitchclass;
scotungetc();
}
for (;;) {
findchar(&c);
if (c == '\'')
nn->octave++;
else if (c == ',')
nn->octave--;
else
break;
}
if (c == 'r') {
ratass(lastnote, curtime);
ratmul(&rattmp, &nn->lastdur, grpmul);
ratadd(curtime, curtime, &rattmp);
ratass(&(*ln)->lastdur, &nn->lastdur);
ratass(&pn->lastdur, &nn->lastdur);
freenote(nn);
break;
}
else {
nn->pitchclass = letterval(c);
if (*octaves) {
c = nn->pitchclass - lastpitchclass;
if (c < -(PITCHCLASSES / 2))
nn->octave++;
else if (c > PITCHCLASSES / 2)
nn->octave--;
}
}
nn->accid = 0;
nn->accmod = FALSE;
for (;;) {
findchar(&c);
if (c == '#') {
nn->accid++;
nn->accmod = TRUE;
}
else if (c == '-') {
nn->accid--;
nn->accmod = TRUE;
}
else if (c == 'n') {
nn->accid = 0;
nn->accmod = TRUE;
}
else
break;
}
if (!nn->accmod)
nn->accid = barkey[nn->pitchclass];
else if (*accidentals)
barkey[nn->pitchclass] = nn->accid;
#ifdef DEBUG
printf(" transpose=%d\n", *transpose);
printf(" octave=%d pitchclass=%d accid=%d transpose=%d pitch=%f\n",
nn->octave, nn->pitchclass, nn->accid, *transpose,
pitchval(nn->octave, nn->pitchclass, nn->accid, *transpose));
#endif
if (c == '_') {
findchar(&c);
if (c == '_') {
nn->tie = TRUE;
nn->slur = 0;
findchar(&c);
}
else {
nn->slur = 1;
nn->tie = FALSE;
}
}
else {
nn->slur = 0;
nn->tie = FALSE;
}
if (pn->slur & 1)
nn->slur += 2;
#ifdef DEBUG
printf(" slur=%d tie=%d\n", nn->slur, nn->tie);
#endif
if (pn->tie) {
ratadd(&rattmp, &pn->start, &pn->dur);
if (ratcmp(&rattmp, curtime))
scoterror(Str("Improper tie"));
if (((nn->octave != pn->octave) ||
(nn->pitchclass != pn->pitchclass) ||
((nn->accid != pn->accid) && (nn->accmod))) &&
(pitchval(nn->octave, nn->pitchclass, nn->accid, *transpose) !=
pitchval(pn->octave, pn->pitchclass, pn->accid, *transpose)))
scoterror(Str("Tie between different pitches"));
ratadd(&pn->dur, &pn->dur, &nn->dur);
ratass(&pn->lastdur, &nn->lastdur);
pn->slur += nn->slur;
pn->tie = nn->tie;
freenote(nn);
nn = pn;
if (c == (char) '[')
scoterror(Str("Warning: params changed on tie"));
}
else {
ps = nn->p = (Strlist *) malloc(sizeof(Strlist));
for (z = 0; z < 4; z++) {
ps->next = (Strlist *) malloc(sizeof(Strlist));
ps = ps->next;
}
ps->next = NULL;
}
ps = nn->p;
sprintf(ps->str, "%.02f", nn->instrum);
ps = ps->next;
sprintf(ps->str, "%g", ratval(&nn->start));
ps = ps->next;
sprintf(ps->str, "%g", ratval(&nn->dur));
ps = ps->next;
sprintf(ps->str, "%d", nn->slur);
ps = ps->next;
sprintf(ps->str, "%.02f",
pitchval(nn->octave, nn->pitchclass, nn->accid, *transpose));
if (c == '[') {
char *pars;
int pnum;
pars = readparams(inst);
#ifdef DEBUG
printf("Params: %s\n", pars);
#endif
z = 0;
pnum = 6;
while (strchr(" \t\r\n", (int) pars[z]))
z++;
for (;;) {
if (pars[z] == (char) ']')
break;
c = 0;
while (!strchr(" \t\r\n:]", (int) pars[z]))
s[c++] = pars[z++];
s[c] = (char) 0;
#ifdef DEBUG
printf("Read: %s\n", s);
#endif
while (strchr(" \t\r\n", (int) pars[z]))
z++;
if (pars[z] == (char) ':') {
pnum = atoi(s);
if (pnum < 6)
scoterror(Str("Parameter number out of range"));
z++;
while (strchr(" \t\r\n", (int) pars[z]))
z++;
continue;
}
#ifdef DEBUG
printf("Param #%d: %s\n", pnum, s);
#endif
if (s[0] == (char) '\'') {
addparam(pnum, &s[1], &nn->p);
addparam(pnum, ".", &nn->carryp);
}
else {
addparam(pnum, s, &nn->p);
addparam(pnum, s, &nn->carryp);
}
pnum++;
}
free(pars);
}
else
scotungetc();
if ((nn != pn) && (!pn->written)) {
#ifdef DEBUG
printf(" doing nextp stuff:\n");
#endif
for (nextpp = (*nextlist); nextpp; nextpp = nextpp->next) {
#ifdef DEBUG
printf(" carrying p%d to p%d?\n", nextpp->src, nextpp->dst);
#endif
if (!strcmp(findparam(nextpp->dst, &pn->carryp), NEXTP)) {
sp = findparam(nextpp->dst, &pn->p);
if (!strcmp(sp, ".")) {
char *sp2;
sp2 = findparam(nextpp->src, &nn->p);
if (!strcmp(sp2, "."))
sp2 = findparam(nextpp->src, &nn->carryp);
strcpy(sp, sp2);
#ifdef DEBUG
printf(" Yes.\n");
#endif
}
}
}
writenote(pn);
}
if ((!(*nextlist)) && (!nn->tie))
writenote(nn);
if (nn != pn) {
if (!pn->written)
scoterror(Str("Lost previous note: not written"));
#ifdef DEBUG
if (pn->next == nn)
printf("* pn->next==nn\n");
#endif
nn->next = pn->next;
#ifdef DEBUG
if (pn2 == nn)
printf("* pn2==nn\n");
#endif
if (pn == *notetop)
*notetop = nn;
else
pn2->next = nn;
freenote(pn);
pn = nn;
#ifdef DEBUG
if (nn->next == nn)
printf("* Circular list created\n");
#endif
}
#ifdef DEBUG
printf(" nn linked into note list\n");
printf(" curtime=%lu/%lu\n", curtime->num, curtime->denom);
printf(" nn->dur=%lu/%lu\n", nn->dur.num, nn->dur.denom);
#endif
*ln = nn;
ratass(lastnote, curtime);
ratmul(&rattmp, &nn->lastdur, grpmul);
ratadd(curtime, curtime, &rattmp);
#ifdef DEBUG
printf(" curtime=%lu/%lu\n", curtime->num, curtime->denom);
printf(" Done with note\n");
#endif
}
}
scotungetc();
}
int main(void)
{
char choice;
PLANE flights[FLIGHTS];
int i, j;
int fl_num;
int index;
FILE * fp;
int flight_nums[] = {102, 311, 444, 519};
fp = fopen("flight2.dat", "r+b");
if (!fp)
{
fputs("Can't open flight2.dat", stderr);
exit(EXIT_FAILURE);
}
rewind(fp);
if (getc(fp) == EOF)
{
for (i = 0; i < FLIGHTS; i++)
{
flights[i].flight_num = flight_nums[i];
for (j = 0; j < SEATS; j++)
{
flights[i].vacancy[j].seat_id = j;
flights[i].vacancy[j].assigned = false;
flights[i].vacancy[j].confirmed = false;
flights[i].vacancy[j].first[0] = '\0';
flights[i].vacancy[j].last[0] = '\0';
}
}
puts("Done for initialization.");
}
else
{
fread(flights, sizeof(PLANE), FLIGHTS, fp);
puts("We have Flights 102, 311, 444, 519");
puts("Enter the flight number, non-numeric value to quit:");
while (scanf("%d", &fl_num) == 1)
{
eatline();
if (index = findint(flight_nums, FLIGHTS, fl_num) == -1)
{
puts("No such flight number. Enter again:");
continue;
}
do
{
puts("To choose a function, enter its letter label:");
puts("a) Show number of empty seats");
puts("b) Show list of empty seats");
puts("c) Show alphabetical list of seats");
puts("d) Assign a customer to a seat assignment");
puts("e) Delete a seat assignment");
puts("f) Confirming a seat assignment");
puts("g) Back to the top level menu");
choice = getchar();
eatline();
if (choice != 'g')
switch (choice)
{
case 'a' :
show_empty_seat_num(flights[index].vacancy, SEATS);
break;
case 'b' :
show_empty_seat_lst(flights[index].vacancy, SEATS);
break;
case 'c' :
show_alpha_lst(flights[index].vacancy, SEATS);
break;
case 'd' :
assign_customer(flights[index].vacancy, SEATS);
break;
case 'e' :
del_assign(flights[index].vacancy, SEATS);
break;
case 'f' :
confirm(flights[index].vacancy, SEATS);
default :
puts("Wrong choice!");
}
} while (choice != 'g');
puts("Enter the next flight number, non-numeric value to quit:");
}
}
rewind(fp);
fwrite(flights, sizeof(PLANE), FLIGHTS, fp);
fclose(fp);
return 0;
}
/////////////////////////////////////////////
// i_proplist(NameInt,Property,List) (+,+,?)
// retrieve property name/arity list
// for required interface e property
//
BtFImpl(i_proplist, t, p)
{
Term NameInt = p->eval_term(t.getarg(0)),
Prop = p->eval_term(t.getarg(1)),
ListProp(ListNULL);
DbIntlog *db;
if ( !NameInt.type(f_ATOM) ||
!Prop.type(f_ATOM) ||
(db = findint(p->get_db(), NameInt.kstr())) == 0)
{ err:
p->BtErr(BTERR_INVALID_ARG_TYPE);
return 0;
}
// search for property
DbEntry::scopemode prop;
BuiltIn* bt = p->get_db()->is_builtin(Prop, 1);
if (!bt)
goto err;
if (bt->eval == i_export) prop = DbEntry::exported;
else
if (bt->eval == i_import) prop = DbEntry::import;
else
if (bt->eval == i_dynamic) prop = DbEntry::dynamic;
else
if (bt->eval == i_begin) prop = DbEntry::local;
else goto err;
slist lprop;
db->EntriesWithProperty(prop, lprop);
// transform the slist in Prolog List
if (lprop.numel() > 0) {
Term tail(f_NOTERM);
slist_iter it(lprop);
DbIntlog::EntryWithProp *pEntry;
while ((pEntry = (DbIntlog::EntryWithProp *)it.next()) != 0) {
// build the name/arity structure
Term sProp = Term(kstring(Operator::DIV), 2);
sProp.setarg(0, Term(kstring(pEntry->id)));
sProp.setarg(1, Term(Int(pEntry->arity)));
Term elem = Term(sProp, Term(ListNULL));
if (tail.type(f_NOTERM))
tail = ListProp = elem;
else {
tail.setarg(1, elem);
tail = elem;
}
}
ListProp = p->save(ListProp);
}
return p->unify(t.getarg(2), ListProp);
}