SHARE
TWEET

Untitled

a guest Mar 29th, 2019 152 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ;Graphic routine To convert RGB images To MSX1 video, by Leandro Correia (www.leandrocorreia.com)
  2. ; Run it on Blitz Basic. Enjoy!
  3.  
  4. Graphics 512,250,32,3
  5.  
  6. ;Input and output images
  7.  
  8. ;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.
  9. ; A good converter could allow the user to crop the image, resample it automatically and then allow user to increase contrast and sharpen it. ;)
  10. imagem=LoadImage("..\msxconv2x2\angelina.png")
  11.  
  12. ;Name of the output BMP
  13. nomefinal$="sample23.bmp"
  14.  
  15. ;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
  16. tolerance=100
  17.  
  18. DrawBlock imagem,0,0
  19.  
  20. Dim msxr(16),msxg(16),msxb(16)
  21. Dim octetr(8),octetg(8),octetb(8)
  22. Dim octetfinal(8), octetvalue(8)
  23. Dim toner(5),toneg(5),toneb(5),distcolor(5)
  24.  
  25. ; Reads the MSX RGB color values at the "data" statement at the end of the program.
  26. For i=0To 15
  27.     Read msxr(i),msxg(i),msxb(i)
  28. Next
  29.  
  30. ; Lookup table to make squareroots quicker...
  31. Dim sqrt(9999999)
  32. For i=0To 9999998
  33.     sqrt(i)=Sqr(i)
  34. Next
  35.  
  36.  
  37. imgh=192:imgw=256
  38. y=0:x=0
  39. DrawBlock imagem,0,0
  40.  
  41.  
  42. While y<192
  43.     bestdistance=99999999
  44.     For i=0To 7
  45.         ; Get the RGB values of 8  pixels of the original image
  46.         GetColor x+i,y
  47.         octetr(i)=ColorRed()
  48.         octetg(i)=ColorGreen()
  49.         octetb(i)=ColorBlue()              
  50.     Next
  51.    
  52.     ; 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 diffent colors: two MSX colors and a mixed RGB of both.
  53.     For cor1=1To 15
  54.         For cor2=cor1 To 15
  55.            
  56.  
  57.             dist=0
  58.            
  59.             If KeyHit(1) Then End
  60.            
  61.             ; First MSX color of the octet
  62.             toner(0)=msxr(cor1)
  63.             toneg(0)=msxg(cor1)
  64.             toneb(0)=msxb(cor1)
  65.            
  66.             ; Second MSX color of the octet
  67.             toner(2)=msxr(cor2)
  68.             toneg(2)=msxg(cor2)
  69.             toneb(2)=msxb(cor2)
  70.  
  71.            
  72.             ; 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.
  73.             toner(1)=(msxr(cor1)+msxr(cor2))/2
  74.             toneg(1)=(msxg(cor1)+msxg(cor2))/2
  75.             toneb(1)=(msxb(cor1)+msxb(cor2))/2
  76.        
  77.             If calcdist2000(msxr(cor1),msxg(cor1),msxb(cor1),msxr(cor2),msxg(cor2),msxb(cor2)) <= tolerance Then ; if colors are not too distant, octect can be either dithered or not
  78.  
  79.                 ; dithered
  80.                 For i=0To 7
  81.                         For j=0To 2
  82.                             distcolor(j)=calcdist2000(toner(j),toneg(j),toneb(j),octetr(i),octetg(i),octetb(i))
  83.                         Next
  84.                         finaldist=distcolor(0):octetvalue(i)=0
  85.                         For j=1To 2
  86.                             If distcolor(j)<finaldist Then finaldist=distcolor(j):octetvalue(i)=j
  87.                         Next
  88.            
  89.                     dist=dist+finaldist
  90.                     If dist > bestdistance Then Exit
  91.                 Next
  92.             Else
  93.                 ; not dithered
  94.                 For i=0To 7
  95.                     finaldista=calcdist2000(toner(0),toneg(0),toneb(0),octetr(i),octetg(i),octetb(i))
  96.                     finaldistb=calcdist2000(toner(2),toneg(2),toneb(2),octetr(i),octetg(i),octetb(i))
  97.                     If finaldista < finaldistb Then
  98.                         octetvalue(i)=0
  99.                         finaldist=finaldista                      
  100.                     Else
  101.                         octetvalue(i)=2
  102.                         finaldist=finaldistb
  103.                     End If
  104.                     dist=dist+finaldist
  105.                     If dist > bestdistance Then Exit
  106.                 Next
  107.             End If
  108.            
  109.             If dist < bestdistance Then
  110.                 bestdistance=dist:bestcor1=cor1:bestcor2=cor2
  111.                 For i=0To 7
  112.                     octetfinal(i)=octetvalue(i)
  113.                 Next
  114.             End If
  115.             If bestdistance=0 Then Exit
  116.         Next
  117.         If bestdistance=0 Then Exit
  118.     Next
  119.     byte=0
  120.     For i=0To 7
  121.         Select octetfinal(i)
  122.             Case 0
  123.                 Color msxr(bestcor1),msxg(bestcor1),msxb(bestcor1)
  124.             Case 1
  125.             If y Mod 2 = i Mod 2 Then Color msxr(bestcor2),msxg(bestcor2),msxb(bestcor2) Else Color msxr(bestcor1),msxg(bestcor1),msxb(bestcor1)
  126.  
  127.             Case 2
  128.                 Color msxr(bestcor2),msxg(bestcor2),msxb(bestcor2)
  129.             End Select
  130.         If ColorRed()=msxr(bestcor2) And ColorGreen()=msxg(bestcor2) And ColorBlue()=msxb(bestcor2) Then byte=byte+2^(7-i)
  131.         Plot 256+x+i,y
  132.     Next  
  133.     y=y+1:If y Mod 8=0 Then y=y-8:x=x+8:If x>255 Then x=0:y=y+8
  134.    
  135.     ; This would be the place for you to write the bytes in the final MSX screen file.
  136. Wend
  137.  
  138. ; Using Blitz Basic routines to save a bitmap with the conversion.
  139.  
  140. final=CreateImage(256,192)
  141. CopyRect 256,0,256,192,0,0,FrontBuffer(),ImageBuffer(final)
  142. SaveBuffer ImageBuffer(final),nomefinal$
  143.  
  144. WaitKey()
  145. End
  146.  
  147.  
  148. Function calcdist2000#(r1#,g1#,b1#,r2#,g2#,b2#)
  149.  
  150. ; Convert two RGB color values into Lab and uses the CIEDE2000 formula to calculate the distance between them.
  151. ; This function first converts RGBs to XYZ and then to Lab.
  152.  
  153. ; 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.
  154. ; Or it could be improved since RGB To Lab is Not a direct conversion.
  155.  
  156. ;   Converting RGB values into XYZ
  157.  
  158.     r#=r1#/255.0
  159.     g#=g1#/255.0
  160.     b#=b1#/255.0
  161.    
  162.     If r# > 0.04045 Then r#=((r#+0.055)/1.055)^2.4 Else r#=r#/12.92
  163.     If g# > 0.04045 Then g#=((g#+0.055)/1.055)^2.4 Else g#=g#/12.92
  164.     If b# > 0.04045 Then b#=((b#+0.055)/1.055)^2.4 Else b#=b#/12.92
  165.    
  166.     r#=r#*100.0
  167.     g#=g#*100.0
  168.     b#=b#*100.0
  169.    
  170.     ;Observer. = 2°, Illuminant = D65
  171.     x#=r#*0.4124 + g#*0.3576 + b#*0.1805
  172.     y#=r#*0.2126 + g#*0.7152 + b#*0.0722
  173.     z#=r#*0.0193 + g#*0.1192 + b#*0.9505
  174.    
  175.     ;Print x
  176.     ;Print y
  177.     ;Print z
  178.    
  179.     x#=x#/95.047   ;Observer= 2°, Illuminant= D65
  180.     y#=y#/100.000
  181.     z#=z#/108.883
  182.    
  183.     If x# > 0.008856 Then x#=x# ^ (1.0/3.0) Else x# = (7.787 * x# ) + ( 16.0 / 116.0 )
  184.     If y# > 0.008856 Then y#=y# ^ (1.0/3.0 ) Else y# = (7.787 * y# ) + ( 16.0 / 116.0 )
  185.     If z# > 0.008856 Then z#=z# ^ (1.0/3.0 ) Else z# = (7.787 * z# ) + ( 16.0 / 116.0 )
  186.    
  187.     l1# = ( 116.0 * y# ) - 16.0
  188.     a1# = 500.0 * (x#-y#)
  189.     b1# = 200.0 * (y#-z#)
  190.  
  191.  
  192.     r#=r2#/255.0
  193.     g#=g2#/255.0
  194.     b#=b2#/255.0
  195.    
  196.     If r# > 0.04045 Then r#=((r#+0.055)/1.055)^2.4 Else r#=r#/12.92
  197.     If g# > 0.04045 Then g#=((g#+0.055)/1.055)^2.4 Else g#=g#/12.92
  198.     If b# > 0.04045 Then b#=((b#+0.055)/1.055)^2.4 Else b#=b#/12.92
  199.    
  200.     r#=r#*100.0
  201.     g#=g#*100.0
  202.     b#=b#*100.0
  203.    
  204.     ;Observer. = 2°, Illuminant = D65
  205.     x#=r#*0.4124 + g#*0.3576 + b#*0.1805
  206.     y#=r#*0.2126 + g#*0.7152 + b#*0.0722
  207.     z#=r#*0.0193 + g#*0.1192 + b#*0.9505
  208.    
  209.  
  210.     x#=x#/95.047   ;Observer= 2°, Illuminant= D65
  211.     y#=y#/100.000
  212.     z#=z#/108.883
  213.    
  214.     If x# > 0.008856 Then x#=x# ^ (1/3.0) Else x# = (7.787 * x# ) + ( 16.0 / 116.0 )
  215.     If y# > 0.008856 Then y#=y# ^ (1/3.0 ) Else y# = (7.787 * y# ) + ( 16.0 / 116.0 )
  216.     If z# > 0.008856 Then z#=z# ^ (1/3.0 ) Else z# = (7.787 * z# ) + ( 16.0 / 116.0 )
  217.    
  218. ;   Converts XYZ to Lab...
  219.    
  220.     l2# = (116.0 * y#) - 16.0
  221.     a2# = 500.0 * (x#-y#)
  222.     b2# = 200.0 * (y#-z#)
  223.    
  224. ; ...and then calculates distance between Lab colors, using the CIEDE2000 formula.
  225.  
  226.     dl#=l2-l1
  227.     hl#=l1+dl*0.5
  228.     sqb1#=Float b1*b1
  229.     sqb2#=Float b2*b2
  230.     c1#=Sqr(Float a1*a1+sqb1)
  231.     c2#=Sqr(Float a2*a2+sqb2)
  232.     hc7#=Float ((c1+c2)*0.5)^Float 7
  233.     trc#=Sqr(hc7/(hc7+6103515625.0))
  234.     t2#=1.5-trc*0.5
  235.     ap1#=a1*t2
  236.     ap2#=a2*t2
  237.     c1#=Sqr(ap1*ap1+sqb1)
  238.     c2#=Sqr(ap2*ap2+sqb2)
  239.     dc#=c2-c1
  240.     hc#=c1+dc*0.5
  241.     hc7#=hc^7.0
  242.     trc#=Sqr(hc7/(hc7+6103515625.0))
  243.     h1#=ATan2(b1,ap1)
  244.     If h1<0 Then h1=h1+Pi*2.0
  245.     h2#=ATan2(b2,ap2)
  246.     If h2<0 Then h2=h2+Pi*2.0
  247.     hdiff#=h2-h1
  248.     hh#=h1+h2
  249.     If Abs(hdiff)>Pi Then
  250.       hh=hh+Pi*2
  251.       If h2<=h1 Then hdiff=hdiff+Pi*2.0
  252.     Else
  253.         hdiff=hdiff-Pi*2.0
  254.     End If
  255.  
  256.     hh#=hh*0.5
  257.     t2#=1-0.17*Cos(hh-Pi/6)+0.24*Cos(hh*2)
  258.     t2#=t2+0.32*Cos(hh*3+Pi/30.0)
  259.     t2#=t2-0.2*Cos(hh*4-Pi*63/180.0)
  260.     dh#=2*Sqr(c1*c2)*Sin(hdiff*0.5)
  261.     sqhl#=(hl-50.0)*(hl-50.0)
  262.     fl#=dl/(1+(0.015*sqhl/sqrt(20.0+sqhl)))
  263.     fc#=dc/(hc*0.045+1.0)
  264.     fh=dh/(t2*hc*0.015+1.0)
  265.     dt#=30*Exp(-(36.0*hh-55.0*Pi^2.0)/(25.0*Pi*Pi))
  266.     r#=0-2*trc*Sin(2.0*dt*Pi/180.0)
  267.     Return Sqr(fl*fl+fc*fc+fh*fh+r*fc*fh)  
  268. End Function
  269.  
  270. ; Data of the MSX palette RGB values.
  271. 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
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top