	subroutine bbscb
c	This is a version of cb for the bulletin board
c++
c
c	>>>>>  CB/Vax Version 3.0  <<<<<
c
c	The Citizens' Band radio simulator for VAX/VMS.  (This is such
c	an incredible simulation, you'll think it's the real thing!)
c
c	Written by:	Dale Miller
c			University of Arkansas at Little Rock
c			2801 S. University
c			Little Rock, AR  72204
c			(501) 569-3220
c
c	Based on RATFIV coding by Chris Thomas - whereabouts currently unknown.
c	Version 3.0 is a complete re-write of the RATFIV code distributed on
c	the DECUS symposia tapes.
	
c
c	While all of the coding is certainly original, the idea isn't....
c	This looks very, very much like the CB simulator program that runs
c	on the CompuServe Information Service.
c
c
c			****  Important Notes  ****
c
c	Starting with V2.0, CB/Vax is distributed in two parts:
c	1)  CBMGR.FOR is the CB Manager.  It runs detached and performs
c	    all of CB/Vax's really important functions.
c	2)  CB.FOR, this program, is the user interface to CB/Vax.
c	You need -both- of these to run CB/Vax!!!
c
c	CB.EXE needs to be INSTALLed with the following privileges:
c		DETACH, WORLD, OPER, SYSNAM, PRMMBX, ALTPRI.
c
c
c	Modification History:
c
c	25-Jan-86/DOM	V3.0	o  Complete re-write in Fortran-77
c				   Addition of scrambling, /time, /squelch.
c				   Provisions for running on a VAXcluster.
c
c	27-Apr-83/JCT	V2.3	o  Trap ^Z's and, if just waiting for a
c				   message, behave like /EXIT.
c				o  Check for /NOBROADCAST at startup and, if
c				   so, tell the user that this won't work.
c				o  Display the current time on a summons.
c				o  Check the MAXPEOPLE limit in the manager.
c				o  Check against batch access, since that's
c				   real nasty.
c				o  In Manager, before every send we check to
c				   make sure the destination terminal is
c				   still owned by the original PID.  This is
c				   to handle line drops and operator STOPs.
c				   Otherwise, messages would continue to be
c				   sent to these terminals.
c
c	16-Apr-83/JCT	V2.2	o  The terminal name is now obtained by
c				   looking at SYS$COMMAND instead of SYS$INPUT.
c				   When we were run from a command procedure,
c				   this caused many problems.
c				o  Commands need only be typed to uniqueness
c				   now, also they may be fully typed out,
c				   instead of the old 3-character limit.
c				o  The /SUMMON command has been added.
c				o  Users can't have null handles anymore.
c
c	27-Mar-83/JCT	V2.1	Substantial enhancements from V2.0:
c				o  40-channel capability
c				o  /STA, /UST, /HAN, /TUN, /HEL commands
c				o  The symbol CB_HANDLE is checked for a
c				   predefined handle.
c				o  Commands can be in mixed case, and only
c				   the first three letters matter.
c				o  Duplicate handles are prohibited.
c				o  The CB Manager is automatically created
c				   if it's not present at startup.
c				o  The CB Manager is automatically deleted
c				   if there's nobody running CB.
c
c	25-Mar-83/JCT	V2.0	Almost total rewrite of V1.0:
c				o  Introduced the "CB Manager" concept.
c				o  Changed default channel to 1.
c
c--
	implicit integer*4 (a-z)
	parameter PCB$V_BATCH = '0E'x	 ! either of these.
	include '($jpidef)'
	include '($prvdef)'
	include '($ttdef)'
	include '($libclidef)'
	include '($dvidef)'
	include '($iodef)'
	include '($ssdef)'
c******************************************************************************
c                                                                             *
c	****  CB/Vax Site-Specific Things  ****                               *
c	(Change at your own discretion - and risk)                            *
c                                                                             *
c******************************************************************************
	character*(*)cbmgr_location, cb_mailbox_name, cb_handle,
	1   cbmgr_procname
	parameter(cbmgr_location = 'sys$common:[sysmgr.ualr.cb]cbmgr.exe',
	1   cb_mailbox_name = 'CB_MBX', cb_handle = 'CB_HANDLE',
	2   cbmgr_procname = 'CB_Manager', cbmgr_grp = 1, cbmgr_mem = 4,
	3   cbmgr_priority = 5)
c	****  end OF SITE-SPECIFIC THINGS  ****

	character*20 tran, our_term, pterminal, nodename
	character*12 my_username
	character*132 text,otext
	character*16 handle
	character*32 mbname, arg
	character*255 msg, ucased
	character*4 command
	character*1 null, space
	character currtim*8,ctime*8,cdate*9
	character*9 dow(7)/'Monday','Tuesday','Wednesday','Thursday',
	1   'Friday','Saturday','Sunday'/
	integer*4 privs(2), items(13), dvi_items(4)
	logical*1 wait, bad_handle,bbs
	integer*4 write_code,ctrl_mask
	structure /status_block/
	    integer*2 iostat,
	1	      msg_len
	    integer*4 reader_pid
	    end structure
	record /status_block/ iostatus
	integer sys$crembx,sys$ascefc,sys$waitfr,sys$qio


c	Message code definitions for the CB Manager.  The first byte of every
c	message sent to him contains the action to be taken, as defined here:

	parameter(new_person = 1, message = 2, leaving = 3, ustat = 4,
	1   status = 5, tune = 6, chg_handle = 7, scramble = 8, 
	2   squelch = 9, summon = 10)

2000	format(a)
2001	format(' You are monitoring channels ',i2,' and ',i2)

	write_code=io$_writevblk .or. io$m_now
	len = 255
	command_index = 0

	items(1) = (65536*jpi$_grp) + 4
	items(2) = %loc(grp)
	items(3) = 0
	items(4) = (65536*jpi$_mem) + 4
	items(5) = %loc(mem)
	items(6) = 0
	items(7) = (65536*jpi$_username) + 12
	items(8) = %loc(my_username)
	items(9) = 0
	items(10) = (65536*jpi$_sts) + 4
	items(11) = %loc(proc_status)
	items(12) = 0
	items(13) = 0
	call sys$getjpi(, , , items, , , )

	sta = sys$setrwm(%val(1))

c	Disable control-Y's while we run.  If we don't, the CB Manager
c	won't know when we're done, and he'll continue to send messages,
c	making the user somewhat unhappy.

	call lib$disable_ctrl(lib$m_cli_ctrly,ctrl_mask)

c	Check our status bits to make sure we're interactive.  Batch access
c	to CB/Vax is not the least bit friendly!

	if ((proc_status .and. (2**'0e'x)) .ne. 0) then
	    write(6,2000)' %You can''t run CB/Vax from batch.'
	    go to 99000
	    end if

c	Check to make sure our terminal is /BROADCAST.  If it's not, then
c	nothing else here will work.

	dvi_items(1) = (65536*'0a'x) + 4
	dvi_items(2) = %loc(devdepend)
	dvi_items(3) = 0
	dvi_items(4) = 0
	call sys$getdvi(, , 'SYS$COMMAND', dvi_items, , , , )
	if ((devdepend .and. tt$m_nobrdcst) .ne. 0) then
	    write(6,2000)' %Your terminal is set /NOBROADCAST.'
	    write(6,2000)' %CB/Vax will not work with your terminal '//
	1	'set this way.'
	    go to 99000
	    end if


	write(6,2000)' Welcome to CB/Vax V2.4'
	if(my_username.eq.'BBS') then
	    bbs=.true.
	else
	    bbs=.false.
	endif

c	Decide if we need to start up the CB Manager.  Attempt to translate
c	the mailbox's logical name.  If we fail, then we assume the manager
c	doesn't exist, so we start him up with appropriate privileges.

	sta = sys$trnlog(cb_mailbox_name,,mbname,,,)

	if (sta .ne. 1) then
	    privs(1) = prv$m_oper + prv$m_prmmbx + prv$m_setpri + 
	1	prv$m_sysnam + prv$m_world
	    privs(2) = 0
	    sta2 = sys$creprc(,cbmgr_location,,,,%ref(privs(1)),,
	1	cbmgr_procname,%val(cbmgr_priority),%val((65536*cbmgr_grp)
	2	+ cbmgr_mem),,)
	    if (sta2 .ne. 1) then
		write(6,2000)' ??Can''t start CB Manager.'
		write(6,2000)' Please contact the system manager.'
		go to 99000
		end if
	     end if
c	Turn off privs for this process.

	privs(1) = privs(1) + prv$m_detach
c	sta = sys$setprv(%val(0),%ref(privs(1)),%val(0),)


c	Try to read the global symbol CB_HANDLE from our process tables.
c	If it's there, then we'll use that as our initial handle.  (You
c	see, having simple entry into CB is important to get people to
c	use it a lot.)

	space = ' '
	null = char(0)
2060	continue
	bad_handle = .false.
	sta = lib$get_symbol(cb_handle, handle)
	if (.not.(sta .and. 1)) then
	    write(6,2000)'$What''s your handle? '
	    read(5,2000, end=2060, err=2060) handle
	    call lib$set_symbol(cb_handle, handle)
	    end if
	    ista=str$trim(handle,handle,i)
	if (i .eq. 0) then
	    write(6, 2000)' You can''t have a null handle!'
	    bad_handle = .true.
	    call lib$delete_symbol(cb_handle)
	    end if
	do k=1,i
	    if(ichar(handle(k:k)).lt.32.or.ichar(handle(k:k)).gt.126) then
		write(6,2000)' Invalid character in handle'
		bad_handle=.true.
		call lib$delete_symbol(cb_handle)
		endif
	    enddo
	if (bad_handle) goto 2060
	length=11
	tran='SYS$COMMAND'
	sta = sys$trnlog(tran(1:length),length,tran,,,)
	our_term = tran(5:20)
	sta = str$trim(our_term, our_term, length)
	if (our_term(length:length) .ne. ':') then
	    our_term(length + 1:length + 1) = ':'
	    end if
	is = index(our_term, '$')
	nodename = our_term(1:is)
	our_term = our_term(is + 1:20)
	istat = lib$getdvi(dvi$_tt_phydevnam, , our_term, , pterminal, )
	our_term = nodename(1:is)//pterminal(2:20)
	nodename=nodename(3:is-1)
	new_chan = 1


C	Build a "new user" string to send to the manager, and send it through
C	the mailbox.
	msg(1:1)   = char(new_person)
	msg(2:17)  = our_term
	msg(18:18) = char(new_chan)
	msg(19:19) = null
	msg(20:20) = null
	msg(21:36) = handle
	msg(37:42) = nodename
	msg(43:50) = ' '		!Scramble key
	msg(51:51) = null		!Scramble type
	msg(52:)   = my_username

C	Open up the mailbox.  This is trickier than it appears...  If we've
C	just created the Manager, the mailbox logical may not be defined by
C	the time we reach here, especially if we're on a fast system.
C	If we have trouble opening the mailbox, then we keep trying every 
C	two seconds until it's open (max 20 seconds).
	trys=0

	sta = .false.
	do while(.not.sta)
	    sta = sys$assign(cb_mailbox_name,mbx_chan,,,)
	    if (.not. sta) then
		trys=trys+1
		if(trys.gt.10) then
		    write(6,2000)' CB internal error.  exiting CB-Vax.'
		    go to 99000
		else
		    call bas$sleep(%val(2))
		end if
	    endif
	    end do
	go to 30000		!Start the whole thing off


C	Long loop.  Repeat until we get an /EXIT command or ^Z from the user.
C	If it's a command, go execute it.  Otherwise, we build a message
C	and send it off to the Manager.

2180	continue
	if (command_index.eq.1) then
	    go to 99000
	    end if
c	read(5, 2000, end=4000, err=4000) text
	txtlen=132
	call get_uplow_string(txtlen,text)
	call parse_cmd(text, command_index, arg)
	istat = str$trim(arg,arg,alen)
	goto (3000,4000,5000,6000,7000,8000,9000,10000,11000,
	1   12000,13000,14000,15000,16000,17000,18000), command_index + 1
	goto 2180

3000    continue	!message (what it's all about)
	if((text.eq.' ').or.(text.eq.otext)) go to 2180
	msg(1:1)   = char(message)
	msg(52:)   = text
	otext=text
	go to 30000

4000    continue	!user leaving
	msg(1:1)   = char(leaving)
	command_index=1
	go to 30000

5000    continue	!change handle
	if(bbs) go to 2180
	bad_handle = .false.
	if(arg(:alen).eq.' ') then
	    write(6,2000)'$What''s your handle? '
	    read(5,2000, end=2060, err=2060) handle
	else
	    handle=arg(:alen)
	endif
	ista=str$trim(handle,handle,i)
	if (i .eq. 0) then
	    write(6, 2000)' Your handle was not changed.'
	    go to 2180
	    end if
	do k=1,i
	    if(ichar(handle(k:k)).lt.32.or.ichar(handle(k:k)).gt.126) then
		write(6,2000)' Invalid character in handle'
		bad_handle=.true.
		call lib$delete_symbol(cb_handle)
		endif
	    enddo
	if (bad_handle) goto 5000
	call lib$set_symbol(cb_handle, handle)
	msg(1:1)   = char(chg_handle)
	msg(21:36) = handle
	go to 30000

6000    continue	!help
	write(6,2000)' Quick summary of CB/Vax commands:'
	write(6,2000)' /EXIT or ^Z   Exits from CB/Vax'
	if(.not.bbs)write(6,2000)' /HANDLE       Changes your handle'
	write(6,2000)' /HELP         Print this help text'
	write(6,2000)' /MONITOR n    Monitor a channel (Max of 2)'
	write(6,2000)' /SCRAMBLE xyz Scramble on key "xyz" (xmit & recieve)'
	write(6,2000)' /SMC xyz      Scramble xmit/recieve scrambled & clear'
	write(6,2000)' /SQUELCH abc  Squelch handle "abc"'
	write(6,2000)' /STATUS       Report number of people on each channel'
	if(.not.bbs)write(6,2000)' /SUMMON user  Summon'//
	1   ' username ''user'' to CB/Vax.'
	write(6,2000)' /TIME         Report time, day, and date'
	write(6,2000)' /TUNE n       Switch to channel ''n''.  '//
	1   'Channels 1-40 available.'
	write(6,2000)' /UNMONITOR n  Stop monitoring a channel'
	write(6,2000)' /UNSCRAMBLE   Do not xmit or recieve scrambled.'
	write(6,2000)' /USTAT        Detailed list of current CB/Vax users'
	write(6,2000)' /XCL xyz      Xmit clear/ recieve scrambled & clear'
	write(6,2000)' '
	write(6,2000)' Commands may be in upper or lower case'
	write(6,2000)' and may be abbreviated to 3 characters.'
	goto 2180

7000	continue	!Monitor
	call ots$cvt_ti_l(arg(:alen), mon_chan)
	if ((mon_chan .lt. 1) .or. (mon_chan .gt. 40)) then
	    write(6, 2000)' That channel doesn''t exist!'
	    goto 2180
	    end if
c	if we are monitoring it already, ignore this request
	if( (mon_chan.eq.ichar(msg(19:19))).or.
	1   (mon_chan.eq.ichar(msg(20:20)))) go to 2180

	msg(1:1)   = char(tune)
	if(msg(19:19).eq.null) then
	    msg(19:19) = char(mon_chan)
	else if(msg(20:20).eq.null) then
	    msg(20:20) = char(mon_chan)
	else
	    write(6,2000)' You can only monitor 2 channels at a time'
	    write(6,2001)ichar(msg(19:19)),ichar(msg(20:20))
	    go to 2180
	endif
	go to 30000

8000	continue	!Scramble
	if(alen.eq.0) then
	    write(6,2000)' You must provide a scramble key'
	    go to 2180
	    endif
	ist=str$upcase(arg(:alen),arg(:alen))
	msg(1:1) = char(scramble)
	msg(43:50) = arg(:alen)
	msg(51:51) = char(1)
	go to 30000

9000	continue	!Scramble and monitor clear
	if(alen.eq.0) then
	    write(6,2000)' You must provide a scramble key'
	    go to 2180
	    endif
	ist=str$upcase(arg(:alen),arg(:alen))
	msg(1:1) = char(scramble)
	msg(43:50) = arg(:alen)
	msg(51:51) = char(2)
	go to 30000

10000	continue	!Squelch
	msg(1:1) = char(squelch)
	msg(52:) = arg(:alen)
	go to 30000

11000	continue	!status
	msg(1:1)   = char(status)
	go to 30000

12000	continue	!summon
	if(bbs) go to 2180
	msg(1:1) = char(summon)
	msg(52:) = arg(:alen)
	write(6,2000)' Summon complete.'
	go to 30000

13000	continue	!Time
	call date(cdate)
	call time(ctime)
	is=lib$day_of_week(,daynum)
	is=str$trim(dow(daynum),dow(daynum),daylen)
	write(6,2000)' It is '//dow(daynum)(1:daylen)//', '//cdate//
	1   ' and it is now '//ctime
	go to 2180

14000	continue	!tune
	call ots$cvt_ti_l(arg(:alen), new_chan)
	if(new_chan.eq.99.and.my_username.eq.'DOMILLER') then
	    msg(1:1) = char(tune)
	    msg(18:18)=char(new_chan)
	    go to 30000
	    endif
	if ((new_chan .lt. 1) .or. (new_chan .gt. 40)) then
	    write(6, 2000)' That channel doesn''t exist!'
	    goto 2180
	    end if
	msg(1:1)   = char(tune)
	msg(18:18) = char(new_chan)
	go to 30000

15000	continue	!Unmonitor
	call ots$cvt_ti_l(arg(:alen), mon_chan)
	if ((mon_chan .lt. 1) .or. (mon_chan .gt. 40)) then
	    write(6, 2000)' That channel doesn''t exist!'
	    goto 2180
	    end if

	msg(1:1)   = char(tune)
	if(msg(19:19).eq.char(mon_chan)) then
	    msg(19:19) = null
	else if(msg(20:20).eq.char(mon_chan)) then
	    msg(20:20) = null
	else
	    write(6,2000)' You are not monitoring that channel'
	    go to 2180
	endif
	go to 30000

16000	continue	!Unscramble
	msg(1:1) = char(scramble)
	msg(43:50) = ' '
	msg(51:51) = char(0)
	go to 30000

17000	continue	!ustat
	msg(1:1)   = char(ustat)
	go to 30000

18000	continue	!Xmit clear, unscramble recieve.
	if(alen.eq.0) then
	    write(6,2000)' You must provide a scramble key'
	    go to 2180
	    endif
	ist=str$upcase(arg(:alen),arg(:alen))
	msg(1:1) = char(scramble)
	msg(43:50) = arg(:alen)
	msg(51:51) = char(3)
	go to 30000

30000	continue		!send a message to the CB manager
	sta = sys$qio(,%val(mbx_chan),%val(write_code),iostatus,,,
	1    %ref(msg),%val(len),,,,)
	if(sta.eq.2264) then
	    wait=wait+1
	    if(wait.gt.10) go to 90000
	    stat=lib$wait(2.0)
	    go to 30000
	else
	    wait=0
	endif
	if (.not. sta) call lib$signal (%val(sta))
	if (.not. iostatus.iostat) call lib$signal(%val(iostatus.iostat))
	go to 2180
c
90000	continue		!unable to fit a message into the mailbox
	write(6,2000)' CB internal error.  exiting CB-Vax.'
	privs(1) = (2**prv$v_oper) + (2**prv$v_prmmbx) +
	1   (2**prv$v_setpri) + (2**prv$v_sysnam)
	privs(2) = 0
	sta2 = sys$creprc(,cbmgr_location,,,,%ref(privs(1)),,
	1   cbmgr_procname,%val(cbmgr_priority),%val((65536*cbmgr_grp)
	2   + cbmgr_mem),,)
	if (sta2 .ne. 1) then
	    write(6,2000)' ??Can''t start CB Manager.'
	    write(6,2000)' Please contact the system manager.'
	    end if
99000	call lib$enable_ctrl(ctrl_mask)
	sta = sys$setrwm(%val(0))
c	call exit
	return
	end

	subroutine parse_cmd(cmdline, command_index, arg)
	implicit integer*4(a - z)
	parameter(maxcmd = 15)
	character*(*)cmdline
	character*32 arg
	character*16 cmdlist(maxcmd), command
	integer*2 cmdlen(maxcmd)
	character*1 space
	data cmdlist/'EXIT', 'HANDLE', 'HELP', 'MONITOR', 'SCRAMBLE',
	1   'SMC', 'SQUELCH', 'STATUS', 'SUMMON', 'TIME', 'TUNE',
	1   'UNMONITOR', 'UNSCRAMBLE', 'USTAT', 'XCL'/
	data cmdlen/1,2,2,1,2,2,2,2,2,2,2,3,3,2,1/

C	Quick case.  If no slash in column 1, this is nothing.
	if (cmdline(1:1) .ne. '/') then
	    command_index = 0
	    return
	    end if

	cmdline = cmdline(2:)
	istat = str$trim(cmdline,cmdline,len)
	clen = str$position(cmdline,' ')
	clen=clen-1
	command = cmdline(1:clen)
	call str$upcase(command, command)
	arg = cmdline(clen+2:)
	do i = 1, maxcmd
	    if (command(:clen) .eq. cmdlist(i)(:clen)) go to 2600
	    end do
2600	continue
	if (i .gt. maxcmd) then
	    write(6, 2000)' %CB-W Invalid CB command; type /HELP for help.'
	else if (cmdlen(i).gt.clen) then
	    write(6,2000)' %CB-W Ambiguous CB command; supply more characters.'
	    i = maxcmd + 1
	end if
	command_index = i
	return
 2000	format(a)
	end
