MSX-GCR 1.0 by Leandro Correia 2019.

; MSX-GCR 1.0 (MSX Graphic Conversion Routine) by Leandro Correia (2019). Many thanks to Rogerio Penchel, Rafael Jannone and Weber Kai for valuable information and support.
; Feel free to use this algorithm in any program you want (well, crediting me would be nice).

Graphics 512,250,32,3


; Parameters: ****************************************************************

;Input and output images

;Image to be loaded and converted. TIP: images are usually better converted to MSX1 if contrast is increased and a sharpen effect is used after reducing them (with bilinear interpolation).
; A good converter could allow to crop the image, resample it automatically and then allow user to increase contrast and sharpen it. ;)

imagem=LoadImage("imageinput.png")
nomefinal$="imageoutput.bmp" ; Name of the output BMP

;Color tolerance for dithering (from 0 to 100). Higher values mean dithering between colors that are not similar, which results in better color accuracy but ugly squares on degradees. 0 means no dithering
tolerance=100

;Name of the MSX screen file dump that'll be saved. This file can be loaded on a real MSX with a simple screen2:bload "name",s
msxfilename$="image.scr"

;Detail level (1 to 255);
;Lower values gives priority in areas with strong luminosity changes (usually good when tolerance value is high, or in photo conversions).
;Higher values makes the conversion ignore these luminosity changes (usually good when tolerance value is low or in simple art conversions).
;But you should test it. Usually 32.0 is a good value. 255 will make the routine completely ignore luminosity variations.
;At best, this value can give subtle (but still welcome) improvements in conversion quality.

detaillevel# = 32.0

;******************************************************************************

DrawBlock imagem,0,0

Dim msxr(16),msxg(16),msxb(16)
Dim octetr(8),octetg(8),octetb(8),octetdetail#(8)
Dim octetfinal(8), octetvalue(8)
Dim toner(5),toneg(5),toneb(5),distcolor#(5)
Dim detail#(256,192) ; Detail map
Dim imagedata(255,192) ; Luminosity data of original image
Dim msxdumpdata(12288); Data for the MSX screen save file


;Reads all luminosity values
For j=0To 191
	For i=0To 255
		GetColor(i,j)
		imagedata(i,j)=(ColorRed()+ColorGreen()+ColorBlue())/3
	Next
Next

;Calculates detail map

If detaillevel <255 Then
	For j=1To 191
		For i=1To 254
			cor=imagedata(i-1,j)
			cor2=imagedata(i,j)
			cor3=imagedata(i+1,j)
			dif1=Abs(cor-cor2)
			dif2=Abs(cor2-cor3)
			If dif1 > dif2 Then corfinal=dif1 Else corfinal=dif2
			cor=imagedata(i,j-1)
			cor3=imagedata(i,j+1)
			dif1=Abs(cor-cor2)
			dif2=Abs(cor2-cor3)
			If dif1 > dif2 Then corfinal2=dif1 Else corfinal2=dif2
			corfinal=(corfinal+corfinal2) Shr 1
			corfinal=corfinal
			detail(i,j)=corfinal
		Next
	Next

	For i=0To 255
		detail(i,0)=0
		detail (i,191)=0
	Next
	For i=0To 191
		detail (0,i)=0
		detail (255,i)=0
	Next

	For j=0To 191
		For i=0To 255
			If detail(i,j)<1 Then detail(i,j)=1
			detail(i,j)=(detail(i,j)/detaillevel#)+1
		Next
	Next
Else
	For j=0To 191
		For i=0To 255
			detail(i,j)=1
		Next
	Next
End If

WaitKey()


; Reads the MSX RGB color values at the "data" statement at the end of the program.
For i=0To 15
	Read msxr(i),msxg(i),msxb(i)
Next


imgh=192:imgw=256
y=0:x=0
DrawBlock imagem,0,0


While y<192
	bestdistance=99999999
	For i=0To 7
		; Get the RGB values of 8 pixels of the original image
		GetColor x+i,y
		octetr(i)=ColorRed()
		octetg(i)=ColorGreen()
		octetb(i)=ColorBlue()
		octetdetail(i)=detail(x+i,y)
	Next

	; Brute force starts. Programs tests all 15 x 15 MSX color combinations. For each pixel octet it'll have to compare the original pixel colors with three different colors:
	; two MSX colors and a mixed RGB of both. If this RGB mixed is chosen it'll later be substituted by dithering.
	For cor1=1To 15
		For cor2=cor1 To 15

			dist=0

			If KeyHit(1) Then End

			; First MSX color of the octet
			toner(0)=msxr(cor1)
			toneg(0)=msxg(cor1)
			toneb(0)=msxb(cor1)

			; Second MSX color of the octet
			toner(2)=msxr(cor2)
			toneg(2)=msxg(cor2)
			toneb(2)=msxb(cor2)


			; A mix of both MSX colors RGB values. Since MSX cannot mix colors, later if this color is chosen it'll be substituted by a 2x2 dithering pattern.
			toner(1)=(msxr(cor1)+msxr(cor2))/2
			toneg(1)=(msxg(cor1)+msxg(cor2))/2
			toneb(1)=(msxb(cor1)+msxb(cor2))/2

			If calcdist2000(msxr(cor1),msxg(cor1),msxb(cor1),msxr(cor2),msxg(cor2),msxb(cor2)) <= tolerance Then ; if colors are not too distant according to the tolerance parameter, octect will be dithered.

				; dithered
				For i=0To 7
						For j=0To 2
							distcolor(j)=(calcdist2000(toner(j),toneg(j),toneb(j),octetr(i),octetg(i),octetb(i)))*octetdetail(i)
						Next
						finaldist=distcolor(0):octetvalue(i)=0
						For j=1To 2
							If distcolor(j)<finaldist Then finaldist=distcolor(j):octetvalue(i)=j
						Next

					dist=dist+finaldist
					If dist > bestdistance Then Exit
				Next
			Else
				; not dithered
				For i=0To 7
					finaldista=(calcdist2000(toner(0),toneg(0),toneb(0),octetr(i),octetg(i),octetb(i)))*octetdetail(i)
					finaldistb=(calcdist2000(toner(2),toneg(2),toneb(2),octetr(i),octetg(i),octetb(i)))*octetdetail(i)

					If finaldista < finaldistb Then
						octetvalue(i)=0
						finaldist=finaldista
					Else
						octetvalue(i)=2
						finaldist=finaldistb
					End If
					dist=dist+finaldist
					If dist > bestdistance Then Exit
				Next
			End If

			If dist < bestdistance Then
				bestdistance=dist:bestcor1=cor1:bestcor2=cor2
				For i=0To 7
					octetfinal(i)=octetvalue(i)
				Next
			End If
			If bestdistance=0 Then Exit
		Next
		If bestdistance=0 Then Exit
	Next
	byte=0
	For i=0To 7
		Select octetfinal(i)
			Case 0
				Color msxr(bestcor1),msxg(bestcor1),msxb(bestcor1)
			Case 1
			If y Mod 2 = i Mod 2 Then Color msxr(bestcor2),msxg(bestcor2),msxb(bestcor2) Else Color msxr(bestcor1),msxg(bestcor1),msxb(bestcor1)

			Case 2
				Color msxr(bestcor2),msxg(bestcor2),msxb(bestcor2)
			End Select
		If ColorRed()=msxr(bestcor2) And ColorGreen()=msxg(bestcor2) And ColorBlue()=msxb(bestcor2) Then byte=byte+2^(7-i)
		Plot 256+x+i,y
	Next
	y=y+1:If y Mod 8=0 Then y=y-8:x=x+8:If x>255 Then x=0:y=y+8

; Bytes to be written in the final MSX screen dump file.
	msxdumpdata(bytepos)=byte
	msxdumpdata(bytepos+6144)=bestcor2*16+bestcor1
	bytepos=bytepos+1
Wend

; Saves screen in an MSX friendly format. To load it on a real MSX:
; 1 SCREEN2
; 2 BLOAD "FILENAME",S


; File header
msxfile=WriteFile(msxfilename)
WriteByte msxfile,$FE
WriteByte msxfile,$00
WriteByte msxfile,$00
WriteByte msxfile,$ff
WriteByte msxfile,$37
WriteByte msxfile,$00
WriteByte msxfile,$00

For i=0To 6143
	WriteByte msxfile,msxdumpdata(i)
Next

For j=0To 2
	For i=0To 255
		WriteByte msxfile,i
	Next
Next

For i=0To 1279
	WriteByte msxfile,0
Next

For i=0To 6143
	WriteByte msxfile,msxdumpdata(i+6144)
Next
CloseFile msxfile

; Using Blitz Basic routines to save a bitmap with the conversion.

final=CreateImage(256,192)
CopyRect 256,0,256,192,0,0,FrontBuffer(),ImageBuffer(final)
SaveBuffer ImageBuffer(final),nomefinal$

WaitKey() ; Waits for a keypress and ends the program.
End


Function calcdist2000#(r1#,g1#,b1#,r2#,g2#,b2#)
	If r1=r2 And g1 = g2 And b1 = b2 Then Return 3

; Convert two RGB color values into Lab and uses the CIEDE2000 formula to calculate the distance between them.
; This function first converts RGBs to XYZ and then to Lab.

; This is not optimized, but I did my best to make it readable. In some rare cases there are some weird colors, so MAYBE there's a small bug in the implementation.
; The RGB to Lab conversion in here could easily be substituted by a giant RGB to Lab lookup table, consuming much more memory, but gaining A LOT in speed.

;	Converting RGB values into XYZ

	r#=r1#/255.0
	g#=g1#/255.0
	b#=b1#/255.0

	If r# > 0.04045 Then r#=((r#+0.055)/1.055)^2.4 Else r#=r#/12.92
	If g# > 0.04045 Then g#=((g#+0.055)/1.055)^2.4 Else g#=g#/12.92
	If b# > 0.04045 Then b#=((b#+0.055)/1.055)^2.4 Else b#=b#/12.92

	r#=r#*100.0
	g#=g#*100.0
	b#=b#*100.0

	;Observer. = 2°, Illuminant = D65
	x#=r#*0.4124 + g#*0.3576 + b#*0.1805
	y#=r#*0.2126 + g#*0.7152 + b#*0.0722
	z#=r#*0.0193 + g#*0.1192 + b#*0.9505

	x#=x#/95.047   ;Observer= 2°, Illuminant= D65
	y#=y#/100.000
	z#=z#/108.883

	If x# > 0.008856 Then x#=x# ^ (1.0/3.0) Else x# = (7.787 * x# ) + ( 16.0 / 116.0 )
	If y# > 0.008856 Then y#=y# ^ (1.0/3.0 ) Else y# = (7.787 * y# ) + ( 16.0 / 116.0 )
	If z# > 0.008856 Then z#=z# ^ (1.0/3.0 ) Else z# = (7.787 * z# ) + ( 16.0 / 116.0 )

	l1# = ( 116.0 * y# ) - 16.0
	a1# = 500.0 * (x#-y#)
	b1# = 200.0 * (y#-z#)


	r#=r2#/255.0
	g#=g2#/255.0
	b#=b2#/255.0

	If r# > 0.04045 Then r#=((r#+0.055)/1.055)^2.4 Else r#=r#/12.92
	If g# > 0.04045 Then g#=((g#+0.055)/1.055)^2.4 Else g#=g#/12.92
	If b# > 0.04045 Then b#=((b#+0.055)/1.055)^2.4 Else b#=b#/12.92

	r#=r#*100.0
	g#=g#*100.0
	b#=b#*100.0

	;Observer. = 2°, Illuminant = D65
	x#=r#*0.4124 + g#*0.3576 + b#*0.1805
	y#=r#*0.2126 + g#*0.7152 + b#*0.0722
	z#=r#*0.0193 + g#*0.1192 + b#*0.9505


	x#=x#/95.047   ;Observer= 2°, Illuminant= D65
	y#=y#/100.000
	z#=z#/108.883

	If x# > 0.008856 Then x#=x# ^ (1/3.0) Else x# = (7.787 * x# ) + ( 16.0 / 116.0 )
	If y# > 0.008856 Then y#=y# ^ (1/3.0 ) Else y# = (7.787 * y# ) + ( 16.0 / 116.0 )
	If z# > 0.008856 Then z#=z# ^ (1/3.0 ) Else z# = (7.787 * z# ) + ( 16.0 / 116.0 )

;	Converts XYZ to Lab...

	l2# = (116.0 * y#) - 16.0
	a2# = 500.0 * (x#-y#)
	b2# = 200.0 * (y#-z#)

; ...and then calculates distance between Lab colors, using the CIEDE2000 formula.

    dl#=l2-l1
    hl#=l1+dl*0.5
    sqb1#=Float b1*b1
    sqb2#=Float b2*b2
    c1#=Sqr(Float a1*a1+sqb1)
    c2#=Sqr(Float a2*a2+sqb2)
    hc7#=Float ((c1+c2)*0.5)^Float 7
    trc#=Sqr(hc7/(hc7+6103515625.0))
    t2#=1.5-trc*0.5
    ap1#=a1*t2
    ap2#=a2*t2
    c1#=Sqr(ap1*ap1+sqb1)
    c2#=Sqr(ap2*ap2+sqb2)
    dc#=c2-c1
    hc#=c1+dc*0.5
    hc7#=hc^7.0
    trc#=Sqr(hc7/(hc7+6103515625.0))
    h1#=ATan2(b1,ap1)
    If h1<0 Then h1=h1+Pi*2.0
    h2#=ATan2(b2,ap2)
    If h2<0 Then h2=h2+Pi*2.0
    hdiff#=h2-h1
    hh#=h1+h2
    If Abs(hdiff)>Pi Then
      hh=hh+Pi*2
      If h2<=h1 Then hdiff=hdiff+Pi*2.0
    Else
		hdiff=hdiff-Pi*2.0
	End If

    hh#=hh*0.5
    t2#=1-0.17*Cos(hh-Pi/6)+0.24*Cos(hh*2)
    t2#=t2+0.32*Cos(hh*3+Pi/30.0)
    t2#=t2-0.2*Cos(hh*4-Pi*63/180.0)
    dh#=2*Sqr(c1*c2)*Sin(hdiff*0.5)
    sqhl#=(hl-50.0)*(hl-50.0)
    fl#=dl/(1+(0.015*sqhl/Sqr(20.0+sqhl)))
    fc#=dc/(hc*0.045+1.0)
    fh=dh/(t2*hc*0.015+1.0)
    dt#=30*Exp(-(36.0*hh-55.0*Pi^2.0)/(25.0*Pi*Pi))
    r#=0-2*trc*Sin(2.0*dt*Pi/180.0)
    Return Sqr(fl*fl+fc*fc+fh*fh+r*fc*fh)
End Function

; Data of the MSX palette RGB values. Of course you could change these values to any palette you want.
Data 0,0,0,0,0,0,36,219,36,109,255,109,36,36,255,73,109,255,182,36,36,73,219,255,255,36,36,255,109,109,219,219,36,219,219,146,36,146,36,219,73,182,182,182,182,255,255,255