% % This file is a product of Sun Microsystems, Inc. and is provided for % unrestricted use provided that this legend is included on all tape % media and as a part of the software program in whole or part. % Users may copy, modify or distribute this file at will. % % THIS FILE IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE % WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR % PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. % % This file is provided with no support and without any obligation on the % part of Sun Microsystems, Inc. to assist in its use, correction, % modification or enhancement. % % SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE % INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS FILE % OR ANY PART THEREOF. % % In no event will Sun Microsystems, Inc. be liable for any lost revenue % or profits or other special, indirect and consequential damages, even % if Sun has been advised of the possibility of such damages. % % Sun Microsystems, Inc. % 2550 Garcia Avenue % Mountain View, California 94043 % % Modifications to the original Sun Microsystems, Inc. source code % made by the Grasshopper Group are in the Public Domain. % % Extensions to this file by Eric Messick of the Grasshopper Group. % % Grasshopper Group % 212 Clayton St % San Francisco, CA 94117 % % % % "@(#)psterm.ps 1.0 88/06/09 SMI % "@(#)$Header: psterm.ps,v 2.3 88/10/05 17:45:46 eric Release $ % % Copyright (c) 1985 by Sun Microsystems, Inc. %/ /hourg /hourg_m framebuffer setstandardcursor pause systemdict begin /PSTermDict 150 dict def end PSTermDict begin % user customization of these items can be done in ~/.pstermrc /DefaultTerminalFont /Screen def /DefaultFontSize 12 def /DefaultLines 24 def /DefaultCols 80 def /morefontmenulength 25 def /EdgeLeft 1 def % space inside frame to leave white /EdgeRight 1 def /EdgeTop 1 def /EdgeBottom 1 def /ScrollbarWidth 16 def /Shrink_To_Cols_Lines true def % contract window to nearest integral size /DefaultSimpleShow true def % false means monospace variable spaced fonts /DefaultFastRepaint true def % false means paint every screen, even if % we're in the middle of painting a screen /DefaultUseCopyArea true def % set to false on silicon graphics % where reading pixels is expensive /smallest_font 1 def % when font size is calculated, start here /next_font_size { 1 add } def % and increment by doing this /OnePointFontXKludge 0 def /OnePointFontYKludge 1 def % translate One Point Font by this with respect to background % twiddle these if icon erases itself % adjust so cursor is on correct line of text % and delete actually wipes out characters /IconXKludge 0 def /IconYKludge 0 def % translate contents of icon by this much % twiddle these if icon borders go away on repaint % adjust so there is EdgeTop point gap above top line of text % we believe that these differences are related to color vs. b/w % systems. some experimentally determined values are: % % Screen Type % FontX FontY IconX IconY % % Black&White % 0 1 0 0 % % Color % 0 -2 0 2 framebuffer setcanvas clippath pathbbox /MaxWindowHeight exch 100 add def /MaxWindowWidth exch 100 add def pop pop % note: this stuff doesn't work right with % multiple framebuffers % until then, it speeds things up % and uses less memory for really big % windows that can't be displayed % completly anyway... % customization beyond this point is not recommended /RePaintCode (\200a) def /BeginSelectionCode (\200b) def /ExtendSelectionCode (\200c) def /EndSelectionCode (\200d) def /AutoMarginToggleCode (\200e) def /PageModeToggleCode (\200f) def /LineColCode (\200g) def /FixedFontCode (\200h) def /VariableFontCode (\200i) def /BeginRectSelectionCode (\200j) def /BeginRectExtendCode (\200k) def /ScrollBarCode (\200l) def /ScrollLengthCode (\200m) def /EndOfRefreshCode (\200n) def /FastRepaintCode (\200o) def /UseCopyAreaCode (\200p) def /sortarray { % array --> sorted_array 10 dict begin /arr exch def /len arr length def 1 1 len 1 sub { /i exch def 0 1 i 1 sub { /j exch def arr i get arr j get lt { /ferd arr i get def arr i arr j get put arr j ferd put } if } for } for arr end } def /PrimarySelection 1 def /fontkey {findfont 14 scalefont} def /longstring 256 string def /LineColMenu [ (24 x 80) { 24 80 ChangeLineCol } ( 8 x 80) { 8 80 ChangeLineCol } (16 x 64) { 16 64 ChangeLineCol } (34 x 80) { 34 80 ChangeLineCol } (60 x 80) { 60 80 ChangeLineCol } (28 x 90) { 28 90 ChangeLineCol } (40 x 90) { 40 90 ChangeLineCol } (48 x 96) { 48 96 ChangeLineCol } (66 x 132) { 66 132 ChangeLineCol } ] /new DefaultMenu send def { /LayoutStyle [3 3] def /CellHorizGap 5 def } LineColMenu send /PointMenu [(1) (2) (4) (6) (8) (10) (12) (14) (16) (18) (24) (32) (48) (64) (96) (128)] [{currentkey cvi ChangeFontSize}] /new DefaultMenu send def { /LayoutStyle [4 4] def /CellHorizGap 5 def } PointMenu send /FontMenu [ [(Courier) /Courier fontkey] [(Courier-Bold) /Courier-Bold fontkey] [(Courier-Oblique) /Courier-Oblique fontkey] [(Courier-BoldOblique) /Courier-BoldOblique fontkey] [(Screen) /Screen fontkey] [(Screen-Bold) /Screen-Bold fontkey] ] [{currentkey 1 get /FontName get ChangeFont}] /new DefaultMenu send def { /LayoutStyle [4 2] def /RowMajor? false def /CenterItems? false def } FontMenu send /MoreFontsMenu [ FontDirectory { pop longstring cvs dup length string copy } forall ] sortarray dup length /HowManyFontsCanYouCount? exch store [{ currentkey ChangeFont }] /new DefaultMenu send def { /LayoutStyle [ morefontmenulength HowManyFontsCanYouCount? min HowManyFontsCanYouCount? 1 sub morefontmenulength div truncate 1 add ] def /RowMajor? false def /CenterItems? false def } MoreFontsMenu send pause /ScrollLengthMenu [ (0) (64) (128) (256) (512) (1024) (2048) (4096) ] [{currentkey cvi ChangeScrollLength}] /new DefaultMenu send def { /LayoutStyle [4 2] def /RowMajor? false def /CellHorizGap 5 def } ScrollLengthMenu send /StuffToMenu [ (Stuff to Frame Label) { /PrimarySelection getselection dup null eq {pop} % See if null selection { dup /ContentsAscii known % Get ascii contents {/ContentsAscii get SL } {pop} ifelse } ifelse } (Stuff to Icon Label) { /PrimarySelection getselection dup null eq {pop} % See if null selection { dup /ContentsAscii known % Get ascii contents {/ContentsAscii get seticonlabel } {pop} ifelse } ifelse } (Stuff to Both) { /PrimarySelection getselection dup null eq {pop} % See if null selection { dup /ContentsAscii known % Get ascii contents {/ContentsAscii get dup SL seticonlabel } {pop} ifelse } ifelse } (Version to Frame Label){ ($Header: psterm.ps,v 2.3 88/10/05 17:45:46 eric Release $) 8 1 index length 9 sub getinterval SL } ] /new DefaultMenu send def pause systemdict /Item known not { (NeWS/liteitem.ps) run } if pause /PropScrollbar SimpleScrollbar dictbegin /Tracking false def dictend classbegin /SetScale { % - => - (set BarScale from size) /BarScale % points per line of text ItemHeight ButtonSize 2 mul sub BarMax BarMin sub div def /BoxSize BarViewPercent BarScale mul neg ItemHeight ButtonSize 2 mul sub min 5 max def } def /ValueToY { % value -> y BarMin BarViewPercent sub dup 0 le { pop ButtonSize } { exch 1 index exch sub 1 index BarMax sub div mul neg BarScale mul ButtonSize add } ifelse } def /YToValue { % y -> value ButtonSize sub BoxSize 2 div add BarScale div BarMin add .5 add truncate CheckValueBounds } def /ferd pop /CheckValueBounds { % value => value (in range) BarMax max BarMin BarViewPercent sub min } def /DoScroll { % - => - SetScrollValue ItemValue ItemPaintedValue ne {EraseBox PaintBox NotifyUser} if } def /SetValue { % value => - /ItemValue exch def /paint self send } def /ClientDown { /Tracking true def /ClientDown super send } def /ClientUp { /Tracking false def } def /SetScrollBarValue { % value range_array => - Tracking { pop pop % it'll catch up } { /setrange self send /SetValue self send } ifelse } def classend def pause /PSTermWindow DefaultWindow dictbegin /Scrollbar null def /ScrollbarActive false def dictend classbegin /BorderRight { ScrollbarActive { { ScrollbarWidth BorderRight 5 min add BorderRight max } DefaultWindow send } { /BorderRight DefaultWindow send } ifelse } def /ClientMinHeight { ScrollbarActive {48} {5} ifelse } def /ClientMinWidth 5 def /ScrollbarOn { ScrollbarActive not { /map Scrollbar send BorderRight /ScrollbarActive true def BorderRight sub FrameX FrameY FrameWidth 4 -1 roll sub FrameHeight /doreshape self send /ShapeStretchControl self send } if } def /ScrollbarOff { ScrollbarActive { /unmap Scrollbar send BorderRight /ScrollbarActive false def BorderRight sub FrameX FrameY FrameWidth 4 -1 roll sub FrameHeight /doreshape self send /ShapeStretchControl self send } if } def /ShapeStretchControl { gsave FrameCanvas setcanvas ControlSize BorderRight gt ControlSize BorderBottom gt and { newpath 0 0 moveto 0 BorderBottom lineto ControlSize BorderRight sub BorderBottom lineto ControlSize BorderRight sub ControlSize lineto ControlSize ControlSize lineto ControlSize 0 lineto closepath } { 0 0 ControlSize ControlSize rectpath } ifelse StretchControl reshapecanvas /MoveFrameControls self send /PaintFrameControls self send grestore } def pause /destroy { /Scrollbar null def /destroy super send } def /CreateFrameControls { % - => - % (Create frame control canvases/items) /CreateFrameControls super send /Scrollbar [10 0 1 10 10] 0 { ScrollBarCode print ItemValue = } FrameCanvas /new PropScrollbar send def { /ItemPaintedValue 0 def } Scrollbar send % this kludge shouldn't be needed } def /CreateFrameInterests { % - => - % (Create frame control interests) /CreateFrameInterests super send FrameInterests begin % Append the scroll bar "start" interests to the frame interests. % The odd "forall" is used to create unique names for inclusion % in the frame interests dictionary. /makestartinterests Scrollbar send { (Scrollbar) 1 index /Name get cvx 100 string cvs append cvn exch def } forall end } def /MoveFrameControls { % - => - ([Re]set frame control shapes) /MoveFrameControls super send ScrollbarActive { FrameWidth BorderRight sub ControlSize 1 sub ScrollbarWidth FrameHeight ControlSize sub BorderTop sub 2 add /reshape Scrollbar send } if } def /PaintFrameControls { % - => - (Paint frame control areas) gsave /PaintFrameControls super send ScrollbarActive { /paint Scrollbar send } if grestore } def /SetScrollBarValue { % totallines currentposition => - ScrollbarActive { [ 2 index 0 1 Window_lines dup 3 sub 1 max exch ] /SetScrollBarValue Scrollbar send } { pop } ifelse pop } def /FixFrame {RePaintCode print} def /PaintClient {RePaintCode print} def /PaintIcon {RePaintCode print} def /reshape { ChangeWidthHeight } def /flipiconic { Flip_Iconic } def /ShapeIconCanvas { gsave ParentCanvas setcanvas IconX null ne { IconX IconY translate } if 0 0 IconWidth IconHeight IconPath IconCanvas reshapecanvas grestore } def pause /makemenus { /ResizeMenu [ (Changing Font Size determines:) {} () {} () {} (Changing Lines/Cols determines:) {} () {} () {} (Changing Window Size determines:) {} () {} () {} ] /new DefaultMenu send def % looks bad { /CenterItems? false def } ResizeMenu send /ToggleMenu [ ( Page Mode) {PageModeToggleCode print} ( Auto-Margins) {AutoMarginToggleCode print} ( Var Width Fonts) { ToggleSimpleShow RePaintCode print} ( Fast Repaint) { ToggleFastRepaint } ( Scrolling Allowed) { ToggleUseCopyArea } ] /new DefaultMenu send def % looks bad { /CenterItems? false def } ToggleMenu send /ConfigMenu [ (Lines x Cols...) LineColMenu (Points...) PointMenu (Fonts...) FontMenu (More Fonts!...) MoreFontsMenu (Resizing stuff...) ResizeMenu (Save Lines...) ScrollLengthMenu (Toggles...) ToggleMenu (Set Labels...) StuffToMenu ] /new DefaultMenu send def /ClientMenu [ (Stuff) { /PrimarySelection getselection dup null eq {pop} % See if null selection { dup /ContentsAscii known % Get ascii contents {/ContentsAscii get print} {pop} ifelse } ifelse } (Frame...) { FrameMenu } MyWindow send (Config...) ConfigMenu ] /new DefaultMenu send def } def /PageModeMenuItem 0 def % which item of /ToggleMenu? /AutoMarginMenuItem 1 def % likewise /SimpleShowMenuItem 2 def % likewise /FastRepaintMenuItem 3 def % likewise /UseCopyAreaMenuItem 4 def % likewise /doreshape { /reshape load } DefaultWindow send def /doflipiconic { /flipiconic load } DefaultWindow send def classend def pause gsave 0.0005 rotate /Courier findfont setfont /OnePointFont currentfont [ 1 (m) stringwidth pop div 0 0 1 currentfont fontheight div 0 0 % these are ignored by NeWS ---- FIXME!! ] makefont def grestore /TSB { % on/off => - ``toggle'' scrollbar 0 eq { /ScrollbarOff } { /ScrollbarOn } ifelse MyWindow send } def /SSBV { % totallines currentpos => - set scrollbar value /SetScrollBarValue MyWindow send } def /BRP { { gsave Iconic? { IconCanvas setcanvas damagepath clipcanvas IconFillColor fillcanvas IconBorderColor strokecanvas PaintIconLabel } { FrameCanvas setcanvas damagepath clipcanvas PaintFrame % initialize client canvas with background color ClientCanvas setcanvas ClientFillColor fillcanvas } ifelse grestore } MyWindow send } def /ERP { clipcanvas } def /EOR { EndOfRefreshCode print } def /CD { % c x y cursordown gsave maxy add translate dup length dup 0 0 moveto 0 1 rlineto 0 rlineto % x component is length of c 0 lineto % x component is length of c closepath backgroundcolor setcolor fill textcolor setcolor 0 maxy neg moveto showtext grestore } def /CU { % c x y cursorup gsave maxy add translate dup length dup 0 0 moveto 0 1 rlineto 0 rlineto % x component is length of c 0 lineto % x component is length of c closepath textcolor setcolor fill backgroundcolor setcolor 0 maxy neg moveto showtext grestore } def /CL { % yby w yfrom nl CopyLine gsave /NumLin exch def % yby w yfrom maxy add 0 exch translate % yby w 0 0 moveto 0 NumLin rlineto % yby w dup 0 rlineto % yby w 0 lineto % yby closepath 0 exch copyarea grestore } def /SL { % s SetFrameLabel { /FrameLabel exch store gsave FrameCanvas setcanvas BorderLeft 1 add FrameHeight BorderTop sub 1 add FrameWidth BorderLeft BorderRight add sub 2 sub BorderTop 2 sub rectpath FrameFillColor setcolor fill % clear label area /paintframelabel self send FrameBorderColor setcolor PaintFrameControls PaintFocus grestore } MyWindow send } def /seticonlabel { { /IconLabel exch store PaintIcon } MyWindow send } def /VB { gsave HiLightCanvas setcanvas overlaydraw HlBgColor setcolor clippath fill .05 60 div sleep overlayerase erasepage grestore } def /AM { % onoff => - (define auto margins) 0 eq {( Auto-Margins)}{(* Auto-Margins)} ifelse { AutoMarginMenuItem } MyWindow send exch {AutoMarginToggleCode print} /changeitem MyWindow /ToggleMenu get send } def /PM { % onoff => - (define page mode) 0 eq {( Page Mode)}{(* Page Mode)} ifelse { PageModeMenuItem } MyWindow send exch {PageModeToggleCode print} /changeitem MyWindow /ToggleMenu get send } def /ToggleSimpleShow { /SimpleShow SimpleShow not store /FontFixedP MonoSpacedFont Font_size 1 eq or SimpleShow not or store FontFixedP { FixedFontCode } { VariableFontCode } ifelse print { SimpleShowMenuItem } MyWindow send SimpleShow {(* Var Width Fonts)}{( Var Width Fonts)} ifelse { ToggleSimpleShow RePaintCode print} /changeitem MyWindow /ToggleMenu get send } def /ToggleFastRepaint { /FastRepaint FastRepaint not store FastRepaintCode print FastRepaint { 1 } { 0 } ifelse = { FastRepaintMenuItem } MyWindow send FastRepaint {(* Fast Repaint)}{( Fast Repaint)} ifelse { ToggleFastRepaint } /changeitem MyWindow /ToggleMenu get send } def /ToggleUseCopyArea { /UseCopyArea UseCopyArea not store UseCopyAreaCode print UseCopyArea { 1 } { 0 } ifelse = { UseCopyAreaMenuItem } MyWindow send UseCopyArea {(* Scrolling Allowed)}{( Scrolling Allowed)} ifelse { ToggleUseCopyArea } /changeitem MyWindow /ToggleMenu get send } def /MT { backgroundcolor setcolor 2 copy maxy add moveto 1 index 0 eq { -.25 0 rmoveto } if % zap blats on left margin 0 1 rlineto Window_cols .25 add 1 index maxy add 1 add lineto 0 -1 rlineto closepath fill moveto pause } def /PN { % paint normal textcolor setcolor showtext } def /PR { dup textstringwidth textcolor setcolor stringbox backgroundcolor setcolor showtext } def /UN { dup textstringwidth textcolor setcolor underscore showtext } def /UR { dup textstringwidth textcolor setcolor dup stringbox backgroundcolor setcolor underscore showtext } def /CE { } def /textstringwidth { % (str) => width FontFixedP { length } { stringwidth pop } ifelse } def /stringbox { % width currentpoint 3 2 roll 0 maxy rmoveto 0 1 rlineto 0 rlineto 0 -1 rlineto closepath fill moveto } def /underscore { % width currentpoint 3 2 roll 1 maxy add 2 div 0 exch rmoveto 0 rlineto stroke moveto } def /showtext { Font_size 1 eq { OnePointFontXKludge OnePointFontYKludge rmoveto show OnePointFontXKludge neg OnePointFontYKludge neg rmoveto } { MonoSpacedFont SimpleShow or { show } { currentpoint ShowChar 0 % (str) x y ( ) 0 { % x y ( ) 0 char put ShowChar % x y (c) show exch 1 add exch moveto currentpoint % x y ShowChar 0 } 6 -1 roll exch forall pop pop exch 1 add exch moveto } ifelse } ifelse } def /HL { % strokeit [ ends of lines ] firstcol firstrow => - % do highlighting gsave 3 index 0 ne { HiLightCanvas setcanvas CurrentMatrix setmatrix -0.005 rotate erasepage } if maxy add 1 add dup % [] x y y 4 1 roll % y [] x y exch dup type /stringtype eq { textstringwidth } if exch moveto % y [] 0 -1 rlineto dup % y [] [] { % ... x dup type /stringtype eq { textstringwidth } { 1 add } ifelse currentpoint % ... x cx cy exch pop % ... x cy lineto 0 1 rlineto } forall % y [] length 1 gt { currentpoint 0 exch % y cx 0 cy lineto pop 0 exch % 0 y lineto } { pop } ifelse closepath currentpath /HiLightPath exch store 0 ne { stroke } if grestore } def /HiLightRect { % strokeit startcol startrow endcol endrow => - gsave 4 index 0 ne { HiLightCanvas setcanvas CurrentMatrix setmatrix -0.005 rotate erasepage } if 0 maxy translate 1 add exch 1 add exch 3 index 1 index moveto 1 index exch lineto 1 index lineto lineto closepath currentpath /HiLightPath exch store 0 ne { stroke } if grestore } def /takedownoutline { % /HiLightCanvas null store % HiLightCanvas /Mapped false put gsave HiLightCanvas setcanvas erasepage grestore } def /clearselectionpath { /HiLightPath null store } def /PaintHiLight { HiLightPath null ne { gsave 5 setrasteropcode HiLightPath setpath fill grestore } if } def /startselset { /CurrentSelection () store } def /extsel { CurrentSelection exch append /CurrentSelection exch store } def /finishselset { % str 10 dict dup begin /ContentsAscii CurrentSelection def /SelectionObjSize 1 def /SelectionHolder childprocess def /Canvas currentcanvas def end /PrimarySelection setselection } def /resetscale { 10 dict begin { Iconic? { IconCanvas } { ClientCanvas } ifelse } MyWindow send setcanvas 0.0005 rotate clippath pathbbox EdgeLeft exch ScaledFont fontdescent add EdgeTop sub translate clear Font_size 1 eq { 1 -1 scale IconXKludge IconYKludge translate OnePointFont setfont } { /xscale ScaledFont setfont (m) stringwidth pop def /yscale ScaledFont fontheight neg def xscale 0 eq { /xscale 0.0005 store } if yscale 0 eq { /yscale -0.0005 store } if xscale yscale scale Term_Font [ Font_size xscale div 0 0 Font_size yscale div 0 0 ] makefont setfont } ifelse textcolor setcolor % 0 setgray 0 1 translate /CurrentMatrix 6 array currentmatrix store /HiLightCanvas { ClientCanvas } MyWindow send createoverlay store clear childprocess dup null ne { MySetTransform createevent copy dup begin /Action matrix currentmatrix def /TimeStamp lasteventtime def end sendevent } { pop } ifelse end /maxy currentfont fontascent neg store } def /whcl2f { gsave 0.0005 rotate /Term_Font SelectedFont store /char_width Window_width { BorderLeft sub BorderRight sub } MyWindow send EdgeLeft sub EdgeRight sub Window_cols div store /char_height Window_height { BorderTop sub BorderBottom sub } MyWindow send EdgeTop sub EdgeBottom sub Window_lines div store /Font_size 0 store smallest_font { dup Term_Font exch scalefont setfont currentfont fontheight char_height ge (m) stringwidth pop char_width ge or { exit } if dup /Font_size exch store next_font_size } loop pop Term_Font Font_size scalefont setfont /ScaledFont currentfont store grestore Shrink_To_Cols_Lines { clf2wh } if } def /whf2cl { gsave 0.0005 rotate Font_size 1 eq { /Term_Font /Courier findfont store /ScaledFont OnePointFont store } { /Term_Font SelectedFont store /ScaledFont Term_Font Font_size scalefont store } ifelse ScaledFont setfont /Window_cols Window_width { BorderLeft sub BorderRight sub } MyWindow send EdgeLeft sub EdgeRight sub (m) stringwidth pop div .5 add truncate 1 max store /Window_lines Window_height { BorderTop sub BorderBottom sub } MyWindow send EdgeTop sub EdgeBottom sub currentfont fontheight div .5 add truncate 1 max store grestore Shrink_To_Cols_Lines { clf2wh } if } def /clf2wh { gsave 0.0005 rotate Font_size 1 eq { /Term_Font /Courier findfont store /ScaledFont OnePointFont store } { /Term_Font SelectedFont store /ScaledFont Term_Font Font_size scalefont store } ifelse ScaledFont setfont /Window_width Window_cols (m) stringwidth pop mul { BorderLeft add BorderRight add } MyWindow send EdgeLeft add EdgeRight add store /Window_height Window_lines currentfont fontheight mul { BorderTop add BorderBottom add } MyWindow send EdgeTop add EdgeBottom add store grestore } def /SetupResizeMenu { /FontChangeProc load /clf2wh load eq { 1 (* Window Size) {} /changeitem MyWindow /ResizeMenu get send 2 ( Lines/Cols ) { ToggleFont } /changeitem MyWindow /ResizeMenu get send } { 1 ( Window Size) { ToggleFont } /changeitem MyWindow /ResizeMenu get send 2 (* Lines/Cols ) {} /changeitem MyWindow /ResizeMenu get send } ifelse /LineColChangeProc load /clf2wh load eq { 4 (* Window Size) {} /changeitem MyWindow /ResizeMenu get send 5 ( Font Size ) { ToggleLineCol } /changeitem MyWindow /ResizeMenu get send } { 4 ( Window Size) { ToggleLineCol } /changeitem MyWindow /ResizeMenu get send 5 (* Font Size ) {} /changeitem MyWindow /ResizeMenu get send } ifelse /WidthHeightChangeProc load /whf2cl load eq { 7 (* Lines/Cols ) {} /changeitem MyWindow /ResizeMenu get send 8 ( Font Size ) { ToggleWidthHeight } /changeitem MyWindow /ResizeMenu get send } { 7 ( Lines/Cols ) { ToggleWidthHeight } /changeitem MyWindow /ResizeMenu get send 8 (* Font Size ) {} /changeitem MyWindow /ResizeMenu get send } ifelse } def /DefaultFontChangeProc /clf2wh load def /ToggleFont { /FontChangeProc load /clf2wh load eq { /FontChangeProc /whf2cl load store } { /FontChangeProc /clf2wh load store } ifelse SetupResizeMenu } def /DefaultLineColChangeProc /clf2wh load def /ToggleLineCol { /LineColChangeProc load /clf2wh load eq { /LineColChangeProc /whcl2f load store } { /LineColChangeProc /clf2wh load store } ifelse SetupResizeMenu } def /DefaultWidthHeightChangeProc /whf2cl load def /ToggleWidthHeight { /WidthHeightChangeProc load /whf2cl load eq { /WidthHeightChangeProc /whcl2f load store } { /WidthHeightChangeProc /whf2cl load store } ifelse SetupResizeMenu } def /ChangeOne { dup /Font eq { pop FontChangeProc } { /LineCol eq { LineColChangeProc } { WidthHeightChangeProc } ifelse } ifelse { /IconWidth Window_cols gsave IconFont setfont IconLabel stringwidth pop grestore max EdgeLeft add EdgeRight add def /IconHeight Window_lines EdgeTop add EdgeBottom add IconFont fontheight add def /ShapeIconCanvas self send } MyWindow send LineColCode print Window_cols = Window_lines = /Window_x { FrameX } MyWindow send store /Window_y { FrameY } MyWindow send store Window_y Window_height add 0 lt { % don't disappear on us! /Window_y 10 Window_height sub store } if Window_x Window_y Window_width MaxWindowWidth min Window_height MaxWindowHeight min /doreshape MyWindow send } def /ChangeScrollLength { ScrollLengthCode print = } def /ChangeFontSize { /SelectedFontSize exch store /Font_size SelectedFontSize store /Font ChangeOne } def /ChangeWidthHeight { /Window_height exch store /Window_width exch store /Window_y exch store /Window_x exch store { /FrameX Window_x store /FrameY Window_y store ClientMinWidth BorderLeft add BorderRight add ClientMinHeight BorderTop add BorderBottom add } MyWindow send dup Window_height gt { /Window_height exch store } { pop } ifelse dup Window_width gt { /Window_width exch store } { pop } ifelse /WidthHeight ChangeOne } def /ChangeLineCol { /Window_cols exch store /Window_lines exch store /LineCol ChangeOne } def /ChangeFont { dup { findfont } errored { gsave framebuffer setcanvas currentcursorlocation [ (Could not find font:) 5 -1 roll 100 string cvs ] popmsg pop grestore } { /SelectedFont exch store pop /MonoSpacedFont SelectedFont /IsFixedPitch get store SelectedFont /FontName get dup /Courier eq 1 index /Courier-Bold eq or 1 index /Courier-Oblique eq or exch /Courier-BoldOblique eq or { /MonoSpacedFont true store } if /FontFixedP MonoSpacedFont Font_size 1 eq or SimpleShow not or store FontFixedP { FixedFontCode } { VariableFontCode } ifelse print Font_size ChangeFontSize } ifelse } def /Flip_Iconic { /doflipiconic self send Iconic? { /Font_size 1 store /FontFixedP MonoSpacedFont Font_size 1 eq or SimpleShow not or store FontFixedP { FixedFontCode } { VariableFontCode } ifelse print ClientCanvas setcanvas ClientFillColor fillcanvas % keep it from repainting twice IconCanvas setcanvas /ScaledFont OnePointFont store ScaledFont setfont IconCanvas /Retained get { /PaintIcon self send } if } { IconCanvas setcanvas IconFillColor fillcanvas ClientCanvas setcanvas /Font_size SelectedFontSize store /FontFixedP MonoSpacedFont Font_size 1 eq or SimpleShow not or store FontFixedP { FixedFontCode } { VariableFontCode } ifelse print /ScaledFont Term_Font Font_size scalefont store ScaledFont setfont ClientCanvas /Retained get { /PaintClient self send } if } ifelse } def /UserWindowCustom nullproc def /createwindow { % x y fs col line framelabel iconlabel font starticonic iconx icony pause /IconInitialX exch store /IconInitialY exch store /StartIconic exch store /InitialFont exch store /MyIconLabel exch store /MyFrameLabel exch store /Window_lines exch store /Window_cols exch store /SelectedFontSize exch store /Window_y exch store /Window_x exch store /MyWindow framebuffer /new PSTermWindow send store /UserWindowCustom load MyWindow send Window_x Window_y 0 0 /doreshape MyWindow send % this calls checkcanvases to set up FrameMenu ... ugh... { /FrameLabel MyFrameLabel def /IconLabel MyIconLabel def makemenus ClientCanvas } MyWindow send createoverlay /HiLightCanvas exch store IconInitialX 0 ge IconInitialY 0 ge and { { /IconX IconInitialX def /IconY IconInitialY def } MyWindow send } if SetupResizeMenu ToggleSimpleShow ToggleFastRepaint ToggleUseCopyArea Window_cols 0 le Window_lines 0 le or { /Window_lines DefaultLines store /Window_cols DefaultCols store } if SelectedFontSize 0 le { /SelectedFontSize DefaultFontSize store } if { InitialFont findfont } errored not { InitialFont ChangeFont } if SelectedFontSize ChangeFontSize MyWindow /ClientCanvas get setcanvas InitialReshapeFromUser { /reshapefromuser MyWindow send } if StartIconic 0 ne { /flipiconic MyWindow send } if /map MyWindow send pause /MySetTransform createevent store MySetTransform begin /Name /SetTransform def /Canvas currentcanvas def end /MyMouseEvents createevent store MyMouseEvents begin /Name [ /MouseDragged /PointButton load /AdjustButton load ] def /Canvas currentcanvas def end } def /startinput { /childprocess null store resetscale ( ) 0 0 CU pause { systemdict /Selections known { { ClientCanvas } MyWindow send dup addkbdinterests pop % dup addselectioninterests pop addfunctionstringsinterest pop { FrameCanvas } MyWindow send dup addkbdinterests pop addfunctionstringsinterest pop { IconCanvas } MyWindow send dup addkbdinterests pop addfunctionstringsinterest pop } { /Ascii 128 dict def /Template createevent def Ascii begin 0 1 127 { dup def } for end Template Ascii seteventname currentcanvas seteventcanvas expressinterest } ifelse MyMouseEvents expressinterest MySetTransform expressinterest /MyEventActions 20 dict dup begin /Ignore { } def /AcceptFocus { % true /reflectfocus MyWindow send } def /RestoreFocus { % true /reflectfocus MyWindow send } def /SetTransform { Action dup null ne { setmatrix } { pop } ifelse } def /SetSelectionAt { } def /ExtendSelectionTo { } def /DeSelect { } def /LoseFocus { % NeWS/X version of DeSelect } def /SelectionRequest { } def /PointButton load { Action /DownTransition eq { false KeyState { /Shift eq { pop true exit } if } forall { BeginRectSelectionCode print } { BeginSelectionCode print } ifelse XLocation = YLocation maxy sub = 1 = /Selection_in_progress? true store } { % /UpTransition Selection_in_progress? { EndSelectionCode print XLocation = YLocation maxy sub = 1 = /Selection_in_progress? false store } if } ifelse } def /AdjustButton load { Action /DownTransition eq { false KeyState { /Shift eq { pop true exit } if } forall { BeginRectExtendCode print } { ExtendSelectionCode print } ifelse XLocation = YLocation maxy sub = 1 = /Selection_in_progress? true store } { % /UpTransition Selection_in_progress? { EndSelectionCode print XLocation = YLocation maxy sub = 1 = /Selection_in_progress? false store } if } ifelse } def /MouseDragged { Selection_in_progress? { ExtendSelectionCode print XLocation = YLocation maxy sub = 1 = } if } def /InsertValue { Action print } def /Default { { UI_private /meta_keys_down get /MetaP? exch store } errored pop ( ) dup 0 Name MetaP? 0 ne { 128 add } if put dup (\200) eq { (\200) print } if print } def end def { awaitevent % systemdict /_termlogger known { _termlogger } if begin % event MyEventActions Name 2 copy known not { pop /Default } if get exec end } loop } fork /childprocess exch store pause pause } def /StretchOpen { % called from -ui StretchOpen /InitialReshapeFromUser true def } def /PSTermInit { /HowManyFontsCanYouCount? 1 def /Term_Font DefaultTerminalFont findfont def /SelectedFont Term_Font def /SelectedFontSize DefaultFontSize def /ScaledFont Term_Font def /InitialFont Term_Font def /InitialReshapeFromUser false def /StartIconic 0 def /IconInitialX -1 def /IconInitialY -1 def /MonoSpacedFont true def /FontFixedP true def /SimpleShow DefaultSimpleShow not def % inverted because we toggle to set up menu /FastRepaint DefaultFastRepaint not def % likewise /UseCopyArea DefaultUseCopyArea not def % likewise /CurrentMatrix matrix def /CurrentSelection () def /char_width 1 def /char_height 1 def /MetaP? 0 def /ShowChar ( ) def /Selection_in_progress? false def /HiLightPath null def /HiLightCanvas null def /Font_size SelectedFontSize def /Window_cols DefaultCols def /Window_lines DefaultLines def /Window_width 0 def /Window_height 0 def /Window_x 0 def /Window_y 0 def /MyIconLabel () def /MyFrameLabel () def /MyWindow null def /MyMouseEvents null def /MySetTransform null def /childprocess null def /FontChangeProc /DefaultFontChangeProc load def /LineColChangeProc /DefaultLineColChangeProc load def /WidthHeightChangeProc /DefaultWidthHeightChangeProc load def /HlBgColor where { pop } { /HlBgColor 0 0 0 rgbcolor def } ifelse pause } def end pause /ptr /ptr_m framebuffer setstandardcursor