thaeler@hc.DSPO.GOV (Bret K. Thaeler) (03/08/89)
%
% Digital Clock.
%
% Author: Bret K. Thaeler
% Mini author: Josh Siegel
% Los Alamos National Labs (MEE-10)
% {thaeler,siegel}@hc.dspo.gov
%
%
% Yet another thing that you can't do with X....
%
% This program brings up a digital clock (looking like your wrist
% watch or a clock) that is COMPLETELY written in NeWS. This clock
% doesn't have ANY C side...
%
% The later it gets the worse this code becomes. It is now late and
% this code is REALLY UGLY....
%
% Have Fun...
%
%
% Create Window
%
%
% Set attributes for window
%
/lasteve null def
/do2412 0 def % 0 => 24, 1 => 12
/toggel2412 {
% togger between 24 and 12 hour clock.
do2412 0 eq {
/do2412 1 store
0 (24 Hour Clock) /toggel2412 /changeitem /ClientMenu win send send
resize_window
} {
/do2412 0 store
0 (12 Hour Clock) /toggel2412 /changeitem /ClientMenu win send send
resize_window
} ifelse
} def
/dohms 0 def % 0 => hms, 1 => hm
/timetnu 1 60 div def % minutes to next update
/toggelhms {
% toggel between HH:MM:SS and HH:MM
dohms 0 eq {
/dohms 1 store
/timetnu 1 store
1 (H:M:S) /toggelhms /changeitem /ClientMenu win send send
resize_window
} {
/dohms 0 store
/timetnu 1 60 div store
1 (H:M) /toggelhms /changeitem /ClientMenu win send send
resize_window
lasteve begin
/TimeStamp currenttime def
end
} ifelse
} def
/win
framebuffer /new DefaultWindow send dup
{
/FrameLabel () def % Give it a label
/BorderLeft 5 def
/BorderRight 5 def
/BorderTop 5 def
/BorderBottom 5 def
/PaintFocus {} def
/IconHeight 30 def
/IconWidth 80 def
200 200 270 70 reshape % Give it a size
/ClientMenu [
(12 Hour Clock) /toggel2412
(H:M) /toggelhms
() {}
(ZAP!) {lasteve /Canvas null put currentprocess killprocessgroup}
] /new DefaultMenu send def
/IconMenu ClientMenu def
/num_dig 9 def
/flipiconic load {
lasteve begin
/TimeStamp currenttime def
end
} exch append cvx /flipiconic exch def
} exch send def
/resize_window {
do2412 0 eq { 8 } { 8.5 } ifelse
dohms 0 eq { 0 } { -3 } ifelse
add 1 add
{ /num_dig exch def } win send
do_app_update
} def
%
% Define the canvas for this beast
%
/can
win /ClientCanvas get
def
/cani
win /IconCanvas get
def
% can /Retained false put
% cani /Retained true put
%
% If we didn't give window a size above use this. Else not.
%
% /reshapefromuser win send
%
% Now display the window
%
% win begin
% FrameInterests /FrameDamageEvent undef
% end
/map win send
can setcanvas
pause pause pause pause
0 0 0 rgbcolor fillcanvas
%
% clock digits
%
/Digital_Font_Dict 10 dict def
Digital_Font_Dict
begin
/FontMatrix [0.05 0 0 0.025 0 0 ] def
/FontBBox [-1 -1 20 40] def
/Encoding StandardEncoding def
/CharProces
dictbegin
Encoding {
{} def
} forall
/Gap 2 def
/Width 20 def
/HorizSeg % { Width Gap 2 mul sub } def
16 def
/HalfHeight 20 def
/VerSeg % { HalfHeight Gap 2 mul sub } def
16 def
/DigitSpacing 10 def
/LineWidth 2 def
/colon {
0 0
HalfHeight 2 div add exch
Width 2 div 5 add add exch
2 copy 2 copy moveto
exch 5 sub exch 5 0 360 arc fill
HalfHeight add 2 copy moveto
exch 5 sub exch 5 0 360 arc fill
stroke
} def
/period {
Width 2 div 5 add 5 moveto
Width 2 div 5 5 0 360 arc fill
} def
/hyphen {
0 0 moveto
Gap HalfHeight rmoveto
HorizSeg 0 rlineto
stroke
} def
/zero {
0 0 moveto
0 Gap rmoveto
0 VerSeg rlineto
0 Gap 2 mul rmoveto
0 VerSeg rlineto
Gap Gap rmoveto
HorizSeg 0 rlineto
Gap Gap neg rmoveto
0 VerSeg neg rlineto
0 Gap 2 mul neg rmoveto
0 VerSeg neg rlineto
Gap neg Gap neg rmoveto
HorizSeg neg 0 rlineto
stroke
} def
/one {
0 0 moveto
Width Gap rmoveto
0 VerSeg rlineto
0 Gap 2 mul rmoveto
0 VerSeg rlineto
stroke
} def
/two {
0 0 moveto
Width Gap sub 0 rmoveto
HorizSeg neg 0 rlineto
Gap neg Gap rmoveto
0 VerSeg rlineto
Gap Gap rmoveto
HorizSeg 0 rlineto
Gap Gap rmoveto
0 VerSeg rlineto
Gap neg Gap rmoveto
HorizSeg neg 0 rlineto
stroke
} def
/three {
0 0 moveto
Gap 0 rmoveto
HorizSeg 0 rlineto
Gap Gap rmoveto
0 VerSeg rlineto
0 Gap 2 mul rmoveto
0 VerSeg rlineto
Gap neg Gap rmoveto
HorizSeg neg 0 rlineto
0 HalfHeight neg rmoveto
HorizSeg 0 rlineto
stroke
} def
/four {
0 0 moveto
Width Gap rmoveto
0 VerSeg rlineto
0 Gap 2 mul rmoveto
0 VerSeg rlineto
Gap neg HalfHeight Gap sub neg rmoveto
HorizSeg neg 0 rlineto
Gap neg Gap rmoveto
0 VerSeg rlineto
stroke
} def
/five {
0 0 moveto
Gap 0 rmoveto
HorizSeg 0 rlineto
Gap Gap rmoveto
0 VerSeg rlineto
Gap neg Gap rmoveto
HorizSeg neg 0 rlineto
Gap neg Gap rmoveto
0 VerSeg rlineto
Gap Gap rmoveto
HorizSeg 0 rlineto
stroke
} def
/six {
0 0 moveto
0 Gap rmoveto
0 VerSeg rlineto
0 Gap 2 mul rmoveto
0 VerSeg rlineto
Gap Gap rmoveto
HorizSeg 0 rlineto
Gap HalfHeight Gap add neg rmoveto
0 VerSeg neg rlineto
Gap neg Gap neg rmoveto
HorizSeg neg 0 rlineto
0 HalfHeight rmoveto
HorizSeg 0 rlineto
stroke
} def
/seven {
0 0 moveto
Width Gap rmoveto
0 VerSeg rlineto
0 Gap 2 mul rmoveto
0 VerSeg rlineto
Gap neg Gap rmoveto
HorizSeg neg 0 rlineto
stroke
} def
/eight {
0 0 moveto
0 Gap rmoveto
0 VerSeg rlineto
0 Gap 2 mul rmoveto
0 VerSeg rlineto
Gap Gap rmoveto
HorizSeg 0 rlineto
Gap Gap neg rmoveto
0 VerSeg neg rlineto
0 Gap 2 mul neg rmoveto
0 VerSeg neg rlineto
Gap neg Gap neg rmoveto
HorizSeg neg 0 rlineto
0 HalfHeight rmoveto
HorizSeg 0 rlineto
stroke
} def
/nine {
0 0 moveto
0 HalfHeight Gap add rmoveto
0 VerSeg rlineto
Gap Gap rmoveto
HorizSeg 0 rlineto
Gap Gap neg rmoveto
0 VerSeg neg rlineto
0 Gap 2 mul neg rmoveto
0 VerSeg neg rlineto
Gap neg Gap neg rmoveto
HorizSeg neg 0 rlineto
0 HalfHeight rmoveto
HorizSeg 0 rlineto
stroke
} def
dictend
def
/BuildChar { % font char
exch
begin
Encoding exch get
CharProces
begin
Width DigitSpacing add 0 -1 -1 20 40 setcachedevice
LineWidth setlinewidth
cvx exec
end
end
} def
end
/Digital_Font Digital_Font_Dict definefont pop
/the_delta 0 def
/the_oldtime [0 0 0 0 0 0 0] def
/redo_time {
10 dict
begin
/the_ball (%socketc13) (r) file dup 60 string readstring pop exch
closefile def
/the_delta currenttime store
/the_oldtime [
the_ball 0 3 getinterval the_ball 4 3 getinterval
the_ball 8 2 getinterval cvi
the_ball 11 2 getinterval cvi the_ball 14 2 getinterval cvi
the_ball 17 2 getinterval cvi the_ball 20 4 getinterval cvi
] store
end
} def
redo_time
/the_newtime {
10 dict
begin
/foo [ the_oldtime aload pop ] def
currenttime the_delta sub
/h 1 index 60 div cvi def
/m 1 index h 60 mul sub cvi def
/s exch dup cvi sub 60 mul def
foo 5 foo 5 get s add cvi put
foo 5 get 60 ge {
/m m 1 add store
foo 5 foo 5 get 60 sub cvi put
} if
foo 4 foo 4 get m add put
foo 4 get 60 ge {
/h h 1 add store
foo 4 foo 4 get 60 sub put
} if
foo 3 foo 3 get h add put
foo 3 get 24 ge {
redo_time
/foo [ the_oldtime aload pop ] def
} if
foo
end
} def
/do_window_update {
gsave
initmatrix
clippath pathbbox 60 div exch
/num_dig win send 30 mul 10 sub div exch scale
pop pop
/Digital_Font findfont 20 scalefont setfont
0 0 0 rgbcolor fillcanvas
1 1 0 rgbcolor setcolor
do2412 1 eq {
30 10 moveto
} {
15 10 moveto
} ifelse
the_newtime
dup 5 get 2 string cvs
dup length 2 exch sub 2 string dup 0 32 put dup 1 32 put
dup 4 -2 roll exch putinterval
exch dup 4 get 2 string cvs
dup length 2 exch sub 2 string dup 0 32 put dup 1 32 put
dup 4 -2 roll exch putinterval
exch 3 get dup 12 gt do2412 1 eq and {
12 sub
/_day_half (PM) def
} {
/_day_half (AM) def
} ifelse
2 string cvs
dup length 2 exch sub 2 string dup 0 32 put dup 1 32 put
dup 4 -2 roll exch putinterval
dohms 0 eq {
(%:%:%) sprintf show
} {
3 -1 roll pop
(%:%) sprintf show
} ifelse
do2412 1 eq {
5 35 moveto
/Iconic? win send {
/Times-Roman findfont 2 scalefont setfont
} {
/Times-Bold findfont 10 scalefont setfont
} ifelse
_day_half show
} if
grestore
} def
{
/PaintClient {
ClientCanvas setcanvas
do_window_update
} def
/PaintIcon {
IconCanvas setcanvas
do_window_update
} def
} win send
/do_app_update {
/Iconic? win send {
cani setcanvas
} {
can setcanvas
} ifelse
do_window_update
} def
{
createevent dup
begin
/Name /FoobarTimeUpdate def
/Canvas can def
end
expressinterest
{
/Iconic? win send {
cani setcanvas
} {
can setcanvas
} ifelse
do_window_update
createevent dup dup /lasteve exch def
begin
/Name /FoobarTimeUpdate def
% /TimeStamp currenttime 0.25 add def
/Canvas can def
% /TimeStamp currenttime 0.01666 add def
/TimeStamp currenttime timetnu add def
end
sendevent
{
awaitevent dup /Name get /FoobarTimeUpdate eq {
pop exit
} {
redistributeevent
} ifelse
} loop
} loop
} fork