sjs@spectral.ctt.bellcore.com (Stan Switzer) (01/27/89)
On a tip from a well-known NeWS jockey, I made a simple but quite
interesting change to my "bouncing world demo." After firing this
off, play around with some of the menu options. Of particular
interest are the "Bump" and "Boing" controls.
If you are using non-retained canvases (color) it'll work better when
it's over a simple background (the root screen, for instance).
Be sure to check out the icon too.
Stan Switzer sjs@ctt.bellcore.com
"However glorous the mind's conception,
alien matter will in time intrude.
Whenever we achieve some good on our earth,
the better things are labeled frauds and fantasies.
The ecstasies that launched us on this life
congeal in the muddled business of living."
-- Goethe
----------------
#!/usr/NeWS/bin/psh
%
% wbounce: Drop everything
%
% Copyright (C) 1988, 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.
%
% Credit where credit's due:
% Bump and Boing concept suggested by Don Hopkins.
% various useful GP utilities:
/outside { % x lowx highx => false -or- closest true
dup 3 index lt
{ 3 1 roll pop pop true }
{ pop dup 2 index gt
{ exch pop true }
{ pop pop false } ifelse
} ifelse
} def
/decrease { % n decr => n' -- decrease n toward zero, not beyond
exch dup 0 lt
{ add dup 0 gt { pop 0 } if }
{ exch sub dup 0 lt { pop 0 } if }
ifelse
} def
% Sleazy way to modify enclosing window variables
/W+ { % /name incr =>
ThisWindow begin exch dup load 3 -1 roll add store end
} def
/W* { % /name factor =>
ThisWindow begin exch dup load 3 -1 roll mul store end
} def
/W= { % /name val =>
ThisWindow begin store end
} def
/BouncingThing DefaultWindow
dictbegin
/ThingWidth 32 def
/ThingHeight 32 def
/SqueezeX 0 def
/SqueezeY 0 def
/UnSqueeze 3 def
/Bump 0 def
/Boing 0 def
/Bcount 0 def
/MovingAllowed? true def
/Xcount 0 def
/Ycount 0 def
/MaxCount 12 def
/X 0 def
/Y 0 def
/dX 16 def
/dY 0 def
/d2X 0 def
/d2Y -2 def
/dT .10 60 div def
/dragX 0 def
/dragY .25 def
/ClientFillColor 1 def
/ThingColor 0 def
/FrameLabel (Bouncing Thing) def
/CanW 0 def /CanH 0 def
/AnimateProcess null def
/PaintClient { ClientFillColor fillcanvas show-thing } def
/wheredrawn null def
dictend
classbegin
/new {
/new super send begin
/wheredrawn 4 array store
/ClientMenu [
(Bigger) { /ThingWidth 4 W+ /ThingHeight 4 W+ }
(Smaller) { /ThingWidth -4 W+ /ThingHeight -4 W+ }
(Flatter) { /ThingWidth 4 W+ }
(Taller) { /ThingHeight 4 W+ }
(Faster) { /dT 1 1.5 div W* }
(Slower) { /dT 1.5 W* }
(More Gravity) { /d2Y -1 W+ }
(Less Gravity) { /d2Y 1 W+ }
(More Drag) { /dragY .05 W+ }
(Less Drag) { /dragY -.05 W+ }
(More Bump) { /Bump 2 W+ }
(Less Bump) { /Bump -2 W+ }
(More Boing) { /Boing 1 W+ }
(Less Boing) { /Boing -1 W+ }
(Zap!) { /destroy ThisWindow send }
(Zap!) { /destroy ThisWindow send }
] /new DefaultMenu send dup begin
/LayoutStyle [ 8 2 ] def
end def
currentdict end
} def
/flipiconic {
/flipiconic super send
} def
/start {
true animate
} def
/stop {
false animate
} def
/animate {
{ AnimateProcess null eq
{ /AnimateProcess { animateproc } fork store }
{ AnimateProcess continueprocess } ifelse
} {
AnimateProcess null ne
{ AnimateProcess suspendprocess } if
} ifelse
} def
/reshape { % x y w h => -
/reshape super send
gsave
ClientCanvas setcanvas clippath pathbbox 4 -2 roll pop pop % w h
/CanH exch store /CanW exch store
grestore
} def
/erase-thing { % X Y Width Heigth => -
rectpath ClientFillColor setshade fill
} def
/compute-thing nullproc def % X Y Width Heigth => X Y Width Height
/draw-thing { % X Y Width Height => - % intended to be overriden
rectpath fill
} def
/show-thing { % - => -
X cvi Y cvi Width cvi Height cvi
/compute-thing self send
wheredrawn aload pop /erase-thing self send
ThingColor setshade
4 copy wheredrawn astore pop
/draw-thing self send
} def
/animate-step { % - => -
% flags
/DoBump false def
/DoBoing false def
% acceleration
/dX dX d2X add store
/dY dY d2Y add store
% velocity
/X X dX add store
/Y Y dY add store
% "friction"
/dX dX dragX decrease store
/dY dY dragY decrease store
% position (bounce off of walls)
123
X 0 CanW Width sub outside { % X rebound
/X exch store /dX dX neg store
Xcount 1 add dup /Xcount exch store MaxCount gt
{ /dX dX kickX add X 0 ne { neg } if store } if
/SqueezeX ThingWidth .5 mul store
X 0 ne { /X X SqueezeX add store } if
Bump 0 ne { /DoBump true def } if
} { % no rebound
/Xcount 0 store
/SqueezeX SqueezeX UnSqueeze sub dup 0 lt { pop 0 } if store
} ifelse
Y 0 CanH Height sub outside { % Y rebound
/Y exch store /dY dY neg store
Ycount 1 add dup /Ycount exch store MaxCount gt
{ /dY dY kickY add Y 0 ne { neg } if store } if
/SqueezeY ThingHeight .5 mul store
Y 0 ne { /Y Y SqueezeY add store } if
Boing 0 ne { /DoBoing true def } if
} { % no rebound
/Ycount 0 store
/SqueezeY SqueezeY UnSqueeze sub dup 0 lt { pop 0 } if store
} ifelse
% draw it
ClientCanvas setcanvas
show-thing
MovingAllowed? {
DoBump {
Iconic? { IconX IconY } { FrameX FrameY } ifelse
Bump X 0 eq { neg } if 3 -1 roll add exch move
} if
DoBoing {
/BoingFac Boing Y 0 eq { neg } if
dY 2 sub dup 0 lt { pop 0 } if dup mul .01 mul
mul cvi def
Iconic? { IconX IconY } { FrameX FrameY } ifelse
BoingFac add move
/Bcount Bcount BoingFac add def
} {
Bcount 0 ne {
Iconic? { IconX IconY } { FrameX FrameY } ifelse
Bcount 0 lt 1 -1 ifelse add move
/Bcount Bcount dup 0 gt -1 1 ifelse add def
} if
} ifelse
} if
123 ne { ZZZ } if
} def
/slide { % avoid problem with bounce and boing
{
/MovingAllowed? false store
GetCanvas setcanvas
InteractionLock { interactivemove } monitor
currentcanvas ParentCanvas setcanvas getcanvaslocation
/move self send
/MovingAllowed? true store
} fork pop
} def
/kickX { CanW Width sub d2X mul abs dup add sqrt } def
/kickY { CanH Height sub d2Y mul abs dup add sqrt } def
/Width { ThingWidth SqueezeX sub } def
/Height { ThingHeight SqueezeY sub } def
/animateproc { % - => -
% initial conditions
/X 0 store
/Y CanH Height sub store
X Y ThingWidth ThingHeight wheredrawn astore pop
% create a timer event event interest
/TimerInterest createevent store
TimerInterest begin
/Name /DelayOver def
currentdict end dup expressinterest
% create a timer event and start it off
createevent copy begin
/TimeStamp currenttime dT add def
currentdict end sendevent
{ % loop
awaitevent begin
/TimeStamp
% TimeStamp % Makes up for lost time
currenttime % Accepts its loss
dT add def
currentdict end sendevent
% and do a step
animate-step
} loop
} def
classend def
/BouncingWorld BouncingThing
dictbegin
/ClientFillColor 0 def
/ThingColor ColorDisplay? { 0 1 0 rgbcolor } { 1 } ifelse def
/FrameLabel (Bouncing World) def
/NImages 30 def
/ImageNo 0 def
/ImageVec null def
dictend
classbegin
/new {
/new super send begin
/ImageVec [ 1 1 NImages { pop null } for ] store
currentdict end
} def
/IconImage /globe def
/IconPath { scale .5 .5 .5 0 360 arc } def
/LoadImage { % nbr => image -- side-effect, saves image in vec
ImageVec exch dup 1 add
10 string cvs (/usr/NeWS/smi/globes/globe) exch append
(.im1) append readcanvas dup 4 1 roll put
} def
/Image { % - => image
ImageNo dup ImageVec exch get % nbr image-or-null
dup null eq { pop dup LoadImage } if % nbr image
exch 1 add dup NImages ge { pop 0 } if /ImageNo exch store % image
} def
/draw-thing { % X Y W H => -
gsave 4 2 roll translate scale
false Image imagemaskcanvas
grestore
} def
classend def
% Following is same w/ double-buffering.
/FasterBouncingWorld BouncingWorld
dictbegin
/FrameLabel (Double-Buffered Bouncing World) def
/TmpCan null def
dictend
classbegin
/new {
/new super send begin
/TmpCan framebuffer newcanvas store
TmpCan /Transparent false put
TmpCan /Retained true put
currentdict end
} def
/compute-thing { % X Y W H => X Y W H -- precompute the image
gsave framebuffer setcanvas
0 0 moveto 2 copy rect TmpCan reshapecanvas
TmpCan setcanvas
ClientFillColor fillcanvas
ThingColor setshade
0 0 moveto 2 copy scale
false Image imagemaskcanvas
grestore
} def
/draw-thing { % X Y W H =>
gsave 4 2 roll translate scale
TmpCan imagecanvas
grestore
} def
classend def
% Tilted bouncing world
/TiltedBouncingWorld BouncingWorld
dictbegin
/FrameLabel (Tilted Bouncing World) def
dictend
classbegin
% draw it tilted
/draw-thing { % X Y W H => -
gsave 4 2 roll translate scale
.5 .5 translate -22.5 rotate -.5 -.5 translate
true Image imagemaskcanvas
grestore
} def
% eliminate screen sh*t
/erase-thing { % X Y Width Heigth => -
4 add 4 1 roll 4 add 4 1 roll 2 sub 4 1 roll 2 sub 4 1 roll
rectpath ClientFillColor setshade fill
} def
classend def
/win framebuffer /new FasterBouncingWorld send def
/reshapefromuser win send
/map win send
/start win send
% win begin AnimateProcess waitprocess % to wait, if we want to use == for dbg