From:	CSBVAX::MRGATE!RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP  3-NOV-1988 03:17
To:	ARISIA::EVERHART
Subj:	vt220 banner program for vaxstations...


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Tue,  1 NOV 88 14:59:05 PDT
Received: from CORNELLC.ccs.cornell.edu by KL.SRI.COM with TCP; Tue, 1 Nov 88 14:30:03 PST
Received: from JHUVMS.BITNET by CORNELLC.ccs.cornell.edu (IBM VM SMTP R1.2) with BSMTP id 6277; Tue, 01 Nov 88 17:32:02 EST
Date:     Tue, 1 Nov 88 17:25 EST
From:     <ECF_STBO%JHUVMS.BITNET@CORNELLC.ccs.cornell.edu>
Subject:  vt220 banner program for vaxstations...
To:       info-vax@kl.sri.com
X-Original-To:  info-vax@kl.sri.com, ECF_STBO

   Here's a program that when run as a detached process,will pick a (supposedly)
random saying out of a hat (well, a file) to be used as the "banner" on vt220
terminal emulator windows.   Sure beats the same old snooze "vt200 Terminal"
every time. Requires SYSNAM privilege (usually not a problem on workstations).

   To use, just create a regular old file of "sayings"; compile and link
the program:
$for change_banner
$for d_dice
$link change_banner,d_dice

   Then run the program (can be put into systartup.com), for example:
$! start up CHB process...
$ass/group disk$chunga:[squid.util]chb.dat chb ! data file location
$run/detached/priv=(nosame,sysnam)/process="ChB" sys_utl:change_banner
$exit
   The logical name CHB is used to locate the file of sayings.

   If you are creating a lot of windows, you might want to increase the
update rate (from the standard 30 secs). You can assign a numeric value
to CHB_UPDATE to change the number of seconds between updates. The file
and CHB_UPDATE are only sampled when the program starts up.


Tom O'Toole
JHUVMS system programmer                         I'm your doctor and
Homewood Computing Facilities                      HERES THE BILL!
Johns Hopkins University
Balto. Md. 21218                                            -DEVO
ecf_stbo@jhuvms.bitnet


$! ...................... Cut between dotted lines and save. ..................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.03 20-Oct-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user ECF_STBO
$! on  1-NOV-1988 16:34:26.34.
$!
$! It contains the following 4 files:
$!        CHANGE_BANNER.FOR
$!        CHB.INC
$!        ITEMLIST.INC
$!        D_DICE.FOR
$!
$!==============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.03 20-Oct-1988 requires VMS V4.4 or higher."
$ EXIT 44
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY

b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) );
s_file_spec := GET_INFO( COMMAND_LINE, "output_file" );SET( OUTPUT_FILE
, b_part, s_file_spec );
b_errors := CREATE_BUFFER( "{Errors}" );i_errors := 0;
pat_beg_1 := ANCHOR & "-+-+-+ Beginning";
pat_beg_2 := LINE_BEGIN & "+-+-+-+ Beginning";
pat_end := ANCHOR & "+-+-+-+-+ End";
pat_trail := " " & LINE_END;POSITION( BEGINNING_OF( b_part ) ); LOOP b
:= SEARCH( pat_trail, FORWARD); EXITIF b=0; POSITION( END_OF( b ) )
; LOOP MOVE_HORIZONTAL( -1 ); EXITIF CURRENT_CHARACTER <> ' '; ERASE_CHARACTER
( 1 ); EXITIF CURRENT_OFFSET=0; ENDLOOP; ENDLOOP; POSITION( BEGINNING_OF
( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE ) = END_OF( b_part )
; s_x := ERASE_CHARACTER( 1 );
  IF s_x = "+" THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <
> 0 THEN
      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF;
  IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN
      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF;
  IF s_x = "V" THEN
    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL( 1 ); ENDIF;
  IF s_x = "X" THEN
    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
( -CURRENT_OFFSET ); ENDIF; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF;
  IF s_x <> "" THEN i_errors := i_errors + 1; s_text := CURRENT_LINE; POSITION
( b_errors );
    COPY_TEXT( "The following line could not be unpacked properly:" )
; SPLIT_LINE; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part )
; MOVE_VERTICAL( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP
  r_x := SEARCH( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x )
; ERASE_CHARACTER( 1 );
  IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) );
  COPY_TEXT( FAO( "The following !UL errors were detected while unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE;
  SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" );ENDIF; EXIT;
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "CHANGE_BANNER.FOR"
$ CHECKSUM_IS = 1630550682
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X! program to change the vt200 banner on a vaxstation at regular intervals...
X! The program reads the file 'chb' to get a list of sayings. Any saying that
X! is larger than nwide chars is truncated! It reads the logical name chb_update
X!  to determine how many seconds between updates. At each update it gets a
X!  saying picked at random from the list and assigns the system/exec name
X! uis$vt_banner to the new name.
X!
X! Tom O'Toole; 12-OCT-1988
X!
X
X`009program change_banner
X
X! declare all
X`009implicit none
X
X! constants...
X`009include 'chb.inc'
X
X! local storage...
X`009character saying*(nwide)
X`009integer nsecs,len_saying,istat
X
X! funs...
X`009integer chb_setname
X
X! initialize list...
X`009call chb_initlist
X
X! find out how long we should wait between updates...
X`009call chb_updatetime(nsecs)
X
X! now loop forever and ever and ever forever
X10`009call chb_getsaying(saying,len_saying)
X`009istat=chb_setname(update_banner,saying(:len_saying))
X`009if(.not.istat) call lib$signal(%val(istat))
X
X`009call bas$sleep(%val(nsecs))
X
X`009goto 10
X
X`009end
X
X
X! routine to manage the list of sayings
X`009subroutine chb_initlist
X
X! declare all...
X`009implicit none
X
X! params...
X`009include 'chb.inc'
X
X! args (for chb_getsaying entry point)...
X`009character saying*(nwide)
X`009integer len_saying
X
X! functions...
X`009integer d_dice
X
X! storage...
X`009character*(nwide) list(maxlist),inrec
X`009integer len_list(maxlist),n,il,i,nc
X
X! first read in the whole list into VM (why not?)
X`009open(unit=27,file='chb',readonly,status='old')
X`009n=0
X`009do il=1,maxlist
X1`009`009format(q,a)
X`009`009read(27,1,end=19)nc,inrec
X`009`009n=n+1
X`009`009len_list(n)=nc
X`009`009list(n)=inrec
X`009enddo
X
X19`009continue
X`009close(unit=27)
X
X! end initialization...
X`009return
X
X`009entry chb_getsaying(saying,len_saying)
X
X! trow dat die...
X`009i=d_dice(n)
X
X! and get the saying...
X`009saying=list(i)
X`009len_saying=len_list(i)
X
X! oo
X`009return
X
X`009end
X
X! routine to get number of secs between updates...
X`009subroutine chb_updatetime(nsecs)
X
X! declare all
X`009implicit none
X
X! args...
X`009integer nsecs
X
X! params...
X`009include '($ssdef)'
X`009include 'chb.inc'
X
X! functions
X`009integer translog
X
X! local...
X`009character*64 nambuf
X`009integer len_name,istat
X
X! translate update_name
X`009istat=translog(update_name,nambuf,len_name)
X`009if(istat.eq.ss$_nolognam) then
X`009`009nsecs=defupdate
X`009elseif(.not.istat) then
X`009`009call lib$signal(%val(istat))
X`009else
X!        decode into integer...
X`009`009read(nambuf(:len_name),*,err=99)nsecs
X`009endif
X
X`009return
X
X99`009write(6,*)'  CHB_UPDATETIME barfed on your assignment of ',
X`0091`009update_name
X`009call exit
X
X`009end
X
X
X! routine to set the name banner_name, system table exec mode (requires sysnam)
X`009integer function chb_setname(name,saying)
X
X! declare all...
X`009implicit none
X
X! stuff for lnm services
X`009include 'itemlist.inc'
X`009include '($ssdef)'
X`009include '($lnmdef)'
X`009include '($psldef)' ! for access modes...
X`009integer sys$crelnm
X
X
X! params, these could be played with to get different tables/acmodes...
X`009character*(*) lnm_srch
X`009parameter (lnm_srch='LNM$SYSTEM_TABLE') ! (system table)
X`009integer acmode
X`009parameter (acmode=psl$c_exec) ! exec mode name...
X
X
X
X! args...
X`009character*(*) name
X`009character*(*) saying
X
X! local data...
X`009record /itmlst/ lnmlst(2)
X
X! set up data structures...
X`009lnmlst(1).buflen=len(saying)
X`009lnmlst(1).code=lnm$_string
X`009lnmlst(1).bufadr=%loc(saying)
X`009lnmlst(2).end_list=0
X`009
X! do the call, create the name...
X`009chb_setname=sys$crelnm(,lnm_srch,name,acmode,lnmlst)
X`009return
X
X`009end`009
X
X
X! read the translation of a name...
X`009integer function translog(name,nambuf,len_name)
X
X
X! declare all...
X`009implicit none
X
X! stuff for lnm services
X`009include 'itemlist.inc'
X`009include '($ssdef)'
X`009include '($lnmdef)'
X`009integer sys$trnlnm
X
X
X! params, these could be played with to get different tables/acmodes...
X`009character*(*) lnm_srch
X`009parameter (lnm_srch='LNM$FILE_DEV') ! (process,group,job,system)
X
X
X
X! args...
X`009character*(*) name
X`009character*(*) nambuf
X`009integer len_name
X
X! local data...
X`009record /itmlst/ lnmlst(2)
X
X! set up data structures...
X`009lnmlst(1).buflen=len(nambuf)
X`009lnmlst(1).code=lnm$_string
X`009lnmlst(1).bufadr=%loc(nambuf)
X`009lnmlst(1).retlenadr=%loc(len_name)
X`009lnmlst(2).end_list=0
X`009
X! do the call, translate the name...
X`009translog=sys$trnlnm(,lnm_srch,name,,lnmlst)
X`009return
X
X`009end
$ GOSUB UNPACK_FILE
$ FILE_IS = "CHB.INC"
$ CHECKSUM_IS = 1109352496
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X! compile time constants for Change_banner program...
X
X`009integer nwide
X`009integer maxlist
X`009integer defupdate
X`009character*(*) update_name
X`009character*(*) update_banner
X
X`009parameter (nwide=72)
X`009parameter (maxlist=500)
X`009parameter (defupdate=60)
X`009parameter (update_name='CHB_UPDATE')
X`009parameter (update_banner='UIS$VT_BANNER')
X
$ GOSUB UNPACK_FILE
$ FILE_IS = "ITEMLIST.INC"
$ CHECKSUM_IS = 1467165035
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X! Standard itemlist declaration for use in VMS system services.
X
X`009structure /itmlst/
X`009union
X`009`009map
X`009`009`009integer*2 buflen
X`009`009`009integer*2 code
X`009`009`009integer*4 bufadr
X`009`009`009integer*4 retlenadr
X`009`009endmap
X`009`009map
X`009`009`009integer*4 end_list
X`009`009endmap
X`009endunion
X`009endstructure
X
$ GOSUB UNPACK_FILE
$ FILE_IS = "D_DICE.FOR"
$ CHECKSUM_IS = 1680435120
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X! throws an n-sided dice...
X`009integer function d_dice(n)
X
X! declare all...
X`009implicit none
X
X!  args...
X`009integer n ! n-sided dice...
X
X! local vars...
X`009real secs,rv
X`009integer nsecs,seed
X`009logical first
X`009data first /.true./
X
X! get a good seed on the first time throo`032
X`009if(first) then
X`009`009secs=secnds(0.0) ! gives # of seconds since midnight
X`009`009nsecs=secs*100
X`009`009seed=nsecs*2+1`032
X`009`009if(seed.lt.1000) seed=seed+1000 ! we have a "large" odd number
X`009`009first=.false.
X`009endif
X
X! trow dat die...
X`009d_dice=int(ran(seed)*n)+1
X
X`009return
X`009end
$ GOSUB UNPACK_FILE
$ EXIT

