integer nv3inimsat_(integer *ifunc, integer *iparms)
{
/* System generated locals */
integer ret_val;
char ch__1[4];
/* Builtin functions */
integer i_indx(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern integer lit_(char *, ftnlen);
extern /* Character */ VOID clit_(char *, ftnlen, integer *);
extern /* Subroutine */ int movw_(integer *, integer *, integer *);
extern real flalo_(integer *);
/* Parameter adjustments */
--iparms;
/* Function Body */
if (*ifunc == 1) {
if (iparms[1] != lit_("MSAT", (ftnlen)4)) {
ret_val = -1;
return ret_val;
}
movw_(&c__3, &iparms[4], polyxxmsatnv3_1.ioff);
metxxxmsatnv3_1.h__ = 35785.845000000001f;
metxxxmsatnv3_1.re = 6378.155f;
metxxxmsatnv3_1.a = .0033670033670033669f;
metxxxmsatnv3_1.rp = metxxxmsatnv3_1.re / (metxxxmsatnv3_1.a + 1.f);
metxxxmsatnv3_1.pi = 3.141592653f;
metxxxmsatnv3_1.cdr = metxxxmsatnv3_1.pi / 180.f;
metxxxmsatnv3_1.crd = 180.f / metxxxmsatnv3_1.pi;
metxxxmsatnv3_1.lpsi2 = 1;
metxxxmsatnv3_1.deltax = .0071999999999999998f;
metxxxmsatnv3_1.deltay = .0071999999999999998f;
metxxxmsatnv3_1.rflon = 0.f;
polyxxmsatnv3_1.sublon = flalo_(&iparms[7]);
} else if (*ifunc == 2) {
clit_(ch__1, (ftnlen)4, &iparms[1]);
if (i_indx(ch__1, "XY", (ftnlen)4, (ftnlen)2) != 0) {
metxxxmsatnv3_1.ic = 1;
}
clit_(ch__1, (ftnlen)4, &iparms[1]);
if (i_indx(ch__1, "LL", (ftnlen)4, (ftnlen)2) != 0) {
metxxxmsatnv3_1.ic = 2;
}
}
ret_val = 0;
return ret_val;
} /* nv3inimsat_ */
integer nv2inimsgt_(integer *ifunc, integer *iparms)
{
/* System generated locals */
integer ret_val;
char ch__1[4];
/* Builtin functions */
integer i_indx(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern integer lit_(char *, ftnlen);
extern /* Character */ VOID clit_(char *, ftnlen, integer *);
/* Parameter adjustments */
--iparms;
/* Function Body */
msgmsgtnv2_1.itype = 0;
ret_val = 0;
if (*ifunc == 1) {
if (iparms[1] != lit_("MSGT", (ftnlen)4)) {
ret_val = -1;
return ret_val;
}
nvparammsgtnv2_1.loff = iparms[2];
nvparammsgtnv2_1.coff = iparms[3];
nvparammsgtnv2_1.lfac = iparms[4];
nvparammsgtnv2_1.cfac = iparms[5];
} else if (*ifunc == 2) {
clit_(ch__1, (ftnlen)4, &iparms[1]);
if (i_indx(ch__1, "XY", (ftnlen)4, (ftnlen)2) != 0) {
msgmsgtnv2_1.itype = 1;
}
clit_(ch__1, (ftnlen)4, &iparms[1]);
if (i_indx(ch__1, "LL", (ftnlen)4, (ftnlen)2) != 0) {
msgmsgtnv2_1.itype = 2;
}
}
return ret_val;
} /* nv2inimsgt_ */
integer kb1optmsg_(char *cfunc, integer *iin, integer *iout, ftnlen cfunc_len)
{
/* System generated locals */
integer ret_val;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern integer lit_(char *, ftnlen);
extern /* Subroutine */ int movw_(integer *, integer *, integer *);
/* external functions */
/* Copyright(c) 1997, Space Science and Engineering Center, UW-Madison */
/* Refer to "McIDAS Software Acquisition and Distribution Policies" */
/* in the file mcidas/data/license.txt */
/* *** $Id: areaparm.inc,v 1.1 2000/07/12 13:12:23 gad Exp $ *** */
/* area subsystem parameters */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* IF YOU CHANGE THESE VALUES, YOU MUST ALSO CHANGE THEM IN */
/* MCIDAS.H !! */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* MAXGRIDPT maximum number of grid points */
/* MAX_BANDS maximum number of bands within an area */
/* MAXDFELEMENTS maximum number of elements that DF can handle */
/* in an area line */
/* MAXOPENAREAS maximum number of areas that the library can */
/* have open (formerly called `NA') */
/* NUMAREAOPTIONS number of options settable through ARAOPT() */
/* It is presently 5 because there are five options */
/* that ARAOPT() knows about: */
/* 'PREC','SPAC','UNIT','SCAL','CALB' */
/* (formerly called `NB') */
/* --- Size (number of words) in an area directory */
/* MAX_AUXBLOCK_SIZE size (in bytes) of the internal buffers */
/* used to recieve AUX blocks during an */
/* ADDE transaction */
/* ----- MAX_AREA_NUMBER Maximum area number allowed on system */
/* ----- MAXAREARQSTLEN - max length of area request string */
/* Parameter adjustments */
--iout;
--iin;
/* Function Body */
ret_val = 0;
if (s_cmp(cfunc, "KEYS", (ftnlen)4, (ftnlen)4) == 0) {
if (iin[4] <= 3 || iin[4] == 12) {
iout[1] = 4;
iout[2] = lit_("RAW ", (ftnlen)4);
iout[3] = lit_("RAD ", (ftnlen)4);
iout[4] = lit_("REFL", (ftnlen)4);
iout[5] = lit_("BRIT", (ftnlen)4);
} else {
iout[1] = 4;
iout[2] = lit_("RAW ", (ftnlen)4);
iout[3] = lit_("RAD ", (ftnlen)4);
iout[4] = lit_("TEMP", (ftnlen)4);
iout[5] = lit_("BRIT", (ftnlen)4);
}
} else if (s_cmp(cfunc, "INFO", (ftnlen)4, (ftnlen)4) == 0) {
if (iin[1] <= 3 || iin[1] == 12) {
iout[1] = 4;
iout[2] = lit_("RAW ", (ftnlen)4);
iout[3] = lit_("RAD ", (ftnlen)4);
iout[4] = lit_("REFL", (ftnlen)4);
iout[5] = lit_("BRIT", (ftnlen)4);
iout[6] = lit_(" ", (ftnlen)4);
iout[7] = lit_("MW**", (ftnlen)4);
iout[8] = lit_("% ", (ftnlen)4);
iout[9] = lit_(" ", (ftnlen)4);
iout[10] = 1;
iout[11] = 100;
iout[12] = 100;
iout[13] = 1;
} else {
iout[1] = 4;
iout[2] = lit_("RAW ", (ftnlen)4);
iout[3] = lit_("RAD ", (ftnlen)4);
iout[4] = lit_("TEMP", (ftnlen)4);
iout[5] = lit_("BRIT", (ftnlen)4);
iout[6] = lit_(" ", (ftnlen)4);
iout[7] = lit_("MW**", (ftnlen)4);
iout[8] = lit_("K ", (ftnlen)4);
iout[9] = lit_(" ", (ftnlen)4);
iout[10] = 1;
iout[11] = 100;
iout[12] = 100;
iout[13] = 1;
}
} else if (s_cmp(cfunc, "CALB", (ftnlen)4, (ftnlen)4) == 0) {
msgcommsgkb1_1.calflg = 1;
movw_(&c__313, &iin[1], msgcommsgkb1_1.calarr);
} else {
ret_val = -1;
}
return ret_val;
} /* kb1optmsg_ */
logical walk_()
{
/* System generated locals */
logical ret_val;
ret_val = TRUE_;
/* !ASSUME WINS. */
if (play_1.winner != aindex_1.player || lit_(play_1.here) || prob_(25,
25)) {
goto L500;
}
if (! findxt_(prsvec_1.prso, play_1.here)) {
goto L450;
}
/* !INVALID EXIT? GRUE */
/* ! */
switch (curxt_1.xtype) {
case 1: goto L400;
case 2: goto L200;
case 3: goto L100;
case 4: goto L300;
}
/* !DECODE EXIT TYPE. */
bug_(9, curxt_1.xtype);
L100:
if (cxappl_(curxt_1.xactio) != 0) {
goto L400;
}
/* !CEXIT... RETURNED ROOM? */
if (flags[*xflag - 1]) {
goto L400;
}
/* !NO, FLAG ON? */
L200:
jigsup_(523);
/* !BAD EXIT, GRUE */
/* ! */
return ret_val;
L300:
if (cxappl_(curxt_1.xactio) != 0) {
goto L400;
}
/* !DOOR... RETURNED ROOM? */
if ((objcts_1.oflag2[curxt_1.xobj - 1] & OPENBT) != 0) {
goto L400;
}
/* !NO, DOOR OPEN? */
jigsup_(523);
/* !BAD EXIT, GRUE */
/* ! */
return ret_val;
L400:
if (lit_(curxt_1.xroom1)) {
goto L900;
}
/* !VALID ROOM, IS IT LIT? */
L450:
jigsup_(522);
/* !NO, GRUE */
/* ! */
return ret_val;
/* ROOM IS LIT, OR WINNER IS NOT PLAYER (NO GRUE). */
L500:
if (findxt_(prsvec_1.prso, play_1.here)) {
goto L550;
}
/* !EXIT EXIST? */
L525:
curxt_1.xstrng = 678;
/* !ASSUME WALL. */
if (prsvec_1.prso == xsrch_1.xup) {
curxt_1.xstrng = 679;
}
/* !IF UP, CANT. */
if (prsvec_1.prso == xsrch_1.xdown) {
curxt_1.xstrng = 680;
}
/* !IF DOWN, CANT. */
if ((rooms_1.rflag[play_1.here - 1] & RNWALL) != 0) {
curxt_1.xstrng = 524;
}
rspeak_(curxt_1.xstrng);
prsvec_1.prscon = 1;
/* !STOP CMD STREAM. */
return ret_val;
L550:
switch (curxt_1.xtype) {
case 1: goto L900;
case 2: goto L600;
case 3: goto L700;
case 4: goto L800;
}
/* !BRANCH ON EXIT TYPE. */
bug_(9, curxt_1.xtype);
L700:
if (cxappl_(curxt_1.xactio) != 0) {
goto L900;
}
/* !CEXIT... RETURNED ROOM? */
if (flags[*xflag - 1]) {
goto L900;
}
/* !NO, FLAG ON? */
L600:
if (curxt_1.xstrng == 0) {
goto L525;
}
/* !IF NO REASON, USE STD. */
rspeak_(curxt_1.xstrng);
/* !DENY EXIT. */
prsvec_1.prscon = 1;
/* !STOP CMD STREAM. */
return ret_val;
L800:
if (cxappl_(curxt_1.xactio) != 0) {
goto L900;
}
/* !DOOR... RETURNED ROOM? */
if ((objcts_1.oflag2[curxt_1.xobj - 1] & OPENBT) != 0) {
goto L900;
}
/* !NO, DOOR OPEN? */
if (curxt_1.xstrng == 0) {
curxt_1.xstrng = 525;
}
/* !IF NO REASON, USE STD. */
rspsub_(curxt_1.xstrng, objcts_1.odesc2[curxt_1.xobj - 1]);
prsvec_1.prscon = 1;
/* !STOP CMD STREAM. */
return ret_val;
L900:
ret_val = moveto_(curxt_1.xroom1, play_1.winner);
/* !MOVE TO ROOM. */
if (ret_val) {
ret_val = rmdesc_(0);
}
/* !DESCRIBE ROOM. */
return ret_val;
} /* walk_ */
integer rdcalgmskb3_(integer *calb, integer *idir, integer *iband, integer *
itab)
{
/* Initialized data */
static real wnfctr[3] = { .7903f,.7874f,.8676f };
/* System generated locals */
address a__1[2];
integer ret_val, i__1, i__2, i__3[2];
real r__1;
char ch__1[55], ch__2[73], ch__3[42];
/* Builtin functions */
double r_sign(real *, real *), pow_ri(real *, integer *);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
double r_mod(real *, real *);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static real c__, g;
static integer i__, j, k;
static real r__, v, c0, v0;
static integer v1, v2, ig[3], iv, ic0[3], iv0[3], ida, dir[512], ihr, imn,
imo, iok, jok;
extern integer lit_(char *, ftnlen), lwix_(char *, integer *, integer *,
integer *, ftnlen);
static integer iss;
static real riv;
static integer iyr, ixv, ifac;
static real beta[21] /* was [7][3] */;
static integer ltab, ioff;
extern real gmtradgmskb3_(real *, integer *);
static integer kend;
extern /* Subroutine */ int gmpfcogmskb3_(char *, integer *, ftnlen);
static integer nlen;
extern /* Subroutine */ int movb_();
static real rrem;
static integer kbyt;
extern integer ksys_(integer *);
static integer idcal;
static char calbl[1*7168];
static integer iarea;
static char cfile[12], cname[4];
static integer ibeta[21] /* was [7][3] */, idate[2], ifact[3], idsen;
extern /* Subroutine */ int edestX_(char *, integer *, ftnlen);
static integer ntabs, istat;
extern /* Subroutine */ int sysin_(integer *, integer *);
static integer icalbl[1792];
extern /* Subroutine */ int swbyt4_(integer *, integer *), araget_(
integer *, integer *, integer *, integer *);
static integer ispare[3], lbstart, nbstart;
/* All variables must be declared */
/* from each line header for IBUF dat */
/* Input array of calibration constants */
/* for GMS, since the area calibratio */
/* block must be accessed locally) */
/* Area directory buffer (this is mandat */
/* Band number of data in area */
/* absolute radiation temperature */
/* Lookup table containing albedo or */
/* (defines NUMAREAOPTIONS) */
/* Global declarations for McIDAS areas */
/* Copyright(c) 1997, Space Science and Engineering Center, UW-Madison */
/* Refer to "McIDAS Software Acquisition and Distribution Policies" */
/* in the file mcidas/data/license.txt */
/* *** $Id: areaparm.inc,v 1.1 2000/07/12 13:12:23 gad Exp $ *** */
/* area subsystem parameters */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* IF YOU CHANGE THESE VALUES, YOU MUST ALSO CHANGE THEM IN */
/* MCIDAS.H !! */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* MAXGRIDPT maximum number of grid points */
/* MAX_BANDS maximum number of bands within an area */
/* MAXDFELEMENTS maximum number of elements that DF can handle */
/* in an area line */
/* MAXOPENAREAS maximum number of areas that the library can */
/* have open (formerly called `NA') */
/* NUMAREAOPTIONS number of options settable through ARAOPT() */
/* It is presently 5 because there are five options */
/* that ARAOPT() knows about: */
/* 'PREC','SPAC','UNIT','SCAL','CALB' */
/* (formerly called `NB') */
/* --- Size (number of words) in an area directory */
/* MAX_AUXBLOCK_SIZE size (in bytes) of the internal buffers */
/* used to recieve AUX blocks during an */
/* ADDE transaction */
/* ----- MAX_AREA_NUMBER Maximum area number allowed on system */
/* ----- MAXAREARQSTLEN - max length of area request string */
/* Flag identifying conversion code */
/* Source pixel size in bytes */
/* Destination pixel size in bytes */
/* Flag specifying how to construct ITAB */
/* Calibration parameters for conve */
/* Radiance table for GMS-5 */
/* We use only IVAL to pass back */
/* the calibration option used */
/* and rename ITAB because its */
/* address is passed as an arg */
/* platform or compiler depend */
/* too, and might be susceptab */
/* ID number of calibration table */
/* byte offset into GMSCAL file(s) */
/* Logical .AND. function */
/* Acquire SYSVAL value */
/* LW file read */
/* Converts CHAR*4 to INTEGER */
/* Real MOD function */
/* Converts GMS-5 TEMP to RAD */
/* index variable */
/* index variable */
/* index variable */
/* Length of arbitrary block in byt */
/* End word count of a block */
/* Input block starting byte count */
/* Output block starting byte count */
/* Input index value */
/* Interpolated data output index v */
/* First table value */
/* Second table value */
/* area number from IDIR array */
/* spacecraft/sensor ID from IDIR a */
/* LWI status returned */
/* Year */
/* Month */
/* Day of month */
/* Hour of day (GMT) */
/* Minute of hour */
/* (from first word in file) */
/* number of tables in the GMSCAL f */
/* Default GMSCAL table directory */
/* GMS-5 McIDAS Calibration block */
/* Calibration ID from data block */
/* (YY,YY,MM,DD,HH,mm) */
/* Six-byte date data block was gen */
/* (1=primary, 2=redundant) */
/* Sensor selector byte */
/* (significant if non-zero) */
/* bad radiance value counter */
/* (significant if non-zero) */
/* error flag for GMP_FCO function */
/* Byte address of CNAME block */
/* IR bands for converting DN to */
/* sensor output voltage (scaled */
/* Calibration constants for the th */
/* the series expansion for each */
/* Number of calibration constants */
/* G constant for each IR band */
/* V0 constant for each IR band */
/* C0 constant for each IR band */
/* Unused spare location in table */
/* the series expansion to be use */
/* Number of calibration constants */
/* Real input index value IV */
/* Remainder mod 1.0 */
/* IR bands for converting DN to */
/* sensor output voltage */
/* Calibration constants for the th */
/* (volts/watt/cm**2/sr) */
/* G constant to be used */
/* (zero level voltage) */
/* V0 constant to be used */
/* C0 constant to be used */
/* series expansion */
/* Intermediate "DN" value used in */
/* Output voltage from series expan */
/* (watts/cm**2/sr) */
/* Radiance from voltage and G cons */
/* W/cm**2/sr to W/etc/cm**-1 */
/* for the GMS-5 IR bands */
/* Wave number factor to convert fr */
/* calibration tables */
/* Input file containing default */
/* GMS-5 McIDAS Calibration block */
/* Table Name in calibration data b */
/* Parameter adjustments */
--itab;
--idir;
--calb;
/* Function Body */
iss = idir[3];
iarea = idir[33];
ltab = 0;
if (idir[3] == 12) {
ltab = 1;
} else if (idir[3] == 13) {
ltab = 3;
} else if (idir[3] == 82 && *iband == 1) {
ltab = 1;
} else if (idir[3] == 82 && *iband == 2) {
ltab = 3;
} else if (idir[3] == 82 && *iband == 8) {
ltab = 3;
} else if (idir[3] == 83 && *iband == 1) {
ltab = 4;
} else if (idir[3] == 83 && *iband == 2) {
ltab = 5;
} else if (idir[3] == 83 && *iband == 3) {
ltab = 6;
} else if (idir[3] == 83 && *iband == 4) {
ltab = 7;
} else if (idir[3] == 83 && *iband == 8) {
ltab = 5;
} else {
edestX_("RD_CAL: Unrecognized data band or SS", &c__0, (ftnlen)36);
ret_val = -1;
goto L500;
}
if (gmsxxgmskb3_1.kopt <= 0 || gmsxxgmskb3_1.kopt > 15) {
gmsxxgmskb3_1.kopt = ksys_(&c__151);
}
if (gmsxxgmskb3_1.kopt <= 0 || gmsxxgmskb3_1.kopt > 15) {
gmsxxgmskb3_1.kopt = 7;
if (idir[3] <= 82) {
gmsxxgmskb3_1.kopt = 3;
}
}
if (idir[3] <= 82 && gmsxxgmskb3_1.kopt > 3) {
edestX_("Invalid calibration option for SS=", &idir[3], (ftnlen)34);
edestX_(" ...was ", &gmsxxgmskb3_1.kopt, (ftnlen)12);
gmsxxgmskb3_1.kopt = 3;
edestX_(" ...reset to ", &gmsxxgmskb3_1.kopt, (ftnlen)17);
edestX_("Options > 3 valid for GMS-5 and later only!", &c__0, (ftnlen)
43);
}
debuggmskb3_2.ival = 0;
idsen = 0;
if ((gmsxxgmskb3_1.kopt & 12) != 0) {
araget_(&iarea, &idir[63], &c__7168, icalbl);
if (icalbl[0] != lit_("GMS5", (ftnlen)4) || icalbl[1] > 90) {
edestX_("Calibration block is not GMS-5 format.", &c__0, (ftnlen)
38);
edestX_("It cannot be used by the GMS calibration module.", &c__0,
(ftnlen)48);
edestX_("Will attempt to use GMSCAL file tables instead.", &c__0, (
ftnlen)47);
goto L200;
}
nlen = icalbl[1];
if (icalbl[2] == lit_("COEF", (ftnlen)4)) {
movb_(&c__256, icalbl, calbl, &c__0, (ftnlen)1);
for (i__ = 1; i__ <= 60; i__ += 3) {
i__1 = i__ + 2;
for (j = i__; j <= i__1; ++j) {
for (k = -3; k <= 0; ++k) {
if (*(unsigned char *)&calbl[(j << 2) + k - 1] < 32 ||
*(unsigned char *)&calbl[(j << 2) + k - 1] >
126) {
*(unsigned char *)&calbl[(j << 2) + k - 1] = '*';
}
}
}
}
movb_(&c__256, &icalbl[icalbl[3] / 4], calbl, &c__0, (ftnlen)1);
movb_(&c__4, calbl, &idcal, &c__0);
movb_(&c__6, calbl + 4, idate, &c__0, (ftnlen)1);
iyr = idate[0] / 65536;
imo = (idate[0] - (iyr << 16)) / 256;
ida = idate[0] - (iyr << 16) - (imo << 8);
ihr = idate[1] / 65536 / 256;
imn = idate[1] / 65536 - (ihr << 8);
movb_(&c__1, calbl + 10, &idsen, &c__0, (ftnlen)1);
idsen /= 16777216;
/* shift right 3 bytes */
ifact[0] = *(unsigned char *)&calbl[11];
movb_(&c__4, calbl + 12, ibeta, &c__0, (ftnlen)1);
movb_(&c__4, calbl + 16, &ibeta[1], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 20, &ibeta[2], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 24, &ibeta[3], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 28, &ibeta[4], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 32, &ibeta[5], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 36, &ibeta[6], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 40, ig, &c__0, (ftnlen)1);
movb_(&c__4, calbl + 44, iv0, &c__0, (ftnlen)1);
movb_(&c__4, calbl + 48, ic0, &c__0, (ftnlen)1);
movb_(&c__4, calbl + 52, ispare, &c__0, (ftnlen)1);
ifact[1] = *(unsigned char *)&calbl[56];
movb_(&c__4, calbl + 57, &ibeta[7], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 61, &ibeta[8], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 65, &ibeta[9], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 69, &ibeta[10], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 73, &ibeta[11], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 77, &ibeta[12], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 81, &ibeta[13], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 85, &ig[1], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 89, &iv0[1], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 93, &ic0[1], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 97, &ispare[1], &c__0, (ftnlen)1);
ifact[2] = *(unsigned char *)&calbl[101];
movb_(&c__4, calbl + 102, &ibeta[14], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 106, &ibeta[15], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 110, &ibeta[16], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 114, &ibeta[17], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 118, &ibeta[18], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 122, &ibeta[19], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 126, &ibeta[20], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 130, &ig[2], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 134, &iv0[2], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 138, &ic0[2], &c__0, (ftnlen)1);
movb_(&c__4, calbl + 142, &ispare[2], &c__0, (ftnlen)1);
if (*iband > 1 && *iband <= 4) {
g = (ig[*iband - 2] & 2147483647) * 1e-6f;
v0 = (iv0[*iband - 2] & 2147483647) * 1e-6f;
c0 = (ic0[*iband - 2] & 2147483647) * 1e-6f;
r__1 = (real) ig[*iband - 2];
g = r_sign(&g, &r__1);
r__1 = (real) iv0[*iband - 2];
v0 = r_sign(&v0, &r__1);
r__1 = (real) ic0[*iband - 2];
c0 = r_sign(&c0, &r__1);
ifac = ifact[*iband - 2] + 1;
if (ifac < 1 || ifac > 7) {
ifac = 7;
}
for (i__ = 1; i__ <= 3; ++i__) {
i__1 = ifac;
for (j = 1; j <= i__1; ++j) {
beta[j + i__ * 7 - 8] = (ibeta[j + i__ * 7 - 8] &
2147483647) * 1e-6f;
r__1 = (real) ibeta[j + i__ * 7 - 8];
beta[j + i__ * 7 - 8] = r_sign(&beta[j + i__ * 7 - 8],
&r__1);
}
}
for (j = 1; j <= 255; ++j) {
/* index on S-VISSR DN l */
c__ = 255.f - j + c0;
/* convert to instrument */
v = 0.f;
i__1 = ifac;
for (k = 1; k <= i__1; ++k) {
/* do the series expansi */
i__2 = k - 1;
v += beta[k + (*iband - 1) * 7 - 8] * pow_ri(&c__, &
i__2);
}
r__ = (v - v0) / g;
/* convert to radiance W */
r__ = r__ * .5f / wnfctr[*iband - 2];
/* convert to mW/etc./cm */
radgmskb3_1.ktab[j - 1] = (integer) (r__ * 1e3f);
/* the KTAB table as */
/* scale by 1000 and put */
}
iok = 0;
for (j = 2; j <= 255; ++j) {
if (radgmskb3_1.ktab[j - 1] < 0 || radgmskb3_1.ktab[j - 1]
> 190000) {
++iok;
}
}
}
} else {
goto L100;
}
if (ltab <= 3) {
goto L100;
}
if (ltab == 4) {
s_copy(cname, "5VIS", (ftnlen)4, (ftnlen)4);
}
if (ltab == 5) {
s_copy(cname, "5IR1", (ftnlen)4, (ftnlen)4);
}
if (ltab == 6) {
s_copy(cname, "5IR2", (ftnlen)4, (ftnlen)4);
}
if (ltab == 7) {
s_copy(cname, "5IR3", (ftnlen)4, (ftnlen)4);
}
if (ltab >= 8) {
goto L100;
}
kbyt = 0;
kend = nlen / 4;
if (kend > 22) {
edestX_("RD_CAL: Bad directory structure. KEND=", &kend, (ftnlen)
39);
kend = 22;
}
i__1 = kend;
for (j = 5; j <= i__1; ++j) {
if (icalbl[j - 1] == lit_(cname, (ftnlen)4)) {
kbyt = icalbl[j];
}
}
if (kbyt != 0) {
movb_(&c__1024, &icalbl[kbyt / 4], &itab[1], &c__0);
itab[1] = itab[2];
itab[256] = itab[255];
} else {
edestX_("KBYT cannot be set -- no table exists", &c__0, (ftnlen)37)
;
goto L100;
}
if (*iband != 1) {
goto L80;
}
for (i__ = 4; i__ >= 1; --i__) {
lbstart = (i__ - 1 << 6) + 1;
nbstart = i__ - 1 << 8;
for (ixv = 256; ixv >= 1; --ixv) {
riv = (real) (ixv - 1) / 252.f * 63.f;
iv = riv;
v1 = itab[lbstart + iv];
v2 = itab[lbstart + iv + 1];
if (iv == 63) {
v2 = 1000000;
}
rrem = r_mod(&riv, &c_b208);
itab[nbstart + ixv] = v1 + (v2 - v1) * rrem + .5f;
}
}
L80:
debuggmskb3_2.ival = 8;
if (iok > 5 && (gmsxxgmskb3_1.kopt & 15) == 8) {
edestX_("Too many of the real-time power series radiances are", &
c__0, (ftnlen)52);
edestX_("outside expected limits and are likely to be in error.", &
c__0, (ftnlen)54);
goto L100;
}
if ((gmsxxgmskb3_1.kopt & 4) == 0) {
goto L400;
}
}
L100:
if ((gmsxxgmskb3_1.kopt & 4) != 0) {
if (iss == 83) {
if (idsen != 2) {
gmpfcogmskb3_("A", &jok, (ftnlen)1);
}
if (idsen == 2) {
gmpfcogmskb3_("B", &jok, (ftnlen)1);
}
if (jok == 0) {
goto L300;
}
for (j = 1; j <= 256; ++j) {
r__1 = itab[j] * .001f;
radgmskb3_1.ktab[j - 1] = gmtradgmskb3_(&r__1, iband) * 1e3f;
}
} else {
goto L200;
}
debuggmskb3_2.ival = 4;
goto L400;
}
L200:
if ((gmsxxgmskb3_1.kopt & 2) != 0) {
s_copy(cfile, "GMSCALU", (ftnlen)12, (ftnlen)7);
istat = lwix_(cfile, &c__0, &c__512, dir, (ftnlen)12);
swbyt4_(dir, &c__512);
if (istat != 0 && (gmsxxgmskb3_1.kopt & 1) == 0) {
/* Writing concatenation */
i__3[0] = 43, a__1[0] = "ERROR reading calibration tables from f"
"ile ";
i__3[1] = 12, a__1[1] = cfile;
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)55);
edestX_(ch__1, &c__0, (ftnlen)55);
goto L300;
}
ntabs = dir[0];
ioff = (ltab - 1 << 8) + 512;
if (ltab > ntabs) {
goto L300;
}
istat = lwix_(cfile, &ioff, &c__256, &itab[1], (ftnlen)12);
swbyt4_(&itab[1], &c__256);
for (j = 1; j <= 256; ++j) {
itab[j + 256] = itab[j];
itab[j + 512] = itab[j];
itab[j + 768] = itab[j];
}
if (istat != 0) {
goto L300;
}
if (iss == 83) {
if (idsen != 2) {
gmpfcogmskb3_("A", &jok, (ftnlen)1);
}
if (idsen == 2) {
gmpfcogmskb3_("B", &jok, (ftnlen)1);
}
if (jok == 0) {
goto L300;
}
for (j = 1; j <= 256; ++j) {
r__1 = itab[j] * .001f;
radgmskb3_1.ktab[j - 1] = gmtradgmskb3_(&r__1, iband) * 1e3f;
}
}
debuggmskb3_2.ival = 2;
goto L400;
}
L300:
if ((gmsxxgmskb3_1.kopt & 1) != 0) {
s_copy(cfile, "GMSCAL", (ftnlen)12, (ftnlen)6);
istat = lwix_(cfile, &c__0, &c__512, dir, (ftnlen)12);
swbyt4_(dir, &c__512);
if (istat != 0) {
/* Writing concatenation */
i__3[0] = 43, a__1[0] = "ERROR reading calibration tables from f"
"ile ";
i__3[1] = 12, a__1[1] = cfile;
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)55);
edestX_(ch__1, &c__0, (ftnlen)55);
ret_val = -1;
goto L500;
}
ntabs = dir[0];
ioff = (ltab - 1 << 8) + 512;
if (ltab > ntabs) {
edestX_("RD_CAL ERROR -- Unrecognized Table ID=", <ab, (ftnlen)
38);
/* Writing concatenation */
i__3[0] = 61, a__1[0] = "The table index is greater than number "
"of tables in the file ";
i__3[1] = 12, a__1[1] = cfile;
s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)73);
edestX_(ch__2, &c__0, (ftnlen)73);
edestX_("Check SS and band number for consistency with the table "
"ID", &c__0, (ftnlen)58);
edestX_(" SS=", &idir[3], (
ftnlen)38);
edestX_(" Band=", iband, (ftnlen)
38);
ret_val = -1;
goto L500;
}
istat = lwix_(cfile, &ioff, &c__256, &itab[1], (ftnlen)12);
swbyt4_(&itab[1], &c__256);
for (j = 1; j <= 256; ++j) {
itab[j + 256] = itab[j];
itab[j + 512] = itab[j];
itab[j + 768] = itab[j];
}
if (istat != 0) {
/* Writing concatenation */
i__3[0] = 30, a__1[0] = "File status error reading file";
i__3[1] = 12, a__1[1] = cfile;
s_cat(ch__3, a__1, i__3, &c__2, (ftnlen)42);
edestX_(ch__3, &istat, (ftnlen)42);
ret_val = -1;
goto L500;
}
if (iss == 83) {
if (idsen != 2) {
gmpfcogmskb3_("A", &jok, (ftnlen)1);
}
if (idsen == 2) {
gmpfcogmskb3_("B", &jok, (ftnlen)1);
}
if (jok == 0) {
ret_val = -1;
goto L500;
}
for (j = 1; j <= 256; ++j) {
r__1 = itab[j] * .001f;
radgmskb3_1.ktab[j - 1] = gmtradgmskb3_(&r__1, iband) * 1e3f;
}
}
debuggmskb3_2.ival = 1;
goto L400;
}
ret_val = -1;
goto L500;
L400:
if (debuggmskb3_2.ival == 0) {
ret_val = -1;
} else {
ret_val = 0;
}
L500:
sysin_(&c__152, &debuggmskb3_2.ival);
for (i__ = 1; i__ <= 1024; ++i__) {
debuggmskb3_2.itabr[i__ - 1] = itab[i__];
}
return ret_val;
} /* rdcalgmskb3_ */
integer kb3optgms_(char *cfunc, integer *iin, integer *iout, ftnlen cfunc_len)
{
/* System generated locals */
address a__1[3];
integer ret_val, i__1[3];
char ch__1[34];
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
extern integer lit_(char *, ftnlen);
static char cfile[8];
extern /* Subroutine */ int edestX_(char *, integer *, ftnlen);
static integer itest;
extern /* Subroutine */ int movwc_(integer *, char *, ftnlen);
extern integer ischar_(integer *), brkset_(char *, char *, ftnlen, ftnlen)
;
/* All variables must be declared */
/* Option or function descriptor */
/* Input parameters */
/* Output parameters */
/* (defines NUMAREAOPTIONS) */
/* Global declarations for McIDAS a */
/* Copyright(c) 1997, Space Science and Engineering Center, UW-Madison */
/* Refer to "McIDAS Software Acquisition and Distribution Policies" */
/* in the file mcidas/data/license.txt */
/* *** $Id: areaparm.inc,v 1.1 2000/07/12 13:12:23 gad Exp $ *** */
/* area subsystem parameters */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* IF YOU CHANGE THESE VALUES, YOU MUST ALSO CHANGE THEM IN */
/* MCIDAS.H !! */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* MAXGRIDPT maximum number of grid points */
/* MAX_BANDS maximum number of bands within an area */
/* MAXDFELEMENTS maximum number of elements that DF can handle */
/* in an area line */
/* MAXOPENAREAS maximum number of areas that the library can */
/* have open (formerly called `NA') */
/* NUMAREAOPTIONS number of options settable through ARAOPT() */
/* It is presently 5 because there are five options */
/* that ARAOPT() knows about: */
/* 'PREC','SPAC','UNIT','SCAL','CALB' */
/* (formerly called `NB') */
/* --- Size (number of words) in an area directory */
/* MAX_AUXBLOCK_SIZE size (in bytes) of the internal buffers */
/* used to recieve AUX blocks during an */
/* ADDE transaction */
/* ----- MAX_AREA_NUMBER Maximum area number allowed on system */
/* ----- MAXAREARQSTLEN - max length of area request string */
/* Flag identifying conversion code */
/* Source pixel size in bytes */
/* Destination pixel size in bytes */
/* Flag specifying how to construct */
/* Calibration parameters for conve */
/* Common block for BRKSET table type */
/* Calibration type for breakpoint */
/* Sets breakpoint table values */
/* Numeric ASCII value of character */
/* Four byte integer representing C */
/* Logical AND function */
/* (stored in frame dir words 38- */
/* Breakpoint table name for SU */
/* Validity test variable */
/* Parameter adjustments */
--iout;
--iin;
/* Function Body */
if (s_cmp(cfunc, "KEYS", (ftnlen)4, (ftnlen)4) == 0) {
if (iin[1] == 12 || iin[1] >= 82 && iin[4] == 1) {
iout[1] = 3;
iout[2] = lit_("RAW ", (ftnlen)4);
iout[3] = lit_("ALB ", (ftnlen)4);
iout[4] = lit_("BRIT", (ftnlen)4);
} else if (iin[1] == 13 || iin[1] >= 82 && iin[4] > 1) {
iout[1] = 4;
iout[2] = lit_("RAW ", (ftnlen)4);
iout[3] = lit_("RAD ", (ftnlen)4);
iout[4] = lit_("TEMP", (ftnlen)4);
iout[5] = lit_("BRIT", (ftnlen)4);
} else {
edestX_("KBX_OPT: Cannot identify vis or IR for KEYS option.", &
c__0, (ftnlen)51);
}
ret_val = 0;
if (ischar_(&iin[38]) == 1) {
movwc_(&iin[38], cfile, (ftnlen)8);
if (brkset_(cfile, brkpntgmskb3_1.caltyp, (ftnlen)8, (ftnlen)4) !=
0) {
ret_val = -3;
}
}
} else if (s_cmp(cfunc, "BRKP", (ftnlen)4, (ftnlen)4) == 0) {
movwc_(&iin[1], cfile, (ftnlen)8);
ret_val = 0;
if (brkset_(cfile, brkpntgmskb3_1.caltyp, (ftnlen)8, (ftnlen)4) != 0)
{
ret_val = -3;
}
} else if (s_cmp(cfunc, "INFO", (ftnlen)4, (ftnlen)4) == 0) {
if (iin[2] == 12 || iin[2] >= 82 && iin[1] == 1) {
iout[1] = 3;
iout[2] = lit_("RAW ", (ftnlen)4);
iout[3] = lit_("ALB ", (ftnlen)4);
iout[4] = lit_("BRIT", (ftnlen)4);
iout[5] = lit_(" ", (ftnlen)4);
iout[6] = lit_(" % ", (ftnlen)4);
iout[7] = lit_(" ", (ftnlen)4);
iout[8] = 1;
iout[9] = 10;
iout[10] = 1;
} else if (iin[2] == 13 || iin[2] >= 82 && iin[1] > 1) {
iout[1] = 4;
iout[2] = lit_("RAW ", (ftnlen)4);
iout[3] = lit_("RAD ", (ftnlen)4);
iout[4] = lit_("TEMP", (ftnlen)4);
iout[5] = lit_("BRIT", (ftnlen)4);
iout[6] = lit_(" ", (ftnlen)4);
iout[7] = lit_("MW**", (ftnlen)4);
iout[8] = lit_(" K ", (ftnlen)4);
iout[9] = lit_(" ", (ftnlen)4);
iout[10] = 1;
iout[11] = 100;
iout[12] = 10;
iout[13] = 1;
} else {
edestX_("KBX_OPT: Cannot identify vis or IR for INFO option.", &
c__0, (ftnlen)51);
}
ret_val = 0;
} else if (s_cmp(cfunc, "METH", (ftnlen)4, (ftnlen)4) == 0) {
itest = iin[1] & -16;
if (itest != 0) {
ret_val = -4;
gmsxxgmskb3_1.kopt = 0;
edestX_("KB3OPTgms : Invali"
"d calibration table method! ", &iin[1], (ftnlen)85);
edestX_(" Must be 1-15", &c__0, (ftnlen)20);
} else {
ret_val = 0;
gmsxxgmskb3_1.kopt = iin[1];
}
} else {
/* Writing concatenation */
i__1[0] = 27, a__1[0] = "Unknown KBX_OPT function-->";
i__1[1] = 4, a__1[1] = cfunc;
i__1[2] = 3, a__1[2] = "<--";
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)34);
edestX_(ch__1, &c__0, (ftnlen)34);
ret_val = -1;
}
return ret_val;
} /* kb3optgms_ */
void cevapp_(integer ri)
{
/* Initialized data */
static const integer cndtck[10] = { 50,20,10,5,0,156,156,156,157,0 };
static const integer lmptck[12] = { 50,30,20,10,4,0,154,154,154,154,155,0 };
/* System generated locals */
integer i__1, i__2;
/* Local variables */
logical f;
integer i, j, bc, br;
if (ri == 0)
return;
/* !IGNORE DISABLED. */
switch (ri) {
case 1: goto L1000;
case 2: goto L2000;
case 3: goto L3000;
case 4: goto L4000;
case 5: goto L5000;
case 6: goto L6000;
case 7: goto L7000;
case 8: goto L8000;
case 9: goto L9000;
case 10: goto L10000;
case 11: goto L11000;
case 12: goto L12000;
case 13: goto L13000;
case 14: goto L14000;
case 15: goto L15000;
case 16: goto L16000;
case 17: goto L17000;
case 18: goto L18000;
case 19: goto L19000;
case 20: goto L20000;
case 21: goto L21000;
case 22: goto L22000;
case 23: goto L23000;
case 24: goto L24000;
}
bug_(3, ri);
/* CEV1-- CURE CLOCK. LET PLAYER SLOWLY RECOVER. */
L1000:
/* Computing MIN */
i__1 = 0, i__2 = advs_1.astren[aindex_1.player - 1] + 1;
advs_1.astren[aindex_1.player - 1] = min(i__1,i__2);
/* !RECOVER. */
if (advs_1.astren[aindex_1.player - 1] >= 0)
return;
/* !FULLY RECOVERED? */
cevent_1.ctick[cindex_1.cevcur - 1] = 30;
/* !NO, WAIT SOME MORE. */
return;
/* CEV2-- MAINT-ROOM WITH LEAK. RAISE THE WATER LEVEL. */
L2000:
if (play_1.here == rindex_1.maint) {
i__1 = findex_1.rvmnt / 2 + 71;
rspeak_(i__1);
}
/* !DESCRIBE. */
++findex_1.rvmnt;
/* !RAISE WATER LEVEL. */
if (findex_1.rvmnt <= 16)
return;
/* !IF NOT FULL, EXIT. */
cevent_1.ctick[cindex_1.cevmnt - 1] = 0;
/* !FULL, DISABLE CLOCK. */
rooms_1.rflag[rindex_1.maint - 1] |= RMUNG;
rrand[rindex_1.maint - 1] = 80;
/* !SAY IT IS FULL OF WATER. */
if (play_1.here == rindex_1.maint)
jigsup_(81);
/* !DROWN HIM IF PRESENT. */
return;
/* CEV3-- LANTERN. DESCRIBE GROWING DIMNESS. */
L3000:
litint_(oindex_1.lamp, &findex_1.orlamp, cindex_1.cevlnt, lmptck, 12);
/* !DO LIGHT INTERRUPT. */
return;
/* CEV4-- MATCH. OUT IT GOES. */
L4000:
rspeak_(153);
/* !MATCH IS OUT. */
objcts_1.oflag1[oindex_1.match - 1] &= ~ ONBT;
return;
/* CEV5-- CANDLE. DESCRIBE GROWING DIMNESS. */
L5000:
litint_(oindex_1.candl, &findex_1.orcand, cindex_1.cevcnd, cndtck, 10);
/* !DO CANDLE INTERRUPT. */
return;
/* CEVAPP, PAGE 3 */
/* CEV6-- BALLOON */
L6000:
cevent_1.ctick[cindex_1.cevbal - 1] = 3;
/* !RESCHEDULE INTERRUPT. */
f = advs_1.avehic[play_1.winner - 1] == oindex_1.ballo;
/* !SEE IF IN BALLOON. */
if (state_1.bloc == rindex_1.vlbot)
goto L6800;
/* !AT BOTTOM? */
if (state_1.bloc == rindex_1.ledg2 || state_1.bloc == rindex_1.ledg3 ||
state_1.bloc == rindex_1.ledg4 || state_1.bloc == rindex_1.vlbot)
goto L6700;
/* !ON LEDGE? */
if ((objcts_1.oflag2[oindex_1.recep - 1] & OPENBT) != 0 &&
findex_1.binff != 0)
goto L6500;
/* BALLOON IS IN MIDAIR AND IS DEFLATED (OR HAS RECEPTACLE CLOSED). */
/* FALL TO NEXT ROOM. */
if (state_1.bloc != rindex_1.vair1)
goto L6300;
/* !IN VAIR1? */
state_1.bloc = rindex_1.vlbot;
/* !YES, NOW AT VLBOT. */
newsta_(oindex_1.ballo, 0, state_1.bloc, 0, 0);
if (f)
goto L6200;
/* !IN BALLOON? */
if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 ||
play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot)
rspeak_(530);
/* !ON LEDGE, DESCRIBE. */
return;
L6200:
f = moveto_(state_1.bloc, play_1.winner);
/* !MOVE HIM. */
if (findex_1.binff == 0)
goto L6250;
/* !IN BALLOON. INFLATED? */
rspeak_(531);
/* !YES, LANDED. */
f = rmdesc_(0);
/* !DESCRIBE. */
return;
L6250:
newsta_(oindex_1.ballo, 532, 0, 0, 0);
/* !NO, BALLOON & CONTENTS DIE. */
newsta_(oindex_1.dball, 0, state_1.bloc, 0, 0);
/* !INSERT DEAD BALLOON. */
advs_1.avehic[play_1.winner - 1] = 0;
/* !NOT IN VEHICLE. */
cevent_1.cflag[cindex_1.cevbal - 1] = FALSE_;
/* !DISABLE INTERRUPTS. */
cevent_1.cflag[cindex_1.cevbrn - 1] = FALSE_;
findex_1.binff = 0;
findex_1.btief = 0;
return;
L6300:
--state_1.bloc;
/* !NOT IN VAIR1, DESCEND. */
newsta_(oindex_1.ballo, 0, state_1.bloc, 0, 0);
if (f)
goto L6400;
/* !IS HE IN BALLOON? */
if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 ||
play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot)
rspeak_(533);
/* !IF ON LEDGE, DESCRIBE. */
return;
L6400:
f = moveto_(state_1.bloc, play_1.winner);
/* !IN BALLOON, MOVE HIM. */
rspeak_(534);
/* !DESCRIBE. */
f = rmdesc_(0);
return;
/* BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY */
/* ! */
L6500:
if (state_1.bloc != rindex_1.vair4)
goto L6600;
/* !AT VAIR4? */
cevent_1.ctick[cindex_1.cevbrn - 1] = 0;
cevent_1.ctick[cindex_1.cevbal - 1] = 0;
findex_1.binff = 0;
findex_1.btief = 0;
state_1.bloc = rindex_1.vlbot;
/* !FALL TO BOTTOM. */
newsta_(oindex_1.ballo, 0, 0, 0, 0);
/* !BALLOON & CONTENTS DIE. */
newsta_(oindex_1.dball, 0, state_1.bloc, 0, 0);
/* !SUBSTITUTE DEAD BALLOON. */
if (f)
goto L6550;
/* !WAS HE IN IT? */
if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 ||
play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot)
rspeak_(535);
/* !IF HE CAN SEE, DESCRIBE. */
return;
L6550:
jigsup_(536);
/* !IN BALLOON AT CRASH, DIE. */
return;
L6600:
++state_1.bloc;
/* !NOT AT VAIR4, GO UP. */
newsta_(oindex_1.ballo, 0, state_1.bloc, 0, 0);
if (f)
goto L6650;
/* !IN BALLOON? */
if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 ||
play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot)
rspeak_(537);
/* !CAN HE SEE IT? */
return;
L6650:
f = moveto_(state_1.bloc, play_1.winner);
/* !MOVE PLAYER. */
rspeak_(538);
/* !DESCRIBE. */
f = rmdesc_(0);
return;
/* ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT. */
L6700:
state_1.bloc += rindex_1.vair2 - rindex_1.ledg2;
/* !MOVE TO MIDAIR. */
newsta_(oindex_1.ballo, 0, state_1.bloc, 0, 0);
if (f)
goto L6750;
/* !IN BALLOON? */
if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 ||
play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot)
rspeak_(539);
/* !NO, STRANDED. */
cevent_1.ctick[cindex_1.cevvlg - 1] = 10;
/* !MATERIALIZE GNOME. */
return;
L6750:
f = moveto_(state_1.bloc, play_1.winner);
/* !MOVE TO NEW ROOM. */
rspeak_(540);
/* !DESCRIBE. */
f = rmdesc_(0);
return;
/* AT BOTTOM, GO UP IF INFLATED, DO NOTHING IF DEFLATED. */
L6800:
if (findex_1.binff == 0 ||
! ((objcts_1.oflag2[oindex_1.recep - 1] & OPENBT) != 0))
return;
state_1.bloc = rindex_1.vair1;
/* !INFLATED AND OPEN, */
newsta_(oindex_1.ballo, 0, state_1.bloc, 0, 0);
/* !GO UP TO VAIR1. */
if (f)
goto L6850;
/* !IN BALLOON? */
if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 ||
play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot)
rspeak_(541);
/* !IF CAN SEE, DESCRIBE. */
return;
L6850:
f = moveto_(state_1.bloc, play_1.winner);
/* !MOVE PLAYER. */
rspeak_(542);
f = rmdesc_(0);
return;
/* CEVAPP, PAGE 4 */
/* CEV7-- BALLOON BURNUP */
L7000:
i__1 = objcts_1.olnt;
for (i = 1; i <= i__1; ++i) {
/* !FIND BURNING OBJECT */
if (oindex_1.recep == objcts_1.ocan[i - 1] &&
(objcts_1.oflag1[i - 1] & FLAMBT) != 0)
goto L7200;
/* L7100: */
}
bug_(4, 0);
L7200:
newsta_(i, 0, 0, 0, 0);
/* !VANISH OBJECT. */
findex_1.binff = 0;
/* !UNINFLATED. */
if (play_1.here == state_1.bloc)
rspsub_(292, objcts_1.odesc2[i - 1]);
/* !DESCRIBE. */
return;
/* CEV8-- FUSE FUNCTION */
L8000:
if (objcts_1.ocan[oindex_1.fuse - 1] != oindex_1.brick)
goto L8500;
/* !IGNITED BRICK? */
br = objcts_1.oroom[oindex_1.brick - 1];
/* !GET BRICK ROOM. */
bc = objcts_1.ocan[oindex_1.brick - 1];
/* !GET CONTAINER. */
if (br == 0 && bc != 0)
br = objcts_1.oroom[bc - 1];
newsta_(oindex_1.fuse, 0, 0, 0, 0);
/* !KILL FUSE. */
newsta_(oindex_1.brick, 0, 0, 0, 0);
/* !KILL BRICK. */
if (br != 0 && br != play_1.here)
goto L8100;
/* !BRICK ELSEWHERE? */
rooms_1.rflag[play_1.here - 1] |= RMUNG;
rrand[play_1.here - 1] = 114;
/* !MUNG ROOM. */
jigsup_(150);
/* !DEAD. */
return;
L8100:
rspeak_(151);
/* !BOOM. */
state_1.mungrm = br;
/* !SAVE ROOM THAT BLEW. */
cevent_1.ctick[cindex_1.cevsaf - 1] = 5;
/* !SET SAFE INTERRUPT. */
if (br != rindex_1.msafe)
goto L8200;
/* !BLEW SAFE ROOM? */
if (bc != oindex_1.sslot)
return;
/* !WAS BRICK IN SAFE? */
newsta_(oindex_1.sslot, 0, 0, 0, 0);
/* !KILL SLOT. */
objcts_1.oflag2[oindex_1.safe - 1] |= OPENBT;
findex_1.safef = TRUE_;
/* !INDICATE SAFE BLOWN. */
return;
L8200:
i__1 = objcts_1.olnt;
for (i = 1; i <= i__1; ++i) {
/* !BLEW WRONG ROOM. */
if (qhere_(i, br) && (objcts_1.oflag1[i - 1] & TAKEBT) != 0)
newsta_(i, 0, 0, 0, 0);
/* L8250: */
}
if (br != rindex_1.lroom)
return;
/* !BLEW LIVING ROOM? */
i__1 = objcts_1.olnt;
for (i = 1; i <= i__1; ++i) {
if (objcts_1.ocan[i - 1] == oindex_1.tcase)
newsta_(i, 0, 0, 0, 0);
/* !KILL TROPHY CASE. */
/* L8300: */
}
return;
L8500:
if (qhere_(oindex_1.fuse, play_1.here) ||
objcts_1.oadv[oindex_1.fuse - 1] == play_1.winner)
rspeak_(152);
newsta_(oindex_1.fuse, 0, 0, 0, 0);
/* !KILL FUSE. */
return;
/* CEVAPP, PAGE 5 */
/* CEV9-- LEDGE MUNGE. */
L9000:
rooms_1.rflag[rindex_1.ledg4 - 1] |= RMUNG;
rrand[rindex_1.ledg4 - 1] = 109;
if (play_1.here == rindex_1.ledg4)
goto L9100;
/* !WAS HE THERE? */
rspeak_(110);
/* !NO, NARROW ESCAPE. */
return;
L9100:
if (advs_1.avehic[play_1.winner - 1] != 0)
goto L9200;
/* !IN VEHICLE? */
jigsup_(111);
/* !NO, DEAD. */
return;
L9200:
if (findex_1.btief != 0)
goto L9300;
/* !TIED TO LEDGE? */
rspeak_(112);
/* !NO, NO PLACE TO LAND. */
return;
L9300:
state_1.bloc = rindex_1.vlbot;
/* !YES, CRASH BALLOON. */
newsta_(oindex_1.ballo, 0, 0, 0, 0);
/* !BALLOON & CONTENTS DIE. */
newsta_(oindex_1.dball, 0, state_1.bloc, 0, 0);
/* !INSERT DEAD BALLOON. */
findex_1.btief = 0;
findex_1.binff = 0;
cevent_1.cflag[cindex_1.cevbal - 1] = FALSE_;
cevent_1.cflag[cindex_1.cevbrn - 1] = FALSE_;
jigsup_(113);
/* !DEAD */
return;
/* CEV10-- SAFE MUNG. */
L10000:
rooms_1.rflag[state_1.mungrm - 1] |= RMUNG;
rrand[state_1.mungrm - 1] = 114;
if (play_1.here == state_1.mungrm)
goto L10100;
/* !IS HE PRESENT? */
rspeak_(115);
/* !LET HIM KNOW. */
if (state_1.mungrm == rindex_1.msafe)
cevent_1.ctick[cindex_1.cevled - 1] = 8;
/* !START LEDGE CLOCK. */
return;
L10100:
i = 116;
/* !HE'S DEAD, */
if ((rooms_1.rflag[play_1.here - 1] & RHOUSE) != 0)
i = 117;
jigsup_(i);
/* !LET HIM KNOW. */
return;
/* CEVAPP, PAGE 6 */
/* CEV11-- VOLCANO GNOME */
L11000:
if (play_1.here == rindex_1.ledg2 || play_1.here == rindex_1.ledg3 ||
play_1.here == rindex_1.ledg4 || play_1.here == rindex_1.vlbot)
goto L11100;
/* !IS HE ON LEDGE? */
cevent_1.ctick[cindex_1.cevvlg - 1] = 1;
/* !NO, WAIT A WHILE. */
return;
L11100:
newsta_(oindex_1.gnome, 118, play_1.here, 0, 0);
/* !YES, MATERIALIZE GNOME. */
return;
/* CEV12-- VOLCANO GNOME DISAPPEARS */
L12000:
newsta_(oindex_1.gnome, 149, 0, 0, 0);
/* !DISAPPEAR THE GNOME. */
return;
/* CEV13-- BUCKET. */
L13000:
if (objcts_1.ocan[oindex_1.water - 1] == oindex_1.bucke)
newsta_(oindex_1.water, 0, 0, 0, 0);
return;
/* CEV14-- SPHERE. IF EXPIRES, HE'S TRAPPED. */
L14000:
rooms_1.rflag[rindex_1.cager - 1] |= RMUNG;
rrand[rindex_1.cager - 1] = 147;
jigsup_(148);
/* !MUNG PLAYER. */
return;
/* CEV15-- END GAME HERALD. */
L15000:
findex_1.endgmf = TRUE_;
/* !WE'RE IN ENDGAME. */
rspeak_(119);
/* !INFORM OF ENDGAME. */
return;
/* CEVAPP, PAGE 7 */
/* CEV16-- FOREST MURMURS */
L16000:
cevent_1.cflag[cindex_1.cevfor - 1] = play_1.here == rindex_1.mtree ||
(play_1.here >= rindex_1.fore1 &&
play_1.here < rindex_1.clear);
if (cevent_1.cflag[cindex_1.cevfor - 1] && prob_(10, 10))
rspeak_(635);
return;
/* CEV17-- SCOL ALARM */
L17000:
if (play_1.here == rindex_1.bktwi)
cevent_1.cflag[cindex_1.cevzgi - 1] = TRUE_;
/* !IF IN TWI, GNOME. */
if (play_1.here == rindex_1.bkvau)
jigsup_(636);
/* !IF IN VAU, DEAD. */
return;
/* CEV18-- ENTER GNOME OF ZURICH */
L18000:
cevent_1.cflag[cindex_1.cevzgo - 1] = TRUE_;
/* !EXITS, TOO. */
newsta_(oindex_1.zgnom, 0, rindex_1.bktwi, 0, 0);
/* !PLACE IN TWI. */
if (play_1.here == rindex_1.bktwi)
rspeak_(637);
/* !ANNOUNCE. */
return;
/* CEV19-- EXIT GNOME */
L19000:
newsta_(oindex_1.zgnom, 0, 0, 0, 0);
/* !VANISH. */
if (play_1.here == rindex_1.bktwi)
rspeak_(638);
/* !ANNOUNCE. */
return;
/* CEVAPP, PAGE 8 */
/* CEV20-- START OF ENDGAME */
L20000:
if (findex_1.spellf)
goto L20200;
/* !SPELL HIS WAY IN? */
if (play_1.here != rindex_1.crypt)
return;
/* !NO, STILL IN TOMB? */
if (! lit_(play_1.here))
goto L20100;
/* !LIGHTS OFF? */
cevent_1.ctick[cindex_1.cevste - 1] = 3;
/* !RESCHEDULE. */
return;
L20100:
rspeak_(727);
/* !ANNOUNCE. */
L20200:
i__1 = objcts_1.olnt;
for (i = 1; i <= i__1; ++i) {
/* !STRIP HIM OF OBJS. */
newsta_(i, 0, objcts_1.oroom[i - 1], objcts_1.ocan[i - 1], 0);
/* L20300: */
}
newsta_(oindex_1.lamp, 0, 0, 0, aindex_1.player);
/* !GIVE HIM LAMP. */
newsta_(oindex_1.sword, 0, 0, 0, aindex_1.player);
/* !GIVE HIM SWORD. */
objcts_1.oflag1[oindex_1.lamp - 1] = (objcts_1.oflag1[oindex_1.lamp - 1] | LITEBT) & ~ ONBT;
objcts_1.oflag2[oindex_1.lamp - 1] |= TCHBT;
cevent_1.cflag[cindex_1.cevlnt - 1] = FALSE_;
/* !LAMP IS GOOD AS NEW. */
cevent_1.ctick[cindex_1.cevlnt - 1] = 350;
findex_1.orlamp = 0;
objcts_1.oflag2[oindex_1.sword - 1] |= TCHBT;
hack_1.swdact = TRUE_;
hack_1.swdsta = 0;
hack_1.thfact = FALSE_;
/* !THIEF GONE. */
findex_1.endgmf = TRUE_;
/* !ENDGAME RUNNING. */
cevent_1.cflag[cindex_1.cevmat - 1] = FALSE_;
/* !MATCHES GONE, */
cevent_1.cflag[cindex_1.cevcnd - 1] = FALSE_;
/* !CANDLES GONE. */
scrupd_(rooms_1.rval[rindex_1.crypt - 1]);
/* !SCORE CRYPT, */
rooms_1.rval[rindex_1.crypt - 1] = 0;
/* !BUT ONLY ONCE. */
f = moveto_(rindex_1.tstrs, play_1.winner);
/* !TO TOP OF STAIRS, */
f = rmdesc_(3);
/* !AND DESCRIBE. */
return;
/* !BAM */
/* ! */
/* CEV21-- MIRROR CLOSES. */
L21000:
findex_1.mrpshf = FALSE_;
/* !BUTTON IS OUT. */
findex_1.mropnf = FALSE_;
/* !MIRROR IS CLOSED. */
if (play_1.here == rindex_1.mrant)
rspeak_(728);
/* !DESCRIBE BUTTON. */
if (play_1.here == rindex_1.inmir || mrhere_(play_1.here) == 1)
rspeak_(729);
return;
/* CEVAPP, PAGE 9 */
/* CEV22-- DOOR CLOSES. */
L22000:
if (findex_1.wdopnf)
rspeak_(730);
/* !DESCRIBE. */
findex_1.wdopnf = FALSE_;
/* !CLOSED. */
return;
/* CEV23-- INQUISITOR'S QUESTION */
L23000:
if (advs_1.aroom[aindex_1.player - 1] != rindex_1.fdoor)
return;
/* !IF PLAYER LEFT, DIE. */
rspeak_(769);
i__1 = findex_1.quesno + 770;
rspeak_(i__1);
cevent_1.ctick[cindex_1.cevinq - 1] = 2;
return;
/* CEV24-- MASTER FOLLOWS */
L24000:
if (advs_1.aroom[aindex_1.amastr - 1] == play_1.here)
return;
/* !NO MOVEMENT, DONE. */
if (play_1.here != rindex_1.cell &&
play_1.here != rindex_1.pcell)
goto L24100;
if (findex_1.follwf)
rspeak_(811);
/* !WONT GO TO CELLS. */
findex_1.follwf = FALSE_;
return;
L24100:
findex_1.follwf = TRUE_;
/* !FOLLOWING. */
i = 812;
/* !ASSUME CATCHES UP. */
i__1 = xsrch_1.xmax;
i__2 = xsrch_1.xmin;
for (j = xsrch_1.xmin; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
if (findxt_(j, advs_1.aroom[aindex_1.amastr - 1]) &&
curxt_1.xroom1 == play_1.here)
i = 813;
/* L24200: */
}
rspeak_(i);
newsta_(oindex_1.master, 0, play_1.here, 0, 0);
/* !MOVE MASTER OBJECT. */
advs_1.aroom[aindex_1.amastr - 1] = play_1.here;
/* !MOVE MASTER PLAYER. */
return;
} /* cevapp_ */
void game_()
{
/* Local variables */
logical f;
integer i;
/* START UP, DESCRIBE CURRENT LOCATION. */
rspeak_(1);
/* !WELCOME ABOARD. */
f = rmdesc_(3);
/* !START GAME. */
/* NOW LOOP, READING AND EXECUTING COMMANDS. */
L100:
play_1.winner = aindex_1.player;
/* !PLAYER MOVING. */
play_1.telflg = FALSE_;
/* !ASSUME NOTHING TOLD. */
if (prsvec_1.prscon <= 1) {
rdline_(input_1.inbuf, 1);
}
#ifdef ALLOW_GDT
if (strcmp(input_1.inbuf + prsvec_1.prscon - 1, "GDT") == 0) {
/* !CALL ON GDT? */
gdt_();
/* !YES, INVOKE. */
goto L100;
/* !ONWARD. */
}
#endif /* ALLOW_GDT */
++state_1.moves;
prsvec_1.prswon = parse_(input_1.inbuf, 1);
if (! prsvec_1.prswon) {
goto L400;
}
/* !PARSE LOSES? */
if (xvehic_(1)) {
goto L400;
}
/* !VEHICLE HANDLE? */
if (prsvec_1.prsa == vindex_1.tellw) {
goto L2000;
}
/* !TELL? */
L300:
if (prsvec_1.prso == oindex_1.valua || prsvec_1.prso == oindex_1.every) {
goto L900;
}
if (! vappli_(prsvec_1.prsa)) {
goto L400;
}
/* !VERB OK? */
L350:
if (! findex_1.echof && play_1.here == rindex_1.echor) {
goto L1000;
}
f = rappli_(rooms_1.ractio[play_1.here - 1]);
L400:
xendmv_(play_1.telflg);
/* !DO END OF MOVE. */
if (! lit_(play_1.here)) {
prsvec_1.prscon = 1;
}
goto L100;
L900:
valuac_(oindex_1.valua);
goto L350;
/* GAME, PAGE 3 */
/* SPECIAL CASE-- ECHO ROOM. */
/* IF INPUT IS NOT 'ECHO' OR A DIRECTION, JUST ECHO. */
L1000:
rdline_(input_1.inbuf, 0);
++state_1.moves;
/* !CHARGE FOR MOVES. */
if (strcmp(input_1.inbuf, "ECHO") != 0)
goto L1300;
rspeak_(571);
/* !KILL THE ECHO. */
findex_1.echof = TRUE_;
objcts_1.oflag2[oindex_1.bar - 1] &= ~ SCRDBT;
prsvec_1.prswon = TRUE_;
/* !FAKE OUT PARSER. */
prsvec_1.prscon = 1;
/* !FORCE NEW INPUT. */
goto L400;
L1300:
prsvec_1.prswon = parse_(input_1.inbuf, 0);
if (! prsvec_1.prswon || prsvec_1.prsa != vindex_1.walkw) {
goto L1400;
}
if (findxt_(prsvec_1.prso, play_1.here)) {
goto L300;
}
/* !VALID EXIT? */
L1400:
more_output(input_1.inbuf);
play_1.telflg = TRUE_;
/* !INDICATE OUTPUT. */
goto L1000;
/* !MORE ECHO ROOM. */
/* GAME, PAGE 4 */
/* SPECIAL CASE-- TELL <ACTOR>, NEW COMMAND */
/* NOTE THAT WE CANNOT BE IN THE ECHO ROOM. */
L2000:
if ((objcts_1.oflag2[prsvec_1.prso - 1] & ACTRBT) != 0) {
goto L2100;
}
rspeak_(602);
/* !CANT DO IT. */
goto L350;
/* !VAPPLI SUCCEEDS. */
L2100:
play_1.winner = oactor_(prsvec_1.prso);
/* !NEW PLAYER. */
play_1.here = advs_1.aroom[play_1.winner - 1];
/* !NEW LOCATION. */
if (prsvec_1.prscon <= 1) {
goto L2700;
}
/* !ANY INPUT? */
if (parse_(input_1.inbuf, 1)) {
goto L2150;
}
L2700:
i = 341;
/* !FAILS. */
if (play_1.telflg) {
i = 604;
}
/* !GIVE RESPONSE. */
rspeak_(i);
L2600:
play_1.winner = aindex_1.player;
/* !RESTORE STATE. */
play_1.here = advs_1.aroom[play_1.winner - 1];
goto L350;
L2150:
if (aappli_(advs_1.aactio[play_1.winner - 1])) {
goto L2400;
}
/* !ACTOR HANDLE? */
if (xvehic_(1)) {
goto L2400;
}
/* !VEHICLE HANDLE? */
if (prsvec_1.prso == oindex_1.valua || prsvec_1.prso == oindex_1.every) {
goto L2900;
}
if (! vappli_(prsvec_1.prsa)) {
goto L2400;
}
/* !VERB HANDLE? */
/* L2350: */
f = rappli_(rooms_1.ractio[play_1.here - 1]);
L2400:
xendmv_(play_1.telflg);
/* !DO END OF MOVE. */
goto L2600;
/* !DONE. */
L2900:
valuac_(oindex_1.valua);
/* !ALL OR VALUABLES. */
goto L350;
} /* game_ */
integer nv2inips_(integer *ifunc, integer *iparms)
{
/* Initialized data */
static real rad = .01745329f;
/* System generated locals */
integer ret_val, i__1;
char ch__1[4];
/* Builtin functions */
double sin(doublereal), tan(doublereal);
integer i_indx(char *, char *, ftnlen, ftnlen);
/* Local variables */
static real r__;
extern integer lit_(char *, ftnlen);
static doublereal decc, drad;
extern /* Character */ VOID clit_(char *, ftnlen, integer *);
extern real flalo_(integer *);
static integer ipole;
extern /* Subroutine */ int llopt_(doublereal *, doublereal *, integer *,
integer *);
static real sclat1;
/* Parameter adjustments */
--iparms;
/* Function Body */
if (*ifunc == 1) {
if (iparms[1] != lit_("PS ", (ftnlen)4)) {
ret_val = -1;
return ret_val;
}
pscompsnv2_1.itype = 1;
pscompsnv2_1.xrow = (real) iparms[2];
pscompsnv2_1.xcol = (real) iparms[3];
ipole = iparms[11];
if (ipole == 0) {
ipole = 900000;
}
pscompsnv2_1.ihem = 1;
if (ipole < 0) {
pscompsnv2_1.ihem = -1;
}
pscompsnv2_1.xpole = flalo_(&ipole);
i__1 = ipole - iparms[4];
pscompsnv2_1.xlat1 = flalo_(&i__1) * rad;
pscompsnv2_1.xspace = iparms[5] / 1e3f;
pscompsnv2_1.xqlon = flalo_(&iparms[6]);
drad = iparms[7] / 1e3;
r__ = drad;
decc = iparms[8] / 1e6;
pscompsnv2_1.iwest = iparms[10];
if (pscompsnv2_1.iwest >= 0) {
pscompsnv2_1.iwest = 1;
}
llopt_(&drad, &decc, &pscompsnv2_1.iwest, &iparms[9]);
pscompsnv2_1.xblat = r__ * sin(pscompsnv2_1.xlat1) / (
pscompsnv2_1.xspace * tan(pscompsnv2_1.xlat1 * .5f));
sclat1 = (90.f - pscompsnv2_1.ihem * flalo_(&iparms[4])) * rad;
pscompsnv2_1.fac = 1.f;
} else if (*ifunc == 2) {
clit_(ch__1, (ftnlen)4, &iparms[1]);
if (i_indx(ch__1, "XY", (ftnlen)4, (ftnlen)2) != 0) {
pscompsnv2_1.itype = 1;
}
clit_(ch__1, (ftnlen)4, &iparms[1]);
if (i_indx(ch__1, "LL", (ftnlen)4, (ftnlen)2) != 0) {
pscompsnv2_1.itype = 2;
}
}
ret_val = 0;
return ret_val;
} /* nv2inips_ */
logical rappl1_(integer ri)
{
/* System generated locals */
integer i__1, i__2;
logical ret_val;
/* Local variables */
integer i;
integer j;
ret_val = TRUE_;
/* !USUALLY IGNORED. */
if (ri == 0) {
return ret_val;
}
/* !RETURN IF NAUGHT. */
/* !SET TO FALSE FOR */
/* !NEW DESC NEEDED. */
switch (ri) {
case 1: goto L1000;
case 2: goto L2000;
case 3: goto L3000;
case 4: goto L4000;
case 5: goto L5000;
case 6: goto L6000;
case 7: goto L7000;
case 8: goto L8000;
case 9: goto L9000;
case 10: goto L10000;
case 11: goto L11000;
case 12: goto L12000;
case 13: goto L13000;
case 14: goto L14000;
case 15: goto L15000;
case 16: goto L16000;
case 17: goto L17000;
case 18: goto L18000;
case 19: goto L19000;
case 20: goto L20000;
case 21: goto L21000;
case 22: goto L22000;
case 23: goto L23000;
case 24: goto L24000;
case 25: goto L25000;
case 26: goto L26000;
case 27: goto L27000;
case 28: goto L28000;
case 29: goto L29000;
case 30: goto L30000;
case 31: goto L31000;
case 32: goto L32000;
case 33: goto L33000;
case 34: goto L34000;
case 35: goto L35000;
case 36: goto L36000;
case 37: goto L37000;
}
bug_(1, ri);
/* R1-- EAST OF HOUSE. DESCRIPTION DEPENDS ON STATE OF WINDOW */
L1000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
i = 13;
/* !ASSUME CLOSED. */
if ((objcts_1.oflag2[oindex_1.windo - 1] & OPENBT) != 0) {
i = 12;
}
/* !IF OPEN, AJAR. */
rspsub_(11, i);
/* !DESCRIBE. */
return ret_val;
/* R2-- KITCHEN. SAME VIEW FROM INSIDE. */
L2000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
i = 13;
/* !ASSUME CLOSED. */
if ((objcts_1.oflag2[oindex_1.windo - 1] & OPENBT) != 0) {
i = 12;
}
/* !IF OPEN, AJAR. */
rspsub_(14, i);
/* !DESCRIBE. */
return ret_val;
/* R3-- LIVING ROOM. DESCRIPTION DEPENDS ON MAGICF (STATE OF */
/* DOOR TO CYCLOPS ROOM), RUG (MOVED OR NOT), DOOR (OPEN OR CLOSED) */
L3000:
if (prsvec_1.prsa != vindex_1.lookw) {
goto L3500;
}
/* !LOOK? */
i = 15;
/* !ASSUME NO HOLE. */
if (findex_1.magicf) {
i = 16;
}
/* !IF MAGICF, CYCLOPS HOLE. */
rspeak_(i);
/* !DESCRIBE. */
i = findex_1.orrug + 17;
/* !ASSUME INITIAL STATE. */
if ((objcts_1.oflag2[oindex_1.door - 1] & OPENBT) != 0) {
i += 2;
}
/* !DOOR OPEN? */
rspeak_(i);
/* !DESCRIBE. */
return ret_val;
/* NOT A LOOK WORD. REEVALUATE TROPHY CASE. */
L3500:
if (prsvec_1.prsa != vindex_1.takew && (prsvec_1.prsa != vindex_1.putw ||
prsvec_1.prsi != oindex_1.tcase)) {
return ret_val;
}
advs_1.ascore[play_1.winner - 1] = state_1.rwscor;
/* !SCORE TROPHY CASE. */
i__1 = objcts_1.olnt;
for (i = 1; i <= i__1; ++i) {
/* !RETAIN RAW SCORE AS WELL. */
j = i;
/* !FIND OUT IF IN CASE. */
L3550:
j = objcts_1.ocan[j - 1];
/* !TRACE OWNERSHIP. */
if (j == 0) {
goto L3600;
}
if (j != oindex_1.tcase) {
goto L3550;
}
/* !DO ALL LEVELS. */
advs_1.ascore[play_1.winner - 1] += objcts_1.otval[i - 1];
L3600:
;
}
scrupd_(0);
/* !SEE IF ENDGAME TRIG. */
return ret_val;
/* RAPPL1, PAGE 3 */
/* R4-- CELLAR. SHUT DOOR AND BAR IT IF HE JUST WALKED IN. */
L4000:
if (prsvec_1.prsa != vindex_1.lookw) {
goto L4500;
}
/* !LOOK? */
rspeak_(21);
/* !DESCRIBE CELLAR. */
return ret_val;
L4500:
if (prsvec_1.prsa != vindex_1.walkiw) {
return ret_val;
}
/* !WALKIN? */
if ((objcts_1.oflag2[oindex_1.door - 1] & (OPENBT + TCHBT)) != OPENBT) {
return ret_val;
}
objcts_1.oflag2[oindex_1.door - 1] = (objcts_1.oflag2[oindex_1.door - 1] |
TCHBT) & ~ OPENBT;
rspeak_(22);
/* !SLAM AND BOLT DOOR. */
return ret_val;
/* R5-- MAZE11. DESCRIBE STATE OF GRATING. */
L5000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(23);
/* !DESCRIBE. */
i = 24;
/* !ASSUME LOCKED. */
if (findex_1.grunlf) {
i = 26;
}
/* !UNLOCKED? */
if ((objcts_1.oflag2[oindex_1.grate - 1] & OPENBT) != 0) {
i = 25;
}
/* !OPEN? */
rspeak_(i);
/* !DESCRIBE GRATE. */
return ret_val;
/* R6-- CLEARING. DESCRIBE CLEARING, MOVE LEAVES. */
L6000:
if (prsvec_1.prsa != vindex_1.lookw) {
goto L6500;
}
/* !LOOK? */
rspeak_(27);
/* !DESCRIBE. */
if (findex_1.rvclr == 0) {
return ret_val;
}
/* !LEAVES MOVED? */
i = 28;
/* !YES, ASSUME GRATE CLOSED. */
if ((objcts_1.oflag2[oindex_1.grate - 1] & OPENBT) != 0) {
i = 29;
}
/* !OPEN? */
rspeak_(i);
/* !DESCRIBE GRATE. */
return ret_val;
L6500:
if (findex_1.rvclr != 0 ||
(qhere_(oindex_1.leave, rindex_1.clear) && (prsvec_1.prsa != vindex_1.movew)) ||
prsvec_1.prso != oindex_1.leave) {
return ret_val;
}
rspeak_(30);
/* !MOVE LEAVES, REVEAL GRATE. */
findex_1.rvclr = 1;
/* !INDICATE LEAVES MOVED. */
return ret_val;
/* RAPPL1, PAGE 4 */
/* R7-- RESERVOIR SOUTH. DESCRIPTION DEPENDS ON LOW TIDE FLAG. */
L7000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
i = 31;
/* !ASSUME FULL. */
if (findex_1.lwtidf) {
i = 32;
}
/* !IF LOW TIDE, EMPTY. */
rspeak_(i);
/* !DESCRIBE. */
rspeak_(33);
/* !DESCRIBE EXITS. */
return ret_val;
/* R8-- RESERVOIR. STATE DEPENDS ON LOW TIDE FLAG. */
L8000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
i = 34;
/* !ASSUME FULL. */
if (findex_1.lwtidf) {
i = 35;
}
/* !IF LOW TIDE, EMTPY. */
rspeak_(i);
/* !DESCRIBE. */
return ret_val;
/* R9-- RESERVOIR NORTH. ALSO DEPENDS ON LOW TIDE FLAG. */
L9000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
i = 36;
/* !YOU GET THE IDEA. */
if (findex_1.lwtidf) {
i = 37;
}
rspeak_(i);
rspeak_(38);
return ret_val;
/* R10-- GLACIER ROOM. STATE DEPENDS ON MELTED, VANISHED FLAGS. */
L10000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(39);
/* !BASIC DESCRIPTION. */
i = 0;
/* !ASSUME NO CHANGES. */
if (findex_1.glacmf) {
i = 40;
}
/* !PARTIAL MELT? */
if (findex_1.glacrf) {
i = 41;
}
/* !COMPLETE MELT? */
rspeak_(i);
/* !DESCRIBE. */
return ret_val;
/* R11-- FOREST ROOM */
L11000:
if (prsvec_1.prsa == vindex_1.walkiw) {
cevent_1.cflag[cindex_1.cevfor - 1] = TRUE_;
}
/* !IF WALK IN, BIRDIE. */
return ret_val;
/* R12-- MIRROR ROOM. STATE DEPENDS ON MIRROR INTACT. */
L12000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(42);
/* !DESCRIBE. */
if (findex_1.mirrmf) {
rspeak_(43);
}
/* !IF BROKEN, NASTY REMARK. */
return ret_val;
/* RAPPL1, PAGE 5 */
/* R13-- CAVE2 ROOM. BLOW OUT CANDLES WITH 50% PROBABILITY. */
L13000:
if (prsvec_1.prsa != vindex_1.walkiw) {
return ret_val;
}
/* !WALKIN? */
if (prob_(50, 50) || objcts_1.oadv[oindex_1.candl - 1] !=
play_1.winner || ! ((objcts_1.oflag1[oindex_1.candl - 1] &
ONBT) != 0)) {
return ret_val;
}
objcts_1.oflag1[oindex_1.candl - 1] &= ~ ONBT;
rspeak_(47);
/* !TELL OF WINDS. */
cevent_1.cflag[cindex_1.cevcnd - 1] = FALSE_;
/* !HALT CANDLE COUNTDOWN. */
return ret_val;
/* R14-- BOOM ROOM. BLOW HIM UP IF CARRYING FLAMING OBJECT. */
L14000:
j = objcts_1.odesc2[oindex_1.candl - 1];
/* !ASSUME CANDLE. */
if (objcts_1.oadv[oindex_1.candl - 1] == play_1.winner && (
objcts_1.oflag1[oindex_1.candl - 1] & ONBT) != 0) {
goto L14100;
}
j = objcts_1.odesc2[oindex_1.torch - 1];
/* !ASSUME TORCH. */
if (objcts_1.oadv[oindex_1.torch - 1] == play_1.winner && (
objcts_1.oflag1[oindex_1.torch - 1] & ONBT) != 0) {
goto L14100;
}
j = objcts_1.odesc2[oindex_1.match - 1];
if (objcts_1.oadv[oindex_1.match - 1] == play_1.winner && (
objcts_1.oflag1[oindex_1.match - 1] & ONBT) != 0) {
goto L14100;
}
return ret_val;
/* !SAFE */
L14100:
if (prsvec_1.prsa != vindex_1.trnonw) {
goto L14200;
}
/* !TURN ON? */
rspsub_(294, j);
/* !BOOM */
/* ! */
jigsup_(44);
return ret_val;
L14200:
if (prsvec_1.prsa != vindex_1.walkiw) {
return ret_val;
}
/* !WALKIN? */
rspsub_(295, j);
/* !BOOM */
/* ! */
jigsup_(44);
return ret_val;
/* R15-- NO-OBJS. SEE IF EMPTY HANDED, SCORE LIGHT SHAFT. */
L15000:
findex_1.empthf = TRUE_;
/* !ASSUME TRUE. */
i__1 = objcts_1.olnt;
for (i = 1; i <= i__1; ++i) {
/* !SEE IF CARRYING. */
if (objcts_1.oadv[i - 1] == play_1.winner) {
findex_1.empthf = FALSE_;
}
/* L15100: */
}
if (play_1.here != rindex_1.bshaf || ! lit_(play_1.here)) {
return ret_val;
}
scrupd_(state_1.ltshft);
/* !SCORE LIGHT SHAFT. */
state_1.ltshft = 0;
/* !NEVER AGAIN. */
return ret_val;
/* RAPPL1, PAGE 6 */
/* R16-- MACHINE ROOM. DESCRIBE MACHINE. */
L16000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
i = 46;
/* !ASSUME LID CLOSED. */
if ((objcts_1.oflag2[oindex_1.machi - 1] & OPENBT) != 0) {
i = 12;
}
/* !IF OPEN, OPEN. */
rspsub_(45, i);
/* !DESCRIBE. */
return ret_val;
/* R17-- BAT ROOM. UNLESS CARRYING GARLIC, FLY AWAY WITH ME... */
L17000:
if (prsvec_1.prsa != vindex_1.lookw) {
goto L17500;
}
/* !LOOK? */
rspeak_(48);
/* !DESCRIBE ROOM. */
if (objcts_1.oadv[oindex_1.garli - 1] == play_1.winner) {
rspeak_(49);
}
/* !BAT HOLDS NOSE. */
return ret_val;
L17500:
if (prsvec_1.prsa != vindex_1.walkiw || objcts_1.oadv[oindex_1.garli - 1]
== play_1.winner) {
return ret_val;
}
rspeak_(50);
/* !TIME TO FLY, JACK. */
moveto_(bats_1.batdrp[rnd_(9)], play_1.winner);
/* !SELECT RANDOM DEST. */
ret_val = FALSE_;
/* !INDICATE NEW DESC NEEDED. */
return ret_val;
/* R18-- DOME ROOM. STATE DEPENDS ON WHETHER ROPE TIED TO RAILING. */
L18000:
if (prsvec_1.prsa != vindex_1.lookw) {
goto L18500;
}
/* !LOOK? */
rspeak_(51);
/* !DESCRIBE. */
if (findex_1.domef) {
rspeak_(52);
}
/* !IF ROPE, DESCRIBE. */
return ret_val;
L18500:
if (prsvec_1.prsa == vindex_1.leapw) {
jigsup_(53);
}
/* !DID HE JUMP??? */
return ret_val;
/* R19-- TORCH ROOM. ALSO DEPENDS ON WHETHER ROPE TIED TO RAILING. */
L19000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(54);
/* !DESCRIBE. */
if (findex_1.domef) {
rspeak_(55);
}
/* !IF ROPE, DESCRIBE. */
return ret_val;
/* R20-- CAROUSEL ROOM. SPIN HIM OR KILL HIM. */
L20000:
if (prsvec_1.prsa != vindex_1.lookw) {
goto L20500;
}
/* !LOOK? */
rspeak_(56);
/* !DESCRIBE. */
if (! findex_1.caroff) {
rspeak_(57);
}
/* !IF NOT FLIPPED, SPIN. */
return ret_val;
L20500:
if (prsvec_1.prsa == vindex_1.walkiw && findex_1.carozf) {
jigsup_(58);
}
/* !WALKED IN. */
return ret_val;
/* RAPPL1, PAGE 7 */
/* R21-- LLD ROOM. HANDLE EXORCISE, DESCRIPTIONS. */
L21000:
if (prsvec_1.prsa != vindex_1.lookw) {
goto L21500;
}
/* !LOOK? */
rspeak_(59);
/* !DESCRIBE. */
if (! findex_1.lldf) {
rspeak_(60);
}
/* !IF NOT VANISHED, GHOSTS. */
return ret_val;
L21500:
if (prsvec_1.prsa != vindex_1.exorcw) {
return ret_val;
}
/* !EXORCISE? */
if (objcts_1.oadv[oindex_1.bell - 1] == play_1.winner && objcts_1.oadv[
oindex_1.book - 1] == play_1.winner && objcts_1.oadv[
oindex_1.candl - 1] == play_1.winner && (objcts_1.oflag1[
oindex_1.candl - 1] & ONBT) != 0) {
goto L21600;
}
rspeak_(62);
/* !NOT EQUIPPED. */
return ret_val;
L21600:
if (qhere_(oindex_1.ghost, play_1.here)) {
goto L21700;
}
/* !GHOST HERE? */
jigsup_(61);
/* !NOPE, EXORCISE YOU. */
return ret_val;
L21700:
newsta_(oindex_1.ghost, 63, 0, 0, 0);
/* !VANISH GHOST. */
findex_1.lldf = TRUE_;
/* !OPEN GATE. */
return ret_val;
/* R22-- LLD2-ROOM. IS HIS HEAD ON A POLE? */
L22000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(64);
/* !DESCRIBE. */
if (findex_1.onpolf) {
rspeak_(65);
}
/* !ON POLE? */
return ret_val;
/* R23-- DAM ROOM. DESCRIBE RESERVOIR, PANEL. */
L23000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(66);
/* !DESCRIBE. */
i = 67;
if (findex_1.lwtidf) {
i = 68;
}
rspeak_(i);
/* !DESCRIBE RESERVOIR. */
rspeak_(69);
/* !DESCRIBE PANEL. */
if (findex_1.gatef) {
rspeak_(70);
}
/* !BUBBLE IS GLOWING. */
return ret_val;
/* R24-- TREE ROOM */
L24000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(660);
/* !DESCRIBE. */
i = 661;
/* !SET FLAG FOR BELOW. */
i__1 = objcts_1.olnt;
for (j = 1; j <= i__1; ++j) {
/* !DESCRIBE OBJ IN FORE3. */
if (! qhere_(j, rindex_1.fore3) || j == oindex_1.ftree) {
goto L24200;
}
rspeak_(i);
/* !SET STAGE, */
i = 0;
rspsub_(502, objcts_1.odesc2[j - 1]);
/* !DESCRIBE. */
L24200:
;
}
return ret_val;
/* RAPPL1, PAGE 8 */
/* R25-- CYCLOPS-ROOM. DEPENDS ON CYCLOPS STATE, ASLEEP FLAG, MAGIC FLAG.
*/
L25000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(606);
/* !DESCRIBE. */
i = 607;
/* !ASSUME BASIC STATE. */
if (findex_1.rvcyc > 0) {
i = 608;
}
/* !>0? HUNGRY. */
if (findex_1.rvcyc < 0) {
i = 609;
}
/* !<0? THIRSTY. */
if (findex_1.cyclof) {
i = 610;
}
/* !ASLEEP? */
if (findex_1.magicf) {
i = 611;
}
/* !GONE? */
rspeak_(i);
/* !DESCRIBE. */
if (! findex_1.cyclof && findex_1.rvcyc != 0) {
i__1 = abs(findex_1.rvcyc) + 193;
rspeak_(i__1);
}
return ret_val;
/* R26-- BANK BOX ROOM. */
L26000:
if (prsvec_1.prsa != vindex_1.walkiw) {
return ret_val;
}
/* !SURPRISE HIM. */
for (i = 1; i <= 8; i += 2) {
/* !SCOLRM DEPENDS ON */
if (screen_1.fromdr == screen_1.scoldr[i - 1]) {
screen_1.scolrm = screen_1.scoldr[i];
}
/* L26100: */
}
/* !ENTRY DIRECTION. */
return ret_val;
/* R27-- TREASURE ROOM. */
L27000:
if (prsvec_1.prsa != vindex_1.walkiw || ! hack_1.thfact) {
return ret_val;
}
if (objcts_1.oroom[oindex_1.thief - 1] != play_1.here) {
newsta_(oindex_1.thief, 82, play_1.here, 0, 0);
}
hack_1.thfpos = play_1.here;
/* !RESET SEARCH PATTERN. */
objcts_1.oflag2[oindex_1.thief - 1] |= FITEBT;
if (objcts_1.oroom[oindex_1.chali - 1] == play_1.here) {
objcts_1.oflag1[oindex_1.chali - 1] &= ~ TAKEBT;
}
/* VANISH EVERYTHING IN ROOM */
j = 0;
/* !ASSUME NOTHING TO VANISH. */
i__1 = objcts_1.olnt;
for (i = 1; i <= i__1; ++i) {
if (i == oindex_1.chali || i == oindex_1.thief || ! qhere_(i,
play_1.here)) {
goto L27200;
}
j = 83;
/* !FLAG BYEBYE. */
objcts_1.oflag1[i - 1] &= ~ VISIBT;
L27200:
;
}
rspeak_(j);
/* !DESCRIBE. */
return ret_val;
/* R28-- CLIFF FUNCTION. SEE IF CARRYING INFLATED BOAT. */
L28000:
findex_1.deflaf = objcts_1.oadv[oindex_1.rboat - 1] != play_1.winner;
/* !TRUE IF NOT CARRYING. */
return ret_val;
/* RAPPL1, PAGE 9 */
/* R29-- RIVR4 ROOM. PLAY WITH BUOY. */
L29000:
if (! findex_1.buoyf || objcts_1.oadv[oindex_1.buoy - 1] != play_1.winner)
{
return ret_val;
}
rspeak_(84);
/* !GIVE HINT, */
findex_1.buoyf = FALSE_;
/* !THEN DISABLE. */
return ret_val;
/* R30-- OVERFALLS. DOOM. */
L30000:
if (prsvec_1.prsa != vindex_1.lookw) {
jigsup_(85);
}
/* !OVER YOU GO. */
return ret_val;
/* R31-- BEACH ROOM. DIG A HOLE. */
L31000:
if (prsvec_1.prsa != vindex_1.digw || prsvec_1.prso != oindex_1.shove) {
return ret_val;
}
++findex_1.rvsnd;
/* !INCREMENT DIG STATE. */
switch (findex_1.rvsnd) {
case 1: goto L31100;
case 2: goto L31100;
case 3: goto L31100;
case 4: goto L31400;
case 5: goto L31500;
}
/* !PROCESS STATE. */
bug_(2, findex_1.rvsnd);
L31100:
i__1 = findex_1.rvsnd + 85;
rspeak_(i__1);
/* !1-3... DISCOURAGE HIM. */
return ret_val;
L31400:
i = 89;
/* !ASSUME DISCOVERY. */
if ((objcts_1.oflag1[oindex_1.statu - 1] & VISIBT) != 0) {
i = 88;
}
rspeak_(i);
objcts_1.oflag1[oindex_1.statu - 1] |= VISIBT;
return ret_val;
L31500:
findex_1.rvsnd = 0;
/* !5... SAND COLLAPSES */
jigsup_(90);
/* !AND SO DOES HE. */
return ret_val;
/* R32-- TCAVE ROOM. DIG A HOLE IN GUANO. */
L32000:
if (prsvec_1.prsa != vindex_1.digw || prsvec_1.prso != oindex_1.shove) {
return ret_val;
}
i = 91;
/* !ASSUME NO GUANO. */
if (! qhere_(oindex_1.guano, play_1.here)) {
goto L32100;
}
/* !IS IT HERE? */
/* Computing MIN */
i__1 = 4, i__2 = findex_1.rvgua + 1;
findex_1.rvgua = min(i__1,i__2);
/* !YES, SET NEW STATE. */
i = findex_1.rvgua + 91;
/* !GET NASTY REMARK. */
L32100:
rspeak_(i);
/* !DESCRIBE. */
return ret_val;
/* R33-- FALLS ROOM */
L33000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(96);
/* !DESCRIBE. */
i = 97;
/* !ASSUME NO RAINBOW. */
if (findex_1.rainbf) {
i = 98;
}
/* !GOT ONE? */
rspeak_(i);
/* !DESCRIBE. */
return ret_val;
/* RAPPL1, PAGE 10 */
/* R34-- LEDGE FUNCTION. LEDGE CAN COLLAPSE. */
L34000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(100);
/* !DESCRIBE. */
i = 102;
/* !ASSUME SAFE ROOM OK. */
if ((rooms_1.rflag[rindex_1.msafe - 1] & RMUNG) != 0) {
i = 101;
}
rspeak_(i);
/* !DESCRIBE. */
return ret_val;
/* R35-- SAFE ROOM. STATE DEPENDS ON WHETHER SAFE BLOWN. */
L35000:
if (prsvec_1.prsa != vindex_1.lookw) {
return ret_val;
}
/* !LOOK? */
rspeak_(104);
/* !DESCRIBE. */
i = 105;
/* !ASSUME OK. */
if (findex_1.safef) {
i = 106;
}
/* !BLOWN? */
rspeak_(i);
/* !DESCRIBE. */
return ret_val;
/* R36-- MAGNET ROOM. DESCRIBE, CHECK FOR SPINDIZZY DOOM. */
L36000:
if (prsvec_1.prsa != vindex_1.lookw) {
goto L36500;
}
/* !LOOK? */
rspeak_(107);
/* !DESCRIBE. */
return ret_val;
L36500:
if (prsvec_1.prsa != vindex_1.walkiw || ! findex_1.caroff) {
return ret_val;
}
/* !WALKIN ON FLIPPED? */
if (findex_1.carozf) {
goto L36600;
}
/* !ZOOM? */
rspeak_(108);
/* !NO, SPIN HIS COMPASS. */
return ret_val;
L36600:
i = 58;
/* !SPIN HIS INSIDES. */
if (play_1.winner != aindex_1.player) {
i = 99;
}
/* !SPIN ROBOT. */
jigsup_(i);
/* !DEAD. */
return ret_val;
/* R37-- CAGE ROOM. IF SOLVED CAGE, MOVE TO OTHER CAGE ROOM. */
L37000:
if (findex_1.cagesf) {
moveto_(rindex_1.cager, play_1.winner);
}
/* !IF SOLVED, MOVE. */
return ret_val;
} /* rappl1_ */
integer nv2inirect_(integer *ifunc, integer *iparms)
{
/* System generated locals */
integer ret_val;
char ch__1[4];
/* Builtin functions */
double pow_ri(real *, integer *), pow_di(doublereal *, integer *);
integer i_indx(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer ipowdele, ipowdlin;
static real r__;
extern integer lit_(char *, ftnlen);
static doublereal decc, drad;
extern /* Character */ VOID clit_(char *, ftnlen, integer *);
extern /* Subroutine */ int llopt_(doublereal *, doublereal *, integer *,
integer *);
static integer ipowecc, ipowrad, ipowlat, ipowlon;
/* Degrees Per Line Power */
/* Degrees Per Element Power */
/* Degrees Radian power */
/* Eccentricity Power */
/* ,ULLON */
/* Parameter adjustments */
--iparms;
/* Function Body */
if (*ifunc == 1) {
if (iparms[1] != lit_("RECT", (ftnlen)4)) {
goto L900;
}
rctcomrectnv2_1.itype = 1;
rctcomrectnv2_1.xrow = (real) iparms[2];
ipowlat = iparms[12];
if (ipowlat == 0) {
ipowlat = 4;
}
/* default is 10000 (10^4) */
rctcomrectnv2_1.zslat = iparms[3] / pow_ri(&c_b4, &ipowlat);
/* REAL Latitude */
rctcomrectnv2_1.xcol = (real) iparms[4];
ipowlon = iparms[13];
if (ipowlon == 0) {
ipowlon = 4;
}
rctcomrectnv2_1.zslon = iparms[5] / pow_ri(&c_b4, &ipowlon);
/* REAL Longitude */
ipowdlin = iparms[14];
if (ipowdlin == 0) {
ipowdlin = 4;
}
rctcomrectnv2_1.zdlat = iparms[6] / pow_ri(&c_b4, &ipowdlin);
/* REAL Degrees_per_line_latitude */
ipowdele = iparms[15];
if (ipowdele == 0) {
ipowdele = 4;
}
rctcomrectnv2_1.zdlon = iparms[7] / pow_ri(&c_b4, &ipowdele);
/* REAL Degrees_per_line_longitude */
ipowrad = iparms[16];
if (ipowrad == 0) {
ipowrad = 3;
}
drad = iparms[8] / pow_di(&c_b8, &ipowrad);
/* REAL Radius of the planet in mete */
r__ = drad;
ipowecc = iparms[17];
if (ipowecc == 0) {
ipowecc = 6;
}
decc = iparms[9] / pow_di(&c_b8, &ipowecc);
/* REAL Eccentricity */
rctcomrectnv2_1.iwest = iparms[11];
/* West positive vs. West negative */
if (rctcomrectnv2_1.iwest >= 0) {
rctcomrectnv2_1.iwest = 1;
}
llopt_(&drad, &decc, &rctcomrectnv2_1.iwest, &iparms[10]);
/* Initialze LLCART c */
if (rctcomrectnv2_1.xcol == 1.f) {
/* special case of XCOL not located at ima */
rctcomrectnv2_1.zslon -= rctcomrectnv2_1.iwest * 180.f;
/* -- so assume it's the left edge(duh) */
}
} else if (*ifunc == 2) {
clit_(ch__1, (ftnlen)4, &iparms[1]);
if (i_indx(ch__1, "XY", (ftnlen)4, (ftnlen)2) != 0) {
rctcomrectnv2_1.itype = 1;
}
clit_(ch__1, (ftnlen)4, &iparms[1]);
if (i_indx(ch__1, "LL", (ftnlen)4, (ftnlen)2) != 0) {
rctcomrectnv2_1.itype = 2;
}
}
ret_val = 0;
return ret_val;
L900:
ret_val = -1;
return ret_val;
} /* nv2inirect_ */
