#!/usr/NeWS/bin/psh % % 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