	Program SHOWME
C
C		Modified from:
C	Program Where (AT&T)
C			author		Andrew W. Potter
c	Written:     	November 25th, 1985
C 
C Modifications by Dale E. Coy
C	Modified by D.E.C.  5-MAY-1986 
C 	Modified by D.E.C. 20-APR-1987 
C	Modified by D.E.C. 16-MAY-1987 
C	Modified by D.E.C.  5-AUG-1987
C	Modified by D.E.C. 26-NOV-1987
C	Modified by D.E.C. 14-JUL-1988
C 
C
	implicit integer*4 (A-Z)

	include	'($DCDEF)'
	include	'($DVIDEF)'
	include	'($JPIDEF)'
	include	'($LNMDEF)'
	include	'($SYIDEF)'
	include	'($TTDEF)'

	byte		dev_type(4)

	Character*4	hdwr
	Character*7	ver
	Character*8	node, cpu_type, lnode
	character*8	symbol1, symbol3
	Character*10	term, vterm
	Character*12	term_type
	Character*15	prcnam
	Character*20	node_type
	Character*12	username
	Character*40 	user
	Character*44	line1, neattime
	Character*80	disk, line3
	Character*86	line2
	Character*256 	dir
	Character*352	line4

	integer		dlen1,dlen2,node_len,int,bat
	
	logical*1 	hw_addr,ver_addr,node_addr
	logical*1	tt_addr,vt_addr,user_addr,prc_addr
	logical*4 	deccrt,deccrt2,avo,drcs
	
	equivalence	(term,tt_addr),(vterm,vt_addr),(username,user_addr)
	equivalence	(hdwr,hw_addr),(node,node_addr),(ver,ver_addr)
	equivalence	(prcnam,prc_addr)
	equivalence	(line1, line2, line3, line4)
                                                
	structure /item_list/
	  integer*2 buflen,code
	  integer*4 address,retlen
	end structure

	record /item_list/ list(9)


c
c	Get SYSTEM info
c

	list(1).buflen = len(hdwr)
	list(1).code = syi$_node_hwtype
	list(1).address = %loc(hw_addr)
	list(1).retlen = %loc(hlen)

	list(2).buflen = len(node)
	list(2).code = syi$_nodename
	list(2).address = %loc(node_addr)
	list(2).retlen = %loc(nlen)

	list(3).buflen = len(ver)
	list(3).code = syi$_version
	list(3).address = %loc(ver_addr)
	list(3).retlen = %loc(vlen)

	list(4).buflen = 4
	list(4).code = syi$_vaxcluster
	list(4).address = %loc(vax_cluster)
	list(4).retlen = %loc(vxclen)

	list(5).buflen = 0
	list(5).code = 0

	status = sys$getsyiw(,,,list,,,)

	if (.not. status) call exit(status)
                        
	if (ver(1:1) .eq. 'V') ver(1:) = ver(2:)
	call str$trim(ver,ver,vlen)
	
c
c	Get DEVICE info
c

	list(1).buflen = len(vterm)
	list(1).code = dvi$_devnam
	list(1).address = %loc(vt_addr)
	list(1).retlen = %loc(vtlen)

	list(2).buflen = len(term)
	list(2).code = dvi$_tt_phydevnam
	list(2).address = %loc(tt_addr)
	list(2).retlen = %loc(tlen)

	list(3).buflen = 4
	list(3).code = dvi$_devtype
	list(3).address = %loc(dev_type)
	list(3).retlen = %loc(tylen)

	list(4).buflen = 4
	list(4).code = dvi$_devclass
	list(4).address = %loc(dev_class)
	list(4).retlen = %loc(cllen)

	list(5).buflen = 4
	list(5).code = dvi$_tt_drcs
	list(5).address = %loc(drcs)
	list(5).retlen = %loc(drcslen)

	list(6).buflen = 4
	list(6).code = dvi$_tt_deccrt
	list(6).address = %loc(deccrt)
	list(6).retlen = %loc(deccrtlen)

	list(7).buflen = 4
	list(7).code = dvi$_tt_deccrt2
	list(7).address = %loc(deccrt2)
	list(7).retlen = %loc(deccrt2len)

	list(8).buflen = 4
	list(8).code = dvi$_tt_avo
	list(8).address = %loc(avo)
	list(8).retlen = %loc(avolen)

	list(9).buflen = 0
	list(9).code = 0
                                        
	status = sys$getdviw(,,'SYS$COMMAND',list,,,,)

	if (.not. status) call exit(status)

	If (deccrt) then
		symbol1 = char(14)//'`'//char(15)
		s1_len = 3
		if (deccrt2 .and. drcs) then
			symbol3 = char(171)//char(187)
			s3_len = 2
		else
			symbol3 = '<=>'
			s3_len = 3
		endif
	else
		symbol1 = '<>'
		s1_len = 2
		symbol3 = '<=>'
		s3_len = 3
	endif
	
c        
c	Get JOB info
c

	list(1).buflen = 4
	list(1).code = jpi$_uic
	list(1).address = %loc(uic)             
	list(1).retlen = %loc(ulen)

	list(2).buflen = len(username)
	list(2).code = jpi$_username
	list(2).address = %loc(user_addr)
	list(2).retlen = %loc(uslen)

	list(3).buflen = len(prcnam)
	list(3).code = jpi$_prcnam
	list(3).address = %loc(prc_addr)
	list(3).retlen = %loc(prclen)

	list(4).buflen = 0
	list(4).code = 0

	status = sys$getjpiw(,,,list,,,)

	if (.not. status) call exit(status)

	call str$trim(user,username(:uslen),uslen)
	if (avo) then
		user = char(27)//'[1m'//user(:uslen)//char(27)//'[0m'
		uslen = uslen + 8
	endif
	
c
c	Get DIRECTORY info
c
	status = sys$setddir(,dlen,dir)

	if (.not. status) call exit(status)

c
c	Get DISK info
c

	list(1).buflen = len(disk)
	list(1).code = lnm$_string
	list(1).address = %loc(disk)
	list(1).retlen = %loc(dklen)

	list(2).buflen = 0
	list(2).code = 0

	status = sys$trnlnm(,'LNM$PROCESS_TABLE','SYS$DISK',,list)

	if (.not. status) call exit(status)
c
c	Get NETWORK info
c

	list(1).buflen = len(lnode)
	list(1).code = lnm$_string
	list(1).address = %loc(lnode)
	list(1).retlen = %loc(lnlen)

	list(2).buflen = 0
	list(2).code = 0

	status = sys$trnlnm(,'LNM$SYSTEM_TABLE','SYS$NODE',,list)

	if (.not. status) call exit(status)
	
C 		Get rid of ::
	lnlen = lnlen - 2
	
c
c	Format the results
c

C FIRST LINE
	
C 		The CPU model........
	If (hdwr(1:1) .eq. '8') then
	  	cpu_type = hdwr(1:hlen)
		cpu_len = hlen
	else if (hdwr(2:2) .eq. '7') then
	  	cpu_type = '11/'//hdwr(2:hlen)
		cpu_len = hlen+2
C 		    Mod for KA650 - Ehud Gavron, Los Alamos
	else if (hdwr(2:hlen) .eq. '650') then
		if (deccrt2 .and. drcs) then
			cpu_type = 'µVaxIII'
			cpu_len = 7
		else
			cpu_type = 'uVaxIII'
			cpu_len = 7
		endif
	else if (hdwr(2:hlen) .eq. 'UV2') then
		if (deccrt2 .and. drcs) then
			cpu_type = 'µVaxII'
			cpu_len = 6
		else
			cpu_type = 'uVaxII'
			cpu_len = 6
		endif
	else if (hdwr(2:hlen) .eq. 'UV1') then
		if (deccrt2 .and. drcs) then
			cpu_type = 'µVaxI'
			cpu_len = 5
		else
			cpu_type = 'uVaxI'
			cpu_len = 5
		endif
	else if (hdwr(1:1) .eq. '3') then
	  	cpu_type = hdwr(1:hlen)
		cpu_len = hlen
	else if (hdwr(1:1) .eq. '9') then
	  	cpu_type = hdwr(1:hlen)
		cpu_len = hlen
	else	  
	  	cpu_type = hdwr(2:hlen)
		cpu_len = hlen-1
	endif

C 	Format Line 1
C 		(Node name, CPU type, VMS version)
C--------------------------------------------------------------------------
	if ((vax_cluster .ne. 0).and.(nlen .gt. 0)) then
		line1='   '//node(1:nlen)//
	1		' '//symbol1(:s1_len)//
	2		' '//cpu_type(1:cpu_len)//
	3		' '//symbol1(:s1_len)//
	4		' VMS '//ver(:vlen)

	       	len1 = nlen+cpu_len + vlen + s1_len + s1_len + 11
		node_type='   VAXcluster node. '
		node_len=20


	else
		if (lnlen.gt.0) then
			line1 =	'   '//lnode(1:lnlen)//
	1			' '//symbol1(:s1_len)//
	2			' '//cpu_type(1:cpu_len)//
	3			' '//symbol1(:s1_len)//
	4			' VMS '//ver(:vlen)

		       	len1 = lnlen + cpu_len + vlen + s1_len + s1_len + 11
			node_type='   DECnet node. '
			node_len=16

		else
			line1 =	'   VAX '//
	2			' '//cpu_type(1:cpu_len)//
	3			' '//symbol1(:s1_len)//
	4			' VMS '//ver(:vlen)

		       	len1 = cpu_len + vlen + s1_len + 14
			node_type = '   '
			node_len = 3

		end if
	end if

C 		And print line 1 (single if no double height capability)
	
	if (deccrt) then
		line1 = char(27)//'#3'//line1
		len1 = len1 + 3
		call lib$put_output (char(27)//')0')
		call lib$put_output (line1(1:len1))
		line1(3:3) = '4'
		call lib$put_output (line1(1:len1))
	else
		line1 = '  '//line1
		len1 = len1 + 2
		call lib$put_output (line1(1:len1))
	end if

	
	
C Get description of Terminal Type, and format Line 2
C 	(Node type, user, and terminal information)
C--------------------------------------------------------------------------

	Call TT_TYPE (Dev_Type(1), term_type, ttlen)

	lenx = node_len + uslen + 7
	line2(:lenx) = node_type(:node_len)//'  User '//
	1		user(1:uslen)
	
	if (dev_class .ne. DC$_TERM) then

		len2 = lenx + 30
		line2 (lenx+1:len2) = 
	1		' (not connected to a terminal)'

	elseif (vterm(2:3) .eq. 'VT') then

		len2 = lenx + ttlen + tlen + vtlen + 17 - 2
		line2 (lenx+1:len2) = 
	1		' at '//term_type(1:ttlen)//
	2		' terminal '//term(2:tlen-1)//
	3		' ('//vterm(2:vtlen-1)//')'
	
	else

		len2 = lenx + ttlen + tlen + 14 - 1
		line2 (lenx+1:len2) = 
	1		' at '//term_type(1:ttlen)//
	2		' terminal '//term(2:tlen-1)
	
	endif


	call lib$put_output(line2(1:len2))

C 
C 		LINE 3 (Time & Number of Jobs)
C--------------------------------------------------------------------------
C 
        call interactive(int,bat)
	call fulltime(neattime,l_day)
	
	status = sys$fao('   !AS  '//symbol3(:s3_len)//
	1	'  !UL user!%S, !UL batch job!%S.',
	2	len3,
	3	line3,
	4       neattime(1:l_day),
	5	%val(int),%val(bat))
	
	if (.not. status) call exit(status)

	call lib$put_output(line3(1:len3))
	
C 
C 		LINE 3B (Process Name if not Username)
C--------------------------------------------------------------------------
C 
	if (username(:uslen) .ne. prcnam(:prclen)) then
		len1 = prclen + 18
		line1(:len1) = '   Process Name:  '//prcnam(:prclen)
	
		call lib$put_output(line1(1:len1))
	endif
	
C 
C 		LINE 4 (Directory Information)
C--------------------------------------------------------------------------
C 
	len4 = 14 + dklen + dlen
	line4(:len4) = '   Directory  '//
	1	disk(1:dklen)// dir(1:dlen)

	call lib$put_output(line4(1:len4))

	
C And an empty line
	call lib$put_output(line4(1:1))
	
	call exit

	end
C 
C ----- SUBROUTINES -----------------------------------------------
*
*	this routine returns the interactive and batch job counts
*
*
*
	subroutine interactive(int,bat)
	implicit integer*2 (a-z)
*
	integer*4 int,bat
**
	external sys$gw_bjobcnt
	external sys$gw_ijobcnt
*
*
	int = peek(sys$gw_ijobcnt)
	bat = peek(sys$gw_bjobcnt)
*

	return
	end
*
	function peek(i)
	integer*2 i,peek
	peek=i
	end
*
*
*
C This subroutine returns a string with the day, date, and time formatted
C (for example) as:	Tuesday, August 4, 1987  10:30 PM
	
	subroutine fulltime(neattime,l_n)
	character*(*) neattime
	
	character*2	hour, day, ampm
C	character*2 	min
	character*3	month
C	character*4 	year
	character*10 	newmon, dayname
	character*23 d
	
	integer*4 today /0/
	integer*4 dayint
	integer l_day
	
	
	call lib$day_of_week(%Val(today),%Ref(dayint))

	goto (1,2,3,4,5,6,7) dayint
	
1	   dayname = 'Monday    '
	   l_day = 6
	   goto 200
	
2	   dayname = 'Tuesday   '
	   l_day = 7
	   goto 200
	
3	   dayname = 'Wednesday '
	   l_day = 9
	   goto 200
	
4	   dayname = 'Thursday  '
	   l_day = 8
	   goto 200
	
5	   dayname = 'Friday    '
	   l_day = 6
	   goto 200
	
6	   dayname = 'Saturday  '
	   l_day = 8
	   goto 200
	
7	   dayname = 'Sunday    '
	   l_day = 6
	   goto 200
	
	
200	call lib$date_time(d)
	day = d(1:2)
	month = d(4:6)
C	year =d(8:11)
	hour = d(13:14)
C	min = d(16:17)
	
	read (hour,'(i2)') ihour
	if (ihour.gt.12) then
	    ihour = ihour - 12
	    ampm = 'PM'
	    hour = '  '
	    write (hour,'(i2)') ihour
	else
 	    ampm = 'AM'
	endif
	if (ihour.eq.12) ampm = 'PM'
	l_h = 2
	if (ihour.lt.10) then
	    hour(1:1) = hour(2:2)
	    l_h = 1
	endif

	if (day(1:1) .eq. ' ') then
	   day(1:1) = day(2:2)
	   l_days = 1
	else
	   l_days = 2
	endif
	
	if (month.eq.'JAN') then 
	   newmon = 'January'
	   l_nm = 7
	elseif  (month.eq.'FEB') then 
	   newmon = 'February'
	   l_nm = 8
	elseif  (month.eq.'MAR') then 
	   newmon = 'March'
	   l_nm = 5
	elseif  (month.eq.'APR') then 
	   newmon = 'April'
	   l_nm = 5
	elseif  (month.eq.'MAY') then 
	   newmon = 'May'
	   l_nm = 3
	elseif  (month.eq.'JUN') then 
	   newmon = 'June'
	   l_nm = 4
	elseif  (month.eq.'JUL') then 
	   newmon = 'July'
	   l_nm = 4
	elseif  (month.eq.'AUG') then 
	   newmon = 'August'
	   l_nm = 6
	elseif  (month.eq.'SEP') then 
	   newmon = 'September'
	   l_nm = 9
	elseif  (month.eq.'OCT') then 
	   newmon = 'October'
	   l_nm = 7
	elseif  (month.eq.'NOV') then 
	   newmon = 'November'
	   l_nm = 8
	elseif  (month.eq.'DEC') then 
	   newmon = 'December'
	   l_nm = 8
	endif
	
	neattime = dayname(1:l_day)//', '//
     1		newmon(1:l_nm)//' '//day(1:l_days)//
     1		', '//d(8:11)//'  '//
     1          hour(1:l_h)//':'//d(16:17)//' '//ampm

	call str$trim(neattime,neattime,l_n)
	return
	end

	
C Subroutine to return 12-character terminal type and length
C 	NOTE: Update from a listing, using FOR/LIST/SHOW=INCLUDE,
C 	when Fortran changes
	
	subroutine tt_type (dev_type,name,length)
	
	byte dev_type
	character*12 name, types(0:128)
C 		WARNING: This might change to 256 some day
	
	include '($TTDEF)'	! Which defines the following indexes
	data types(tt$_UNKNOWN) /'Unknown Type'/
	data types(tt$_VT05) /'VT05'/
	data types(tt$_VK100) /'Gigi'/
	data types(tt$_VT173) /'VT173'/
	data types(tt$_TQ_BTS) /'TQ_BTS'/
	data types(tt$_TEK401X) /'Tek 401X'/
	data types(tt$_FT1) /'FT1'/
	data types(tt$_FT2) /'FT2'/
	data types(tt$_FT3) /'FT3'/
	data types(tt$_FT4) /'FT4'/
	data types(tt$_FT5) /'FT5'/
	data types(tt$_FT6) /'FT6'/
	data types(tt$_FT7) /'FT7'/
	data types(tt$_FT8) /'FT8'/
C	data types(tt$_LAX) 		Duplicates LA36 below
	data types(tt$_LA36) /'LA36'/
	data types(tt$_LA120) /'LA120'/
	data types(tt$_LA34) /'LA34'/
	data types(tt$_LA38) /'LA38'/
	data types(tt$_LA12) /'LA12'/
	data types(tt$_LA100) /'LA100'/
C	data types(tt$_LA24) 		Duplicates LA100 above
	data types(tt$_LQP02) /'LQP02'/
	data types(tt$_LA84) /'LA84'/
	data types(tt$_LA210) /'LA210'/
	data types(tt$_LN03) /'LN03'/
	data types(tt$_LN01K) /'LN01K'/
	data types(tt$_LA80) /'LA80'/
C	data types(tt$_VT5X) 		Duplicates VT52 below
	data types(tt$_VT52) /'VT52'/
	data types(tt$_VT55) /'VT55'/
	data types(tt$_VT100) /'VT100'/
	data types(tt$_VT101) /'VT101'/
	data types(tt$_VT102) /'VT102'/
	data types(tt$_VT105) /'VT105'/
	data types(tt$_VT125) /'VT125'/
	data types(tt$_VT131) /'VT131'/
	data types(tt$_VT132) /'VT132'/
	data types(tt$_VT80) /'VT80'/
	data types(tt$_VT200_SERIES) /'VT200 Series'/
	data types(tt$_PRO_SERIES) /'Pro Series'/
	data types(tt$_VT300_SERIES) /'VT300 Series'/
	
C $TTDEF was updated to contain VT300 information at V5.0 - prior to that,
C	data types('00000070'X) /'VT300 Series'/

	Call STR$Trim (name, %Descr(types(dev_type)), length)
	Return
	
	END
