#! /usr/NeWS/bin/psh
%!
%% drawer1.0
%%
systemdict /Item known not { (NeWS/liteitem.ps) run } if

/drawer1.0 400 dict def
drawer1.0 begin

/xst {exch store} def
/mst {4 string cvs ( ) append} def

[/blueLineEventMgr /MyEventMgr /FrameEventMgr
 /CyanSlide /YellowSlide /MagentaSlide /BlackSlide /items
 /inFileButton /foo1 /foo3] {null def} forall
/mouse? true def
/userMessage? true def
/Helvetica findfont 30 scalefont setfont
/fileName (NeWS/drawer_info) def
/oldFileName (NeWS/drawer_info) def
/inFileName fileName def
/outFileName (/tmp/drawer.out) def
/inFile inFileName (r) file def
/outFile outFileName (w) file def
/inFileArray null def
/drawMarks [] def
/CP? false def
/LP? false def
/AP? 0 def
/Left (lsh) def
/Right (rsh) def
/Centre (csh) def
[/X0 /Y0 /X1 /Y1 /X2 /Y2 /X3 /Y3 /inval /modval] {0 def} forall
/fontArray [
 /Times-Roman /Times-Italic /Times-Bold /Times-BoldItalic
 /Helvetica /Helvetica-Bold /Helvetica-BoldOblique /Helvetica-Oblique
 /Courier /Courier-Bold /Courier-Oblique /Courier-BoldOblique
] def
/pointSizeArray [ 64 8 14 18 24 32] def
/textLayout [/Left /Centre /Right] def
/currentTextLayout /Left def
/currentFont /Times-Roman def
/currentPointSize 64 def
/cyan 0 def
/yellow 0 def
/magenta 0 def
/black 0 def
/Cyan 1 def
/Yellow 1 def
/Magenta 1 def
/Black 1 def
/lineWidth 0 def
/lineColor? true def
/snap 1 def
/overlay null def



/prolog (%!
%%drawerPRO1.0
/drawerPRO1.0 where not {
  /drawerPRO1.0 100 dict def
  drawerPRO1.0 begin
  /invCol {3 index add neg dup 0 lt {pop 0} if 3 1 roll} def
  /setcymbcolor { 1 sub 4 1 roll invCol invCol invCol setrgbcolor pop } def
  /_k {setcymbcolor} def
  /_K {setcymbcolor} def
  /m {moveto} def
  /c {curveto} def
  /cp {closepath} def
  /s {setlinewidth _K stroke} def
  /f {closepath _k fill} def
  /fs {closepath gsave _k fill grestore s newpath} def
  /csh {
   _K findfont exch scalefont setfont
   dup stringwidth pop .5 mul neg 0 rmoveto show
  } def
  /lsh {_K findfont exch scalefont setfont show} def
  /rsh {
   _K findfont exch scalefont setfont
   dup stringwidth pop neg 0 rmoveto show
  } def
  end
} if
drawerPRO1.0 begin
%%EndProlog
) def

prolog cvx exec

/blueLine {
 100 dict begin
 /overlay currentcanvas createoverlay store
 /Point {
  currentcursorlocation 4 string cvs exch 4 string cvs exch
  ( ) exch append append ( ) append
 } def
 /s {5 pop stroke} def
 /f {4 pop stroke} def
 /fs {9 pop stroke} def
 /cp {closepath} def
 /csh {
  4 pop findfont exch scalefont setfont
  dup stringwidth pop .5 mul neg 0 rmoveto show
 } def
 /lsh {
  4 pop findfont exch scalefont setfont show
 } def
 /rsh {
  4 pop findfont exch scalefont setfont dup stringwidth pop neg 0 rmoveto show
 } def
 /MT {} def
 /CP? false store
 /LP? false store
 /AP? 0 store
 /xgrid {togrid /x exch store} def
 /ygrid {togrid /y exch store} def
 /togrid {
  /inval exch store
  /modval inval snap mod store
  modval 0 eq {inval} {
   inval snap mod .5 snap mul le {
    inval modval sub
   } {
    inval modval sub snap add
   } ifelse
  } ifelse
 } def
 /PointProc { % - => -
  CP? {
   LP? {
    /drawMarks drawMarks
    [X1 mst Y1 mst X2 mst Y2 mst X3 mst Y3 mst (c) 6 {append} repeat]
    append store
    ccan2 setcanvas X0 Y0 moveto drawMarks dup length 1 sub get cvx exec stroke
    /X0 X3 store /Y0 Y3 store
    /AP? 0 store
   } if
   overlay setcanvas
   X0 Y0 {x xgrid y ygrid x y lineto} getanimated
   waitprocess aload pop /Y3 xst /X3 xst
   [/X1 /X2] {X3 store} forall [/Y1 /Y2] {Y3 store} forall
   X0 Y0 moveto X3 Y3 lineto stroke
   /LP? true store
  }
   {
    LP? { %%%%%%#### test
     /drawMarks drawMarks
     [X1 mst Y1 mst X2 mst Y2 mst X3 mst Y3 mst (c) 6 {append} repeat]
     append store
     ccan2 setcanvas X0 Y0 moveto drawMarks dup length 1 sub get cvx exec stroke
     /AP? 0 store /LP? false store
    } if
    currentcursorlocation ygrid xgrid
    x y /Y0 xst /X0 xst
    /drawMarks drawMarks
    [X0 mst Y0 mst (m) 2 {append} repeat]
    append store
    /CP? true store
   } ifelse
 } def
 /AdjustProc { % - => -
  LP? {
   AP? {
    0 {
     overlay setcanvas
     X0 Y0 {pop pop x xgrid y ygrid x y x y X3 Y3 curveto} getanimated
     waitprocess aload pop dup /Y1 xst /Y2 xst dup /X1 xst /X2 xst
     X0 Y0 moveto X1 Y1 X2 Y2 X3 Y3 curveto stroke
     /AP? 1 store
    } 
    1 {
     overlay setcanvas
     X0 Y0 {pop pop X1 Y1 x xgrid y ygrid x y X3 Y3 curveto} getanimated
     waitprocess aload pop /Y2 xst /X2 xst
     X0 Y0 moveto X1 Y1 X2 Y2 X3 Y3 curveto stroke
     /AP? 2 store
    } 
    2 {
     overlay setcanvas
     X0 Y0 {pop pop X1 Y1 X2 Y2 x xgrid y ygrid x y curveto} getanimated
     waitprocess aload pop /Y3 xst /X3 xst
     X0 Y0 moveto X1 Y1 X2 Y2 X3 Y3 curveto stroke
     /AP? 0 store
    } 
   /Default {(boom) =}
   } case
  } if
 } def
 /blueLineEventMgr [
  PointButton {PointProc} /DownTransition currentcanvas eventmgrinterest
  AdjustButton {AdjustProc} /DownTransition currentcanvas eventmgrinterest
  AdjustButton {ccan3 canvastotop} /DownTransition ccan1 eventmgrinterest
 ] forkeventmgr store
 end
} def

/fileNotFoundError {
 setcanvas
 gsave clippath 1 setgray fill 0 setgray
 clippath pathbbox 1000 div exch 1000 div exch scale pop pop
 /Times-Roman findfont 100 scalefont setfont
 (File Not) dup stringwidth pop 2 div neg 500 add 600 moveto show
 (Available) dup stringwidth pop 2 div neg 500 add 500 moveto show
 2000 {pause} repeat
 /fileName (NeWS/drawer_new) store loadInFile
 grestore
} def

/badPSError {
 setcanvas
 gsave clippath 1 setgray fill 0 setgray
 clippath pathbbox 1000 div exch 1000 div exch scale pop pop
 /Times-Roman findfont 100 scalefont setfont
 (Error in) dup stringwidth pop 2 div neg 500 add 600 moveto show
 (PostScript) dup stringwidth pop 2 div neg 500 add 500 moveto show
 (File) dup stringwidth pop 2 div neg 500 add 400 moveto show
 grestore
} def

/loadInFile {
 inFile closefile
 /inFileName fileName store
 fileName (NeWS/drawer_info) eq fileName (NeWS/drawer_help) eq or {/userMessage? true store}
 {/userMessage? false store} ifelse
 /inFile inFileName (r) file store
  /inFileArray [] store
  {[ inFile 257 string readline {
   ] inFileArray exch append /inFileArray exch store pause
   } {pop exit} ifelse pause} loop
} def

loadInFile

/doInFile {inFileArray {cvx exec pause} forall} def

/establishFont {currentFont findfont currentPointSize scalefont setfont} def

/invCol {3 index add neg dup 0 lt {pop 0} if 3 1 roll} def
/setcymbcolor { 1 sub 4 1 roll invCol invCol invCol setrgbcolor pop } def
/cymbcolor { 1 sub 4 1 roll invCol invCol invCol rgbcolor pop } def

/paintBox {
  gsave ccan3 setcanvas
  409 154 129 78 rectpath .8 setgray fill
  414 159 119 68 rectpath
  gsave cyan magenta yellow black setcymbcolor fill grestore
  lineWidth setlinewidth 
  Cyan Magenta Yellow Black setcymbcolor stroke
  /Times-Roman findfont 24 scalefont setfont
  422 187 moveto (drawer 1.o) show grestore
  paintFont
} def

/paintFont {
 gsave ccan3 setcanvas
 74 327 464 102 rectpath 1 setgray fill
 Cyan Magenta Yellow Black setcymbcolor establishFont
 (NeWS rules!) dup stringwidth pop 2 div neg 304 add 355 moveto show
 grestore
} def

/cyanNP {
 lineColor? {/Cyan} {/cyan} ifelse
 ItemValue 100 div store paintBox
} def

/yellowNP {
 lineColor? {/Yellow} {/yellow} ifelse
 ItemValue 100 div store paintBox
} def

/magentaNP {
 lineColor? {/Magenta} {/magenta} ifelse
 ItemValue 100 div store paintBox
} def

/blackNP {
 lineColor? {/Black} {/black} ifelse
 ItemValue 100 div store paintBox
} def

/fillNP {
 /lineColor? false store
 % cyan /setvalue CyanSlide send
 % yellow /setvalue YellowSlide send
 % magenta /setvalue MagentaSlide send
 % black /setvalue BlackSlide send
} def

/strokeNP {
 /lineColor? true store
% Cyan /setvalue CyanSlide send
% Yellow /setvalue YellowSlide send
% Magenta /setvalue MagentaSlide send
% Black /setvalue BlackSlide send
} def

/createitems {
 /items 50 dict dup begin
    
 /strokeButton (line)
  /strokeNP ccan3 63 63
  /new ButtonItem send dup /ItemBorderColor .5 .5 .5 rgbcolor put
  409 88 /move 3 index send def
    
 /fillButton (fill)
  /fillNP ccan3 63 63
  /new ButtonItem send dup /ItemBorderColor .5 .5 .5 rgbcolor put
  475 88 /move 3 index send def
 
 /CyanSlide   (Cyan) [0 100 50] /Top /cyanNP ccan3 330 30
  /new SliderItem send 74 238 /move 3 index send def
  {/ClientDrag {ClientDown NotifyUser} def} CyanSlide send

 /YellowSlide (Yellow) [0 100 50] /Top /yellowNP ccan3 330 30
  /new SliderItem send 74 187 /move 3 index send def
  {/ClientDrag {ClientDown NotifyUser} def} YellowSlide send

 /MagentaSlide  (Magenta) [0 100 50] /Top /magentaNP ccan3 330 30
  /new SliderItem send 74 138 /move 3 index send def
  {/ClientDrag {ClientDown NotifyUser} def} MagentaSlide send
        
 /BlackSlide   (Black) [0 100 50] /Top /blackNP ccan3 330 30
  /new SliderItem send 74 88 /move 3 index send def
  {/ClientDrag {ClientDown NotifyUser} def} BlackSlide send

 /lineWidthSlide   (LineWidth) [0 10 0] /Top
  {/lineWidth ItemValue store paintBox} ccan3 129 30
  /new SliderItem send 409 238 /move 3 index send def
  {/ClientDrag {ClientDown NotifyUser} def} lineWidthSlide send

 /snapSlide   (Grid Snap: ) [1 200 snap] /Right
  {/snap ItemValue store} ccan3 464 30
  /new SliderItem send 74 438 /move 3 index send def
  {/ClientDrag {ClientDown NotifyUser} def} snapSlide send

 /fontButton (Font: ) fontArray [ exch {20 string cvs} forall ] /Right
  {fontArray ItemValue get /currentFont exch store paintFont}
  ccan3 235 30 /new CycleItem send 74 287 /move
  3 index send def
  
 /textLayoutButton (Align: ) textLayout [ exch {20 string cvs} forall ]
  /Right {textLayout ItemValue get /currentTextLayout exch store}
  ccan3 80 30 /new CycleItem send 314 287 /move 3 index send def

 /pointSizeButton (Points: ) pointSizeArray [ exch {20 string cvs} forall ]
  /Right {pointSizeArray ItemValue get /currentPointSize exch store paintFont}
  ccan3 129 30 /new CycleItem send 409 287 /move
  3 index send def

 /fileNameEntry (File: ) fileName /Right {/fileName ItemValue store} ccan3
  463 30 /new TextItem send {
   /ItemFont ItemFont 1 scalefont def
  } 1 index send 74 478 /move 3 index send def

 end def
} def

/interestArray [] def

/doHot { /Name exch def
 Name currentcanvas newcanvas store 0 0 4 2 roll rectpath
 Name cvx exec reshapecanvas
 Name cvx exec setcanvas movecanvas % x y are on the stack
 Name cvx exec begin /Transparent true def /Mapped true def end
 /interestArray
  interestArray
  [ PointButton 5 -1 roll /DownTransition Name cvx exec eventmgrinterest ]
 append store
} def

/goBaby! {/MyEventMgr interestArray forkeventmgr store} def

/ccan1Repaint {
 gsave 1 fillcanvas 0 setgray {doInFile} stopped {ccan1 badPSError} if grestore
 gsave drawerPRO1.0 begin drawMarks {cvx exec} forall end grestore
} def

/ccan2Repaint {
  gsave clippath .7 .7 1 setrgbcolor fill grestore
  10 dict begin
  /s {5 pop stroke} def
  /f {4 pop stroke} def
  drawMarks {cvx exec} forall
  end
} def

/ccan3Repaint {
 .8 fillcanvas 0 setgray
 items paintitems
 paintBox paintFont
 inFileButtonPaint
} def

/plsWait {
 setcanvas
 gsave clippath 1 setgray fill 0 setgray
 clippath pathbbox 1000 div exch 1000 div exch scale pop pop
 /Times-Roman findfont 100 scalefont setfont
 (Please) dup stringwidth pop 2 div neg 500 add 600 moveto show
 (Wait) dup stringwidth pop 2 div neg 500 add 500 moveto show
 grestore
} def

/inFileButtonPaint {
 inFileButton setcanvas
 gsave clippath 1 setgray fill
 0 setgray clippath pathbbox 792 div exch 612 div exch scale pop pop
 gsave {doInFile} stopped {inFileButton badPSError} if grestore
 gsave drawerPRO1.0 begin drawMarks {cvx exec} forall end grestore
 grestore
} def

/Spots {
 ccan1 setcanvas
 {userMessage? {/fileName (NeWS/drawer_help) store loadInFile ccan3 canvastotop}
 {ccan2 canvastotop} ifelse} clippath pathbbox /foo1 doHot
 ccan2 setcanvas blueLine
 ccan3 setcanvas
 { } clippath pathbbox /foo3 doHot
 {fileName oldFileName eq {
   ccan1 canvastotop ccan1 setcanvas
   gsave drawerPRO1.0 begin drawMarks {cvx exec} forall end grestore
   } {
   inFileButton plsWait {
    loadInFile
   } stopped {
    inFileButton fileNotFoundError
   } if
  inFileButtonPaint ccan1 setcanvas ccan1Repaint ccan3 setcanvas
 } ifelse
 /oldFileName fileName store
 }
 74 518 150 194 /inFileButton doHot
 goBaby!
 createitems
 /itemmgr items forkitems def
} def

/preview {
 ccan1 canvastotop ccan1 setcanvas
 gsave drawerPRO1.0 begin drawMarks {cvx exec} forall end grestore
 inFileButtonPaint
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% AKB.ps some keyboard interception 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/messageComplete {
 /drawMarks drawMarks
    [ (\() buffer (\)) ( )
     currentPointSize 10 string cvs ( )
     (/) currentFont 30 string cvs ( )
     Cyan mst Magenta mst Yellow mst Black mst
     currentTextLayout cvx exec 13 {append} repeat]
 append store
 preview
} def

/maxlenBuffer 200 def
/buffer maxlenBuffer string def
/buflen 0 def
/addToBuffer {
 buflen maxlenBuffer lt {
  buffer buflen Name put
  /buflen buflen 1 add store
 } if
} def

/clearBuffer {
 /buffer maxlenBuffer string store
 /buflen 0 store
} def

/seteventmgrcallback {	% interest proc => -
 /ClientData 10 dict dup /CallBack 5 -1 roll put put
} def

/eventmgrkbdinterest {	% callback can Editkeys? Fnames? Fstrings? => proc
 [6 1 roll] {
  3 index addkbdinterests				% p can E? FN? FS? a
  exch {[4 index addfunctionstringsinterest] append} if	% p can E? FN? a
  exch {[3 index addfunctionnamesinterest] append} if	% p can E? a
  exch {[2 index addeditkeysinterest] append} if	% p can a
  {2 index seteventmgrcallback} forall		% p can
  pop pop
 } append cvx
} def

/KBScanner {
 /MyEventProc {
  begin
  CP? LP? not and {
  Name type (integertype) eq {
    Name 13 ne {
      addToBuffer
     } {
      messageComplete /CP? false store
      ccan2 setcanvas 0 setgray
      X0 Y0 moveto
      buffer currentPointSize
      currentFont 0 0 0 0 currentTextLayout cvx exec cvx exec
      clearBuffer
     } ifelse
    } if
    overlay setcanvas erasepage
    X0 Y0 moveto
    buffer currentPointSize
    currentFont 0 0 0 0 currentTextLayout cvx exec cvx exec
   } if
  end
  } def
 /p [
  {MyEventProc} ccan2 true true false eventmgrkbdinterest
 ] forkeventmgr def
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% end akb.ps
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



/MyWindow LiteWindow []
classbegin
 /BorderLeft 2 def
 /BorderRight 2 def
 /BorderTop 2 def
 /BorderBottom 2 def
 /CreateFrameMenu { % - => - (Create frame menu)
  /FrameMenu [
   (closepath) {
    LP? {
     /drawMarks drawMarks
     [X1 mst Y1 mst X2 mst Y2 mst X3 mst Y3 mst (c) 6 {append} repeat]
     append store
     ccan2 setcanvas X0 Y0 moveto drawMarks dup length 1 sub get cvx exec stroke
     /X0 X3 store /Y0 Y3 store
     /AP? 0 store /LP? false store
    } if
    /drawMarks drawMarks [(cp)] append store /CP? false store
   }
   (fill) {
    LP? {
     /drawMarks drawMarks
     [X1 mst Y1 mst X2 mst Y2 mst X3 mst Y3 mst (c) 6 {append} repeat]
     append store
     ccan2 setcanvas X0 Y0 moveto drawMarks dup length 1 sub get cvx exec stroke
     /X0 X3 store /Y0 Y3 store
     /AP? 0 store /LP? false store
    } if
    /drawMarks drawMarks
    [cyan mst magenta mst yellow mst black mst (f) 4 {append} repeat]
    append store /CP? false store preview
   }
   (stroke) {
    LP? {
     /drawMarks drawMarks
     [X1 mst Y1 mst X2 mst Y2 mst X3 mst Y3 mst (c) 6 {append} repeat]
     append store
     ccan2 setcanvas X0 Y0 moveto drawMarks dup length 1 sub get cvx exec stroke
     /X0 X3 store /Y0 Y3 store
     /AP? 0 store /LP? false store
    } if
    /drawMarks drawMarks
    [Cyan mst Magenta mst Yellow mst Black mst lineWidth mst (s)
     5 {append} repeat]
    append store /CP? false store preview
   }
   (fill&stroke) {
    LP? {
     /drawMarks drawMarks
     [X1 mst Y1 mst X2 mst Y2 mst X3 mst Y3 mst (c) 6 {append} repeat]
     append store
     ccan2 setcanvas X0 Y0 moveto drawMarks dup length 1 sub get cvx exec stroke
     /X0 X3 store /Y0 Y3 store
     /AP? 0 store /LP? false store
    } if

    /drawMarks drawMarks
    [
     Cyan mst Magenta mst Yellow mst Black mst lineWidth mst
     cyan mst magenta mst yellow mst black mst (fs) 9 {append} repeat]
    append store /CP? false store preview
   }
   (edit drawing) {ccan2 canvastotop}
   (controls) {ccan3 canvastotop}
   (Move) {/slide ThisWindow send}
   (Top) {/totop ThisWindow send}
   (Bottom) {/tobottom ThisWindow send}
   (new) {
    /drawMarks [] store
    [/CP? /LP?] {false store} forall
    /paintclient win send
   }
   (write File:) {
    /out fileName (w) file def
    out prolog writestring
    drawMarks {out exch (\n) append writestring} forall
    out closefile
   }
   (template image) {
    {fileName readcanvas} stopped not {
     gsave
     ccan2 canvastotop overlay setcanvas getwholerect waitprocess 
     ccan2 setcanvas
     matrix currentmatrix
     exch aload pop 4 2 roll translate scale
     exch imagecanvas
     setmatrix
     grestore
    } if
   }
   (Quit) {
    blueLineEventMgr killprocessgroup
    MyEventMgr killprocessgroup
    drawer1.0 /ccan1 undef
    drawer1.0 /ccan2 undef
    drawer1.0 /ccan3 undef
    /destroy win send
   }
   (Close)     {/flipiconic ThisWindow send}
   (Redisplay) {/paint ThisWindow send}
  ] /new DefaultMenu send def
 } def
 /PaintFocus { } def
classend def

/win framebuffer /new MyWindow send def
{/PaintClient {
  can setcanvas clippath pathbbox 4 copy 4 copy
  rectpath ccan1 reshapecanvas
  rectpath ccan2 reshapecanvas
  rectpath ccan3 reshapecanvas
  Spots
  ccan1 setcanvas ccan1Repaint
  ccan2 setcanvas ccan2Repaint
  ccan3 setcanvas ccan3Repaint
 } def
} win send
270 54 612 792 /reshape win send
/map win send
/can win /ClientCanvas get def
/ccan2 can newcanvas def
ccan2 /Mapped true put ccan2 /Transparent false put
/ccan1 can newcanvas def
ccan1 /Mapped true put ccan1 /Transparent false put
/ccan3 can newcanvas def
ccan3 /Mapped true put ccan3 /Transparent false put
KBScanner

end
