!	RPK

!	4.16 RAZTROS ČRNOBELIH ODTENKOV

!	Avtor: Mitja Laharnar 3.l.-KGS

!	Program pretvori (filtrira) barvno sliko formata PPM, ki ima ASCII obliko ali sivinsko sliko 
!	formata PGM, ki ima ASCII obliko po metodi Error diffusion z uporabo algoritma Floyd and Steinberg.
!	Program barvni sliki zmanjša število barv na 2, 5, 8, 27 ali 64 barv, sivinsko sliko pa pretvori
!   v črnobelo (dve barvi). 

	
	CHARACTER G1*2, G2, G5*3, ODG*2, ODG1*2, ODG2*2, INDAT*40, OUTDAT*40,IZH*3,IZH1*3,IZH2*2
	PARAMETER (n=3310000)
	INTEGER*2 IN(n), OUT(n), ERR, ERR1, ERR2, ERR3, G3, G4
	
	WRITE (*,*)	'											                                '
	WRITE (*,*)	'    ***********************************************************************'
	WRITE (*,*)	'    *  Program:  Lahi Converter                                           *'
	WRITE (*,*)	'    *  Verzija:  1.0                                                      *'
	WRITE (*,*)	'    *  Avtor:    Mitja Laharnar                                           *'
	WRITE (*,*)	'    *  Opis:     Program zmanjsa stevilo barv vhodne slike po metodi      *'
	WRITE (*,*)	'    *            Error diffusion z uporabo algoritma Floyd and Steinberg. *'
	WRITE (*,*)	'    *  Omejitve: Max. velikost barvne slike je 1210x908 pikslov.          *'
	WRITE (*,*)	'    *            Max. velikost sivinske slike je 2100x1575 pikslov.       *'
	WRITE (*,*)	'    *            Min. kolicina pomnilnika za pretvorbo ene slike je 16 MB.*'
	WRITE (*,*)	'    *                                                                     *'
	WRITE (*,*)	'    *  Copyright (c) 1998 by Mitja Laharnar                               *'
	WRITE (*,*)	'    ***********************************************************************'


100	WRITE (*,10) 'IZBERI ENO OD NASLEDNJIH MOZNOSTI (Pritisni tipko 1,2 ali 3):'
10	FORMAT (//A63/)
	WRITE (*,*) '     1. Pretvorba BARVNE slike formata PPM (oblike ASCII)'
	WRITE (*,*) '     2. Pretvorba SIVINSKE slike formata PGM (oblike ASCII) v crnobelo sliko' 
	WRITE (*,20) '     3. IZHOD IZ PROGRAMA' 
20	FORMAT (A26/)	
	READ (*,*) ODG
	
	IF ((ODG/='1').AND.(ODG/='2').AND.(ODG/='3')) THEN
	WRITE (*,*) 'Napacna izbira !'
	GOTO 100
	END IF 

	

	IF (ODG=='1') THEN

180	WRITE (*,13) ' Barvno sliko lahko pretvorim v naslednje stevilo barv: [0-vrnitev]'
13	FORMAT (/A68/)
	WRITE (*,*)	'     1. 2 barvi (black, white)'
	WRITE (*,*) '     2. 5 barv (black, white, cyan, magenta, yellow)'
	WRITE (*,*) '     3. 8 barv (black, white, cyan, magenta, yellow, red, green, blue)'
	WRITE (*,*) '     4. 27 barv'
	WRITE (*,14) '     5. 64 barv'
14	FORMAT (A16/)
	READ (*,*) ODG1


	IF ((ODG1/='1').AND.(ODG1/='2').AND.(ODG1/='3').AND.(ODG1/='4').AND.(ODG1/='5').AND.(ODG1/='0')) THEN
	WRITE (*,*) 'Napacna izbira !'
	GOTO 180
	END IF 

	IF (ODG1=='0') THEN
	GOTO 100
	END IF


	IF (ODG1=='2') THEN
190	WRITE (*,15) ' Slika s petimi barvami je lahko: [0-vrnitev, 9-zacetek]'
15  FORMAT (/A57/)
	WRITE(*,*) '   1. Bolj zrnata'
	WRITE(*,*) '   2. Manj zrnata'
	READ(*,*) ODG2

	IF ((ODG2/='1').AND.(ODG2/='2').AND.(ODG2/='0').AND.(ODG2/='9')) THEN
	WRITE (*,*) 'Napacna izbira !'
	GOTO 190
	END IF
	
	IF (ODG2=='0') THEN
	GOTO 180
	END IF

	IF (ODG2=='9') THEN
	GOTO 100
	END IF


	END IF


110	WRITE (*,*) 'Podaj ime VHODNE datoteke (napisi tudi koncnico .ppm): [0-vrnitev, 9-zacetek]'
	READ (*,*) INDAT
	
	IF ((INDAT=='0').AND.(ODG1=='2')) THEN
	GOTO 190
	END IF

	IF ((INDAT=='0').AND.(ODG1/='2')) THEN
	GOTO 180
	END IF

	IF (INDAT=='9') THEN
	GOTO 100
	END IF


	OPEN (1,FILE=INDAT,STATUS='old',ERR=300)

! Branje podatkov iz glave vhodne datoteke

	READ (1,*) G1,G2				
	
	IF (G2=='#') THEN
	READ (1,*) G3,G4,G5				
	END IF

	IF ((G2/='#').OR.(G3==0).OR.(G4==0).OR.(G5=='0')) THEN
	WRITE (*,11) 'Datoteka mora v drugi vrstici vsebovati enovrsticni komentar (# ......)!'
11	FORMAT (/A73)
	GOTO 200		
	END IF


	IF ((G3*G4*3)>3296040) THEN
	WRITE (*,30) 'Vhodna slika je vecja od 1210x908 pikslov. Zato te slike ne mores pretvoriti!' 
30	FORMAT (/A78)	
	GOTO 200
	END IF

	WRITE (*,40) 'Podaj ime IZHODNE datoteke (napisi tudi koncnico .ppm): [0-vrnitev, 9-zacetek]'
40	FORMAT (/A79)
	READ (*,*) OUTDAT

	IF (OUTDAT=='0') THEN
	GOTO 110
	END IF

	IF (OUTDAT=='9') THEN
	GOTO 100
	END IF


	END IF



	IF (ODG=='2') THEN

120	WRITE (*,*) 'Podaj ime VHODNE datoteke (napisi tudi koncnico .pgm): [0-vrnitev]'
	READ (*,*) INDAT

	IF (INDAT=='0') THEN
	GOTO 100
	END IF

	
	OPEN (1,FILE=INDAT,STATUS='old',ERR=300)

! Branje podatkov iz glave vhodne datoteke

	READ (1,*) G1,G2				
	
	IF (G2=='#') THEN
	READ (1,*) G3,G4,G5				
	END IF

	IF ((G2/='#').OR.(G3==0).OR.(G4==0).OR.(G5=='0')) THEN
	WRITE (*,12) 'Datoteka mora v drugi vrstici vsebovati enovrsticni komentar (# ......)!'
12	FORMAT (/A73)
	GOTO 200		
	END IF
	
	
	IF ((G3*G4)>3307500) THEN
	WRITE (*,50) 'Vhodna slika je vecja od 2100x1575 pikslov. Zato te slike ne mores pretvoriti!' 
50	FORMAT (/A79)	
	GOTO 200
	END IF

	WRITE (*,60) 'Podaj ime IZHODNE datoteke (napisi tudi koncnico .pgm): [0-vrnitev, 9-zacetek]'
60	FORMAT (/A79)
	READ (*,*) OUTDAT

	IF (OUTDAT=='0') THEN
	GOTO 120
	END IF

	IF (OUTDAT=='9') THEN
	GOTO 100
	END IF


	END IF



	IF (ODG=='3') THEN
	GOTO 500
	END IF


!	Zanka za branje podatkov iz številčnega dela vhodne datoteke

	READ (1,*,END=70) (IN(i), i=1,n)		     
70	CONTINUE

	CLOSE (1)


	OPEN (2,FILE=OUTDAT,STATUS='new',ERR=400)


!	Zanka za metodo Error diffusion po Floyd and Steinberg algoritmu



	IF (ODG1=='1') THEN			! Zanka za pretvorbo barvne slike na 2 barvi
	
	DO j=0,i-1,3


	IF ((IN(j+1)+IN(j+2)+IN(j+3))<=382) THEN					
	OUT(j+1)=0
	OUT(j+2)=0
	OUT(j+3)=0 							
	END IF


	IF ((IN(j+1)+IN(j+2)+IN(j+3))>382) THEN					
	OUT(j+1)=255
	OUT(j+2)=255
	OUT(j+3)=255 							
	END IF

	
	ERR1=IN(j+1)-OUT(j+1)			!	Določitev napake (error) za R, G in B posebaj
	ERR2=IN(j+2)-OUT(j+2)
	ERR3=IN(j+3)-OUT(j+3)

	IN(j+4)=IN(j+4)+(7./16.)*ERR1					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+4)=IN(j+(3*G3)+4)+(1./16.)*ERR1		! za barvno sliko in sicer
	IN(j+(3*G3)+1)=IN(j+(3*G3)+1)+(5./16.)*ERR1		! samo za RED
	IN(j+(3*G3)-2)=IN(j+(3*G3)-2)+(3./16.)*ERR1		!

	IN(j+5)=IN(j+5)+(7./16.)*ERR2					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+5)=IN(j+(3*G3)+5)+(1./16.)*ERR2		! za barvno sliko in sicer
	IN(j+(3*G3)+2)=IN(j+(3*G3)+2)+(5./16.)*ERR2		! samo za GREEN	
	IN(j+(3*G3)-1)=IN(j+(3*G3)-1)+(3./16.)*ERR2		!

	IN(j+6)=IN(j+6)+(7./16.)*ERR3					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+6)=IN(j+(3*G3)+6)+(1./16.)*ERR3		! za barvno sliko in sicer
	IN(j+(3*G3)+3)=IN(j+(3*G3)+3)+(5./16.)*ERR3		! samo za BLUE	
	IN(j+(3*G3))=IN(j+(3*G3))+(3./16.)*ERR3			!


	END DO
	END IF





	IF (ODG2=='1') THEN			 ! Zanka za pretvorbo barvne slike na 5 barv, slika je bolj zrnata
	
	DO j=0,i-1,3

	IF ((IN(j+1)<=127).AND.(IN(j+2)<=127).AND.(IN(j+3)<=127)) THEN					
	OUT(j+1)=0
	OUT(j+2)=0
	OUT(j+3)=0 							
	END IF

	IF ((IN(j+1)>127).AND.(IN(j+2)>127).AND.(IN(j+3)>127)) THEN					
	OUT(j+1)=255
	OUT(j+2)=255
	OUT(j+3)=255 							
	END IF

	IF ((IN(j+1)<=127).AND.(IN(j+2)>127).AND.(IN(j+3)>127)) THEN					
	OUT(j+1)=0
	OUT(j+2)=255
	OUT(j+3)=255 							
	END IF

	IF ((IN(j+1)>127).AND.(IN(j+2)<=127).AND.(IN(j+3)>127)) THEN					
	OUT(j+1)=255
	OUT(j+2)=0
	OUT(j+3)=255 							
	END IF

	IF ((IN(j+1)>127).AND.(IN(j+2)>127).AND.(IN(j+3)<=127)) THEN					
	OUT(j+1)=255
	OUT(j+2)=255
	OUT(j+3)=0 							
	END IF



    IF ((IN(j+1)<=127).AND.(IN(j+2)>127).AND.(IN(j+3)<=127)) THEN		! zelena			
	OUT(j+1)=255														! v rumeno
	OUT(j+2)=255
	OUT(j+3)=0							
	END IF


	IF ((IN(j+1)>127).AND.(IN(j+2)<=127).AND.(IN(j+3)<=127)) THEN		! rdeča			
	OUT(j+1)=255														! v magento 
	OUT(j+2)=0
	OUT(j+3)=255 							
	END IF


	IF ((IN(j+1)<=127).AND.(IN(j+2)<=127).AND.(IN(j+3)>127)) THEN		! modra			
	OUT(j+1)=0														    ! v cyan
	OUT(j+2)=255															
	OUT(j+3)=255 							
	END IF


	
	ERR1=IN(j+1)-OUT(j+1)			!	Določitev napake (error) za R, G in B posebaj
	ERR2=IN(j+2)-OUT(j+2)
	ERR3=IN(j+3)-OUT(j+3)

	IN(j+4)=IN(j+4)+(7./16.)*ERR1					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+4)=IN(j+(3*G3)+4)+(1./16.)*ERR1		! za barvno sliko in sicer
	IN(j+(3*G3)+1)=IN(j+(3*G3)+1)+(5./16.)*ERR1		! samo za RED
	IN(j+(3*G3)-2)=IN(j+(3*G3)-2)+(3./16.)*ERR1		!

	IN(j+5)=IN(j+5)+(7./16.)*ERR2					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+5)=IN(j+(3*G3)+5)+(1./16.)*ERR2		! za barvno sliko in sicer
	IN(j+(3*G3)+2)=IN(j+(3*G3)+2)+(5./16.)*ERR2		! samo za GREEN	
	IN(j+(3*G3)-1)=IN(j+(3*G3)-1)+(3./16.)*ERR2		!

	IN(j+6)=IN(j+6)+(7./16.)*ERR3					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+6)=IN(j+(3*G3)+6)+(1./16.)*ERR3		! za barvno sliko in sicer
	IN(j+(3*G3)+3)=IN(j+(3*G3)+3)+(5./16.)*ERR3		! samo za BLUE	
	IN(j+(3*G3))=IN(j+(3*G3))+(3./16.)*ERR3			!


	END DO
	END IF





	IF (ODG2=='2') THEN			 ! Zanka za pretvorbo barvne slike na 5 barv, slika je manj zrnata
	
	DO j=0,i-1,3

	IF ((IN(j+1)<=127).AND.(IN(j+2)<=127).AND.(IN(j+3)<=127)) THEN					
	OUT(j+1)=0
	OUT(j+2)=0
	OUT(j+3)=0 							
	END IF

	IF ((IN(j+1)>127).AND.(IN(j+2)>127).AND.(IN(j+3)>127)) THEN					
	OUT(j+1)=255
	OUT(j+2)=255
	OUT(j+3)=255 							
	END IF

	IF ((IN(j+1)<=127).AND.(IN(j+2)>127).AND.(IN(j+3)>127)) THEN					
	OUT(j+1)=0
	OUT(j+2)=255
	OUT(j+3)=255 							
	END IF

	IF ((IN(j+1)>127).AND.(IN(j+2)<=127).AND.(IN(j+3)>127)) THEN					
	OUT(j+1)=255
	OUT(j+2)=0
	OUT(j+3)=255 							
	END IF

	IF ((IN(j+1)>127).AND.(IN(j+2)>127).AND.(IN(j+3)<=127)) THEN					
	OUT(j+1)=255
	OUT(j+2)=255
	OUT(j+3)=0 							
	END IF



    IF ((IN(j+1)<=127).AND.(IN(j+2)>127).AND.(IN(j+3)<=127)) THEN		! zelena			
	OUT(j+1)=255														! v rumeno
	OUT(j+2)=255
	OUT(j+3)=0							
	END IF


	IF ((IN(j+1)>127).AND.(IN(j+2)<=127).AND.(IN(j+3)<=127)) THEN		! rdeča			
	OUT(j+1)=255														! v magento 
	OUT(j+2)=0
	OUT(j+3)=255 							
	END IF


	IF ((IN(j+1)<=127).AND.(IN(j+2)<=127).AND.(IN(j+3)>127)) THEN		! modra			
	OUT(j+1)=0														    ! v belo
	OUT(j+2)=0															
	OUT(j+3)=0 							
	END IF


	
	ERR1=IN(j+1)-OUT(j+1)			!	Določitev napake (error) za R, G in B posebaj
	ERR2=IN(j+2)-OUT(j+2)
	ERR3=IN(j+3)-OUT(j+3)

	IN(j+4)=IN(j+4)+(7./16.)*ERR1					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+4)=IN(j+(3*G3)+4)+(1./16.)*ERR1		! za barvno sliko in sicer
	IN(j+(3*G3)+1)=IN(j+(3*G3)+1)+(5./16.)*ERR1		! samo za RED
	IN(j+(3*G3)-2)=IN(j+(3*G3)-2)+(3./16.)*ERR1		!

	IN(j+5)=IN(j+5)+(7./16.)*ERR2					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+5)=IN(j+(3*G3)+5)+(1./16.)*ERR2		! za barvno sliko in sicer
	IN(j+(3*G3)+2)=IN(j+(3*G3)+2)+(5./16.)*ERR2		! samo za GREEN	
	IN(j+(3*G3)-1)=IN(j+(3*G3)-1)+(3./16.)*ERR2		!

	IN(j+6)=IN(j+6)+(7./16.)*ERR3					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+6)=IN(j+(3*G3)+6)+(1./16.)*ERR3		! za barvno sliko in sicer
	IN(j+(3*G3)+3)=IN(j+(3*G3)+3)+(5./16.)*ERR3		! samo za BLUE	
	IN(j+(3*G3))=IN(j+(3*G3))+(3./16.)*ERR3			!


	END DO
	END IF





	IF (ODG1=='3') THEN		 ! Zanka za pretvorbo barvne slike na 8 barv
	
	DO j=1,i-1

	IF (IN(j)<=127) THEN					
	OUT(j)=0 							
	END IF

	IF (IN(j)>127) THEN
	OUT(j)=255
	END IF

	
	ERR=IN(j)-OUT(j)			!	Določitev napake (error)
	
	IN(j+3)=IN(j+3)+(7./16.)*ERR					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+3)=IN(j+(3*G3)+3)+(1./16.)*ERR		! za barvno sliko, ki ima v enem
	IN(j+(3*G3))=IN(j+(3*G3))+(5./16.)*ERR			! pikslu še tri številke (RGB).
	IN(j+(3*G3)-3)=IN(j+(3*G3)-3)+(3./16.)*ERR		!

	END DO
	END IF




	IF (ODG1=='4') THEN		  ! Zanka za pretvorbo barvne slike na 27 barv
	
	DO j=1,i-1

	IF (IN(j)<=85) THEN					
	OUT(j)=0 							
	END IF

	IF ((IN(j)>85).AND.(IN(j)<=170)) THEN					
	OUT(j)=127 							
	END IF

	IF (IN(j)>170) THEN
	OUT(j)=255
	END IF

	
	ERR=IN(j)-OUT(j)			!	Določitev napake (error)
	
	IN(j+3)=IN(j+3)+(7./16.)*ERR					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+3)=IN(j+(3*G3)+3)+(1./16.)*ERR		! za barvno sliko, ki ima v enem
	IN(j+(3*G3))=IN(j+(3*G3))+(5./16.)*ERR			! pikslu še tri številke (RGB).
	IN(j+(3*G3)-3)=IN(j+(3*G3)-3)+(3./16.)*ERR		!

	END DO
	END IF




	IF (ODG1=='5') THEN		  ! Zanka za pretvorbo barvne slike na 64 barv
	
	DO j=1,i-1

	IF (IN(j)<=64) THEN					
	OUT(j)=0 							
	END IF

	IF ((IN(j)>64).AND.(IN(j)<=127)) THEN					
	OUT(j)=96 							
	END IF

	IF ((IN(j)>127).AND.(IN(j)<=191)) THEN					
	OUT(j)=159 							
	END IF

	IF (IN(j)>191) THEN
	OUT(j)=255
	END IF

	
	ERR=IN(j)-OUT(j)			!	Določitev napake (error)
	
	IN(j+3)=IN(j+3)+(7./16.)*ERR					! Floyd and Steinberg algoritem
	IN(j+(3*G3)+3)=IN(j+(3*G3)+3)+(1./16.)*ERR		! za barvno sliko, ki ima v enem
	IN(j+(3*G3))=IN(j+(3*G3))+(5./16.)*ERR			! pikslu še tri številke (RGB).
	IN(j+(3*G3)-3)=IN(j+(3*G3)-3)+(3./16.)*ERR		!

	END DO
	END IF






	IF (ODG=='2') THEN	    ! Zanka za pretvorbo sivinske slike v črnobelo sliko

	DO j=1,i-1

	IF (IN(j)<=127) THEN					
	OUT(j)=0 							
	END IF

	IF (IN(j)>127) THEN
	OUT(j)=255
	END IF

	
	ERR=IN(j)-OUT(j)			!	Določitev napake (error)
	
	IN(j+1)=IN(j+1)+(7./16.)*ERR			! Floyd and Steinberg algoritem
	IN(j+G3+1)=IN(j+G3+1)+(1./16.)*ERR		! za sivinsko sliko, ki ima za
	IN(j+G3)=IN(j+G3)+(5./16.)*ERR			! en piksel samo eno številko.
	IN(j+G3-1)=IN(j+G3-1)+(3./16.)*ERR		!

	END DO
	END IF
	
	
!	Zanka za zapis podatkov

150	WRITE(2,80) G1,'# Created by Lahi Converter',G3,G4,G5
80	FORMAT (A2/A27/I6,I5/A3)

	WRITE (2,*) (OUT(j), j=1,i-1)

	CLOSE (2)


!   Ostalo

200	WRITE (*,90) 'Ali zelis pretvoriti se kaksno drugo sliko (D/N)?'
90	FORMAT (/A50)
	WRITE (*,*) ' !! OPOZORILO !!: Ce imate malo pomnilnika raje pritisnite Ne !!'
	READ (*,*) IZH
	
	IF ((IZH/='da').AND.(IZH/='ne').AND.(IZH/='d').AND.(IZH/='n')) THEN
	WRITE (*,*) 'Napacen odgovor !'
	GOTO 200
	END IF 

	IF ((IZH=='da').OR.(IZH=='d')) THEN
	GOTO 100
	END IF
					
	IF ((IZH=='ne').OR.(IZH=='n')) STOP '    ****************************   NASVIDENJE   ***************************'


300	WRITE (*,91) 'Te datoteke ni v tem imeniku! Ali zelis pretvoriti katero drugo sliko (D/N)?'
91	FORMAT (/A77)
	WRITE (*,*) '[9-zacetek]'
	READ (*,*) IZH1
	
	IF ((IZH1/='da').AND.(IZH1/='ne').AND.(IZH1/='d').AND.(IZH1/='n').AND.(IZH1/='9')) THEN
	WRITE (*,*) 'Napacen odgovor !'
	GOTO 300
	END IF 

	IF ((IZH1=='da').OR.(IZH1=='d')) THEN

	IF (ODG=='1') THEN
	GOTO 110
	END IF

	IF (ODG=='2') THEN
	GOTO 120
	END IF

	END IF

	IF (IZH1=='9') THEN
	GOTO 100
	END IF

					
	IF ((IZH1=='ne').OR.(IZH1=='n')) STOP '    ****************************   NASVIDENJE   ***************************'



400	WRITE (*,92) 'Ta datoteka ze obstaja v tem imeniku! [1-ponovni vnos, 2-izhod]'
92	FORMAT (/A64)
	READ (*,*) IZH2
	
	IF ((IZH2/='1').AND.(IZH2/='2')) THEN
	WRITE (*,*) 'Napacna izbira !'
	GOTO 400
	END IF 

					
	IF ((IZH2=='1')) THEN
	
	IF (ODG=='1') THEN
	GOTO 110
	END IF

	IF (ODG=='2') THEN
	GOTO 120
	END IF

	END IF


	IF (IZH2=='2') STOP '    ****************************   NASVIDENJE   ***************************'




500	STOP '    ****************************   NASVIDENJE   ***************************' 




	END