module GRAFLIB
use dflib
real*8       xgmin,xgmax,ygmin,ygmax,zgmin,zgmax
common /gr1/ xgmin,xgmax,ygmin,ygmax,zgmin,zgmax
type (wxycoord) wxy; type(qwinfo)qww
contains

subroutine GRAFINIT(win,tit) ! инициализация графики
integer win; character(*) tit
qww.type=2;ii=setwsizeqq(QWIN$FRAMEWINDOW,qww)
open(win,file='user',title=tit);!ii=clickmenuqq(QWIN$TILE)
call setviewport(10,10,810,810)
dxg=xgmax-xgmin; dyg=ygmax-ygmin
xgmin1=xgmin-0.1*dxg; xgmax1=xgmax+0.1*dxg
ygmin1=ygmin-0.1*dyg; ygmax1=ygmax+0.1*dyg
ii=setwindow(.true.,xgmin1,ygmax1,xgmax1,ygmin1)
ncol=setcolor(15)  ! задание текущего цвета (0...15)
ii=rectangle_w(3,xgmin1,ygmax1,xgmax1,ygmin1) ! заливка окна
if(initializefonts()<0) stop 'fonts not found!' ! инициализация шрифтов
if(setfont('t''Times New Roman Cyr''h30''b')==0) stop 'font not set!'
end subroutine GRAFINIT

subroutine AXIS(xax,yax,icol,dr) ! построение 2D-осей
character(*) xax,yax; real*8 dr,drx,dry,dxg,dyg
ncol=setcolor(icol); dxg=xgmax-xgmin; dyg=ygmax-ygmin
drx=dr*(dyg/dxg); dry=dr
call Plot2((/xgmin,xgmax/),(/0.0d0,0.0d0/),icol,1000,drx)
call Plot2((/0.0d0,0.0d0/),(/ygmin,ygmax/),icol,1000,dry)
call moveto_w(xgmax+0.02*dxg,-0.05*dyg,wxy); call outgtext(xax)         
call moveto_w(-0.05*dxg,ygmax+0.05*dyg,wxy); call outgtext(yax)         
end subroutine AXIS

subroutine GRID(Nxg,Nyg,icol) ! построение сетки
character(6) ch1
real*8 x,dx,y,dy
ncol=setcolor(icol); dxg=xgmax-xgmin; dyg=ygmax-ygmin
dx=dxg/Nxg; dy=dyg/Nyg
x=xgmin; y=ygmax
do i=1,Nxg+1
 call moveto_w(x,ygmin,wxy); iz=lineto_w(x,y)
 call moveto_w(x,0.0_8,wxy); write(ch1,'(f6.2)')x; call outgtext(ch1) 
 x=x+dx
end do
x=xgmax; y=ygmin
do i=1,Nyg+1
 call moveto_w(xgmin,y,wxy); iz=lineto_w(x,y)
 if(abs(y)>1.d-3)then
  call moveto_w(-0.1d0*dxg,y,wxy); write(ch1,'(f6.2)')y; call outgtext(ch1) 
 end if
 y=y+dy
end do       
end subroutine GRID

subroutine PLOT(x,y,icol,isl,im) ! построение 2D-кривой
real*8 x(:),y(:)
imin=lbound(x,dim=1); imax=ubound(x,dim=1)
ncol=setcolor(icol)
select case(im);case(1);mask=#FFFF;case(2);mask=#FF00;end select
call setlinestyle(mask)
call moveto_w(x(imin),y(imin),wxy)
do i=imin,imax
 iz=lineto_w(x(i),y(i)); call sleepqq(isl)
end do
end subroutine PLOT

subroutine PLOT2(x,y,icol,Np,dr) ! построение 2D-кривой толстой линией
real*8 x(:),y(:),dr
imin=lbound(x,dim=1); imax=ubound(x,dim=1)
ncol=setcolor(icol)
do k=imin,imax-1
 dx=(x(k+1)-x(k))/(Np-1)
 dy=(y(k+1)-y(k))/(Np-1)
 do j=1,Np
  if(abs(dx)<1d-9)then ! верт. линия
   xp=x(k)
   yp=y(k)+dy*(j-1)
  else
   xp=x(k)+dx*(j-1)
   yp=y(k)+(dy/dx)*(xp-x(k))
  end if
  iz=ellipse_w(3,xp-dr,yp-dr,xp+dr,yp+dr)   
 end do
end do
end subroutine PLOT2

subroutine Map2D(x,y,z,ivar,x2,y2) ! параллельное проецирование
real*8 x(:),y(:),z(:),x2(:)
real*8 y2(:),fi,psi,dsf,dcf,dsp,dcp
select case(ivar)
case(1) ! изометрия
 fi=dasin(1.0_8/dsqrt(3.0_8))
 psi=dasin(1.0_8/dsqrt(2.0_8))
case(2) ! диметрия
 fi=dasin(1.0_8)/4.0_8
 psi=dasin(dtan(fi))
end select
dsf=dsin(fi);  dcf=dcos(fi)
dsp=dsin(psi); dcp=dcos(psi)
!x2=x*dcp+z*dsp; y2=x*dsf*dsp+y*dcf-z*dsf*dcp ! ось x вправо
x2=-x*dcp+z*dsp; y2=-x*dsf*dsp+y*dcf-z*dsf*dcp ! ось x влево
end subroutine Map2D

subroutine Axis3D(xax,yax,zax,ivar,icol,dr) ! построение 3D-осей
real*8 xa(4),ya(4),za(4),xa2(4),ya2(4),dr
character(*) xax,yax,zax
ca=1.0
xa=(/0.0d0,xgmax,0.d0,0.0d0/)*ca
ya=(/0.0d0,0.0d0,ygmax,0.0d0/)*ca
za=(/0.0d0,0.d0,0.0d0,zgmax/)*ca
call Map2D(xa,ya,za,ivar,xa2,ya2)
do i=2,4
 call Plot2((/xa2(1),xa2(i)/),(/ya2(1),ya2(i)/),icol,1000,dr)
end do
call moveto_w(xa2(2),ya2(2),wxy); call outgtext(xax)
call moveto_w(xa2(3),ya2(3),wxy); call outgtext(yax)
call moveto_w(xa2(4),ya2(4),wxy); call outgtext(zax)
end subroutine Axis3D

subroutine Plot3D(x,y,z,ivar,icol,isl,im) ! построение 3D-кривой
real*8 x(:),y(:),z(:)
real*8, allocatable :: x2(:),y2(:)
N=size(x); allocate(x2(N),y2(N))
call Map2D(x,y,z,ivar,x2,y2)
call Plot(x2,y2,icol,isl,im)
end subroutine Plot3D

subroutine Animate(x,u,xax,yax,icol,isl,im,dr,Lclear) ! анимация
!use GRAFLIB
real*8 x(:),u(:,:),dr; logical Lclear
character(*) xax,yax
M=size(u,dim=1)
do j=1,M
 call Axis(xax,yax,0,dr)
 call GRID(5,5,0)
 call Plot(x,u(j,:),icol,0,im); call sleepqq(isl)
 if(Lclear)then;if(j<M)call Plot(x,u(j,:),15,0,im);end if
end do
end subroutine Animate

end module GRAFLIB