Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/3/3989

Internet Message Format | 1991-09-08 | 15KB

Path: wupost!uunet!europa.asd.contel.com!darwin.sura.net!noc.sura.net!haven.umd.edu!mimsy!nrlvx1.nrl.navy.mil!koffley
From: [e-mail]
Newsgroups: alt.sources
Subject: VMS UAF PROFILE part 15 of 18
Message-ID: <[e-mail]>
Date: 5 Sep 91 11:47:36 GMT
Organization: NRL SPACE SYSTEMS DIVISION
Lines: 514

-+-+-+-+-+-+-+-+ START OF PART 15 -+-+-+-+-+-+-+-+
X`091              display_ID, status, twelve, sixty, two
X
X`09integer*2      channel
X
X`09external       AST
X
X
X
X`09data           zero     / 0 /, twelve / 12 /,  sixty / 60 /
X`09data           num_rows  / 24 / , num_cols / 79 /, two / 2 /
X
X
X
X
X`09call SMG$CREATE_VIRTUAL_KEYBOARD (kybd_ID ,,,)
X`09call SMG$CREATE_VIRTUAL_DISPLAY (7, num_cols-2, display_ID)
X`09call SMG$LABEL_BORDER (display_id, ' Userlog Record Contents ')
X`09call DISPLAY_LABELS
X
X`09call SMG$CREATE_VIRTUAL_DISPLAY (twelve, 40, mm_ID, smg$m_border)
X`09call SMG$LABEL_BORDER (mm_id,  ' Port Logins Main Menu ')
X`09call DISPLAY_MAIN_MENU_LABELS
X
X
X`09return
X`09end
X
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
X
X
X`09subroutine BLANK_FIELD (field_num)
X
X
X`09common / SMG_data /  paste_ID, kybd_ID, num_rows, num_cols, display_ID,
X`091                    mm_id
X
X`09include        '($smgdef)'
X`09include        '($iodef)'
X
X
X`09integer*4      paste_ID, kybd_ID, zero, num_rows, num_cols,
X`091              display_ID, field_num
X
X
X`09if (field_num .eq. 1) then
X`09   call SMG$ERASE_CHARS (display_ID, 23, 2, 16)
X`09elseif (field_num .eq. 2) then
X`09   call SMG$ERASE_CHARS (display_ID, 23, 3, 16)
X`09elseif (field_num .eq. 3) then
X`09   call SMG$ERASE_CHARS (display_ID, 23, 4, 16)
X`09elseif (field_num .eq. 4) then
X`09   call SMG$ERASE_CHARS (display_ID, 23, 5, 16)
X`09elseif (field_num .eq. 5) then
X`09   call SMG$ERASE_CHARS (display_ID, 23, 6, 16)
X`09elseif (field_num .eq. 6) then
X`09   call SMG$ERASE_CHARS (display_ID, 23, 2, 53)
X`09elseif (field_num .eq. 7) then
X`09   call SMG$ERASE_CHARS (display_ID, 23, 3, 53)
X`09elseif (field_num .eq. 8) then
X`09   call SMG$ERASE_CHARS (display_ID, 23, 4, 53)
X`09elseif (field_num .eq. 9) then
X`09   call SMG$ERASE_CHARS (display_ID, 23, 5, 53)
X`09   call SMG$DRAW_RECTANGLE (display_ID, 1,1, 9,80)
X`09endif
X
X`09return
X`09end
X
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
X
X`09subroutine DISPLAY_LABELS`20
X
X
X`09common / SMG_data /  paste_ID, kybd_ID, num_rows, num_cols, display_ID,
X`091                    mm_id
X
X
X`09include        '($smgdef)'
X`09include        '($iodef)'
X
X
X
X`09character*15   labels (9)
X
X`09data           labels`20
X`091              / 'USERNAME :', 'SERVER :', 'TIME_STAMP :',`20
X`092                'LOGIN_MODE :',
X`093                'MASTER_PID :', 'PID : ', 'LOGIN_TIME :',
X`094                'UIC :', 'TERMINAL : '/
X
X`09integer*4      paste_ID, kybd_ID, zero, num_rows, num_cols,
X`091              display_ID
X
X
X
X`09do i = 1,5
X`09   if (i .eq. 1) then
X`09      call SMG$INSERT_CHARS (display_ID, labels(1), 2, 3,
X`091                            SMG$M_BOLD, 0)
X`09      call SMG$INSERT_CHARS (display_ID, labels(2), 2, 40,
X`091                            SMG$M_BOLD, 0)
X`09   elseif (i .eq. 2) then
X`09      call SMG$INSERT_CHARS (display_ID, labels(3), 3, 3,
X`091                            SMG$M_BOLD, 0)
X`09      call SMG$INSERT_CHARS (display_ID, labels(4), 3, 40,
X`091                            SMG$M_BOLD, 0)
X`09   elseif (i .eq. 3) then
X`09      call SMG$INSERT_CHARS (display_ID, labels(5), 4, 3,
X`091                            SMG$M_BOLD, 0)
X`09      call SMG$INSERT_CHARS (display_ID, labels(6), 4, 40,
X`091                            SMG$M_BOLD, 0)
X`09   elseif (i .eq. 4) then
X`09      call SMG$INSERT_CHARS (display_ID, labels(7), 5, 3,
X`091                            SMG$M_BOLD, 0)
X`09      call SMG$INSERT_CHARS (display_ID, labels(8), 5, 40,
X`091                            SMG$M_BOLD, 0)
X`09   elseif (i .eq. 5) then
X`09      call SMG$INSERT_CHARS (display_ID, labels(9), 6, 3,
X`091                            SMG$M_BOLD, 0)
X`09   endif
X`09enddo
X
X
X
X
X`09return
X`09end
X
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
X`09subroutine DISPLAY_FIELDS (username, server, time_stamp, mode,
X`091                          master_pid, pid, login_time, uic,
X`092                          terminal)
X
X
X`09common / SMG_data /  paste_ID, kybd_ID, num_rows, num_cols, display_ID,
X`091                    mm_id
X
X
X`09include        '($smgdef)'
X`09include        '($trmdef)'
X`09include        '($iodef)'
X`09include        'dua2:`5Bkoffley.com`5Duserlog_struc.inc'
X
X
X
X
X`09integer*4      paste_ID, kybd_ID, zero, num_rows, num_cols,
X`091              display_ID, L1, len_trim, mod, num_char_read
X
X`09character*2    string, term_string
X
X`09integer*2      terminator
X
X
X
X
X`09do i = 1,5
X`09   if (i .eq. 1) then
X`09      L1 = len_trim (username)
X`09      call SMG$put_CHARS (display_ID, username(1:L1), 2, 16, , , , )
X`09      L1 = len_trim (server)
X`09      call get_hash_num (%ref(kilo), %ref(L1), %loc(server))
X`09      call SMG$put_CHARS (display_ID, server(1:L1), 2, 53, , , ,)
X`09   elseif (i .eq. 2) then
X`09      L1 = len_trim (time_stamp)
X`09      call SMG$put_CHARS (display_ID, time_stamp(1:L1), 3, 16, , , ,)
X`09      L1 = len_trim (mode)
X`09      call SMG$put_CHARS (display_ID, mode(1:L1), 3, 53, , , , )
X`09   elseif (i .eq. 3) then
X`09      L1 = len_trim (master_pid)
X`09      call SMG$put_CHARS (display_ID, master_pid(1:L1), 4, 16, , , , )
X`09      L1 = len_trim (pid)
X`09      call SMG$put_CHARS (display_ID, pid(1:L1), 4, 53, , , , )
X`09   elseif (i .eq. 4) then
X`09      L1 = len_trim (login_time)
X`09      call SMG$put_CHARS (display_ID, login_time(1:L1), 5, 16, , , , )
X`09      L1 = len_trim (uic)
X`09      call SMG$put_CHARS (display_ID, uic(1:L1), 5, 53, , , , )
X`09   elseif (i .eq. 5) then
X`09      L1 = len_trim (terminal)
X`09      if (terminal(1:1).eq. ' ') write (6,'(a1)') char(7)
X`09      call SMG$put_CHARS (display_ID, terminal(1:L1), 6, 15, , , , )
X`09   endif
X`09enddo
X
X
X`09mod = TRM$M_TM_CVTLOW .or. TRM$M_TM_PURGE
X`09call SMG$SET_CURSOR_ABS (display_ID, 2, 11)
X`09terminator = 0
X
X`09call repeat (string, ' ')
X`09call SMG$READ_STRING (kybd_ID, string, , 1, mod , , , num_char_read ,`20
X`091                     terminator, display_ID, , , , term_string)
X
X`09do i = 1,9
X`09   call blank_field (i)
X`09enddo
X`09call SMG$DRAW_RECTANGLE (display_ID, 1,1, 9,80)
X
X`09return
X`09end
X
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
X
X`09subroutine GET_FIELD (field_num, val)
X
X
X
X`09common / SMG_data /  paste_ID, kybd_ID, num_rows, num_cols, display_ID,
X`091                    mm_id
X
X`09include        '($smgdef)'
X`09include        '($iodef)'
X
X
X`09integer*4      paste_ID, kybd_ID, zero, num_rows, num_cols, term,
X`091              display_ID, field_num, mod, status
X`09real*4         val
X`09character*15   char_val
X`09character*80   string, error_msg
X
X
X
X`09mod = io$m_nofiltr
X
X1`09call BLANK_FIELD (field_num)
X
X`09
X`09if (field_num .eq. 1) then
X`09   call SMG$SET_CURSOR_ABS (display_ID, 7, 15)
X`09elseif (field_num .eq. 2) then
X`09   call SMG$SET_CURSOR_ABS (display_ID, 8, 15)
X`09elseif (field_num .eq. 3) then
X`09   call SMG$SET_CURSOR_ABS (display_ID, 9, 15)
X`09elseif (field_num .eq. 4) then
X`09   call SMG$SET_CURSOR_ABS (display_ID, 10, 15)
X`09elseif (field_num .eq. 5) then
X`09   call SMG$SET_CURSOR_ABS (display_ID, 11, 15)
X`09elseif (field_num .eq. 6) then
X`09   call SMG$SET_CURSOR_ABS (display_ID, 7, 45)
X`09elseif (field_num .eq. 7) then
X`09   call SMG$SET_CURSOR_ABS (display_ID, 8, 45)
X`09elseif (field_num .eq. 8) then
X`09   call SMG$SET_CURSOR_ABS (display_ID, 9, 45)
X`09elseif (field_num .eq. 9) then
X`09   call SMG$SET_CURSOR_ABS (display_ID, 10, 45)
X`09endif
X
X
X999`09return
X`09end
X
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
X
X`09subroutine READ_FIELDS
X
X`09real*4          val
X
X`09integer*4       i
X
X
X
X
X`09do i = 1, 11
X`09   call GET_FIELD (i, val)
X`09enddo
X
X
X`09return
X`09end
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
X
X
X`09subroutine FORMAT_MSG (string)
X
X
X`09integer*4               max_buffer_size, status
X`09character*(*)           string
X
X`09data                    max_buffer_size  / 80 /
X
X`09call CENTER_STRING (string, max_buffer_size, status)
X
X
X
X
X`09return
X`09end
X
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
X
X`09subroutine GET_ERROR_MSG (error_msg, status)
X
X
X
X`09parameter              (max_errors = 4)
X`09character*80           error_msg, error_msgs (max_errors)
X`09integer*4              status
X
X`09data                   error_msgs`20
X`091  /'Entry contains all blank characters  --- try again.',
X`092   'Entry is too long and contains no decimal point -- try again.',
X`093   'Error decoding entered value -- try again.' ,
X`094   'Integer value required for this entry  --- try again.' /
X
X
X
X
X`09status = abs (status)
X
X`09if (status .gt. max_errors) then
X`09   error_msg = 'Unknown error status encountered.'
X`09else`20
X`09   error_msg = error_msgs (status)
X`09endif
X`20
X
X
X`09return
X`09end
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
X`09subroutine AST`20
X
X
X
X
X
X`09include     'uaf.cmn'
X`09include     '($LIBCLIDEF)'
X`09include     '($SMGDEF)'
X
X
X
X`09call LIB$ENABLE_CTRL (LIB$M_CLI_CTRLY)
X`09call SMG$DELETE_PASTEBOARD (pasteboard)
X`09write (6,1) char(27) // '`5BH' // char(27) // '`5BJ'
X1`09format ('+',a6,$)
X`09call exit
X
X`09end
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
X
X
X`09subroutine DISPLAY_MAIN_MENU_LABELS`20
X
X
X`09common / SMG_data /  paste_ID, kybd_ID, num_rows, num_cols, display_ID,
X`091                    mm_id
X
X
X`09include        '($smgdef)'
X`09include        '($iodef)'
X
X
X
X`09character*25   labels (09)
X
X`09data           labels`20
X`091              / '1','DISPLAY ALL USER DATA','2','DISPLAY PORTS ONLY',
X`092                '3','PORT SUMMARY','X', 'RETURN', 'OPTION : ' /
X
X`09integer*4      mm_ID, mm_kybd_ID, scroll_ID, entry_ID
X
X
X
X`09do i = 1, 4
X`09   if (i .eq. 1) then
X`09      call SMG$INSERT_CHARS (mm_ID, labels(1), 3, 3,
X`091                            SMG$M_BOLD, 0)
X`09      call SMG$INSERT_CHARS (mm_ID, labels(2), 3, 10,
X`091                            SMG$M_BOLD, 0)
X`09   elseif (i .eq. 2) then
X`09      call SMG$INSERT_CHARS (mm_ID, labels(3), 4, 3,
X`091                            SMG$M_BOLD, 0)
X`09      call SMG$INSERT_CHARS (mm_ID, labels(4), 4, 10,
X`091                            SMG$M_BOLD, 0)
X`09   elseif (i .eq. 3) then
X`09      call SMG$INSERT_CHARS (mm_ID, labels(5), 5, 3,
X`091                            SMG$M_BOLD, 0)
X`09      call SMG$INSERT_CHARS (mm_ID, labels(6), 5, 10,
X`091                            SMG$M_BOLD, 0)
X`09   elseif (i .eq. 4) then
X`09      call SMG$INSERT_CHARS (mm_ID, labels(7), 6, 3,
X`091                            SMG$M_BOLD, 0)
X`09      call SMG$INSERT_CHARS (mm_ID, labels(8), 6, 10,
X`091                            SMG$M_BOLD, 0)
X`09   elseif (i .eq. 5) then
Xc`09      call SMG$INSERT_CHARS (mm_ID, labels(5), 7, 3,
Xc`091                            SMG$M_BOLD, 0)
Xc`09      call SMG$INSERT_CHARS (mm_ID, labels(10), 7, 10,
Xc`091                            SMG$M_BOLD, 0)
X`09   endif
X`09enddo
X
X`09call SMG$INSERT_CHARS (mm_ID, labels(9), 9, 3,
X`091                      SMG$M_BOLD, 0)
X
X
X`09return
X`09end
X
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
X
X`09subroutine READ_MAIN_MENU_OPTION (option)
X
X
X`09common / SMG_data /  paste_ID, kybd_ID, num_rows, num_cols, display_ID,
X`091                    mm_id
X
X`09include        '($SYSSRVNAM)'
X`09include        '($SMGDEF)'
X`09include        '($IODEF)'
X`09include        '($TRMDEF)'
X
X
X`09real*4          val
X
X`09integer*4       i, status, mm_kybd_ID, mm_id, mod, term,
X`091               option, left_justify, length, len_trim, scroll_ID,`20
X`092               entry_ID, SMG$READ_STRING
X
X`09character*4     string
X`09integer*2       terminator
X`09character*1     term_string
X
X`09external        len_trim, left_justify, SMG$READ_STRING
X
X
X`09mod = TRM$M_TM_CVTLOW .or. TRM$M_TM_PURGE
X
X1`09call SMG$ERASE_LINE (mm_ID, 9, 10)
X`09call SMG$SET_CURSOR_ABS (mm_ID, 9, 11)
X`09call repeat (string, ' ')
X`09status =  SMG$READ_STRING (kybd_ID, string, , 1, mod , , , num_char_read
V ,`20
X`091                     terminator, mm_ID, , , , term_string)
+-+-+-+-+-+-+-+-  END  OF PART 15 +-+-+-+-+-+-+-+-
--
\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
< Joe Koffley                        [e-mail]             >
< Naval Research Laboratory          [e-mail]                >
< Space Systems Division             AT&T  :  202-767-0894                   >
\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/