h25257
s 00000/00000/00292
d D 1.12 83/03/18 17:34:13 mjb 12 11
c 
e
s 00001/00001/00291
d D 1.11 83/03/03 00:34:31 mjb 11 10
c 
e
s 00009/00004/00283
d D 1.10 83/03/02 18:54:08 mjb 10 9
c implemented ^j to move down one column
e
s 00002/00001/00285
d D 1.9 83/02/18 00:35:48 mjb 9 8
c fixed numerous bugs with insertion and pie data in general
e
s 00023/00017/00263
d D 1.8 83/02/09 21:21:58 mjb 8 7
c 
e
s 00063/00020/00217
d D 1.7 83/02/03 20:26:39 mjb 7 6
c put in deletion of fields
e
s 00005/00003/00232
d D 1.6 83/02/01 16:55:38 mjb 6 5
c fixed bug with hitting <ESC> in choice menus
e
s 00004/00002/00231
d D 1.5 83/01/31 23:09:07 mjb 5 4
c fixed bug which allowed multiple - + and .
e
s 00001/00001/00232
d D 1.4 83/01/31 20:27:08 mjb 4 3
c changes for error reporting
e
s 00001/00001/00232
d D 1.3 83/01/28 14:37:06 mjb 3 2
c modified for cursor information
e
s 00070/00063/00163
d D 1.2 83/01/22 19:10:54 tes 2 1
c Modified for annnotate interface
e
s 00226/00000/00000
d D 1.1 83/01/20 11:12:14 tes 1 0
c date and time created 83/01/20 11:12:14 by tes
e
u
tes
mjb
U
t
T
I 1
subroutine managd (termn)
########################################################################
#                                                                      #
#          THIS MATERIAL IS CONFIDENTIAL AND IS FURNISHED UNDER        #
#          A WRITTEN LICENSE AGREEMENT.  IT MAY NOT BE USED,           #
#          COPIED OR DISCLOSED TO OTHERS EXCEPT IN ACCORDANCE          #
#          WITH THE TERMS OF THAT AGREEMENT.                           #
#                                                                      #
#          COPYRIGHT (C) 1982 GRAPHIC SOFTWARE SYSTEMS INC.            #
#          ALL RIGHTS RESERVED.                                        #
#                                                                      #
#     Function: Manage the data area of the current menu               #
#                                                                      #
#     Input Parameters:                                                #
#            termn - (short int) character to use as terminator        #
#                                                                      #
#     Output Parameters:                                               #
#            None                                                      #
#                                                                      #
#     Routines Called:                                                 #
#            None                                                      #
#                                                                      #
########################################################################
SHORTINT termn

D 2
SHORTINT key, bakspc(2), locbuf(2)
E 2
I 2
D 7
SHORTINT key, savkey, bakspc(2), locbuf(2)
E 7
I 7
SHORTINT key, savkey, locbuf(2)
E 7
E 2
integer cmdlng, row, column, mode, iptr, cdtapt
D 7
integer istart, iend, errflg
E 7
I 7
integer istart, iend, errflg, i, j, item, cmdlen
E 7
integer isalfa, isatgl, itgl, savrow, savcol

include(`mnucom')

equivalence (key, locbuf(1))

data locbuf /NUL, NUL/
D 7
data bakspc /UNDERLINE, NUL/
E 7

if (dtabfr(1) > 0) {   # make sure that we've got a choice defined
   errflg = NO
   cmdlng = dtabfr(1)
   row = dtabfr(2)
   column = dtabfr(3)
   istart = column
D 2
   cdtapt = 6
E 2
   iend = istart + dtabfr(4) - 1
   mode = dtabfr(5)
   iptr = 1
   call revers (1)
   call movcur (row, column)
I 2

   # initialize data and column pointers to one less than next character
   # position so that pointers point to last charater input or beginning
   # of data field
   cdtapt = 5
   column = column - 1
E 2
   while (dtamod == ON) {
D 10
      call getkey (key)
E 10
I 10
D 11
      ifdef(`UNIX',`call gdevin (key)',`call ttyin (key)')
E 11
I 11
      call ttyin (key)
E 11
E 10
I 7
      if (key == EM) key = key - 10
E 7
      if (key == termn) {

	 call delerr (errflg)
	    
	 # switch to data area
	 dtamod = OFF
	 }
D 7
      else if (key >= BS & key <= CR) {
E 7
I 7
      else if (key >= BS & key <= SI) {
E 7

         call delerr (errflg)
	    
	 key = key - BEL

	 # BS = backspace and erase character or if at beginning of
	 #      field backup (horizontally) one field
	 # HT = move one field right
	 # LF = move one field down, left side
	 # VT = move one field up
	 # FF = move one character right
	 # CR = move to next field down, left side
D 7
	 go to (10, 20, 30, 40, 25, 30), key   # BS, HT, LF, VT, FF, CR
E 7
I 7
	 # EM <ctrl Y> = delete current field
E 7

I 7
	      # BS, HT, LF, VT, FF, CR, SO, EM
D 10
	 go to (10, 20, 30, 40, 25, 30, 50, 60), key
E 10
I 10
	 go to (10, 20, 35, 40, 25, 30, 50, 60), key
E 10

E 7
	 # Here for BS
 10      continue
D 2
	    column = column - 1
	    cdtapt = cdtapt - 1
	    if (column < istart) {
E 2
I 2
	    if (column < istart | (column == istart & column == iend)) {
E 2
	       savrow = row
	       repeat {
	          call bakpos (iptr, row, column, mode)
	          } until (row == savrow | iptr == 1)
	       if (iptr == 1 & row != savrow) {
	          row = savrow   # we have a single column, return to
		  go to 20       #   where we were
		  }
D 2
	       istart = column
               cdtapt = iptr + 5
	       iend = istart + dtabfr(iptr+3) - 1
E 2
I 2
D 7
	       if (.true.) go to 49
E 7
I 7
	       if (.true.) go to 70
E 7
E 2
	       }
	    else {
D 7
	       if (mnumod == EXITxGRAPHICSxMODE) {
E 7
I 7
	       if (mnumod == ENTERxGRAPHICSxMODE) {
E 7

D 7
		  # back space to the last character
	          call qtext (row, column, bakspc)
		  }
	       else {

E 7
		  # when doing graphic menu, we must erase the last character
		  call erase
		  key = dtabfr(cdtapt)
		  call qtext (row, column, locbuf)
		  call appear
		  }
I 7

E 7
D 2

               dtabfr(cdtapt) = UNDERLINE
E 2
I 2
               key = UNDERLINE
               dtabfr(cdtapt) = key
	       call qtext (row, column, locbuf)
	       cdtapt = cdtapt - 1
	       column = column - 1
E 2
	       }
D 7
	    go to 50
E 7
I 7
	    go to 80
E 7

	    # here for VT into last field
D 7
 40         continue
E 7
I 7
  40     continue
E 7
	       call bakpos (iptr, row, column, mode)
D 2
	       istart = column
	       cdtapt = iptr + 5
	       iend = istart + dtabfr(iptr+3) - 1
	       go to 50
E 2
I 2
D 7
	       go to 49
E 7
I 7
	       go to 70
E 7
E 2

  20     continue
	    # HT = move right one field
	    savrow = row
	    repeat {
	       call nxtpos (iptr, row, column, mode)
	       } until (row == savrow)
D 2
	    istart = column
            cdtapt = iptr + 5
	    iend = istart + dtabfr(iptr+3) - 1
	    go to 50
E 2
I 2
D 7
	    go to 49
E 7
I 7
	    go to 70
E 7
E 2
  25     continue
	    # FF = move right one column
	    column = column + 1
	    cdtapt = cdtapt + 1
D 7
	    go to 50
E 7
I 7
	    go to 80
E 7

  30     continue
D 10
	    # here for LF or CR, move to next field
E 10
I 10
	    # here for CR, move to next field
E 10
	    savrow = row
	    savcol = column
	    iptr = 1
	    repeat {
	       call nxtpos (iptr, row, column, mode)
	       } until ((row >= savrow + 1) | (iptr == 1))
I 7
            go to 70
E 7
I 2

I 10
  35     continue
	    # here for LF, move down to next field
	    call nxtpos (iptr, row, column, mode)
	    go to 70

E 10
D 7
  49     continue
E 7
I 7
  50     continue
D 8
# # here for SO, insert a field
# if (crntid == GRAPHxDATAxFRAME | crntid == PIExEDIT) {
#    
#    item = 1
#    i = 1
#    while (dtabfr(i) != NUL) {  # Determine item to insert at
#       cmdlen = dtabfr(i)
#       savrow = dtabfr(i+1)
#       savcol = dtabfr(i+2)
#       if (savrow == row & savcol == istart) break
#       item = item + 1
#       i = i + cmdlen
#       }
  #       
#  call insert (item, crntid)
#  }
E 8
I 8
     # here for SO, insert a field
     if (crntid == GRAPHxDATAxFRAME | crntid == PIExEDIT) {
   
       item = 1
       i = 1
       while (dtabfr(i) != NUL) {  # Determine item to insert at
          cmdlen = dtabfr(i)
          savrow = dtabfr(i+1)
          savcol = dtabfr(i+2)
          if (savrow == row & savcol == istart) break
          item = item + 1
          i = i + cmdlen
          }
      if (crntid == PIExEDIT) {
	 if (item < 3) go to 80
         while (item > 10) {
	    item = item - 8
	    }
         } 
     call insdta (item, crntid)
D 9
     }
E 9
I 9
     cdtapt = iptr + 4
E 9
     column = istart - 1
I 9
     }
E 9
E 8

D 8
         go to 80
E 8
I 8
     go to 80
E 8

  60     continue
	    # here for <ctrl Y>, delete field
	       
	    cdtapt = iptr + 4
	    j = cdtapt + 1
            for (i=istart; i<=iend; i=i+1) {

	       if (mnumod == ENTERxGRAPHICSxMODE) {
	          # when doing graphic menu, we must erase the last character
	          call erase
	          key = dtabfr(j)
	          call qtext (row, i, locbuf)
                  call appear
		  }
	      key = UNDERLINE
	      dtabfr(j) = key
	      j = j + 1
	      call qtext (row, i, locbuf)
	      }
            column = istart - 1

	 go to 80

  70     continue
E 7
E 2
	    istart = column
D 2
	    cdtapt = iptr + 5
E 2
I 2
	    cdtapt = iptr + 4    # one less than the actual start
	    column = column - 1
E 2
	    iend = istart + dtabfr(iptr+3) - 1
I 2

E 2
D 7
  50     continue
E 7
I 7
  80     continue
E 7
	 }
D 2
      else if (mode == 1) {
E 2
I 2
      else {

	 #      alpha,integer,decimal,   ,toggle
D 7
	 go to (100,  200,    300,    700,500), mode
E 7
I 7
	 go to (100,  200,    300,        700,   500), mode
E 7

   100 continue
E 2
	 
	 # alpha area
D 2
         if (isalfa (key) != 0) {
E 2

D 2
	    call delerr (errflg)
E 2
I 2
         if (isalfa (key) != 0) go to 600
	 go to 700   #error
E 2

D 2
	    call qtext (row, column, locbuf)
	    column = column + 1
	    dtabfr(cdtapt) = key
	    cdtapt = cdtapt + 1
	    }
	 else {
	    call errout (errflg)
	    }
	 }
      else if (mode == 5) {
E 2
I 2
   200 continue
   300 continue
E 2

I 2
	 # integer or decimal field

D 5
	 if ((key >= DIG0 & key <= DIG9) | (key == PERIOD & mode == 3) |
D 4
	     (key == BLANK) | (key == MINUS) ) go to 600
E 4
I 4
	     (key == BLANK) | (key == MINUS & mode == 3) ) go to 600
E 5
I 5
         if ((key >= DIG0 & key <= DIG9) | 
	    (key == PERIOD & mode == 3) |
            (key == BLANK) | 
	    ((key == MINUS | key == PLUS) & mode == 3) ) go to 600
E 5
E 4
         go to 700   #error
   500 continue

E 2
	 # toggle field
I 2

E 2
         itgl = iptr + dtabfr(iptr+3) + 6
D 2
	 if (isatgl (key, dtabfr(itgl)) != 0) {
E 2
I 2
	 if (isatgl (key, dtabfr(itgl)) != 0) go to 600
         go to 700
E 2

D 2
	    call delerr (errflg)
E 2
I 2
   600 continue
E 2

D 2
	    call qtext (row, column, locbuf)
E 2
I 2
         call delerr (errflg)

	 if (column < iend) {
E 2
	    column = column + 1
D 2
	    dtabfr (cdtapt) = key
E 2
	    cdtapt = cdtapt + 1
	    }
D 2
	 else {
	    call errout (errflg)
	    }
	 }
      else {
E 2

D 2
	 if ((key >= DIG0 & key <= DIG9) | (key == PERIOD & mode == 3) |
	     (key == BLANK) | (key == MINUS) ){
E 2
I 2
	 if (mnumod == ENTERxGRAPHICSxMODE) {
E 2

D 2
            call delerr (errflg)
	       
	    # integer or decimal area
	    call qtext (row, column, locbuf)
	    column = column + 1
	    dtabfr(cdtapt) = key
	    cdtapt = cdtapt + 1
E 2
I 2
            # when doing graphic menu, we must erase the character currently
	    # in the cell
	    savkey = key
            key = dtabfr(cdtapt)
            call erase
            call qtext (row, column, locbuf)
            call appear
	    key = savkey
            }

	 dtabfr (cdtapt) = key
	 call qtext (row, column, locbuf)
         go to 999

   700 continue
	 if (errflg != YES) {
D 10
            call gdevot (BEL)
E 10
I 10
            ifdef(`UNIX',`call gdevot (BEL)',`call ttyout (BEL)')
E 10
D 6
            call apmesg (INVALIDxKEY, 1)
            call revers (1)
	    errflg = YES
E 6
I 6
            if (crntid > 200) {
	       call apmesg (INVALIDxKEY, 1)
	       call revers (1)
	       errflg = YES
	       }
E 6
E 2
	    }
D 2
	 else {
	    call errout (errflg)
	    }
E 2
I 2

   999 continue
E 2
	 }
      if (column > iend) {
	 column = iend
	 cdtapt = cdtapt - 1
         }
D 2
      call movcur (row, column)
E 2
I 2
      call movcur (row, column+1)
E 2
      }
   }
else
   dtamod = OFF
call revers (0)

return
end
D 2
subroutine errout (errflg)
integer errflg
   call gdevot (BEL)
   call apmesg (INVALIDxKEY, 1)
   call revers (1)
   errflg = YES
   return
end
E 2
subroutine delerr (errflg)
integer errflg
   if (errflg == YES) {
D 2
      errflg = NO
E 2
D 3
      call dlmesg (INVALIDxKEY)
E 3
I 3
      call apmesg (TOGGLExTOxCHOICE, 0)
E 3
      call revers (1)
I 2
      errflg = NO
E 2
      }
   return
end
E 1
