SHARE
TWEET

anembryonicpictureconverterforenterprise256cpixelmode.sdlbas

a guest Nov 6th, 2017 271 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. finp$="lena_80x200.png"
  2. if argc>=3 then:finp$=command$(3):end if
  3. '- original qbasic version - 0112141818
  4. '- sdlbasic version - 0405111338
  5. '- halftone picture converter (bmp 4/8/24bit)
  6. xed=0:yed=0:open finp$ for input as #1:for i=1 to 16:n=readbyte(1):next:for i=1 to 2:n=readbyte(1):next
  7. xed=readbyte(1)*256:xed=xed+readbyte(1):for i=1 to 2:n=readbyte(1):next:yed=readbyte(1)*256:yed=yed+readbyte(1)
  8. close #1
  9. setdisplay(xed,yed,32,1):paper(8^8-1):ink(0):pen(0):cls:
  10. '- opens the image
  11. loadimage(finp$,1):pasteicon(0,0,1)
  12. dim clust[16,16] '-,o4b[2]
  13. '-- define cluster
  14.  
  15. a$="00,09,02,11,04,13,06,15,08,01,10,03,12,05,14,07,"  '- 8x2 matrix
  16.  
  17. 'a$="00,06,08,14,02,12,04,10,08,14,00,06,04,10,02,12"
  18. for y2=0 to 7:for x2=0 to 1
  19.   lc=(y2*2)+x2
  20.   clust[x2,y2]=val(mid$(a$,(lc*3)+1,2)):next:next
  21. dim cor[16]
  22. cor[0]=0x000000:cor[1]=0x0000FF:cor[2]=0xFF0000:cor[3]=0xFF00FF
  23. cor[4]=0x00FF00:cor[5]=0x00FFFF:cor[6]=0xFFFF00:cor[7]=0xFFFFFF
  24. for y=0 to yed-1
  25.   for x=0 to xed-1
  26.     ind=point(x,y)
  27.  
  28.     b=ind mod 256:ind=int(ind/256)
  29.     g=ind mod 256:ind=int(ind/256)
  30.     r=ind mod 256
  31.  
  32.     b2=int(b/86)
  33.     g2=int(g/37)
  34.     r2=int(r/37)
  35.  
  36.     b3=int((b mod 86)*3)
  37.     g3=int((g mod 37)*7)
  38.     r3=int((r mod 37)*7)
  39.  
  40.     k=int(((b*11)+(r*30)+(g*59))/100)
  41.     k2=int(((b2*11)+(r2*30)+(g2*59))/100)
  42.     k3=int(((b3*11)+(r3*30)+(g3*59))/100)
  43.  
  44.     patgf=(((clust[x mod 2,y mod 8]+1)*255)/16)
  45.  
  46.     rpat=0:if r>patgf then:rpat=1:end if
  47.     gpat=0:if g>patgf then:gpat=1:end if
  48.     bpat=0:if b>patgf then:bpat=1:end if
  49.     kpat=0:if k>patgf then:kpat=1:end if
  50.  
  51.     rpat2=0:if r2>patgf then:rpat2=1:end if
  52.     gpat2=0:if g2>patgf then:gpat2=1:end if
  53.     bpat2=0:if b2>patgf then:bpat2=1:end if
  54.     kpat2=0:if k2>patgf then:kpat2=1:end if
  55.  
  56.     rpat3=0:if r3>patgf then:rpat3=1:end if
  57.     gpat3=0:if g3>patgf then:gpat3=1:end if
  58.     bpat3=0:if b3>patgf then:bpat3=1:end if
  59.     kpat3=0:if k3>patgf then:kpat3=1:end if
  60.  
  61.     o4b=(bpat+(rpat*2)+(gpat*4)) mod 8
  62.     'ink(0):if kpat<>0 then:ink(0xFFFFFF):end if
  63.     'ink(cor[o4b])
  64.  
  65.     ink(rgb((r2+rpat3)*35,(g2+gpat3)*35,(b2+bpat3)*85))
  66.  
  67.     dot(x,y)
  68.     next:next
  69. '- saves the image
  70. fout$=finp$+".bmp"
  71. grab (1,0,0,xed,yed):saveimage(fout$,1)
  72. shell ("convert "+finp$+".bmp "+finp$+".png")
  73. shell ("rm "+finp$+".bmp")
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