% TrmPS.cps: version 3.8 of 8/24/87
% Emacs Source File
%
% @(#)TrmPS.cps	3.8	8/24/87

%
% Tag definitions:
%
#define	tGetDimensions	 0
#define	tGetFont	 1
#define	tGetFontInfo	 2
#define	tGetCharWidth	 3
#define	tHereIsChar	 4
#define	tHereIsMouse	 5
#define	tHereIsDamage	 6
#define	tHereIsFuncKey	 7

%
% Create a fresh emacs display object and keep it for the stubs to use.
%
cdef ps_initialize(c, l)
	%
	% Emacs windows are constructed as instances of a subclass
	% of the default window implementation.
	%
	/EmacsDisplay DefaultWindow

	% Instance variables.
	dictbegin
	    % Use SunView default font.
	    /defaultpointsize 12 def
	    /defaultfont (Screen) def

	    % Info pertaining to the current font.
	    /maxy null def
	    /miny null def
	    /yh	null def
	    /emat null def
	    /charwidth null def
	    /PointSize null def
	    /FontName null def
	dictend

	% Things held in common for the entire class.
	classbegin
	    /new { % canvas => display
		% 
		% to get a new one, we need a window.
		% 
		/new super send dup begin
		    false setprintermatch

		    /FrameLabel (Emacs) def
		    /FixFrame { tHereIsDamage tagprint } def
		    /PaintClient { tHereIsDamage tagprint } def
		    /IconImage /emacs def

		    /reshapefromuser self send
		    /map self send

		    ClientCanvas setcanvas

		    defaultfont defaultpointsize /SetFont self send
		    ( ) 0 0 /CU self send
		    /HL0 self send

		    /paint self send
		    /mainloop self send
		end
	    } def

	    /zap {
		% XXX: stopmainloop isn't defined yet.
		/stopmainloop self send
		/destroy super send
	    } def

	    /ding {
		5 setrasteropcode clippath fill
		clippath fill tcolor setcolor
	    } def

	    (\007) cvn /ding load def

	    /CD { 	% c x y cursordown
		gsave
		    translate
		    0 miny moveto
		    0 yh rlineto
		    charwidth 0 rlineto
		    0 yh neg rlineto
		    closepath
		    backgroundcolor setcolor
		    fill
		    textcolor setcolor
		    0 0 moveto
		    show
		grestore
	    } def

	    /CU { 	% c x y cursorup
		gsave
		    translate
		    0 miny moveto
		    0 yh rlineto
		    charwidth 0 rlineto
		    0 yh neg rlineto
		    closepath
		    textcolor setcolor
		    fill
		    backgroundcolor setcolor
		    0 0 moveto
		    show
		grestore
	    } def

	    /ER {	% Erase N cells from x y
		miny add moveto
		0 yh rlineto
		0 rlineto
		0 yh neg rlineto
		closepath
		bcolor setcolor
		fill
		tcolor setcolor
	    } def

	    /CP {	% dy h-1 w x y CP
		miny add 0 exch moveto
		-1 add dup 0 exch rlineto
		exch 0 rlineto
		neg 0 exch rlineto
		closepath
		0 exch copyarea
	    } def

	    /HL0 { 
		/bcolor backgroundcolor def
		/tcolor textcolor def
		tcolor setcolor
	    } def

	    /HL1 {
		/bcolor textcolor def
		/tcolor backgroundcolor def
		tcolor setcolor
	    } def

	    % fn psize SetFont -
	    % Switch to the font named by fn with point size psize.
	    % Catch failures, but don't bother reporting them.
	    % If the desired font exists, record fn and ps in FontName
	    % and PointSize for future reference.
	    /SetFont {
		% Replicate fn and psize on the stack.
		1 index 1 index
		% Check for invalid (or nonexistent) font by
		% catching the stop the error handler will issue.
		exch cvn { findfont } stopped {
		    pop pop pop pop	% Remove both fn psize pairs.
		} {
		    exch scalefont setfont
		    0 0 moveto (gy_MTWY()/|{}) false charpath pathbbox
		    /maxy exch def pop
		    /miny exch def pop
		    /yh maxy miny sub def
		    /emat 6 array currentmatrix def
		    /charwidth ( ) stringwidth pop def
		    /PointSize exch def
		    /FontName exch def
		} ifelse
	    } def

	    /BRP {
		{
		    gsave
			FrameCanvas setcanvas damagepath clipcanvas
			PaintFrame
		    grestore
		} /doit self send
	    } def

	    /ERP {
		gsave
		    FrameCanvas setcanvas clipcanvas
		grestore
	    } def

	    /IL {
		/nl exch def /dy exch def /y exch def
		0 y moveto winwidth nl rect 0 dy copyarea
		0 y moveto winwidth dy rect
		backgroundcolor setcolor fill textcolor setcolor
	    } def

	    /DL {
		/nl exch def /dy exch def /y exch def
		0 y dy add moveto winwidth nl rect 0 dy neg copyarea
		0 y nl add moveto winwidth dy rect
		backgroundcolor setcolor fill textcolor setcolor
	    } def

	    /mainloop {
		% Set up PostScript process to get input
		% and transmit it to Emacs.
		{
		    30 dict begin		% process-private storage

		    % Interest-related definitions.

		    /lasttime 0 def
		    /doubletime 1 60 div def

		    % MouseOut is invoked as the name procedure for mouse
		    % events.  It examines the event for modifiers and then
		    % transmits an encoded representation to Emacs.
		    /MouseOut { 
			ThisEvent begin
			    tHereIsMouse tagprint

			    % Record timestamp info so that we can tell whether
			    % the next event is a doubleclick.  (N.B: old
			    % lasttime value left on stack for use immediately
			    % below.)
			    lasttime /lasttime TimeStamp store

			    % Add in modifier info and send to Emacs.
			    % XXX: Shouldn't we add doubletime to lasttime?
			    TimeStamp doubletime add ge { 32 add } if	% doubleclick
			    Action /UpTransition eq { 64 add } if	% up
			    Shift { 16 add } if
			    Meta { 8 add } if
			    Control { 4 add } if
			    typedprint

			    % Transmit the event's coordinates.
			    currentcanvas setcanvas
			    XLocation typedprint
			    YLocation typedprint
			end
		    } def
		    % The button procedures push the clicked button's value
		    % on the stack and then call MouseOut to process modifiers.
		    /LeftMouseButton { 1 MouseOut } def
		    /MiddleMouseButton { 2 MouseOut } def
		    /RightMouseButton { 3 MouseOut } def

		    % Interest expression.

		    currentcanvas addkbdinterests pop
		    currentcanvas addfunctionstringsinterest pop

		    /OtherInterests 10 dict def
		    OtherInterests begin
			/LeftMouseButton dup def
			/MiddleMouseButton dup def
			/RightMouseButton dup def
		    end
		    createevent dup begin
			/Name OtherInterests def
			/Canvas currentcanvas def
		    end expressinterest

		    % Input event processing.

		    {
			pause
			clear
			/ThisEvent awaitevent def

			/Meta false def
			/Shift false def
			/Control false def

			% Process the elements of the event's KeyState array,
			% defining all names in it as true.
			% XXX: What's the purpose of defining ST here?
			ThisEvent /KeyState get
			dup systemdict exch /ST exch put
			{ dup type /nametype eq { true def } if } forall

			% Dispatch on the event's type: a numeric Name field
			% implies a key press, a Name of /InsertValue denotes
			% a function key press, and anything else means a
			% mouse event (which is assumed to have a procedure
			% embodying how it should be preocssed in its Name
			% field).  This code could stand some cleanup.
			ThisEvent /Name get
			dup type /integertype eq {
			    % Regular key.
			    tHereIsChar tagprint Meta { 128 add } if typedprint
			} {
			dup /InsertValue eq {
			    % Function key.
			    tHereIsFuncKey tagprint
			    ThisEvent /Action get typedprint
			} {
			    % Mouse event.
			    { cvx exec } stopped
			} ifelse
			} ifelse

		    } loop
		    end
		} fork pop
	    } def

	classend def

	% Create the emacs window.
	/display framebuffer /new EmacsDisplay send def

cdef ps_zap_display()
    /zap display send

cdef ps_CursorDown(cstring str, x, y)
    str x y /CD display send

cdef ps_CursorUp(cstring str, x, y)
    str x y /CU display send

cdef ps_blanks(x, y, n)
    n x y /ER display send

cdef ps_flash()
    /ding display send

cdef ps_setHL0()
    /HL0 display send

cdef ps_setHL1()
    /HL1 display send

cdef ps_wipescreen()
    backgroundcolor setcolor clippath fill textcolor setcolor

cdef ps_writechars(x, y, cstring str)
    x y moveto str show

cdef ps_inslines(y, dy, nl)
    y dy nl /IL display send

cdef ps_dellines(y, dy, nl)
    y dy nl /DL display send

cdef ps_beginrepair()
    /BRP display send

cdef ps_endrepair()
    /ERP display send

% This isn't right: setcursorlocation apparently uses the coordinate
% system of the overall screen canvas instead of the emacs canvas's
% coordinate system.
cdef ps_WarpMouse(x, y)
    x y setcursorlocation

cdef ps_AddMenu(s)
    % big, gaping hole here for now

% (Attempt to) switch to the font named by fn with point size psize.
%	Note that the implementation uses SetFont, which catches
%	failures, but doesn't report them.  To determine whether
%	this call worked, use ps_GetFont and compare its results
%	with the arguments to this call.
cdef ps_SetFont(string fn, int psize)
    fn psize /SetFont display send


cdef ps_IsChar(c)		=> tHereIsChar (c)
cdef ps_IsMouse(b, x, y)	=> tHereIsMouse (b, x, y)
cdef ps_IsFuncKey(string s)	=> tHereIsFuncKey (s)
cdef ps_IsDamage()		=> tHereIsDamage

% Return window dimensions in pixel coordinates.
cdef ps_GetDimensions(int ph, int pw)
    display begin
	tGetDimensions tagprint
	ClientCanvas setcanvas
    end
    initclip clippath
    pathbbox typedprint dup /winwidth exch def typedprint
    clear
=>  tGetDimensions (ph, pw)


%
% Font manipulation routines
%	These depend on state established in ps_initialize
%	and ps_initialize_continued.
%

% Return current font name and point size.
cdef ps_GetFont(string fname, int psize)
    display begin
	tGetFont	tagprint
	FontName	typedprint
	PointSize	typedprint
    end
=>  tGetFont (fname, psize)

% Return global information about the current font.
cdef ps_GetFontInfo(int minyval, int ch, int cw)
    display begin
	tGetFontInfo	tagprint
	miny		typedprint
	yh		typedprint
	charwidth	typedprint
    end
=>  tGetFontInfo (minyval, ch, cw)

% Return information about character i of the current font.
%cdef ps_GetCharWidth(int i, int w)
%    % ...
%    tGetCharWidth	tagprint
%=>  tGetCharWidth (w)