MODULE CLOCK;
FROM FASTO IMPORT WRITEAT;
FROM MAINREAD IMPORT BLANK;
FROM STDIO IMPORT GETKEY,CLS,GOTOXY,GETXY,RDSTR,WRCHAR,WRSTR,WAITKEY;
FROM NUMIO IMPORT WRCARD,WRCARD0,STRTOCARD,SUBSTRTOCARD;
FROM GRAPH1 IMPORT LINETO,PLOT,SETMODE;
FROM GRAPH2 IMPORT CIRCLE;
FROM SYMBOL IMPORT SYMBOL1;
FROM R3MATH IMPORT SIN,COS;
FROM HARDWARE IMPORT LOCK,UNLOCK,IM1,KEYSCAN;
FROM SYSTEM IMPORT WORD,NEWPROCESS,TRANSFER,IOTRANSFER,ADDRESS,ADR;
 
CONST ERRSTR='Error in input - please retry';
 
(***** general date & time *****)
TYPE 
  daytype=(sun,mon,tue,wed,thu,fri,sat);
  monthtype=(jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec);
  TIME=RECORD 
    hours:[0..23];
    minutes:[0..59] ;
    ticks,seconds:CARDINAL END;
  DATE=RECORD 
    Year:CARDINAL;
    month:monthtype;
    monthlen:[28..31];
    DD:[1..31] END;

PROCEDURE leapyear(Y:CARDINAL):BOOLEAN;
BEGIN
IF Y MOD 100=0 THEN RETURN Y MOD 400=0
 ELSE RETURN Y MOD 4=0 END
END leapyear;

PROCEDURE setmonthlen(VAR d:DATE);
BEGIN WITH d DO CASE month OF
sep,apr,jun,nov:monthlen:=30|
feb:IF leapyear(Year) THEN monthlen:=29
     ELSE monthlen:=28 END|
ELSE monthlen:=31
END END END setmonthlen;

PROCEDURE InputTime(VAR t:TIME);
VAR S:ARRAY [0..7] OF CHAR;
    SX,SY,P:CARDINAL;
    OK:BOOLEAN;
BEGIN WITH t DO LOOP
GETXY(SX,SY);RDSTR(S);
P:=0;OK:=TRUE;
hours:=SUBSTRTOCARD(S,P,OK);INC(P);
minutes:=SUBSTRTOCARD(S,P,OK);INC(P);
seconds:=SUBSTRTOCARD(S,P,OK);
IF OK AND (hours<24) AND (minutes<60) AND (seconds<60) THEN
  ticks:=0;EXIT END;
WRITEAT(1,22,ERRSTR);
BLANK(SX,SY,8);
END END END InputTime;

PROCEDURE InputDate(VAR d:DATE);
VAR S:ARRAY [0..9] OF CHAR;
    P,SX,SY,M:CARDINAL;
    OK:BOOLEAN;
BEGIN WITH d DO LOOP
GETXY(SX,SY);
RDSTR(S);P:=0;OK:=TRUE;
DD:=SUBSTRTOCARD(S,P,OK);INC(P);
M:=SUBSTRTOCARD(S,P,OK);INC(P);
Year:=SUBSTRTOCARD(S,P,OK);INC(P);
IF OK AND (M>=1) AND (M<=12) THEN
  IF Year<40 THEN Year:=2000+Year
   ELSIF Year<100 THEN Year:=1900+Year END;
  month:=VAL(monthtype,M-1);
  setmonthlen(d);
  IF (DD>=1) AND (DD<=monthlen) THEN
    EXIT END END;
WRITEAT(1,22,ERRSTR);
BLANK(SX,SY,10)
END END END InputDate;

PROCEDURE WriteTime(t:TIME);
BEGIN WITH t DO
WRCARD(hours,2);WRCHAR(':');
WRCARD0(minutes,2);WRCHAR(':');
WRCARD0(seconds,2)
END END WriteTime;

PROCEDURE WriteDD(DD:SHORTCARD);
BEGIN
WRCARD(DD,1);
CASE DD OF
 1,21,31:WRSTR('st')|
 2,22:WRSTR('nd')|
 3,23:WRSTR('rd')|
 ELSE WRSTR('th') END
END WriteDD;
 
PROCEDURE WriteDay(day:daytype);
BEGIN CASE day OF
mon:WRSTR('Monday')|
tue:WRSTR('Tuesday')|
wed:WRSTR('Wednesday')|
thu:WRSTR('Thursday')|
fri:WRSTR('Friday')|
sat:WRSTR('Saturday')|
sun:WRSTR('Sunday')
END END WriteDay;

PROCEDURE WriteMonth(month:monthtype);
BEGIN CASE month OF
jan:WRSTR('January')|
feb:WRSTR('february')|
mar:WRSTR('March')|
apr:WRSTR('April')|
may:WRSTR('May')|
jun:WRSTR('June')|
jul:WRSTR('July')|
aug:WRSTR('August')|
sep:WRSTR('September')|
oct:WRSTR('October')|
nov:WRSTR('November')|
dec:WRSTR('December')
END END WriteMonth;
 
(***** Current date/time *****)
VAR CurrentTime:TIME;
    CurrentDate:DATE;
    clockon:BOOLEAN;
CONST len=250;
VAR main,intr:ADDRESS;
    wsp:ARRAY [1..len] OF CHAR;
VAR MM,YY:SHORTCARD;
PROCEDURE setmmyy;
BEGIN WITH CurrentDate DO
YY:=Year MOD 100;MM:=ORD(month)+1;
END END setmmyy;
 
PROCEDURE InputCurrent;
BEGIN
WRITEAT(2,2,'CURRENT TIME/DATE INPUT');
WRITEAT(2,4,'Enter Current date');
WRITEAT(2,5,'(DD/MM/YY)');
GOTOXY(3,6);InputDate(CurrentDate);setmmyy;
WRITEAT(2,10,'Enter current time');
WRITEAT(2,11,'(HH:MM:SS)');
IM1;
NEWPROCESS(TIMER,ADR(wsp),len,intr);
GOTOXY(3,12);InputTime(CurrentTime);
TRANSFER(main,intr);
END InputCurrent;

(***** Interrupt Routine *****)
PROCEDURE TIMER;
 
PROCEDURE nextday;
BEGIN WITH CurrentDate DO
IF DD<monthlen THEN INC(DD)
 ELSE DD:=1;
  IF month<>dec THEN INC(month);
    setmonthlen(CurrentDate);
   ELSE INC(Year);
    month:=jan END;
  setmmyy END;
END END nextday;

VAR OK:BOOLEAN;
BEGIN WITH CurrentTime DO LOOP
IOTRANSFER(intr,main);
KEYSCAN;
IF ticks<>49 THEN 
  INC(ticks) 
 ELSE
  ticks:=0;OK:=TRUE;
  IF seconds<>59 THEN 
    INC(seconds)
   ELSE seconds:=0;
    IF minutes<>59 THEN 
      INC(minutes)
     ELSE minutes:=0;
      IF hours<>23 THEN 
        INC(hours)
       ELSE hours:=0;
        nextday END END END END 
END END END TIMER;

(***** Display *****)
VAR facenum:ARRAY [1..12],[0..4] OF CHAR;
PROCEDURE initfacenum;
PROCEDURE hexto(S:ARRAY OF CHAR;VAR sym:ARRAY OF CHAR);
 
VAR i,m,n:SHORTCARD;
BEGIN
m:=0;
FOR i:=0 TO HIGH(S) DO
  n:=ORD(S[i])-ORD('0');
  IF n>=17 THEN DEC(n,7) END;
  m:=16*m+n;
  IF ODD(i) THEN
    sym[i DIV 2]:=CHR(m);
    m:=0 END END;
END hexto;
 
BEGIN
hexto('180808081C',facenum[1]);
hexto('380418203C',facenum[2]);
hexto('1824082418',facenum[3]);
hexto('0C14243E04',facenum[4]);
hexto('3820380438',facenum[5]);
hexto('1820382418',facenum[6]);
hexto('3C04081010',facenum[7]);
hexto('1824182418',facenum[8]);
hexto('18241C0418',facenum[9]);
hexto('C6494949E6',facenum[10]);
hexto('CC444444EE',facenum[11]);
hexto('CE414648EF',facenum[12]);
END initfacenum;
  
PROCEDURE Display;
CONST cx=128;cy=112;
VAR sx,sy,sx0,sy0:INTEGER;
    time:TIME;

PROCEDURE transtime;
BEGIN LOCK;time:=CurrentTime;UNLOCK END transtime;

CONST pi=RL3(3.14159);
VAR sec,min:REAL3;
PROCEDURE secondhand;
VAR secangle:REAL3;
CONST sr=RL3(60);
BEGIN
sec:=RL3(time.seconds)+RL3(time.ticks)/RL3(50);
secangle:=pi*sec/RL3(30);
sx:=cx+INT(sr*SIN(secangle));sy:=cy+INT(sr*COS(secangle));
END secondhand;

TYPE coords=RECORD x,y:INTEGER END;
PROCEDURE drawhand(h,hp:coords);
BEGIN
PLOT(cx+h.x,cy+h.y);LINETO(cx+hp.x,cy+hp.y);
LINETO(cx-hp.x,cy-hp.y);LINETO(cx+h.x,cy+h.y);
END drawhand;
VAR m,mp,h,hp:coords;
PROCEDURE minutehand;
VAR minangle,mcos,msin:REAL3;
CONST rm=RL3(50);wm=RL3(5);
BEGIN
min:=RL3(time.minutes)+sec/RL3(60);
minangle:=pi*min/RL3(30);
mcos:=COS(minangle);msin:=SIN(minangle);
m.x:=INT(rm*msin);m.y:=INT(rm*mcos);
mp.x:=INT(wm*mcos);mp.y:=-INT(wm*msin);
drawhand(m,mp);
END minutehand;

PROCEDURE hourhand;
CONST rh=RL3(40);wh=RL3(8);
VAR hrs,hrangle,hcos,hsin:REAL3;
BEGIN
hrs:=RL3(time.hours)+min/RL3(60);
hrangle:=pi*hrs/RL3(6);
hcos:=COS(hrangle);hsin:=SIN(hrangle);
h.x:=INT(rh*hsin);h.y:=INT(rh*hcos);
hp.x:=INT(wh*hcos);hp.y:=-INT(wh*hsin);
drawhand(h,hp);
END hourhand;

PROCEDURE Setface;
CONST irad=79;rad=RL3(irad-5);
VAR i:CARDINAL;
    ang:REAL3;
BEGIN
CLS;
transtime;
SETMODE(1);
CIRCLE(cx,cy,irad);
FOR i:=1 TO 12 DO
  ang:=RL3(i)*(pi/RL3(6));
  SYMBOL1(cx+INT(rad*SIN(ang)),cy+INT(rad*COS(ang)),facenum[i],1) END;
SETMODE(2);
secondhand;
PLOT(cx,cy);LINETO(sx,sy);
minutehand;
hourhand;
WITH time DO 
  osec5:=seconds DIV 5;
  omin5:=minutes DIV 5;
  ohr12:=hours DIV 12 END;
END Setface;

VAR retime:TIME;redate:DATE;
PROCEDURE recalc;
BEGIN
transtime;retime:=time;
LOCK;redate:=CurrentDate;UNLOCK;
GOTOXY(0,20);
IF retime.hours<12 THEN WRSTR('AM') ELSE WRSTR('PM') END;
(*WriteDay(jd.dayofweek);*)WRCHAR(' ');
WITH redate DO
  WriteDD(DD);WRCHAR(' ');
  WriteMonth(month);
  WRCARD(Year,5) END;
END recalc;
VAR sec5,osec5,min5,omin5,hr12,ohr12:CARDINAL;
m0,mp0,h0,hp0:coords;
BEGIN
Setface;
recalc;
WRITEAT(0,23,'Press EDIT to exit');
REPEAT
  transtime;
  sx0:=sx;sy0:=sy;
  secondhand;
  IF (sx<>sx0) OR (sy<>sy0) THEN
    PLOT(cx,cy);LINETO(sx,sy);
    PLOT(cx,cy);LINETO(sx0,sy0) END;
  (* Update minute hand every 5 seconds *)
  sec5:=time.seconds DIV 5;
  IF sec5<>osec5 THEN
    osec5:=sec5;
    m0:=m;mp0:=mp;
    minutehand;
    drawhand(m0,mp0);
    (* update hour hand every 5 minutes *)
    min5:=time.minutes DIV 5;
    IF min5<>omin5 THEN
      omin5:=min5;
      h0:=h;hp0:=hp;
      hourhand;
      drawhand(h0,hp0);
      hr12:=time.hours DIV 12;
      IF hr12<>ohr12 THEN 
        recalc END END END;
UNTIL GETKEY()=CHR(7)
END Display;

(***** Main Program *****)
BEGIN
initfacenum;
InputCurrent;
Display;
END CLOCK.
