*** IBMCLOCK.prg
*
* (c) CTS, MRI 1991
*
private tl,tp,tr,bt,bl,br,lf,rt,li,ri,TM,mESCA,mCURS,mTALK,mFIX,TMALL
DECL TM[11,3], TMALL[3]
mESCA=SET('ESCA')='ON'
mCURS=SET('CURS')='ON'
mTALK=SET('TALK')='ON'
mFIX=.F.
SET TALK OFF
SET ESCA OFF
SET CURS OFF
*=-
*    If this was called by an ON KEY LABEL Command, you must
*    deactivate the ON KEY LABEL by un-remarking the following
*    line and enter the calling key name at the end of the line
*
   ON KEY LABEL F2
   ON KEY LABEL CTRL-T DO TOGLTIME
*=-
IF TYPE('X')#'N' .OR. TYPE('Y')#'N' .OR. X>19 .OR. Y>39
  IF TYPE('X')#"U" .OR. TYPE('Y')#"U"
    x1=X
    y1=Y
    mFIX=.T.
  ENDIF
  X=1
  Y=1
ENDIF
DEFINE WINDOW CLOCK FROM X,Y TO X+5,Y+30 DOUBLE COLOR W+/N,,GR+/R
ACTI WIND CLOCK
DO IBMCHRS
*=-
DO WHILE .T.
  XTIME=IIF(SET('HOUR')=24,TIME(),IIF(VAL(LEFT(TIME(),2))>12,;
        STR(VAL(LEFT(TIME(),2))-12,2)+SUBS(TIME(),3,6),TIME()))
  HR1=VAL(LEFT(XTIME,1))+1
  HR2=VAL(SUBS(XTIME,2,1))+1
  MN1=VAL(SUBS(XTIME,4,1))+1
  MN2=VAL(SUBS(XTIME,5,1))+1
  SC1=VAL(SUBS(XTIME,7,1))+1
  SC2=VAL(SUBS(XTIME,8,1))+1
  TMALL[1]=TM[HR1,1]+" "+TM[HR2,1]+TM[11,1]+TM[MN1,1]+" "+TM[MN2,1]+TM[11,1]+TM[SC1,1]+" "+TM[SC2,1]
  TMALL[2]=TM[HR1,2]+" "+TM[HR2,2]+TM[11,2]+TM[MN1,2]+" "+TM[MN2,2]+TM[11,2]+TM[SC1,2]+" "+TM[SC2,2]
  TMALL[3]=TM[HR1,3]+" "+TM[HR2,3]+TM[11,3]+TM[MN1,3]+" "+TM[MN2,3]+TM[11,3]+TM[SC1,3]+" "+TM[SC2,3]
  @0,1 SAY TMALL[1]
  @1,1 SAY TMALL[2]
  @2,1 SAY TMALL[3]
  @3,20 SAY IIF(SET('HOUR')=24,'Military',"    "+IIF(VAL(LEFT(TIME(),2))>12,"P","A")+".M.")
  I=INKEY()
  IF I=27
    EXIT
  ENDIF
ENDDO
RELE WIND CLOCK
IF mCURS
  SET CURS ON
ENDIF
IF mESCA
  SET ESCA ON
ENDIF
IF mTALK
  SET TALK ON
ENDIF
IF mFIX
  X=x1
  Y=y1
ENDIF
*=-
*    If this was called by an ON KEY LABEL Command, you must
*    Reactivate the ON KEY LABEL by un-remarking the following
*    line and enter the calling key name after LABEL and before
*    the DO CALENDAR part of the command
*
  ON KEY LABEL F2 DO CLOCKIT
  ON KEY LABEL CTRL-T
*=-
RETURN
*** End of IBMCLOCK.prg
*
*=-    Procedures & Functions follow
*
PROC TOGLTIME
ON KEY LABEL F5
IF SET('HOUR')=12
  SET HOUR TO 24
ELSE
  SET HOUR TO 12
ENDIF
ON KEY LABEL F5 DO TOGLTIME
RETURN
*
PROC IBMCHRS
tl=chr(201)
tr=chr(187)
bl=chr(200)
br=chr(188)
store chr(205) to tp,bt,mi
store chr(186) to lf,rt
li=chr(204)
ri=chr(185)
tn=chr(210)
bn=chr(208)
bx=CHR(220)
mt=' '
*
tm[1,1]=tl+tp+tr
tm[1,2]=lf+mt+rt
tm[1,3]=bl+bt+br
tm[2,1]=mt+mt+tn
tm[2,2]=mt+mt+lf
tm[2,3]=mt+mt+bn
tm[3,1]=tp+tp+tr
tm[3,2]=tl+mi+br
tm[3,3]=bl+mi+mi
tm[4,1]=tp+tp+tr
tm[4,2]=mt+mi+ri
tm[4,3]=bt+bt+br
tm[5,1]=tn+mt+tn
tm[5,2]=bl+mi+ri
tm[5,3]=mt+mt+bn
tm[6,1]=tl+tp+tp
tm[6,2]=bl+mi+tr
tm[6,3]=bt+bt+br
tm[7,1]=tl+tp+tp
tm[7,2]=li+mi+tr
tm[7,3]=bl+bt+br
tm[8,1]=tp+tp+tr
tm[8,2]=mt+mt+rt
tm[8,3]=mt+mt+bn
tm[9,1]=tl+tp+tr
tm[9,2]=li+mi+ri
tm[9,3]=bl+mi+br
tm[10,1]=tl+mi+tr
tm[10,2]=bl+mi+ri
tm[10,3]=mi+mi+br
TM[11,1]=MT+BX+MT
TM[11,2]=MT+BX+MT
TM[11,3]=MT+MT+MT

RETURN
*=- End of PROCEDURES
*