home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3983 < prev    next >
Internet Message Format  |  1991-09-08  |  15KB
  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 9 of 18
  5. Message-ID: <1991Sep5.074454.553@nrlvx1.nrl.navy.mil>
  6. Date: 5 Sep 91 11:44:54 GMT
  7. Organization: NRL SPACE SYSTEMS DIVISION
  8. Lines: 451
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 9 -+-+-+-+-+-+-+-+
  11. X        if (col.gt.35) access2 = access_type
  12. XC
  13. XC Get rid of the instructions window.
  14. XC
  15. X        call smg$unpaste_virtual_display ( instruct, pasteboard )
  16. XC
  17. XC Update the screen with the new access information
  18. XC
  19. X        if (line.eq.5) then
  20. X           if (col.lt.35) network_p = access1
  21. X           if (col.gt.35) network_s = access2
  22. X           call find_access ( access_flag, line, network_p,
  23. X     .      network_s )
  24. X        elseif (line.eq.6) then
  25. X           if (col.lt.35) batch_p = access1
  26. X           if (col.gt.35) batch_s = access2
  27. X           call find_access ( access_flag, line, batch_p, batch_s )
  28. X        elseif (line.eq.7) then
  29. X           if (col.lt.35) local_p = access1
  30. X           if (col.gt.35) local_s = access2
  31. X           call find_access ( access_flag, line, local_p, local_s )
  32. X        elseif (line.eq.8) then
  33. X           if (col.lt.35) dialup_p = access1
  34. X           if (col.gt.35) dialup_s = access2
  35. X           call find_access ( access_flag, line, dialup_p, dialup_s )
  36. X        elseif (line.eq.9) then
  37. X           if (col.lt.35) remote_p = access1
  38. X           if (col.gt.35) remote_s = access2
  39. X           call find_access ( access_flag, line, remote_p, remote_s )
  40. X        endif
  41. X
  42. X        end
  43. X
  44. XC************************************************************************
  45. X
  46. X        Subroutine SET_BITS ( access_type )
  47. XC
  48. XC The purpose of this subroutine is to deny complete access to a
  49. XC particular field.
  50. XC
  51. X        Include 'uaf.cmn'
  52. X        Integer*4 access_type, i
  53. X
  54. X        do i = 0,23
  55. X           call lib$bbssi ( i, access_type )
  56. X        enddo
  57. X
  58. X        end
  59. X
  60. XC************************************************************************
  61. X
  62. X        Subroutine CLR_BITS ( access_type )
  63. XC
  64. XC The purpose of this subroutine is to grant complete access to a
  65. XC particular field.
  66. XC
  67. X        Include 'uaf.cmn'
  68. X        Integer*4 access_type, i
  69. X
  70. X        do i = 0,23
  71. X           call lib$bbcci ( i, access_type )
  72. X        enddo
  73. X
  74. X        end
  75. X
  76. XC************************************************************************
  77. X
  78. X        Subroutine SHOW_DAYS ( owner, tables, defcli, defdev,
  79. X     .   defdir, lgicmd )
  80. XC
  81. XC The purpose of this subroutine is to paste the primary and secondary
  82. XC days to the screen and allow movement of the cursor to the desired
  83. XC field for enabling or disabling of the days.
  84. XC
  85. X        Include 'uaf.cmn'
  86. X        Include '($smgdef)'
  87. X        Integer*4 i, line, col
  88. X        Character*25 string
  89. X        Character*16 day_names(7)
  90. X        Character*(*) owner, tables, defcli, defdev, defdir, lgicmd
  91. X
  92. X        data day_names
  93. X     .  /'Monday          ','Tuesday         ','Wednesday       ',
  94. X     .   'Thursday        ','Friday          ','Saturday        ',
  95. X     .   'Sunday          ' /
  96. X
  97. X        bogus_key = .true.
  98. X        line = 5
  99. X        col = 10
  100. XC
  101. XC Begin creating the virtual display.
  102. XC
  103. X        call smg$begin_pasteboard_update ( pasteboard )
  104. X        call smg$erase_display ( message )
  105. X        call smg$put_chars ( days_board,
  106. X     .   ' Primary and Secondary Days: ',
  107. X     .   1, 24 ,, smg$m_bold )
  108. X        call smg$put_chars ( days_board, ' Primary Days   ', 3, 10 ,,
  109. X     .   smg$m_reverse )
  110. X        call smg$put_chars ( days_board, ' Secondary Days ', 3, 45 ,,
  111. X     .   smg$m_reverse )
  112. XC
  113. XC write the days to the board
  114. XC
  115. X        do i = 1,7
  116. X           call smg$put_chars ( days_board, day_names(i), line, col )
  117. X           col = col + 35
  118. X           call smg$put_chars ( days_board, day_names(i), line, col )
  119. X           line = line + 1
  120. X           col = 10
  121. X        enddo
  122. XC
  123. XC Call the subroutine SCAN_DAYS to determine the primary and
  124. XC secondary days.
  125. XC
  126. X        call scan_days
  127. XC
  128. XC Reset the values for line and column.
  129. XC
  130. X        line = 5
  131. X        col = 10
  132. XC
  133. XC Write the instructions into the message window.
  134. XC
  135. X        call smg$put_chars ( message,
  136. X     .   'Use arrow keys to move to desired field.', 1, 2 )
  137. X        call smg$put_chars ( message,
  138. X     .   'Hit SELECT, PERIOD, or T to change primary or secondary day.',
  139. X     .   2, 2 )
  140. X        call smg$put_chars ( message,
  141. X     .   'PF keys: go to another screen.
  142. X     .   ControlZ: exit to main display.',
  143. X     .   3, 2 )
  144. XC
  145. XC Paste the virtual displays to the screen, end the pasteboard update,
  146. XC and set the cursor to the first position.
  147. XC
  148. X        call smg$paste_virtual_display ( days_board, pasteboard, 1, 1 )
  149. X        call smg$paste_virtual_display ( message, pasteboard, 22, 1 )
  150. X        call smg$end_pasteboard_update ( pasteboard )
  151. X        call smg$set_cursor_abs ( days_board, line, col )
  152. XC
  153. XC Read a keystroke. Loop until terminator (ctrlZ) is pressed.
  154. XC
  155. X        do while (bogus_key)
  156. X           call smg$read_keystroke ( keyboard, term )
  157. XC
  158. XC Right arrow, or letter 'l' - move to next field to the right
  159. XC
  160. X           if (term.eq.smg$k_trm_right.or.
  161. X     .      term.eq.smg$k_trm_uppercase_l.or.
  162. X     .      term.eq.smg$k_trm_lowercase_l) then
  163. X              if (line.eq.11.and.col.eq.45) then
  164. X                 line = 5
  165. X                 col = 10
  166. X              elseif (col.eq.10) then
  167. X                 col = 45
  168. X              elseif (col.eq.45) then
  169. X                 line = line + 1
  170. X                 col = 10
  171. X              endif
  172. X              call smg$set_cursor_abs ( days_board, line, col )
  173. XC
  174. XC Left arrow, or letter 'h' - move to previous field to the left
  175. XC
  176. X           elseif (term.eq.smg$k_trm_left.or.
  177. X     .      term.eq.smg$k_trm_uppercase_h.or.
  178. X     .      term.eq.smg$k_trm_lowercase_h) then
  179. X              if (line.eq.5.and.col.eq.10) then
  180. X                 line = 11
  181. X                 col = 45
  182. X              elseif (col.eq.10) then
  183. X                 line = line - 1
  184. X                 col = 45
  185. X              elseif (col.eq.45) then
  186. X                 col = 10
  187. X              endif
  188. X              call smg$set_cursor_abs ( days_board, line, col )
  189. XC
  190. XC Down arrow, or carriage return, or letter 'j' - move to next field below
  191. XC
  192. X           elseif (term.eq.smg$k_trm_down.or.
  193. X     .      term.eq.smg$k_trm_cr.or.
  194. X     .      term.eq.smg$k_trm_uppercase_j.or.
  195. X     .      term.eq.smg$k_trm_lowercase_j) then
  196. X              if (line.eq.11) then
  197. X                 line = 5
  198. X              else
  199. X                 line = line + 1
  200. X              endif
  201. X              call smg$set_cursor_abs ( days_board, line, col )
  202. XC
  203. XC Up arrow, or letter 'k' - move to previous field above
  204. XC
  205. X           elseif (term.eq.smg$k_trm_up.or.
  206. X     .      term.eq.smg$k_trm_uppercase_k.or.
  207. X     .      term.eq.smg$k_trm_lowercase_k) then
  208. X              if (line.eq.5) then
  209. X                 line = 11
  210. X              else
  211. X                 line = line - 1
  212. X              endif
  213. X              call smg$set_cursor_abs ( days_board, line, col )
  214. XC
  215. XC Select or keypad period (.) key - enter edit mode
  216. XC
  217. X           elseif (term.eq.smg$k_trm_select.or.
  218. X     .      term.eq.smg$k_trm_period.or.
  219. X     .      term.eq.smg$k_trm_uppercase_t.or.
  220. X     .      term.eq.smg$k_trm_lowercase_t) then
  221. X              change = .true.
  222. X              call smg$read_from_display ( days_board, string )
  223. X              call read_days ( string(1:16) )
  224. XC
  225. XC PF1 - go to flags screen
  226. XC
  227. X           elseif (term.eq.smg$k_trm_pf1) then
  228. X              call smg$unpaste_virtual_display ( days_board,
  229. X     .         pasteboard )
  230. X              call show_flags ( owner, tables, defcli, defdev,
  231. X     .         defdir, lgicmd )
  232. X              bogus_key = .false.
  233. XC
  234. XC PF3 - go to access times screen
  235. XC
  236. X           elseif (term.eq.smg$k_trm_pf3) then
  237. X              call smg$unpaste_virtual_display ( days_board,
  238. X     .         pasteboard )
  239. X              call show_access ( owner, tables, defcli, defdev,
  240. X     .         defdir, lgicmd )
  241. X              bogus_key = .false.
  242. XC
  243. XC PF4 - go to privilege screen
  244. XC
  245. X           elseif (term.eq.smg$k_trm_pf4) then
  246. X              call smg$unpaste_virtual_display ( days_board,
  247. X     .         pasteboard )
  248. X              call show_privs ( owner, tables, defcli, defdev,
  249. X     .         defdir, lgicmd )
  250. X              bogus_key = .false.
  251. XC
  252. XC CtrlW - repaint screen
  253. XC
  254. X           elseif (term.eq.smg$k_trm_ctrlw) then
  255. X              call smg$repaint_screen ( pasteboard )
  256. XC
  257. XC CtrlZ - exit to main screen
  258. XC
  259. X           elseif (term.eq.smg$k_trm_ctrlz) then
  260. X              bogus_key = .false.
  261. X           endif
  262. X        enddo
  263. X
  264. X        call smg$unpaste_virtual_display ( days_board, pasteboard )
  265. X
  266. X        end
  267. X
  268. XC************************************************************************
  269. X
  270. X        Subroutine READ_DAYS ( day )
  271. XC
  272. XC The purpose of this subroutine is to read the day at the cursor and
  273. XC reverse the mode.
  274. XC
  275. X        Include 'uaf.cmn'
  276. X        Include '($smgdef)'
  277. X        Include '($uaidef)'
  278. X        Integer*4 i, day_types(7)
  279. X        Character*16 day_names(7)
  280. X        Character*(*) day
  281. X
  282. X        data day_types
  283. X     .  / uai$v_monday, uai$v_tuesday, uai$v_wednesday,
  284. X     .    uai$v_thursday, uai$v_friday, uai$v_saturday,
  285. X     .    uai$v_sunday /
  286. X
  287. X        data day_names
  288. X     .  /'Monday          ','Tuesday         ','Wednesday       ',
  289. X     .   'Thursday        ','Friday          ','Saturday        ',
  290. X     .   'Sunday          ' /
  291. XC
  292. XC Set the primary or secondary day accordingly.
  293. XC
  294. X        do i = 1,7
  295. X           if (day.eq.day_names(i)) then
  296. X              if (btest(prime,day_types(i))) then
  297. X                 call lib$bbcci ( day_types(i), prime )
  298. X              else
  299. X                 call lib$bbssi ( day_types(i), prime )
  300. X              endif
  301. X           endif
  302. X        enddo
  303. XC
  304. XC Call subroutine SCAN_DAYS to determine new values.
  305. XC
  306. X        call scan_days
  307. X
  308. X        end
  309. X
  310. XC************************************************************************
  311. X
  312. X        Subroutine SCAN_DAYS
  313. XC
  314. XC The purpose of this subroutine is to determine which days are
  315. XC primary or secondary and set the video rendition accordingly.
  316. XC
  317. X        Include 'uaf.cmn'
  318. X        Include '($smgdef)'
  319. X        Include '($uaidef)'
  320. X        Integer*4 i, line, rend_mask, day_types(7)
  321. X
  322. X        data day_types
  323. X     .  / uai$v_monday, uai$v_tuesday, uai$v_wednesday,
  324. X     .    uai$v_thursday, uai$v_friday, uai$v_saturday,
  325. X     .    uai$v_sunday /
  326. X
  327. X        rend_mask = smg$m_bold.or.smg$m_underline
  328. X        line = 5
  329. X
  330. X        call smg$begin_pasteboard_update ( pasteboard )
  331. XC
  332. XC Find out what the primary and secondary days are for the user
  333. XC
  334. X        do i = 1,7
  335. X           if (btest(prime,day_types(i))) then
  336. X              call smg$change_rendition ( days_board, line, 10,
  337. X     .         1, 16, 0 )
  338. X              call smg$change_rendition ( days_board, line, 45,
  339. X     .         1, 16, rend_mask )
  340. X           else
  341. X              call smg$change_rendition ( days_board, line, 10,
  342. X     .         1, 16, rend_mask )
  343. X              call smg$change_rendition ( days_board, line, 45,
  344. X     .         1, 16, 0 )
  345. X           endif
  346. X           line = line + 1
  347. X        enddo
  348. X
  349. X        call smg$end_pasteboard_update ( pasteboard )
  350. X
  351. X        end
  352. X
  353. XC************************************************************************
  354. X
  355. X        Subroutine SHOW_FLAGS ( owner, tables, defcli, defdev,
  356. X     .   defdir, lgicmd )
  357. XC
  358. XC The purpose of this subroutine is to paste the login flags to
  359. XC the board and allow moving of the cursor to the desired field
  360. XC in order to enable or disable a particular flag.
  361. XC
  362. X        Include 'uaf.cmn'
  363. X        Include '($smgdef)'
  364. X        Integer*4 line, col, i, j
  365. X        Character*25 string
  366. X        Character*12 flag_names(18)
  367. X        Character*(*) owner, tables, defcli, defdev, defdir, lgicmd
  368. X
  369. X        data flag_names
  370. X     .  /'Audit       ','Restricted  ','Defcli      ',
  371. X     .   'Disctly     ','Disnewmail  ','Disreconnect',
  372. X     .   'Disreport   ','Diswelcome  ','Genpwd      ',
  373. X     .   'Lockpwd     ','Dismail     ','Disuser     ',
  374. X     .   'Autolog     ','Pwdexpired  ','Pwd2_expired',
  375. X     .   'Disforce_pwd','Captive     ','Disimage    '/
  376. X
  377. X        bogus_key = .true.
  378. X        line = 3
  379. XC
  380. XC Begin creating the board.
  381. XC
  382. X        call smg$begin_pasteboard_update ( pasteboard )
  383. X        call smg$erase_display ( message )
  384. X        call smg$put_chars ( flags_board, ' Login Flags: ',
  385. X     .   1, 33 ,, smg$m_bold )
  386. X
  387. X        col = 25
  388. XC
  389. XC put all flag names to the screen
  390. XC
  391. X        do j = 1,18,2
  392. X           do i = j,j+1
  393. X              call smg$put_chars ( flags_board, flag_names(i),
  394. X     .         line, col )
  395. X              col = col + 25
  396. X           enddo
  397. X           line = line + 1
  398. X           col = 25
  399. X        enddo
  400. X
  401. X        line = line - 1
  402. XC
  403. XC Call the subroutine SCAN_FLAG to determine which flags are enabled.
  404. XC
  405. X        call scan_flag
  406. XC
  407. XC Reset line and column values.
  408. XC
  409. X        line = 3
  410. X        col = 25
  411. XC
  412. XC Write instructions to the message window
  413. XC
  414. X        call smg$put_chars ( message,
  415. X     .   'Use arrow keys to move to desired field.', 1, 2 )
  416. X        call smg$put_chars ( message,
  417. X     .   'Hit SELECT, PERIOD, or T to change flag.', 2, 2 )
  418. X        call smg$put_chars ( message,
  419. X     .   'PF keys: go to another screen.
  420. X     .   ControlZ: exit to main display.',
  421. X     .   3, 2 )
  422. XC
  423. XC Paste virtual displays, end the pasteboard update, and set the cursor
  424. XC to the first position
  425. XC
  426. X        call smg$paste_virtual_display ( flags_board, pasteboard, 1,1 )
  427. X        call smg$paste_virtual_display ( message, pasteboard, 22, 1 )
  428. X        call smg$end_pasteboard_update ( pasteboard )
  429. X        call smg$set_cursor_abs ( flags_board, line, col )
  430. XC
  431. XC Read a keystroke. Loop until terminator key is hit (ctrlZ).
  432. XC
  433. X        do while (bogus_key)
  434. X           call smg$read_keystroke ( keyboard, term )
  435. XC
  436. XC Right arrow, or letter 'l' - move to next field at right
  437. XC
  438. X           if (term.eq.smg$k_trm_right.or.
  439. X     .      term.eq.smg$k_trm_uppercase_l.or.
  440. X     .      term.eq.smg$k_trm_lowercase_l) then
  441. X              if (line.eq.11.and.col.eq.50) then
  442. X                 line = 3
  443. X                 col = 25
  444. X              elseif (col.eq.50) then
  445. X                 line = line + 1
  446. X                 col = 25
  447. X              elseif (col.eq.25) then
  448. X                 col = 50
  449. X              endif
  450. X              call smg$set_cursor_abs ( flags_board, line, col )
  451. XC
  452. XC Left arrow, or letter 'h' - move to previous field at left.
  453. XC
  454. +-+-+-+-+-+-+-+-  END  OF PART 9 +-+-+-+-+-+-+-+-
  455. -- 
  456. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  457. < Joe Koffley                        KOFFLEY@NRLVAX.NRL.NAVY.MIL             >
  458. < Naval Research Laboratory          KOFFLEY@CCF.NRL.NAVY.MIL                >
  459. < Space Systems Division             AT&T  :  202-767-0894                   >
  460. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  461.