home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3982 < prev    next >
Encoding:
Internet Message Format  |  1991-09-09  |  14.9 KB
  1. Path: wupost!uunet!europa.asd.contel.com!darwin.sura.net!noc.sura.net!haven.umd.edu!mimsy!nrlvx1.nrl.navy.mil!koffley
  2. From: koffley@nrlvx1.nrl.navy.mil
  3. Newsgroups: alt.sources
  4. Subject: VMS UAF PROFILE part 8 of 18
  5. Message-ID: <1991Sep5.074429.552@nrlvx1.nrl.navy.mil>
  6. Date: 5 Sep 91 11:44:29 GMT
  7. Organization: NRL SPACE SYSTEMS DIVISION
  8. Lines: 390
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 8 -+-+-+-+-+-+-+-+
  11. X        call smg$paste_virtual_display ( access_board, pasteboard, 1,1 )
  12. X        call smg$paste_virtual_display ( message, pasteboard, 22, 1 )
  13. X        call smg$end_pasteboard_update ( pasteboard )
  14. X        call smg$set_cursor_abs ( access_board, line, col )
  15. XC
  16. XC Read a keystroke and loop until an exit is called
  17. XC
  18. X        do while (bogus_key)
  19. X           call smg$read_keystroke ( keyboard, term )
  20. XC
  21. XC Right arrow, or letter 'l' - right to next field
  22. XC
  23. X           if (term.eq.smg$k_trm_right.or.
  24. X     .      term.eq.smg$k_trm_uppercase_l.or.
  25. X     .      term.eq.smg$k_trm_lowercase_l) then
  26. X              if (line.eq.9.and.col.eq.70) then
  27. X                 line = 5
  28. X                 col = 11
  29. X              elseif (col.eq.34) then
  30. X                 col = 47
  31. X              elseif (line.ne.9.and.col.eq.70) then
  32. X                 line = line + 1
  33. X                 col = 11
  34. X              else
  35. X                 col = col + 1
  36. X              endif
  37. X              call smg$set_cursor_abs ( access_board, line, col )
  38. XC
  39. XC Left arrow, or letter 'h' - left to previous field
  40. XC
  41. X           elseif (term.eq.smg$k_trm_left.or.
  42. X     .      term.eq.smg$k_trm_uppercase_h.or.
  43. X     .      term.eq.smg$k_trm_lowercase_h) then
  44. X              if (line.eq.5.and.col.eq.11) then
  45. X                 line = 9
  46. X                 col = 70
  47. X              elseif (line.ne.5.and.col.eq.11) then
  48. X                 line = line - 1
  49. X                 col = 70
  50. X              elseif (col.eq.47) then
  51. X                 col = 34
  52. X              else
  53. X                 col = col - 1
  54. X              endif
  55. X              call smg$set_cursor_abs ( access_board, line, col )
  56. XC
  57. XC Up arrow, or letter 'k' - up to previous field
  58. XC
  59. X           elseif (term.eq.smg$k_trm_up.or.
  60. X     .      term.eq.smg$k_trm_uppercase_k.or.
  61. X     .      term.eq.smg$k_trm_lowercase_k) then
  62. X              if (line.eq.5) then
  63. X                 line = 9
  64. X              else
  65. X                 line = line - 1
  66. X              endif
  67. X              call smg$set_cursor_abs ( access_board, line, col )
  68. XC
  69. XC Down arrow, or Carriage Return, or letter 'j' - down to next field
  70. XC
  71. X           elseif (term.eq.smg$k_trm_down.or.
  72. X     .      term.eq.smg$k_trm_cr.or.
  73. X     .      term.eq.smg$k_trm_uppercase_j.or.
  74. X     .      term.eq.smg$k_trm_lowercase_j) then
  75. X              if (line.eq.9) then
  76. X                 line = 5
  77. X              else
  78. X                 line = line + 1
  79. X              endif
  80. X              call smg$set_cursor_abs ( access_board, line, col )
  81. XC
  82. XC Plus (+) key, or Insert Here key, to allow full access to field
  83. XC
  84. X           elseif (term.eq.smg$k_trm_plus_sign.or.
  85. X     .      term.eq.smg$k_trm_insert_here) then
  86. X              change = .true.
  87. X              if (line.eq.5.and.col.lt.35) then
  88. X                 call clr_bits ( network_p )
  89. X                 access_flag = 'Network:'
  90. X                 call find_access ( access_flag, line,
  91. X     .              network_p, network_s )
  92. X              elseif (line.eq.5.and.col.gt.35) then
  93. X                 call clr_bits ( network_s )
  94. X                 access_flag = 'Network:'
  95. X                 call find_access ( access_flag, line,
  96. X     .              network_p, network_s )
  97. X              endif
  98. X              if (line.eq.6.and.col.lt.35) then
  99. X                 call clr_bits ( batch_p )
  100. X                 access_flag = 'Batch:'
  101. X                 call find_access ( access_flag, line,
  102. X     .              batch_p, batch_s )
  103. X              elseif (line.eq.6.and.col.gt.35) then
  104. X                 call clr_bits ( batch_s )
  105. X                 access_flag = 'Batch:'
  106. X                 call find_access ( access_flag, line,
  107. X     .              batch_p, batch_s )
  108. X              endif
  109. X              if (line.eq.7.and.col.lt.35) then
  110. X                 call clr_bits ( local_p )
  111. X                 access_flag = 'Local:'
  112. X                 call find_access ( access_flag, line,
  113. X     .              local_p, local_s )
  114. X              elseif (line.eq.7.and.col.gt.35) then
  115. X                 call clr_bits ( local_s )
  116. X                 access_flag = 'Local:'
  117. X                 call find_access ( access_flag, line,
  118. X     .              local_p, local_s )
  119. X              endif
  120. X              if (line.eq.8.and.col.lt.35) then
  121. X                 call clr_bits ( dialup_p )
  122. X                 access_flag = 'Dialup:'
  123. X                 call find_access ( access_flag, line,
  124. X     .              dialup_p, dialup_s )
  125. X              elseif (line.eq.8.and.col.gt.35) then
  126. X                 call clr_bits ( dialup_s )
  127. X                 access_flag = 'Dialup:'
  128. X                 call find_access ( access_flag, line,
  129. X     .              dialup_p, dialup_s )
  130. X              endif
  131. X              if (line.eq.9.and.col.lt.35) then
  132. X                 call clr_bits ( remote_p )
  133. X                 access_flag = 'Remote:'
  134. X                 call find_access ( access_flag, line,
  135. X     .              remote_p, remote_s )
  136. X              elseif (line.eq.9.and.col.gt.35) then
  137. X                 call clr_bits ( remote_s )
  138. X                 access_flag = 'Remote:'
  139. X                 call find_access ( access_flag, line,
  140. X     .              remote_p, remote_s )
  141. X              endif
  142. X              call smg$set_cursor_abs ( access_board, line, col )
  143. XC
  144. XC Minus (-) key, or Remove key, to disallow access to field
  145. XC
  146. X           elseif (term.eq.smg$k_trm_dash.or.
  147. X     .      term.eq.smg$k_trm_remove) then
  148. X              change = .true.
  149. X              if (line.eq.5.and.col.lt.35) then
  150. X                 call set_bits ( network_p )
  151. X                 access_flag = 'Network:'
  152. X                 call find_access ( access_flag, line,
  153. X     .              network_p, network_s )
  154. X              elseif (line.eq.5.and.col.gt.35) then
  155. X                 call set_bits ( network_s )
  156. X                 access_flag = 'Network:'
  157. X                 call find_access ( access_flag, line,
  158. X     .              network_p, network_s )
  159. X              endif
  160. X              if (line.eq.6.and.col.lt.35) then
  161. X                 call set_bits ( batch_p )
  162. X                 access_flag = 'Batch:'
  163. X                 call find_access ( access_flag, line,
  164. X     .              batch_p, batch_s )
  165. X              elseif (line.eq.6.and.col.gt.35) then
  166. X                 call set_bits ( batch_s )
  167. X                 access_flag = 'Batch:'
  168. X                 call find_access ( access_flag, line,
  169. X     .              batch_p, batch_s )
  170. X              endif
  171. X              if (line.eq.7.and.col.lt.35) then
  172. X                 call set_bits ( local_p )
  173. X                 access_flag = 'Local:'
  174. X                 call find_access ( access_flag, line,
  175. X     .              local_p, local_s )
  176. X              elseif (line.eq.7.and.col.gt.35) then
  177. X                 call set_bits ( local_s )
  178. X                 access_flag = 'Local:'
  179. X                 call find_access ( access_flag, line,
  180. X     .              local_p, local_s )
  181. X              endif
  182. X              if (line.eq.8.and.col.lt.35) then
  183. X                 call set_bits ( dialup_p )
  184. X                 access_flag = 'Dialup:'
  185. X                 call find_access ( access_flag, line,
  186. X     .              dialup_p, dialup_s )
  187. X              elseif (line.eq.8.and.col.gt.35) then
  188. X                 call set_bits ( dialup_s )
  189. X                 access_flag = 'Dialup:'
  190. X                 call find_access ( access_flag, line,
  191. X     .              dialup_p, dialup_s )
  192. X              endif
  193. X              if (line.eq.9.and.col.lt.35) then
  194. X                 call set_bits ( remote_p )
  195. X                 access_flag = 'Remote:'
  196. X                 call find_access ( access_flag, line,
  197. X     .              remote_p, remote_s )
  198. X              elseif (line.eq.9.and.col.gt.35) then
  199. X                 call set_bits ( remote_s )
  200. X                 access_flag = 'Remote:'
  201. X                 call find_access ( access_flag, line,
  202. X     .              remote_p, remote_s )
  203. X              endif
  204. X              call smg$set_cursor_abs ( access_board, line, col )
  205. XC
  206. XC Select key, or keypad period (.) key, to toggle edit mode
  207. XC
  208. X           elseif (term.eq.smg$k_trm_select.or.
  209. X     .      term.eq.smg$k_trm_period) then
  210. X              change = .true.
  211. X              call read_hours ( line, col, access_flag )
  212. X              call smg$set_cursor_abs ( access_board, line, col )
  213. XC
  214. XC PF1 - access flags display
  215. XC
  216. X           elseif (term.eq.smg$k_trm_pf1) then
  217. X              call smg$unpaste_virtual_display ( access_board,
  218. X     .         pasteboard )
  219. X              call show_flags ( owner, tables, defcli, defdev,
  220. X     .         defdir, lgicmd )
  221. X              bogus_key = .false.
  222. XC
  223. XC PF2 - primary and secondary days display
  224. XC
  225. X           elseif (term.eq.smg$k_trm_pf2) then
  226. X              call smg$unpaste_virtual_display ( access_board,
  227. X     .         pasteboard )
  228. X              call show_days ( owner, tables, defcli, defdev,
  229. X     .         defdir, lgicmd )
  230. X              bogus_key = .false.
  231. XC
  232. XC PF4 - privilege display
  233. XC
  234. X           elseif (term.eq.smg$k_trm_pf4) then
  235. X              call smg$unpaste_virtual_display ( access_board,
  236. X     .         pasteboard )
  237. X              call show_privs ( owner, tables, defcli, defdev,
  238. X     .         defdir, lgicmd )
  239. X              bogus_key = .false.
  240. XC
  241. XC CtrlW - repaint screen
  242. XC
  243. X           elseif (term.eq.smg$k_trm_ctrlw) then
  244. X              call smg$repaint_screen ( pasteboard )
  245. XC
  246. XC CtrlZ - exit to main display
  247. XC
  248. X           elseif (term.eq.smg$k_trm_ctrlz) then
  249. X              bogus_key = .false.
  250. X           endif
  251. X        enddo
  252. XC
  253. XC Unpaste the virtual display.
  254. XC
  255. X        call smg$unpaste_virtual_display ( access_board, pasteboard )
  256. X
  257. X        end
  258. X
  259. XC************************************************************************
  260. X
  261. X        Subroutine FIND_ACCESS ( access_flag, line, check1, check2 )
  262. XC
  263. XC The purpose of this subroutine is to determine the hourly access times
  264. XC for the type of login specified. Check1 and Check2 are checked to see
  265. XC if bits are set (meaning no access) or not set (meaning access allowed).
  266. XC The appropriate character ('-' for noaccess and '#' for access) is put
  267. XC to the display.
  268. XC
  269. X        Include 'uaf.cmn'
  270. X        Include '($smgdef)'
  271. X        Integer*4 check1, check2
  272. X        Integer*4 line, col
  273. X        Character*(*) access_flag
  274. XC
  275. XC Begin the pasteboard update.
  276. XC
  277. X        call smg$begin_pasteboard_update ( pasteboard )
  278. X        call smg$put_chars ( access_board, access_flag, line, 1 )
  279. X
  280. X        col = 11
  281. XC
  282. XC '-' means no access allowed. '#' means access is allowed.
  283. XC
  284. X        do i = 0,23
  285. X           if (btest(check1,i)) then
  286. X              call smg$put_chars ( access_board, '-', line, col )
  287. X           else
  288. X              call smg$put_chars ( access_board, '#', line, col )
  289. X           endif
  290. X           col = col + 1
  291. X        enddo
  292. X
  293. X        col = 47
  294. X
  295. X        do i = 0,23
  296. X           if (btest(check2,i)) then
  297. X              call smg$put_chars ( access_board, '-', line, col )
  298. X           else
  299. X              call smg$put_chars ( access_board, '#', line, col )
  300. X           endif
  301. X           col = col + 1
  302. X        enddo
  303. XC
  304. XC End the pasteboard update.
  305. XC
  306. X        call smg$end_pasteboard_update ( pasteboard )
  307. X
  308. X        end
  309. X
  310. XC***************************************************************
  311. X
  312. X        Subroutine READ_HOURS ( line, col, access_flag )
  313. XC
  314. XC The purpose of this subroutine is to allow the user to pick the
  315. XC hours for which access will be allowed or denied. The select key
  316. XC starts the selection and another select will mark the end of the
  317. XC select region. Whatever access restrictions that were in effect
  318. XC will be reversed.
  319. XC
  320. X        Include 'uaf.cmn'
  321. X        Include '($smgdef)'
  322. X        Integer*4 line, col, col_equiv(70)
  323. X        Integer*4 access1, access2, access_type
  324. X        Character*1 char
  325. X        Character*(*) access_flag
  326. X
  327. X        data col_equiv
  328. X     .   /0,0,0,0,0,0,0,0,0,0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,
  329. X     .    17,18,19,20,21,22,23,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,3,4,5,6,7,
  330. X     .    8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23/
  331. X        bogus_key = .true.
  332. XC
  333. XC Create instructions window and paste it to the board
  334. XC
  335. X        call smg$create_virtual_display ( 3, 65, instruct,
  336. X     .   smg$m_border )
  337. X        call smg$put_chars ( instruct, ' Move cursor to desired location
  338. X     . and press SELECT when finished', 2, 1 )
  339. X        call smg$paste_virtual_display ( instruct, pasteboard, 15, 5 )
  340. X        call smg$set_cursor_abs ( access_board, line, col )
  341. X
  342. X        if (line.eq.5) then
  343. X           access_flag = 'Network:'
  344. X           access1 = network_p
  345. X           access2 = network_s
  346. X           if (col.lt.35) access_type = network_p
  347. X           if (col.gt.35) access_type = network_s
  348. X        elseif (line.eq.6) then
  349. X           access_flag = 'Batch:'
  350. X           access1 = batch_p
  351. X           access2 = batch_s
  352. X           if (col.lt.35) access_type = batch_p
  353. X           if (col.gt.35) access_type = batch_s
  354. X        elseif (line.eq.7) then
  355. X           access_flag = 'Local:'
  356. X           access1 = local_p
  357. X           access2 = local_s
  358. X           if (col.lt.35) access_type = local_p
  359. X           if (col.gt.35) access_type = local_s
  360. X        elseif (line.eq.8) then
  361. X           access_flag = 'Dialup:'
  362. X           access1 = dialup_p
  363. X           access2 = dialup_s
  364. X           if (col.lt.35) access_type = dialup_p
  365. X           if (col.gt.35) access_type = dialup_s
  366. X        elseif (line.eq.9) then
  367. X           access_flag = 'Remote:'
  368. X           access1 = remote_p
  369. X           access2 = remote_s
  370. X           if (col.lt.35) access_type = remote_p
  371. X           if (col.gt.35) access_type = remote_s
  372. X        endif
  373. XC
  374. XC Loop until the select key is hit again to terminate selection.
  375. XC
  376. X        do while (bogus_key)
  377. X           call smg$read_from_display ( access_board, char )
  378. X           if (char.eq.'-') then
  379. X              call lib$bbcci ( col_equiv(col), access_type )
  380. X           elseif (char.eq.'#') then
  381. X              call lib$bbssi ( col_equiv(col), access_type )
  382. X           endif
  383. X           call smg$read_keystroke ( keyboard, term )
  384. X           if (term.eq.smg$k_trm_select.or.
  385. X     .      term.eq.smg$k_trm_period) bogus_key = .false.
  386. X           if (term.eq.smg$k_trm_right) then
  387. X              if (col.ne.34.and.col.ne.70) col = col + 1
  388. X           endif
  389. X           call smg$set_cursor_abs ( access_board, line, col )
  390. X        enddo
  391. X
  392. X        if (col.lt.35) access1 = access_type
  393. +-+-+-+-+-+-+-+-  END  OF PART 8 +-+-+-+-+-+-+-+-
  394. -- 
  395. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  396. < Joe Koffley                        KOFFLEY@NRLVAX.NRL.NAVY.MIL             >
  397. < Naval Research Laboratory          KOFFLEY@CCF.NRL.NAVY.MIL                >
  398. < Space Systems Division             AT&T  :  202-767-0894                   >
  399. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  400.