/* strek_db_subs.f -- translated by f2c (version of 19 December 1990 16:50:21). You must link the resulting object file with the libraries: -lF77 -lI77 -lm -lc (in that order) */ #include "f2c.h" /* Common Block Declarations */ struct { char means[256]; } key_defs__; #define key_defs__1 key_defs__ /* Table of constant values */ static integer c__1 = 1; static integer c__9 = 9; static integer c__3 = 3; static integer c__0 = 0; /* Subroutine */ int strek_write__(new_, ship_name__, user_name__, capt_name__, nick_name__, key_file__, ship_avail__, last_score__, cum_score__, ship_active__, top_ten__, ship_name_len, user_name_len, capt_name_len, nick_name_len, key_file_len) logical *new_; char *ship_name__, *user_name__, *capt_name__, *nick_name__, *key_file__; integer *ship_avail__, *last_score__, *cum_score__; logical *ship_active__, *top_ten__; ftnlen ship_name_len; ftnlen user_name_len; ftnlen capt_name_len; ftnlen nick_name_len; ftnlen key_file_len; { /* Format strings */ static char fmt_110[] = "(a10,a10,a30,i10)"; /* System generated locals */ integer i__1; olist o__1; cllist cl__1; alist al__1; inlist ioin__1; /* Builtin functions */ integer s_cmp(), f_inqu(), f_open(), s_rdue(), do_uio(), e_rdue(), s_wdue( ), e_wdue(), f_clos(), s_rsfe(), do_fio(), e_rsfe(), f_rew(); /* Subroutine */ int s_copy(); integer s_wsfe(), e_wsfe(); /* Local variables */ static char temp[30]; static integer ship_retired__, i, j, k; static char ctemp[10*10]; static integer count; static char stemp[30*10]; static integer num_lines__; static char my_tmp__[10*10]; static real status; static integer top_scores__[10]; static logical fyn; /* Fortran I/O blocks */ static cilist io___4 = { 0, 1, 0, 0, 1 }; static cilist io___6 = { 0, 1, 0, 0, 1 }; static cilist io___7 = { 0, 1, 0, 0, 0 }; static cilist io___9 = { 0, 1, 0, 0, 1 }; static cilist io___11 = { 0, 1, 0, 0, 0 }; static cilist io___13 = { 0, 1, 0, 0, 0 }; static cilist io___15 = { 0, 2, 0, fmt_110, 0 }; static cilist io___21 = { 0, 2, 0, fmt_110, 0 }; static cilist io___22 = { 0, 2, 0, fmt_110, 0 }; static cilist io___23 = { 0, 2, 0, fmt_110, 0 }; /* ******************************************************************* */ /* ***** ***** */ /* ***** STAR TREK VERSION 3.0 ***** */ /* ***** ***** */ /* ***** written by ***** */ /* ***** ***** */ /* ***** Justin S. Revenaugh ***** */ /* ***** ***** */ /* ***** 7/87 ***** */ /* ***** ***** */ /* ***** Massachussetts Institute of Technology ***** */ /* ***** Department of Earth, Atmospheric and Planetary Science ***** */ /* ***** ***** */ /* ******************************************************************* */ /* STREK_WRITE updates the two STREK info files (strek_info and */ /* strek_top_scores). If (new) then a name is appended, else the */ /* name is updated. */ /* if ship name is blank then return */ /* Parameter adjustments */ --ship_avail__; /* Function Body */ if (s_cmp(ship_name__, " ", 30L, 1L) == 0) { *top_ten__ = FALSE_; return 0; } /* open up strek_info file */ ioin__1.inerr = 0; ioin__1.infilen = 30; ioin__1.infile = TREK_INFO; ioin__1.inex = &fyn; ioin__1.inopen = 0; ioin__1.innum = 0; ioin__1.innamed = 0; ioin__1.inname = 0; ioin__1.inacc = 0; ioin__1.inseq = 0; ioin__1.indir = 0; ioin__1.infmt = 0; ioin__1.inform = 0; ioin__1.inunf = 0; ioin__1.inrecl = 0; ioin__1.innrec = 0; ioin__1.inblank = 0; f_inqu(&ioin__1); if (! fyn) { status = (float)1.; return 0; } o__1.oerr = 0; o__1.ounit = 1; o__1.ofnmlen = 30; o__1.ofnm = TREK_INFO; o__1.orl = 1000; o__1.osta = "old"; o__1.oacc = "direct"; o__1.ofm = "unformatted"; o__1.oblnk = 0; f_open(&o__1); ioin__1.inerr = 0; ioin__1.infilen = 36; ioin__1.infile = TOP_SCORES; ioin__1.inex = &fyn; ioin__1.inopen = 0; ioin__1.innum = 0; ioin__1.innamed = 0; ioin__1.inname = 0; ioin__1.inacc = 0; ioin__1.inseq = 0; ioin__1.indir = 0; ioin__1.infmt = 0; ioin__1.inform = 0; ioin__1.inunf = 0; ioin__1.inrecl = 0; ioin__1.innrec = 0; ioin__1.inblank = 0; f_inqu(&ioin__1); if (! fyn) { status = (float)1.; return 0; } o__1.oerr = 0; o__1.ounit = 2; o__1.ofnmlen = 36; o__1.ofnm = TOP_SCORES; o__1.orl = 1000; o__1.osta = "old"; o__1.oacc = 0; o__1.ofm = "formatted"; o__1.oblnk = 0; f_open(&o__1); /* if new then update num_lines and append info */ if (*ship_active__) { ship_retired__ = 0; } else { ship_retired__ = 1; } if (*new_) { s_rdue(&io___4); do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer)); e_rdue(); ++num_lines__; s_wdue(&io___6); do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer)); e_wdue(); io___7.cirec = num_lines__ + 1; s_wdue(&io___7); do_uio(&c__1, ship_name__, 30L); do_uio(&c__1, user_name__, 10L); do_uio(&c__1, capt_name__, 10L); do_uio(&c__1, nick_name__, 10L); do_uio(&c__1, key_file__, 256L); for (i = 1; i <= 3; ++i) { do_uio(&c__1, (char *)&ship_avail__[i], (ftnlen)sizeof(integer)); } do_uio(&c__1, (char *)&(*last_score__), (ftnlen)sizeof(integer)); do_uio(&c__1, (char *)&(*cum_score__), (ftnlen)sizeof(integer)); do_uio(&c__1, (char *)&ship_retired__, (ftnlen)sizeof(integer)); e_wdue(); cl__1.cerr = 0; cl__1.cunit = 1; cl__1.csta = 0; f_clos(&cl__1); } else { /* name is old, find it and update */ s_rdue(&io___9); do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer)); e_rdue(); count = 1; L10: io___11.cirec = count + 1; s_rdue(&io___11); do_uio(&c__1, temp, 30L); e_rdue(); if (s_cmp(temp, ship_name__, 30L, 30L) == 0) { io___13.cirec = count + 1; s_wdue(&io___13); do_uio(&c__1, ship_name__, 30L); do_uio(&c__1, user_name__, 10L); do_uio(&c__1, capt_name__, 10L); do_uio(&c__1, nick_name__, 10L); do_uio(&c__1, key_file__, 256L); for (i = 1; i <= 3; ++i) { do_uio(&c__1, (char *)&ship_avail__[i], (ftnlen)sizeof( integer)); } do_uio(&c__1, (char *)&(*last_score__), (ftnlen)sizeof(integer)); do_uio(&c__1, (char *)&(*cum_score__), (ftnlen)sizeof(integer)); do_uio(&c__1, (char *)&ship_retired__, (ftnlen)sizeof(integer)); e_wdue(); goto L20; } if (count == num_lines__) { cl__1.cerr = 0; cl__1.cunit = 1; cl__1.csta = 0; f_clos(&cl__1); } ++count; goto L10; L20: cl__1.cerr = 0; cl__1.cunit = 1; cl__1.csta = 0; f_clos(&cl__1); } /* determine if the score is a top ten score */ for (j = 1; j <= 10; ++j) { s_rsfe(&io___15); do_fio(&c__1, my_tmp__ + (j - 1) * 10, 10L); do_fio(&c__1, ctemp + (j - 1) * 10, 10L); do_fio(&c__1, stemp + (j - 1) * 30, 30L); do_fio(&c__1, (char *)&top_scores__[j - 1], (ftnlen)sizeof(integer)); e_rsfe(); /* L30: */ } al__1.aerr = 0; al__1.aunit = 2; f_rew(&al__1); i = 1; *top_ten__ = FALSE_; L40: if (*cum_score__ > top_scores__[i - 1]) { *top_ten__ = TRUE_; goto L50; } if (i == 10) { goto L50; } ++i; goto L40; L50: if (*top_ten__) { /* see if ship is already on the list */ i__1 = i - 1; for (j = 1; j <= i__1; ++j) { if (s_cmp(stemp + (j - 1) * 30, ship_name__, 30L, 30L) == 0) { *top_ten__ = FALSE_; cl__1.cerr = 0; cl__1.cunit = 2; cl__1.csta = 0; f_clos(&cl__1); return 0; } /* L55: */ } for (j = i; j <= 10; ++j) { if (s_cmp(stemp + (j - 1) * 30, ship_name__, 30L, 30L) == 0) { /* move everybody up one to delete the duplicate entry */ for (k = j; k <= 9; ++k) { s_copy(my_tmp__ + (k - 1) * 10, my_tmp__ + k * 10, 10L, 10L); s_copy(stemp + (k - 1) * 30, stemp + k * 30, 30L, 30L); s_copy(ctemp + (k - 1) * 10, ctemp + k * 10, 10L, 10L); top_scores__[k - 1] = top_scores__[k]; /* L70: */ } } /* L60: */ } /* write out the new list, note that a ship that was previously */ /* on the list and who's score drops as a result of a mission */ /* will remain on the list. */ i__1 = i - 1; for (j = 1; j <= i__1; ++j) { s_wsfe(&io___21); do_fio(&c__1, my_tmp__ + (j - 1) * 10, 10L); do_fio(&c__1, ctemp + (j - 1) * 10, 10L); do_fio(&c__1, stemp + (j - 1) * 30, 30L); do_fio(&c__1, (char *)&top_scores__[j - 1], (ftnlen)sizeof( integer)); e_wsfe(); /* L80: */ } s_wsfe(&io___22); do_fio(&c__1, user_name__, 10L); do_fio(&c__1, capt_name__, 10L); do_fio(&c__1, ship_name__, 30L); do_fio(&c__1, (char *)&(*cum_score__), (ftnlen)sizeof(integer)); e_wsfe(); for (j = i; j <= 9; ++j) { s_wsfe(&io___23); do_fio(&c__1, my_tmp__ + (j - 1) * 10, 10L); do_fio(&c__1, ctemp + (j - 1) * 10, 10L); do_fio(&c__1, stemp + (j - 1) * 30, 30L); do_fio(&c__1, (char *)&top_scores__[j - 1], (ftnlen)sizeof( integer)); e_wsfe(); /* L90: */ } } cl__1.cerr = 0; cl__1.cunit = 2; cl__1.csta = 0; f_clos(&cl__1); return 0; } /* strek_write__ */ /* Subroutine */ int strek_review__(ship_name__, user_name__, capt_name__, nick_name__, ship_avail__, cum_score__, last_score__, ship_active__, key_file__, status, ship_name_len, user_name_len, capt_name_len, nick_name_len, key_file_len) char *ship_name__, *user_name__, *capt_name__, *nick_name__; integer *ship_avail__, *cum_score__, *last_score__; logical *ship_active__; char *key_file__; integer *status; ftnlen ship_name_len; ftnlen user_name_len; ftnlen capt_name_len; ftnlen nick_name_len; ftnlen key_file_len; { /* System generated locals */ olist o__1; cllist cl__1; inlist ioin__1; /* Builtin functions */ integer f_inqu(), f_open(), s_rdue(), do_uio(), e_rdue(), s_cmp(), f_clos( ); /* Local variables */ static char temp[30]; static integer ship_retired__, i, count, num_lines__; static logical fyn; /* Fortran I/O blocks */ static cilist io___25 = { 0, 1, 0, 0, 1 }; static cilist io___28 = { 0, 1, 0, 0, 0 }; static cilist io___30 = { 0, 1, 0, 0, 0 }; /* STREK_REVIEW reviews the STREK database which includes */ /* ships, shipnames, captains, cumulative scores, ship avail- */ /* ability times and last outing scores. File is hardwired to */ /* be STREK_INFO. The file structure is as follows: */ /* line 1 number of lines (i8) */ /* lines 2 - last: */ /* shipname (char*30), captain (char*10), nickname (char*10), */ /* ship availability (3i*4), last outing score (i*10), cumu- */ /* lative score (i*10), ship active toggle (i*1). */ /* The file is direct access, and all new entries are appended */ /* to the end. */ /* A second file called STREK_TOP_SCORES is maintained. In it */ /* are the current ten best scores (ascii). The file is struct- */ /* ered: */ /* lines 1 - 10 captains name (char*10), shipname (char*30), and */ /* cumulative score (i*10). */ /* version 1 */ /* -jsr 8/85 */ /* open up strek_info file */ /* Parameter adjustments */ --ship_avail__; /* Function Body */ *status = 0; ioin__1.inerr = 0; ioin__1.infilen = 30; ioin__1.infile = TREK_INFO; ioin__1.inex = &fyn; ioin__1.inopen = 0; ioin__1.innum = 0; ioin__1.innamed = 0; ioin__1.inname = 0; ioin__1.inacc = 0; ioin__1.inseq = 0; ioin__1.indir = 0; ioin__1.infmt = 0; ioin__1.inform = 0; ioin__1.inunf = 0; ioin__1.inrecl = 0; ioin__1.innrec = 0; ioin__1.inblank = 0; f_inqu(&ioin__1); if (! fyn) { *status = 1; return 0; } o__1.oerr = 0; o__1.ounit = 1; o__1.ofnmlen = 30; o__1.ofnm = TREK_INFO; o__1.orl = 1000; o__1.osta = "old"; o__1.oacc = "direct"; o__1.ofm = "unformatted"; o__1.oblnk = 0; f_open(&o__1); /* read number of lines */ s_rdue(&io___25); do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer)); e_rdue(); count = 1; L10: io___28.cirec = count + 1; s_rdue(&io___28); do_uio(&c__1, temp, 30L); e_rdue(); if (s_cmp(temp, ship_name__, 30L, 30L) == 0) { io___30.cirec = count + 1; s_rdue(&io___30); do_uio(&c__1, temp, 30L); do_uio(&c__1, user_name__, 10L); do_uio(&c__1, capt_name__, 10L); do_uio(&c__1, nick_name__, 10L); do_uio(&c__1, key_file__, 256L); for (i = 1; i <= 3; ++i) { do_uio(&c__1, (char *)&ship_avail__[i], (ftnlen)sizeof(integer)); } do_uio(&c__1, (char *)&(*last_score__), (ftnlen)sizeof(integer)); do_uio(&c__1, (char *)&(*cum_score__), (ftnlen)sizeof(integer)); do_uio(&c__1, (char *)&ship_retired__, (ftnlen)sizeof(integer)); e_rdue(); goto L20; } if (count == num_lines__) { cl__1.cerr = 0; cl__1.cunit = 1; cl__1.csta = 0; f_clos(&cl__1); *status = 2; return 0; } ++count; goto L10; L20: cl__1.cerr = 0; cl__1.cunit = 1; cl__1.csta = 0; f_clos(&cl__1); if (ship_retired__ == 1) { *ship_active__ = FALSE_; } else { *ship_active__ = TRUE_; } return 0; } /* strek_review__ */ /* Subroutine */ int strek_question__(user_name__, capt_name__, nick_name__, ship_name__, key_file__, new_, user_name_len, capt_name_len, nick_name_len, ship_name_len, key_file_len) char *user_name__, *capt_name__, *nick_name__, *ship_name__, *key_file__; logical *new_; ftnlen user_name_len; ftnlen capt_name_len; ftnlen nick_name_len; ftnlen ship_name_len; ftnlen key_file_len; { /* Builtin functions */ /* Subroutine */ int s_copy(); integer s_wsle(), do_lio(), e_wsle(), s_rsfe(), do_fio(), e_rsfe(), s_cmp( ); /* Local variables */ static integer j; extern /* Subroutine */ int strek_parse_key_defs__(); static logical found; extern /* Subroutine */ int strek_search_name__(), getusername_(); /* Fortran I/O blocks */ static cilist io___33 = { 0, 6, 0, 0, 0 }; static cilist io___34 = { 0, 6, 0, 0, 0 }; static cilist io___35 = { 0, 6, 0, 0, 0 }; static cilist io___36 = { 0, 5, 0, "(a)", 0 }; static cilist io___37 = { 0, 6, 0, 0, 0 }; static cilist io___38 = { 0, 6, 0, 0, 0 }; static cilist io___39 = { 0, 5, 0, "(a)", 0 }; static cilist io___40 = { 0, 6, 0, 0, 0 }; static cilist io___41 = { 0, 6, 0, 0, 0 }; static cilist io___42 = { 0, 6, 0, 0, 0 }; static cilist io___43 = { 0, 5, 0, "(a)", 0 }; static cilist io___45 = { 0, 6, 0, 0, 0 }; static cilist io___47 = { 0, 6, 0, 0, 0 }; static cilist io___48 = { 0, 6, 0, 0, 0 }; static cilist io___49 = { 0, 6, 0, 0, 0 }; static cilist io___50 = { 0, 6, 0, 0, 0 }; static cilist io___51 = { 0, 6, 0, 0, 0 }; static cilist io___52 = { 0, 5, 0, "(a)", 0 }; static cilist io___53 = { 0, 6, 0, 0, 0 }; /* STREK_QUESTION determines if the player has a ship or if he */ /* is new (or just a new ship). */ /* version 1 */ /* -jsr 8/85 */ /* key definition common */ s_copy(nick_name__, " ", 10L, 1L); getusername_(user_name__, 10L); /* question captains */ s_wsle(&io___33); do_lio(&c__9, &c__1, "STAR TREK v.3", 13L); e_wsle(); s_wsle(&io___34); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___35); do_lio(&c__9, &c__1, "What is your name, captain?", 27L); e_wsle(); s_rsfe(&io___36); do_fio(&c__1, capt_name__, 10L); e_rsfe(); strek_search_name__(user_name__, capt_name__, ship_name__, key_file__, new_, 10L, 10L, 30L, 256L); if (*new_) { s_wsle(&io___37); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___38); do_lio(&c__9, &c__1, "What do your friends call you sir?", 34L); e_wsle(); s_rsfe(&io___39); do_fio(&c__1, nick_name__, 10L); e_rsfe(); L10: s_wsle(&io___40); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___41); do_lio(&c__9, &c__1, "Enter pathname of your key definition file.", 43L); e_wsle(); s_wsle(&io___42); do_lio(&c__9, &c__1, " for no file.", 21L); e_wsle(); s_rsfe(&io___43); do_fio(&c__1, key_file__, 256L); e_rsfe(); if (s_cmp(key_file__, " ", 256L, 1L) != 0) { strek_parse_key_defs__(key_file__, &found, 256L); if (! found) { s_wsle(&io___45); do_lio(&c__9, &c__1, "The key definition file was not found,\ try again.", 49L); e_wsle(); goto L10; } } else { for (j = 1; j <= 256; ++j) { key_defs__1.means[j - 1] = j; /* L20: */ } } } else { if (s_cmp(key_file__, " ", 256L, 1L) != 0) { strek_parse_key_defs__(key_file__, &found, 256L); if (! found) { s_wsle(&io___47); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___48); do_lio(&c__9, &c__1, "The key definition file was not found,", 38L); e_wsle(); s_wsle(&io___49); do_lio(&c__9, &c__1, "enter the pathname of another file.", 35L); e_wsle(); s_wsle(&io___50); do_lio(&c__9, &c__1, " for no file.", 21L); e_wsle(); s_wsle(&io___51); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_rsfe(&io___52); do_fio(&c__1, key_file__, 256L); e_rsfe(); if (s_cmp(key_file__, " ", 256L, 1L) != 0) { strek_parse_key_defs__(key_file__, &found, 256L); } if (! found || s_cmp(key_file__, " ", 256L, 1L) == 0) { for (j = 1; j <= 256; ++j) { key_defs__1.means[j - 1] = j; /* L30: */ } } } } else { for (j = 1; j <= 256; ++j) { key_defs__1.means[j - 1] = j; /* L40: */ } } } s_wsle(&io___53); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); return 0; } /* strek_question__ */ /* Subroutine */ int strek_ships__() { /* Initialized data */ static char retired[10+1] = "retired "; /* Format strings */ static char fmt_100[] = "(\002STAR TREK Ship Registry as of \002,i4\ ,\002/\002,i2,\002/\002,i2)"; static char fmt_120[] = "(1x,a30,x,i10,5x,a7,i10)"; static char fmt_130[] = "(1x,a30,x,i10,2x,i4,\002/\002,i2,\002/\002,i2,i\ 10)"; /* System generated locals */ integer i__1; olist o__1; cllist cl__1; inlist ioin__1; /* Builtin functions */ integer f_inqu(), f_open(), s_wsle(), do_lio(), e_wsle(), s_wsfe(), do_fio(), e_wsfe(), s_rdue(), do_uio(), e_rdue(), f_clos(); /* Local variables */ static char key_file__[256]; static integer ship_retired__, i, j; static shortint decoded_clock__[6]; static char nick_name__[10], capt_name__[10], ship_name__[30], user_name__[10]; static integer cum_score__, num_lines__, ship_avail__[3]; extern /* Subroutine */ int caldecodelocaltime_(); static integer last_score__; static real status; static logical fyn; /* Fortran I/O blocks */ static cilist io___58 = { 0, 6, 0, 0, 0 }; static cilist io___59 = { 0, 6, 0, 0, 0 }; static cilist io___60 = { 0, 6, 0, fmt_100, 0 }; static cilist io___62 = { 0, 6, 0, 0, 0 }; static cilist io___63 = { 0, 6, 0, 0, 0 }; static cilist io___64 = { 0, 6, 0, 0, 0 }; static cilist io___65 = { 0, 1, 0, 0, 1 }; static cilist io___68 = { 0, 1, 0, 0, 0 }; static cilist io___78 = { 0, 6, 0, fmt_120, 0 }; static cilist io___79 = { 0, 6, 0, fmt_130, 0 }; static cilist io___80 = { 0, 6, 0, 0, 0 }; static cilist io___81 = { 0, 6, 0, 0, 0 }; /* STREK_SHIPS outputs the current ship list including the */ /* scores of their last outings. */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/cal.ins.ftn' */ /* % include '/sys/ins/time.ins.ftn' */ /* get local time */ caldecodelocaltime_(decoded_clock__); /* open database */ ioin__1.inerr = 0; ioin__1.infilen = 30; ioin__1.infile = TREK_INFO; ioin__1.inex = &fyn; ioin__1.inopen = 0; ioin__1.innum = 0; ioin__1.innamed = 0; ioin__1.inname = 0; ioin__1.inacc = 0; ioin__1.inseq = 0; ioin__1.indir = 0; ioin__1.infmt = 0; ioin__1.inform = 0; ioin__1.inunf = 0; ioin__1.inrecl = 0; ioin__1.innrec = 0; ioin__1.inblank = 0; f_inqu(&ioin__1); if (! fyn) { status = (float)1.; return 0; } o__1.oerr = 0; o__1.ounit = 1; o__1.ofnmlen = 30; o__1.ofnm = TREK_INFO; o__1.orl = 1000; o__1.osta = "old"; o__1.oacc = "direct"; o__1.ofm = "unformatted"; o__1.oblnk = 0; f_open(&o__1); /* print out header */ s_wsle(&io___58); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___59); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsfe(&io___60); for (i = 1; i <= 3; ++i) { do_fio(&c__1, (char *)&decoded_clock__[i - 1], (ftnlen)sizeof( shortint)); } e_wsfe(); s_wsle(&io___62); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___63); do_lio(&c__9, &c__1, "SHIP NAME LAST SCORE AVAILA\ BLE SCORE", 63L); e_wsle(); s_wsle(&io___64); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_rdue(&io___65); do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer)); e_rdue(); i__1 = num_lines__ + 1; for (j = 2; j <= i__1; ++j) { io___68.cirec = j; s_rdue(&io___68); do_uio(&c__1, ship_name__, 30L); do_uio(&c__1, user_name__, 10L); do_uio(&c__1, capt_name__, 10L); do_uio(&c__1, nick_name__, 10L); do_uio(&c__1, key_file__, 256L); for (i = 1; i <= 3; ++i) { do_uio(&c__1, (char *)&ship_avail__[i - 1], (ftnlen)sizeof( integer)); } do_uio(&c__1, (char *)&last_score__, (ftnlen)sizeof(integer)); do_uio(&c__1, (char *)&cum_score__, (ftnlen)sizeof(integer)); do_uio(&c__1, (char *)&ship_retired__, (ftnlen)sizeof(integer)); e_rdue(); if (ship_retired__ == 1) { s_wsfe(&io___78); do_fio(&c__1, ship_name__, 30L); do_fio(&c__1, (char *)&last_score__, (ftnlen)sizeof(integer)); do_fio(&c__1, retired, 10L); do_fio(&c__1, (char *)&cum_score__, (ftnlen)sizeof(integer)); e_wsfe(); } else { s_wsfe(&io___79); do_fio(&c__1, ship_name__, 30L); do_fio(&c__1, (char *)&last_score__, (ftnlen)sizeof(integer)); for (i = 1; i <= 3; ++i) { do_fio(&c__1, (char *)&ship_avail__[i - 1], (ftnlen)sizeof( integer)); } do_fio(&c__1, (char *)&cum_score__, (ftnlen)sizeof(integer)); e_wsfe(); } /* L10: */ } s_wsle(&io___80); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___81); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); cl__1.cerr = 0; cl__1.cunit = 1; cl__1.csta = 0; f_clos(&cl__1); return 0; } /* strek_ships__ */ /* Subroutine */ int strek_scores__() { /* Initialized data */ static char dummy1[34+1] = " User CAPTAIN SHIP NA"; static char dummy2[34+1] = "ME SCORE"; /* Format strings */ static char fmt_100[] = "(\002 Top 10 STAR TREK Scores as of \002,i4,\ \002/\002,i2,\002/\002,i2)"; static char fmt_130[] = "(a34,a34)"; static char fmt_110[] = "(a10,a10,a30,i10)"; static char fmt_120[] = "(i2,\002.\002,2x,a10,x,a10,x,a30,x,i10)"; /* System generated locals */ olist o__1; cllist cl__1; inlist ioin__1; /* Builtin functions */ integer f_inqu(), f_open(), s_wsle(), do_lio(), e_wsle(), s_wsfe(), do_fio(), e_wsfe(), s_rsfe(), e_rsfe(), f_clos(); /* Local variables */ static integer i, j; static shortint decoded_clock__[6]; static char capt_name__[10], ship_name__[30], user_name__[10]; extern /* Subroutine */ int caldecodelocaltime_(); static real status; static integer top_scores__; static logical fyn; /* Fortran I/O blocks */ static cilist io___87 = { 0, 6, 0, 0, 0 }; static cilist io___88 = { 0, 6, 0, fmt_100, 0 }; static cilist io___90 = { 0, 6, 0, 0, 0 }; static cilist io___91 = { 0, 6, 0, fmt_130, 0 }; static cilist io___92 = { 0, 6, 0, 0, 0 }; static cilist io___94 = { 0, 2, 0, fmt_110, 0 }; static cilist io___99 = { 0, 6, 0, fmt_120, 0 }; static cilist io___100 = { 0, 6, 0, "(a1)", 0 }; static cilist io___101 = { 0, 6, 0, "(a1)", 0 }; /* STREK_SCORES prints out the list of top scores currently */ /* in STREK_TOP_SCORES. */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/cal.ins.ftn' */ /* % include '/sys/ins/time.ins.ftn' */ /* get local time */ caldecodelocaltime_(decoded_clock__); /* open up top scores file and read */ ioin__1.inerr = 0; ioin__1.infilen = 36; ioin__1.infile = TOP_SCORES; ioin__1.inex = &fyn; ioin__1.inopen = 0; ioin__1.innum = 0; ioin__1.innamed = 0; ioin__1.inname = 0; ioin__1.inacc = 0; ioin__1.inseq = 0; ioin__1.indir = 0; ioin__1.infmt = 0; ioin__1.inform = 0; ioin__1.inunf = 0; ioin__1.inrecl = 0; ioin__1.innrec = 0; ioin__1.inblank = 0; f_inqu(&ioin__1); if (! fyn) { status = (float)1.; return 0; } o__1.oerr = 0; o__1.ounit = 2; o__1.ofnmlen = 36; o__1.ofnm = TOP_SCORES; o__1.orl = 1000; o__1.osta = "old"; o__1.oacc = 0; o__1.ofm = "formatted"; o__1.oblnk = 0; f_open(&o__1); /* print out header */ s_wsle(&io___87); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsfe(&io___88); for (i = 1; i <= 3; ++i) { do_fio(&c__1, (char *)&decoded_clock__[i - 1], (ftnlen)sizeof( shortint)); } e_wsfe(); s_wsle(&io___90); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsfe(&io___91); do_fio(&c__1, dummy1, 34L); do_fio(&c__1, dummy2, 34L); e_wsfe(); s_wsle(&io___92); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); for (j = 1; j <= 10; ++j) { s_rsfe(&io___94); do_fio(&c__1, user_name__, 10L); do_fio(&c__1, capt_name__, 10L); do_fio(&c__1, ship_name__, 30L); do_fio(&c__1, (char *)&top_scores__, (ftnlen)sizeof(integer)); e_rsfe(); s_wsfe(&io___99); do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); do_fio(&c__1, user_name__, 10L); do_fio(&c__1, capt_name__, 10L); do_fio(&c__1, ship_name__, 30L); do_fio(&c__1, (char *)&top_scores__, (ftnlen)sizeof(integer)); e_wsfe(); /* L10: */ } /* print*,' ' */ s_wsfe(&io___100); do_fio(&c__1, " ", 1L); e_wsfe(); /* print*,' ' */ s_wsfe(&io___101); do_fio(&c__1, " ", 1L); e_wsfe(); cl__1.cerr = 0; cl__1.cunit = 2; cl__1.csta = 0; f_clos(&cl__1); return 0; } /* strek_scores__ */ /* Subroutine */ int strek_damage_date__(damage_days__, ship_avail__) integer *damage_days__, *ship_avail__; { /* Initialized data */ static integer days[12] = { 31,28,31,30,31,30,31,31,30,31,30,31 }; /* System generated locals */ integer i__1; /* Local variables */ static integer ichk, iday, ichk1, ichk2; static shortint decoded_clock__[6]; static integer iyear, imonth; extern /* Subroutine */ int caldecodelocaltime_(); /* STREK_DAMAGE_DATE computes the ship availability date */ /* given the damage repair time in whole days. This is */ /* used after a game but before updating STREK_INFO via */ /* STREK_WRITE. Note that damage date can't exceed 1 year */ /* and is not adjusted for leap years encountered when */ /* damage occurs in a non-leap year. */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/cal.ins.ftn' */ /* % include '/sys/ins/time.ins.ftn' */ /* days in months data */ /* Parameter adjustments */ --ship_avail__; /* Function Body */ /* get local time */ caldecodelocaltime_(decoded_clock__); /* if a leap year change days(2) */ i__1 = decoded_clock__[0]; ichk = i__1 % 4; if (ichk == 0) { days[1] = 29; i__1 = decoded_clock__[0]; ichk1 = i__1 % 100; i__1 = decoded_clock__[0]; ichk2 = i__1 % 400; if (ichk1 == 0) { if (ichk2 == 0) { days[1] = 29; } else { days[1] = 28; } } } /* add damage days to local time */ iday = *damage_days__ + decoded_clock__[2]; imonth = decoded_clock__[1]; if (iday > days[imonth - 1]) { iday -= days[imonth - 1]; imonth = decoded_clock__[1] + 1; } if (imonth <= 12) { iyear = decoded_clock__[0]; } else { iyear = decoded_clock__[0] + 1; imonth += -12; } /* load ship availability date */ ship_avail__[1] = iyear; ship_avail__[2] = imonth; ship_avail__[3] = iday; return 0; } /* strek_damage_date__ */ /* Subroutine */ int strek_startup__(user_name__, capt_name__, nick_name__, ship_name__, last_score__, cum_score__, key_file__, new_, user_name_len, capt_name_len, nick_name_len, ship_name_len, key_file_len) char *user_name__, *capt_name__, *nick_name__, *ship_name__; integer *last_score__, *cum_score__; char *key_file__; logical *new_; ftnlen user_name_len; ftnlen capt_name_len; ftnlen nick_name_len; ftnlen ship_name_len; ftnlen key_file_len; { /* Builtin functions */ integer s_wsle(), do_lio(), e_wsle(); /* Subroutine */ int s_stop(); integer s_rsfe(), do_fio(), e_rsfe(); /* Local variables */ extern /* Subroutine */ int strek_scores__(), strek_review__(); static integer ship_avail__[3]; static char answer[1]; static integer status; extern /* Subroutine */ int strek_question__(); static logical ship_active__; extern /* Subroutine */ int strek_ships__(); /* Fortran I/O blocks */ static cilist io___113 = { 0, 6, 0, 0, 0 }; static cilist io___114 = { 0, 6, 0, 0, 0 }; static cilist io___115 = { 0, 6, 0, 0, 0 }; static cilist io___116 = { 0, 6, 0, 0, 0 }; static cilist io___117 = { 0, 6, 0, 0, 0 }; static cilist io___118 = { 0, 6, 0, 0, 0 }; static cilist io___119 = { 0, 6, 0, 0, 0 }; static cilist io___120 = { 0, 5, 0, "(a)", 0 }; static cilist io___122 = { 0, 6, 0, 0, 0 }; /* STREK_STARTUP initializes the strek system. The order */ /* of calls is: */ /* STREK_QUESTION - get captain info and ship name, */ /* STREK_REVIEW - if ship is old get it's stats. */ /* options: STREK_SHIPS - review the current ship registry, */ /* and STREK_SCORES - review the top 10 scores. */ /* version 1 */ /* -jsr 8/85 */ /* STREK is open so question the captain */ strek_question__(user_name__, capt_name__, nick_name__, ship_name__, key_file__, new_, 10L, 10L, 10L, 30L, 256L); /* if this is a new ship or captain set up scores */ if (*new_) { *cum_score__ = 0; *last_score__ = 0; } else { /* this is an old ship, check her status in the registry */ strek_review__(ship_name__, user_name__, capt_name__, nick_name__, ship_avail__, cum_score__, last_score__, &ship_active__, key_file__, &status, 30L, 10L, 10L, 10L, 256L); if (status == 1) { s_wsle(&io___113); do_lio(&c__9, &c__1, "STREK_INFO doesn't exist, execution stops!", 42L); e_wsle(); s_wsle(&io___114); do_lio(&c__9, &c__1, "Run XSTREK_STARTUP_DB to initialize the da\ tabase.", 49L); e_wsle(); s_wsle(&io___115); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_stop("", 0L); } } /* review the registry or scores? */ L10: s_wsle(&io___116); do_lio(&c__9, &c__1, "Enter to view the ship registry,", 36L); e_wsle(); s_wsle(&io___117); do_lio(&c__9, &c__1, " to view the top ten scores or", 39L); e_wsle(); s_wsle(&io___118); do_lio(&c__9, &c__1, " to start.", 24L); e_wsle(); s_wsle(&io___119); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_rsfe(&io___120); do_fio(&c__1, answer, 1L); e_rsfe(); if (*answer == 'r') { strek_ships__(); goto L10; } else if (*answer == 's') { strek_scores__(); goto L10; } else { s_wsle(&io___122); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); } return 0; } /* strek_startup__ */ /* Subroutine */ int strek_ship_avail__(ship_avail__, avail) integer *ship_avail__; logical *avail; { static shortint decoded_clock__[6]; extern /* Subroutine */ int caldecodelocaltime_(); /* STREK_SHIP_AVAIL decodes the ship available time from */ /* STREK_INFO and decides if the ship is ready or not. */ /* Dead ships are flagged in STREK_INFO and needn't */ /* be processed herein. */ /* If (avail) then the ship is available. */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/time.ins.ftn' */ /* % include '/sys/ins/cal.ins.ftn' */ /* get local time */ /* Parameter adjustments */ --ship_avail__; /* Function Body */ caldecodelocaltime_(decoded_clock__); /* compare dates and see if ship is ready */ if (ship_avail__[1] > decoded_clock__[0]) { *avail = FALSE_; return 0; } else if (ship_avail__[1] < decoded_clock__[0]) { *avail = TRUE_; return 0; } else if (ship_avail__[2] > decoded_clock__[1]) { *avail = FALSE_; return 0; } else if (ship_avail__[2] < decoded_clock__[1]) { *avail = TRUE_; return 0; } else if (ship_avail__[3] > decoded_clock__[2]) { *avail = FALSE_; return 0; } else { *avail = TRUE_; } return 0; } /* strek_ship_avail__ */ /* Subroutine */ int strek_dock__(d_pct__, score, user_name__, capt_name__, nick_name__, ship_name__, cum_score__, key_file__, new_ship__, user_name_len, capt_name_len, nick_name_len, ship_name_len, key_file_len) real *d_pct__; integer *score; char *user_name__, *capt_name__, *nick_name__, *ship_name__; integer *cum_score__; char *key_file__; logical *new_ship__; ftnlen user_name_len; ftnlen capt_name_len; ftnlen nick_name_len; ftnlen ship_name_len; ftnlen key_file_len; { /* Initialized data */ static real time[6] = { (float)1.25,(float)1.25,(float).75,(float).5,( float).75,(float).5 }; static logical active = TRUE_; static integer seconds = 2; /* Format strings */ static char fmt_100[] = "(\002 Your ship will be ready on \002,i4,\002\ /\002,i2,\002/\002,i2)"; /* Builtin functions */ integer i_nint(); /* Subroutine */ int s_copy(); integer s_wsle(), do_lio(), e_wsle(), s_cmp(), s_wsfe(), do_fio(), e_wsfe( ); /* Local variables */ extern /* Subroutine */ int strek_write__(); static integer days; extern /* Subroutine */ int timewait_(); static real timerelative; extern /* Subroutine */ int gprterminate_(), strek_scores__(); static integer i, j; static shortint clock[3]; extern /* Subroutine */ int strek_damage_date__(), calsectoclock_(), strek_message__(); static real damage; static integer ship_avail__[3], status; static char message[80*3]; static logical top_ten__; /* Fortran I/O blocks */ static cilist io___136 = { 0, 6, 0, 0, 0 }; static cilist io___137 = { 0, 6, 0, fmt_100, 0 }; static cilist io___139 = { 0, 6, 0, 0, 0 }; static cilist io___140 = { 0, 6, 0, 0, 0 }; static cilist io___141 = { 0, 6, 0, 0, 0 }; static cilist io___142 = { 0, 6, 0, 0, 0 }; static cilist io___143 = { 0, 6, 0, 0, 0 }; static cilist io___144 = { 0, 6, 0, 0, 0 }; static cilist io___145 = { 0, 6, 0, 0, 0 }; /* STREK_DOCK updates the STREK database after docking */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/cal.ins.ftn' */ /* % include '/sys/ins/gpr.ins.ftn' */ /* % include '/sys/ins/time.ins.ftn' */ /* Parameter adjustments */ --d_pct__; /* Function Body */ /* do house keeping */ *cum_score__ += *score; calsectoclock_(&seconds, clock); /* add up damage times */ damage = (float).5; for (j = 1; j <= 6; ++j) { damage += ((float)1. - d_pct__[j]) * time[j - 1]; /* L10: */ } days = i_nint(&damage); strek_damage_date__(&days, ship_avail__); /* write update info to STREK_INFO */ strek_write__(new_ship__, ship_name__, user_name__, capt_name__, nick_name__, key_file__, ship_avail__, score, cum_score__, & active, &top_ten__, 30L, 10L, 10L, 10L, 256L); /* write messages to screen */ s_copy(message, " ", 80L, 1L); s_copy(message + 80, "Awaiting permission to dock.", 80L, 28L); s_copy(message + 160, " ", 80L, 1L); strek_message__(message, &c__3, 80L); timewait_(&timerelative, clock, &status); s_copy(message + 80, "Docking completed, good going captain. ", 80L, 39L); strek_message__(message, &c__3, 80L); timewait_(&timerelative, clock, &status); /* terminate graphics */ gprterminate_(&c__1, &status); s_wsle(&io___136); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); if (s_cmp(ship_name__, " ", 30L, 1L) != 0) { s_wsfe(&io___137); for (i = 1; i <= 3; ++i) { do_fio(&c__1, (char *)&ship_avail__[i - 1], (ftnlen)sizeof( integer)); } e_wsfe(); } s_wsle(&io___139); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___140); do_lio(&c__9, &c__1, "Score for this mission: ", 24L); do_lio(&c__3, &c__1, (char *)&(*score), (ftnlen)sizeof(integer)); e_wsle(); s_wsle(&io___141); do_lio(&c__9, &c__1, "Cumulative score: ", 18L); do_lio(&c__3, &c__1, (char *)&(*cum_score__), (ftnlen)sizeof(integer)); e_wsle(); s_wsle(&io___142); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); if (top_ten__) { strek_scores__(); s_wsle(&io___143); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___144); do_lio(&c__9, &c__1, "Congratulations! Your score places you in the \ Top 10.", 53L); e_wsle(); s_wsle(&io___145); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); } return 0; } /* strek_dock__ */ /* Subroutine */ int strek_no_energy__(num_times__, user_name__, capt_name__, nick_name__, ship_name__, key_file__, score, cum_score__, new_, user_name_len, capt_name_len, nick_name_len, ship_name_len, key_file_len) integer *num_times__; char *user_name__, *capt_name__, *nick_name__, *ship_name__, *key_file__; integer *score, *cum_score__; logical *new_; ftnlen user_name_len; ftnlen capt_name_len; ftnlen nick_name_len; ftnlen ship_name_len; ftnlen key_file_len; { /* Initialized data */ static integer seconds = 5; static integer ship_avail__[3] = { 0,0,0 }; static char message_1__[80*3+1] = "Message from engineering: \ Sir, the battery reserves are cri\ tically low. Non-vital subsystems being dr\ opped. "; static char message_2__[80*3+1] = "Message from engineering: \ Main system shutdown occuring on \ all decks. Life-support system is in dan\ ger of failure. "; static char message_3__[80*3+1] = "Message from engineering: \ Life-support system is down, oxyg\ en content is dropping. Main system shutdown complete\ . "; /* Builtin functions */ /* Subroutine */ int s_copy(); integer s_wsfi(), do_fio(), e_wsfi(), s_wsle(), do_lio(), e_wsle(), s_cmp( ); /* Subroutine */ int s_stop(); /* Local variables */ extern /* Subroutine */ int strek_write__(), timewait_(); static real timerelative; extern /* Subroutine */ int gprterminate_(), strek_scores__(); static char blank[80*3]; static shortint clock[3]; extern /* Subroutine */ int calsectoclock_(), strek_message__(); static integer status; static logical top_ten__; /* Fortran I/O blocks */ static icilist io___152 = { 0, blank+160, 0, "(a30, a10)", 80, 1 }; static cilist io___157 = { 0, 6, 0, 0, 0 }; static cilist io___158 = { 0, 6, 0, 0, 0 }; static cilist io___159 = { 0, 6, 0, 0, 0 }; static cilist io___160 = { 0, 6, 0, 0, 0 }; static cilist io___161 = { 0, 6, 0, 0, 0 }; static cilist io___162 = { 0, 6, 0, 0, 0 }; static cilist io___163 = { 0, 6, 0, 0, 0 }; static cilist io___164 = { 0, 6, 0, 0, 0 }; static cilist io___165 = { 0, 6, 0, 0, 0 }; static cilist io___166 = { 0, 6, 0, 0, 0 }; static cilist io___167 = { 0, 6, 0, 0, 0 }; static cilist io___168 = { 0, 6, 0, 0, 0 }; /* STREK_NO_ENERGY advises the captain to cut energy use. Messages */ /* become more and more urgent as the number of turns w/o energy */ /* increases. After 150 turns the ship is retired and the database */ /* updated. */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/cal.ins.ftn' */ /* % include '/sys/ins/gpr.ins.ftn' */ /* % include '/sys/ins/time.ins.ftn' */ /* data for message strings */ if (*num_times__ == 1) { strek_message__(message_1__, &c__3, 80L); } else if (*num_times__ == 50) { strek_message__(message_2__, &c__3, 80L); } else if (*num_times__ == 100) { strek_message__(message_3__, &c__3, 80L); } else if (*num_times__ == 150) { s_copy(blank, "Message from chief engineer Scotty:", 80L, 35L); s_copy(blank + 80, "Sir, aye can't hold on much longah.", 80L, 35L); s_wsfi(&io___152); do_fio(&c__1, "It looks like the game's over ", 30L); do_fio(&c__1, nick_name__, 10L); e_wsfi(); strek_message__(blank, &c__3, 80L); /* do house keeping */ *cum_score__ += *score; calsectoclock_(&seconds, clock); strek_write__(new_, ship_name__, user_name__, capt_name__, nick_name__, key_file__, ship_avail__, score, cum_score__, & c__0, &top_ten__, 30L, 10L, 10L, 10L, 256L); timewait_(&timerelative, clock, &status); /* terminate graphics */ gprterminate_(&c__1, &status); s_wsle(&io___157); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___158); do_lio(&c__9, &c__1, "Score for this mission: ", 24L); do_lio(&c__3, &c__1, (char *)&(*score), (ftnlen)sizeof(integer)); e_wsle(); s_wsle(&io___159); do_lio(&c__9, &c__1, "Cumulative score: ", 18L); do_lio(&c__3, &c__1, (char *)&(*cum_score__), (ftnlen)sizeof(integer)) ; e_wsle(); s_wsle(&io___160); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); if (top_ten__) { strek_scores__(); s_wsle(&io___161); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___162); do_lio(&c__9, &c__1, "Congratulations! Your score places you in \ the Top 10.", 53L); e_wsle(); s_wsle(&io___163); do_lio(&c__9, &c__1, "A rather hollow victory I would think.", 38L); e_wsle(); s_wsle(&io___164); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); } s_wsle(&io___165); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); if (s_cmp(ship_name__, " ", 30L, 1L) != 0) { s_wsle(&io___166); do_lio(&c__9, &c__1, "Your ship, the ", 15L); do_lio(&c__9, &c__1, ship_name__, 30L); e_wsle(); s_wsle(&io___167); do_lio(&c__9, &c__1, "was decommissioned after being found by Fe\ deration scouts.", 58L); e_wsle(); s_wsle(&io___168); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); } s_stop("", 0L); } return 0; } /* strek_no_energy__ */ /* Subroutine */ int strek_search_name__(user_name__, capt_name__, ship_name__, key_file__, new_, user_name_len, capt_name_len, ship_name_len, key_file_len) char *user_name__, *capt_name__, *ship_name__, *key_file__; logical *new_; ftnlen user_name_len; ftnlen capt_name_len; ftnlen ship_name_len; ftnlen key_file_len; { /* Format strings */ static char fmt_100[] = "(x,i1,\002. \002,a30)"; /* System generated locals */ integer i__1; olist o__1; cllist cl__1; /* Builtin functions */ integer f_open(), s_rdue(), do_uio(), e_rdue(), s_cmp(), f_clos(); /* Subroutine */ int s_copy(); integer s_wsle(), do_lio(), e_wsle(), s_wsfe(), do_fio(), e_wsfe(), s_rsle(), e_rsle(), s_rsfe(), e_rsfe(); /* Local variables */ static char nick[10*10], practice[30]; static integer ship_retired__; static char temp1[30], temp2[10], temp3[10]; extern /* Subroutine */ int strek_ship_avail__(); static integer i, j; static logical avail; static char nick_name__[10]; static logical ready[10]; static char ships[30*10]; static integer count, cum_score__, num_lines__, number, ship_avail__[3], last_score__; static char key[256*10]; /* Fortran I/O blocks */ static cilist io___169 = { 0, 1, 0, 0, 1 }; static cilist io___173 = { 0, 1, 0, 0, 0 }; static cilist io___177 = { 0, 1, 0, 0, 0 }; static cilist io___189 = { 0, 6, 0, 0, 0 }; static cilist io___190 = { 0, 6, 0, 0, 0 }; static cilist io___191 = { 0, 6, 0, 0, 0 }; static cilist io___192 = { 0, 6, 0, fmt_100, 0 }; static cilist io___193 = { 0, 6, 0, fmt_100, 0 }; static cilist io___194 = { 0, 6, 0, 0, 0 }; static cilist io___195 = { 0, 6, 0, 0, 0 }; static cilist io___196 = { 0, 6, 0, 0, 0 }; static cilist io___197 = { 0, 5, 0, 0, 0 }; static cilist io___199 = { 0, 6, 0, 0, 0 }; static cilist io___200 = { 0, 6, 0, 0, 0 }; static cilist io___201 = { 0, 5, 0, "(a)", 0 }; /* STREK_SEARCH_NAME searches for the names of ships for a certain */ /* captain. To fly a certain ship he need only type the number */ /* associated with it. */ /* 4/86 -jsr */ /* open the info file and read off all ship names */ o__1.oerr = 0; o__1.ounit = 1; o__1.ofnmlen = 30; o__1.ofnm = TREK_INFO; o__1.orl = 1000; o__1.osta = "old"; o__1.oacc = "direct"; o__1.ofm = "unformatted"; o__1.oblnk = 0; f_open(&o__1); /* read number of lines */ s_rdue(&io___169); do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer)); e_rdue(); count = 2; i__1 = num_lines__ + 1; for (i = 2; i <= i__1; ++i) { io___173.cirec = i; s_rdue(&io___173); do_uio(&c__1, temp1, 30L); do_uio(&c__1, temp3, 10L); do_uio(&c__1, temp2, 10L); e_rdue(); if (s_cmp(temp2, capt_name__, 10L, 10L) == 0 && s_cmp(temp3, user_name__, 10L, 10L) == 0) { io___177.cirec = i; s_rdue(&io___177); do_uio(&c__1, ships + (count - 1) * 30, 30L); do_uio(&c__1, temp3, 10L); do_uio(&c__1, temp2, 10L); do_uio(&c__1, nick + (count - 1) * 10, 10L); do_uio(&c__1, key + (count - 1 << 8), 256L); for (j = 1; j <= 3; ++j) { do_uio(&c__1, (char *)&ship_avail__[j - 1], (ftnlen)sizeof( integer)); } do_uio(&c__1, (char *)&last_score__, (ftnlen)sizeof(integer)); do_uio(&c__1, (char *)&cum_score__, (ftnlen)sizeof(integer)); do_uio(&c__1, (char *)&ship_retired__, (ftnlen)sizeof(integer)); e_rdue(); strek_ship_avail__(ship_avail__, &avail); if (avail) { ready[count - 1] = TRUE_; } else { ready[count - 1] = FALSE_; } ++count; } /* L10: */ } cl__1.cerr = 0; cl__1.cunit = 1; cl__1.csta = 0; f_clos(&cl__1); --count; s_copy(practice, "practice flight", 30L, 15L); s_copy(ships, "initiate new ship", 30L, 17L); ready[0] = TRUE_; s_wsle(&io___189); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___190); do_lio(&c__9, &c__1, "Ships available:", 16L); e_wsle(); s_wsle(&io___191); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsfe(&io___192); do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); do_fio(&c__1, practice, 30L); e_wsfe(); i__1 = count; for (i = 1; i <= i__1; ++i) { if (ready[i - 1]) { s_wsfe(&io___193); do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer)); do_fio(&c__1, ships + (i - 1) * 30, 30L); e_wsfe(); } /* L20: */ } L30: s_wsle(&io___194); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___195); do_lio(&c__9, &c__1, "Enter the number of the ship you wish to fly.", 45L) ; e_wsle(); s_wsle(&io___196); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_rsle(&io___197); do_lio(&c__3, &c__1, (char *)&number, (ftnlen)sizeof(integer)); e_rsle(); if (number == 1) { s_wsle(&io___199); do_lio(&c__9, &c__1, " ", 1L); e_wsle(); s_wsle(&io___200); do_lio(&c__9, &c__1, "What do you want to call your ship sir?", 39L); e_wsle(); s_rsfe(&io___201); do_fio(&c__1, ship_name__, 30L); e_rsfe(); *new_ = TRUE_; } else if (number > 1 && ready[number - 1]) { *new_ = FALSE_; s_copy(ship_name__, ships + (number - 1) * 30, 30L, 30L); s_copy(nick_name__, nick + (number - 1) * 10, 10L, 10L); s_copy(key_file__, key + (number - 1 << 8), 256L, 256L); } else if (number == 0) { *new_ = TRUE_; s_copy(ship_name__, " ", 30L, 1L); } else { goto L30; } return 0; } /* strek_search_name__ */