1 /* prompt.f -- translated by f2c (version 19980913).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "f2c.h"
7
8 /* Table of constant values */
9
10 static integer c__1 = 1;
11
12 /* $Procedure PROMPT ( Prompt a user for a string ) */
prompt_(char * prmpt,char * string,ftnlen prmpt_len,ftnlen string_len)13 /* Subroutine */ int prompt_(char *prmpt, char *string, ftnlen prmpt_len,
14 ftnlen string_len)
15 {
16 /* System generated locals */
17 integer i__1, i__2;
18 cilist ci__1;
19
20 /* Builtin functions */
21 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
22 s_rsfe(cilist *), e_rsfe(void), i_len(char *, ftnlen);
23
24 /* Local variables */
25 extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
26 ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen)
27 , setmsg_(char *, ftnlen);
28 integer iostat;
29 extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
30
31 /* $ Abstract */
32
33 /* This routine prompts a user for keyboard input. */
34
35 /* $ Disclaimer */
36
37 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
38 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
39 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
40 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
41 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
42 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
43 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
44 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
45 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
46 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
47
48 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
49 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
50 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
51 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
52 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
53 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
54
55 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
56 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
57 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
58 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
59
60 /* $ Required_Reading */
61
62 /* None. */
63
64 /* $ Keywords */
65
66 /* UTILITY */
67
68 /* $ Declarations */
69 /* $ Brief_I/O */
70
71 /* Variable I/O Description */
72 /* -------- --- -------------------------------------------------- */
73 /* PRMPT I The prompt to use when asking for input. */
74 /* STRING O The response typed by a user. */
75
76 /* $ Detailed_Input */
77
78 /* PRMPT is a character string that will be displayed from the */
79 /* current cursor position and describes the input that */
80 /* the user is expected to enter. The string PRMPT should */
81 /* be relatively short, i.e., 50 or fewer characters, so */
82 /* that a response may be typed on the line where the */
83 /* prompt appears. */
84
85 /* All characters (including trailing blanks) in PRMPT */
86 /* are considered significant and will be displayed. */
87
88 /* $ Detailed_Output */
89
90 /* STRING is a character string that contains the string */
91 /* entered by the user. */
92
93 /* $ Parameters */
94
95 /* None. */
96
97 /* $ Exceptions */
98
99 /* This subroutine uses discovery check-in so that it may be called */
100 /* after an error has occurred. */
101
102 /* 1) If the attempt to write the prompt to the standard output */
103 /* device fails, returning an IOSTAT value not equal to zero, the */
104 /* error SPICE(WRITEFAILED) will be signalled. */
105
106 /* 2) If the attempt to read the response from the standard input */
107 /* device fails, returning an IOSTAT value not equal to zero, the */
108 /* error SPICE(READFAILED) will be signalled. */
109
110 /* $ Files */
111
112 /* None. */
113
114 /* $ Particulars */
115
116 /* This is a utility that allows you to "easily" request information */
117 /* from a program user. At a high level, it frees you from the */
118 /* peculiarities of a particular implementation of FORTRAN cursor */
119 /* control. */
120
121 /* $ Examples */
122
123 /* Suppose you wanted to ask a user to input an answer to */
124 /* a question such as "Do you want to try again? (Y/N) " */
125 /* and leave the cursor at the end of the question as shown here: */
126
127 /* Do you want to try again? (Y/N) _ */
128
129 /* (The underscore indicates the cursor position). */
130
131 /* The following line of code will do what you want. */
132
133 /* CALL PROMPT ( 'Do you want to try again? (Y/N) ', ANSWER ) */
134
135 /* $ Restrictions */
136
137 /* This routine is environment specific. Standard FORTRAN does not */
138 /* provide for user control of cursor position after write */
139 /* statements. */
140
141 /* $ Literature_References */
142
143 /* None. */
144
145 /* $ Author_and_Institution */
146
147 /* K.R. Gehringer (JPL) */
148 /* W.L. Taber (JPL) */
149
150 /* $ Version */
151
152 /* - SPICELIB Version 3.25.0, 10-MAR-2014 (BVS) */
153
154 /* Updated for SUN-SOLARIS-64BIT-INTEL. */
155
156 /* - SPICELIB Version 3.24.0, 10-MAR-2014 (BVS) */
157
158 /* Updated for PC-LINUX-64BIT-IFORT. */
159
160 /* - SPICELIB Version 3.23.0, 10-MAR-2014 (BVS) */
161
162 /* Updated for PC-CYGWIN-GFORTRAN. */
163
164 /* - SPICELIB Version 3.22.0, 10-MAR-2014 (BVS) */
165
166 /* Updated for PC-CYGWIN-64BIT-GFORTRAN. */
167
168 /* - SPICELIB Version 3.21.0, 10-MAR-2014 (BVS) */
169
170 /* Updated for PC-CYGWIN-64BIT-GCC_C. */
171
172 /* - SPICELIB Version 3.20.0, 13-MAY-2010 (BVS) */
173
174 /* Updated for SUN-SOLARIS-INTEL. */
175
176 /* - SPICELIB Version 3.19.0, 13-MAY-2010 (BVS) */
177
178 /* Updated for SUN-SOLARIS-INTEL-CC_C. */
179
180 /* - SPICELIB Version 3.18.0, 13-MAY-2010 (BVS) */
181
182 /* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
183
184 /* - SPICELIB Version 3.17.0, 13-MAY-2010 (BVS) */
185
186 /* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
187
188 /* - SPICELIB Version 3.16.0, 13-MAY-2010 (BVS) */
189
190 /* Updated for PC-WINDOWS-64BIT-IFORT. */
191
192 /* - SPICELIB Version 3.15.0, 13-MAY-2010 (BVS) */
193
194 /* Updated for PC-LINUX-64BIT-GFORTRAN. */
195
196 /* - SPICELIB Version 3.14.0, 13-MAY-2010 (BVS) */
197
198 /* Updated for PC-64BIT-MS_C. */
199
200 /* - SPICELIB Version 3.13.0, 13-MAY-2010 (BVS) */
201
202 /* Updated for MAC-OSX-64BIT-INTEL_C. */
203
204 /* - SPICELIB Version 3.12.0, 13-MAY-2010 (BVS) */
205
206 /* Updated for MAC-OSX-64BIT-IFORT. */
207
208 /* - SPICELIB Version 3.11.0, 13-MAY-2010 (BVS) */
209
210 /* Updated for MAC-OSX-64BIT-GFORTRAN. */
211
212 /* - SPICELIB Version 3.10.0, 18-MAR-2009 (BVS) */
213
214 /* Updated for PC-LINUX-GFORTRAN. */
215
216 /* - SPICELIB Version 3.9.0, 18-MAR-2009 (BVS) */
217
218 /* Updated for MAC-OSX-GFORTRAN. */
219
220 /* - SPICELIB Version 3.8.0, 19-FEB-2008 (BVS) */
221
222 /* Updated for PC-LINUX-IFORT. */
223
224 /* - SPICELIB Version 3.7.0, 14-NOV-2006 (BVS) */
225
226 /* Updated for PC-LINUX-64BIT-GCC_C. */
227
228 /* - SPICELIB Version 3.6.0, 14-NOV-2006 (BVS) */
229
230 /* Updated for MAC-OSX-INTEL_C. */
231
232 /* - SPICELIB Version 3.5.0, 14-NOV-2006 (BVS) */
233
234 /* Updated for MAC-OSX-IFORT. */
235
236 /* - SPICELIB Version 3.4.0, 14-NOV-2006 (BVS) */
237
238 /* Updated for PC-WINDOWS-IFORT. */
239
240 /* - SPICELIB Version 3.3.0, 26-OCT-2005 (BVS) */
241
242 /* Updated for SUN-SOLARIS-64BIT-GCC_C. */
243
244 /* - SPICELIB Version 3.2.0, 03-JAN-2005 (BVS) */
245
246 /* Updated for PC-CYGWIN_C. */
247
248 /* - SPICELIB Version 3.1.0, 03-JAN-2005 (BVS) */
249
250 /* Updated for PC-CYGWIN. */
251
252 /* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */
253
254 /* Added MAC-OSX environments. */
255
256 /* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */
257
258 /* The environment lines were expanded so that the supported */
259 /* environments are now explicitely given. New */
260 /* environments are WIN-NT */
261
262 /* - SPICELIB Version 3.0.3, 24-SEP-1999 (NJB) */
263
264 /* CSPICE environments were added. Some typos were corrected. */
265
266 /* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */
267
268 /* The environment lines were expanded so that the supported */
269 /* environments are now explicitely given. New */
270 /* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
271
272 /* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */
273
274 /* The environment lines were expanded so that the supported */
275 /* environments are now explicitely given. Previously, */
276 /* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
277 /* by the environment label SUN. */
278
279 /* - SPICELIB Version 3.0.0, 08-APR-1998 (NJB) */
280
281 /* Module was updated for the PC-LINUX platform. */
282
283 /* - SPICELIB Version 2.0.0, 20-JUL-1995 (WLT) (KRG) */
284
285 /* This routine now participates in error handling. It */
286 /* checks to make sure no I/O errors have occurred while */
287 /* attempting to write to standard output or read from standard */
288 /* input. It uses discovery checkin if an error is detected. */
289
290 /* Restructured the subroutine a little bit; the writing of the */
291 /* prompt is the only bit that is environment specific, so the */
292 /* code was rearranged to reflect this. There is now only a single */
293 /* READ statement. */
294
295 /* - SPICELIB Version 1.0.0, 15-OCT-1992 (WLT) */
296
297 /* -& */
298 /* $ Index_Entries */
299
300 /* Prompt for keyboard input */
301 /* Prompt for input with a user supplied message */
302
303 /* -& */
304 /* $ Revisions */
305
306 /* - SPICELIB Version 3.0.0, 08-APR-1998 (NJB) */
307
308 /* Module was updated for the PC-LINUX platform. */
309
310 /* - SPICELIB Version 2.0.0, 20-JUL-1995 (WLT) (KRG) */
311
312 /* This routine now participates in error handling. It */
313 /* checks to make sure no I/O errors have occurred while */
314 /* attempting to write to standard output or read from standard */
315 /* input. It uses discovery checkin if an error is detected. */
316
317 /* Restructured the subroutine a little bit; the writing of the */
318 /* prompt is the only bit that is environment specific, so the */
319 /* code was rearranged to reflect this. There is now only a single */
320 /* READ statement. */
321
322 /* -& */
323
324 /* Local variables */
325
326
327
328
329 /* The code below should be used in the following environments: */
330
331 /* SUN/Fortran, */
332 /* HP/HP-Fortran, */
333 /* Silicon Graphics/Silicon Graphics Fortran, */
334 /* DEC Alpha-OSF/1--DEC Fortran, */
335 /* NeXT/Absoft Fortran */
336 /* PC Linux/Fort77 */
337
338 ci__1.cierr = 1;
339 ci__1.ciunit = 6;
340 ci__1.cifmt = "(A,$)";
341 iostat = s_wsfe(&ci__1);
342 if (iostat != 0) {
343 goto L100001;
344 }
345 iostat = do_fio(&c__1, prmpt, prmpt_len);
346 if (iostat != 0) {
347 goto L100001;
348 }
349 iostat = e_wsfe();
350 L100001:
351
352 /* If none of the write statements above works on a particular */
353 /* unsupported platform, read on... */
354
355 /* Although, this isn't really what you want, if you need to port */
356 /* this quickly to an environment that does not support the format */
357 /* statement in any of the cases above, you can comment out the */
358 /* write statement above and un-comment the write statement below. */
359 /* In this way you can get a program working quickly in the new */
360 /* environment while you figure out how to control cursor */
361 /* positioning. */
362
363 /* WRITE (*,*, IOSTAT=IOSTAT ) PRMPT */
364
365 /* Check for a write error. It's not likely, but the standard output */
366 /* can be redirected. Better safe than confused later. */
367
368 if (iostat != 0) {
369 chkin_("PROMPT", (ftnlen)6);
370 setmsg_("An error occurred while attempting to write a prompt to the"
371 " standard output device, possibly because standard output ha"
372 "s been redirected to a file. There is not much that can be d"
373 "one about this if it happens. We do not try to determine whe"
374 "ther standard output has been redirected, so be sure that th"
375 "ere are sufficient resources available for the operation bei"
376 "ng performed.", (ftnlen)372);
377 sigerr_("SPICE(WRITEFAILED)", (ftnlen)18);
378 chkout_("PROMPT", (ftnlen)6);
379 return 0;
380 }
381
382 /* Now that we've written out the prompt and there was no error, we */
383 /* can read in the response. */
384
385 ci__1.cierr = 1;
386 ci__1.ciend = 1;
387 ci__1.ciunit = 5;
388 ci__1.cifmt = "(A)";
389 iostat = s_rsfe(&ci__1);
390 if (iostat != 0) {
391 goto L100002;
392 }
393 iostat = do_fio(&c__1, string, string_len);
394 if (iostat != 0) {
395 goto L100002;
396 }
397 iostat = e_rsfe();
398 L100002:
399 if (iostat != 0) {
400 chkin_("PROMPT", (ftnlen)6);
401 setmsg_("An error occurred while attempting to retrieve a reply to t"
402 "he prompt \"#\". A possible cause is that you have exhauste"
403 "d the input buffer while attempting to type your response. "
404 "It may help if you limit your response to # or fewer charact"
405 "ers. ", (ftnlen)242);
406 errch_("#", prmpt, (ftnlen)1, prmpt_len);
407 /* Computing MIN */
408 i__2 = i_len(string, string_len);
409 i__1 = min(i__2,131);
410 errint_("#", &i__1, (ftnlen)1);
411 sigerr_("SPICE(READFAILED)", (ftnlen)17);
412 chkout_("PROMPT", (ftnlen)6);
413 return 0;
414 }
415 return 0;
416 } /* prompt_ */
417
418