%! % Date: 29 Sep 89 00:17:14 GMT % From: spectral!sjs@bellcore.com (Stan Switzer) % Subject: Blankscreen 1.1 % To: news-makers@brillig.umd.edu % % It's been about six months since I posted "blankscreen 1.0." Since % then I've made a number of (umm...) improvements. Here's the bigger, % if not better, "blankscreen 1.1." % % Extensive user documantation is contained in the header comments. % I'll just describe the new features and major caveats here. % % New Features: % % Easy (as such things go) to add your own animations % % Contains a number of standard animations and animation base-classes % % Menu Selection of animations % % "Exit Desktop" button (can be disabled) % % Inumerable bugs fixed and much unspeakable hackery cleaned-up % % Major Caveats: % % If you use "ksh" or "tcsh" or any shell other than "/bin/sh" or % "/bin/csh" read the WARNINGS section below. Basically, the % password checking hack will fail. The solution is to be sure that % /etc/shells contains the pathname of your login shell (anywhere % where you might log in) or to use one of the standard shells and % have your .login or .profile file exec your desired shell. Another % solution is to disable the "locking" feature. Enquire within... % % Blankscreen is only known to work on NeWS 1.1 using Sun-3 style % keyboards. It very well might work elsewhere, but I be mighty % suprised. % % I'll post a few example user-customization animations in a few days. % % Enjoy, % % Stan % ---------------------- % % BlankScreen: Lights out! % % Copyright (C) 1989 by Stan Switzer. All rights reserved. % This program is provided for unrestricted use, provided that this % copyright message is preserved. There is no warranty, and no author % or distributer accepts responsibility for any damage caused by this % program. % % DESCRIPTION: % % BlankScreen monitors your keyboard and mouse for activity, % invoking a screen-saver when there has been no activity in a user- % selectable time period. If, after another user-selectable time period, % there has been no keyboard or mouse activity, BlankScreen quietly enters % a "lock" mode which demands your login password before releasing the % workstation. % % Certain locking modes, for instance the default "Randomator," allow % menu selections and, consequently, do not leave the "blanking mode" simply % because of mouse motion. However, any key press or mouse button (except % for the menu button, of course) will exit the blanking mode. % % At invocation, the variables /BlankTime and /LockTime control the amount % of idle time that causes blanking and amount of blanked time that leads % to locking. Changing these values later has no effect (to protect against % accidents). The default times for these values are three minutes % and two minutes respectively. If you find locking objectionable, you % can disable it by setting /LockTime to 0. % % When blankscreen is restarted, it kills any other running (but % unlocked) blankscreen processes. This allows you to change the % timer parameters without compromising the security of the % locking function. % % If /BlankFKey is defined, it is the name of a function key to use to % blank the screen on demand. Similarly for /LockFKey. I use the following: % /BlankFKey /FunctionF6 def /LockFKey /FunctionF7 def % % Unless you define /BlankscreenExitButton to false before % starting blankscreen, there will be an "EXit NeWS" button on the % password-query display. If you press this button, you will exit % NeWS entirely. Assuming that you started NeWS using % "exec news_server" from your login shell, this option affords you a % measure of security while allowing you to be a socially responsible % user of shared facilities. % % The NeWS-clock poem can be changed by assigning a different array of % strings to /Poetry before invoking blankscreen. A value of "null" % disables the poetry entirely. % % The colors used in the blanking display can be changed by assigning values to % the appropriate variables before invocation. Interested parties should % look at the first few lines of source. % % If you don't like the standard animation, there are other alternatives. % You can define the procedure "CreateAnimationObject" to override the % default animation "Randomator". The following definition will % result in a bouncing globe instead: % /CreateAnimationObject { /new WorldBouncer send } def % Other alternatives can be found within. If you don't like any of these % you can write your own animation using any of the classes provided. % (CreateAnimationObject is invoked after all of the classes are defined so % it can define a new subclass and instantiate it.) If you % need subclassing assistance, or have a nice animation you'd like to share, % mail me. If I get enough animations, I'll start a library and forward % it to the the archives periodically. % % It is safe to say that this is a case of a simple hack having % gotten completely out of hand. % % WARNINGS: % % This program checks passwords by trying to connect to your FTP % server (yes, this is a hack). You would do well to see if you can % "ftp localhost" before you begin using this program. If your % login shell is not /bin/sh or /bin/csh (for instance /.../ksh) % you must make sure that the file /etc/shells contains the paths of all % full-service shells or some systems will "protect" you from using % FTP. The idea is to make it so that non-shell logins cannnot be used % to "sneak in" and FTP out files; unfortunately, this policy is overly % cautious. IF ANYONE HAS A BETTER IDEA FOR CHECKING PASSWORDS (without % writing any C), PLEASE SEND ME MAIL. % % Additionally, either (USER) or (LOGNAME) must be in the environment % for the locking mode to know who you are. (If you are running any % of the usual varieties of UNIX, it will be.) % % If either of these assumptions fails to hold true, setting "LockTime" % to 0 disables automatic locking, thus avoiding the problem. % % Because this program goes to great lengths to defeat the keyboard focus % manager, it depends on things that might easily change from one % release of NeWS to another. I only know for sure that it works in % NeWS 1.1 with a Sun-3 keyboard. % % Finally, "forkunix" must work (I don't know about non-UNIX NeWS % implementations), and there must be a reasonably standard "date" % command. % % NeWS Notes: % % I should probably be registering "global" interests relative to a % framebuffer overlay instead of a null canvas. % % Interests having dictionaries of procs for both their Name and Action % do not execute either procedure but instead return both an event and array % from awaitevent. The array contains the two procedures that should have % been executed. Maybe I should have been using "forkeventmgr" anyway to % avoid all of this hassle (then again, for security reasons, maybe not). % % Because a newly created process tends to get the same process table % address as the last reclaimed dead process and because pending % process-specific events are not scrubbed when their process dies, % a process will occasionally receive an event sent to a previous % incarnation of itself. This can be a pain if you get two shuttle events, % for instance, together driving a timing loop. My solution is to include % a "uniquecid" value as the /Action in both the event and the interest so % that we can't get these bogus events. % % There are some interesting techniques in here that you may feel free % to borrow. My favorite is the "condition" handler. A close runner-up % is the FTP password hack (thanks Don) and the date query. Please % do not use the keyboard handling as a model for input handling since % this code intentionally subverts the very mechanisms you should % generally be using. % % ------------ % Stan Switzer sjs@ctt.bellcore.com % % 3/27/89 - SJS % Release 1.0 % 3/29/89 - SJS % Cleaned up animation and timing mechanisms % 8/31/89 - SJS % Various clean-up activities in preparation for 1.1 release % Numerous hacks, tweaks and frobs. % 9/28/89 - SJS % Release 1.1 % Start a new dictionary here to prevent patching of the locking code, prevent % unauthorized access to the /Password entry, and to avoid systemdict % namespace pollution. gsave 100 dict begin { end } pop % { end } pop is to fool formatters! /default { % key val -> - def into current dictionary, val is default 1 index where { 2 index get exch pop } if def } def /BlankTime 180 default /LockTime 120 default /conprint { pop pop } def /Conprint { sprintf console exch writestring console flushfile } def % /conprint /Conprint load def % Colors: /SC { % key grayshade pastelhue-or-color -> - set color dup type /colortype ne { .35 1 hsbcolor } if % pastel hue ColorDisplay? not 3 1 roll ifelse dup type /colortype ne { dup dup rgbcolor } if % gray value default } def /BlankColor 0 0 0 0 rgbcolor SC /HourColor 1 .5 SC /MinColor 1 .5 SC /ClockColor 1 .5 SC /TextColor 1 .5 SC /QuoteColor 1 .5 SC % Is there to be a "server-exit button?" /BlankscreenExitButton true default % Generally, I prefer that users wishing to change the displayed verses do % so by defining the new verses before "running" this file. This way, we % can avoid unnecesary speciation of this program. /Poetry [ (`The time has come', the Walrus said,) ( `To talk of many things:) (Of shoes\320and ships\320and sealing wax\320) ( Of cabbages\320and kings\320) (And why the sea is boiling hot\320) ( And whether pigs have wings.') ( \320 Lewis Carroll) ] default % Likewise, I have defined hooks for you to specify your own animation. % Use them if at all possible. Redefine either proc, as convenient, % to create and/or select the animation. /CreateAnimationObject { % Canvas -> obj /AnimationClass Randomator def % default DefineAnimationClass % backward compatability /new AnimationClass send } default /DefineAnimationClass { % defines the default animation class % The user can redefine /AnimationClass here, using one of her own or % one of the following: % PoetryThing WorldBouncer WorldNeWSBouncer ClockThing % BounceClockThing StarField SkyRockets PoetryAndBouncer % WorldAndStars Circulator Randomator } default % By default we enable the color tricks, but they depend on the ability % of the server to keep retained unmapped canvases: /EnableColorTricks? true default % We are going to be paranoid and hoist certain non-operator procs into % our private dictionary to prevent insertion of trojan horses in the % password collection and checking logic. I know of a few holes here, but % I don't see the point of documenting them, if you get my drift. Still, % considering how "append," for instance, is used in here, it is only % prudent to protect ourselves. /CopyProc { % proc -> proc' dup type /arraytype eq { % array? dup xcheck exch 0 exch { % forall -- exec? n item CopyProc exch 1 add } forall array astore exch { cvx } if } if } def [ /append ] { % hoist these global procs ... dup load CopyProc def } forall /GetDate { % - -> (str) true -or- false { 25 dict begin % fork (to keep events from being confused) /Interest createevent dup begin /Name [ /TimeOut /Date ] def end dup expressinterest def /Timer Interest createevent copy dup begin /Name /TimeOut def /TimeStamp currenttime .25 add def end dup sendevent def (echo "createevent dup begin) ( /Name /Date def /Action (`date`)) append ( def end sendevent" | psh) append forkunix awaitevent dup /Name get /TimeOut eq { pop [ false ] } { Timer recallevent /Action get [ exch true ] } ifelse end } fork waitprocess aload pop } def /GetHHMMSS { % - -> hh mm ss true -or- false GetDate { 3 { ( ) search { % (true) post match pre { exch pop () ne { exit } if ( ) search not { exit } if } loop } if } repeat ( ) search 4 2 roll pop pop pop 2 { (:) search pop exch pop cvi exch } repeat cvi true } { false } ifelse } def /Midnight { Midnightproc waitprocess pop /Midnightproc null store Midnight } def /Midnightproc { /Midnight currenttime GetHHMMSS % try again if it didn't work (maybe server wasn't started yet) true { GetHHMMSS } ifelse % try still again if it didn't work (this time we'll wait a bit) true { 1 sleep GetHHMMSS } ifelse { % worked? 3 -1 roll 60 mul 3 -1 roll add exch 60 div add sub store true } { % not worked? pop pop false } ifelse } fork def % GetUserid: -> % false -- didn't work % (userid) true -- got user id /GetUserid { (USER) { getenv } errored { pop (LOGNAME) { getenv } errored { pop false } true ifelse } true ifelse } def % Check password using ftp server (Don Hopkins thought of using FTP). % % CheckPW: (userid) (password) -> % false -- check didn't work % ok? true -- OK? is true iff PW is correct % % NOTE: we wish to distinguish failure of the checking procedure from % failure of the check itself. /CheckPW { { 25 dict begin /Password exch def /User exch def /S (%socketc21) (rw) file def % socket /R { S exch readline } def % str -> str -- read from socket /W { S exch writestring S flushfile } def % str -> - -- write socket /SR { % (good) (bad) timeoutsec -> good? true -or- false -- srch /Time exch 60 div def /Interest createevent dup begin /Name /DoneEvent def end dup expressinterest def /Bad exch def /Good exch def /Match1 { anchorsearch { pop pop true } { pop false } ifelse } def /Match { dup type /arraytype eq { { Match1 { true exit } if } forall } { Match1 } ifelse } def /Str 200 string def /Proc { % fork { % loop Str R not { /Ugly exit } if dup Good Match { /Good exit } if dup Bad Match { /Bad exit } if pop } loop exch pop Interest createevent copy dup /Action 4 -1 roll put sendevent } fork def /Timer Interest createevent copy dup begin /Action /TimeOut def /TimeStamp currenttime Time add def end dup sendevent def awaitevent /Action get dup /TimeOut eq { Proc killprocess pop /Ugly } { Timer recallevent } ifelse dup /Ugly eq { pop false } { /Good eq true } ifelse Interest revokeinterest } def { % only once through: (220 ) (xxx ) 15 SR not { false exit } if not { false exit } if (user ) User append (\n) append W (331 ) [ (530 ) (500 ) ] 15 SR not { false exit } if not { false exit } if (pass ) Password append (\n) append W (230 ) [ (530 ) (500 ) ] 20 SR not { false exit } if true exit } loop dup 2 1 ifelse array astore (quit\n) W S closefile end } fork exch pop exch pop waitprocess aload pop } def /UserID GetUserid not (Unknown User) if def /BlanketCanvas framebuffer gsave dup setcanvas newcanvas /ptr /ptr_m 2 index setstandardcursor dup begin /Transparent false def /Retained false def /Mapped false def /EventsConsumed /AllEvents def end clippath dup reshapecanvas grestore def % Base class for animations. Handles animation timing and graphics context. % It is "abstract" in the sense that it doesn't make sense to instantiate it. % It must first be subclassed. /Animator Object dictbegin % abstract animator class /AnimatorProc null def /CanW 0 def /CanH 0 def /Canvas null def dictend classbegin % public methods: /new { % canvas -> obj /new super send begin /Canvas exch def gsave Canvas setcanvas clippath pathbbox grestore /CanH exch def /CanW exch def pop pop currentdict end } def /animate { % bool -> - AnimatorProc null ne { % Don't dance! /AnimatorProc dup load killprocess null def GSave FillColor fillcanvas grestore } if { % Dance! /AnimatorProc { %fork GSave InitAnimation Animate } fork def } if } def /paint { GSave gsave FillColor fillcanvas grestore DoPaint grestore } def /monitor_drag true def % Painting methods: /FillColor 0 def /TextColor TextColor def /Font currentfont def /GSave { gsave Canvas setcanvas TextColor setshade Font setfont } def /Paint nullproc def /DoPaint { Paint } def % Animation methods: /Interval 1 60 div def /Animate { createevent dup begin /Name /Animator def % shouldn't have to do this but newly created process sometimes % spoofs as previous one and gets the old event even tho it is % process-specific! /Action uniquecid def end dup expressinterest createevent copy { AnimateStep dup begin /TimeStamp pause currenttime Interval add def end sendevent awaitevent % leave event on stack } loop } def /AnimateStep nullproc def /InitAnimation nullproc def classend def % An "animated thing" class. Some graphical object moves around the screen, % either randomly, according to a "gravitational" trajectory, or according % to the whims of a subclass. It is semi-abstract in that it is intended to % be subclassed, but will work if used directly (it paints a rectangle at % random spots on the screen [big deal]). This class contains a useful % double buffering mechanism--perhaps this one will work regardless of % server canvas retaining policy. /AnimatedThing Animator dictbegin % semi-abstract animation class /X 0 def /Y 0 def dictend classbegin % public methods: /new { % canvas -> - /new super send begin DoubleBuffer? { InstallDoubleBuffer } if currentdict end } def % random motion (default): /MoveRandom { CanW CanH Size 3 -1 roll exch sub random mul cvi 3 1 roll sub random mul cvi exch /Y exch store /X exch store } def /MoveThing /MoveRandom load def % Alternative bouncing motion scheme. % just override as follows: % /MoveThing { MoveBounce } def /InitAnimation { InitBounce } def /dX 8 def /dY 0 def % velocity /d2X 0 def /d2Y -2 def % acceleration (default: down) /bounceX -1 def /bounceY -.95 def % rebound factors /countX 0 def /countY 0 def /maxCount 20 def /da2v { % d a -> v -- distance accel -> velocity mul dup 0 lt -2 2 ifelse mul sqrt cvi % (fizix 101) } def /Outside { % v x lowx highx -> false -or- closest true dup 3 index lt { 4 1 roll pop pop 0 ge { true } { pop false} ifelse } { pop dup 2 index gt { exch pop exch 0 le { true } { pop false} ifelse } { pop pop pop false } ifelse } ifelse } def /InitBounce { % reasonable way to intitialize a bounce /X 0 def /Y CanH Size exch pop sub def /dY 0 def } def /MoveBounce { /dX dX d2X add def /dY dY d2Y add def % acceleration /X X dX add def /Y Y dY add def % velocity Size % W H dX X 0 CanW 6 -1 roll sub Outside { % X rebound /X exch def /dX dX bounceX mul cvi def /countX countX 1 add def countX maxCount ge { /dX CanW Size pop sub d2X da2v def } if } { /countX 0 def } ifelse dY Y 0 CanH 5 -1 roll sub Outside { % Y rebound /Y exch def /dY dY bounceY mul cvi def /countY countY 1 add def countY maxCount ge { /dY CanH Size exch pop sub d2Y da2v def } if } { /countY 0 def } ifelse } def % Painting methods: /FillColor 0 def /TextColor TextColor def /Font currentfont def /GSave { gsave Canvas setcanvas TextColor setshade Font setfont } def /DoPaint { X Y moveto ComputeThing PaintThing } def /ComputeThing nullproc def /PaintThing { Paint } def % Double-buffering scheme: % (a good argument for multiple inheritance) /DoubleBuffer? false def /ColorBuffer? false def /InstallDoubleBuffer { /PaintThing { gsave currentpoint translate Size scale BufferCanvas ImageBufferCanvas grestore } def /ComputeThing { gsave BufferCanvas setcanvas gsave FillColor fillcanvas grestore TextColor setshade 0 0 moveto Paint grestore } def ColorBuffer? { /BuildBufferCanvas { gsave framebuffer dup newcanvas exch setcanvas 0 0 moveto Size rect dup reshapecanvas grestore dup /Retained true put dup /Transparent false put } def /ImageBufferCanvas { imagecanvas } def } if /BufferCanvas BuildBufferCanvas def } def /BuildBufferCanvas { % This would appear to be an officially recognized way % to create a for-sure retained canvas (it has to be parentless) % so we can't simply use newcanvas): Size 1 [ 3 index 0 0 5 index neg 0 1 index ] (some arbitrary initial image data) buildimage } def /ImageBufferCanvas { true exch imagemaskcanvas } def % Animation methods: /Interval 3 60 div def /AnimateStep { X Y Size % for rectpath, after ComputeThing MoveThing ComputeThing rectpath currentcolor FillColor setshade fill setcolor X Y moveto PaintThing } def % Default thing (a small rectangle) /Size { 20 20 } def % totally arbitrary /Paint { Size rect fill % totally arbitrary (gotta do something!) } def classend def % A clock /ClockThing AnimatedThing [] classbegin /ClockRad 36 def /MinHand { ClockRad .8 mul cvi } def /HourHand { ClockRad .45 mul cvi } def /PaintHand { % deg r -> - exch gsave rotate -4 -4 moveto 4 -4 lineto 0 exch lineto closepath fill grestore } def /PaintClock { % - -> - gsave ClockRad dup rmoveto currentpoint translate ClockColor setcolor gsave 12 { 30 rotate -2 ClockRad moveto 4 0 rlineto -2 -6 rlineto closepath fill } repeat grestore currenttime Midnight sub cvi dup 3600 mod 60 div HourColor setcolor -30 mul HourHand PaintHand MinColor setcolor 60 mod -6 mul MinHand PaintHand grestore } def /Paint /PaintClock load def /Size { ClockRad dup add dup } def classend def % A clock that bounces /BounceClockThing ClockThing [] classbegin /DoubleBuffer? true def /MoveThing { MoveBounce } def /InitAnimation { InitBounce } def /Interval .1 60 div def classend def % Propoganda /XBusters AnimatedThing [] classbegin % The official logo of the Ad-Hoc Committee to Rid the World of the % Evil Scourge of the X Windowing System % (In fairness, X has some meritorious features: resource database, % consistent command-line options, serviceable client-side toolkit % support, liberal color management policy, lots of PD S/W, and a % halfway decent terminal emulator, to name a few.) /Interval 15 60 div def /XColor ColorDisplay? { .5 1 .7 hsbcolor } .5 ifelse def /NoColor ColorDisplay? { 0 1 .5 hsbcolor } .25 ifelse def /XLogo { % n => - -- trace an n pt. X logo at current point matrix currentmatrix exch dup scale currentpoint translate currentpoint 0 1 moveto .25 1 lineto .556 .59 lineto .093 0 lineto 0 0 lineto .381 .49 lineto closepath 1 0 moveto .75 0 lineto .444 .41 lineto .907 1 lineto 1 1 lineto .619 .51 lineto closepath moveto setmatrix } def /NoSymbol { % n => - -- trace a "no" symbol at the current point matrix currentmatrix exch dup scale currentpoint translate currentpoint .5 .5 .5 0 360 arc closepath .5 .5 .38 35 235 arcn closepath .5 .5 .38 215 55 arcn closepath moveto setmatrix } def /NoXLogo { % n => - -- trace an n pt. "no X" logo at current point gsave dup NoSymbol NoColor setshade fill grestore gsave dup .1 mul dup rmoveto dup .8 mul XLogo XColor setshade fill grestore pop } def /Paint { Size gsave scale 1 NoXLogo grestore } def /Size { 300 dup } def classend def % Clock, logo, and poetry /PoetryThing ClockThing [] classbegin /Font /Times-Roman findfont 92 scalefont def /String (NeWS) def /Verses Poetry def /NVerses Verses null eq { 0 } { Verses length } ifelse def /Poetry? NVerses 0 gt def /ClockRad Poetry? 48 36 ifelse def /Vfont /Times-Roman findfont 14 scalefont def /LogoUp Poetry? 22 0 ifelse def /VerseNo 0 def /Verse { Verses VerseNo dup 0 lt 1 index NVerses ge or { pop /VerseNo 0 store 0 } if get } def /InitAnimation { /VerseNo -1 store } def /MoveThing { NextVerse /MoveThing super send } def /NextVerse { /VerseNo VerseNo 1 add store } def /Size { /Size super send exch GSave String stringwidth pop Vfont setfont Verses { stringwidth pop max } forall add exch 2 array astore cvx /Size exch def Size grestore } def /Paint { PaintClock ClockRad 2 mul 0 rmoveto gsave 0 LogoUp rmoveto String show grestore Poetry? { gsave Vfont dup setfont fontdescent 0 exch rmoveto QuoteColor setcolor Verse show grestore } if } def classend def % Abstract class to bounce a sequence of images /ImageBouncer AnimatedThing [ /ImageList /N ] classbegin % NB: abstract class /new { % imagelist canvas -> thing /new super send begin /ImageList exch def /N 0 def currentdict end } def % class method! /genlist { % (prefix) (suffix) n -> [ imagelist ] [ 4 1 roll 1 exch 1 exch { % for: mark ... (pre) (suf) i 2 index exch (XXXX) cvs append 1 index append 3 1 roll } for pop pop ] } def /DoubleBuffer? true def /CurrImage { % - -> image ImageList N get dup type /stringtype eq { pause readcanvas pause ImageList N 2 index put } if } def /MoveThing { MoveBounce /N N 1 add dup ImageList length ge { pop 0 } if def } def /InitAnimation { InitBounce } def /WColor .3 1 .4 hsbcolor def /OColor .5 .5 .65 hsbcolor def /TwiddleColors nullproc def % yuck (yuck)! /Paint { gsave currentpoint translate Size scale ColorBuffer? { TwiddleColors } if false CurrImage imagemaskcanvas grestore } def /Interval .05 60 div def classend def % Bounce the world /WorldBouncer ImageBouncer [] classbegin /new { % canvas -> thing GlobeList exch /new super send } def /TwiddleColors { .5 .5 .5 0 360 arc OColor setcolor fill WColor setcolor } def ColorDisplay? EnableColorTricks? and { /ColorBuffer? true def } if /Size { 64 64 } def classend def % List of Globes, shared among various classes /GlobeList (NEWSHOME) getenv (/smi/globes/globe) append (.im1) 30 /genlist ImageBouncer send def % Crass commercialism /WorldNeWSBouncer WorldBouncer [] classbegin /Font { /Times-Roman findfont /Size super send exch pop scalefont /Font 1 index def } def /Size { /Size super send exch gsave Font setfont (NeWS) stringwidth pop grestore add exch 2 array astore cvx /Size exch def Size } def /Paint { gsave currentpoint translate gsave Size exch pop dup scale false CurrImage imagemaskcanvas grestore Size exch pop 0 moveto (NeWS) show grestore } def /ColorBuffer false def classend def % A field of stars, though it might be taken for "granite" /StarField Animator dictbegin /NStars 0 def /Count 0 def dictend classbegin /maxCount 10 def /maxNStars 30 def /minNStars 15 def /AnimateStep { NStars { CanW random mul cvi CanH random mul cvi moveto random .4 le { % blank a patch random 1 add 5.5 mul cvi 0 } { % color a patch random 1.2 mul 1 add cvi ColorDisplay? { 3 { random .3 mul .7 add } repeat rgbcolor } 1 ifelse } ifelse setshade dup rect fill } repeat /Count Count 1 sub def Count 0 lt { /Count maxCount def NStars minNStars gt { /NStars NStars 1 sub def } if } if } def /InitAnimation { /NStars maxNStars def /Count maxCount def } def /DoPaint { InitAnimation } def /Interval .2 60 div def classend def % Simple skyrockets animation, explosion more of a fizzle /SkyRockets AnimatedThing [ /State /dLim1 /dLim2 /explR ] classbegin /Interval .05 60 div def /InitAnimation { % Launch it: /State /Ball def /X CanW random mul cvi def /dX 30 random .5 sub mul cvi def /Y 0 def /dY CanH Size exch pop sub d2Y da2v def % to top /dY dY random 4 div .75 add mul cvi def % times .75 to 1.0 /dLim1 dY -.7 random mul mul cvi def % explode /dLim2 dY -.85 random mul mul cvi def % fizzle dLim1 dLim2 lt { /dLim2 dLim1 /dLim1 dLim2 def def } if } def /MoveThing { MoveBounce dY dLim1 lt { /State /Explode def /explR 4 def } if dY dLim2 lt { InitAnimation } if } def /Size { 60 60 } def /Paint { gsave Size 2 idiv exch 2 idiv exch rmoveto currentpoint translate State { % case /Ball { % -2 -2 5 5 rectpath fill 0 0 3 0 360 arc fill } /Explode { 6 { 120 random mul cvi rotate explR random mul 0 moveto explR 2 mul random .5 add mul 0 lineto stroke } repeat /explR explR 4 add def } } case grestore } def classend def % Run several animations together /Tandomator Object [ /Canvas /Animators ] classbegin % NB: abstract class /new { % canvas classarray -> obj /new super send begin exch /Canvas exch def /Animators exch [ exch { Canvas exch /new exch send } forall ] def currentdict end } def /animate { Animators { 1 index exch /animate exch send } forall pop } def /paint { % Animators { /paint exch send } forall % the "right" way /paint Animators 0 get send % the hack way } def /monitor_drag { true Animators { /monitor_drag exch send and } forall } def classend def % What it sez... /PoetryAndBouncer Tandomator [] classbegin /new { [ PoetryThing WorldBouncer ] /new super send } def classend def % Likewise... /WorldAndStars Tandomator [] classbegin /new { [ StarField WorldBouncer ] /new super send } def classend def % A list of interesting animations to be used by the "Randomator" % and "Circulator." These can be modified in "CreateAnimationObject." /Animations [ PoetryThing % historical interest (sentimental artifact?) WorldNeWSBouncer PoetryAndBouncer WorldAndStars SkyRockets XBusters % propoganda alert! % WorldBouncer StarField % boring but servicable % ClockThing BounceClockThing % just plain boring ] def % Select from among Animations using menu /Selectomator Tandomator [ /Nanimators /Current /N /SelectionMenu ] classbegin /new { % canvas -> obj Animations /new super send begin /Nanimators Animators length def /N 0 def /SelectionMenu [ Animators { /ClassName exch send 50 string cvs } forall ] [ { currentindex { false animate /N exch def true animate } Animation send } ] /new DefaultMenu send { % Make the menu a child of the "blanket" canvas so that it % can never end up "behind" it. Easy, right? Wrong! % This is all I should need to do: /ParentCanvas BlanketCanvas def % but I need these hacks too :-( % 1) because LiteMenu slopily uses "framebuffer" in some places % where it should use "ParentCanvas": /framebuffer BlanketCanvas def % 2) Because LiteMenu depends on obnoxious behavior of % "newcanvas" (in particular, that children of "framebuffer" % have different default attributes than all others): /showat { % instance method ;-) MenuCanvas null eq { /MenuCanvas ParentCanvas newcanvas def MenuCanvas /Retained RetainCanvas? put MenuCanvas /Transparent false put MenuCanvas /EventsConsumed /AllEvents put MenuWidth null eq { layout } if reshape } if % instance method "super send" hack: /showat ParentDict supersend } def } 1 index send def { % fork createevent dup /Name MenuButton put dup /Action /DownTransition put dup /Canvas Canvas put expressinterest { awaitevent /IgnoreClick? true store /showat SelectionMenu send } loop } fork pop currentdict end } def /animate { Current null ne { false /animate Current send /Current null def } if { /Current Animators N get def true /animate Current send } if } def /paint { Current null ne { /paint Current send } if } def /monitor_drag false def classend def % Cyclicly choose from among the animations above /Circulator Selectomator [] classbegin /animate { dup /animate super send { /N N 1 add def N Nanimators ge { /N 0 def } if } if } def classend def % Randomly choose from among the animations above /Randomator Circulator [] classbegin /new { /new super send dup begin Randomize end } def /Randomize { /N Nanimators random mul cvi dup Nanimators ge { pop 0 } if def } def /animate { dup /animate super send { Randomize } if } def classend def /Animation BlanketCanvas CreateAnimationObject def % It would probably be better to subclass the following from some form of % Item. However, to prevent sneaky code inserted in LiteItem from stealing % passwords, we write it from scratch. This is turning out to be a real % Robinson Crusoe (Gilligan's Island?) adventure. /MessageCanvas Object dictbegin /Canvas null def /Message () def /EventProc null def dictend classbegin /Width 350 def /Height 85 def /CornerRadius 10 def /FillColor 1 def /TextColor 0 def /Font /Times-Roman findfont 18 scalefont def /new { /new super send begin % canvas -> obj /Canvas gsave exch dup setcanvas newcanvas dup begin /Transparent false def /Retained false def /Mapped false def end def grestore currentdict end } def /MessagePath { CornerRadius 5 1 roll rrectpath } def /reshape { % x y w h -> - gsave Canvas /Parent get setcanvas 4 2 roll translate 0 0 4 2 roll MessagePath Canvas reshapecanvas grestore } def /ExpressInterests { % Damage Repair createevent dup /Name 1 dict dup begin /Damaged { { GSave damagepath clipcanvas Paint newpath clipcanvas grestore } self 0 pop send } def end put dup /Canvas Canvas put expressinterest } def /StartEventProc { /EventProc { % fork ExpressInterests { awaitevent pop } loop } fork def } def /setmessage { /Message exch def paint } def /map-it { % bool -> - dup { EventProc null eq { StartEventProc } if } if Canvas /Mapped 3 -1 roll put } def /Paint { % - -> - gsave FillColor fillcanvas grestore Width Message stringwidth pop sub .5 mul Height currentfont fontascent sub .5 mul moveto Message show } def /GSave { gsave Canvas setcanvas Font setfont TextColor setshade } def /paint { GSave Paint grestore } def classend def % Error message canvas: /RaspberryMessage BlanketCanvas /new MessageCanvas send { clippath pathbbox 4 2 roll pop pop exch Width sub 2 idiv exch Height sub 2 idiv Width Height reshape } 1 index send def % Password query canvas: /QueryMessage BlanketCanvas /new MessageCanvas send { /Paint { gsave FillColor fillcanvas grestore 12 60 moveto (Userid: ) show UserID show 12 40 moveto (Password: ) show % Password show (#%*&@!%&@#X?#No!*NeWS!*%$#@$@!) % cryptic missive dup length 0 exch PWpos min getinterval show 2 0 rmoveto 5 -5 rlineto -11 0 rlineto closepath fill 30 15 moveto Message show } def clippath pathbbox 4 2 roll pop pop exch Width sub 2 idiv exch Height sub 2 idiv Width Height reshape } 1 index send def /ButtonCanvas MessageCanvas dictbegin /Inside? false def dictend classbegin /UpColor 1 def /DownColor .5 def /FillColor { Inside? DownColor UpColor ifelse } def /Notify nullproc def /ButtonDown { null blockinputqueue { % fork createevent dup /Action 1 dict dup begin /UpTransition { dup /Name get PointButton eq { Inside? { Notify } if } if exit } def end put expressinterest createevent dup /Name 2 dict dup begin /EnterEvent { /Inside? true store paint } def /ExitEvent { /Inside? false store paint } def end put dup /Canvas Canvas put expressinterest unblockinputqueue /Inside? true store paint { awaitevent pop } loop } fork } def /ExpressInterests { /ExpressInterests super send % Left Mouse click: createevent dup /Name 1 dict dup begin PointButton { /ButtonDown self 0 pop send } def end put dup /Canvas Canvas put dup /Action /DownTransition put expressinterest } def classend def /ExitButton null BlankscreenExitButton { pop BlanketCanvas /new ButtonCanvas send { /Message (Exit NeWS) def /Notify {exitcleanly} def GSave /Height currentfont fontheight 20 add def /Width Message stringwidth pop 20 add def grestore { Canvas getcanvaslocation } QueryMessage send exch 400 add exch Width Height reshape } 1 index send } if def /nouse /nouse_m BlanketCanvas setstandardcursor /PWstring 100 string def /PWpos 0 def /Password () def /AddPW { PWpos PWstring length lt { PWstring PWpos 3 -1 roll put /PWpos PWpos 1 add store /Password PWstring 0 PWpos getinterval store } { pop } ifelse % Thanks Don } def /DelPW { /PWpos PWpos 1 sub 0 max store /Password PWstring 0 PWpos getinterval store } def /ClearPW { /PWpos 0 store /Password PWstring 0 PWpos getinterval store 0 1 Password length 1 sub { Password exch 0 put } for % zero PW string } def /seconds { 60 div } def /Member? { % item array -> bool false 3 1 roll { % forall 1 index eq { exch pop true exch } if } forall pop } def /Secure? { State { /Lock /Query /Check /Raspberry } Member? } def /State null def % Timer while in state: /StateTimes 10 dict dup begin /Sleep 15 BlankTime 2 div min seconds def /Monitor BlankTime seconds def /Blank LockTime seconds def /Lock 0 def /Query 30 seconds def /Check 0 def /Raspberry 5 seconds def end def /Conditions [ dictbegin % Invisible monitoring: /Condition { State /Monitor eq } def /Enter { MonitorClicks expressinterest MonitorMouseDrag expressinterest } def /Leave { MonitorClicks revokeinterest MonitorMouseDrag revokeinterest } def dictend dictbegin % Screen is blanked: /Condition { State { /Blank /Lock /Query /Check /Raspberry } Member? } def /Enter { true /animate Animation send pause BlanketCanvas canvastotop BlanketCanvas /Mapped true put } def /Leave { BlanketCanvas /Mapped false put false /animate Animation send } def /Remain { BlanketCanvas canvastotop } def dictend dictbegin % Keyboard and mouse monitoring when blanked: /Condition { State { /Blank /Lock /Raspberry } Member? } def /Enter { MonitorClicks expressinterest /monitor_drag Animation send { MonitorMouseDrag expressinterest } if } def /Leave { MonitorClicks revokeinterest MonitorMouseDrag /IsInterest get { MonitorMouseDrag revokeinterest } if } def dictend dictbegin % Querying: /Condition { State /Query eq } def /Enter { ClearPW (Enter Password.) /setmessage QueryMessage send QueryInterests /expressinterest load forall } def /Leave { QueryInterests /revokeinterest load forall } def dictend dictbegin % Checking: /Condition { State /Check eq } def /Enter { (Checking Password.) /setmessage QueryMessage send CheckInterest expressinterest } def /Leave { CheckInterest revokeinterest } store dictend dictbegin % Querying or checking: /Condition { State { /Query /Check } Member? } def /Enter { true /map-it QueryMessage send ExitButton null ne { true /map-it ExitButton send } if /ptr /ptr_m BlanketCanvas setstandardcursor } def /Leave { false /map-it QueryMessage send ExitButton null ne { false /map-it ExitButton send } if /nouse /nouse_m BlanketCanvas setstandardcursor } def dictend dictbegin % Error Message /Condition { State /Raspberry eq } def /Enter { true /map-it RaspberryMessage send } def /Leave { false /map-it RaspberryMessage send } def dictend ] def % General-purpose condition handler: monitors changes to boolean conditions % and invokes associated handling routines. /HandleConditions { 0 begin Conditions { % forall begin /Value Condition def % evaluate condition Prev Value { { True Same Remain Was } % Is and was { True Different Enter WasNot } % Is and was not } { { False Different Leave Was } % Is not and was { False Same Desists WasNot } % Is not and was not } ifelse ifelse /Prev Value def end } forall end } dup 0 dictbegin /Prev false def % initial value of the condition /Condition {false} def % Condition check proc { /True /False /Enter /Leave /Same /Different /Remain /Desists /Was /WasNot } { nullproc def } forall dictend put def % Change to a new state: /newState { % state -> - (>> % -> %\n) [ State 3 index ] conprint /State exch store HandleConditions TimerEvent /IsQueued get { TimerEvent recallevent } if StateTimes State get dup 0 eq { pop } { (>> Time %\n) [ 2 index ] conprint TimerEvent dup /TimeStamp 4 -1 roll pause currenttime add put sendevent } ifelse } def /SBInitialize { % Express interests, etc. % Must be done in the forked event, so it must be part of a proc. % Still, it'll only be executed once, so after it is executed, we % free up some server memory by having it delete itself! % What to do when the timer expires: /TimerInterest createevent dup begin /Name 2 dict dup begin /Timer { State { % case /Sleep { /Monitor newState } /Monitor { /Blank newState } /Default { /Lock newState } } case } def end def % avoid spurious events from reuse of proocess tbl of killed proc: /Action uniquecid def end dup expressinterest def % External control: /ControlInterest createevent dup begin /Name /BlankScreen def /Action 5 dict dup begin /Destroy { Secure? not { currentprocess killprocessgroup } if } def /Blank { Secure? not { /Blank newState } if } def /Lock { /Lock newState } def /Query { /Query newState } def end def end dup expressinterest def % We clone this event from the interest to get the /Process value: /TimerEvent TimerInterest createevent copy dup begin /Name /Timer def end def /IgnoreClick? false def /MonitorClicks createevent dup begin /Priority 20 def /Exclusivity true def /Action 1 dict dup begin /DownTransition { /IgnoreClick? false def dup redistributeevent pause pause IgnoreClick? not { Secure? /Query /Sleep ifelse newState } if } def end def end def /MonitorMouseDrag createevent dup begin /Priority 5 def /Exclusivity true def /Name 1 dict dup begin /MouseDragged { dup redistributeevent pause Secure? { /Query newState } { /Sleep newState } ifelse } def end def end def % Canvas damage interest createevent dup begin /Name 1 dict dup begin /Damaged { gsave BlanketCanvas setcanvas damagepath clipcanvas /paint Animation send newpath clipcanvas grestore } def end def /Canvas BlanketCanvas def end expressinterest % It is important to understand that this is THE HARD WAY to get keyboard % input and it is done this way solely to subvert the focus manager. % Normally, you would want to cooperate with the focus manager and use % addkbdinterests (which is MUCH simpler). /QueryInterests [ createevent dup begin /Priority 20 def /Name ascii_keymap def /Action 2 dict dup begin /DownTransition { dup /Name get dup 32 ge 1 index 127 lt and { % printable ASCII dup AddPW /paint QueryMessage send } if dup 8 eq 1 index 127 eq or { % BS or DEL DelPW /paint QueryMessage send } if dup 24 eq 1 index 21 eq or { % ^X or ^U ClearPW /paint QueryMessage send } if dup 3 eq { % ^C /Lock newState } if dup 10 eq 1 index 13 eq or { % CR or LF /Check newState { UserID Password ClearPW CheckPW { % worked null (Bad Password) ifelse } (Check Failed) ifelse CheckInterest createevent copy begin /Name /PWresult def /Action exch def currentdict end sendevent } fork pop } if pop } def end def /Exclusivity true def end createevent dup begin % Handle shifts here % priority below key processing /Priority 19 def /Name 20 dict dup begin % reverse engineering at its worst... keyboard_positions { % forall dup 0 get type /arraytype ne { [ exch ] } if % Name [ [key class] [key class] ... ] { % forall aload pop /shift_key ne { pop } { % Name key [ /dup cvx UI_private /begin cvx 5 index /do_shift_key cvx /end cvx ] cvx % Name key { dup D begin Name do_shift_key end } def % in /Name entry of this this interest } ifelse } forall pop } forall end def /Exclusivity true def end createevent dup begin % absorb all other KB & mouse clicks % priority below shift processing /Priority 18 def /Exclusivity true def /Action 1 dict dup begin /DownTransition { dup /Name get type /integertype ne { % let mouse clicks fall through dup redistributeevent } if } def end def end ] def /CheckInterest createevent dup begin /Name 1 dict dup begin /PWresult { dup /Action get dup null eq { % OK pop /Sleep } { /setmessage RaspberryMessage send /Raspberry } ifelse newState } def end def /Canvas /Canvas QueryMessage send def % avoid fraud! end def /Sleep newState currentdict /SBInitialize undef % poof! } def /ScreenBlank { SBInitialize % express interests, etc. { % Event processing loop: awaitevent dup type /arraytype eq { /exec load forall } if (>> Event % % % -> %\n) exch [ exch begin Name Action Canvas end State ] conprint } loop } def % kill our illustrious predecessors createevent dup begin /Name /BlankScreen def /Action /Destroy def end sendevent % bind specified F-keys /BlankFKey where { pop BlankFKey { createevent dup begin /Name /BlankScreen def /Action /Blank def end sendevent } bindkey } if /LockFKey where { pop LockFKey { createevent dup begin /Name /BlankScreen def /Action /Lock def end sendevent } bindkey } if % let the dust settle before we enter the fray! pause pause BlankTime 0 ne { { newprocessgroup ScreenBlank } fork pop } if { begin } pop end grestore % do it this way to fool formatters!