#! /usr/NeWS/bin/psh
%
% Reagan Bites
% By Don Hopkins
% Warp function by Rehmi Post and Don Hopkins
% Mouth action due to brain damage induced by Hanan Samet's diahrea medicine.
%
% 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. 
%

/warpdict 50 dict def
warpdict begin
  /fudge 2 def
end

/warp	% hparts vparts source ==> ---
{   warpdict begin
    /fromCan exch def
    gsave
      fromCan setcanvas
      clippath pathbbox points2rect
      /fromHeight exch def /fromWidth exch def pop pop
      /thruCan fromCan newcanvas def
      thruCan /Retained true put
    grestore
    /fromHeights exch normalize def
    /fromWidths exch normalize def
    /n fromHeights length def
    /m fromWidths length def
    /toWidth 1 n div def
    /toHeight 1 m div def
    /thruY 0 def
    /toY 0 def
    (Warp %/%) [image_number 1 add images] printf flush
    0  1  m 1 sub { /j exch def
	/thruX 0 def
	/toX 0 def
        0  1  n 1 sub { /i exch def
	    gsave showsquare grestore
            (.) print flush
 	    /thruX thruX thruWidth add def
	    /toX toX toWidth add def
        } for
	/thruY thruY thruHeight add def
	/toY toY toHeight add def
    } for
   (\n) print flush
    end
} def

% Divide the numbers in an array by their sum, so the array sums to 1.
/normalize  % array ==> normalized_array
{   0  1 index  { add } forall
    /total exch def
    [ exch { total div } forall ]
} def

/showsquare % --- ==> ---
{   /thruWidth fromWidths i get fromWidth mul round def
    /thruHeight fromHeights j get fromHeight mul round def

    % Make a copy of the source square
    gsave
      fromCan setcanvas
      thruX thruY translate
      0 0 thruWidth thruHeight rectpath
      thruCan reshapecanvas
      thruCan setcanvas
      thruX neg thruY neg translate
      fromWidth fromHeight scale
      fromCan imagecanvas
    grestore

    % Translate and scale so that the thru square is mapped onto
    % the destination square
    toX toY translate
    fudge dup idtransform
    abs toHeight add exch abs toWidth add exch
    scale
    thruCan imagecanvas
    5 { pause } repeat
} def

/load_can { % - => -
  systemdict /canvas-dict known not {
    systemdict /canvas-dict 100 dict put
  } if
  canvas-dict canvasfile known {
    /can canvas-dict canvasfile get def
  } {
    currentcursorlocation [(I'm getting loaded ...)] popmsg
    /can canvasfile readcanvas def
    systemdict canvasfile can put
    killprocess
  } ifelse
} def

/periodic-warp { % angle => -
  /arg exch def
  [ 9 arg sin 8 mul add
    14 arg 10 add cos 13 mul add
    4 arg 30 add cos 3 mul add
    3 arg 120 add sin 2.4 mul add ]
  [ 10 arg cos 9 mul add
    7 arg 9 add dup add sin 6 mul add
    14 arg sin 9 mul add
    6 arg 50 add sin 5 mul add ]
  can
  warp
} def

/main {
    /canvasfile ($1) dup length 0 eq {pop (demo/ron.can)} if def
    /images ($2) dup length 0 ne {cvi} {pop 30} ifelse def

    load_can
    /win framebuffer /new Animator send def	% Create a window
    /reshapefromuser win send				% Shape window.
    /map win send

    gsave
      0 1 images 1 sub {
        /image_number exch def
        /new-page win send setcanvas
        clippath pathbbox scale pop pop
	image_number images div 360 mul
	periodic-warp
	/update-last-page win send
	.25 60 div sleep
      } for
    grestore
    
} def

main