00100	  
00200	  require "pbuf2.hdr[102,160]" source!file;
00300	  require "Pbuf2.Rel" load!module;
00400	  
00500	  define ESC = '33;
00600	  define ESC1 = '34;
00700	  define ESC2 = '35;
00800	  define XON = '23;
00900	  define XOF = '21;
01000	
01100	  define PACKEDIMAGE = '2;
01200	  define INBUFFERS = 3;
01300	  define OUTBUFFERS = 8;
01400	
01500	  boolean imagemode;
01600	  integer TTYChan;
01700	
01800	  simple procedure GraphicByteOut(integer x);
01900	    begin
02000	      if imagemode then
02100		begin
02200		  if x geq '40 then 
02300		    begin
02400		      WordOut(TTYChan,x);
02500		      return;
02600		    end;
02700		  if (x = ESC1) or (x = 0) or (x = XON) or (x = XOF) then
02800		    begin
02900		      WordOut(TTYChan,ESC1);
03000		      WordOut(TTYChan,x+"A"-1);
03100		      return;
03200		    end;
03300		  WordOut(TTYChan,x);
03400		  return;
03500		end;
03600	      if x < '40 then
03700		begin
03800		  OutChr(ESC1);
03900		  OutChr(x+"A"-1);
04000		  return;
04100		 end;
04200	      if (x > '177) and ((x land '177) < '40) then
04300		begin
04400		  OutChr(ESC2);
04500		  OutChr((x land '177)+"A"-1);
04600		  return;
04700		end;
04800	      if x > '177 then
04900		begin
05000		  OutChr(ESC);
05100		  OutChr(x land '177);
05200		  return;
05300		end;
05400	      OutChr(x);
05500	    end;
05600	
05700	  simple procedure GraphicWordOut(integer x);
05800	    begin
05900	     GraphicByteOut(x lsh -8);
06000	     GraphicByteOut(x land '377);
06100	    end;
06200	
06300	  simple procedure PlotLine(integer line; integer linelen; safe integer array linearray);
06400	    begin
06500	      integer i;
06600	      linelen := (linelen+15)/16;
06700	      if imagemode then WordOut(TTYChan,ESC) else OutChr(ESC);
06800	      if imagemode then WordOut(TTYChan,"S") else OutChr("S");
06900	      GraphicWordOut(line);
07000	      GraphicWordOut(linelen);
07100	      for i := 1 step 1 until linelen do
07200		begin
07300		  GraphicWordOut(linearray[i]);
07400		end;
07500	    end;
07600	
07700	  procedure PutPoint(integer x,y);
07800	    begin
07900	      OutChr(ESC);
08000	      OutChr("P");
08100	      GraphicWordOut(x);
08200	      GraphicWordOut(y);
08300	    end;
08400	
08500	  simple procedure PutLine(integer x1,y1,x2,y2);
08600	    begin
08700	      OutChr(ESC);
08800	      OutChr("L");
08900	      GraphicWordOut(x1);
09000	      GraphicWordOut(y1);
09100	      GraphicWordOut(x2);
09200	      GraphicWordOut(y2);
09300	    end;
09400	
09500	  simple procedure ClearScreen;
09600	    begin
09700	      OutChr(ESC);
09800	      OutChr("C");
09900	     end;
10000	
10100	  procedure ShowPicture(integer buff,xlen,ylen,maxval,minval);
10200	    begin
10300	      integer picrows,piccols,len,dummy,threshhold;
10400	      threshhold := 0;
10500	      picrows := Rows(buff);
10600	      piccols := Colms(buff);
10700	      len := (xlen+15)/16;
10800	      if imagemode then
10900		begin
11000	          TTYChan := GetChan;
11100	          Open(TTYChan,"TTY",PACKEDIMAGE,INBUFFERS,OUTBUFFERS,dummy,dummy,dummy);
11200		end;
11300	        begin
11400		  safe integer array linearray[1:len];
11500		  safe integer array currenterror[0:xlen];
11600		  integer i,nexterror;
11700		  ArrClr(currenterror);
11800		  for i := 0 step 1 until ylen-1 do
11900		    begin
12000		      integer j;
12100		      nexterror := 0;
12200		      ArrClr(linearray);
12300		      for j := 0 step 1 until xlen-1 do
12400		        begin 
12500			  integer val,diff;
12600			  val := GetPnt(1+(i*picrows)/ylen,1+(j*piccols)/xlen,buff) + currenterror[j];
12700			  if val < threshhold then
12800			    begin 
12900			      diff := val - minval;
13000			      linearray[(j/16)+1] := linearray[(j/16)+1] lor (1 lsh (15 - (j land 15)));
13100			    end;
13200			  if val geq threshhold then
13300			    begin
13400			      diff := val - maxval;
13500			    end;
13600			  currenterror[j+1] := currenterror[j+1] + (diff/2);
13700			  currenterror[j] := nexterror + diff/4;
13800			  nexterror := diff/4;
13900			end;
14000		      PlotLine(i,xlen,linearray);
14100		    end;
14200		end;
14300	      if imagemode then 
14400		begin
14500		  Close(TTYChan);
14600		  Release(TTYChan);
14700		end;
14800	    end;
14900	
15000	   Simple Procedure PrintPic;
15100		  begin
15200		    string filename;
15300		    integer buff,eof,maxval,minval,xlength,ylength;
15400		    OutStr("Show picture.");
15500		    OutStr(CRLF&"Filename:");
15600		    filename := Inchwl;
15700		    OutStr("Max value:");
15800		    maxval := Cvd(Inchwl);
15900		    OutStr("Min value:");
16000		    minval := Cvd(Inchwl);
16100		    OutStr("X length:");
16200		    xlength := Cvd(Inchwl);
16300		    OutStr("Y length:");
16400		    ylength := Cvd(Inchwl);
16500		    buff := FndBuf;
16600		    InDump("DSK",filename,buff,eof);
16700		    ShowPicture(buff,xlength,ylength,maxval,minval);
16800		    FreBuf(buff);
16900		  end;
17000	
17100	   Simple Procedure PutBox(integer x,y,sizex,sizey);
17200	       begin
17300	       integer s2x,s2y;
17400	       s2x := sizex/2; s2y := sizey/2;
17500	       PutLine(x-s2x,y-s2y,x+s2x,y-s2y);
17600	       PutLine(x-s2x,y-s2y,x-s2x,y+s2y);
17700	       PutLine(x+s2x,y+s2y,x+s2x,y-s2y);
17800	       PutLine(x+s2x,y+s2y,x-s2x,y+s2y);
17900	       end;
18000	
18100	   Simple Procedure PutDot(integer x,y);
18200	       begin
18300	       integer i,j;
18400	       for i := x -1 step 1 until x+1 do
18500	         for j := y-1 step 1 until y+1 do
18600	                PutPoint(i,j);
18700	       end;
18800	
18900	
19000