mh@wlbr.EATON.COM (Mike Hoegeman) (05/12/88)
howdy..
This is part of a larger NeWS forms package that I'm currently building.
I wasn't going to post this till I polished it up some more ( put scroll bars
in , etc...) but I have to put in a bunch of stuff for interfacing with the
oracle rdbms so it looks like I might not get back to it for awhile so
I'll go ahead and post it now. If anyone actually uses this and has
suggestions or improvements they've made to it please drop me a note.
to try it out just snip at the marker below and run it through psh.
Sorry about the lack of documentation
Also , you'll see some cps stuff in here which goes along with
some C-code for use in scrolling BIG chunks of data. the C-code
uses some code that is not all mine so I'm not going to post
that unless there's a demand for it.
%=========== SNIP HERE SNIP HERE SNIP HERE SNIP HERE SNIP HERE ========
%+
% Module: scrfld.ps
% Author: Mike Hoegeman
% Function: scroll field class
% Notes:
% Modification History:
% Date Author Reason
% -------------------------------------------------------------
% 01May88 MCH Initial Release.
% -------------------------------------------------------------
%-
/ScrFld Object
%% ================= Instance Variables =============================
dictbegin
/SFEvtMgr nulldict def
/SFMenu nulldict def
/SFLabel null def
/SFMaxSelects 15 def %% max selects allowed for this field
/SFSelList [] def
/SFCanvas nulldict def %% canvas for this field
/SFParent nulldict def %% parent can for this field
/SFX 0 def
/SFY 0 def
/SFW 0 def
/SFH 0 def
/SFFillColor 0 0 1 hsbcolor def
/SFEColor .778 .900 1.0 hsbcolor def
/SFOColor 0 0 0 hsbcolor def
/SFSelColor 1 1 1 hsbcolor def
/SFTextColor SFOColor def
/SFFontSize 12 def
/SFFont /Courier findfont SFFontSize scalefont def
/SFLMargin 2 def %% left margin for data
/SFData nulldict def %% handle to where the data lives
/SFDataBuf null def
/HideMark (#) def %% stuff is hidden before this character
/User nulldict def %% cubbyhole for user stuff...
%% these are use for paging data between client and us
/SFCPS nulldict def %% cps glue dict, installed by client (if there is one)
/DataOnClient? false def
/Home (_?UnknownHome?_) def %% proc that pushes on stack
%% the dict that we live in
%% scrolling gadget stuff - don't have scroll bars yet
/GdgtW 16 def
/PgControl nulldict def
dictend
classbegin
%% ================= Class Variables ================================
%% ================= Methods ========================================
%+
% classname: - => /class_name
% Function: return the name of the class
%-
/classname {
/ScrFld
} def
%+
% new: x y w h parentcanvas => instance
%-
/new {
/new super send begin
/SFParent exch store
/SFH exch store /SFW exch store
/SFY exch store /SFX exch store
%% if there is a client we are interacting with, he's defined the
%% cps glue dict in userdict, pull it in to the instance were we
%% can see it
userdict /SFCPS known { /SFCPS userdict /SFCPS get def } if
currentdict end
} def
%+
% destroy: - => -
%-
/destroy {
/unmap self send
%% null out any possible objects that are memory intensive.
/SFCanvas null store
/PgCanvas null store
SFEvtMgr killprocess store
/SFEvtMgr null store
/SFData nulldict store
/SFUser nulldict store
} def
%+
% set: [(string1).... (stringN)] => -
% or.. (datatag) (type) (desc)
% Function: define the data to be scrolled.
%-
/set {
dup
type /arraytype eq {
%% all scroll buf data is local
%% => -
/SFData 5 dict store
SFData begin
/Data exch def
/TElem 0 def
/TLine 0 def
/BElem 0 def
/BLine 0 def
end
/DataOnClient? false store
/SFDataBuf SFData /Data get store
} {
%% scroll buf data is on client
%% => (datatag) (type) (desc)
SFCPS nulldict eq {
(/user/bin/msg scrfld.ps: where's my SFCPS dict?\n) forkunix
pause quit
} if
/SFData 5 dict store
SFData begin
/Data 3 index def
/TElem 0 def
/TLine 0 def
/BElem 0 def
/BLine 0 def
end
/DataOnClient? true store
%% tell client to load up a scroll field lineset with what
%% we want and then ship us the first scroll region's worth
%% of data.
/SFDataBuf null store
SFCPS begin
%% => (datatag) (type) (desc)
SFgetdata
end %% SFCPS
%% tell client to give us the first scroll region's worth
(waiting...) [] dbgprintf
{
0 1 60 { pop pause pause pause } for
SFDataBuf null ne { exit } if
(.) [] dbgprintf
} loop
} ifelse
} def
%+
% MakeSelInterests: canvas => -
% Function: create the EIS selection interests and tweaks them
% so they're palatable to the "forkeventmgr" utility.
%-
/MakeSelInterests {
addselectioninterests %% consume canvas arg here
aload pop
%% tell the evt mgr to ignore EIS's private events
begin
/ClientData 10 dict dup begin
/CallBack nullproc def
end def
end
%% Insert the evtmgr callback proc for this interest
%% (forkevtmgr needs this so that the evt mgr it creates knows what
%% to do with the event once it get's it).
%% => interest
begin
/ClientData 10 dict dup begin
/CallBack {DoSelect} def
end def
end
} def
%+
% DoSelect: event => -
% Function: forkeventmgr style CallBack proc.
% Handles all incoming selection events
% Notes: Currently scrollfields use the EIS buffer model
% for selection handling
% -- NOT FULLY COMPLETED --
%-
/DoSelect {
%% => selection event
1 dict begin
/evt exch def
evt /Name get [
/Ignore {}
%% not sure what the hell to do with this so just print it out
%% when we get one and we'll find out soon enough!!
/InsertValue {
(scrfld: got a /InsertValue: \n\t/Action = %)
[ evt /Action get] dbgprintf
}
%% user has made a selection in this canvas
/SetSelectionAt {
evt /Action get /Preview get not {
%% make sure we are in the right canvas
/SFSelList
[
gsave SFCanvas setcanvas
evt begin XLocation YLocation Point2Elem end
grestore
]
store
} if
%% now register the selection w/ the EIS
%% ... TO BE DONE
%%
%% selection-dict 10 dict dup begin
%% /ContentsAscii XXXXX def
%% /Rank evt /Action get /Rank get def
%% /Canvas SFCanvas def
%% /SelectionResponder null def
%% /SelectionObjsize ContentsAscii length def
%% /SelectionStartIndex 0 def
%% /SelectionLastIndex SelectionObjsize 1 sub def
%%
%% end setselection
%%
paintdata
}
%% user has extended the current selection
/ExtendSelectionTo {
evt /Action get /Preview get not {
%% make sure we are in the right canvas
gsave SFCanvas setcanvas
evt begin XLocation YLocation end Point2Elem
grestore
AddToSelList
} if
%% now re-register the extended selection w/ the EIS
%% ... TO BE DONE
%%
%% selection-dict 10 dict dup begin
%% /ContentsAscii XXXXX def
%% /Rank evt /Action get /Rank get def
%% /Canvas SFCanvas def
%% /SelectionResponder null def
%% /SelectionObjsize ContentsAscii length def
%% /SelectionStartIndex 0 def
%% /SelectionLastIndex SelectionObjsize 1 sub def
%%
%% end setselection
%%
paintdata
}
/DeSelect {
%% At the moment we don't really care about being
%% deselected..
}
/Default {}
] case
end
} def
%+
% AddToSelList: int => -
% Function: Add a element index to the selection list. If it is
% already present in the list it is not added.
%-
/AddToSelList {
1 dict begin
/addition exch def
SFSelList {
%% null out " addition " if it already exists in the array
addition eq { /addition null def exit } if
} forall
addition null ne {
/SFSelList SFSelList [ addition ] append store
} if
end %%localscope
} def
%+
% Point2Elem: xpos ypos => int
% Function: Returns the element index that is currently displayed
% at point x,y in the scroll field canvas. the Element
% index is from the start of the data as a whole not
% from the start of the display buffer.
%-
/Point2Elem {
gsave SFCanvas setcanvas
3 dict begin
exch pop %% the "x"
/ypos exch def
/elem SFData /TElem get def
/firstone? true def
0 SFH SFLabel null ne { SFFontSize sub } if moveto
SFDataBuf {
firstone? {
/firstone? false def
SFData /TLine get nthline_on not {
(/user/bin/msg scrfld: Point2Elem_BooBoo tell_mike)
forkunix pause ()
} if
} if
%% is the point clicked above the curr point yet ??
currentpoint exch pop ypos lt {
pop exit
} if
countlines SFFontSize mul neg 0 exch rmoveto
/elem elem 1 add def
} forall
elem 1 sub 0 max
end
grestore
} def
%+
% MakeSFInterests: - => -
% Function: Create interests for this fld and start a
% event manager for them.
%-
/MakeSFInterests {
SFEvtMgr nulldict eq {
/SFEvtMgr [
%% pager control stuff
PointButton
{ pop scrollup }
DownTransition
PgControl
eventmgrinterest
AdjustButton
{ pop scrolldown }
DownTransition
PgControl
eventmgrinterest
%% selection stuff
{ SFCanvas MakeSelInterests }
%%% menu stuff
MenuButton
{ SFMenu nulldict ne { /show SFMenu send } if }
DownTransition
SFCanvas
eventmgrinterest
] forkeventmgr store
} if
} def
%+
% reshape: x y w h => -
% Function: Reshape the scroll field and all it's controls
%-
/reshape {
ChkCans
Reshape
ReshapeControls
} def
/Reshape {
/SFH exch def /SFW exch def
/SFY exch def /SFX exch def
gsave
SFParent setcanvas SFX SFY translate
%% reshape the scroll field...
0 0 SFW SFH rectpath SFCanvas reshapecanvas
grestore
} def
%+
%
%-
/map {
ChkCans
SFCanvas /Mapped true put
PgControl /Mapped true put
} def
/unmap {
SFCanvas nulldict ne {
SFCanvas /Mapped false put
PgControl /Mapped false put
} if
} def
%+
% paint: - => -
% Function paint the scroll field in it's entirety
%-
/paint {
ChkCans
gsave SFCanvas setcanvas SFTextColor setcolor SFFont setfont
{
SFFillColor fillcanvas SFTextColor strokecanvas
PaintData PaintCtrls PaintLabel
} CallPaintProc
grestore
} def
/paintdata { /PaintData CallPaintProc } def
/unpaintdata { /UnpaintData CallPaintProc } def
/CallPaintProc {
gsave SFCanvas setcanvas SFTextColor setcolor SFFont setfont
cvx exec
grestore
} def
%+
% ReshapeControls: - => -
% Function: reshapes all controls associated w/ the window
%
%-
/ReshapeControls {
gsave
%% make him a small square guy on the lower
%% left of the field
SFCanvas setcanvas
0 0 GdgtW dup rectpath PgControl reshapecanvas
grestore
} def
%+
% ChkCans: - => -
% Function: deferred init of canvases and the interests associated w/ them.
%-
/ChkCans {
SFCanvas nulldict eq {
/SFCanvas SFParent newcanvas store
SFCanvas /Transparent false put
SFCanvas /Retained false put
SFCanvas /EventConsumed /MatchedEvents put
SFX SFY SFW SFH Reshape
/PgControl SFCanvas newcanvas store
%%%PgControl /Transparent false put
%%%PgControl /Retained false put
PgControl /EventConsumed /MatchedEvents put
ReshapeControls
MakeSFInterests
} if
} def
%+
% PaintLabel: - => -
% Function: paints the label for the scroll field (if one exists).
%-
/PaintLabel {
SFLabel type /stringtype eq {
GdgtW SFLMargin add SFH SFFontSize sub 1 sub moveto
SFLabel show
0 SFH SFFontSize sub 1 sub moveto SFW 0 rlineto stroke
} if
} def
%+
% PaintData: - => -
% Function: paints the scrolled data visible within the window
%-
/PaintData {
SFData nulldict ne SFDataBuf null ne and {
SFDataBuf datashow pop
} if
} def
/UnpaintData {
SFData nulldict ne SFDataBuf null ne and {
SFDataBuf SFFillColor datashow pop
} if
} def
/scrolldelta {
SFH 2 idiv dup SFFontSize mod sub SFFontSize idiv
} def
/linesshowing {
} def
/scrolldown {
%% Don't bother if there is nothing there
SFData nulldict ne {
3 dict begin
%% calc the no. of lines we need
DataOnClient? {
SFData /Data get
Home
scrolldelta dup 2 mul
SFCPS begin SFgetbuf end
}{
scrolldelta SFData /TElem get SFData /TLine get seekforward
dup null eq {
pop pop %% we've hit bottom, do nothing
} {
%% Make a subset of the scroll data, which is
%% the stuff we are currently displaying. this lives
%% in SFDataBuf
%% unpaint what is there
{ SFDataBuf SFFillColor datashow } CallPaintProc pop
SFData begin
/TLine exch def
/TElem exch def
/SFDataBuf
Data TElem Data length 1 sub getinterval
%%[ Data TElem get TLine nthline_on pop ]
%%TElem Data length 1 sub ge {
%% []
%%} {
%% Data TElem 1 add Data length 1 sub getinterval
%%} ifelse
%%append
store
end
%% paint the new stuff
{ SFDataBuf datashow } CallPaintProc pop
%% /paint self send
} ifelse
} ifelse
end
} if %% SFData null ne
} def
/scrollup {
%% if empty , don't bother
SFData nulldict ne {
3 dict begin
%% calc the no. of lines we need
DataOnClient? {
%%
SFData /Data get
Home
scrolldelta dup neg exch 2 mul
SFCPS begin SFgetbuf end
}{
{ SFDataBuf SFFillColor datashow } CallPaintProc pop
%
scrolldelta SFData /TElem get SFData /TLine get seekbackward
dup null eq {
%% seek went past the start of the Data...
pop pop
SFData begin
%% set start of displayable stuff to be start of
%% of all the scroll data...
/TElem 0 def
/TLine 0 def
end
} {
%% Make a subset of the scroll data, which is
%% the stuff we are currently displaying. this lives
%% in SFDataBuf
SFData begin
/TLine exch def
/TElem exch def
end
} ifelse
SFData begin
/SFDataBuf
Data TElem Data length 1 sub getinterval
%%[ Data TElem get TLine nthline_on pop ]
%%TElem Data length 1 sub ge {
%% []
%%} {
%% Data TElem 1 add Data length 1 sub getinterval
%%} ifelse
%%append
store
end % SFData
{ SFDataBuf datashow } CallPaintProc pop
%%% /paint self send
} ifelse
end %% local scope
} if %% SFData nulldict ne
} def
%+
% datashow: [ (text\ntext\n....) (..) ... ] color => bool
% Function: with the current point's y-coord as the left margin, display
% the argument string, wrapping at newlines. showing is stopped
% when the curren point's x-coord is less than zero. false
% is returned if the currentpoint's x-coord is less than zero
% after the showing has taken place. the color parame is optional.
% it is include for things like unpainting.
%-
/datashow {
6 dict begin
gsave
dup type /arraytype eq { /usecolor null def } { /usecolor exch def } ifelse
/rval true def
/elem SFData /TElem get def
/firstone? true def
%% so we do not mess up our border strokes
1.5 clippath pathbbox points2rect insetrect rectpath clip
%% move down a little further if we have a label
GdgtW SFH SFFontSize SFLabel null eq {1} {2} ifelse mul sub moveto
usecolor null ne { usecolor setcolor } if
/xpos currentpoint pop def
%% consume [(...) (...) ... ]
{
firstone? {
%% get just the showable part of the first element
/firstone? false def
SFData /TLine get
nthline_on not {
/datashow_error dbgbreak
%%(/user/bin/msg scrfld: datashow_BooBoo inform_mike) forkunix
pause ()
} if
%% don't show the stuff before the hide mark
SFData /TLine get 0 eq {
HideMark search { pop pop } if
} if
} {
%% don't show the stuff before the hide mark
HideMark search { pop pop } if
} ifelse
rval not { pop exit } if
usecolor null eq {
elem InSelList {
SFSelColor setcolor
} {
%% set color depending on if the element index is odd or even
elem elem 1 or eq { SFOColor } { SFEColor } ifelse setcolor
} ifelse
} if
{ %%start loop
currentpoint SFFontSize add exch pop 0 lt {
pop /rval false def exit
} if
(\n) search {
%% show the line and do a "cr/nl"
currentpoint SFFontSize sub
3 -1 roll
show
moveto
pop %% the newline, leave what's left on stack
} {
%% last line in blk , show and bail
show
exit
} ifelse
%%% pause
} loop
/elem elem 1 add def
xpos currentpoint exch pop SFFontSize sub moveto
} forall
rval
grestore
end %% localscope
} def
%+
% InSelList: N => bool
% Function: Is element "N" of the scroll data in the select list ?
%-
/InSelList {
1 dict begin
/n exch def
SFSelList { n eq { /n true def exit } if } forall
n true eq %% leave verdict on stack
end %% localscope
} def
%+
% PaintCtrls: - => -
% Function: paints any controls associated with the scroll field.
%-
/PaintCtrls {
gsave PgControl setcanvas
0 0 moveto /cycle showicon
grestore
} def
%+
% seekbackward: linesforward startelem startline => seekedelem seekedline
% Function:
%-
/seekbackward {
11 dict begin
/startline exch def %% grab args off stack...
/startelem exch def
/linesback exch def
/seekedelem null def %% local var. init stuff...
/seekedline null def
/totallines 0 def
/Data SFData /Data get def
%% seek backward elem by elem ...
startelem -1 0 {
/i exch def
i dup startelem eq {
Data exch get startline till_nthline not { () } if
} {
Data exch get
} ifelse
/curelem exch def
/linecount curelem countlines def
/totallines totallines linecount add def
%% Have we hit the elem w/ the linesback-th line yet?
totallines linesback ge {
%% Yes, note the elem it was in and the line no.
/seekedelem i def
/seekedline
totallines linesback sub %% overshoot amount == line #
def
exit
} if
} for
seekedelem %% leave return vals on stack
seekedline
end %localscope
} def
%+
%
%
% Note: If N > than the max # of lines int the arg string false
% is returned, otherwise true is returned along with a string
% identical to the argument string.
%-
/till_nthline {
3 dict begin
/n exch def
/sofar 0 def
/rval null def
%% => (stuff...\n...\n....)
{
sofar n ge { pop exit } if
rval null eq { /rval () def } if
(\n) search {
rval exch
append /rval exch def
/sofar sofar 1 add def
pop %% the (\n)
sofar n ge { pop exit } { /rval rval (\n) append def } ifelse
} {
rval exch
append /rval exch def
exit
} ifelse
} loop
rval null ne { rval true } { false } ifelse
end %localscope
} def
%+
% seekforward: linesforward startelem startline => seekedelem seekedline
% Function:
%-
/seekforward {
11 dict begin
/startline exch def %% grab args off stack...
/startelem exch def
/linesforward exch def
/seekedelem null def %% local var. init stuff...
/seekedline null def
/totallines 0 def
/Data SFData /Data get def
%% seek forward elem by elem...
startelem 1 Data length 1 sub {
/i exch def
i dup startelem eq {
Data exch get startline nthline_on not { () } if
} {
Data exch get
} ifelse
/curelem exch def
/linecount curelem countlines def
/totallines totallines linecount add def
%% Have we hit the elem w/ the linesforward-th line yet?
totallines linesforward ge {
%% Yes, note the elem it was in and the line no.
/seekedelem i def
/seekedline
Data seekedelem get countlines %% total lines in this elem
totallines linesforward sub sub %% less overshoot amount
1 sub
def
exit
} if
} for
seekedelem %% leave return vals on stack
seekedline
end %localscope
} def
%+
% nthline_on: (string1\n...stringN\n...) N => false
% (string1\n...stringN\n...) N => true (stringN\n...)
%
% Function: Return Nth line on from argument string.
% If nthline is greater than total number of lines ,
% () is returned.
%
% Note: First line in string is referenced as "0" not "1"
%-
/nthline_on {
3 dict begin
/n exch def
/sofar 0 def
/rval null def
{
sofar n eq { /rval exch def exit } if
(\n) search { pop pop } { pop exit } ifelse
/sofar sofar 1 add def
} loop
rval null ne { rval true } { false } ifelse end
} def
/countlines {
1 dict begin
/i 0 def
{
/i i 1 add def
(\n) search { pop pop }{ pop exit } ifelse
} loop
i %% leave ret val on stack
end %localscope
} def
classend def
%% ================= End Of ScrFld Class ===========================
%% ========== test fragment for the scroll field class =============
/paintit {
1 1 1 hsbcolor fillcanvas
/paint ScrollFld send
} def
/scrwin framebuffer /new DefaultWindow send def
/reshapefromuser scrwin send
{
/PaintClient { paintit } def
/ScrollFld
4 4 300 100 ClientCanvas /new ScrFld send
def
/FrameLabel (Scroll Field Demo) def
/IconLabel FrameLabel def
} scrwin send
/sfld scrwin /ScrollFld get def
{ /SFLabel (Scroll Field Demo) def } sfld send
[
(here is some scrollfield data)
(notice that you can have multi-line\nelements as data!)
(here's a real long one\nA\nB\nC\nD\nE\nF\nG\nH\nI\nJ\nK\nL\nM\nN\nO)
(Now some quotes that are in the PostScript Blue Book)
(To Read means to obtain meaning from words, and\n\
legibility is THAT QUALITY WHICH enables words\n\
to be read easily, quickly, and accurately.\n\
\n\
JOHN C. TARR)
(If my film makes one more person feel miserable\n\
I'll feel I've done my job.\n\
\n\
WOODY ALLEN)
(Printing is the source of practically all human evolution\n\
Without it the tremendous progress in the fields of science and\n\
technology would not have been possible\n\
\n\
VALTER FALK)
(now some single line elements)
(1)
(2)
(3)
(4)
(5)
(6)
(7)
(8)
(9)
(0)
(a)
(b)
(c)
(d)
]
/set sfld send
/map sfld send
/map scrwin send