MsxScr04c8x1pictFilter0709211600.sdlbas

finp$="source.png"

'- 0108091823
'---- teste1_0105052418_fileopening_msx1_8x1_conv.txt
'---- 010808 - primeira tentativa no firstbasic-dos

'- reads palette after imagemagick conversion
tmfl$="_tmpr01.gif"

'- shell("convert "+finp$+" -colors 16 "+tmfl$+".xpm")
shell("convert "+finp$+" -colors 16 "+tmfl$)

dim npaletr[16],npaletg[16],npaletb[16]
dim clust[8,8],grpltlev[16]
dim rfromat[16],gfromat[16],bfromat[16],r0[8,8],g0[8,8],b0[8,8],plte[16]

open tmfl$ for input as #1
   for i=1 to 13:n=readbyte(1):next
   for i=0 to 15
      n=readbyte(1):npaletr[i]=int((int(n/32))*(255/7))
      n=readbyte(1):npaletg[i]=int((int(n/32))*(255/7))
      n=readbyte(1):npaletb[i]=int((int(n/32))*(255/7))
   next
 close #1

shell ("rm "+tmfl$)




'- reads png file
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
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)
close #1:setdisplay(xed,yed,32,1):paper(8^8-1):ink(0):pen(0):cls


'for i=0 to 15
'  prints(str$(npaletr[i])+","+str$(npaletg[i])+","+str$(npaletb[i]))
' next
'for i=0 to 15
'  ink(rgb(npaletr[i],npaletg[i],npaletb[i])):bar(0,4*i,xed,64):next
'waitkey


loadimage(finp$,1):pasteicon(0,0,1)

'- defines the cluster for halftone
dmst$="00,06,08,14,02,12,04,10,08,14,00,06,04,10,02,12."
for y2=0 to 3:for x2=0 to 3:clust[x2,y2]=val(mid$(dmst$,((y2*4+x2)*3)+1,2)):next:next


fout$=finp$+"_.bmp"
fout2$=finp$+"_.png"

'- colour palette
'dmst$="0,1,5,1,7,2,6,1,7,2,5,6,6,6,7,":for i=0 to 14:rr=val(mid$(dmst$,(i*2)+1,1)):npaletr[i]=(rr*255)/7:next
'dmst$="0,1,1,4,1,3,2,6,3,6,5,7,6,6,7,":for i=0 to 14:rg=val(mid$(dmst$,(i*2)+1,1)):npaletg[i]=(rg*255)/7:next
'dmst$="0,7,1,1,1,7,5,1,3,7,5,6,2,8,7,":for i=0 to 14:rb=val(mid$(dmst$,(i*2)+1,1)):npaletb[i]=(rb*255)/7:next




'- defines grayscale from the palette
'dmst$="0000,0237,0314,0395,0400,0448,0504,0564,0600,0701,0714,0765,0778,0825,1000."
'for i=0 to 14:grd=val(mid$(dmst$,(i*5)+1,4)):grpltlev[i]=((grd*255)/1000):next

for i=0 to 15:grpltlev[i]=int(((npaletr[i]*30)+(npaletg[i]*59)+(npaletb[i]*11))/100): next


'- sorts the palette

for i=0 to 14
for j=i+1 to 15
if grpltlev[i]>grpltlev[j] then
  tmprq=grpltlev[i]:grpltlev[i]=grpltlev[j]:grpltlev[j]=tmprq
  tmprq=npaletr[i]:npaletr[i]=npaletr[j]:npaletr[j]=tmprq
  tmprq=npaletg[i]:npaletg[i]=npaletg[j]:npaletg[j]=tmprq
  tmprq=npaletb[i]:npaletb[i]=npaletb[j]:npaletb[j]=tmprq
end if
next:next




'for i=0 to 15
'  ink(rgb(npaletr[i],npaletg[i],npaletb[i])):bar(0,4*i,xed,64):next'
'waitkey





for i=0 to 15:plte[i]=rgb(npaletr[i],npaletg[i],npaletb[i]):next
xmax=xed
ymax=yed
xmaxo=int(xmax/8):ymaxo=int(ymax/8)
xmaxoo=xmaxo*8:ymaxoo=ymaxo*8
xsm0=(xmaxoo and 255):ysm0=(ymaxoo and 255)

for i=0 to 15:rfromat[i]=npaletr[i]:gfromat[i]=npaletg[i]:bfromat[i]=npaletb[i]:next
for y1=0 to ymaxo-1
  setcaption(str$(int((y1*100)/ymaxo))+"%")
  for x1=0 to xmaxo-1
    for y2=0 to 7:for x2=0 to 7
      y=y1*8+y2:x=x1*8+x2:iy=(ymax-1)-y:ympos=(((iy*xmax)+x)*3)+55
      zzz=point(x,y)
      b0[x2,y2]=bitwiseand(zzz,255):zzz=int(zzz/256)
      g0[x2,y2]=bitwiseand(zzz,255):zzz=int(zzz/256)
      r0[x2,y2]=bitwiseand(zzz,255)
      next:next
    for y2=0 to 7
      y=y1*8+y2
      '- atribute reading and mounting
      bi=0:ri=0:gi=0
      for x2=0 to 7:x=(x1*8)+x2:iy=(ymax-1)-y:bi=bi+b0[x2,y2]:gi=gi+g0[x2,y2]:ri=ri+r0[x2,y2]:next
      b=bi/8:g=gi/8:r=ri/8:dbuf=1000:paattr=0:ikattr=15:pa=0:ik=15
      lumik=15:lumpa=0

      for pa=0 to 14
        for ik=pa+1 to 15
          graypa=grpltlev[pa]: grayik=grpltlev[ik]
          '- lumik=grayik:lumpa=graypa
          grayrgb=(((b*11)+(r*30)+(g*59))/100)
          if grayrgb>graypa and grayrgb<grayik then
            ikincid=((grayrgb-graypa)*255)/(grayik-graypa)
            rfikinc=((rfromat[ik]*ikincid)+(rfromat[pa]*(255-ikincid)))/255
            gfikinc=((gfromat[ik]*ikincid)+(gfromat[pa]*(255-ikincid)))/255
            bfikinc=((bfromat[ik]*ikincid)+(bfromat[pa]*(255-ikincid)))/255
            rdist=abs(rfikinc-r):gdist=abs(gfikinc-g):bdist=abs(bfikinc-b)
            rgbdist=sqr((rdist^2)+(gdist^2)+(bdist^2))
            if rgbdist<=dbuf then:dbuf=rgbdist:paattr=pa:ikattr=ik:lumik=grayik:lumpa=graypa:end if
            end if
          next:next

        '- memory block 4 reading as grayscale for screen 2
        dflum=lumik-lumpa:pkvar=0
        for x2=0 to 7
          x=x1*8+x2:yi=(ymaxoo-1)-y:b=b0[x2,y2]:g=g0[x2,y2]:r=r0[x2,y2]
          vlue=(((b*11)+(r*30)+(g*59))/100)
          patgf1=x2 mod 4:patgf2=y mod 4:patgf=(((clust[patgf1,patgf2]+1)*255)/16)
          varnd=((patgf*dflum)/255)+lumpa
          ik=ikattr
          if varnd>vlue then:ik=paattr:end if

          ink(plte[ik]):dot(x,y)

          next:next:next:next

grab (1,0,0,xed,yed):saveimage(fout$,1)
shell("convert "+fout$+" "+fout2$)
shell("rm "+fout$)