program CKDEMO C C This program demonstrates the use of the CK handler. It produces C a running date/time display on a VT100-compatible terminal. The C program terminates when you press the RETURN key. C C William K. Walker C C RDB/Alpha Systems C 740 Alpha Rd., Box 149 C Alpha, OH 45301 C C (513) 426-7094/426-0344 C C CompuServe: Bill Walker 71066,24 C EasyLink: 62752448 (or Telex 62752448 ESL UD) C MCI Mail: 333-1675 / RDBALPHA (or Telex 6503331675 MCI UW) C byte S(24), B(512), H(3), DH(7) data H/"033,'[','H'/ data DH/"033,'#','3',"012,"033,'#','4'/ C C Open a channel to the clock C open(unit=10, name='CK:', access='DIRECT', recordsize=128) C C Do some initialization... C NREC=1 !1st record for direct access call clrvt !Home cursor, clear screen call cursor(0) !Kill cursor (if VT200) type 1700, DH, H !Set top double height/width call ipoke("44,"10100.or.IPEEK("44)) !TT: in special mode call rctrlo !Zap any control-O's C C Look for a character from console; quit if we see one... C 10 if(ittinr()) 15, 15, 12 12 if(ittinr().gt.0) go to 12 call clrvt call cursor(1) call exit C C Read clock registers C 15 read(10'NREC) B NREC=NREC+1 if(NREC.gt.255) NREC=1 C C Convert to ASCII and print the result C call clokdt(B,S) type 1701, S, S, H C C Do a beep or two if due then go wait for a new time C II=B(5) JJ=B(3) KK=B(1) call tchek(II,JJ,KK) go to 10 C C Formats C 1700 format('+',10A1,$) 1701 format('+',7X,24A1/' ',7X,27A1,$) end subroutine clokdt(B,STRING) C C Routine to convert register values to an ASCII date/time string C C B is a byte array containing the clock register values C C STRING is the resulting ASCII C byte B(1), STRING(1), S(25), BB(4) real WWW(7), MMM(12), RR equivalence (BB,RR) data WWW/'Sun ','Mon ','Tue ','Wed ','Thu ','Fri ','Sat '/ data MMM/'Jan-','Feb-','Mar-','Apr-','May-','Jun-','Jul-', 1 'Aug-','Sep-','Oct-','Nov-','Dec-'/ call scopy('www dd-mmm-yy hh:mm:ss',S) I=B(7) RR=WWW(I) do 10 I=1,3 10 S(I)=BB(I) I=B(9) RR=MMM(I) II=0 do 20 I=9,11 II=II+1 20 S(I)=BB(II) I=B(5) call enci1(I,S(17)) I=B(3) call enci1(I,S(20)) I=B(1) call enci1(I,S(23)) I=B(8) call enci1(I,S(6)) I=B(10) call enci1(I,S(13)) do 30 I=1,24 30 STRING(I)=S(I) return end subroutine enci1(NUMBER,STRING) C C Encode an integer value as a two-character ASCII string with a C leading zero (if necessary). C C NUMBER is the value to encode C C STRING is the array to receive the ASCII string C byte STRING(2), B(3) encode(3,1001,B,err=10) NUMBER+100 STRING(1)=B(2) STRING(2)=B(3) return 10 STRING(1)='*' STRING(2)='*' return 1001 format(I3) end subroutine clrvt C C Clear the screen on a VT100 C byte ZAP(7) data ZAP/"033,'[','H', 1 "033,'[','J',"200/ call print(ZAP) return end subroutine cursor(NSWICH) C C Turn the cursor off (NSWICH=0) or on (NSWICH not 0) for a C VT200 series terminal C byte ON(7), OFF(7) data ON/"033,'[','?','2','5','h',"200/ data OFF/"033,'[','?','2','5','l',"200/ if(NSWICH.eq.0) call print(OFF) if(NSWICH.ne.0) call print(ON) return end subroutine tchek(IH,IM,IS) C C This routine beeps once on the half hour and twice on the C hour. C C IH,IM,IS are the hour, minute, and second C byte BEL data BEL/007/ if((IM.ne.0).and.(IM.ne.30).or.(IS.gt.0)) return type 1701, BEL if(IM.eq.0) type 1701, BEL N=2 return 1701 format('+',A1,$) end