%!
%
% MouSee.ps
% By Don Hopkins, University of Maryland Human Computer Interaction Lab.
%
% MouSee run.
% MouSee Spot make, You Button press when. 
% MouSee Trail leave, You Mouse move when.
% MouSee Trail thick leave, You Button press Mouse move and when.
% Fun have!
%
% Copyright (C) 1988 by Don Hopkins. All rights reserved.
% This program is provided for unrestricted use, provided that this 
% copyright message is preserved. There is no warranty, and no author 
% or distributer accepts responsibility for any damage caused by this 
% program. 
%

/MouSeeWindow DefaultWindow
dictbegin
  /MouseX 0 def
  /MouseY 0 def
  /OldMouseX 0 def
  /OldMouseY 0 def
  /HScale null def
  /VScale null def
  /LeftButtonState false def
  /MiddleButtonState false def
  /RightButtonState false def
  /MouseCanvas null def
dictend
classbegin
  /MouseWidth 38 def
  /MouseHeight 50 def
  /CornerRadius 4 def
  /ButtonRadius 3 def
  /ButtonWidth .1 def

  /PaintClient {
    gsave
      1 fillcanvas
      draw-mouse
    grestore
  } def

  /reshape { % x y w h => -
    /reshape super send
    gsave
      framebuffer setcanvas
      clippath pathbbox 4 -2 roll pop pop % fbw fbh
      ClientCanvas setcanvas
      clippath pathbbox 4 -2 roll pop pop % fbw fbh ccw cch
      MouseHeight sub 1 max exch
      MouseWidth sub 1 max exch
      3 -1 roll div /VScale exch def
      exch div /HScale exch def
    grestore
  } def

  /mouse-path {
    CornerRadius 0 0 MouseWidth MouseHeight rrectpath
  } def

  /mouse-trail {
    DX DY rlineto
  } def

  /move-mouse { % x y => -
    gsave
      /OldMouseX MouseX store  /OldMouseY MouseY store
      /MouseY exch store  /MouseX exch store
      /DX MouseX OldMouseX sub HScale mul store
      /DY MouseY OldMouseY sub VScale mul store
      ClientCanvas setcanvas
      ((%, %)   ) [MouseX MouseY] sprintf
      dup stringbbox 8 add rectpath 1 setgray fill
      0 0 moveto
      0 setgray show
      OldMouseX HScale mul
      OldMouseY VScale mul translate
%      mouse-path
%      gsave 1 setgray fill grestore
%      1 setgray fill
      MouseWidth 2 div MouseHeight 2 div moveto mouse-trail
%      MouseWidth 0 moveto mouse-trail
%      MouseWidth MouseHeight moveto mouse-trail
%      0 MouseHeight moveto mouse-trail
      0 setlinecap
      LeftButtonState MiddleButtonState RightButtonState
      or or 4 1 ifelse
      gsave dup 2 add setlinewidth 1 setgray stroke grestore
      setlinewidth 0 setgray stroke
      MouseCanvas setcanvas
      MouseX HScale mul MouseY 3 sub VScale mul 
      movecanvas
    grestore
  } def

  /draw-mouse {
    gsave
      MouseCanvas setcanvas
      mouse-path
      gsave .5 setgray fill grestore
      0 setgray 3 setlinewidth stroke
      draw-buttons
    grestore
  } def

  /draw-buttons {
    LeftButtonState draw-left-button
    MiddleButtonState draw-middle-button
    RightButtonState draw-right-button
  } def

  /draw-left-button {
    MouseWidth .2 mul draw-button
  } def

  /draw-middle-button {
    MouseWidth .5 mul draw-button
  } def

  /draw-right-button {
    MouseWidth .8 mul draw-button
  } def

  /mark-button {
    gsave
      framebuffer setcanvas
      XLocation HScale mul MouseWidth 2 div add
      YLocation VScale mul MouseHeight 2 div add
      ClientCanvas setcanvas
      2 copy 10 0 360 arc 1 setgray fill
      8 0 360 arc 0 setgray fill
    grestore
  } def

  /set-left-button {
    mark-button
    /DownTransition eq
    dup /LeftButtonState exch store
    draw-left-button
  } def

  /set-middle-button {
    mark-button
    /DownTransition eq
    dup /MiddleButtonState exch store
    draw-middle-button
  } def

  /set-right-button {
    mark-button
    /DownTransition eq
    dup /RightButtonState exch store
    draw-right-button
  } def

  /draw-button { % bool x => -
    gsave
    MouseCanvas setcanvas
    ButtonRadius exch
    MouseWidth ButtonWidth mul sub  MouseHeight .5 mul round
    MouseWidth ButtonWidth mul dup add  MouseHeight .4 mul round
    rrectpath
    gsave .25 .75 ifelse setgray fill grestore
    1 setlinewidth 1 setgray stroke
    grestore
  } def

  /update-mouse {
    XLocation YLocation move-mouse
  } def

  /make-mouse {
    gsave
      ClientCanvas /Retained true put
      FrameCanvas /Retained true put % X11/NeWS
      /MouseCanvas ClientCanvas newcanvas def
      MouseCanvas /Transparent false put
      MouseCanvas /Retained true put
      ClientCanvas setcanvas
      mouse-path MouseCanvas 
      reshapecanvas
      framebuffer setcanvas
      currentcursorlocation
      /MouseY exch def
      /MouseX exch def
      MouseCanvas setcanvas
      MouseX HScale mul MouseY VScale mul movecanvas
      MouseCanvas /Mapped true put
    grestore
  } def


  /tracker {
      createevent dup begin
        /Name [
	  /LeftMouseButton /MiddleMouseButton /RightMouseButton
          /MouseDragged
        ] def
	/Priority 10 def
	/Exclusivity true def
      end expressinterest
      createevent dup begin
        /Name /Damaged def
	/Canvas MouseCanvas def
      end expressinterest
      framebuffer setcanvas
      { awaitevent dup begin
        Name {
	  /LeftMouseButton { Action set-left-button }
	  /MiddleMouseButton { Action set-middle-button }
	  /RightMouseButton { Action set-right-button }
	  /MouseDragged { update-mouse }
	  /Damaged { draw-mouse }
	} case
	redistributeevent
        end
      } loop
  } def

  /track {
    make-mouse
    /TrackProcess {tracker} fork def
  } def
classend def

/win framebuffer /new MouSeeWindow send def
/reshapefromuser win send
/map win send
/track win send