Path: utzoo!attcan!uunet!lll-winken!lll-tis!helios.ee.lbl.gov!pasteur!ucbvax!TOR.NTA.NO!dahls%vax.elab.unit.uninett
From: dahls%vax.elab.unit.uninett@TOR.NTA.NO (J|rn Yngve Dahl-Stamnes)
Newsgroups: comp.os.vms
Subject: clock program
Message-ID: <128*dahls@vax.elab.unit.uninett>
Date: 27 May 88 15:51:00 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Organization: The Internet
Lines: 229


                ** YACP = Yet Another Clock Program. **

This clock program work only on VT330/VT340 terminals (may be modified to
work on other terminals). It use the status line to display the current
date and time. 

  +-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+
  ! The University of Trondheim           ! Joern Yngve Dahl-Stamnes  !
  ! The Norwegian Institute of Technology ! System Manager            !
  ! Division of Physical Electronics      !                           !
  ! N 7034 Trondheim, Norway              !                           !
  !---------------------------------------+---------------------------!
  !             dahls%vax.elab.unit.uninett@tor.nta.no                !
  !------->>>>>>>>  "t'nia stnatsnoc ,t'now selbairaV"  <<<<<<<<------!
  +-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+

$!...................... Cut on the dotted line and save ......................
$! VAX/VMS archive file created by VMS_SHAR V-5.04 04-Feb-1988
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by DAHLS
$! on Friday 27-MAY-1988 16:42:41.50
$!
$! It contains the following 2 files:
$! CLOCK300.FOR CLOCK300.COM
$!=============================================================================
$Set Symbol/Scope=(NoLocal,NoGlobal)
$Version=F$GetSYI("VERSION")
$If Version.ges."V4.4" then goto Version_OK
$Write SYS$Output "Sorry, you are running VMS ",Version, -
", but this procedure requires V4.4 or higher."
$Exit 44
$Version_OK:CR[0,8]=13
$Pass_or_Failed="failed!,passed."
$Goto Start
$Convert_File:
$Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1:Define/User_Mode SYS$Output NL:
$Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$Delete VMS_SHAR_DUMMY.DUMMY;*
$Checksum 'File_is
$Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2:Return
$Start:
$File_is="CLOCK300.FOR"
$Check_Sum_is=1233007583
$Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
XCASE- TAB-F PROG+ WHEN 880527 16:42:09  ; VER  20;
X      options     /extend_source
X      program     vt300_clock
X!
X! This program display the current date and time on the 25. line
X! (status line) on the VT330/VT340 terminal.
X!
X! To start this program from DCL, use the com-file CLOCK300.COM
X!
X      implicit none
X
X      include     '($iodef)/nolist'
X      include     '($ssdef)/nolist'
X      include     '($lnmdef)/nolist'
X
X      external    sys$asctim, sys$assign, sys$canwak, sys$dassgn, sys$qiow, 
X     &            sys$bintim, sys$schdwk, sys$hiber, sys$trnlnm
X
X      integer*4   sys$asctim, sys$assign, sys$canwak, sys$dassgn, sys$qiow, 
X     &            sys$bintim, sys$schdwk, sys$hiber, sys$trnlnm
X
X      structure   /itmlst/
X          union
X              map
X                  integer*2   buflen, itmcod
X                  integer*4   bufadr, retlen
X              end map
X              map
X                  integer*4   end_list
X              end map
X          end union
X      end structure
X
X      record  /itmlst/    lnm_list(2)
X
X      character*23    time
X      character*16    delta
X      character*10    flag_str
X
X      integer*4       flag_len, func, status
X      integer*2       chan
X
X      logical*4       flag_on, flag_wait
X      byte            buff (37), sb1 (8), sb2 (6)
X      byte            dtime (8), hostw (5)
X
X      equivalence     (buff(1),sb1(1))
X      equivalence     (buff(9),time)
X      equivalence     (buff(32),sb2(1))
X
X      data    hostw   / 27,91,50,36,126 /
X      data    sb1     / 27,91,49,36,125,9,9,9 /
X      data    sb2     / 13,27,91,48,36,125 /
X!
X! Modify the delta time (if you want).
X!
X      data    delta   / '0000 00:00:05.00' /
X!
X! Get the terminal IO channel.
X!
X      status = sys$assign (%descr('SYS$OUTPUT'),%ref(chan),,)
X      if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X!
X! Convert wakeup time to binary time.
X!
X      status = sys$bintim (%descr(delta),%ref(dtime))
X      if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X!
X! Enable host-writable status line on the VT330/VT340 terminal.
X!
X      func = io$_writevblk .or. io$m_noformat
X      status = sys$qiow (,%val(chan),%val(func),,,,%ref(hostw),%val(5),,,,)
X      if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X!
X! Set schedule wakeup time with repeat.
X!
X      status = sys$schdwk (,,%ref(dtime),%ref(dtime))
X      if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X!
X! Define item list for $TRNLNM.
X!
X      lnm_list(1).buflen = 10
X      lnm_list(1).itmcod = lnm$_string
X      lnm_list(1).bufadr = %loc(flag_str)
X      lnm_list(1).retlen = %loc(flag_len)
X      lnm_list(2).end_list = 0
X!
X! The_almost_never_ending_loop.
X!
X      flag_on = .true.
X      flag_wait = .false.
X      do while ( flag_on )
X!
X! Get the current time.
X!
X          status = sys$asctim (,%descr(time),,)
X!
X! Put the time buffer to the status line (if not in wait state).
X!
X          if ( .not. flag_wait )
X     &        status = sys$qiow (,%val(chan),%val(func),,,,
X     &        %ref(buff),%val(37),,,,)
X!
X! Hibernate.
X!
X          status = sys$hiber ()
X!
X! Check flag status.
X!
X          status = sys$trnlnm (,%descr('LNM$JOB'),%descr('CLOCK_FLAG'),
X     &        ,%ref(lnm_list))
X          flag_wait = flag_str(1:4) .eq. 'WAIT'
X          flag_on = flag_str(1:2) .eq. 'ON' .or. flag_wait
X      enddo
X!
X! Cancel schedule wakeup time.
X!
X      status = sys$canwak (,,)
X      if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X!
X! Change to status line on the VT300 terminal.
X!
X      hostw(3) = 49
X      status = sys$qiow (,%val(chan),%val(func),,,,%ref(hostw),%val(5),,,,)
X      if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X!
X! Deassign IO channel.
X!
X      status = sys$dassgn (%val(chan))
X      if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X!
X! Los Endos...
X!
X      end
$GoSub Convert_File
$File_is="CLOCK300.COM"
$Check_Sum_is=373247803
$Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$
X$! Command file to start/stop the CLOCK300 program
X$
X$ if P1 .eqs. "" then exit
X$ FLAG = f$logical("CLOCK_FLAG")
X$ P1 = f$extract(0,1,P1)
X$ if P1 .eqs. "1" then goto START
X$ if P1 .eqs. "0" then goto STOP
X$ if P1 .eqs. "W" then goto WAIT
X$ write sys$output " USE 1=start, 0=stop, W=wait"
X$ exit
X$
X$STOP:
X$ define/job/nolog clock_flag off
X$ exit
X$
X$START:
X$ if FLAG .eqs. "ON" then exit
X$ if FLAG .eqs. "WAIT" then goto NOWAIT
X$ define/job/nolog clock_flag on
X$ spawn/nowait/input=nl:/process=clock run cs$util:clock300
X$ exit
X$
X$WAIT:
X$ define/job/nolog clock_flag wait
X$ exit
X$
X$NOWAIT:
X$ define/job/nolog clock_flag on
X$ exit
$GoSub Convert_File
$Exit