C GETCH.FOR C C************************************************************************ C C GETCH returns the next character from the input stream. C C Arguments C Name Type I/O Meaning C --------------------------------------------------- C ch char O Next char from input C C************************************************************************ C subroutine getch (ch) implicit integer (a-z) parameter INPUT_CHAN = 5 parameter IMAX = 80 parameter STACK_MAX = 3 character ch * (*), buffer * (IMAX), stack (STACK_MAX) character EOL /13/ character EOF /26/ character chold /' '/ integer icol /IMAX/ integer ichan /INPUT_CHAN/ integer pntr /0/ logical e_flag, echo_flag /.FALSE./ common /getchc/ EOL, EOF, chold common /getchi/ icol, ichan, pntr, echo_flag 50 format (q, a) 60 format ('+',a) if (pntr .gt. 0) then ! pop off push back stack ch = stack (pntr) pntr = pntr - 1 return endif if (chold .eq. EOL) then 100 read (ichan, 50, iostat=ios) ecol, buffer (1:max(1,ecol)) ! read next line if (ios .lt. 0) then ! end of file ch = EOF go to 500 endif if (echo_flag) type 60, buffer (1:max(1,ecol)) ! echo icol = 0 endif icol = icol + 1 if (icol .le. ecol) then ! next character ch = buffer(icol:icol) else ! end of line ch = EOL endif chold = ch 500 return C C************************************************************************ C C PUT_BACK pushes a character back into the input stream by C stacking it. C C************************************************************************ C entry put_back (ch) pntr = pntr + 1 if (pntr .gt. STACK_MAX) then type *,' Lexical Scanner Stack Overflow Fatal Error' call exit endif stack (pntr) = ch return C C************************************************************************ C C SET_SOURCE changes the I/O channel to read from and C turns echoing on or off. C C************************************************************************ C entry set_source (chan, e_flag) ichan = chan echo_flag = e_flag return end