(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "12-Sep-88 01:29:15" {ERINYES}MEDLEY>BICLOCK.;5 38172 changes to%: (FNS BICLOCK BICLOCKPROCESS) (VARS BICLOCKCOMS) previous date%: "14-Dec-87 17:32:47" {ERINYES}MEDLEY>BICLOCK.;2) (* " Copyright (c) 1984, 1985, 1986, 1987, 1988 by Bernt Nilsson @ University of Linkoeping. All rights reserved. ") (PRETTYCOMPRINT BICLOCKCOMS) (RPAQQ BICLOCKCOMS [(FNS BICLOCK BICLOCKBEFN BICLOCKCFN BICLOCKFINDFONT BICLOCKNRFN BICLOCKPROCESS BICLOCKRPFN BICLOCKRSFN BICLOCKSETALARM BICLOCKSETALARM1 BICLOCKSETALARM2 IDLE.BICLOCK) (RECORDS BICLOCKPARMS UPTIMEREC) [INITVARS (BICLOCKWINDOW) (BICLOCKDEFAULTPROPS '(SECONDS T COLOR SHADOW MARKS NIL DIGITS 1 CHIME NIL ALARM NIL SIZE 152 HORIZONTAL LEFT-OF-LOGO VERTICAL TOP CREATE T)) (BICLOCKUSERPROPS) (BICLOCKINITIALPROPS) (BICLOCKIDLEPROPS '(HORIZONTAL CENTER VERTICAL CENTER] [P (CL:PROCLAIM '(CL:SPECIAL BICLOCKWINDOW BICLOCKDEFAULTPROPS BICLOCKUSERPROPS BICLOCKINITIALPROPS BICLOCKIDLEPROPS] [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (BICLOCKWINDOW (BICLOCK BICLOCKINITIALPROPS] (ADDVARS (IDLE.FUNCTIONS (Biclock 'IDLE.BICLOCK)) (IDLE.SUSPEND.PROCESS.NAMES BICLOCKPROCESS)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA BICLOCK]) (DEFINEQ (BICLOCK [LAMBDA PROPS (* ; "Edited 12-Sep-88 01:25 by masinter") (LET ((PLIST (APPEND (if [AND (EQ PROPS 1) (OR (NULL (ARG PROPS 1)) (LISTP (ARG PROPS 1] then (ARG PROPS 1) else (for I from 1 to PROPS collect (ARG PROPS I))) BICLOCKUSERPROPS BICLOCKDEFAULTPROPS))) (if [OR (ODDP (LENGTH PLIST)) (find P in PLIST by (CDDR P) suchthat (NOT (LITATOM P] then (ERROR "ARG NOT PROPLIST IN BICLOCK" PLIST)) (if (LISTGET PLIST 'CREATE) then (LET ((W (OR (LISTGET PLIST 'WINDOW) (CREATEW (OR (for P in PLIST by (CDDR P) as V in (CDR PLIST) by (CDDR V) do (SELECTQ P (SIZE (RETURN (if V then (CREATEREGION (SELECTQ (LISTGET PLIST 'HORIZONTAL) (LEFT 0) (CENTER (QUOTIENT (DIFFERENCE SCREENWIDTH V) 2)) (LEFT-OF-LOGO (- SCREENWIDTH V (if LOGOW then (WINDOWPROP LOGOW 'WIDTH) else 0))) (RIGHT (DIFFERENCE (DIFFERENCE SCREENWIDTH V) 1)) (OR (NUMBERP (LISTGET PLIST 'HORIZONTAL)) 0)) (SELECTQ (LISTGET PLIST 'VERTICAL) (BOTTOM 0) (CENTER (QUOTIENT (DIFFERENCE SCREENHEIGHT V) 2)) (BELOW-LOGO (- SCREENHEIGHT V (if LOGOW then (WINDOWPROP LOGOW 'HEIGHT) else 0))) (TOP (DIFFERENCE (DIFFERENCE SCREENHEIGHT V) 1)) (OR (NUMBERP (LISTGET PLIST 'VERTICAL)) 0)) V V)))) (REGION (RETURN V)) NIL)) (GETREGION 20 20 NIL 'BICLOCKNRFN)) NIL 0))) [PARMS (create BICLOCKPARMS SECONDSMODE _ (LISTGET PLIST 'SECONDS) COLORMODE _ (LISTGET PLIST 'COLOR) MARKMODE _ [SELECTQ (LISTGET PLIST 'MARKS) (HOUR 5) ((HOUR&MINUTE MINUTE) 1) (|3/6/9/12| 15) (NUMBERP (LISTGET PLIST 'MARKS] DIGMODE _ [SELECTQ (LISTGET PLIST 'DIGITS) (HOUR 1) (|3/6/9/12| 3) (NUMBERP (LISTGET PLIST 'DIGITS] CHIMEMODE _ [SELECTQ (LISTGET PLIST 'CHIME) (HOUR 60) (QUORTER 15) (NUMBERP (LISTGET PLIST 'CHIME] ROMANDIGS _ (for P in PLIST by (CDDR P) as V in (CDR PLIST) by (CDDR V) do (SELECTQ P (ROMAN (RETURN V)) (ARABIC (RETURN (NOT V))) NIL)) ADJUSTEVENT _ (CREATE.EVENT) ALARMTIME _ (if (LISTGET PLIST 'ALARMTIME) then (IDATE (LISTGET PLIST 'ALARMTIME] P) (if (NOT (LISTGET PLIST 'IDLE)) then (DEL.PROCESS 'BICLOCKPROCESS) (AND BICLOCKWINDOW (CLOSEW BICLOCKWINDOW))) (SETQ P (ADD.PROCESS (LIST (FUNCTION BICLOCKPROCESS) (KWOTE W) (KWOTE PARMS)) 'RESTARTABLE 'HARDRESET)) (WINDOWPROP W 'PROCESS P) (WINDOWPROP W 'NEWREGIONFN (FUNCTION BICLOCKNRFN)) (WINDOWPROP W 'RESHAPEFN (FUNCTION BICLOCKRSFN)) (WINDOWPROP W 'REPAINTFN (FUNCTION BICLOCKRPFN)) (WINDOWPROP W 'CLOSEFN (FUNCTION BICLOCKCFN)) (WINDOWPROP W 'AFTERMOVEFN (FUNCTION BICLOCKRPFN)) (WINDOWPROP W 'PARMS PARMS) (WINDOWPROP W 'WINDOWENTRYFN (FUNCTION BICLOCKBEFN)) (WINDOWPROP W 'BUTTONEVENTFN (FUNCTION BICLOCKBEFN)) W]) (BICLOCKBEFN [LAMBDA (W) (* lmm "19-Nov-86 07:41") (LET [(PROC (WINDOWPROP W 'PROCESS] [if (PROCESS.FINISHEDP PROC) then (PRINTOUT PROMPTWINDOW T "RESTARING BICLOCK PROCESS") (WINDOWPROP W 'PROCESS (SETQ PROC (ADD.PROCESS [LIST (FUNCTION BICLOCKPROCESS) (KWOTE W) (KWOTE (WINDOWPROP W 'PARMS] 'RESTARTABLE 'HARDRESET] (if (.COPYKEYDOWNP.) then (SUSPEND.PROCESS PROC) (INVERTW W) (UNTILMOUSESTATE (NOT (OR LEFT MIDDLE))) (BKSYSBUF (DATE)) (INVERTW W) (WAKE.PROCESS PROC) else (with BICLOCKPARMS (WINDOWPROP W 'PARMS) (if (MOUSESTATE LEFT) then (if ALARMTIME then (PROMPTPRINT (DATE) " ALARM AT " (GDATE ALARMTIME)) else (PROMPTPRINT (DATE) " NO ALARM SET")) elseif (MOUSESTATE MIDDLE) then (LET [(SEL (MENU (create MENU ITEMS _ `(("Seconds On" 'SON) ("Seconds Off" 'SOFF) ("White" 'WHITE "White with border" (SUBITEMS ("Shadow" 'SHADOW "White with shadow")) ) ("Black" 'BLACK) ["Markers" 'MINSEC "Use Submenu to Change number of Markers" (SUBITEMS ("No markers" 'NOMARKER) ("3/6/9/12 Markers" '3HOURMARKS) ("Only hours" 'HOURMARKS) ("Hours and minutes" 'MINHOURMARKS] ["Digits" 'HOUR "Use Submenu to Change number of Digits" (SUBITEMS ("No Digits" 'NODIG) ("3/6/9/12 Hours" '3HOUR) ("All Hours" 'HOUR) ("Arabic digits" 'ARABIC) ("Roman digits" 'ROMAN] ["Chime" 'CHIME "Use Submenu to Change Chime interval" (SUBITEMS ("No chime" 'NOCHIME) ("Hours" 'CHIME) ("Hours and quarters" 'CHIME15MIN] ("Set Alarm" 'ALARM) ("Alarm Off" 'AOFF] (SELECTQ SEL (SON (SETQ SECONDSMODE T)) (SOFF (SETQ SECONDSMODE NIL)) ((WHITE BLACK SHADOW) (SETQ COLORMODE SEL)) (NOMARKER (SETQ MARKMODE NIL)) (3HOURMARKS (SETQ MARKMODE 15)) (HOURMARKS (SETQ MARKMODE 5)) (MINHOURMARKS (SETQ MARKMODE 1)) (NODIG (SETQ DIGMODE NIL)) (3HOUR (SETQ DIGMODE 3)) (HOUR (SETQ DIGMODE 1)) (ARABIC (SETQ ROMANDIGS NIL)) (ROMAN (SETQ ROMANDIGS T)) (NOCHIME (SETQ CHIMEMODE NIL)) (CHIME (SETQ CHIMEMODE 60)) (CHIME15MIN (SETQ CHIMEMODE 15)) (ALARM (BICLOCKSETALARM W)) (AOFF (SETQ ALARMTIME NIL)) NIL) (if (MEMB SEL '(NOMARKER 3HOURMARKS HOURMARKS MINHOURMARKS NODIG 3HOUR HOUR ARABIC ROMAN)) then (RESTART.PROCESS (WINDOWPROP W 'PROCESS)) else (WAKE.PROCESS (WINDOWPROP W 'PROCESS]) (BICLOCKCFN [LAMBDA (W) (DEL.PROCESS (WINDOWPROP W 'PROCESS]) (BICLOCKFINDFONT [LAMBDA (SIZE MODERNCLASSIC) (* ; "Edited 26-Nov-86 14:46 by Pavel") (LET [(ALLFONTS (FONTSAVAILABLE '* '* 'MRR 0 'DISPLAY] [SORT ALLFONTS (FUNCTION (LAMBDA (F1 F2) (OR [AND MODERNCLASSIC (MEMB (CAR F1) '(MODERN CLASSIC)) (NOT (MEMB (CAR F2) '(MODERN CLASSIC] (GREATERP (CADR F1) (CADR F2)) (AND (EQP (CADR F1) (CADR F2)) (for FAM in '(MODERN CLASSIC GACHA HELVETICA HELVETICAD TERMINAL) do (if (EQ FAM (CAR F1)) then (RETURN T) elseif (EQ FAM (CAR F2)) then (RETURN NIL] (find FONT in ALLFONTS suchthat (LEQ (CADR FONT) SIZE]) (BICLOCKNRFN [LAMBDA (FP MP) (* BN "17-Sep-84 10:40") (COND [MP (with POSITION MP (PROG [(DX (IDIFFERENCE XCOORD (fetch (POSITION XCOORD) of FP))) (DY (IDIFFERENCE YCOORD (fetch (POSITION YCOORD) of FP] [COND [(IGREATERP (IABS DX) (IABS DY)) (SETQ YCOORD (IPLUS (fetch (POSITION YCOORD) of FP) (ITIMES DX (COND ((MINUSP (ITIMES DX DY)) -1) (T 1] (T (SETQ XCOORD (IPLUS (fetch (POSITION XCOORD) of FP) (ITIMES DY (COND ((MINUSP (ITIMES DX DY)) -1) (T 1] (RETURN MP] (T FP]) (BICLOCKPROCESS [LAMBDA (W PARMS) (* ; "Edited 12-Sep-88 01:26 by masinter") (CENTERPRINTINREGION "Wait" NIL W) (with BICLOCKPARMS PARMS (PROG [(WIDTH (WINDOWPROP W 'WIDTH)) (HEIGHT (WINDOWPROP W 'HEIGHT] (while T bind S (BM _ (BITMAPCREATE WIDTH HEIGHT)) (BG _ (BITMAPCREATE WIDTH HEIGHT)) (BM1 _ (BITMAPCREATE WIDTH HEIGHT)) (SHADOW _ (BITMAPCREATE WIDTH HEIGHT)) (XC _ (IQUOTIENT WIDTH 2)) (YC _ (IQUOTIENT HEIGHT 2)) (SX _ (ARRAY 60 'FIXP 0 0)) (SY _ (ARRAY 60 'FIXP 0 0)) MX MY HX HY MP HP R MARKUR MARKLR MARK1LR DOTR SECR MINR HOURR CIRCW MARKW MARK1W SECW MINW HOURW DIGW DIGFONT NOW SECS (SLOWMODE _ T) (SMODE _ T) (MEAN _ 50) (LIMIT _ 1000) CL0 REF NOSEC INVERTFLG LASTCHIME (CHIMECOUNT _ 0) first (* ; "First set up some relations") (BLOCK) (WINDOWPROP W 'ICONIMAGE BM) (WINDOWPROP W 'ICONMASK BG) (SETQ R (- (IMIN XC YC) 4)) (SETQ MARKUR (CL:* R 1.0)) (SETQ MARKLR (CL:* R 0.9)) (SETQ MARK1LR (CL:* R 0.98)) (SETQ DOTR (CL:* R 0.05)) (SETQ SECR (CL:* R 1.0)) (SETQ MINR (CL:* R 0.9)) (BLOCK) (SETQ HOURR (CL:* R 0.6)) (SETQ CIRCW (CL:* R 0.03)) (SETQ MARKW (CL:* R (SELECTQ COLORMODE (SHADOW 0.05) 0.0375))) (SETQ MARK1W (CL:* R 0.009)) (SETQ SECW (IMAX 1 (CL:* R 0.01))) (SETQ MINW (IMAX 2 (CL:* R 0.037))) (SETQ HOURW (IMAX 3 (CL:* R 0.07))) (SETQ DIGW (CL:* R (if (NUMBERP MARKMODE) then 0.75 else 0.9))) (SETQ S (DSPCREATE BM)) (DSPXOFFSET XC S) (DSPYOFFSET YC S) (* ;; "Generate signature") (if (SETQ DIGFONT (BICLOCKFINDFONT (TIMES R 0.15))) then (DSPFONT DIGFONT S) (CENTERPRINTINREGION "BN" (CREATEREGION (MINUS XC) (MINUS (QUOTIENT (TIMES YC 4) 5)) WIDTH (QUOTIENT (TIMES YC 4) 5)) S)) (SETQ DIGFONT (BICLOCKFINDFONT (CL:* R (if (NUMBERP MARKMODE) then 0.2 else 0.25)) ROMANDIGS)) (DSPFONT DIGFONT S) (DSPOPERATION 'PAINT S) (* ; "Generate background Hour Marks") (for H from 1 to 12 as V from 60 by -30 bind SYM do (BLOCK) (SETQ HX (COS V)) (SETQ HY (SIN V)) (if (AND (NUMBERP MARKMODE) (ZEROP (IMOD (CL:* H 5) MARKMODE))) then (DRAWLINE (CL:* HX MARKUR) (CL:* HY MARKUR) (CL:* HX MARKLR) (CL:* HY MARKLR) MARKW 'REPLACE S)) (if (AND DIGFONT (NUMBERP DIGMODE) (ZEROP (IMOD H DIGMODE))) then (SETQ SYM (if ROMANDIGS then (CAR (NTH '(ÿïÁÿ ÿïÂÿ ÿïÃÿ ÿïÄÿ ÿïÅÿ ÿïÆÿ ÿïÇÿ ÿïÈÿ ÿïÉÿ ÿïÊÿ ÿïÊÁÿ ÿïÊÂÿ) H)) else H)) (MOVETO (- (CL:* HX DIGW) (QUOTIENT (STRINGWIDTH SYM S) 2)) (- (CL:* HY DIGW) (if ROMANDIGS then (- (QUOTIENT (FONTPROP S 'HEIGHT) 2) (FONTPROP S 'DESCENT)) else (QUOTIENT (FONTPROP S 'ASCENT) 2))) S) (PRIN1 SYM S))) (* ;  "Generate background Second Marks") (for I from 0 to 59 as V from 90 by -6 do (BLOCK) (SETA SX I (FIX (CL:* (SETQ MX (COS V)) SECR))) (SETA SY I (FIX (CL:* (SETQ MY (SIN V)) SECR))) (if (AND (NUMBERP MARKMODE) (ZEROP (IMOD I MARKMODE))) then (DRAWLINE (CL:* MX SECR) (CL:* MY SECR) (CL:* MX MARK1LR) (CL:* MY MARK1LR) MARK1W 'REPLACE S))) (BLOCK) (FILLCIRCLE 0 0 DOTR BLACKSHADE S) (* ;  "Let this be the Background to be used in the loop") (BITBLT BM NIL NIL BG) (* ;  "Determine a reference point for millisecond clock, that is half a second ahead...") (while (= (DAYTIME) T1) bind (T1 _ (DAYTIME)) do (BLOCK) finally (SETQ REF (IPLUS (CLOCK 0) 500))) do (BITBLT BG NIL NIL BM) (* ;  "Compute number of seconds since midnight") (SETQ NOW (DAYTIME)) (SETQ SECS (with UPTIMEREC (\UNPACKDATE (if ADJUSTALARM then ALARMTIME else NOW)) (IPLUS (CL:* HOUR 3600) (CL:* MINUTE 60) SECOND))) (if SLOWMODE then (BLOCK)) (* ; "Draw Hour Arm") (COND ((EQP HP (IQUOTIENT SECS 120)) (DRAWLINE 0 0 HX HY HOURW 'REPLACE S)) (T (DRAWLINE 0 0 (SETQ HX (FIX (CL:* (SIN (SETQ HP (IQUOTIENT SECS 120))) HOURR))) (SETQ HY (FIX (CL:* (COS HP) HOURR))) HOURW 'REPLACE S))) (if SLOWMODE then (BLOCK)) (* ; "Draw Minute Arm") (COND ((EQP MP (IQUOTIENT SECS 10)) (DRAWLINE 0 0 MX MY MINW 'REPLACE S)) (T (DRAWLINE 0 0 (SETQ MX (FIX (CL:* (SIN (SETQ MP (IQUOTIENT SECS 10))) MINR))) (SETQ MY (FIX (CL:* (COS MP) MINR))) MINW 'REPLACE S))) (if SLOWMODE then (BLOCK)) (* ; "Draw Seconds Arm") (COND ((NOT NOSEC) (DRAWLINE 0 0 (ELT SX (IMOD SECS 60)) (ELT SY (IMOD SECS 60)) SECW 'REPLACE S))) (* ; "Now, Generate The Shadow") (if SLOWMODE then (BLOCK)) [SELECTQ COLORMODE (SHADOW (BITBLT BM NIL NIL SHADOW) [for DX from 0 to 1 do (for DY from -2 to 0 do (if SLOWMODE then (BLOCK)) (BITBLT SHADOW NIL NIL SHADOW DX DY NIL NIL 'INPUT 'PAINT) when (OR (NEQ DX 0) (NEQ DY 0]) (PROGN (BITBLT BM NIL NIL SHADOW) (for DX from -1 to 1 do (for DY from -1 to 1 do (if SLOWMODE then (BLOCK)) (BITBLT SHADOW NIL NIL SHADOW DX DY NIL NIL 'INPUT 'PAINT) when (OR (NEQ DX 0) (NEQ DY 0] (if SLOWMODE then (BLOCK)) (* ; "Find the Real background") (TOTOPW W) (BITBLT (WINDOWPROP W 'IMAGECOVERED) NIL NIL BM1) (BITBLT SHADOW NIL NIL BM1 NIL NIL NIL NIL 'INPUT (SELECTQ COLORMODE ((WHITE SHADOW) 'PAINT) (BLACK 'ERASE) NIL)) (if SLOWMODE then (BLOCK)) (BITBLT BM NIL NIL BM1 NIL NIL NIL NIL 'INPUT (SELECTQ COLORMODE ((WHITE SHADOW) 'ERASE) (BLACK 'PAINT) NIL)) (* ; "Now, at last, Output it") (BITBLT BM1 NIL NIL W NIL NIL NIL NIL (if INVERTFLG then 'INVERT else 'INPUT) 'REPLACE) [if SLOWMODE then (if [AND CHIMEMODE (OR (NULL LASTCHIME) (NOT (= (IQUOTIENT LASTCHIME (CL:* CHIMEMODE 60)) (IQUOTIENT SECS (CL:* CHIMEMODE 60] then (if LASTCHIME then (SETQ CHIMECOUNT (if (= (IMOD (IQUOTIENT SECS 60) 60) 0) then (IPLUS (IMOD (- (IQUOTIENT SECS (CL:* 60 60)) 1) 12) 1) else 1))) (SETQ LASTCHIME SECS)) (if (> CHIMECOUNT 0) then (add CHIMECOUNT -1) (BEEPON 440) (BLOCK 25) (BEEPON 220) (BLOCK 25) (BEEPOFF)) (for N from 1 to (COND (SMODE 10) (T 1)) bind (DEL _ (COND ((OR SMODE (AND ALARMTIME (<= ALARMTIME NOW)) (> CHIMECOUNT 0)) 1000) (T 60000))) until (OR ADJUSTALARM (AND ALARMTIME (<= ALARMTIME NOW) )) repeatwhile (AND NOSEC (> MEAN LIMIT)) do (BLOCK (- DEL (IMOD (- (CLOCK 0) REF) DEL))) (SETQ CL0 (CLOCK 0)) (BLOCK) (SETQ MEAN (IQUOTIENT (IPLUS (CL:* MEAN 8) (CL:* (IMAX (IMIN (- (CLOCK 0) CL0) 500) 0) 2)) 10] (SETQ SLOWMODE (NOT ADJUSTALARM)) (SETQ SMODE SECONDSMODE) (SETQ NOSEC (AND (OR (NOT SMODE) (> MEAN LIMIT)) (NOT ADJUSTALARM))) (SETQ INVERTFLG (if (AND ALARMTIME (ILEQ ALARMTIME NOW)) then (BEEPON (if INVERTFLG then 440 else 880)) (BLOCK 50) (BEEPOFF) (NOT INVERTFLG) elseif ADJUSTALARM then (AWAIT.EVENT ADJUSTEVENT) NIL)) (SETQ LIMIT (IMIN (if (> LIMIT (/ (CL:* MEAN 10) 9)) then (- LIMIT 1) else (+ LIMIT 1)) 50]) (BICLOCKRPFN [LAMBDA (W) (WAKE.PROCESS (WINDOWPROP W 'PROCESS]) (BICLOCKRSFN [LAMBDA (W) (* lmm "24-Oct-86 15:17") (RESTART.PROCESS (WINDOWPROP W 'PROCESS]) (BICLOCKSETALARM [LAMBDA (W) (* lmm "24-Oct-86 15:21") (LET [(M (OR (WINDOWPROP W 'ADJUSTMENUW) (MENUWINDOW (create MENU ITEMS _ `(("
") ("") ("") ,@[for I1 in '(24 12 3 1 -1 -3 -12 -24) as I2 in '(30 15 5 1 -1 -5 -15 -30) join (for QQQ in '(T NIL NIL) as SCALE in (CONSTANT (LIST (TIMES 60 60) 60 1)) as HELP in '("Will Increment/Decrement Hours by that Amount" "Will Increment/Decrement Minutes by that Amount" "Will Increment/Decrement Seconds by that Amount") collect (LET ((I (if QQQ then I1 else I2))) (LIST I (LIST (FUNCTION BICLOCKSETALARM1) (KWOTE W) (KWOTE (TIMES I SCALE))) HELP] ("OK!" (BICLOCKSETALARM2 ,(KWOTE W)) "Will Exit Adjust Mode") ("_0" (BICLOCKSETALARM1 ,(KWOTE W) 3600 T) "Will Reset Alarm Time to Hr:00:00") ("_0" (BICLOCKSETALARM1 ,(KWOTE W) 60 T) "Will Reset Alarm Time to Hr:Min:00")) TITLE _ "Adjust Alarm" CENTERFLG _ T MENUCOLUMNS _ 3] (WINDOWPROP W 'ADJUSTMENUW M) (ATTACHWINDOW M W 'BOTTOM 'JUSTIFY) (with BICLOCKPARMS (WINDOWPROP W 'PARMS) (SETQ ALARMTIME (OR ALARMTIME (PLUS (DAYTIME) 60))) (SETQ ADJUSTALARM T) (NOTIFY.EVENT ADJUSTEVENT) (PROMPTPRINT (GDATE ALARMTIME]) (BICLOCKSETALARM1 [LAMBDA (W DSEC MODULOFLG) (* lmm "24-Oct-86 15:21") (with BICLOCKPARMS (WINDOWPROP W 'PARMS) [LET [(OLDTIME (OR ALARMTIME (PLUS (DAYTIME) 60] (SETQ ALARMTIME (if MODULOFLG then (DIFFERENCE OLDTIME (IMOD (with UPTIMEREC (\UNPACKDATE ALARMTIME) (IPLUS (ITIMES HOUR 3600) (ITIMES MINUTE 60) SECOND)) DSEC)) else (IPLUS OLDTIME DSEC] (NOTIFY.EVENT ADJUSTEVENT) (PROMPTPRINT (GDATE ALARMTIME]) (BICLOCKSETALARM2 [LAMBDA (W) (* lmm "24-Oct-86 15:17") (with BICLOCKPARMS (WINDOWPROP W 'PARMS) (SETQ ADJUSTALARM NIL) (NOTIFY.EVENT ADJUSTEVENT) (DETACHWINDOW (WINDOWPROP W 'ADJUSTMENUW)) (CLOSEW (WINDOWPROP W 'ADJUSTMENUW]) (IDLE.BICLOCK [LAMBDA (W) (* BKN "17-Jun-86 14:22") (RESETLST (LET ((BW (BICLOCK BICLOCKIDLEPROPS))) (RESETSAVE NIL (LIST (FUNCTION CLOSEW) BW)) (while T do (BLOCK 5000) (if (NEQ (\GETBASEPTR BW 2) W) then (TOTOPW W)) (MOVEW BW [RAND 0 (DIFFERENCE SCREENWIDTH (WINDOWPROP BW 'WIDTH] (RAND 0 (DIFFERENCE SCREENHEIGHT (WINDOWPROP BW 'HEIGHT]) ) (DECLARE%: EVAL@COMPILE (DATATYPE BICLOCKPARMS (SECONDSMODE COLORMODE MARKMODE DIGMODE CHIMEMODE ROMANDIGS ALARMTIME ADJUSTALARM ADJUSTEVENT)) (RECORD UPTIMEREC (YEAR MONTH DAY HOUR MINUTE SECOND QQQ)) ) (/DECLAREDATATYPE 'BICLOCKPARMS '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER) '((BICLOCKPARMS 0 POINTER) (BICLOCKPARMS 2 POINTER) (BICLOCKPARMS 4 POINTER) (BICLOCKPARMS 6 POINTER) (BICLOCKPARMS 8 POINTER) (BICLOCKPARMS 10 POINTER) (BICLOCKPARMS 12 POINTER) (BICLOCKPARMS 14 POINTER) (BICLOCKPARMS 16 POINTER)) '18) (RPAQ? BICLOCKWINDOW ) (RPAQ? BICLOCKDEFAULTPROPS '(SECONDS T COLOR SHADOW MARKS NIL DIGITS 1 CHIME NIL ALARM NIL SIZE 152 HORIZONTAL LEFT-OF-LOGO VERTICAL TOP CREATE T)) (RPAQ? BICLOCKUSERPROPS ) (RPAQ? BICLOCKINITIALPROPS ) (RPAQ? BICLOCKIDLEPROPS '(HORIZONTAL CENTER VERTICAL CENTER)) (CL:PROCLAIM '(CL:SPECIAL BICLOCKWINDOW BICLOCKDEFAULTPROPS BICLOCKUSERPROPS BICLOCKINITIALPROPS BICLOCKIDLEPROPS)) (DECLARE%: DONTEVAL@LOAD DOCOPY (RPAQ BICLOCKWINDOW (BICLOCK BICLOCKINITIALPROPS)) ) (ADDTOVAR IDLE.FUNCTIONS (Biclock 'IDLE.BICLOCK)) (ADDTOVAR IDLE.SUSPEND.PROCESS.NAMES BICLOCKPROCESS) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA BICLOCK) ) (PUTPROPS BICLOCK COPYRIGHT ("Bernt Nilsson @ University of Linkoeping" 1984 1985 1986 1987 1988)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1744 36493 (BICLOCK 1754 . 7779) (BICLOCKBEFN 7781 . 13339) (BICLOCKCFN 13341 . 13412) (BICLOCKFINDFONT 13414 . 14853) (BICLOCKNRFN 14855 . 16271) (BICLOCKPROCESS 16273 . 32113) ( BICLOCKRPFN 32115 . 32188) (BICLOCKRSFN 32190 . 32347) (BICLOCKSETALARM 32349 . 34451) ( BICLOCKSETALARM1 34453 . 35474) (BICLOCKSETALARM2 35476 . 35811) (IDLE.BICLOCK 35813 . 36491))))) STOP