!! Erzeugt die Datei plot.dat mit vier
!! Polygonen, die das Haus des Nikolaus darstellen
!! (c) 6/97 sdteffen

program Nikolaus
 implicit none

  !! reale Punkte des Hauses
  integer, parameter :: nPunkte = 5
  real,parameter, dimension(nPunkte) :: rX = (/2., 2., 7.2, 10., 10./)
  real, parameter, dimension(nPunkte) :: rY = (/2, 6, 10, 6, 2/)
  
  !!Zeichenreihenfolge
  integer, parameter :: nZeichen = 9
  integer, parameter, dimension(nZeichen) :: iReihe = (/1, 2, 3, 4, 2, 5, 1, 4, 5/)
  
  !!Groesse Zeichenflaeche
  real, parameter :: rZeichenBreite = 0.36, rZeichenHoehe = 0.235

  !! Eckpunkte und Groesse Haus
  real :: rLinkeEcke, rUntereEcke, rHausBreite, rHausHoehe    

  !! Bildpunkte des Hauses
  real, dimension(nPunkte,2) :: rBXY

  !! Laufvariable
  integer :: i

  !! Groesse des Hauses ermitteln
  rLinkeEcke = minval(rX)
  rHausBreite = maxval(rX) - rLinkeEcke
  rUntereEcke = minval(rY)
  rHausHoehe = maxval(rY) - rUntereEcke
  
  !! plot.dat oeffnen
  open(1, file="plot.dat", position="REWIND")

  !!Translation  I. Quadrant
  do i = 1, nPunkte
    rBXY(i, 1) = .52 + (rX(i) - rLinkeEcke)*rZeichenBreite/rHausBreite
    rBXY(i, 2) = .395 + (rY(i) - rUntereEcke)*rZeichenHoehe/rHausHoehe
  end do
  call writePolygon()

  !!Translation  II. Quadrant
  do i = 1, nPunkte
    rBXY(i, 1) = .48 - (rX(i) - rLinkeEcke)*rZeichenBreite/rHausBreite
    rBXY(i, 2) = .395 + (rY(i) - rUntereEcke)*rZeichenHoehe/rHausHoehe
  end do
  call writePolygon()

  !!Translation  III. Quadrant
  do i = 1, nPunkte
    rBXY(i, 1) = .48 - (rX(i) - rLinkeEcke)*rZeichenBreite/rHausBreite
    rBXY(i, 2) = .355 - (rY(i) - rUntereEcke)*rZeichenHoehe/rHausHoehe
  end do
  call writePolygon()

  !!Translation  IV. Quadrant
  do i = 1, nPunkte
    rBXY(i, 1) = .52 + (rX(i) - rLinkeEcke)*rZeichenBreite/rHausBreite
    rBXY(i, 2) = .355 - (rY(i) - rUntereEcke)*rZeichenHoehe/rHausHoehe
  end do
  call writePolygon()

  !! EndeKennung fuer preview.exe
  write(1,*)'Ende'

  stop 'eat the rich'

  contains
    
    subroutine writePolygon()
      integer :: i
      write(1,*)'Polygon'
      write(1,"(I5,',')")nZeichen
      do i = 1, nZeichen
        write(1, "(E11.4,',',E11.4,',')")rBXY(iReihe(i),1),rBXY(iReihe(i),2)
      end do
      return
    end subroutine writePolygon
end program Nikolaus