% % 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 or modify this file without charge, but are not authorized to % license or distribute it to anyone else except as part of a product % or program developed by the user. % % 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 % % % textcan.demo 1.4 88/02/10 % % Copyright (c) 1987 by Sun Microsystems, Inc. % Steve Isaac 12/18/87 % % Server-only demonstration of the TextCanvas. Run this file from a psh. % Caret position is set by clicking the left mouse button. Type into the % text canvas and see the results. You can send messages to the Text % canvas from the psh session, for example: % % [(Hello)(there)] false 10 5 /writelines Text send % % --- Put everything in the userdict so we can reference things (ie. TextWindow, % TextCanvas) from callback routines userdict begin % --- Global variables /Win null def % the TextWindow /Text null def % the TextCanvas /Can null def % the canvas % --- Load up classes if necessary systemdict /NeWSWindow known {systemdict /NeWSWindow undef} if (/usr/NeWS/clientsrc/client/nterm/NeWSwin.ps) run systemdict /NeWSScrollbar known {systemdict /NeWSScrollbar undef} if (/usr/NeWS/clientsrc/client/nterm/NeWSSbar.ps) run systemdict /TextCanvas known {systemdict /TextCanvas undef} if (/usr/NeWS/clientsrc/client/nterm/textcan.ps) run % --- Utility routines /DoStuff { % - => - % --- Send the current primary selection to input 10 dict begin /CurrentSelection null def /SelDict /PrimarySelection getselection def SelDict null ne { SelDict /ContentsAscii known { /CurrentSelection SelDict /ContentsAscii get def } if } if CurrentSelection null ne { createevent dup begin /Name /InsertValue def /Action CurrentSelection def /Canvas Can def end sendevent } if end } def /DoPaste { % - => - % --- Send the current primary selection to input 10 dict begin /CurrentSelection null def /SelDict /PrimarySelection getselection def SelDict null ne { SelDict /ContentsAscii known { /CurrentSelection SelDict /ContentsAscii get def } if } if CurrentSelection null ne { createevent dup begin /Name /InsertValue def /Action CurrentSelection def /Canvas Can def end sendevent } if end } def /PutNeWS { % - => - % --- Put the primary selection onto the NeWS shelf 10 dict begin /SelDict /PrimarySelection getselection def SelDict null ne { /SelDict1 SelDict length dict def SelDict SelDict1 copy SelDict1 /ShelfSelection setselection } if end } def /GetNeWS { % - => - % --- Send the NeWS shelf selection to input 10 dict begin /CurrentSelection null def /SelDict /ShelfSelection getselection def SelDict null ne { SelDict /ContentsAscii known { /CurrentSelection SelDict /ContentsAscii get def } if } if CurrentSelection null ne { createevent dup begin /Name /InsertValue def /Action CurrentSelection def /Canvas Can def end sendevent } if end } def /PutSunView { % - => - % --- Put the primary selection onto the SunView shelf (news_selection -1 >/tmp/winselection;set_selection 3 /tmp/winselection) forkunix } def /GetSunView { % - => - % --- Send the SunView shelf selection to input 10 dict begin % --- Note: we use SelectionBuffer0 as a temporary holding place /SelectionBuffer0 clearselection (get_selection | news_selection -s -b0) forkunix % --- Wait for SelectionBuffer0 to be filled. { /SelDict /SelectionBuffer0 getselection def SelDict null ne { exit } if 1 240 div sleep } loop /CurrentSelection null def SelDict /ContentsAscii known { /CurrentSelection SelDict /ContentsAscii get def } if CurrentSelection null ne { createevent dup begin /Name /InsertValue def /Action CurrentSelection def /Canvas Can def end sendevent } if end } def % --- Begin Initialization /Win framebuffer /new NeWSWindow send def /reshapefromuser Win send /addVscroll Win send /addHscroll Win send /HScrollbar Win /HScrollbar get def /VScrollbar Win /VScrollbar get def /Can Win /ClientCanvas get def /Text 200 Can /new TextCanvas send def % --- Hook the different object together via callback routines { /PaintClient {/fixdamage Text send} def } Win send { /ReshapeClient {/reshape Text send} def } Win send { /NotifyUser { null ItemValue /moveviewport Text send } def } VScrollbar send { /ClientDrag { DoScroll null ItemValue /moveviewport Text send } def } VScrollbar send { /NotifyUser { ItemValue null /moveviewport Text send } def } HScrollbar send { /ClientDrag { DoScroll ItemValue null /moveviewport Text send } def } HScrollbar send { /KeyHitCallback { % key => - 10 dict begin /key exch def key 13 eq { /getcaretpos Text send pop /y exch 1 add def [() ()] true /writeatcaret Text send }{ /s 1 string def s 0 key put [s] true /writeatcaret Text send } ifelse end } def } Text send { /InsertValueCallback { % string => - 10 dict begin /s exch def /newlines 0 def s {10 eq {/newlines newlines 1 add def} if} forall /a newlines 1 add array def 0 1 newlines 1 sub { /i exch def s (\n) search pop /pre exch def pop /s exch def a i pre put } for a newlines s put a true /writeatcaret Text send } def } Text send { /LeftMouseUpCallback { % col row => - 10 dict begin /row exch def /col exch def col row /movecaret Text send end } def } Text send % --- Create menus /colorsquare { % color keyword => - /paint eq {20 20 rect setcolor fill} {pop 20 20} ifelse } def /SetColor { % color => - /currentindex colorsmenu send { 0 { dup /setfgcolor Win send /setfgcolor Text send } 1 { dup /setbgcolor Win send /setbgcolor Text send } 2 { /setcaretcolor Text send} } case /paint Win send } def /shelfmenu [ (Get) {GetNeWS} (Put) {PutNeWS} (Get SunView) {GetSunView} (Put SunView) {PutSunView} ] /new DefaultMenu send def /colormenu [1 dup dup rgbcolor [exch {colorsquare}] .925 dup dup rgbcolor [exch {colorsquare}] .875 .125 neg .250 { dup dup rgbcolor [exch {colorsquare}] } for ColorDict { exch pop [exch {colorsquare}] } forall] [{currentkey 0 get SetColor}] /new DefaultMenu send def { /LayoutStyle [7 ColorDict length 1 index div ceiling exch 1 add] def /StrokeSelection? true def /CellHorizGap 2 def /CellVertGap 2 def /RetainCanvas? true def } colormenu send /colorsmenu [ (Text Color =>) colormenu (Fill Color =>) colormenu (Caret Color =>) colormenu ] /new DefaultMenu send def /FntPts 14 def /fontkey {findfont FntPts scalefont} def /fontaction {null /changefont Text send} def /fontmenu [ [(Screen) /Screen fontkey] [(..Bold) /Screen-Bold fontkey] [() /Screen-Bold fontkey] [() /Screen-Bold fontkey] [(Courier) /Courier fontkey] [(..Bold) /Courier-Bold fontkey] [(..Oblique) /Courier-Oblique fontkey] [(..BoldOblique) /Courier-BoldOblique fontkey] ] [{currentkey 1 get /FontName get fontaction}] /new DefaultMenu send def { /LayoutStyle [4 2] def /RowMajor? false def /CenterItems? false def } fontmenu send /pointsizemenu [(6) (8) (10) (12) (14) (16) (18) (24) (32) (64)] [{null currentkey cvi /changefont Text send}] /new DefaultMenu send def { /LayoutStyle [2 5] def /CellHorizGap 5 def } pointsizemenu send { /ClientMenu [ (Stuff) {DoStuff} (Shelf) shelfmenu (Points) pointsizemenu (Fonts) fontmenu (Colors) colorsmenu /sun30 FrameMenu ] /new DefaultMenu send store { /LayoutStyle /Horizontal def /PullRightDelta 0 def /Border 2 def /CenterItems? false def /PullRightDelta 0 def } ClientMenu send } Win send % --- The user can now start typing; let him know by showing the window. % --- Note that this must be done after the client menu is set up, since % the window frame event manager (which handles the menu) is invoked here /oncaret Text send /map Win send % --- Paint the entire window to make sure all color changes are visible /paint Win send end % userdict begin /lines [ (Line1) (Line2) (Line3a) (Line4aa) (Line5aaa) (Line6aaaa) (Line7aaa) (Line8aa) (Line9a) (Line10aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) (Line11) (Line12) (Line13) (Line14) (Line15) (Hey, Mom, lookit the long line over here..... Full of all sorts of stuff) (aaa) ] def lines false /writeatcaret Text send /longlines [ (Lyje1Lyje1Lyje1Lyje1Lyje1Lyje1Lyje1Lyje1Lyje1Lyje1Lyje1Lyje1) (Lyje2Lyje2Lyje2Lyje2Lyje2Lyje2Lyje2Lyje2Lyje2Lyje2Lyje2Lyje2) (Lyje3Lyje3Lyje3Lyje3Lyje3Lyje3Lyje3Lyje3Lyje3Lyje3Lyje3Lyje3) (Lyje4Lyje4Lyje4Lyje4Lyje4Lyje4Lyje4Lyje4Lyje4Lyje4Lyje4Lyje4) (Lyje5Lyje5Lyje5Lyje5Lyje5Lyje5Lyje5Lyje5Lyje5Lyje5Lyje5Lyje5) (Lyje6Lyje6Lyje6Lyje6Lyje6Lyje6Lyje6Lyje6Lyje6Lyje6Lyje6Lyje6) (Lyje7Lyje7Lyje7Lyje7Lyje7Lyje7Lyje7Lyje7Lyje7Lyje7Lyje7Lyje7) (Lyje8Lyje8Lyje8Lyje8Lyje8Lyje8Lyje8Lyje8Lyje8Lyje8Lyje8Lyje8) (Lyje9Lyje9Lyje9Lyje9Lyje9Lyje9Lyje9Lyje9Lyje9Lyje9Lyje9Lyje9) (bbbbbb) ] def longlines false /writeatcaret Text send lines false /writeatcaret Text send longlines false /writeatcaret Text send lines false /writeatcaret Text send longlines false /writeatcaret Text send lines false /writeatcaret Text send