module JapiGraf

!!=============================================================================
!! Procedury pro 2D grafy s využitímm knihovny JAPI v G95
!! Verse 2.4 pro g95 - 070907 - 100907
!! Jan Celý, ÚFKL PřF MU
!!-----------------------------------------------------------------------------
!! Historie oprav a doplnku je v zaveru souboru
!!=============================================================================
!!
!! Zakladem je plocha PlotArea,podle ni se zvoli rozmer canvas a
!! frame (resp.s menu)
!! Vlastni graf se kresli do obdelniku - PlotArea - na canvas
!!
!!  ViewPort:
!!      +-frame----------------------------------------------+
!!      |          Hlavicka frame + menu                     |
!!      |----------------------------------------------------|
!!      | canvas             ^  PAtop                        |
!!      |                    v                               |
!!      |            +---------------------+                 |
!!      | <--------->|  PlotArea           |<--------------->|
!!      |   PAleft   |                     |     PAright     |
!!      |            +---------------------+                 |
!!      |                    ^  PAbottom                     |
!!      |                    v                               |
!!      +----------------------------------------------------+
!!
!! Normalni souradnice stinitka monitoru:
!!   (0,0)+------------------------------------+
!!        |                                    |
!!        |                                    |
!!        +------------------------------------+ (1,1)
!!
!!
!! Uzivatelske souradnice (canvas,PlotArea)
!!   	  +------------------------------------+ (uxmax,uymax)
!!        |                                    |
!!        |                                    |
!!        +------------------------------------+
!!    (uxmin,uymin)
!!
!!=============================================================================

use std_type
use japi
use rgbcolor

implicit none

private

character(len=10),parameter,public :: JapigrafVer = "2.4"

intrinsic :: abs,int,min,max,modulo,trim,len_trim

PUBLIC ::	StartJapi,Nx2Pix,Ny2Pix,SetPAmargins,DefViewPort,&
			Real2Str,PlotSymbol3,PlotSymbol5,ShowVP,HideVP,&
			SetGcursor,USetGcursor,GetGcursor,SetFGcolor,SetBGcolor,&
			ClipCanvas,ClipPlotArea,OsaX,OsaY,PlotLabels,&
			Ubod2Pbod,Uline,ULineTo,DrawCircle, &
			PisText, PlotFunction,&
			AddStdMenu, StartStdMenu, NastavStdGraf,&
			UPolyLine, Conrec,&
			NastavFrame, NastavCanvas, SestavVPinfo

public :: operator(+) , operator(-)

private :: PbodPlus, PbodMinus, UbodPlus, UbodMinus

!======================== Uzivatelske TYPY ====================================
! typ pro uzivatelske souradnice pro PlotArea
type,public :: userCO
	real(kind=DP) :: uxmin,uxmax,uymin,uymax
end type userCO

! typ pro informace o objektu (frame,canvas,PlotArea)
type,public :: objCO
	integer :: polx,poly,psirka,pvyska
end type objCO

! typ pro informace o objektu v normalnich souradnicich (frame,canvas,PlotArea)
type,public :: NobjCO
	real(DP) :: Npolx,Npoly,Nsirka,Nvyska
end type NobjCO

! Informace o castech ViewPort
type,public :: UPinfo
	type(userCO) :: Uinfo
	type(objCO)	 :: Pinfo
end type UPinfo

! Informace o frame
type,public :: FrameInfo
	integer :: frame
	character(len=255) :: NadpisFR
	TYPE(objCO) :: PmiryFR
	type(rgbcol) :: BGbarvaFR
end type FrameInfo

! informace o canvas
type,public :: CanvasInfo
	integer :: canvas
	type(objCO) :: PmiryC,PmiryPA
	type(userCO) :: UmezeC,UmezePA
	type(rgbcol) :: BGbarvaC,BGbarvaPA
	integer :: pix2ux,pix2uy
end type CanvasInfo

! informace o PlotArea
Type,public :: PlotAreaInfo
	integer :: PAleft,PAright,PAbottom,PAtop
end type PlotAreaInfo

! Inforamace o celem ViewPort
type,public :: ViewPortInfo
	integer :: frame, canvas
	type(UPinfo) :: canvasUPinfo, PlotAreaUPinfo
	TYPE(rgbcol) :: canvasRGBcolor, PlotAreaRGBcolor
	integer :: pix2ux, pix2uy
end type ViewPortInfo

! typ pro bod v uzivatelskych jednotkach
type,public :: Ubod
	real(kind=DP) :: x,y
end type Ubod
! typ pro bod v pixelech
type,public :: Pbod
	integer :: px,py
end type Pbod

! ============== interface pro operatory +, - ====================
interface operator(+)
	module procedure PbodPlus, UbodPlus
end interface
interface operator(-)
	module procedure PbodMinus, UbodMinus
end interface

! ----------------- typy pro kresbu symbolu ------------------
type,Public :: Symbol3
	integer(kind=i1b),dimension(9) :: pix
end type Symbol3

type,Public :: Symbol5
	integer(kind=i1b),dimension(25) :: pix
end type Symbol5

! ========== privatni promenne pro procedury:==================================
!
!integer,private ::  soubor, tisk, tiskcanvas, konec  ! AddStdmenu, StartStdMenu

integer,private :: menubar,soubor,konec,tisk,tiskcanvas,graf	! pro menu
integer :: bmp, ppm,image
character(len=100) :: jmeno
logical :: imgl
!
!===================== Nastavovane globalni promenne ==========================
!
! Zjistena sirka s vyska stinitka (pixelu) v StartJapi()
integer,public :: S_width, S_height
! AspectRatio=S_width/S_height, nastavi se v StartJapi
real(kind=DP),Public :: AspRatio

!------------------------- Poloha PlotArea ------------------------------------
! Odsazeni leveho a spodniho okraje PlotArea od okraju canvas
! je mozne je v programu menit pred volanim DefViewPort
integer,public :: PAleft, PAbottom, PAtop ,PAright
! Uschova, ve StartJapi se zkopiruji, nebo se nastavi SetPAmargin
INTEGER,parameter,private :: &
		sPAleft = 80, sPAbottom = 40, sPAtop = 30, sPAright=10

!------- Informace o castech ViewPort, prenesou se sem z DefViewPort ----------
type(ViewPortInfo),private :: SVPinfo
! Posledne nastavene infoVP
type(ViewPortInfo),public :: AinfVP

!------------------------- Graficky kursor ------------------------------------
! nastaveni meni SetGcursor, Uline a ULineTo ho nastavi na koncovy bod
! v StartJapi se nastavi na Pbod(0,0)
type(Pbod),private :: Gcur

!------------------------ Delka delicich carek os -----------------------------
integer,public :: BigTick = 6 ,SmallTick = 2  ! velka a mala carka v pixelech

!=============================== Symboly ======================================
!------------------------ Symboly v matici 3x3 --------------------------------
type(Symbol3),parameter,public :: plus3 = Symbol3((/0,1,0,1,1,1,0,1,0/))
type(Symbol3),parameter,public :: krat3 = Symbol3((/1,0,1,0,1,0,1,0,1/))
type(Symbol3),parameter,public :: ctvr3 = Symbol3((/1,1,1,1,0,1,1,1,1/))
type(Symbol3),parameter,public :: diam3 = Symbol3((/0,1,0,1,0,1,0,1,0/))
type(Symbol3),parameter,public :: ctvr3f = Symbol3((/1,1,1,1,1,1,1,1,1/))
type(Symbol3),parameter,public :: diam3f = Symbol3((/0,1,0,1,1,1,0,1,0/))

!------------------------ Symboly v matici 5x5 --------------------------------
type(Symbol5),parameter,public :: plus5 = &
	Symbol5((/0,0,1,0,0,0,0,1,0,0,1,1,1,1,1,0,0,1,0,0,0,0,1,0,0/))
type(Symbol5),parameter,public :: krat5 = &
	Symbol5((/1,0,0,0,1,0,1,0,1,0,0,0,1,0,0,0,1,0,1,0,1,0,0,0,1/))
type(Symbol5),parameter,public :: ctvr5 = &
	Symbol5((/1,1,1,1,1,1,0,0,0,1,1,0,0,0,1,1,0,0,0,1,1,1,1,1,1/))
type(Symbol5),parameter,public :: diam5 = &
	Symbol5((/0,0,1,0,0,0,1,0,1,0,1,0,0,0,1,0,1,0,1,0,0,0,1,0,0/))
type(Symbol5),parameter,public :: ctvr5f = &
	Symbol5((/1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1/))
type(Symbol5),parameter,public :: diam5f = &
	Symbol5((/0,0,1,0,0,0,1,1,1,0,1,1,1,1,1,0,1,1,1,0,0,0,1,0,0/))
type(Symbol5),parameter,public :: kruh5 = &
	Symbol5((/0,1,1,1,0,1,0,0,0,1,1,0,0,0,1,1,0,0,0,1,0,1,1,1,0/))
type(Symbol5),parameter,public :: kruh5f = &
	Symbol5((/0,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,0/))

!
!==============================================================================
!---------------------  PROCEDURY a FUNKCE ------------------------------------
!==============================================================================

contains

subroutine StartJapi()
!!
!! ZAHAJOVACI procedura pro JAPI i JapiGraf
!! Inicializace JAPI a zjisteni rozliseni obrazovky
!!
	IF( .NOT. j_start()) THEN
		PRINT*, "can't connect to JAPI server"
  		CALL j_quit()
  		stop
	END IF
	call SetPAmargins()
	Gcur = Pbod(0,0)
	S_width = j_getscreenwidth()
	S_height = j_getscreenheight()
	AspRatio = real(S_height)/real(S_width)
end subroutine StartJapi

subroutine SetPAmargins()
	PAleft = sPAleft
	PAtop = sPAtop
	PAbottom = sPAbottom
	PAright = sPAright
end subroutine SetPAmargins

subroutine ShowVP(infVP)
	type(ViewPortInfo),intent(IN) :: infVP
	call j_show(infVP%frame)
end subroutine ShowVP

subroutine HideVP(infVP)
	type(ViewPortInfo),intent(IN) :: infVP
	call j_hide(infVP%frame)
end subroutine HideVP

!======================== Nastaveni rgb barev =================================

subroutine SetFGcolor(infVP,barva)
!!
!! Nastavi rgb_barvu popredi canvas
!!
	type(ViewPortInfo),intent(in) :: infVP
	type(rgbcol),intent(in) :: barva
	call j_setcolor(infVP%canvas,barva%r,barva%g,barva%b)
end subroutine SetFGcolor

subroutine SetBGcolor(infVP,barva)
!!
!! Nastavi rgb_barvu pozadi canvas
!!
	type(ViewPortInfo),intent(in) :: infVP
	type(rgbcol),intent(in) :: barva
	call j_setcolorbg(infVP%canvas,barva%r,barva%g,barva%b)
end subroutine SetBGcolor

!========================== Graficky kursor ===================================

subroutine SetGcursor(pxpy)
	! Nastavuje hodnotu Gcur
	type(Pbod),intent(IN) :: pxpy
	Gcur = pxpy
end subroutine SetGcursor

function GetGcursor() result(Gcursor)
	type(Pbod) :: Gcursor
	Gcursor = Gcur
end function GetGcursor

subroutine USetGcursor(infVP,Uxy,Poffxy)
	type(ViewPortInfo),intent(in) :: infVP
	type(Ubod),intent(in) :: Uxy
	type(Pbod),intent(in),optional :: Poffxy
	Gcur = Ubod2Pbod(infVP,Uxy)
	if (present(Poffxy)) Gcur = Gcur+Poffxy
end subroutine USetGcursor

!===================== Normalni souradnice ====================================

function Nx2Pix(NormalniX) result(Pixelu)
	! Prevadi x-ovou normalni souradnici obrazovky na pixely
	real(kind=DP),intent(in) :: NormalniX
	Integer :: Pixelu
	Pixelu = int(NormalniX*S_width)
end function Nx2Pix

function Ny2Pix(NormalniY) result(Pixelu)
!!
!! Prevadi y-ovou normalni souradnici obrazovky na pixely
!!
	real(kind=DP),intent(in) :: NormalniY
	Integer :: Pixelu
	Pixelu = int(NormalniY*S_height)
end function Ny2Pix

!========================= ektere U-funkce a procedury ========================

function Ubod2Pbod(infVP,xy) result(pxpy)
!!
!! Prevod uzivatelskeho bodu na Pbod podle usrCA pro dany obj(=canvas)
!!
	type(ViewPortInfo),intent(in) :: infVP
	type(Ubod),intent(in) :: xy
	type(Pbod) :: pxpy

	type(UPinfo) :: infCA
	integer :: objw, objh

	infCA = infVP%canvasUPinfo
	objw = infCA%Pinfo%psirka
	objh = infCA%Pinfo%pvyska
	pxpy%px = objw*&
		((xy%x-infCA%Uinfo%uxmin)/(infCA%Uinfo%uxmax-infCA%Uinfo%uxmin))
	pxpy%py = objh*&
		(1-((xy%y-infCA%Uinfo%uymin)/(infCA%Uinfo%uymax-infCA%Uinfo%uymin)))
end function Ubod2Pbod

subroutine ULine(infVP,xy1,xy2,barva)
!!
!! Nakresli primku od Ubod1 do Ubod2 v rgb_barve
!!
	type(ViewPortInfo),intent(in) :: infVP
	type(Ubod),intent(in) :: xy1, xy2
	type(rgbcol),intent(in) :: barva
	type(Pbod) :: pxpy1, pxpy2
	type(UPinfo) :: infCA

	infCA = infVP%canvasUPinfo
	pxpy1 = Ubod2Pbod(infVP,xy1)
	pxpy2 = Ubod2Pbod(infVP,xy2)
	call SetFGcolor(infVP,barva)
	call j_drawline(infVP%canvas,pxpy1%px,pxpy1%py,pxpy2%px,pxpy2%py)
	Gcur = pxpy2
end subroutine ULine

Subroutine ULineTo(infVP,xy2,barva)
!!
!! nakresli caru z pozice dane Gcur do xy2 a nastavi
!! Gcur na novou hodnotu
!!
	type(ViewPortInfo),intent(in) :: infVP
	type(Ubod),intent(in) ::xy2
	type(rgbcol),intent(in) :: barva
	type(Pbod) :: pxpy2

	type(UPinfo) :: infCA

	infCA = infVP%canvasUPinfo
	pxpy2 = Ubod2Pbod(infVP,xy2)
	call SetFGcolor(infVP,barva)
	call j_drawline(infVP%canvas,Gcur%px,Gcur%py,pxpy2%px,pxpy2%py)
	Gcur = pxpy2
end subroutine ULineTo

subroutine UPolyLine(infVP,body,barva)
	type(ViewPortInfo),intent(in) :: infVP
	type(Ubod),dimension(:),intent(in) :: body
	type(rgbcol),intent(in) :: barva
	type(Pbod) :: p
	integer,dimension(size(body)) :: x, y
	integer :: i, Nbodu
	Nbodu = size(body)
	if (Nbodu<2) return
	do i=1,Nbodu
		P = Ubod2Pbod(infVP,body(i))
		x(i) = P%px
		y(i) = P%py
	end do
	call SetFGcolor(infVP,barva)
	call j_drawpolyline(infVP%canvas,Nbodu,x,y)
end subroutine UPolyLine

subroutine DrawCircle(infVP,stred,rx,barva)
	type(ViewPortInfo),intent(in) :: infVP
	type(Ubod),intent(in) :: stred
	real(kind=DP),intent(in) :: rx
	type(rgbcol),intent(in) :: barva
	type(Pbod) :: Pstred

	call SetFGcolor(infVP,barva)
	Pstred = Ubod2Pbod(infVP,stred)
	call j_drawoval(infVP%canvas,Pstred%px,Pstred%py,&
					int(rx*infVP%pix2ux),int(rx*infVP%pix2uy))
end subroutine DrawCircle

!========================== DefViewPort ======================================
!=============================================================================
!
subroutine DefViewPort(NposxFR,NposyFR,nadpisFR,&
						NsirkaPA,NvyskaPA,SetAspRatio,&
						UxMin,UxMax,UyMin,UyMax,&
					    canvasCol,PlotAreaCol,&
						VPinfo)
!!
!! Definuje ViewPort tvoreny frame a v nem canvas
!! Nsirka,Nvyska = sirka a vyska PlotArea v normalnich souradnicich
!! NposX, NposY = poloha leveho horniho rohu frame v norm. souradnicich
!! nadpis = text v zahlavi frame
!! canvasCol,PlotAreaCol = barvy pozadi canvas a PlotArea v rgb_barve
!! UxMin,UxMax,UyMin,UyMax = uzivatelske meze pro PlotArea (do UserPA)
!! odpovidajici uzivatelske meze pro canvas se ulozi do UserCA
!! frame, canvas = vracene handlery na frame a canvas
!!
	real(kind=DP),Intent(in) :: NposxFR,NposyFR,NsirkaPA,NvyskaPA
	character(len=*),intent(in) :: nadpisFR
	logical,intent(in) :: SetAspRatio
	type(rgbcol),intent(IN) :: canvasCol,PlotAreaCol
	real(kind=DP),intent(in) :: UxMin, UxMax, UyMin, UyMax
	type(ViewPortInfo),intent(out) :: VPinfo

	! Pro vypoctene rozmery canvas + frame a polohu frame
	integer :: frame,canvas
	type(UPinfo) :: infoCA , infoPA
	integer :: sirkaCanvas, vyskaCanvas
	integer,parameter :: proFRx=25, proFRy=50
	! pocet pixelu na uzivatelskou jednotku
	integer :: sirkaPA,vyskaPA
	real(kind=DP) :: usrx2pix,usry2pix
	REAL(kind=DP) :: oprNsirkaPA, oprNvyskaPA, AP

	oprNsirkaPA = NsirkaPA
	oprNvyskaPA = NvyskaPA
	if (SetAspRatio) then
		AP=(abs(UyMax-UyMin)/NvyskaPA)/(abs(UxMax-UxMin)/NsirkaPA)
		if (AP>1.0) oprNsirkaPA=NsirkaPA/AP
		IF (AP<1.0) oprNvyskaPA=NvyskaPA*AP
	end if
	sirkaPA = Nx2Pix(AspRatio*oprNsirkaPA)+1
	vyskaPA = Ny2Pix(oprNvyskaPA)+1
	sirkaCanvas = sirkaPA+PAleft+PAright
	vyskaCanvas = vyskaPA+PAtop+PAbottom

	! --- FRAME	---
	frame = j_frame(nadpisFR)
	call j_setpos(frame,Nx2Pix(NposxFR),Ny2Pix(NposyFR))
	call j_setsize(frame,sirkaCanvas+proFRx,vyskaCanvas+proFRy)
	call j_setnamedcolorbg(frame,J_WHITE)

	! --- CANVAS ---
	canvas = j_canvas(frame,sirkaCanvas,vyskaCanvas)
	call j_setcolorbg(canvas,canvasCol%r,canvasCol%g,canvasCol%b)
	call j_setpos(canvas,5,PAtop)
	call j_setflowlayout(frame,J_VERTICAL)

	! naplneni CA - hodnoty pro canvas
	usrx2pix = (Uxmax-Uxmin)/sirkaPA
	usry2pix = (Uymax-Uymin)/vyskaPA
	infoCA%Uinfo = userCO(UxMin-usrx2pix*PAleft,UxMax+usrx2pix*PAright,&
							UyMin-usry2pix*PAbottom,UyMax+usry2pix*PAtop)
	infoCA%Pinfo = objCO(0,0,sirkaCanvas,vyskaCanvas)

	! naplneni userPA hodnoty pro PlotArea
	infoPA%Uinfo = userCO(UxMin,UxMax,Uymin,UyMax)
	infoPA%Pinfo = objCO(PAleft,PAtop,sirkaPA,vyskaPA)

	! vybarveni PA
	call j_setcolor(canvas,PlotAreaCol%r,PlotAreaCol%g,PlotAreaCol%b)
	call j_fillrect(canvas,PAleft,PAtop,sirkaPA,vyskaPA)

	! Clipping na celou canvas
	call j_cliprect(canvas,0,0,sirkaCanvas,vyskaCanvas)

	!ulozi do globalnich privatnich promennych
	VPinfo%PlotAreaUPInfo = infoPA
	VPinfo%CanvasUPInfo = infoCA
	VPinfo%frame = frame
	VPinfo%canvas = canvas
	VPinfo%canvasRGBcolor = canvasCol
	VPinfo%PlotAreaRGBcolor = PlotAreaCol
	VPinfo%pix2ux = sirkaPA/abs(UxMax-UxMin)
	VPinfo%pix2uy = vyskaPA/abs(UyMax-UyMin)
	SVPinfo = VPinfo
	AinfVP = VPinfo
end subroutine DefViewPort

!============================== Clipping =====================================
subroutine ClipCanvas(infVP)
	type(ViewPortInfo),intent(in) :: infVP
	type(UPinfo) :: infCA
	infCA = infVP%canvasUPinfo
	call j_cliprect(infVP%canvas,infCA%Pinfo%polx,infCA%Pinfo%poly,&
					infCA%Pinfo%psirka,infCA%Pinfo%pvyska)
end subroutine ClipCanvas

subroutine ClipPlotArea(infVP)
	type(ViewPortInfo),intent(in) :: infVP
	type(UPinfo) :: infPA
	infPA = infVP%PlotAreaUPinfo
	call j_cliprect(infVP%canvas,infPA%Pinfo%polx,infPA%Pinfo%poly,&
					infPA%Pinfo%psirka,infPA%Pinfo%pvyska)
end subroutine ClipPlotArea

!================================= Osy =======================================

!--------------------------------- OsaX --------------------------------------
subroutine OsaX(infVP,UodX,UdoX,UpolY,Uvkrok,Mdilku,barva,gridX,gridCol)
	type(ViewPortInfo),intent(in) :: infVP
	real(kind=DP),intent(in) :: UpolY,UodX,UdoX,Uvkrok
	integer,intent(in) :: Mdilku	! pocet malych kroku ; carek je (Mdilku-1)
	type(rgbcol),intent(in) :: barva, gridCol
	logical,intent(in) :: gridX

	type(UPinfo) :: infPA
	real(kind=DP) :: odX,doX,polY,yPAmin,yPAmax,UMkrok,pom
	real(kind=DP) :: Ux1vd,zbytek,Ux
	type(Pbod) ::  Pxy
	integer :: i,delka,offX,offY
	character(len=20) :: popis

	infPA = infVP%PlotAreaUPinfo

		! Pripadna korekce nastavenych hodnot, osa jen do PA
	OdX = max(UodX,infPA%Uinfo%uxmin)
	DoX = min(UdoX,infPA%Uinfo%uxmax)
		! pro kresbu mrize
	yPAmin = infPA%Uinfo%uymin
	yPAmax = infPA%Uinfo%uymax
		! y poloha osy X musi byt v PA
	polY = min(max(yPAmin,UpolY),yPAmax)
	UMkrok = UVkrok/Mdilku   	! maly krok
	! Deleni a popis osy
	! najit polohu 1.velke delici carky Ux
	zbytek = modulo(OdX,Uvkrok)
	Ux1vd = OdX - zbytek
	IF (zbytek>0.0_DP) Ux1vd = Ux1vd + Uvkrok
	! Kresba deleni a popis
	Ux = Ux1vd
	call SetFGcolor(infVP,barva)
	i = 1
	Do
		pom = Ux-i*Umkrok
		if (pom<OdX) exit
		Pxy = Ubod2Pbod(infVP,Ubod(pom,poly))
		call j_drawline(infVP%canvas,Pxy%px,Pxy%py,Pxy%px,Pxy%py+SmallTick)
		i = i+1
	end do
	Do
		if (gridX .and. ((Ux>OdX) .or.(Ux<DoX))) &
			call Uline(infVP,Ubod(Ux,yPAmin),Ubod(Ux,yPAmax),gridCol)
		call SetFGcolor(infVP,barva)
		Pxy = Ubod2Pbod(infVP,Ubod(Ux,poly))
		call j_drawline(infVP%canvas,Pxy%px,Pxy%py,Pxy%px,Pxy%py+BigTick)
		! Popis hlavniho deleni
		call Real2Str(Ux,popis,delka)
		offY = j_getfontascent(infVP%canvas)
		offX = (j_getfontheight(infVP%canvas)*0.6*delka)/2
		call j_drawstring(infVP%canvas,Pxy%px-offX,Pxy%py+BigTick+offY+2,popis)
		if (Ux==DoX) Exit ! Velkou carku ano, male a grid uz ne
			! male dilky
		do i=1,Mdilku-1
			pom = Ux +i*UMkrok
			IF (pom>DoX) exit
			Pxy = Ubod2Pbod(infVP,Ubod(pom,poly))
			call j_drawline(infVP%canvas,Pxy%px,Pxy%py,Pxy%px,Pxy%py+SmallTick)
		end DO
		Ux = Ux+UVkrok
		if (Ux>DoX) exit
	end do
		! Kresba vlastni osy
	call Uline(infVP,Ubod(odX,polY),Ubod(doX,polY),barva)
end subroutine OsaX

!---------------------------- OsaY ------------------------------------------
subroutine OsaY(infVP,UodY,UdoY,UpolX,Uvkrok,Mdilku,barva,gridY,gridCol)
	type(ViewPortInfo),intent(in) :: infVP
	real(kind=DP),intent(in) :: UpolX,UodY,UdoY,Uvkrok
	integer,intent(in) :: Mdilku
	type(rgbcol),intent(in) :: barva, gridCol
	logical,intent(in) :: gridY

	type(UPinfo) :: infPA
	real(kind=DP) :: odY,doY,polX,xPAmin,xPAmax,UMkrok,pom
	real(kind=DP) :: Uy1vd,zbytek,Uy
	type(Pbod) ::  Pxy
	integer :: i,offX,offY,delka
	character(len=20) :: popis

	infPA = infVP%PlotAreaUPinfo

	! Pripadna korekce nastavenych hodnot osa jen do PA
	OdY = max(UodY,infPA%Uinfo%uymin)
	DoY = min(UdoY,infPA%Uinfo%uymax)
	xPAmin = infPA%Uinfo%uxmin
	xPAmax = infPA%Uinfo%uxmax
	polX = min(max(xPAmin,UpolX),xPAmax)
	UMkrok = UVkrok/Mdilku

	! Deleni a popis osy
	! najit polohu 1.velke delici carky Ux
	zbytek = modulo(OdY,Uvkrok)
	Uy1vd = OdY - zbytek
	IF (zbytek>0.0_DP) Uy1vd = Uy1vd + Uvkrok
	! Kresba
	!call Uline(infVP,Ubod(polX,OdY),Ubod(polX,DoY),barva)
	Uy = Uy1vd
	call SetFGcolor(infVP,barva)
	i = 1
	Do
		pom = Uy-i*Umkrok
		if (pom<OdY) exit
		Pxy = Ubod2Pbod(infVP,Ubod(polX,pom))
		call j_drawline(infVP%canvas,Pxy%px,Pxy%py,Pxy%px-SmallTick,Pxy%py)
		i = i+1
	end do
	Do
		if (gridY .and. ((Uy>OdY) .and.(Uy<DoY))) &
			call Uline(infVP,Ubod(xPAmin,Uy),Ubod(xPAmax,UY),gridCol)
		call SetFGcolor(infVP,barva)
		Pxy = Ubod2Pbod(infVP,Ubod(polX,Uy))
		call j_drawline(infVP%canvas,Pxy%px,Pxy%py,Pxy%px-BigTick,Pxy%py)
		call Real2Str(Uy,popis,delka)
		offY = j_getfontascent(infVP%canvas)/2-1
		offX = offY*delka+BigTick+10
		call j_drawstring(infVP%canvas,Pxy%px-offX,Pxy%py+offY,trim(popis))
		if (Uy==DoY) EXIT !Velkou carku ano, male uz ne
		do i=1,Mdilku-1
			pom = Uy+i*UMkrok
			if (pom>DoY) Exit
			Pxy = Ubod2Pbod(infVP,Ubod(polX,pom))
			call j_drawline(infVP%canvas,Pxy%px,Pxy%py,Pxy%px-SmallTick,Pxy%py)
		end DO
		Uy = Uy+UVkrok
		if (Uy>DoY) exit
	end do
	call Uline(infVP,Ubod(polX,OdY),Ubod(polX,DoY),barva)
end subroutine OsaY

subroutine PlotLabels(infVP,xlabel,ylabel,nadpis,barva)
	type(ViewPortInfo),intent(in) :: infVP
	character(len=*),intent(in) :: xlabel,ylabel,nadpis
	type(rgbcol),intent(in) :: barva
	integer :: strlen,xpos,ypos,fontascent
	type(objCO) :: PAinf

	PAinf = infVP%PlotAreaUPInfo%Pinfo
	fontascent = j_getfontascent(infVP%canvas)
	call SetFGcolor(infVP,barva)
	! xlabel
	strlen = len(xlabel)
	xpos = PAinf%polx + (PAinf%psirka - strlen*0.5*fontascent)/2.0
	ypos = PAinf%poly+PAinf%pvyska+BigTick+2*fontascent+2
	call j_drawstring(infVP%canvas,xpos,ypos,xlabel)
	! y label
	strlen = len(ylabel)
	xpos = PAinf%polx - (strlen*fontascent)
	ypos = PAinf%poly+(PAinf%pvyska+j_getfontheight(infVP%canvas))/2.0
	call j_drawstring(infVP%canvas,xpos,ypos,ylabel)
	! nadpis
	strlen = len(nadpis)
	xpos = PAinf%polx + (PAinf%psirka - strlen*0.5*fontascent)/2.0
	ypos = PAinf%poly - 12
	call j_drawstring(infVP%canvas,xpos,ypos,nadpis)

end subroutine PlotLabels

!============================ Vystup textu ====================================

subroutine PisText(infVP,OdBodu,barva,text,velikost,jmenofontu,styl)
	type(ViewPortInfo),intent(in) :: infVP
	type(Pbod),intent(in) :: OdBodu
	type(rgbcol),intent(in) :: barva
	character(len=*),intent(in) :: text
	Integer,intent(in),Optional :: velikost
	Integer,intent(in),optional :: jmenofontu
	Integer,intent(in),optional :: styl

	Integer :: sJmenoFontu, sVelikost, sStyl,label
		! Moznosti
		! jmeno : J_COURIER, J_HELVETIA, J_TIMES, J_DIALOGIN, J_DIALOGOUT
		! styl  : J_PLAIN, J_BOLD, J_ITALIC

	sVelikost = 12
	if (present(velikost)) sVelikost=velikost
	call j_setfontsize(infVP%canvas,sVelikost)
	sJmenoFontu = J_HELVETIA
	if (present(jmenofontu)) sJmenoFontu=jmenofontu
	call j_setfontname(infVP%canvas,sJmenoFontu)
	sStyl = J_PLAIN
	if (present(styl)) sStyl=styl
	call j_setfontstyle(infVP%canvas,sStyl)
	call SetGcursor(OdBodu)
	call SetFGcolor(infVP,barva)
	call j_drawstring(infVP%canvas,OdBodu%px,OdBodu%py,text)
end subroutine PisText

!================== Pomocne procedury =========================================

subroutine Real2Str(cislo,cstr,delka,MezES)
	! prevod realneho cisla na retezec max delky <znaku>
	real(kind=DP),intent(in) :: cislo
	character(len=*),intent(out) :: cstr
	integer,intent(out) :: delka
	real(kind=DP),intent(in),optional :: MezES
	real(kind=DP) :: HrRad1, HrRad2
	character(len=10) :: mant,expo
	integer :: polE,polDT, pom,iexpo
	real(kind=DP) :: rpom
	character(len=80) :: pcstr,pfmt

	HrRad1 = 1.0e4
	HrRad2 = 1.0e-4
	if (present(MezES)) then
		HrRad1 = abs(MezES)
		HrRad2 = 1.0_DP/HrRad1
	end if

	if (abs(cislo)<(100*tiny(cislo))) then
		cstr = "0"
		delka = 1
		return
	end if

	write(unit=cstr,fmt="(ES20.2E3)")cislo
	cstr = adjustl(cstr) ! nevyznamne znaky pred cislem za cislo
	polE = index(cstr,"E") ! poloha E
	mant = cstr(:polE-1)
	expo = cstr(polE+1:len_trim(cstr))
	read(unit=expo,fmt="(i3)")iexpo

	if (abs(cislo)<=HrRad1.and.abs(cislo)>=HrRad2) then
		! ------------------ format F -------------------------------
		write(unit=cstr,fmt="(f15.6)") cislo
		cstr = adjustl(cstr)
		delka = len_trim(cstr)
		polDT = index(cstr,".")
		do		! Odstrani koncove nuly
			if (index(cstr(:delka),"0",.true.) /= delka) exit
			delka = delka - 1
		end do
		cstr = cstr(:delka)
	if (index(cstr,".",.true.)== delka) delka = delka-1
		cstr = cstr(:delka)

	else
		! ----------- semilogaritmicky tvar ------------------------
		! uprava exponentu
		pom = index(expo,"0")
		if (pom>0) then
			do
				pom = pom+1
				if (index(expo(pom:),"0") /= pom) exit
			end do
			expo = expo(pom+1:)
		end if
			! uprava mantisy
		pom = len_trim(mant)
		do
			if (index(mant(:pom),"0",.true.)/=pom) exit
			pom = pom-1
		end do
		if (index(mant(:pom),".",.true.)==pom) pom = pom-1
		if (cstr(polE+1:polE+1)=="-") expo = "-"//expo
		cstr = mant(:pom)//"e"//expo
		delka = len_trim(adjustl(cstr))
	end if

end subroutine Real2Str

!========================== PlotSymbol ========================================

subroutine PlotSymbol3(infVP,Upoloha,symbol,barva)
	! Nakresli nektery z definovanych symbolu v rastru 3x3
	type(ViewPortInfo),intent(in) :: infVP
	type(Ubod),intent(in) :: Upoloha
	type(Symbol3),intent(in) :: symbol
	type(rgbcol),intent(in) :: barva

	type(Pbod) :: Pxy
	integer :: i,px,py

	call SetFGcolor(infVP,barva)
	Pxy = Ubod2Pbod(infVP,Upoloha)
	px = Pxy%px-1
	py = Pxy%py-1
	do i=1,9
		if (symbol%pix(i) == 1_i1b) call j_drawpixel(infVP%canvas,px,py)
		px = px+1
		if (i==3 .or. i==6) px = px-3
		if (i==3 .or. i==6) py = py+1
	end do
end subroutine PlotSymbol3

subroutine PlotSymbol5(infVP,Upoloha,symbol,barva)
	! Nakresli nektery z definovanych symbolu v rastru 5x5
	type(ViewPortInfo),intent(in) :: infVP
	type(Ubod),intent(in) :: Upoloha
	type(Symbol5),intent(in) :: symbol
	type(rgbcol),intent(in) :: barva

	type(Pbod) :: Pxy
	integer :: i,px,py

	call SetFGcolor(infVP,barva)
	Pxy = Ubod2Pbod(infVP,Upoloha)
	px = Pxy%px-2
	py = Pxy%py-2
	do i=1,25
		if (symbol%pix(i) == 1_i1b) call j_drawpixel(infVP%canvas,px,py)
		px = px+1
		if (i==5 .or. i==10 .or. i==15 .or. i==20 ) px = px-5
		if (i==5 .or. i==10 .or. i==15 .or. i==20) py = py+1
	end do
end subroutine PlotSymbol5

!============================= PlotFunction ===================================

subroutine PlotFunction(infVP,funX,barva,OdX,DoX,krokX)
	! do nastaveneho prostredi (zadane infVP) nakresli funkci funX
	type(ViewPortInfo),intent(in) :: infVP
	interface
		function funX(x) result(y)
			use std_type
			real(kind=DP),intent(in) :: x
			!real(kind=DP),dimension(:),intent(in),optional :: param
			real(kind=DP) :: y
		end function funX
	end interface
	type(rgbcol),intent(in) :: barva
	real(kind=DP),intent(in),optional :: OdX,DoX,krokX

	real(kind=DP) :: xmin,xmax,x,dx
	xmin = infVP%PlotAreaUPInfo%Uinfo%uxmin
	xmax = infVP%PlotAreaUPInfo%Uinfo%uxmax
	if (present(OdX)) xmin = min(max(xmin,OdX),xmax)
	if (present(DoX)) xmax = max(min(xmax,DoX),xmin)
	dx = abs(xmax-xmin)/200
	if (present(krokX)) dx=krokX

	call USetGcursor(infVP,Ubod(xmin,funX(xmin)))
	x = xmin
	do
		x = x+dx
		if (x>xmax) exit
		call UlineTo(infVP,Ubod(x,funX(x)),barva)
	end do
end subroutine PlotFunction

!============ Procedury pro operatory +,- pro Pbod a Ubod =====================

function PbodPlus(Pbod1,Pbod2) result(Pbodsuma)
	type(Pbod),intent(in) :: Pbod1, Pbod2
	type(Pbod) :: Pbodsuma
	Pbodsuma%px = Pbod1%px + Pbod2%px
	Pbodsuma%py = Pbod1%py + Pbod2%py
end function PbodPlus

function PbodMinus(Pbod1,Pbod2) result(Pbodsuma)
	type(Pbod),intent(in) :: Pbod1, Pbod2
	type(Pbod) :: Pbodsuma
	Pbodsuma%px = Pbod1%px - Pbod2%px
	Pbodsuma%py = Pbod1%py - Pbod2%py
end function PbodMinus

function UbodPlus(Ubod1,Ubod2) result(Ubodsuma)
	type(Ubod),intent(in) :: Ubod1, Ubod2
	type(Ubod) :: Ubodsuma
	Ubodsuma%x = Ubod1%x + Ubod2%x
	Ubodsuma%y = Ubod1%y + Ubod2%y
end function UbodPlus

function UbodMinus(Ubod1,Ubod2) result(Ubodsuma)
	type(Ubod),intent(in) :: Ubod1, Ubod2
	type(Ubod) :: Ubodsuma
	Ubodsuma%x = Ubod1%x - Ubod2%x
	Ubodsuma%y = Ubod1%y - Ubod2%y
end function UbodMinus

!============================= StdMenu ========================================

subroutine AddStdMenu(infVP)
	! Doplni na frame menu s polozkami
	! Soubor/Exit
	! Tisk/Canvas
	! Graf/Ulozit ulozit graf jako BMP nebo PPM
	type(ViewPortInfo),intent(in) :: infVP

	menubar = j_menubar(infVP%frame)
	soubor  = j_menu(menubar,"Soubor")
	tisk = j_menu(menubar,"Tisk")
	graf = j_menu(menubar,"Graf")
	tiskcanvas = j_menuitem(tisk,"Canvas")
	konec	= j_menuitem(soubor,"Konec")
	bmp = j_menuitem(graf,"Ulozit graf jako BMP")
	ppm = j_menuitem(graf,"Ulozit graf jako PPM")
end subroutine AddStdMenu

subroutine StartStdMenu(infVP)
	! Aktivuje menu nastevene AddStdMenu
	! Ve smycce ceka na stisknuti prislusne polozky
	! vystoupi z ni po Soubor/Exit
	! Potom muze byt znovu volana
	type(ViewPortInfo),intent(in) :: infVP
	integer :: menuobj
	integer :: image

	DO
		menuobj = j_nextaction()
			! KONEC
		if ((menuobj==infVP%frame).or.(menuobj==konec)) exit
			! tisk canvas
		if (menuobj==tiskcanvas) call j_print(infVP%canvas)
			! ulozit canvas jako obrazek bmp, resp. ppm
		if ((menuobj==bmp).or.(menuobj==ppm)) then
				! prevod canvas na image
			image = j_getimage(infVP%canvas)
			!~ image = j_getscaledimage(infVP%canvas,&
			!~ infVP%canvasUPinfo%Pinfo%polx,infVP%canvasUPinfo%Pinfo%poly,&
			!~ infVP%canvasUPinfo%Pinfo%psirka,infVP%canvasUPinfo%Pinfo%pvyska,&
			!~ infVP%canvasUPinfo%Pinfo%psirka,infVP%canvasUPinfo%Pinfo%pvyska)
				! Vlastni ulozeni ve formatu bmp nebo ppm
			if (menuobj==bmp) then
				! jedna moznost zadani jmena (bez pripony bmp !)
				call j_filedialog(infVP%frame,"Uloz jako BMP/S",".",jmeno)
				if (len(jmeno)>0) imgl = j_saveimage(image,jmeno//".bmp",J_BMP)
			else
				! druha moznost zadani jmena souboru (bez pripony ppm !)
				call j_fileselect(infVP%frame,"Uloz jako PPM","*.ppm",jmeno)
				if (len(jmeno)>0) imgl = j_saveimage(image,jmeno//".ppm",J_PPM)
			end if
				! zprava, ze se ulozeni nepovedlo
			if (.not.imgl) &
			print *,"Obrazek nelze ulozit"
		end if
	end do
end subroutine StartStdMenu

!=============================== NastavStdGraf ================================
!
subroutine NastavStdGraf(infoVP,UodX,UdoX,UodY,UdoY,VPnadpis,&
						PlotOx,PlotOy,Velikost,KrokX, KrokY,DilkuX,DilkuY,&
						PopisX,PopisY,Nadpis,Grid)
	! Nastavi prostredi pro kresbu standardniho grafu
	! ihned po jejim provedeni je mozne v prostredi kreslit
	type(ViewPortInfo),intent(out) :: infoVP
	real(kind=DP),intent(in) :: UodX, UdoX, UodY, UdoY
	character(len=*),intent(in) :: VPnadpis
	logical,intent(in),optional :: PlotOx, PlotOy
	integer,intent(in),optional :: Velikost
	real(kind=DP),intent(in),optional :: KrokX, KrokY
	integer,intent(in),optional :: DilkuX, DilkuY
	character(len=*),intent(in),optional :: PopisX, PopisY, Nadpis
	logical,intent(in),optional :: Grid
	real(kind=DP) :: sKrokX, sKrokY
	integer :: sDilkuX, sDilkuY
	logical :: sPlotOx, sPlotOy
	integer :: sVelikost = 5
	character(len=80) :: sPopisX , sPopisY, sNadpis
	logical :: sGrid
	real(kind=DP) :: Nrozmer, Npos
	integer :: frame1,canvas1
	type(ViewPortInfo) :: infoVP1
	type(UPinfo) :: infoPA1, infoCA1

	sPlotOx = .false.
	if (present(PlotOx)) sPlotOx = PlotOx
	sPlotOy = .false.
	if (present(PlotOy))  sPlotOy = PlotOy

	if (present(Velikost)) then
		sVelikost = Velikost
		if (sVelikost < 2) sVelikost = 2
		if (sVelikost > 9) sVelikost = 9
	end if
	sPopisX = ""
	if (present(PopisX)) sPopisX = PopisX
	sPopisY = ""
	if (present(PopisY)) sPopisY = PopisY
	sNadpis = ""
	if (present(Nadpis)) sNadpis = Nadpis
	sGrid = .false.
	if (present(Grid)) sGrid = Grid

	Nrozmer = 0.1_DP*sVelikost
	Npos = (1.0_DP-Nrozmer)/2.0_DP

	call DefViewPort(Npos,Npos,VPnadpis,Nrozmer,Nrozmer,.false.,&
					 UodX,UdoX,UodY,UdoY,white,white,infoVP1)
	infoVP = infoVP1
	call AddStdMenu(infoVP1)
	frame1 =infoVP1%frame
	canvas1 = infoVP1%canvas

		! Kresba os X
	if (sPlotOx) then
		if (present(KrokX)) then
			sKrokX = KrokX
		else
			sKrokX = abs(UdoX-UodX)/10
		end if
		if (present(DilkuX)) then
			sDilkuX = DilkuX
		else
			sDilkuX = 10
		end if
		call OsaX(infoVP1,UodX,UdoX,UodY,sKrokX,sDilkuX,black,sGrid,gray90)
	end if
		! Kresba osy Y
	if (sPlotOy) then
		if (present(KrokY)) then
			sKrokY = KrokY
		else
			sKrokY = abs(UdoY-UodY)/10
		end if
		if (present(DilkuY)) then
			sDilkuY = DilkuY
		else
			sDilkuY = 10
		end if
		call OsaY(infoVP1,UodY,UdoY,UodX,sKrokY,sDilkuY,black,sGrid,gray90)
	end if

	call PlotLabels(infoVP1,trim(sPopisX),trim(sPopisY),trim(sNadpis),black)
	call j_show(frame1)

end subroutine NastavStdGraf

!============================  conrec (kresba isolinii) =======================

subroutine Conrec(infVP,x,y,d,z,barvy_z)
!!
!!  Procedura pro kresbu izolinii funkce z=f(x,y)
!!  Algoritmus:P.D.Bourke, Byte Magazin 1987
!!  Kresli do nastaveneho ViewPortu
!!  Vstup :
!!  infVP = informace o nastavenem ViewPortu
!!  x = pole hodnot x, dimension(ilb:iub)  - meze zjisti procedura
!  y = pole hodnot y, dimension(jlb:jub)  - meze zjisti procedura
!  d = pole funkcnich hodnot, dimension(ilb:iub,jlb:jub)
!      meze kontroluje procedura, jestlize neodpovidaji nasleduje RETURN
!      d(i,j) = f(x(i),y(j)), i=ilb,iub, j=jlb,jub
!  z = VZESTUPNE usporadane pole hodnot pro izolinie
!      predpoklada se deklarace z(nc), pocet izolinii nc zjisti procedura
!      pro nc=0 nasleduje RETURN
!  barvy_z = paleta 16 rgb barev, type(paleta) je definovany v modulu rgbcolor2
!            volitelny parametr, jestlize neni uveden, pouzije se black_p
!            (vsechny polozky black) definovana v rgbcolor2
!
!
! =============================================================================
	type(ViewPortInfo),intent(in) :: infVP
    real(kind=DP),dimension(:,:),intent(in) :: d      ! (ilb:iub,jlb:jub)
    real(kind=DP),dimension(:),intent(in) :: x, y     ! (ilb:iub),(jlb:jub)
    real(kind=DP),dimension(:),intent(in) :: z        ! (1:nc)
	type(paleta),intent(in),optional :: barvy_z

    integer :: ilb,iub,jlb,jub, nc
	type(paleta) :: bpal
	real(kind=DP),dimension(0:4) :: h, xh, yh
    integer,dimension(0:4) :: sh
	integer i,j,k,m,m1,m2,m3
	real(kind=DP) :: dmin,dmax,x1,x2,y1,y2
	integer,dimension(0:3),parameter :: im = (/0,1,1,0/)
	integer,dimension(0:3),parameter :: jm = (/0,0,1,1/)
    integer cas_key
    integer,dimension(0:2,0:2,0:2),parameter :: castab = &
                                          reshape((/0,0,9, 0,1,5, 7,4,8,  &
                                                    0,3,6, 2,3,2, 6,3,0,  &
                                                    8,4,7, 5,1,0, 9,0,0/),&
                                                  (/3,3,3/))
!  kontrolni vypis
! print "(3i3)",(((castab(k,i,j),j=0,2),i=0,2),k=0,2)
! read *

!	  Meze poli a testy
	ilb = lbound(x,1)
	iub = ubound(x,1)
	jlb = lbound(y,1)
	jub = ubound(y,1)
	if (lbound(d,1)/=ilb .or. ubound(d,1)/=iub .or. &
		lbound(d,2)/=jlb .or. ubound(d,2)/=jub) return
	nc = size(z)
	if (nc==0) return

	if (present(barvy_z)) then
		bpal = barvy_z
	else
		bpal = black_p
	end if
!
!     Scan the arrays, top down, left to right within rows
!
	do j=jub-1,jlb,-1
        do i=ilb,iub-1
            dmin = min(d(i,j),d(i,j+1),d(i+1,j),d(i+1,j+1))
            dmax = max(d(i,j),d(i,j+1),d(i+1,j),d(i+1,j+1))
            if ((dmax>=z(1)).and.(dmin<=z(nc))) then
               	do k=1,nc
                	if (z(k)>dmin .and. z(k)<=dmax) then
                     	do m=4,0,-1
							if (m>0) then
							   h(m)=d(i+im(m-1),j+jm(m-1))-z(k)
							   xh(m)=x(i+im(m-1))
							   yh(m)=y(j+jm(m-1))
							else
							   h(0) =(h(1)+h(2)+h(3)+h(4))/4.0
							   xh(0)=(x(i)+x(i+1))/2.0
							   yh(0)=(y(j)+y(j+1))/2.0
							end if
							if (h(m)>0.0) then
							   sh(m)=1
							elseif (h(m)<0.0) then
								sh(m)=-1
							else
							   	sh(m)=0
							end IF
	                   	end do  ! pro m
!
!     Note: at this stage the relative heights of the corners and the
!     centre are in the h array, and the corresponding coordinates are
!     in the xh and yh arrays. The centre of the box is indexed by 0
!     and the 4 corners by 1 to 4 as shown below.
!     Each triangle is then indexed by the parameter m, and the 3
!     vertices of each triangle are indexed by parameters m1,m2,and m3.
!     It is assumed that the centre of the box is always vertex 2 though
!     this is important only when all 3 vertices lie exactly on the same
!     contour level, in which case only the side of the box is drawn.
!
!           vertex 4 +-------------------+ vertex 3
!                    | \               / |
!                    |   \    m=3    /   |
!                    |     \       /     |
!                    |       \   /       |
!                    |  m=4    X   m=2   |       the centre is vertex 0
!                    |       /   \       |
!                    |     /       \     |
!                    |   /    m=1    \   |
!                    | /               \ |
!           vertex 1 +-------------------+ vertex 2
!
!                    Scan each triangle in the box
!
						do  m=1,4
							m1=m
							m2=0
							if (m/=4) then
							   m3=m+1
							else
							   m3=1
							endif
							cas_key = castab(sh(m1)+1,sh(m2)+1,sh(m3)+1)
							if (cas_key==0) cycle
							select case (cas_key)
		!     Case 1 - Line between vertices 1 and 2
								case (1)
									x1=xh(m1)
									y1=yh(m1)
									x2=xh(m2)
									y2=yh(m2)
		!     Case 2 - Line between vertices 2 and 3
								case (2)
									x1=xh(m2)
									y1=yh(m2)
									x2=xh(m3)
									y2=yh(m3)
		!     Case 3 - Line between vertices 3 and 1
								case (3)
									x1=xh(m3)
									y1=yh(m3)
									x2=xh(m1)
									y2=yh(m1)
		!     Case 4 - Line between vertex 1 and side 2-3
								case (4)
									x1=xh(m1)
									y1=yh(m1)
									x2=(h(m3)*xh(m2)-h(m2)*xh(m3))/(h(m3)-h(m2))
									y2=(h(m3)*yh(m2)-h(m2)*yh(m3))/(h(m3)-h(m2))
		!     Case 5 - Line between vertex 2 and side 3-1
								case (5)
									x1=xh(m2)
									y1=yh(m2)
									x2=(h(m1)*xh(m3)-h(m3)*xh(m1))/(h(m1)-h(m3))
									y2=(h(m1)*yh(m3)-h(m3)*yh(m1))/(h(m1)-h(m3))
		!     Case 6 - Line between vertex 3 and side 1-2
								case (6)
									x1=xh(m3)
									y1=yh(m3)
									x2=(h(m2)*xh(m1)-h(m1)*xh(m2))/(h(m2)-h(m1))
									y2=(h(m2)*yh(m1)-h(m1)*yh(m2))/(h(m2)-h(m1))
		!     Case 7 - Line between sides 1-2 and 2-3
								case (7)
									x1=(h(m2)*xh(m1)-h(m1)*xh(m2))/(h(m2)-h(m1))
									y1=(h(m2)*yh(m1)-h(m1)*yh(m2))/(h(m2)-h(m1))
									x2=(h(m3)*xh(m2)-h(m2)*xh(m3))/(h(m3)-h(m2))
									y2=(h(m3)*yh(m2)-h(m2)*yh(m3))/(h(m3)-h(m2))
		!     Case 8 - Line between sides 2-3 and 3-1
								case (8)
									x1=(h(m3)*xh(m2)-h(m2)*xh(m3))/(h(m3)-h(m2))
									y1=(h(m3)*yh(m2)-h(m2)*yh(m3))/(h(m3)-h(m2))
									x2=(h(m1)*xh(m3)-h(m3)*xh(m1))/(h(m1)-h(m3))
									y2=(h(m1)*yh(m3)-h(m3)*yh(m1))/(h(m1)-h(m3))
		!     Case 9 - Line between sides 3-1 and 1-2
								case (9)
									x1=(h(m1)*xh(m3)-h(m3)*xh(m1))/(h(m1)-h(m3))
									y1=(h(m1)*yh(m3)-h(m3)*yh(m1))/(h(m1)-h(m3))
									x2=(h(m2)*xh(m1)-h(m1)*xh(m2))/(h(m2)-h(m1))
									y2=(h(m2)*yh(m1)-h(m1)*yh(m2))/(h(m2)-h(m1))
							end select

							call Uline(infVP,Ubod(x1,y1),Ubod(x2,y2),bpal%bp(k))

						end do   ! m
					end if   ! z(k)>dmin .and. z(k)<=dmax
	          	end do  ! k
			end if    ! dmax>=z(1).and.dmin<=z(nc)
	  	end do  ! i
	end do  ! j

	return
end subroutine Conrec

!========================= Doplnky do ver. 2.4 ================================
!
!========================= Nastaveni frame ====================================
!
function NastavFrame(FRnobjCO,FRnadpis,FRbarvaBG) result(infFR)
	type(NobjCO),intent(in) :: FRnobjCO
	character(len=*),intent(in) :: FRnadpis
	type(rgbcol),intent(in) :: FRbarvaBG
	type(FrameInfo) :: infFR

	integer :: frame,Polx,Poly,Psirka,Pvyska

	frame = j_frame(FRnadpis)
	infFR%frame = frame
	infFR%NadpisFR = FRnadpis
	Psirka = Nx2Pix(FRnobjCO%Nsirka)
	Pvyska = Ny2Pix(FRnobjCO%Nvyska)
	call j_setsize(frame,Psirka,Pvyska)
	Polx = Nx2Pix(FRnobjCO%Npolx)
	Poly = Ny2Pix(FRnobjCO%Npoly)
	call j_setpos(frame,Polx,Poly)
	infFR%PmiryFR%polx = Polx
	infFR%PmiryFR%poly = Poly
	infFR%PmiryFR%psirka = Psirka
	infFR%PmiryFR%pvyska = Pvyska
	call j_setcolorbg(frame,FRbarvaBG%r,FRbarvaBG%g,FRbarvaBG%b)
	infFR%BGbarvaFR =FRbarvaBG
end function NastavFrame

!======================== Nastaveni canvas na frame ===========================
!
function NastavCanvas(frame,CNobjCO,CUmeze,CbarvaBG,CinfPA,PAbarva) result(infC)
	! umozni nastaveni vice canvas na jedno frame
	! poloha a velikost v normalnich souradnicich, kter0 se v tuto chvili
	! uz nevztahuji k cele obrazovce, ale k frame !!!
	integer,intent(in) :: frame
	type(NobjCO),intent(in) :: CNobjCO
	type(userCO),intent(in),optional :: CUmeze
	type(rgbcol),intent(in),optional :: CbarvaBG, PAbarva
	type(PlotAreaInfo),Intent(in),optional :: CinfPA
	type(CanvasInfo) :: infC

	integer :: canvas,PolxC,PolyC,PsirkaC,PvyskaC,PsirkaPA,PvyskaPA
	real(DP) :: pix2ux, pix2uy
	type(userCO) :: sCUmeze, sPAUmeze
	type(PlotAreaInfo) :: sCinfPA
	type(rgbcol) :: sCbarvaBG, sPAbarva

	sCbarvaBG = white
	if (present(CbarvaBG)) sCbarvaBG = CbarvaBG
	sPAbarva = sCbarvaBG
	if (present(PAbarva)) sPAbarva = PAbarva

	sCUmeze = userCO(0.0_DP,100.0_DP,0.0_DP,100.0_DP)
	if (present(CUmeze)) sCUmeze = CUmeze
	sPAUmeze = sCUmeze
		! Umeze PA se zatim berou jako Umeze C

	sCinfPA = PlotAreaInfo(0,0,0,0)
	PsirkaPA = PsirkaC
	PvyskaPA = PvyskaC
	if (present(CinfPA)) sCinfPA = CinfPA

	PsirkaC = Nx2Pix(CNobjCO%Nsirka)					! sirkaC v pixelech
	PvyskaC = Ny2Pix(CNobjCO%Nvyska)					! vyskaC v pixelech
	PsirkaPA = PsirkaC-sCinfPA%PAleft-sCinfPA%PAright+1	! sirkaPA v pixelech
	PvyskaPA = PvyskaC-sCinfPA%PAbottom-sCinfPA%PAtop+1	! vyskaPA v pixelech

	! Je-li pritomno CinfPA chapou se CUmeze jako mezePA a sCUmeze se opravi
	pix2ux = PsirkaPA/abs(sPAUmeze%uxmax-sPAUmeze%uxmin)
	pix2uy = PvyskaPA/abs(sPAUmeze%uymax-sPAUmeze%uymin)
	if (present(CinfPA)) then
		! puvodni meze zachovat pro PA
		infC%UmezePA%uxmin = sCUmeze%uxmin
		infC%UmezePA%uxmax = sCUmeze%uxmax
		infC%UmezePA%uymin = sCUmeze%uymin
		infC%UmezePA%uymax = sCUmeze%uymax
		! meze pro canvas opravit
		sCUmeze%uxmin = sCUmeze%uxmin-sCinfPA%PAleft/pix2ux
		sCUmeze%uxmax = sCUmeze%uxmax+sCinfPA%PAright/pix2ux
		sCUmeze%uymin = sCUmeze%uymin-sCinfPA%PAbottom/pix2uy
		sCUmeze%uymax = sCUmeze%uymax+sCinfPA%PAtop/pix2uy
	end if

	canvas = j_canvas(frame,PsirkaC,PvyskaC)
	infC%canvas = canvas
	PolxC = Nx2Pix(CNobjCO%Npolx)
	PolyC = Ny2Pix(CNobjCO%Npoly)
	call j_setpos(canvas,PolxC,PolyC)

	infC%PmiryC%polx = PolxC
	infC%PmiryC%poly = PolyC
	infC%PmiryC%psirka = PsirkaC
	infC%PmiryC%pvyska = PvyskaC

	infC%PmiryPA%polx = sCinfPA%PAleft
	infC%PmiryPA%poly = sCinfPA%PAtop
	infC%PmiryPA%psirka = PsirkaPA
	infC%PmiryPA%pvyska = PvyskaPA

	infC%UmezeC%uxmin = sCUmeze%uxmin
	infC%UmezeC%uxmax = sCUmeze%uxmax
	infC%UmezeC%uymin = sCUmeze%uymin
	infC%UmezeC%uymax = sCUmeze%uymax

	call j_setcolorbg(canvas,sCbarvaBG%r,sCbarvaBG%g,sCbarvaBG%b)
	infC%BGbarvaC = sCbarvaBG

	call j_setcolor(canvas,sPAbarva%r,sPAbarva%g,sPAbarva%b)
	infC%BGbarvaPA = sPAbarva
	if (sPAbarva%r/=sCbarvaBG%r .or. sPAbarva%g/=sCbarvaBG%g &
		.or. sPAbarva%b/=sCbarvaBG%b )  &
		call j_fillrect(canvas,sCinfPA%PAleft,sCinfPA%PAtop,PsirkaPA,PvyskaPA)

	infC%pix2ux = pix2ux
	infC%pix2uy = pix2uy

end function NastavCanvas

!========================= Sestaveni infVP ===================================
!
function SestavVPinfo(infFR,infC) result(infVP)
	type(FrameInfo),intent(in) :: infFR
	type(CanvasInfo),intent(in) :: infC
	type(ViewPortInfo) :: infVP

	type(UPinfo) :: UPinfoC, UPinfoPA

	infVP%frame = infFR%frame
	infVP%canvas = infC%canvas

	UPinfoC%Pinfo = infC%PmiryC
	UPinfoC%Uinfo = infC%UmezeC
	infVP%canvasUPinfo = UPinfoC

	UPinfoPA%Pinfo = infC%PmiryPA
	UPinfoPA%Uinfo = infC%UmezePA
	infVP%PlotAreaUPinfo = UPinfoPA

	infVP%canvasRGBcolor = infC%BGbarvaC
	infVP%PlotAreaRGBcolor = infC%BGbarvaPA

	infVP%pix2ux = infC%pix2ux
	infVP%pix2uy = infC%pix2uy

end function SestavVPinfo

end module JapiGraf

!#############################################################################
! ==================================== Info ==================================
! 23.5.2006
! Dodany procedury AddStdMenu, StartStdMenu, PlotStdGraf
! Provedena zamena vsech KIND=SP na KIND=DP :
! v DefViewPort pro NposxFR,NposyFR,NsirkaPA,NvyskaPA
! a v Nx2Pix a Ny2Pix
!
! 27.5.2006
! Uprava procedury Real2Str
! Dodan optional MezES, a uvnitr logical :: fmtF
!
! 29.5.2006
! Uprava OsaX, OsaY tak aby kreslil male dilky i pred prvnim velkym dilkem
!
! 30.5.2006
! PlotStdGraf zmenen na NastavStdGraf a doplneny dalsi OPTIONAL parametry
!
! 3.7.2006
! Pridano:
! a) procedurry conrec, PlotContours
! b) typ paleta barev jako pole
!
! 7.7.2006
! zmeny conrec :
! zmena mezi poli
! deklarace h,xh,yh; zruseny funkce, vzorce primo pro x1,y1,x2,z2
!
! 4.4.2007
! Doplnena TYPE(ViewPortInfo),PUBLIC :: AinfVP
! uchovava posledni nastaveni VPinfo v DefViewPort
!
! 31.7.2007
! Opravena funkce promenne SetAspRatio v procedure DefViewPort
!
! ver. 2.2
!==========
! 28.8.2007
! Zmena procedury NastavStdGraf (funkce OPTIONAL promennych)
! Zmeny procedury PlotFunction (funkce OPTIONAL promennych)
!
! ver. 2.3
!=========
! 6.9.2007
!- Uprava kresby mrize (aby se kreslila drive nez osa) v OsaX, OsaY
!- Rozsirena procedura AddStdMenu o polozku Graf umoznujici ulozit
!  canvas jako obrazek ve formatu bmp nebo ppm.
!- Zrusena procedura SetCanvasFont a doplnena procedura PisText
!
! ver. 2.4
!=========
! 7.9.2007
!- Zavedeny typy FrameInfo, CanvasInfo, PlotAreaInfo
!- Doplneny funkce NastavFrame, NastavCanvas
! 10.9.2007
!- Uprava a doplneni funkci NastavCanvas, SestavVPinfo
!