%!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% PostScript Structure CyberSpace
% Copyright (C) 1989
% By Don Hopkins
% All rights reserved.
%
% WARNING WARNING! DANGER! DANGER WILL ROBINSON! DANGER!
% This is *gross* code. I mean UUUUUGLY! I wrote it the week before Usenix.
% You're damn right it needs to be rewritten. But you get the idea, ehe?
systemdict begin
statusdict begin
0 setjobtimeout
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Load necessary stuff
systemdict /NeWSScrollbar known not
{
(/usr/NeWS/clientsrc/client/nterm/NeWSSbar.ps) LoadFile
} if
systemdict /TextCanvas known not
{
(/usr/NeWS/clientsrc/client/nterm/textcan.ps) LoadFile
} if
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% StructItem class definition
/StructItem LabeledItem
dictbegin
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Instance variables
/Shrink .8 def
/Pad 3 def
/StartPoint 14 def
/Point StartPoint def
/x 0 def
/y 0 def
/Levels 0 def
/DL null def
/UpdateDL? true def
/ItemFrame 2 def
/ItemRadius 5 def
/ItemBorder 6 def
/ItemButton [PointButton MenuButton] def
/StackI null def
/LayoutLock null def
/LastX 0 def
/LastY 0 def
/LastTime 0 def
/DX 0 def /DY 0 def
/TabX 0 def /TabY 0 def /TabWidth 0 def /TabHeight 0 def
/PinX 0 def
/PinHeight 0 def
/DropShadow 6 def
dictend
classbegin
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Class variables
/DoubleClickTime 1 60 div def
/CanvasYFudge 2 store
/Sort? true def
/SlidePower .4 store
/SlideSpeed .05 60 div store
/MaxV .1 store
/LineGap 30 def
/ItemLabelFont /Helvetica-Bold findfont 14 scalefont def
/ItemFont /Courier findfont def
/ItemXFont /Courier-Oblique findfont def
/Icon? false def
/SortBy /by-name def
/View /layout-struct def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Initialization stuff
/new { % Collection Index notifyproc parentcanvas => instance
4 2 roll 2 copy get type (% \267) sprintf % notify parent cont ind label
5 1 roll 2 array astore % label notify parent object
3 1 roll /Right % label object notify parent loc
3 1 roll % label object loc notify parent
/new super send begin
ItemCanvas /Transparent false put
ItemCanvas /Retained true put
/LayoutLock createmonitor def
currentdict end
} def
/ensure-DL {
UpdateDL? {
Collection Index Levels grow-struct
/DL exch store
/ObjectWidth 0 store /ObjectHeight 0 store
/UpdateDL? false store
} if
ObjectWidth 0 eq ObjectHeight 0 eq or {
perform-layout
} if
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Event handlers
/ClientDown {
CurrentEvent update-shifts
CurrentEvent /Name get MenuButton eq {
event-in-tab? {
show-tab-menu
} {
show-struct-menu
} ifelse
} if
} def
/show-tab-menu {
userdict /it self put
CurrentEvent /showat TabMenu send
} def
/show-struct-menu {
ItemBegin
userdict /it self put
do-search
ob null ne {
CurrentEvent /showat StructMenu send
} if
ItemEnd
} store
/ClientUp {
CurrentEvent update-shifts
CurrentEvent /Name get PointButton eq {
NotifyUser
} if
StopItem
} def
/click-point {
ItemBegin
event-in-tab? {
point-tab
} {
point-struct
} ifelse
ItemEnd
} def
/point-tab {
DL begin gsave
/Icon? Icon? not def
Icon? {
/OW ObjectWidth def
/OH ObjectHeight def
Font setfont Str stringbbox points2rect
/IconH exch def /IconW exch def
/ObjectWidth IconW store
/ObjectHeight IconH store
} {
/ObjectWidth OW store
/ObjectHeight OH store
} ifelse
grestore end
redo-shape
/LastTime 0 store
} def
/point-struct {
ItemCanvas setcanvas
CurrentEvent begin
LastX XLocation sub dup mul LastY YLocation sub dup mul add
end
4 lt currenttime LastTime sub DoubleClickTime lt and not {
% first click
/it self store
do-search
userdict /ob get null ne {
Shift { % Shift to select the index
ob /I get
} {
ob /Obj get
} ifelse
/LastTime currenttime store
Control {
exec-it
/LastTime 0 store
} {
select-object
} ifelse
} if
ItemCanvas setcanvas
CurrentEvent begin
/LastX XLocation store /LastY YLocation store
end
} {
% double clicks
ob null ne {
DL begin Icon? end {
point-tab
} {
open-struct
} ifelse
} if
/LastTime 0 store
} ifelse
} store
/event-in-tab? {
ItemBegin
newpath label-bbox rectpath
CurrentEvent begin XLocation YLocation end pointinpath
ItemEnd
} def
/ClientExit {
StopItem
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Menu definitions
/PointMenu [
(2) (4) (6) (8) (10) (12) (14) (16) (18) (20) (22) (24) (28) (32)
] [
{currentkey cvi {/StartPoint exch def redo-layout} it send}
] /new DefaultMenu send def
/LocationMenu [
(LeftBelow) (LeftAbove) (AboveLeft) (AboveRight)
(RightAbove) (RightBelow) (BelowRight) (BelowLeft)
] [
{ currentkey cvn
{/ObjectLoc exch def location 10 10 reshape damage-view}
it send}
] /new DefaultMenu send store
LocationMenu /PieInitialAngle 360 16 div put
/ShrinkMenu [
(.1) (.2) (.3) (.4) (.5) (.6) (.7) (.8) (.9) (1)
] [
{currentkey cvr {/Shrink exch def redo-layout} it send}
] /new DefaultMenu send def
/TabMenu [
(Point...) PointMenu
(---) {}
(Print) {/write-DL it send}
(Zap) {/Free it send}
(Shrink...) ShrinkMenu
(---) {}
(Location...) LocationMenu
(Pack) {/pack it send}
] /new DefaultMenu send store
/ChangeMenu [
(toke in) { /token-obj it send }
(executable){ /cvx-obj it send }
(name) { /cvn-obj it send }
(string) { /cvs-obj it send }
(toke out) { /tokout-obj it send }
(literal) { /cvlit-obj it send }
(integer) { /cvi-obj it send }
(real) { /cvr-obj it send }
] /new DefaultMenu send def
/EditMenu [
(undef) { /undef-obj it send }
(emacs) {} % tokout to emacs
(nulldef) { /nulldef-obj it send }
(primary) {} % tokout to Primary selection
] /new DefaultMenu send def
EditMenu /PieInitialAngle 45 put
/StructMenu [
(push) {/push-obj it send}
(load&push) {/load&push-obj it send}
(load) {/load-obj it send}
(edit...) EditMenu
(exec) {/exec-obj it send}
(change...) ChangeMenu
(paste) {/paste-obj it send}
(open) {/open-obj it send}
] /new DefaultMenu send def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Menu callbacks
/token-obj {
{ clear Externals begin
ob /Obj get
{ { token { exch } { exit } ifelse
} loop
} errored {
clear ob /Obj get
} {
count array astore cvx
} ifelse
end
} fork waitprocess
replace-obj
} def
/cvx-obj {
{ ob /Obj get cvx } errored {pop} {
replace-obj
} ifelse
} def
/cvn-obj {
{ ob /Obj get cvn } errored {pop} {
replace-obj
} ifelse
} def
/cvs-obj {
{ ob /Obj get 256 string cvs } errored {pop} {
replace-obj
} ifelse
} def
/tokout-obj {
ob /Obj get tokout replace-obj
} def
/cvlit-obj {
{ ob /Obj get cvlit } errored {pop} {
replace-obj
} ifelse
} def
/cvi-obj {
{ ob /Obj get cvi } errored {pop} {
replace-obj
} ifelse
} def
/cvr-obj {
{ ob /Obj get cvr } errored {pop} {
replace-obj
} ifelse
} def
/load&push-obj {
ob /Obj get load&push-it
} def
/load&push-it { %
[ exch cvlit {dup load} /errored cvx
{ pop (%% ) (%Load: % is not defined!\n) printf }
{ exch 1 index exch (%% ) (%Load: % Push: %\n) printf }
/ifelse cvx ] cvx
execute-it
} def
/load-obj {
ob /Obj get load-it
} def
/load-it { %
[ exch cvlit {dup load} /errored cvx
{ pop (%% ) (%Load: % is not defined!\n) printf }
{ exch 1 index exch (%% ) (%Load: % Select: %\n) printf
select-object } /ifelse cvx ] cvx
execute-it
} def
/open-obj {
open-struct
} def
/push-obj {
ob /Obj get push-it
} def
/push-it {
[ exch [ exch ] 0 /get cvx
/dup cvx (%% ) (%Push: %\n) /printf cvx ] cvx
execute-it
} def
/nulldef-obj {
ob /Obj get
dup type /dicttype ne { pop } {
selected-object dup null eq { pop } {
2 copy null put
0 grow-struct
ob begin
Branches null ne {
/Branches [
Branches {
dup /I get
counttomark 2 add index /I get
eq {pop} if
} forall
counttomark 3 add -1 roll
] Sort? {SortBy quicksort} if def
} if
end
redo-layout
} ifelse
} ifelse
} store
/undef-obj {
ob /Obj get
dup type /dicttype ne { pop } {
selected-object dup null eq { pop } {
2 copy known {
2 copy undef
ob begin
Branches null ne {
/Branches [
Branches {
begin /C load /I load known { currentdict } if end
} forall
] def
} if
end
redo-layout
} if
} ifelse
} ifelse
} store
/exec-obj {
ob /Obj get exec-it
} def
/exec-it { % obj => -
{ [ exch cvlit /cvx cvx
/dup cvx (%% ) (%Exec: %\n) /printf cvx
cvx /exec cvx ] cvx
execute-it
} fork pop pause
} def
/paste-obj {
selected-object
replace-obj
} def
/replace-obj { % obj => -
ob begin
replace-struct
end
redo-layout
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Moving and shaping
/just-reshape {
/ItemHeight exch def /ItemWidth exch def
ItemWidth 0 eq ItemHeight 0 eq and {
/UpdateDL? true store
} if
ensure-DL
adjust-geometry
ItemWidth ItemHeight /reshape super send
gsave ItemCanvas setcanvas ItemFillColor fillcanvas grestore
} def
/reshape { % x y w h
just-reshape
location move
} def
/just-move {
/move super send
} def
/move { % x y
label-bbox /lh exch def /lw exch def % x y lx ly
2 index add /ly exch def % x y lx
2 index add /lx exch def % x y
ly 0 max /ClientHeight win send lh sub min ly sub add exch
lx 0 max /ClientWidth win send lw sub min lx sub add exch
/move super send
snaps-here? pop
Index ThisI eq {/paint-hilite win send} if
StackI null ne StackI Index ne and {
/MoveMe TellStack
} if
} store
/redo-layout {
perform-layout
redo-shape
} def
/redo-shape {
location 10 10 just-reshape
damage-view
} def
/label-bbox { % x y w h
TabX TabY TabWidth TabHeight
} def
/tab-top { % - => y
location TabY add TabHeight add exch pop
} def
/tab-bottom { % - => y
location TabY add exch pop
} store
/label-rect { % X Y w h
location TabY add exch TabX add exch TabWidth TabHeight
} def
/pin-rect { % X Y w h
location exch PinX add 3 sub exch % x y
PinHeight 0 lt {
PinHeight add
} if
ItemHeight PinHeight abs add
6 exch
} def
/object-bbox { % x y w h
ObjectX ItemBorder sub ObjectY ItemBorder sub % x y
ObjectWidth ItemBorder dup add add % w
ObjectHeight ItemBorder dup add add % h
} def
/ItemPath {
ItemRadius label-bbox rrectpath
ItemRadius object-bbox rrectpath
} def
/AdjustItemSize { % - => - [uses item context]
ObjectLoc [
/Right /Left /RightBelow /RightAbove /LeftBelow /LeftAbove {
/ItemWidth ItemBorder 3 mul ItemGap add
LabelWidth add ObjectWidth add def
/ItemHeight ItemBorder 2 mul LabelHeight
ObjectHeight max add def
}
/Top /Bottom /AboveLeft /AboveRight /BelowLeft /BelowRight {
/ItemWidth ItemBorder 2 mul LabelWidth ObjectWidth max add def
/ItemHeight ItemBorder 3 mul ItemGap add
LabelHeight add ObjectHeight add def
}
] case
} store
/CalcObj&LabelXY { % - => - [uses item context]
ObjectLoc {
/RightAbove {
/LabelX ItemBorder def /LabelY ItemBorder def
/ObjectX ItemBorder dup add LabelWidth add ItemGap add def
/ObjectY ItemHeight ObjectHeight sub 2 div def
/TabX LabelX ItemBorder sub def /TabY LabelY ItemBorder sub def
/TabWidth
ItemBorder LabelWidth add ItemGap add ItemRadius dup add add def
/TabHeight LabelHeight ItemBorder dup add add def }
/RightBelow /Right {
/LabelX ItemBorder def
/LabelY ItemHeight ItemBorder sub LabelHeight sub def
/ObjectX ItemBorder dup add LabelWidth add ItemGap add def
/ObjectY ItemHeight ObjectHeight sub 2 div def
/TabX LabelX ItemBorder sub def /TabY LabelY ItemBorder sub def
/TabWidth
ItemBorder LabelWidth add ItemGap add ItemRadius dup add add def
/TabHeight LabelHeight ItemBorder dup add add def }
/LeftAbove {
/LabelX ItemBorder dup add ItemGap add ObjectWidth add def
/LabelY ItemBorder def
/ObjectX ItemBorder def
/ObjectY ItemHeight ObjectHeight sub 2 div def
/TabX LabelX ItemGap sub ItemRadius dup add sub def
/TabY LabelY ItemBorder sub def
/TabWidth
ItemRadius dup add ItemGap add LabelWidth add ItemBorder add def
/TabHeight LabelHeight ItemBorder dup add add def }
/LeftBelow /Left {
/LabelX ItemBorder dup add ItemGap add ObjectWidth add def
/LabelY ItemHeight ItemBorder sub LabelHeight sub def
/ObjectX ItemBorder def
/ObjectY ItemHeight ObjectHeight sub 2 div def
/TabX LabelX ItemGap sub ItemRadius dup add sub def
/TabY LabelY ItemBorder sub def
/TabWidth
ItemRadius dup add ItemGap add LabelWidth add ItemBorder add def
/TabHeight LabelHeight ItemBorder dup add add def }
/AboveRight /Top {
/LabelX ItemBorder def /LabelY ItemBorder def
/ObjectX ItemWidth ObjectWidth sub 2 div def
/ObjectY ItemBorder dup add LabelHeight add ItemGap add def
/TabX LabelX ItemBorder sub def /TabY LabelY ItemBorder sub def
/TabWidth LabelWidth ItemBorder dup add add def
/TabHeight
ItemBorder LabelHeight add ItemGap add ItemRadius dup add add
def }
/AboveLeft {
/LabelX ItemWidth ItemBorder sub LabelWidth sub def
/LabelY ItemBorder def
/ObjectX ItemWidth ObjectWidth sub 2 div def
/ObjectY ItemBorder dup add LabelHeight add ItemGap add def
/TabX LabelX ItemBorder sub def /TabY LabelY ItemBorder sub def
/TabWidth LabelWidth ItemBorder dup add add def
/TabHeight
ItemBorder LabelHeight add ItemGap add ItemRadius dup add add
def }
/BelowRight /Bottom {
/LabelX ItemBorder def
/LabelY ItemBorder dup add ObjectHeight add ItemGap add def
/ObjectX ItemWidth ObjectWidth sub 2 div def
/ObjectY ItemBorder def
/TabX LabelX ItemBorder sub def
/TabY LabelY ItemGap sub ItemRadius dup add sub def
/TabWidth LabelWidth ItemBorder dup add add def
/TabHeight
ItemRadius dup add ItemGap add LabelHeight add ItemBorder add
def }
/BelowLeft {
/LabelX ItemWidth ItemBorder sub LabelWidth sub def
/LabelY ItemBorder dup add ObjectHeight add ItemGap add def
/ObjectX ItemWidth ObjectWidth sub 2 div def
/ObjectY ItemBorder def
/TabX LabelX ItemBorder sub def
/TabY LabelY ItemGap sub ItemRadius dup add sub def
/TabWidth LabelWidth ItemBorder dup add add def
/TabHeight
ItemRadius dup add ItemGap add LabelHeight add ItemBorder add
def }
} case
/PinX LabelX LabelWidth add 2 sub def
} def
/adjust-geometry {
/ItemLabel Collection Index get type (% \267) sprintf store
LabelSize /LabelHeight exch def /LabelWidth exch def
AdjustItemSize
CalcObj&LabelXY
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Display
/PaintItem {
ItemRadius label-bbox rrectpath
ItemFillColor setcolor fill
ItemFrame 0 gt {
ItemFrame ItemRadius label-bbox rrectframe
ItemBorderColor setcolor eofill
} if
ItemRadius object-bbox rrectpath
ItemFillColor setcolor fill
ItemFrame 0 gt {
ItemFrame ItemRadius object-bbox rrectframe
ItemBorderColor setcolor eofill
} if
ShowLabel
paint-struct
} store
/paint-struct {
gsave
ensure-DL
ItemTextColor setcolor
ObjectX ObjectY ObjectHeight add translate
DL draw-struct
grestore
} def
/damage-view {
gsave
%ItemParent setcanvas bbox rectpath extenddamage
paint
grestore
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Accessers
/Collection {
ItemObject 0 get cvlit
} def
/Index {
ItemObject 1 get cvlit
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Structure stuff
/old-search-struct { % proc x y dict => proc x y
begin
dup Y ge {
dup Y H add lt {
% Path setpath
newpath X Y W H rectpath
%(x % y % X % Y % W % H % \n)[3 index 3 index X Y W H ]dbgprintf
2 copy pointinpath {
2 index exec
} {
Branches null ne {
Branches {
search-struct
} forall
} if
} ifelse
} if
} if
end
} def
/do-search {
DL begin Icon? end {
/obs [ DL ] store
/ob DL store
} {
gsave
ItemCanvas setcanvas
ObjectX ObjectY ObjectHeight add translate
DL
CurrentEvent begin XLocation YLocation end
search-struct
/obs exch store
obs length 0 eq { null } {
obs dup length 1 sub get
} ifelse
/ob exch store
grestore
} ifelse
} def
% Return the path down the display list to the substructure enclosing (x,y).
/search-struct { % dict x y => [ dl1 dl2 ... dln ]
10 dict begin
/ssy exch def /ssx exch def
[ exch
{ do-search-struct
% unsucessful search
exit
} loop % catch possible exit
]
end
} def
/do-search-struct { % dl => dl dl' dl'' dl''' ...
begin
ssx X ge {
ssy Y ge {
ssx X W add le {
ssy Y H add le {
currentdict Branches end
dup null eq { pop } {
{ do-search-struct } forall
} ifelse
exit % skip past all the ends on the execution stack
} if
} if
} if
} if
end
} store
/open-struct {
gsave
DL /Icon? undef
ItemCanvas setcanvas
ObjectX ObjectY ObjectHeight add translate
ob begin
L 0 eq Shift or {
L 1 add grow-substruct
} {
/L 0 def
/Branches null def
} ifelse
end % ob
Meta not { redo-layout } if
grestore
} def
% (dl on dictstack)
/replace-struct { % obj => -
C I 3 -1 roll put
C I 0 grow-struct
begin
/Branches Branches
/C dup load /I dup load /L L
/Obj dup load /Str Str
/X X /Y Y /W W /H H
end
def def def def def def def def def def def
} def
/grow-substruct { % l => -
/L exch def
/forbidden? {pop false} def
/Branches
C I L grow-struct
1 index get def
currentdict /forbidden? undef
} def
/composite? { % obj => bool
type {
/arraytype /dicttype /canvastype
/processtype /eventtype /fonttype
{true}
/Default
{false}
} case
} def
/forbidden-dict 50 dict def
forbidden-dict begin
/Interests null def
/Process null def
/BuildChar null def
/Encoding null def
/WidthArray null def
/ParentDictArray null def
/ParentDict null def
/TopCanvas null def
/BottomCanvas null def
/TopChild null def
/CanvasAbove null def
/CanvasBelow null def
/Parent null def
end % forbidden-dict
/forbidden? {
forbidden-dict exch known
} def
% Collection Index Levels => dict
/grow-struct {
/xcurs /xcurs_m ItemCanvas setstandardcursor
LayoutLock {
/hourg /hourg_m ItemCanvas setstandardcursor
do-grow-struct
} monitor
/ptr /ptr_m ItemCanvas setstandardcursor
} def
/do-grow-struct {
pause
32 dict begin
/L exch def
cvlit /I exch def cvlit /C exch def
/Obj C I get def
/Str /Obj load I (% = %) sprintf def
/X 0 def
/Y 0 def
/W 0 def
/H 0 def
/StrY 0 def
/LineX 0 def
/Obj load composite?
I forbidden? not and
L 0 gt and {
/Obj load dup type /arraytype eq {
/Branches exch [ exch
{ pop /Obj load counttomark 1 sub L 1 sub do-grow-struct } forall
] def
} {
/Branches exch [ exch
{ pop /Obj load exch L 1 sub do-grow-struct } forall
] Sort? {SortBy quicksort} if def
} ifelse
} {
/Branches null def
} ifelse
currentdict end
} def
% /SortBy default:
/by-name {
/Str get exch /Str get lt
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Layout
/perform-layout {
/xcurs /xcurs_m ItemCanvas setstandardcursor
LayoutLock {
/hourg /hourg_m ItemCanvas setstandardcursor
/ItemLabel Collection Index get type (% \267) sprintf store
init-format DL do-layout
/ObjectHeight DL /Y get neg store
adjust-geometry
} monitor
/ptr /ptr_m ItemCanvas setstandardcursor
} def
/init-format {
/Point StartPoint def
/x 0 def
/y 0 def
/ObjectWidth 0 def
/ObjectHeight 0 def
} def
/LineHeight {
currentfont fontheight 1 add
} def
/do-layout { % dict => -
begin
/View load cvx exec
end
pause
} def
/layout-struct { % - => -
/Str /Obj load I (% = %) sprintf def
/Obj load xcheck Point 10 ge and {
/Font ItemXFont Point scalefont def
} {
/Font ItemFont Point scalefont def
} ifelse
Font setfont
/X x def
/Y y def
/W Str stringwidth pop LineGap add def
Branches null eq { % Icon? or
/H LineHeight def
} {
/x x W add store
/Point Point Shrink mul store
Branches {
do-layout
} forall
/Point Point Shrink div store
/x x W sub store
0 0 % w h
Branches {
begin
exch W max
exch H add
end
} forall % W H
LineHeight max 1 max /H exch def
/LineX X W add LineGap sub def
W add /W exch def
} ifelse
/Y Y H sub def
/StrY Y Font fontdescent add H LineHeight sub 2 div add def
/y Y store
/ObjectWidth ObjectWidth x W add LineGap sub max store
} store
% dict => -
/draw-struct {
pause
begin
Icon? {
gsave
Font setfont
0 Font fontdescent IconH sub
2 copy moveto
Str show
translate
-2 ItemRadius
Str stringbbox points2rect
insetrrect rrectpath
0 setlinewidth
0 setgray
stroke
grestore
} {
show-obj
Branches null ne Icon? not and {
LineX
Y H 2 div add
Branches length 0 ne {
Branches 0 get begin
2 copy moveto
X Pad sub Y H add lineto
W 0 rlineto
stroke
end
Branches {
begin
2 copy moveto
X Pad sub Y lineto
Pad dup add 0 rlineto
stroke
currentdict end
draw-struct
} forall
Branches dup length 1 sub get begin
2 copy moveto
X Pad sub Y lineto
W 0 rlineto
stroke
end
} if
pop pop
} if
} ifelse
end
} store
/show-obj {
Font setfont
X StrY moveto
Str show
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Printing
% This needs to be brought up to date...
/write-DL { %
{ /f (DL.ps) (w) file def
f (%!\n) writestring
f (gsave 0 setgray 0 setlinewidth 20 20 translate\n) writestring
DL begin
f H W (%%) (%BoundingBox: 0 0 % %\n) sprintf writestring
end
/cur-font-name null def
/cur-font-size 0 def
DL print-struct
f (grestore showpage\n) writestring
f closefile
} stopped pop
} def
/print-struct { % dict => -
pause
begin
Font /FontMatrix get 0 get
/Obj load xcheck ItemXFont ItemFont ifelse /FontName get
1 index cur-font-size eq 1 index cur-font-name eq and { pop pop } {
2 copy /cur-font-name exch store /cur-font-size exch store
(/% findfont % scalefont setfont\n) sprintf
f exch writestring
} ifelse
Font setfont
Font fontdescent
StrY ObjectHeight add X
(% % moveto ) sprintf f exch writestring
Str ( (%) show\n) sprintf f exch writestring
Branches null ne Icon? not and {
X W add LineGap sub
Y H 2 div add ObjectHeight add
Branches {
begin
2 copy exch (% % moveto ) sprintf f exch writestring
X Pad sub Y ObjectHeight add exch (% % lineto ) sprintf
f exch writestring
Pad 2 mul 0 exch (% % rlineto ) sprintf f exch writestring
f (stroke\n) writestring
currentdict end
print-struct
} forall
Branches length 0 ne {
Branches dup length 1 sub get begin
2 copy exch (% % moveto ) sprintf f exch writestring
X Pad sub Y H add ObjectHeight add exch (% % lineto ) sprintf
f exch writestring
Pad 2 mul 0 exch (% % rlineto ) sprintf f exch writestring
f ( stroke\n) writestring
end
} if
pop pop
} if
end
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Stack stuff
/execute-it { % obj => -
/exec-and-update items StackI null eq ThisI StackI ifelse get send
} def
/TellStack { % message => -
createevent begin
/Name exch def
/ClientData Index def
/Action StackI def
/Canvas ItemParent def
currentdict end sendevent
} def
/pack {
StackI null ne {
/PackStack items StackI get send
} if
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Snap dragging
/pinned? { % y h => bool
location pop PinX add 3 1 roll % x y h
6 exch % x y w h
pin-rect rectsoverlap
} store
% items backgroundcolor => - (interactively move item)
/moveinteractive {
ItemBegin
10 dict begin
/GA_constraint 0 def
/GA_value /calc_GA_value load def
currentcursorlocation
/DY exch def /DX exch def
currentcanvas mapcanvas false dragcanvas
end
ItemEnd
} store
/SnapIn {
ThisI StackI ne {
StackI null ne {
/PopMe TellStack
} if
/StackI ThisI store
/PushMe TellStack
} if
} def
/SnapOut {
StackI null ne StackI Index ne and {
/PopMe TellStack
/StackI null store
} if
} def
/snaps-here? { % - => bool
ThisI null eq ThisI Index eq or {false} {
/pin-rect items ThisI get send
label-rect
rectsoverlap dup {
SnapIn
} {
SnapOut
} ifelse
} ifelse
} def
/calc_GA_value {
StackI Index eq {
currentcursorlocation pop % cx
} {
StackI null eq {
snaps-here? {
location
pop DX add % ix
} {
currentcursorlocation pop % cx
} ifelse
} {
location TabY add TabHeight
/pinned? items StackI get send not {
SnapOut
pop currentcursorlocation pop % cx
} { % ix
{ location pop PinX add } items StackI get send % ItemX PinX
PinX sub % ItemX ItemGoal
exch 1 index exch sub % ItemGoal ItemDelta
currentcursorlocation pop % ItemGoal ItemDelta CurX'
2 index exch sub % ItemGoal ItemDelta CurDelta
DX add dup abs TabWidth gt {
SnapOut
pop pop pop currentcursorlocation pop DX sub
} {
1 index abs 1 index abs gt {exch} if % ItemGoal Close Far
pop % ItemGoal Close
.2 mul sub
} ifelse
DX add
} ifelse
} ifelse
} ifelse
} store
/NextPos { % - => x y
location % x y
label-bbox % X Y x y w h
exch pop add % X Y x y+h
3 -1 roll add % X x Y+y+h
exch 3 -1 roll add exch % X+x Y+y+h
exch PinX add exch
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Storage managment
/Free {
SnapOut
ItemCanvas /Retained false put
unmap
ItemLock {
/free-items [
free-items aload pop Index
] store
} monitor
} def
/init-attributes {
{/ObjectWidth /DL /UpdateDL? /Shrink /StartPoint /PinHeight}
{ InstanceVarDict 1 index get store } forall
/ObjectLoc /Right store
adjust-geometry
} store
% obj => -
/Reuse {
Collection Index 3 -1 roll put
ItemCanvas /Retained true put
ItemCanvas canvastotop
init-attributes
ensure-DL
redo-layout
} store
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% TextStructItem class definition
/TextStructItem StructItem
dictbegin
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Instance variables
/I null def
/MyStack null def
/MyProcess null def
/Scroller null def
/ScrollerWidth 16 def
/Notifier null def
/NotifierHeight 16 def
/SubItemGap 2 def
/SubItemMgr null def
/DeferedUpdateEvent null def
/DeferedStack null def
/UpdateDelay .25 60 div def
dictend
classbegin
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Class Variables
/TextWidth 600 def
/TextHeight 150 def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
/new {
/new super send begin
/MyStack [] def
/ItemLabel (processtype) def
currentdict end
} def
/kbd-reset {
/dialog-buf () store
/dialog-string () store
{(\n%% Reset!\n) print} execute-it
} def
/shut-down {
{ psh-socket (\ndbgstop\nquit\n) writestring
psh-socket flushfile
} errored pop
null {{dbgstop} errored exit} send-exec-event
1 60 div sleep
} def
/kbd-reboot {
{ /dialog-buf () store
/dialog-string () store
[ () (%% Reboot!) () ] true /writeatcaret dialog-text send
shut-down
psh-socket closefile
/psh-socket null store
ensure-DL
% { EventMgr null ne { EventMgr killprocess } if
% /EventMgr Interests forkeventmgr store
% KeyboardEventMgr null ne { KeyboardEventMgr killprocess } if
% /KeyboardEventMgr { KeyboardHandler } fork store
% } dialog-text send
start-event-mgrs
} fork waitprocess pop
} def
/select-process {
selected-object dup type /processtype eq {
set-process
} if
} def
/adjust-geometry {
LabelSize /LabelHeight exch def /LabelWidth exch def
AdjustItemSize
CalcObj&LabelXY
} def
/DialogMenu [
(pack) {/PackStack it send}
(reset) {/kbd-reset it send}
(reboot) {/kbd-reboot it send}
(process) {/select-process it send}
] /new DefaultMenu send def
/SelectionMenu [
(push) {{Collection Index get push-it} it send}
(load) {{Collection Index get load-it} it send}
(exec) {{Collection Index get exec-it} it send}
(change...) /ChangeMenu StructItem send
] /new DefaultMenu send def
/replace-obj { % obj => -
Collection Index 2 index put
select-object
} def
/show-tab-menu {
userdict /it self put
CurrentEvent /showat DialogMenu send
} def
/show-struct-menu {
userdict /it self put
userdict /ob 20 dict put
ob begin
/C Collection def
/I Index def
/Obj Collection Index get def
end
CurrentEvent /showat SelectionMenu send
} def
/exec-and-update { % func => -
{ exec
count array astore aload
createevent begin
/Name /UpdateStack def
/ClientData exch def
/Canvas _ViewCanvas def
currentdict end sendevent
} send-exec-event
} def
/send-exec-event { % data action
6 { % wait up to 3 seconds if no process
MyProcess null eq { .5 60 div sleep } { exit } ifelse
} repeat
MyProcess null eq {
pop pop
gsave framebuffer setcanvas
currentcursorlocation [(No process!)] popmsg pop
grestore
} {
createevent begin
/Name /ExecIt def
/Process MyProcess def
/Action exch def
/ClientData exch def
currentdict end sendevent
} ifelse
} def
/UpdateStack { %
DeferedUpdateEvent null ne {
DeferedUpdateEvent recallevent
} if
/DeferedUpdateEvent CurrentEvent store
DeferedUpdateEvent begin
/Name /DeferedUpdate def
/TimeStamp currenttime UpdateDelay add def
end % event
DeferedUpdateEvent sendevent
} def
/DeferedUpdate { %
/DeferedUpdateEvent null store
[ /getcaretpos dialog-text send pop 1 gt { () } if
dialog-string dialog-buf
CurrentEvent /ClientData get length
(NeWS[%]> %%) sprintf
{ (\n) search { % chop string up at newlines
exch pop exch
} {
exit
} ifelse
} loop
]
true /writeatcaret dialog-text send
pause
CurrentEvent /ClientData get
SetStack
} def
/ProcessReady {
CurrentEvent dup /ClientData get
exch /Action get
set-process
} def
/set-process { % stack process => -
/MyProcess exch def
SetStack
{ currentprocess (%% ) (%Hello, my name is %!\n) printf } execute-it
} def
/SelectionChanged {
CurrentEvent /Action get /PrimarySelection eq {
CurrentEvent /ClientData get dissect-selection
Collection Index 2 index put
(%: %)
[ 3 -1 roll dup type exch ]
/printf Notifier send
} if
} def
/makestartinterests {
/makestartinterests super send
[ exch aload pop
/ProcessReady {/ProcessReady /Self GetFromCurrentEvent send}
null ItemCanvas eventmgrinterest
dup /Self self PutInEventMgrInterest
/UpdateStack {/UpdateStack /Self GetFromCurrentEvent send}
null ItemCanvas eventmgrinterest
dup /Self self PutInEventMgrInterest
/DeferedUpdate {/DeferedUpdate /Self GetFromCurrentEvent send}
null ItemCanvas eventmgrinterest
dup /Self self PutInEventMgrInterest
/SelectionChanged {/SelectionChanged /Self GetFromCurrentEvent send}
null null eventmgrinterest
dup /Self self PutInEventMgrInterest
/PushMe {/DoPushMe /Self GetFromCurrentEvent send}
Index ItemParent eventmgrinterest
dup /Self self PutInEventMgrInterest
/PopMe {/DoPopMe /Self GetFromCurrentEvent send}
Index ItemParent eventmgrinterest
dup /Self self PutInEventMgrInterest
/MoveMe {/DoMoveMe /Self GetFromCurrentEvent send}
Index ItemParent eventmgrinterest
dup /Self self PutInEventMgrInterest
]
} def
/DoPushMe {
CurrentEvent /ClientData get PushMe
} def
/DoPopMe {
CurrentEvent /ClientData get PopMe
} def
/DoMoveMe {
LayoutLock {
SortStack ReplaceStack
} monitor
} def
/PushMe { % index => -
LayoutLock {
/I exch def
/MyStack [
MyStack {
dup I eq {pop} if
} forall
I
] store
SortStack
GetStack
{count 1 roll count 1 sub {pop} repeat aload pop}
[ {Collection Index get} items I get send
(%% ) (%Drag Push: %\n) sprintf /print cvx] append cvx
send-exec-event
} monitor
} def
/SortStack {
MyStack {
/tab-top exch items exch get send exch
/tab-top exch items exch get send
lt
} quicksort pop
} store
/PopMe { % index => -
LayoutLock {
/I exch def
/MyStack [
MyStack {
dup I eq {pop} if
} forall
] store
GetStack
{count 1 roll count 1 sub {pop} repeat aload pop}
[ {Collection Index get} items I get send
(%% ) (%Drag Pop: %\n) sprintf /print cvx] append cvx
send-exec-event
} monitor
} def
/ReplaceStack {
GetStack
{count 1 roll count 1 sub {pop} repeat aload pop}
send-exec-event
} def
% To do:
% Make this premptable: Each pass it does one thing to make the
% display look more like MyStack. (bottom to top priority)
/SetStack { % stack => -
LayoutLock {
ItemBegin 10 dict begin
/NewStack exch def
/OldStack 200 dict def
MyStack {
items 1 index get {Collection Index get} exch send
OldStack 3 1 roll put
} forall
/MyStack [] store
NewStack { % new
pause
/I null def
OldStack { % new ind old
dup 3 index eq { % new ind old
xcheck 2 index xcheck eq { % new ind
/I exch def exit % new
} { pop } ifelse % new
} { pop pop } ifelse % new
} forall % new
pause
/I load null ne {
pop %
OldStack /I load undef
/MyStack [
MyStack aload pop /I load
] store
} { % new
/MyStack [
MyStack aload length 3 add -1 roll % /MyStack [ ... new
create-struct % /MyStack [ ... newind
] store %
} ifelse
} forall
pause
OldStack { % ind old
pop % ind
items exch get % item
dup /StackI null put % XXX
/Free exch send %
pause
} forall
pause
/Y tab-top def
MyStack { % ind
items exch get % item
Y { % PrevTop
dup tab-bottom exch sub % PrevTop below
dup 0 lt {
location 2 index sub just-move
pause
} if
pop pop tab-top
} 3 -1 roll send % NextTop
/Y exch def %
} forall %
pin-rect % x y w h
exch pop add exch pop % PinTop
Y lt { % if we ran off the top of the stack, then pack it down.
PackStack
} if
pause
ItemEnd end
} monitor
} store
/create-struct { % obj => i
ItemLock {
20 dict begin
/Obj exch def
NextStackPos
/NextY exch def /NextX exch def
free-items length 0 eq {
Stack SP /Obj load put
Stack SP {click-point} can
/new StructItem send
/It exch def
/items [
items aload pop
It
] store
/I SP def
/SP SP 1 add store
It /StackI Index put
createevent begin
/Name /UpdateInterests def
/Canvas ItemParent def
/ClientData I def
currentdict end sendevent
} {
/I free-items dup length 1 sub get def
/It items I get def
/free-items [
free-items aload pop pop
] store
It /StackI Index put
/Obj load /Reuse It send
} ifelse
NextX NextY
{ 2 copy 20 20 just-reshape
exch PinX sub exch just-move
map damage-view
} It send
I
pause pause
end
} monitor
} store
/GetStack {
% Don't use [ ... ] in case there are marks on the stack!!
MyStack {
{Collection Index get} exch items exch get send
} forall
MyStack length array astore
} def
/PackStack {
10 dict begin
/Y tab-top def
MyStack {
items exch get
Y { % PrevTop
dup tab-bottom exch sub % PrevTop below
location 2 index sub just-move
pause pause
pop pop tab-top
} 3 -1 roll send
/Y exch def
pause pause
} forall
end
pause
} def
/NextStackPos { % - => x y
MyStack length 0 eq {
NextPos
} {
MyStack dup length 1 sub get items exch get
/NextPos exch send
} ifelse
} store
/ClientExit {
CurrentEvent /KeyState get {
dup PointButton eq {
{
ItemBegin
/StackI Index store
/ThisI Index store
ItemCanvas setcanvas
location TabY add TabHeight 2 div add exch PinX add exch
ItemParent createoverlay setcanvas
{ 2 setlinewidth exch pop x0 exch lineto }
getanimated waitprocess aload pop % x y
exch pop location exch pop sub
dup 0 gt {ItemHeight sub 0 max} if
/PinHeight exch store
/paint-hilite win send
ItemEnd
} fork pop exit
} if
} forall
StopItem
} def
/paint-struct {
gsave
ensure-DL
/paint Scroller send
/paint Notifier send
dialog-can setcanvas
/fixdamage dialog-text send
grestore
} def
/DrawHilite {
gsave can setcanvas
location CanvasYFudge add translate
ItemRadius object-bbox
4 -1 roll DropShadow add
4 -1 roll DropShadow sub
4 2 roll
rrectpath
.5 setgray fill
-3 ItemRadius label-bbox insetrrect rrectpath
2 setlinewidth 0 setgray stroke
PinHeight 0 ne {
1 setlinecap
2 setlinewidth
0 setgray
PinX 0 dup PinHeight add min 6 sub moveto
0 ItemHeight PinHeight abs add 12 add rlineto
stroke
1 setlinecap
6 setlinewidth
0 setgray
PinX 0 dup PinHeight add min moveto
0 ItemHeight PinHeight abs add rlineto
gsave stroke grestore
2 setlinewidth
1 setgray
stroke
} if
grestore
} store
/reshape {
/reshape super send
gsave
ensure-DL
ItemCanvas setcanvas
ObjectX ScrollerWidth add SubItemGap add ObjectY translate
0 0
ObjectWidth ScrollerWidth sub SubItemGap sub
ObjectHeight NotifierHeight sub SubItemGap sub
rectpath dialog-can reshapecanvas
dialog-can /Mapped true put
/reshape dialog-text send
ItemCanvas setcanvas
{ [ 1 0 1 TextHeight div dup CanHeight floor 1 sub mul null ] }
dialog-text send
/setrange Scroller send
ObjectX ObjectY
ScrollerWidth ObjectHeight NotifierHeight sub SubItemGap sub
/reshape Scroller send
/paint Scroller send
ObjectX ObjectY ObjectHeight add NotifierHeight sub
ObjectWidth NotifierHeight
/reshape Notifier send
/paint Notifier send
/SubItemMgr
dictbegin
/Scroller Scroller def
/Notifier Notifier def
dictend forkitems
store
grestore
} def
/ensure-DL {
/ObjectWidth TextWidth def %XXX
/ObjectHeight TextHeight def %XXX
dialog-text null eq {
/dialog-can ItemCanvas newcanvas store
/dialog-text 200 dialog-can /new TextCanvas send store
{ /KeyDict 200 dict def
KeyDict begin
127 { (erase character) comment % Rubout
dialog-string length 0 ne {
getcaretpos
exch dup 1 gt {
1 sub exch
movecaret
getcaretpos
1 3 1 roll deletestring
/dialog-string dialog-string dup length 1 sub
0 max 0 exch getinterval store
} if
} if
} def
8 127 load def % Backspace
23 { (erase word) comment % ^W
dialog-string length 0 ne {
{
getcaretpos
exch dup 1 gt {
1 sub exch
movecaret
getcaretpos
1 3 1 roll deletestring
/dialog-string dialog-string dup length 1 sub
0 max 0 exch getinterval store
dialog-string length 0 eq {
exit
} if
dialog-string dup length 1 sub 1 getinterval
( ) eq {
exit
} if
} {
exit
} ifelse
} loop
} if
} def
24 { (erase line) comment % ^X
getcaretpos
exch dialog-string length sub 1 max exch
2 copy
movecaret
dialog-string length 3 1 roll
deletestring
/dialog-string () store
} def
21 24 load def % ^U
13 { (exec line) comment % Return
[ () () ] true writeatcaret
dialog-string /dialog-enter dialog-item send
/dialog-string () store
} def
10 { (select line) comment % Newline
[ () () ] true writeatcaret
dialog-string select-object
/dialog-string () store
prompt
} def
10 128 add { (input line) comment % Meta-Newline
[ () () ] true writeatcaret
dialog-string /dialog-newline dialog-item send
/dialog-string () store
prompt
} def
19 { (insert selection) comment % ^S
selected-object (%) sprintf
[ 1 index ] true writeatcaret
/dialog-string exch dialog-string exch append store
} def
11 { (stack to selection) comment % ^K
{ (%% Stack to selection\n) print
select-object
} /execute-it dialog-item send
} def
25 { (selection to stack) comment % ^Y
{ (%% Selection to stack\n) print
selected-object
} /execute-it dialog-item send
} def
3 { (reset input) comment % ^C
/kbd-reset dialog-item send
} def
4 { (reboot process) comment % ^D
/kbd-reboot dialog-item send
} def
/FunctionR9 { (page up) comment
/ScrollPageForward /FakeScroll dialog-scroll send
} def
/FunctionR15 { (page down) comment
/ScrollPageBackward /FakeScroll dialog-scroll send
} def
/FunctionR7 { (scroll down) comment
/ScrollLineForward /FakeScroll dialog-scroll send
} def
/FunctionR13 { (scroll up) comment
/ScrollLineBackward /FakeScroll dialog-scroll send
} def
/FunctionR11 { (scroll to bottom) comment
1 /ScrollTo dialog-scroll send
} def
/FunctionF10 { (help) comment % Alternate
[ () (Key Bindings:) ()] true writeatcaret
[ KeyDict {
comment-string exch key-name
(%: %) sprintf
} forall ]
/gt quicksort
[()] append true writeatcaret
prompt
} def
/FunctionR1 { (describe key) comment
[ () (Describe key: ) ] true writeatcaret
/DescribingKey? true store
} def
/FunctionR2 { (bind selection to key) comment
[ () selected-object (Bind % to key: ) sprintf ]
true writeatcaret
/BindingKey? true store
} def
end % KeyDict
/typein {
[1 index] true writeatcaret
/dialog-string exch dialog-string exch append store
} def
/DescribingKey? false def
/BindingKey? false def
/key 0 def
/KeyHitCallback { % event =>
dup update-shifts
/Name get
dup type /integertype eq {
Meta {128 add} if
} {
Meta { (Meta%) sprintf } if
Shift { (Shift%) sprintf } if
Control { (Control%) sprintf } if
cvn
} ifelse
/key exch def
BindingKey? DescribingKey? or {
BindingKey? {
selected-object
KeyDict key known {
KeyDict key get
} { null } ifelse
select-object
dup null eq {
pop KeyDict key undef
} {
KeyDict exch key exch put
} ifelse
} if
[ ()
KeyDict key known {
KeyDict key get comment-string
} {
key type /integertype eq (self insert) (unbound) ifelse
} ifelse
key key-name
(%: %) sprintf
()
] true writeatcaret
/BindingKey? false store
/DescribingKey? false store
prompt
} {
KeyDict key known {
{ KeyDict key get cvx exec } fork pop
pause
} {
key type /integertype eq {
key cvis typein
} {
% beep
} ifelse
} ifelse
} ifelse
} def
/s null def
/newlines 0 def
/i 0 def
/a null def
/pre null def
/InsertValueCallback { % string => -
dialog-string /dialog-enter dialog-item send
/s exch store
/newlines 0 store
0 1 s length 1 sub {
/i exch store
s i get 13 eq { s i 10 put } if
s i get 10 eq {
/newlines newlines 1 add store
} if
} for
/a newlines 1 add array store
0 1 newlines 1 sub {
/i exch store
s (\n) search pop
/pre exch store
pop
/s exch store
a i pre put
pre (\n) append /dialog-enter dialog-item send
} for
a newlines s put
/dialog-string s store
a true writeatcaret
} def
/KeyboardHandler { % - => -
% --- Handler for keyboard, InsertValue, and Deselect events
/KeyboardInterest [
% Can addkbdinterests aload pop
% Can addselectioninterests aload pop
% % Get rid of LiteUI's mouse interests
% revokeinterest
% Can addfunctionnamesinterest
% dup /Action /DownTransition put
can addkbdinterests aload pop % XXX can=ClientCanvas
can addselectioninterests aload pop
% Get rid of LiteUI's mouse interests
revokeinterest
can addfunctionnamesinterest
dup /Action /DownTransition put
] def
/dialog-proc currentprocess store
{ awaitevent dup /Name get {
/DeSelect {
dup /Action get /PrimarySelection eq {
false DrawSelection
/SelectionPath null store
} if
/Action get /InputFocus eq {
InactivateCaret
} if
}
/RestoreFocus {
pop ReactivateCaret
}
/InsertValue {
/Action get InsertValueCallback
}
/Ignore {
pop
}
/Default {
KeyHitCallback
} if
} case
} loop
} def
/destroy { % - => -
KeyboardInterest null ne {
KeyboardInterest can revokekbdinterests % XXX can=ClientCanvas
} if
KeyboardEventMgr null ne { % added! -deh
KeyboardEventMgr killprocess
} if
EventMgr null ne {
EventMgr killprocess
} if
DelayedMoveProc null ne { % added! -deh
DelayedMoveProc killprocess
} if
MouseDragEventMgr null ne {
MouseDragEventMgr killprocess
} if
} def
/CaretBlinkTime 3 def
/CaretDutyCycle 0.95 def % Percentage on
% This doesn't work:
/FontHeight 12 def
/FontName FontName def
[ () (%% Ready!) () ] true writeatcaret
oncaret
} dialog-text send
/Scroller
[1 0 .005 .05 null] 1 {} ItemCanvas /new NeWSScrollbar send
def
/dialog-scroll Scroller store
{
/NotifyUser {
null ItemValue /moveviewport dialog-text send
} def
/ClientDrag {
DoScroll null ItemValue /moveviewport dialog-text send
} def
/FakeScroll { % motion => -
ItemBegin
/ScrollMotion exch def
DoScroll
EraseBox PaintBox
NotifyUser
ItemEnd
} def
/ScrollTo { % val => -
ItemBegin
/ItemValue exch def
EraseBox PaintBox
NotifyUser
ItemEnd
} def
} Scroller send
/Notifier
(Selection:) () /Right {} ItemCanvas /new MessageItem send
def
{
/ItemFont /Screen-Bold findfont 13 scalefont def
/ItemFrame 1 def
} Notifier send
} if
psh-socket null eq {
MyProcess null ne { MyProcess killprocess } if
/MyProcess null store
incoming null ne { incoming killprocess } if
/incoming null store
systemdict /_ViewCanvas ItemCanvas put
/psh-socket { socket-file (r) file } errored {
{ newprocessgroup
framebuffer setcanvas
500 500 [(Could not establish connection)] popmsg pop
} fork pause pause pop
currentprocess killprocessgroup
} if store
/incoming {
{ { psh-socket 255 string readline false eq {
[() (Lost it!) ()] true writeatcaret
% 1 60 div sleep
% /kbd-reboot dialog-item send
/incoming null store
currentprocess killprocess
} if
[ exch
getcaretpos
pop 1 ne { () exch } if
()
] true writeatcaret
psh-socket bytesavailable 0 eq { prompt } if
} loop
} dialog-text send
} fork store
psh-socket
(systemdict/dbgstart known not{(NeWS/debug.ps)run}if dbgstart\n_InitProcess\n)
writestring
psh-socket flushfile
} if
} def
/dialog-newline { % str => -
psh-socket exch writestring
psh-socket 10 write
psh-socket flushfile
} def
/dialog-enter { % str => -
/dialog-buf exch dialog-buf (%%\n) sprintf store
{ dialog-buf
{ token } errored {
[(%% Syntax error!)] true /writeatcaret dialog-text send
kbd-reset exit
} {
{ exch /dialog-buf exch store
[ exch ] cvx execute-it
} {
dialog-buf ( _FOO_) append token { % Ignore white space
exch pop /_FOO_ eq {
/dialog-buf () store
} if
} if
exit
} ifelse
} ifelse
} loop
} def
/destroy {
shut-down
SubItemMgr null ne {
SubItemMgr killprocess
/SubItemMgr null store
} if
dialog-text null ne {
% {{destroy} errored pop} dialog-text send
/destroy dialog-text send
/dialog-text null store
} if
} def
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Icky system globals and merciless kludges
/comment { pop } def
% Reap dead debuggers
/rd {
[ DbgDicts {pop} forall ] {
dup /State get /zombie eq {
DbgDicts 1 index undef
killprocess
} { pop } ifelse
} forall
} def
systemdict /DbgDicts known { rd } if
/dirname {
ob begin
uniquecid dup 3 -1 roll
(dir2dict % % | psh) sprintf forkunix
[exch cidinterest1only] forkeventmgr waitprocess
replace-struct
end
redo-layout
} store
/filename {
(file2dict % | psh) sprintf forkunix
} def
/_ViewCanvas null def
/_InitProcess {
createevent begin
/Canvas _ViewCanvas def
/Name /ProcessReady def
/Action currentprocess def
count array astore aload
/ClientData exch def
currentdict end sendevent
createevent begin
/Name /ExecIt def
currentdict end expressinterest
{ awaitevent
dup /ClientData get exch
/Action get exec
{currentfile flushfile} errored {exit} if
} loop
quit
} def
/revokekbdinterests { % [ int1 int2 ... intn ] can => -
removefocusinterest
% aload pop revokeinterest revokeinterest revokeinterest
{revokeinterest} forall
} store
systemdict /old-setselection known not {
/old-setselection /setselection load def
/setselection { % dict rank
2 copy old-setselection
createevent begin
/Name /SelectionChanged def
/Action exch def
/ClientData exch def
currentdict end sendevent
} def
} if
/select-object { % obj => -
20 dict begin
/ContentsPostScript 1 index def
/ContentsAscii exch (%) sprintf def
/SelectionObjSize 1 def
/SelectionResponder null def
/Canvas currentcanvas def % XXX?
/SelectionHolder currentprocess def % XXX?
currentdict
end
/PrimarySelection setselection
} def
/dissect-selection { % seldict => obj
dup null ne {
dup /ContentsPostScript known {
dup /ContentsPostScript get % seldict obj
1 index /SelectionStartIndex known {
1 index /SelectionLastIndex known {
exch dup /SelectionStartIndex get % obj seldict start
exch /SelectionLastIndex get % obj start last
1 index sub % obj start len
getinterval % subobj
} {
exch /SelectionStartIndex get get % subobj
} ifelse
} { exch pop } ifelse % obj
} {
dup /ContentsAscii known {
/ContentsAscii get
} if
} ifelse
} if
} def
/selected-object { % - => obj
/PrimarySelection getselection
dissect-selection
} def
% NeWS-print 0.996
% Written by Josh Siegel
% Munged by Don Hopkins
/Externals 512 dict def
/ExternalsBack 512 dict def
Externals /Count 0 put
/string-magic
dictbegin
(\b) 0 get (\\b) def
(\f) 0 get (\\f) def
(\n) 0 get (\\n) def
(\r) 0 get (\\r) def
(\t) 0 get (\\t) def
(\() 0 get (\\\() def
(\)) 0 get (\\\)) def
(\\) 0 get (\\\\) def
dictend
def
/fixstring {
10 dict
begin
/len 0 def
/out 1 index length 3 mul string def
{
dup string-magic exch known {
string-magic exch get
} {
cvis
} ifelse
out len 2 index putinterval
/len exch length len add def
} forall
out 0 len getinterval dup length string copy
end
} def
/stringer { % proc => string
dup type cvlit
{
/arraytype {
pause
/arraylvl arraylvl 1 add store
dup xcheck {
/the_string the_string ( {\n) append store
{
stringer
} forall
/the_string the_string ( }\n) append store
} {
/the_string the_string ( [\n) append store
{
stringer
} forall
/the_string the_string ( ]\n) append store
} ifelse
/arraylvl arraylvl 1 sub store
}
/nametype {
dup xcheck {
the_string
arraylvl 0 eq (% /% cvx ) (% %) ifelse
sprintf
/the_string exch store
} {
the_string (% /%) sprintf
/the_string exch store
} ifelse
}
/operatortype {
255 string cvs dup length 2 sub 1 exch getinterval
the_string
arraylvl 0 eq (% /% cvx ) (% %) ifelse
sprintf
/the_string exch store
}
/stringtype {
fixstring
the_string (% \(%\)) sprintf
/the_string exch store
}
/marktype {
(mark ) % [ DANGER! ]
}
/booleantype /integertype /realtype /nulltype {
the_string (% %) sprintf
/the_string exch store
}
/Default {
dup type /dicttype ne dictlvl 0 ne or arraylvl 0 ne or {
ExternalsBack 1 index known {
ExternalsBack exch get % name
} {
Externals begin Count /Count Count 1 add def end % obj count
1 index type (&%_%) sprintf % obj name
Externals 1 index 3 index put % obj name
ExternalsBack 3 -1 roll 2 index put % name
} ifelse
the_string ( //) append exch append /the_string exch store
} {
/dictlvl dictlvl 1 add store
/the_string the_string ( dictbegin\n) append store
{ pause
/the_string the_string (\t) append store
exch stringer stringer
/the_string the_string ( def\n) append store
} forall
/the_string the_string ( dictend \n) append store
/dictlvl dictlvl 1 sub store
} ifelse
} def
} case
} def
/tokout { % obj => string
10 dict
begin
/cnt Externals /Count get def
/dictlvl 0 def
/arraylvl 0 def
/the_string () def
stringer the_string
cnt Externals /Count get ne {
(Externals begin\n%\nend\n) sprintf
} def
end
} def
end % systemdict
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Nasty userdict variables
/dialog-text null def
/dialog-can null def
/dialog-proc null def
/dialog-string () def
/dialog-buf () def
/dialog-item null def
/dialog-scroll null def
(NEWSSERVER) getenv
(;) search pop
(.) search pop pop pop
/socket-port exch def
pop
/socket-host exch def
/socket-file (%socketc) socket-port append socket-host append def
/psh-socket null def
/SP 0 def
/Stack 256 array def
/Pallets 100 dict def
Stack 0 Pallets put
Stack 1 (Nothing!) put
/ThisI null def
/it null def
/ob null def
/obs null def
/FillColor 1 1 1 rgbcolor def
/ItemLock createmonitor def
/items [] def
/free-items [] def
/Meta false def
/Control false def
/Shift false def
/win null def
/can null def
/slidemgr null def
/itemmgr null def
/incoming null def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% User Utilities
%
% quicksort by Don Woods at Sun Microsystems, Inc.
%
/quicksort { % array proc => array (sorted, reuses same storage)
10 dict begin
/Bigger? exch cvx def % a b bigger? => t if a<b
dup quickrecur % start recursion
end
} def % quicksort
/quickrecur { % array => -- sorts array in place, using Bigger? for comparisons
dup length dup 2 gt { % A N
% the next lines (until but not incl /Key...) subsort three elements
% so we can use the median as the partitioning element; this improves
% performance for the case where the array is initially nearly sorted,
% but is not strictly necessary for the algorithm to work (it does
% seem to improve average runtime by about 10%)
2 copy 1 sub 2 copy 2 idiv 1 index 0 % A N A N-1 A (N-1)/2 A 0
6 copy get 5 1 roll get 3 1 roll get % above & A[N-1] A[(N-1)/2] A[0]
2 copy Bigger? {exch} if % subsort for three elements
3 1 roll 2 copy Bigger? {exch} if % ... (call them min mid max)
3 -1 roll 2 copy Bigger? {exch} if % ... subsort finished
9 index % A N A N-1 A (N-1)/2 A 0 min mid max N
3 eq {
5 2 roll put 4 1 roll put put % store min/mid/max back
pop pop % pop A & N
} { % else store mid at 0, max at N-1, min at (N-1)/2, then partition
3 -1 roll 5 2 roll put exch 4 1 roll put put % A N
/Key 2 index 0 get def % partitioning value
0 % A N 0, also known as A j i
{ % main partitioning loop
% incr i until i=j or A[i]>=A[0]; note A[j] is rangecheck
{ 1 add 2 copy gt { % i++; A j i j>i?
dup 3 index exch get % A j i A[i]
Key exch Bigger? not {exit} if
} {exit} ifelse
} loop
% decr j until A[j]<=A[0]; happens at j=i-1 if not sooner
exch { % A i j
1 sub dup 3 index exch get % A i j A[j]
Key Bigger? not {exit} if
} loop
2 copy gt {exit} if % if i>=j, finished partition
% swap A[j] & A[i]; stack has: A i j
2 index 4 copy exch get % A i j A A i A[j]
4 1 roll get % A i j A[j] A A[i]
3 index exch put % A i j A[j]
4 copy exch pop put pop exch % A j i
} loop
% finish partition by exchanging A[j] with A[0]; stack has: A i j
exch pop 2 copy 4 copy get % A j A j A j A[j]
exch pop 0 exch put Key put % A j
% now recur on A[0..j-1] and A[j+1..N-1]
2 copy 1 add 1 index length 1 index sub % A j A j+1 N-1
getinterval 3 1 roll 0 exch getinterval % A[j+1..N-1] A[0..j-1]
2 copy length exch length gt {exch} if % put smaller on top
quickrecur quickrecur % tail recursion avoids deep stack
} ifelse % =3 or >3 elements
} { % handle 1- and 2-element cases specially for efficiency
2 eq {
dup aload pop Bigger? {aload 3 1 roll exch 3 -1 roll astore} if
} if
pop % pop the array
} ifelse
} def % quickrecur
% end of quicksort
/shift-names 10 dict def
shift-names begin
/Meta false def
/Shift false def
/Control false def
end % shift-names
/update-shifts {
shift-names {store} forall
/KeyState get {
shift-names 1 index known { true store } { pop } ifelse
} forall
} store
/key-names 40 dict def
key-names begin
8 (Backspace) def
9 (Tab) def
10 (Newline) def
13 (Return) def
27 (Escape) def
127 (Delete) def
end % key-names
/key-name { % key => string
dup type /integertype eq {
dup 127 and
key-names 1 index known {
key-names exch get
} {
dup 32 lt {
64 add cvis (^%) sprintf
} {
cvis
} ifelse
} ifelse
exch 128 ge {
(Meta-%) sprintf
} if
} {
(%) sprintf
} ifelse
} store
/comment-string { % obj => string
dup type /arraytype eq {
dup length 2 ge {
dup 1 get /comment eq {
0 get
} if
} if
} if
(%) sprintf
} def
/destroy { % dummy destroy method
} def
% Forward messages on to stack
/prompt {
{} execute-it
} def
/execute-it {
/execute-it dialog-item send
} def
/exec-it {
/exec-it dialog-item send
} def
/push-it {
/push-it dialog-item send
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Pallets of useful functions
Pallets begin
/Debug dictbegin
/dlb /dbglistbreaks cvx def
/de /dbgenter cvx def
/dx /dbgexit cvx def
/dk /dbgkill cvx def
/dc /dbgcontinue cvx def
/dcc {dbgcopystack dbgcontinue} def
/dw /dbgwhere cvx def
/execstack {DbgImplicitBreak DbgGetExecStack} def
/exec /exec cvx def
/stack /stack cvx def
/clear /clear cvx def
/typo { % undefined (select correct spelling) => -
userdict begin
dup cvlit [ get-selection (%) sprintf cvn cvx ] cvx def
end
exec
} def
dictend def
/Number dictbegin
0 {10 mul} def
1 {10 mul 1 add} def
2 {10 mul 2 add} def
3 {10 mul 3 add} def
4 {10 mul 4 add} def
5 {10 mul 5 add} def
6 {10 mul 6 add} def
7 {10 mul 7 add} def
8 {10 mul 8 add} def
9 {10 mul 9 add} def
/Back {10 div floor} def
/Reset {0 mul} def
/Enter {0} def
dictend def
currentautobind false setautobind
/Math {
{add sub mul div idiv mod}
{neg abs min max}
{ceiling floor round truncate}
{cos sin tan arcsin arccos arctan atan exp ln log sqrt}
{random rand}
{ % Sort this stuff out:
append astore copy getinterval putinterval arrayinsert arraydelete
pickarray arrayop modifyproc
LoadFile run
and or xor not bitshift
begin end currentdict
forall for loop repeat case exit if ifelse stopped stop errored
userdict systemdict
cleartomark count counttomark
index roll pop dup exch exec
cvas cvad cvi cvis cvlit cvn cvr cvrs cvs cvx litstring
array dict string dictbegin dictend length maxlength extend
fork killprocess waitprocess currentprocess newprocessgroup killprocessgroup
forkunix getenv putenv
type xcheck
nullproc nullarray nullstring nulldict
eq ne gt lt ge le true false null
printf print = == sprintf stack pstack po
file readstring writestring read write readline flushfile token closefile
readhexstring writehexstring bytesavailable fprintf currentfile status
flush writeobject
readcanvas writecanvas eowritecanvas writescreen eowritescreen
movecanvas getcanvaslocation
reshapecanvas eoreshapecanvas
erasepage fillcanvas
get put def store load undef known where
send self super classbegin classend
setautobind currentautobind
pause sleep
bind
newpath closepath moveto lineto currentpath eocurrentpath setpath
rlineto rmoveto currentpoint emptypath pointinpath
extenddamage eoextenddamage
dashpath strokepath flattenpath
pathbbox pathforall pathforallvec
stroke fill
matrix concat concatmatrix currentmatrix setmatrix initmatrix
defaultmatrix identmatrix
rotate translate scale
currentcursorlocation setcursorlocation
getcanvascursor setcanvascursor setstandardcursor
getcanvasshape setcanvasshape
setgray setcolor currentcolor contrastwithcurrent currentgray setshade
rgbcolor setrgbcolor currentrgbcolor hsbcolor sethsbcolor currenthsbcolor
countdictstack countexecstack dictstack execstack
awaitevent createevent CurrentEvent countinputqueue sendevent
recallevent redistributeevent
eventmgrinterest forkeventmgr forkitems getanimated getclick
getfbclick getrect getwholerect
expressinterest revokeinterest globalinterestlist
createmonitor monitor monitorlocked
currenttime lasteventtime
localhostname vmstatus
gsave grestore grestoreall initgraphics save restore
dtransform transform itransform idtransform
currentdash setdash currentflat setflat currentlinecap setlinecap
currentlinejoin setlinejoin currentlinequality setlinequality
currentlinewidth setlinewidth currentmiterlimit setmiterlimit
currentprintermatch setprintermatch currentrasteropcode setrasteropcode
currentstate setstate
currentfont setfont findfont scalefont definefont findfilefont makefont
fontascent fontdescent fontheight
arc arcn arcto curveto rcurveto controlpoint rcontrolpoint
ashow widthshow awidthshow cshow rshow show kshow showcursor showicon
stringbbox stringwidth
clip eoclip clipcanvas eoclipcanvas clipcanvaspath clippath eoclippath
initclip
framebuffer
copyarea eocopyarea
setcanvas currentcanvas buildimage newcanvas createcanvas createoverlay
image imagecanvas imagemask imagemaskcanvas
canvasabove canvasbelow topchildcanvas parentcanvas
canvastotop canvastobottom insertcanvasabove insertcanvasbelow
search anchorsearch
rect rrect rectpath rrectpath insertrect insetrrect ovalpath ovalframe
rectframe rrectframe
points2rect rect2points rectsoverlap
popmsg
}
} cvlit def
/Stack {
dup pop exch clear load def store get put aload forall [ ]
} cvlit def
setautobind
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Item managment
/createitems {
ItemLock {
/items [
Stack 0 {click-point} can
/new StructItem send
20 10 0 0 /reshape 5 index send
Stack 1 {} can
/new TextStructItem send
20 50 0 0 /reshape 5 index send
] def
/SP items length store
/dialog-item items 1 get store
{/PinHeight 600 def /StackI 1 def} dialog-item send
/ThisI 1 store
} monitor
} def
/slideitem { % items fillcolor item => -
gsave
dup 4 1 roll % item items fillcolor item
{ItemCanvas canvastotop
moveinteractive location move} exch send % item
grestore
} def
/update-slide-interests {
CurrentEvent /ClientData get % Index
items exch get % item
dup /ItemCanvas get % item can
MiddleMouseButton [items FillColor % item can name [ dict color
6 -1 roll /slideitem cvx] cvx % can name proc
DownTransition % can name proc action
4 -1 roll eventmgrinterest % interest
expressinterest
} def
/update-start-interests {
CurrentEvent /ClientData get % Index
items exch get % item
mark
[/makestartinterests 3 index send aload pop]
{dup xcheck {exec} {expressinterest} ifelse} forall
cleartomark
pop
} def
/start-event-mgrs {
% Create event manager to slide around the items.
% Create a bunch of interests to move the items.
% Note we actually create toe call-back proc to have the arguments we need.
% The proc looks like: {items color "thisitem" slideitem}.
% We could also have used the interest's clientdata dict.
slidemgr null ne {slidemgr killprocess} if
/slidemgr [
items { % key item
dup /ItemCanvas get % item can
MiddleMouseButton [items FillColor % item can name [ dict color
6 -1 roll /slideitem cvx] cvx % can name proc
DownTransition % can name proc action
4 -1 roll eventmgrinterest % interest
} forall
/UpdateInterests /update-slide-interests
null can eventmgrinterest
] forkeventmgr store
itemmgr null ne {itemmgr killprocess} if
/itemmgr [
items iteminterests aload pop
/UpdateInterests /update-start-interests
null can eventmgrinterest
] forkeventmgr store
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Window class definition
/CyberWindow DefaultWindow
dictbegin
/FrameLabel (PostScript Structure CyberSpace) def
/IconLabel (PS CyberSpace) def
/IconImage /galaxy def
dictend
classbegin
/PaintClient {
paint-hilite
items paintitems
} def
/paint-hilite {
ClientCanvas setcanvas
erasepage
/DrawHilite dialog-item send
} def
/ClientMenu [
(Break Stack) { clear /BrokenStack /dbgbreak dialog-item send }
(Credits) { /display-credits win send }
(Break Window) { clear /BrokenWindow /dbgbreak win send }
(KeyDict) { /KeyDict dialog-text send select-object }
] /new DefaultMenu send def
/display-credits {
gsave
framebuffer setcanvas
currentcursorlocation
[ (NeWS CyberSpace:)
( by Don Hopkins)
(----------------)
(Code stolen from:)
( Josh Siegel)
( Don Woods)
] popmsg pop
grestore
} def
/DestroyClient {
itemmgr type /processtype eq { itemmgr killprocess } if
slidemgr type /processtype eq { slidemgr killprocess } if
items {
/destroy exch send
} forall
/items null store
/_ViewCanvas null store
/PrimarySelection clearselection % XXX?
/DestroyClient super send
} def
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Create objects
/win framebuffer /new CyberWindow send store % Create a window
0 0 900 900 /reshape win send
/can win /ClientCanvas get store
% BOO HISS
can /Transparent false put
can /Retained true put
createitems
% /reshapefromuser win send
/map win send
start-event-mgrs