%!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% NeWS Forth HyperTIES
% Stamp Pad Class Definitions
% Don Hopkins
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

systemdict begin

/Stamp Object
dictbegin
  /Name null def
  /ID null def
  /FilePos null def
  /X 0 def
  /Y 0 def
  /Width 0 def
  /Height 0 def
dictend
classbegin
  /new { % name id filepos => Obj
    /new super send begin
      /FilePos exch def /ID exch def /Name exch def
      currentdict
    end
  } def

  /dlist {
    aload pop
  } def

  /size {
    Width Height
  } def

  /compile {
    pop pop
  } def
classend def

/Picture Stamp
dictbegin
  /Source null def
dictend
classbegin
  /new { % source width height name id filepos => obj
    /new super send begin
      /Height exch def /Width exch def /Source exch def
    currentdict end
  } def

  /compile { % x y => -
    /Y exch def /X exch def
    Source
  } def

classend def

/UnitPicture Picture []
classbegin
  /compile { % x y => -
    /Y exch def /X exch def
    Width Height X Y
    {gsave translate scale} dlist
    Source
    {grestore} dlist
  } def
classend def

/ScaledRaster Picture []
classbegin
  /compile { % x y => -
    /Y exch def /X exch def
    Width Height X Y
    {gsave translate scale} dlist
    Source
    {imagecanvas grestore} dlist
  } def
classend def

/Raster ScaledRaster []
classbegin
  /new { % can name id filepos => object
    gsave 3 index setcanvas
      clippath pathbbox 4 -2 roll pop pop 5 2 roll
    grestore
    /new super send
  } def
classend def

/TargetStamp Stamp
[/Args /Init /NewClass /Ref /Serial /TID /Obj]
classbegin
  /new { % args init class name id filepos => obj
    /new super send begin
      cvn /NewClass exch def /Init exch def /Args exch def
      /Serial 0 def
    currentdict end
  } def

  /compile { % x y width height ref => -
    {/Ref /Height /Width /Y /X} {exch def} forall
    /TID Serial Name (%.%) sprintf def
    /LastTID TID store
    /Serial Serial 1 add def
    Args Ref TID FilePos Can /new NewClass load send
    /Obj exch def
    TargetDict TID cvn Obj put
    Page /Targets get TID Ref put
    Obj /TargetPileID ContentsPileID put
    Obj /ID ID put
    /Init load Obj send
    {clear X Y Width Height /reshape Obj send} fork waitprocess
    /Obj null def
  } def
classend def

end % systemdict