!	PREDMET: Računalniško podprto konstruiranje

!	NASLOV NALOGE: 10.10 Meglenje slike

!	AVTOR: Tomaž Bučar

!	OPIS PROGRAMA: Program zamegli rastersko sivinsko sliko formata PGM, ki ima ASCII obliko
!	zapisa ali barvno sliko formata PPM, ki ima prav tako ASCII obliko zapisa. Program sliko
!	zamegli s povprečenjem sosednih točk, ki jim priredimo določene uteži.



	PARAMETER (n=3000000)
	INTEGER VT(n),VTM(3000,3000),IT(3000,3000),W,H,S
	CHARACTER TD*2,KOM,VFILE*20,IFILE*20,IZB1,IZB11,IZB21,IZB2*2,IZB3*2,IZB4,IZB5*2

	WRITE(*,*)	'	_________________________________________________________________'
	WRITE(*,*)	'                                                                        '
	WRITE(*,*)	'	  PROGRAM:	     Tblur                                       '
	WRITE(*,*)	'	  RAZLICICA:     1.0                                             '
	WRITE(*,*)	'	  AVTOR:         Tomaz Bucar                                     '
	WRITE(*,*)	'	  OPIS PROGRAMA: Program s povprecenjem sosednih tock zamegli    '
	WRITE(*,*)	'	                 rastersko barvno ali sivinsko sliko             '
	WRITE(*,*)	'	  OMEJITVE:      Najvecja velikost barvne slike je 1000000 tock  '
	WRITE(*,*)	'	                 Najvecja velikost sivinske slike je 3000000 tock'
	WRITE(*,*)	'	                                                                 '
	WRITE(*,*)	'	  Copyright 1999 by Tomaz Bucar			                 '
	WRITE(*,*)	'	_________________________________________________________________'
	WRITE(*,*)	'                                                                        '


110	WRITE(*,10) 'S pritiskom na tipko 1,2 ali 3 izberi eno od naslednjih moznosti:'
10	FORMAT(A68/)
	WRITE(*,*) '   1. Zameglitev sivinske slike formata *.PGM'
	WRITE(*,*) '   2. Zameglitev barvne slike formata *.PPM'
	WRITE(*,11) '   3. Izhod iz programa'
11	FORMAT(A24/)
	READ(*,*) IZB1

	IF ((IZB1/='1').AND.(IZB1/='2').AND.(IZB1/='3')) THEN
		WRITE(*,*) '  Izbrali ste napacno moznost!'
		GOTO 110
	END IF


	!Izhod iz programa
	IF (IZB1=='3') THEN
120		WRITE(*,25) 'Ali ste prepricani, da zelite koncati program? (da/ne)'
25		FORMAT (/A57/)
		READ(*,*) IZB2	
		IF ((IZB2/='da').AND.(IZB2/='ne')) THEN
			WRITE(*,*) '  Izbrali ste napacno moznost!'
			GOTO 120
		END IF
		
		IF (IZB2=='da') THEN
				GOTO 210	
		ELSE
				GOTO 110
		END IF
	END IF 


	!Zameglitev sivinske slike
	IF (IZB1=='1') THEN
130		WRITE (*,12) 'Napisi ime vhodne datoteke tipa *.pgm:'
12		FORMAT (/A41/)
		READ(*,*) VFILE
		OPEN(1,FILE=VFILE,STATUS='OLD',ERR=190)
		READ(1,*) TD,KOM
		
		IF ((TD=='P2').AND.(KOM=='#')) THEN
		READ (1,*) W,H,S
		ELSE
		WRITE(*,*) '  Napisali ste nepravilen tip datoteke!'
		GOTO 130
		END IF
		
		IF ((W*H)>3000000) THEN
		WRITE(*,23) 'Vhodna slika je vecja od 3000000 tock'
23		FORMAT (/A40/)
		GOTO 220
		END IF
		
		READ(1,*,END=140) (vt(k),k=1,n)
140		CONTINUE
		CLOSE (1)

230		WRITE(*,21) 'Sivinsko sliko lahko zameglimo:'
21		FORMAT (/A34/)
		WRITE(*,*) '   1. Blur (manjsi ucinek, filter 3 krat 3)' 
		WRITE(*,*) '   2. More blur (vecji ucinek, filter 5 krat 5)'
		WRITE(*,*) '   3. Gaussian blur (Gaussova krivulja, filter 5 krat 5)'
		READ(*,*) IZB11
	
		IF ((IZB11/='1').AND.(IZB11/='2').AND.(IZB11/='3')) THEN
			WRITE(*,*) '  Izbrali ste napacno moznost!'
			GOTO 230
		END IF


150		WRITE(*,*) 'Napisi ime izhodne datoteke tipa *.pgm:'
		READ(*,*) IFILE
		OPEN(2,FILE=IFILE,STATUS='NEW',ERR=200)
	
		DO j=1,W
			DO i=1,H
			VTM(i,j)=VT(j+(i-1)*W)
			END DO
		END DO

		IF (IZB11=='1') THEN	!Blur
			DO j=1,W
				DO i=1,H
				IT(i,j)=(1.0*VTM(i,j)+1.0*(VTM(i,j+1)+VTM(i,j-1)+VTM(i-1,j)+VTM(i+1,j))+1.0*(VTM(i-1,j-1)+VTM(i+1,j-1)+VTM(i-1,j+1)+VTM(i+1,j+1)))/9
				END DO
			END DO
		END IF

		IF (IZB11=='2') THEN	!More blur
			DO j=1,W
				DO i=1,H
				IT(i,j)=(1.0*VTM(i,j)+1.0*(VTM(i,j+1)+VTM(i,j-1)+VTM(i-1,j)+VTM(i+1,j))+1.0*(VTM(i-1,j-1)+VTM(i+1,j-1)+VTM(i-1,j+1)+VTM(i+1,j+1))+1.0*(VTM(i-2,j-2)+VTM(i-2,j+2)+VTM(i+2,j-2)+VTM(i+2,j+2))+1.0*(VTM(i-2,j)+VTM(i,j+2)+VTM(i,j-2)+VTM(i+2,j))+1.0*(VTM(i-2,j-1)+VTM(i-1,j-2)+VTM(i-2,j+1)+VTM(i-1,j+2)+VTM(i+1,j-2)+VTM(i+2,j-1)+VTM(i+2,j+1)+VTM(i+1,j+2)))/25
				END DO
			END DO
		END IF

		IF (IZB11=='3') THEN	!Gaussian blur
			DO j=1,W
				DO i=1,H
				IT(i,j)=(1.0*VTM(i,j)+0.5*(VTM(i,j+1)+VTM(i,j-1)+VTM(i-1,j)+VTM(i+1,j))+0.375*(VTM(i-1,j-1)+VTM(i+1,j-1)+VTM(i-1,j+1)+VTM(i+1,j+1))+0.175*(VTM(i-2,j-2)+VTM(i-2,j+2)+VTM(i+2,j-2)+VTM(i+2,j+2))+0.25*(VTM(i-2,j)+VTM(i,j+2)+VTM(i,j-2)+VTM(i+2,j))+0.2*(VTM(i-2,j-1)+VTM(i-1,j-2)+VTM(i-2,j+1)+VTM(i-1,j+2)+VTM(i+1,j-2)+VTM(i+2,j-1)+VTM(i+2,j+1)+VTM(i+1,j+2)))/7.8
				END DO
			END DO
		END IF


		WRITE(2,13) TD,'# Created by Tblur',W,H,S
13		FORMAT(A2/A18/I5,I4/I3)
		DO 	i=1,H
			WRITE(2,14) (IT(i,j),j=1,W)
		END DO

14		FORMAT (2000(I3,1X))
		CLOSE(2)	
	END IF
	

	! Zameglitev barvne slike
	IF (IZB1=='2') THEN
160		WRITE (*,15) 'Napisi ime vhodne datoteke tipa *.ppm:'
15		FORMAT (/A41/)
		READ(*,*) VFILE
		OPEN(1,FILE=VFILE,STATUS='OLD',ERR=190)
		READ(1,*) TD,KOM
		
		IF ((TD=='P3').AND.(KOM=='#')) THEN
		READ (1,*) W,H,S
		ELSE
		WRITE(*,*) 'Napisali ste nepravilen tip datoteke!'
		GOTO 160
		END IF
		
		IF ((W*H)>1000000) THEN
		WRITE(*,24) 'Vhodna slika je vecja od 1000000 tock'
24		FORMAT (/A40/)
		GOTO 220
		END IF
		
		READ(1,*,END=170) (vt(i),i=1,n)
170		CONTINUE
		CLOSE (1)

240		WRITE(*,22) 'Barvno sliko lahko zameglimo:'
22		FORMAT (/A32/)
		WRITE(*,*) '   1. Blur (manjsi ucinek, filter 3 krat 3)' 
		WRITE(*,*) '   2. More blur (vecji ucinek, filter 5 krat 5)'
		WRITE(*,*) '   3. Gaussian blur (Gaussova krivulja, filter 5 krat 5)'
		READ(*,*) IZB21
	
		IF ((IZB21/='1').AND.(IZB21/='2').AND.(IZB21/='3')) THEN
			WRITE(*,*) '  Izbrali ste napacno moznost!'
			GOTO 240
		END IF

180		WRITE(*,*) 'Napisi ime izhodne datoteke tipa *.ppm:'
		READ(*,*) IFILE
		OPEN(2,FILE=IFILE,STATUS='NEW',ERR=200)
	
		DO j=1,(3*W)
			DO i=1,H
			VTM(i,j)=VT(j+(i-1)*(3*W))
			END DO
		END DO
		
		IF (IZB21=='1') THEN	!Blur
			! povprečenje rdeče barve

			DO j=1,3*W,3
				DO i=1,H
				IT(i,j)=(VTM(i,j)+1.0*(VTM(i,j+3)+VTM(i,j-3)+VTM(i-1,j)+VTM(i+1,j))+1.0*(VTM(i-1,j-3)+VTM(i+1,j-3)+VTM(i-1,j+3)+VTM(i+1,j+3)))/9
				END DO
			END DO

			! povprečenje zelene barve

			DO j=2,3*W,3
				DO i=1,H
				IT(i,j)=(VTM(i,j)+1.0*(VTM(i,j+3)+VTM(i,j-3)+VTM(i-1,j)+VTM(i+1,j))+1.0*(VTM(i-1,j-3)+VTM(i+1,j-3)+VTM(i-1,j+3)+VTM(i+1,j+3)))/9
				END DO
			END DO

			! povprečenje modre barve

			DO j=3,3*W,3
				DO i=1,H
				IT(i,j)=(1.0*VTM(i,j)+0.5*(VTM(i,j+3)+VTM(i,j-3)+VTM(i-1,j)+VTM(i+1,j))+0.3*(VTM(i-1,j-3)+VTM(i+1,j-3)+VTM(i-1,j+3)+VTM(i+1,j+3)))/4.2
				END DO
			END DO
		END IF

		IF (IZB21=='2') THEN	!More blur
			! povprečenje rdeče barve

			DO j=1,3*W,3
				DO i=1,H
				IT(i,j)=(VTM(i,j)+1.0*(VTM(i,j+3)+VTM(i,j-3)+VTM(i-1,j)+VTM(i+1,j))+1.0*(VTM(i-1,j-3)+VTM(i+1,j-3)+VTM(i-1,j+3)+VTM(i+1,j+3))+1.0*(VTM(i-2,j-6)+VTM(i-2,j+6)+VTM(i+2,j-6)+VTM(i+2,j+6))+1.0*(VTM(i-2,j)+VTM(i,j+6)+VTM(i,j-6)+VTM(i+2,j))+1.0*(VTM(i-2,j-3)+VTM(i-1,j-6)+VTM(i-2,j+3)+VTM(i-1,j+6)+VTM(i+1,j-6)+VTM(i+2,j-3)+VTM(i+2,j+3)+VTM(i+1,j+6)))/25
				END DO
			END DO

			! povprečenje zelene barve

			DO j=2,3*W,3
				DO i=1,H
				IT(i,j)=(VTM(i,j)+1.0*(VTM(i,j+3)+VTM(i,j-3)+VTM(i-1,j)+VTM(i+1,j))+1.0*(VTM(i-1,j-3)+VTM(i+1,j-3)+VTM(i-1,j+3)+VTM(i+1,j+3))+1.0*(VTM(i-2,j-6)+VTM(i-2,j+6)+VTM(i+2,j-6)+VTM(i+2,j+6))+1.0*(VTM(i-2,j)+VTM(i,j+6)+VTM(i,j-6)+VTM(i+2,j))+1.0*(VTM(i-2,j-3)+VTM(i-1,j-6)+VTM(i-2,j+3)+VTM(i-1,j+6)+VTM(i+1,j-6)+VTM(i+2,j-3)+VTM(i+2,j+3)+VTM(i+1,j+6)))/25
				END DO
			END DO

			! povprečenje modre barve

			DO j=3,3*W,3
				DO i=1,H
				IT(i,j)=(VTM(i,j)+1.0*(VTM(i,j+3)+VTM(i,j-3)+VTM(i-1,j)+VTM(i+1,j))+1.0*(VTM(i-1,j-3)+VTM(i+1,j-3)+VTM(i-1,j+3)+VTM(i+1,j+3))+1.0*(VTM(i-2,j-6)+VTM(i-2,j+6)+VTM(i+2,j-6)+VTM(i+2,j+6))+1.0*(VTM(i-2,j)+VTM(i,j+6)+VTM(i,j-6)+VTM(i+2,j))+1.0*(VTM(i-2,j-3)+VTM(i-1,j-6)+VTM(i-2,j+3)+VTM(i-1,j+6)+VTM(i+1,j-6)+VTM(i+2,j-3)+VTM(i+2,j+3)+VTM(i+1,j+6)))/25
				END DO
			END DO
		END IF

		IF (IZB21=='3') THEN	!Gaussian blur
			! povprečenje rdeče barve

			DO j=1,3*W,3
				DO i=1,H
				IT(i,j)=(VTM(i,j)+0.5*(VTM(i,j+3)+VTM(i,j-3)+VTM(i-1,j)+VTM(i+1,j))+0.375*(VTM(i-1,j-3)+VTM(i+1,j-3)+VTM(i-1,j+3)+VTM(i+1,j+3))+0.175*(VTM(i-2,j-6)+VTM(i-2,j+6)+VTM(i+2,j-6)+VTM(i+2,j+6))+0.25*(VTM(i-2,j)+VTM(i,j+6)+VTM(i,j-6)+VTM(i+2,j))+0.2*(VTM(i-2,j-3)+VTM(i-1,j-6)+VTM(i-2,j+3)+VTM(i-1,j+6)+VTM(i+1,j-6)+VTM(i+2,j-3)+VTM(i+2,j+3)+VTM(i+1,j+6)))/7.8
				END DO
			END DO
		
			! povprečenje zelene barve

			DO j=2,3*W,3
				DO i=1,H
				IT(i,j)=(VTM(i,j)+0.5*(VTM(i,j+3)+VTM(i,j-3)+VTM(i-1,j)+VTM(i+1,j))+0.375*(VTM(i-1,j-3)+VTM(i+1,j-3)+VTM(i-1,j+3)+VTM(i+1,j+3))+0.175*(VTM(i-2,j-6)+VTM(i-2,j+6)+VTM(i+2,j-6)+VTM(i+2,j+6))+0.25*(VTM(i-2,j)+VTM(i,j+6)+VTM(i,j-6)+VTM(i+2,j))+0.2*(VTM(i-2,j-3)+VTM(i-1,j-6)+VTM(i-2,j+3)+VTM(i-1,j+6)+VTM(i+1,j-6)+VTM(i+2,j-3)+VTM(i+2,j+3)+VTM(i+1,j+6)))/7.8
				END DO
			END DO
			
			! povprečenje modre barve

			DO j=3,3*W,3
				DO i=1,H
				IT(i,j)=(VTM(i,j)+0.5*(VTM(i,j+3)+VTM(i,j-3)+VTM(i-1,j)+VTM(i+1,j))+0.375*(VTM(i-1,j-3)+VTM(i+1,j-3)+VTM(i-1,j+3)+VTM(i+1,j+3))+0.175*(VTM(i-2,j-6)+VTM(i-2,j+6)+VTM(i+2,j-6)+VTM(i+2,j+6))+0.25*(VTM(i-2,j)+VTM(i,j+6)+VTM(i,j-6)+VTM(i+2,j))+0.2*(VTM(i-2,j-3)+VTM(i-1,j-6)+VTM(i-2,j+3)+VTM(i-1,j+6)+VTM(i+1,j-6)+VTM(i+2,j-3)+VTM(i+2,j+3)+VTM(i+1,j+6)))/7.8
				END DO
			END DO
		END IF


		WRITE(2,16) TD,'# Created by Tblur',W,H,S
16		FORMAT(A2/A18/I5,I4/I3)
		DO 	i=1,H
			WRITE(2,17) (IT(i,j),j=1,3*W)
		END DO

17		FORMAT(2000(I3,1X))
		CLOSE(2)	
	END IF


	! dodatno besedilo
220	WRITE(*,20) 'Zelite pretvoriti se katero sliko (da/ne)?'
20	FORMAT (/A47/)
	READ(*,*) IZB5

	IF ((IZB5/='da').AND.(IZB5/='ne')) THEN
		WRITE(*,*) '  Izbrali ste napacno moznost!'
		GOTO 220
	END IF

	IF (IZB5=='da') THEN
		GOTO 110
	ELSE
		GOTO 120
	END IF


190	WRITE(*,18) 'Te datoteke ni v imeniku. Zelite pretvoriti katero drugo sliko? (da/ne)'
18	FORMAT (/A74/)
	READ(*,*) IZB3
	
	IF ((IZB3/='da').AND.(IZB3/='ne')) THEN
		WRITE(*,*) '  Izbrali ste napacno moznost!'
		GOTO 190
	END IF
	
	IF (IZB3=='da') THEN
		
		IF (IZB1=='1') THEN
		GOTO 130
		END IF

		IF (IZB1=='2') THEN
			GOTO 160
		END IF

		ELSE 
		GOTO 120
	END IF
	
	
200	WRITE(*,19) 'Ime te datoteke ze obstaja v imeniku!'
19	FORMAT(/A61/)
	WRITE(*,*) '   1. Ponoven vnos'
	WRITE(*,*) '   2. Zacetek'
	WRITE(*,*) '   3. Izhod'
	READ(*,*) IZB4
	
	IF ((IZB4/='1').AND.(IZB4/='2').AND.(IZB4/='3')) THEN
		WRITE(*,*) '  Izbrali ste napacno moznost!'
		GOTO 200
	END IF
	
	IF (IZB4=='1') THEN
		
		IF (IZB1=='1') THEN
			GOTO 150
		END IF

		IF (IZB1=='2') THEN
			GOTO 180
		END IF

	ELSE IF	(IZB4=='2')	THEN
		GOTO 110

	ELSE 
		GOTO 120
	
	END IF



		
210	STOP '  ________________________________Lep pozdrav!________________________________'

	end