5 ! digital clock v2
 10 OPTION BASE 0 @ DELAY 0,0 @ A=1

 20 DISP "MEM ALLOC"
 22 DIM B0$[2*10] ! BSETUP
 24 DIM B9$[2*10] ! BRESET
 26 DIM B1$[((4+80)*2)+((4+1)*22*2)] ! frame
 28 DIM B2$[(4+80)*2] ! middle line
 30 DIM B3$[((9+4)*7*6)+((6+4)*7*2)] ! date
 32 DIM B4$[((9+4)*7*6)+((6+4)*7*2)] ! time
 34 DIM F1$(10)[9*7],   F2$(2)[6*7]      ! font arrays
 36 DIM T1$(3)[(9+4)*7],T2$(10)[(9+4)*7] ! {0..2} & {0..9} hours caching
 38 DIM T3$(6)[(9+4)*7],T4$(10)[(9+4)*7] ! {0..5} & {0..9} minutes caching
 40 DIM T5$(6)[(9+4)*7],T6$(10)[(9+4)*7] ! {0..5} & {0..9} seconds caching
 42 DIM P$(4)[(6+4)*7] ! {: : / /} punctuations caching
 44 DIM R(2), C(8) ! row & col positions

 50 DISP "BUILDING CACHE"
 52 B0$="" @ CALL BSETUP(B0$)
 54 B9$="" @ CALL BRESET(B9$)
 56 R(0)= 3 @ R(1)=13 @ W1=10 @ W2=7
 58 C(0)= 3 @ C(1)=13 @ C(2)=23 @ C(3)=30
 60 C(4)=40 @ C(5)=50 @ C(6)=57 @ C(7)=67
 62 CALL LDIGIT(F1$) @ CALL LPUNCT(F2$)
 64 FOR I=0 TO 2 @ T1$(I)="" @ CALL BDIGIT(T1$(I),R(1),C(0),F1$(),I) @ NEXT I
 66 FOR I=0 TO 9 @ T2$(I)="" @ CALL BDIGIT(T2$(I),R(1),C(1),F1$(),I) @ NEXT I
 68 P$(2)="" @ CALL BPUNCT(P$(2),R(1),C(2),F2$(),0)
 70 FOR I=0 TO 5 @ T3$(I)="" @ CALL BDIGIT(T3$(I),R(1),C(3),F1$(),I) @ NEXT I
 72 FOR I=0 TO 9 @ T4$(I)="" @ CALL BDIGIT(T4$(I),R(1),C(4),F1$(),I) @ NEXT I
 74 P$(3)="" @ CALL BPUNCT(P$(3),R(1),C(5),F2$(),0)
 76 FOR I=0 TO 5 @ T5$(I)="" @ CALL BDIGIT(T5$(I),R(1),C(6),F1$(),I) @ NEXT I
 78 FOR I=0 TO 9 @ T6$(I)="" @ CALL BDIGIT(T6$(I),R(1),C(7),F1$(),I) @ NEXT I
 80 B1$="" @ CALL BFRAME(B1$, 1,0,21,79)
 82 B2$="" @ CALL BFRAME(B2$,11,0,11,79)

100 DISP "SHOW CLOCK"
102 CALL ILSEND(B0$,A) @ CALL ILSEND(B1$,A) @ CALL ILSEND(B2$,A)
104 D8$="" @ D9$="" @ T8$="" @ T9$=""
106 D0$=D9$ @ B3$=""
108 CALL BDATE(B3$,F1$(),F2$(),  3,3,W1,W2,D8$,D9$)
110 IF D0$#D8$ THEN CALL ILSEND(B3$,A)
112 T0$=T9$ @ B4$=""
114 ! CALL BTIME(B4$,F1$(),F2$(), 13,3,W1,W2,T8$,T9$)
116 CALL CTIME(B4$,T1$(),T2$(),T3$(),T4$(),T5$(),T6$(),P$(2),P$(3),T8$,T9$)
118 IF T0$#T9$ THEN CALL ILSEND(B4$,A)
120 DISP "20"&D9$&" "&T9$
122 IF LEN(KEY$)=0 THEN GOTO 106

190 DISP "END"
192 CALL ILSEND(B9$,A)
194 PUT "#43"
196 END

450 ! cached-time(buffer,digit-cached-array(6x),punct-cached(2x),current-time,prev-time)
452 SUB CTIME(B$,C1$(),C2$(),C3$(),C4$(),C5$(),C6$(),P1$,P2$,T1$,T2$)
454   L1=LEN(T1$) @ T1$=TIME$
456   L2=LEN(T2$) @ IF L2=0 THEN T2$=T1$
458   IF L1>0 AND T1$=T2$ THEN GOTO 490
460   T1=VAL(T1$[1,1]) @ T2=VAL(T2$[1,1])
462   IF L1=0 OR T1#T2 THEN B$=B$&C1$(T1)
464   T1=VAL(T1$[2,2]) @ T2=VAL(T2$[2,2])
466   IF L1=0 OR T1#T2 THEN B$=B$&C2$(T1)
468   IF L1=0 THEN B$=B$&P1$
470   T1=VAL(T1$[4,4]) @ T2=VAL(T2$[4,4])
472   IF L1=0 OR T1#T2 THEN B$=B$&C3$(T1)
474   T1=VAL(T1$[5,5]) @ T2=VAL(T2$[5,5])
476   IF L1=0 OR T1#T2 THEN B$=B$&C4$(T1)
478   IF L1=0 THEN B$=B$&P2$
480   T1=VAL(T1$[7,7]) @ T2=VAL(T2$[7,7])
482   IF L1=0 OR T1#T2 THEN B$=B$&C5$(T1)
484   T1=VAL(T1$[8,8]) @ T2=VAL(T2$[8,8])
486   IF L1=0 OR T1#T2 THEN B$=B$&C6$(T1)
488   T2$=T1$
490 END SUB

500 ! build-date(buffer,digit-font,punct-font,row,col,d-width,p-width,curr-date,prev-date)
502 SUB BDATE(B$,D$(),P$(),R,C,W1,W2,D1$,D2$)
504   L1=LEN(D1$) @ D1$=DATE$
506   L2=LEN(D2$) @ IF L2=0 THEN D2$=D1$
508   IF L1>0 AND D1$=D2$ THEN GOTO 540
510   D1=VAL(D1$[1,1]) @ D2=VAL(D2$[1,1])
512   W=0    @ IF L1=0 OR D1#D2 THEN CALL BDIGIT(B$,R,C+W,D$(),D1)
514   D1=VAL(D1$[2,2]) @ D2=VAL(D2$[2,2])
516   W=W+W1 @ IF L1=0 OR D1#D2 THEN CALL BDIGIT(B$,R,C+W,D$(),D1)
518   W=W+W1 @ IF L1=0          THEN CALL BPUNCT(B$,R,C+W,P$(), 1)
520   D1=VAL(D1$[4,4]) @ D2=VAL(D2$[4,4])
522   W=W+W2 @ IF L1=0 OR D1#D2 THEN CALL BDIGIT(B$,R,C+W,D$(),D1)
524   D1=VAL(D1$[5,5]) @ D2=VAL(D2$[5,5])
526   W=W+W1 @ IF L1=0 OR D1#D2 THEN CALL BDIGIT(B$,R,C+W,D$(),D1)
528   W=W+W1 @ IF L1=0          THEN CALL BPUNCT(B$,R,C+W,P$(), 1)
530   D1=VAL(D1$[7,7]) @ D2=VAL(D2$[7,7])
532   W=W+W2 @ IF L1=0 OR D1#D2 THEN CALL BDIGIT(B$,R,C+W,D$(),D1)
534   D1=VAL(D1$[8,8]) @ D2=VAL(D2$[8,8])
536   W=W+W1 @ IF L1=0 OR D1#D2 THEN CALL BDIGIT(B$,R,C+W,D$(),D1)
538   D2$=D1$
540 END SUB

550 ! build-time(buffer,digit-font,punct-font,row,col,d-width,p-width,curr-time,prev-time)
552 SUB BTIME(B$,D$(),P$(),R,C,W1,W2,T1$,T2$)
554   L1=LEN(T1$) @ T1$=TIME$
556   L2=LEN(T2$) @ IF L2=0 THEN T2$=T1$
558   IF L1>0 AND T1$=T2$ THEN GOTO 590
560   T1=VAL(T1$[1,1]) @ T2=VAL(T2$[1,1])
562   W=0    @ IF L1=0 OR T1#T2 THEN CALL BDIGIT(B$,R,C+W,D$(),T1)
564   T1=VAL(T1$[2,2]) @ T2=VAL(T2$[2,2])
566   W=W+W1 @ IF L1=0 OR T1#T2 THEN CALL BDIGIT(B$,R,C+W,D$(),T1)
568   W=W+W1 @ IF L1=0          THEN CALL BPUNCT(B$,R,C+W,P$(), 0)
570   T1=VAL(T1$[4,4]) @ T2=VAL(T2$[4,4])
572   W=W+W2 @ IF L1=0 OR T1#T2 THEN CALL BDIGIT(B$,R,C+W,D$(),T1)
574   T1=VAL(T1$[5,5]) @ T2=VAL(T2$[5,5])
576   W=W+W1 @ IF L1=0 OR T1#T2 THEN CALL BDIGIT(B$,R,C+W,D$(),T1)
578   W=W+W1 @ IF L1=0          THEN CALL BPUNCT(B$,R,C+W,P$(), 0)
580   T1=VAL(T1$[7,7]) @ T2=VAL(T2$[7,7])
582   W=W+W2 @ IF L1=0 OR T1#T2 THEN CALL BDIGIT(B$,R,C+W,D$(),T1)
584   T1=VAL(T1$[8,8]) @ T2=VAL(T2$[8,8])
586   W=W+W1 @ IF L1=0 OR T1#T2 THEN CALL BDIGIT(B$,R,C+W,D$(),T1)
588   T2$=T1$
590 END SUB

600 ! build-setup(buffer)
602 SUB BSETUP(B$)
604   B$=B$&CHR$(27)&"E"&CHR$(27)&"<"
606 END SUB

620 ! build-reset(buffer)
622 SUB BRESET(B$)
624   B$=B$&CHR$(27)&"E"
626 END SUB

640 ! build-frame(buffer,top-row,left-col,bottom-row,right-col)
642 SUB BFRAME(B$,R1,C1,R2,C2)
644   DEF FNC$(R,C)=CHR$(27)&"%"&CHR$(C)&CHR$(R)
646   V$=CHR$(124) @ H$="-" @ C$="+"
648   B$=B$&FNC$(R1,C1)
650   B$=B$&C$ @ FOR C=C1+1 TO C2-1 @ B$=B$&H$ @ NEXT C @ B$=B$&C$
652   FOR R=R1+1 TO R2-1
654   B$=B$&FNC$(R,C1)&V$&FNC$(R,C2)&V$
656   NEXT R
658   B$=B$&FNC$(R2,C1)
660   B$=B$&C$ @ FOR C=C1+1 TO C2-1 @ B$=B$&H$ @ NEXT C @ B$=B$&C$
662 END SUB

700 ! build-digit(buffer,top-row,left-col,digit-font-array,digit-index)
702 SUB BDIGIT(B$,R,C,F$(),D)
704   DEF FNC$(R,C)=CHR$(27)&"%"&CHR$(C)&CHR$(R)
706   DEF FND$(F$,L)=F$[L*9+1,L*9+9]
708   FOR I=0 TO 6
710     B$=B$&FNC$(R+I,C)&FND$(F$(D),I)
712   NEXT I
714 END SUB

720 ! build-punct(buffer,top-row,left-col,punct-font-array,punct-index)
722 SUB BPUNCT(B$,R,C,F$(),P)
724   DEF FNC$(R,C)=CHR$(27)&"%"&CHR$(C)&CHR$(R)
726   DEF FNP$(F$,L)=F$[L*6+1,L*6+6]
728   FOR I=0 TO 6
730     B$=B$&FNC$(R+I,C)&FNP$(F$(P),I)
732   NEXT I
734 END SUB

740 ! load-digit-font-array(digit-font-array)
742 SUB LDIGIT(D$())
744   D$(0)="  #####   ##   ## ##     ####     ####     ## ##   ##   #####  " ! 0
746   D$(1)="    ##     ####       ##       ##       ##       ##    ####### " ! 1
748   D$(2)=" ####### ##     ##       ## ####### ##       ##       #########" ! 2
750   D$(3)=" ####### ##     ##       ## #######        ####     ## ####### " ! 3
752   D$(4)="##       ##    ## ##    ## ##    ## #########      ##       ## " ! 4
754   D$(5)="###########       ##       ########        ####     ## ####### " ! 5
756   D$(6)=" ####### ##     ####       ######## ##     ####     ## ####### " ! 6
758   D$(7)="###########    ##      ##      ##      ##       ##       ##    " ! 7
760   D$(8)=" ####### ##     ####     ## ####### ##     ####     ## ####### " ! 8
762   D$(9)=" ####### ##     ####     ## ########       ####     ## ####### " ! 9
764 END SUB

780 ! load-punctuation-font-array(punctuation-font-array)
782 SUB LPUNCT(P$())
784   P$(0)="  ##   ####   ##          ##   ####   ##  " ! :
786   P$(1)="     #    #    #    ##    #    #    #     " ! /
788 END SUB

900 ! hp-il-send(buffer,device-address)
902 SUB ILSEND(B$,A)
904   SEND UNT UNL LISTEN A MTA DATA B$ UNT UNL
906 END SUB