/component superclass /value (The quick brown fox jumped over the lazy dog.) def /offset 0 def /selfrom 0 def /selto 0 def /editable true def /hilite /none def %begin postscript section /value persist %end postscript section %begin postscript section /offset persist %end postscript section %begin postscript section /selfrom persist %end postscript section %begin postscript section /selto persist %end postscript section %begin postscript section /scrollthreshold persist %end postscript section %begin postscript section /scrolllinedelay persist %end postscript section /minwidth //OLScrollButW 8 add 2 mul def /minheight //OLScrollButH def /action { % -- [value] /Action self Send } def /PaintLScroll { % -- offset 0 ne { BG setcolor 0 0 //OLScrollButW 2 add h rectpath fill hilite /left eq 0 0 OLScrollButLeft } if } def /PaintRScroll { % -- textfont value exch currentfont exch setfont exch stringwidth pop exch setfont offset add w 8 sub gt { BG setcolor w //OLScrollButW sub 2 sub 0 //OLScrollButW 2 add h rectpath fill hilite /right eq w //OLScrollButW sub 0 OLScrollButRight } if } def /PaintText { % float float -- focus_state 3 -1 roll offset 0 ne { //OLScrollButW 2 add } 0 ifelse dup 3 1 roll max 4 1 roll 3 -1 roll w textfont value exch currentfont exch setfont exch stringwidth pop exch setfont offset add w 8 sub gt { //OLScrollButW 2 add } 0 ifelse dup 4 1 roll sub min 4 1 roll textfont value selfrom 0 exch GetInterval exch currentfont exch setfont exch stringwidth pop exch setfont offset add 4 add textfont value selto 0 exch GetInterval exch currentfont exch setfont exch stringwidth pop exch setfont offset add 4 add false 4 index 1 w 8 -1 roll sub 7 -1 roll sub OLHLine BG setcolor newpath 4 index 2 5 index 7 index sub h rectpath selfrom selto lt { dup 5 index gt } false ifelse { 1 index 4 index lt } false ifelse { 4 -1 roll min gsave 3 index 2 index max 3 2 index 6 index 5 index max sub textfont fontheight rectpath eoclip fill FG setcolor offset 4 add textfont fontdescent 3 add moveto textfont setfont value show grestore newpath gsave 3 index 2 index max 3 3 -1 roll 6 -1 roll 4 index max sub textfont fontheight rectpath clip exch /none ne { FG setcolor fill BG } { BG setcolor fill FG } ifelse setcolor textfont fontdescent 3 add moveto textfont setfont value selfrom selto selfrom sub getinterval show grestore } { pop gsave clip fill FG setcolor offset 4 add textfont fontdescent 3 add moveto textfont setfont value show grestore dup 5 -1 roll gt { dup 4 -1 roll lt } { 3 -1 roll pop false } ifelse { 1 index /none ne } false ifelse { textfont fontdescent 3 add moveto /active eq OLCaret } { pop pop } ifelse } ifelse newpath } def /Paint { % -- PaintLScroll PaintRScroll 0 w PaintText } def /focus_change { % -- /Paint gexec } def /update_value { % float int int string -- gsave ginit dup length 0 5 -1 roll max min 3 1 roll dup length 3 -1 roll 3 index max min exch 0 w textfont 3 index exch currentfont exch setfont exch stringwidth pop exch setfont sub 8 sub 6 -1 roll max min 4 1 roll dup value ne true { 1 index selto ne } ifelse true { 2 index selfrom ne } ifelse true { 3 index offset ne } ifelse { textfont value exch currentfont exch setfont exch stringwidth pop exch setfont offset add w 8 sub gt offset 0 ne 3 -1 roll /value exch promote 3 -1 roll /selto exch promote 3 -1 roll /selfrom exch promote 3 -1 roll cvi /offset exch promote visible { textfont value exch currentfont exch setfont exch stringwidth pop exch setfont offset add w 8 sub gt { exch not } { exch pop false } ifelse {PaintRScroll} if offset 0 ne {not} { pop false } ifelse {PaintLScroll} if 0 w PaintText } { pop pop } ifelse } { pop pop pop pop } ifelse grestore } def /trackstart 0 def /track_lscroll { % -- offset 0 ne { offset 20 add selfrom selto value update_value } if } def /track_rscroll { % -- textfont value exch currentfont exch setfont exch stringwidth pop exch setfont offset add w 8 sub gt { offset 20 sub selfrom selto value update_value } if } def /track_select { % -- textfont value trackx offset sub 4 sub stringpos offset trackstart 2 index min trackstart 4 -1 roll max value update_value } def /OnSelect { % -- mouseevent /XLocation get focus_state 1 index offset 0 ne { //OLScrollButW 2 add } 0 ifelse lt { exch pop offset 0 ne { /none eq {request_focus} if /hilite /left promote PaintLScroll scrollthreshold scrolllinedelay /track_lscroll track_timed pop /hilite unpromote PaintLScroll } {pop} } { 1 index w textfont value exch currentfont exch setfont exch stringwidth pop exch setfont offset add w 8 sub gt { //OLScrollButW 2 add } 0 ifelse sub gt { exch pop textfont value exch currentfont exch setfont exch stringwidth pop exch setfont offset add w 8 sub gt { /none eq {request_focus} if /hilite /right promote PaintRScroll scrollthreshold scrolllinedelay /track_rscroll track_timed pop /hilite unpromote PaintRScroll } {pop} ifelse } { textfont value 4 -1 roll offset sub 4 sub stringpos /trackstart exch promote /none eq { request_focus track_state /mouse_drag eq { offset trackstart trackstart value update_value /track_select track pop } if } { offset trackstart trackstart value update_value /track_select track pop } ifelse /trackstart unpromote } } ifelse ifelse } def /compute_offset { % string int -- float textfont 3 -2 roll 0 exch GetInterval exch currentfont exch setfont exch stringwidth pop exch setfont dup offset neg lt { //OLScrollButW exch sub 4 add } { dup offset add w //OLScrollButW sub gt { w 2 div exch sub } { pop offset } ifelse } ifelse } def /setvalue { % string -- 0 0 2 index length 4 -1 roll update_value } def /setselect { % int int -- value 2 index compute_offset 3 -2 roll value update_value } def /clearselection { % int int -- 0 value length 4 -1 roll min max exch value 2 index 0 exch GetInterval value 3 index 4 -1 roll max 1 index length 1 index sub GetInterval append 2 copy exch compute_offset 3 -1 roll dup 4 -1 roll update_value } def /insertselection { % string -- selfrom 1 index length add value selfrom 0 exch GetInterval 3 -1 roll value selto 1 index length 1 index sub GetInterval append append exch 2 copy compute_offset exch dup 4 -1 roll update_value } def /onkey { % int -- gsave ginit dup onkey$SwiTch0 exch 2 copy known not { pop /$deFaUlT } if get exec grestore } def /onkey$SwiTch0 6 dict dup begin /$deFaUlT { cvis insertselection } def 127 { pop selfrom selto eq { selfrom 1 sub } {selfrom} ifelse selto clearselection } def 8 currentdict 127 get def 13 { pop action } def 10 currentdict 13 get def 9 currentdict 10 get def end def