Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- finp$="TopPolynesiaCook3_740x555.jpg"
- fout$=finp$+"_.bmp"
- foutscr$=finp$+"_.scr"
- '- sdlbasic version 0708072157
- '- from firstbasic version: 0201310133
- '- conversor tem erros - verificar - ciano é visto como preto (?)
- '- please be sure the picture source is a .png
- '- sudo apt-get install xawtv vgrabbj imagemagick pzxtools music123 lame mpg123
- dim zxdisp[32768]
- xed=320:yed=250
- close #1:setdisplay(xed,yed,32,1):paper(8^8-1):ink(0):pen(0):cls:Loadimage(finp$,1):pasteicon(0,0,1)
- dim clust[8,16],r0[8,16],g0[8,16],b0[8,16],plte[16]
- plte[ 0]=0x000000:plte[ 2]=0x0000FF:plte[ 1]=0xFF0000:plte[ 3]=0xFF00FF
- plte[ 4]=0x00FF00:plte[ 6]=0x00FFFF:plte[ 5]=0xFFFF00:plte[ 7]=0xFFFFFF
- plte[ 8]=0x000000:plte[10]=0x0000FF:plte[ 9]=0xFF0000:plte[11]=0xFF00FF
- plte[12]=0x00FF00:plte[14]=0x00FFFF:plte[13]=0xFFFF00:plte[15]=0xFFFFFF
- '- "00,12,03,15,08,04,11,07,02,14,01,13,10,06,09,05."
- '- "00,06,08,14,02,12,04,10,08,14,00,06,04,10,02,12."
- 'clstr$="00,06,08,14,02,12,04,10,08,14,00,06,04,10,02,12."
- 'clstr$="00,01,02,03,04,05,06,07,08,09,10,11,12,13,14,15."
- 'clstr$="00,04,08,12,10,14,02,06,00,04,08,12,10,14,02,06."
- clstr$="00,04,08,12,08,12,00,04,00,04,08,12,08,12,00,04,"
- for y2=0 to 3:for x2=0 to 3:clust[x2,y2]=val(mid$(clstr$,((y2*4+x2)*3)+1,2)):next:next
- hbedge=255 '- halfbright attr edge -zx32=218, zx32fs=153 , realthing=180?
- rgrsp=30:ggrsp=30:bgrsp=30 '- for r, g and b saturation levels
- for y1=0 to int(yed/10):for x1=0 to int(xed/8)
- for y2=0 to 9:for x2=0 to 7
- y=y1*10+y2:x=x1*8+x2
- zzz=point(x,y)
- r0[x2,y2]=bitwiseand(zzz,255):zzz=int(zzz/256)
- g0[x2,y2]=bitwiseand(zzz,255):zzz=int(zzz/256)
- b0[x2,y2]=bitwiseand(zzz,255)
- next:next
- bi=0:ri=0:gi=0
- for y2=0 to 9:for x2=0 to 7
- x=(x1*8)+x2:y=(y1*10)+y2
- bi=bi+b0[x2,y2]:gi=gi+g0[x2,y2]:ri=ri+r0[x2,y2]
- next:next
- b=bi/80:g=gi/80:r=ri/80:xrreg=0
- hbrite=0:if (r<hbedge) and(g<hbedge) and(b<hbedge) then:hbrite=1:end if
- hbampl=255-(hbrite*(255-hbedge))
- if b>(hbampl/2) then:b=(hbampl-b):xrreg=bitwiseor(xrreg,1):end if
- if r>(hbampl/2) then:r=(hbampl-r):xrreg=bitwiseor(xrreg,2):end if
- if g>(hbampl/2) then:g=(hbampl-g):xrreg=bitwiseor(xrreg,4):end if
- halbr=(r*rgrsp)/100:halbg=(g*ggrsp)/100:halbb=(b*bgrsp)/100:vlik=7
- if((r>halbb) and(g<=halbb)) or((b<=halbr) and(g<=halbr))then:vlik=3:end if
- if((g>halbb) and(r<=halbb)) or((b<=halbg) and(r<=halbg))then:vlik=5:end if
- if((g>halbr) and(b<=halbr)) or((r<=halbg) and(b<=halbg))then:vlik=6:end if
- if((r<=halbb) and(g<=halbb)) then: vlik=1:end if
- if((b<=halbr) and(g<=halbr)) then: vlik=2:end if
- if((b<=halbg) and(r<=halbg)) then: vlik=4:end if
- brattr=1-hbrite:ikattr=bitwisexor(vlik,xrreg):paattr=xrreg
- if ikattr<paattr then:tmpr=ikattr:ikattr=paattr:paattr=tmpr:end if
- atvl=bitwiseor((ikattr*8),paattr):atvl=bitwiseor(atvl,(brattr*64))
- zxdisp[6144+x1+(y1*32)]=atvl
- ikval=ikattr+(bitwiseand(ikattr,6)/2)
- paval=paattr+(bitwiseand(paattr,6)/2)
- lumik=(ikval*255)/10:lumpa=(paval*255)/10
- if brattr<1 then:lumik=(lumik*hbedge)/255:lumpa=(lumpa*hbedge)/255:end if
- dflum=lumik-lumpa
- for y2=0 to 9
- dbny=0
- for x2=0 to 7
- y=y1*10+y2:x=x1*8+x2:b=b0[x2,y2]:g=g0[x2,y2]:r=r0[x2,y2]
- vlue=((b+(r*3)+(g*6))/10)
- patgf=(((clust[bitwiseand(x2,3),bitwiseand(y2,3)]+1)*255)/16)
- varnd=((patgf*dflum)/255)+lumpa
- ik=ikattr+(8*brattr)
- if varnd>vlue then:
- ik=paattr+(8*brattr)
- dbny=dbny+(2^(7-x2))
- end if
- ink(plte[ik]):dot(x,y)
- next
- ' yf=(bitwiseand(y,7)*8) or (bitwiseand(y,56)/8) or bitwiseand(y,192)
- yf=bitwiseor(bitwiseand(y,7)*8,bitwiseand(y,56)/8)
- yf=bitwiseor(bitwiseand(y,192),yf)
- zxdisp[(yf*32)+x1]=dbny
- next:next:next
- grab (1,0,0,xed,yed):saveimage(fout$,1)
- 'open foutscr$ for output as #1
- 'for i=0 to 6911
- ' writebyte (1,zxdisp[i])
- ' next
- 'close #1
- waitkey
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement