[bb] Ice/Vernis layer (b+) by Nebula [ 1+ years ago ]

Started by BlitzBot, June 29, 2017, 00:28:41

Previous topic - Next topic
Print
Go Down Pages1
User actions

BlitzBot

June 29, 2017, 00:28:41
Title : Ice/Vernis layer (b+)
Author : Nebula
Posted : 1+ years ago

Description : The moment after I released this filter. The advertisement industry started using this. Graphical filters are a hot thing.

This one (source) can be modified. Ice man effect. Liquid effect. Vernis (paint finishing) effect.

(hectic)

Code :
Code (blitzbasic) Select
;
;
;
Global wwidth = 800
Global wheight =  600

Global win = CreateWindow("Test Window - Basic (3)",200,100,wwidth,wheight,0,3^2)
Global can = CreateCanvas(0,0,GadgetWidth(win),GadgetHeight(win),win)
;
Global md,mu
; wait until the user closes one of the windows
;
Dim coppermap(1,640)
Dim genmap(100,100)
subdivide 0,0,100,100
Type editor
Field x,y,w,h
Field x1,y1,x2,y2,ix1,iy1,mc
Field gt
End Type
Global editor.editor = New editor
editorgt=1
Type shape
Field bmap
Field x,y,w,h,div#
Field tp
End Type
;
Type bmap
Field gridmap,colormap,effectmap,tempmap
Field im1,im
End Type
Global bmap.bmap = New bmap
bmapgridmap = CreateImage(GadgetWidth(can),GadgetHeight(can))
bmapcolormap = CreateImage(GadgetWidth(can),GadgetHeight(can))
bmapeffectmap = CreateImage(GadgetWidth(can),GadgetHeight(can))
bmap empmap = CreateImage(GadgetWidth(can),GadgetHeight(can))
;
drawgrid
;
makecoppermap


t = CreateTimer(20)
;

loadmyimage

Function loadmyimage()
rf$ = RequestFile("Select a graphic file")
;RuntimeError rf$
loadfoto(rf$)
dofoto(2)
FlushMouse():FlushEvents() : Delay 200
End Function

Repeat
;
vw$ = WaitEvent()
If vw = $803 Then Exit
;
Select vw
Case $205
ActivateGadget can

Case $102
Select EventData()
Case 2:editorgt = 1
Case 3:editorgt = 2
Case 38:loadmyimage
End Select
Case $201 ; mouse down
If RectsOverlap(EventX(),EventY(),1,1,GadgetX(can),GadgetY(can),GadgetWidth(can),GadgetHeight(can)) = True Then
md = True : mu = False
;this.shape = New shape
;this p = 1
;thisx = EventX()
;thisy = EventY()
;thisw = 100
;thish  = 100
;thisdiv = 1.5
editorix1 = EventX()
editoriy1 = EventY()
editorx1 = EventX()
editory1 = EventY()
editorx2 = EventX()
editory2 = EventY()
End If
Case $203
If EventX() < GadgetWidth(can) And EventX() > 0
editorx2 = EventX()
End If
If EventY() < GadgetHeight(can)-32 And EventY()>0
editory2 = EventY()
End If



Case $202 ; mouse up
md = False : mu=True
this.shape = New shape
thisx = editorx1
thisy = editory1
thisw = editorx2-editorx1
thish = editory2 - editory1
thisdiv=Rnd(1,5)
this p=editorgt
 If editorx2 < editorix1 Then thisx = editorx2 : thisw = editorx1 - editorx2
 If editory2 < editoriy1 Then thisy = editory2 : thish = editory1 - editory2

;flashyblendoval(this.shape)
FlushMouse()
Case $4001
SetBuffer CanvasBuffer(can)
Cls
DrawBlock bmapgridmap,0,0
DrawBlock bmapim,0,0
DrawImage bmapeffectmap,0,0
Color 255,255,255
Text 0,0,md
Text 0,20,mu
;Rect 100,100,200,200
;drawrectangles()
;
ax = Sin(n1) * 128
n1=n1+16
;DebugLog ax
;
If md = True Then ovalmouserect
;
Text 320,0, ms
Text 320,20,shapecount()
;flashyoval 128+ax,128+ax,64,64,128,128+ax,1
;blendcopypasteoval 128+ax,128+ax,64,64,1.5
;colmapdisplay
;
;blendcopypasteoval 320+ax,140-ax,32,32,1.5
;
FlipCanvas can
End Select
;
Forever

End ; bye!
Function drawrectangles()
;
For this.shape = Each shape
;
Select this p
Case 1
Color 200,0,0
Oval thisx,thisy,thisw,thish,True
End Select
;
Next
;
End Function
Function drawrectangle(x,y,w,h)
Color 200,0,0
Rect x,y,w,h,True
End Function

Function drawgrid()
;
SetBuffer ImageBuffer(bmapgridmap)
n = 0
Color n,n,255
nn = GadgetHeight(can)/16
sw = 1
For y = 0 To ImageHeight(bmapgridmap) Step 32
For x = 0 To ImageWidth(bmapgridmap) Step 32
oldn = n
n2 = getcolormapcolor(x,y,2)
Color n2,n2,n2
Rect x,y,33,33,False
sw = -sw
n = oldn
Next:
Color n,n,255
n = n + nn
If n > 256 - 32 Then nn = -nn
;
;DebugLog n
;
Next
; color map plotted
Color 255,100,100
For y=0 To ImageHeight(bmapgridmap) Step 4
For x=0 To ImageWidth(bmapgridmap) Step 4
;
r = getcolormapcolor(x,y,3)
Color r,r,r

Plot x,y
;
Next:Next
;
;
Color 255,100,100

For i=0 To 460
x=Rand(GadgetWidth(can))
y=Rand(GadgetHeight(can))
r = getcolormapcolor(x,y,2)
;
Color r,r,r
;
;
;
Plot x-Rand(16),y-Rand(16)
;
Next

SetBuffer CanvasBuffer(can)
;
End Function

Function makecolormap()
End Function
;
Function getColormapcolor(x#,y#,m#)
If x<0 Then Return
If y>GadgetHeight(can) Then Return
If x>GadgetWidth(can) Then Return
If x<0 Then Return
a# = 100
Local mx# = ( GadgetWidth(can)  / a )
Local my# = ( GadgetHeight(can)  / a )
;DebugLog x + ": " + x/mx
;DebugLog y
;DebugLog genmap(x / mx , y / my)
r = (genmap(x / mx,y / my) + 34) * m#
If r<0 Then r = 0
If r>255 Then r=255
Return r
End Function
;
Function colmapdisplay()
For x=0 To GadgetWidth(can) Step 32
For y=0 To GadgetHeight(can) Step 16
n$ = getcolormapcolor(x,y,3)
Color 255,255,n
Text x,y,n$
Next:Next
End Function
;
Function SubDivide(x1,y1,x2,y2);
 If (x2-x1<2) And (y2-y1<2) Then Return;
;  {If this is pointing at just on pixel, Exit because
;   it doesn't need doing}
 
  dist=(x2-x1+y2-y1); {Find distance between points.  Use when generating a random number}
  hdist=dist / 2;
 
  midx=(x1+x2) / 2; {Find Middle Point}
  midy=(y1+y2) / 2;
 
  c1=Genmap(x1,y1); {Get pixel colors of corners}
  c2=Genmap(x2,y1);
  c3=Genmap(x2,y2);
  c4=Genmap(x1,y2);
 
;  { If Not already defined, work out the midpoints of the corners of
;   the rectangle by means of an average plus a random number. }
  If Genmap(midx,y1)=0 Then Genmap(midx,y1)=((c1+c2+Rand(dist)-hdist) / 2);
  If Genmap(midx,y2)=0 Then Genmap(midx,y2)=((c4+c3+Rand(dist)-hdist) / 2);
  If Genmap(x1,midy)=0 Then Genmap(x1,midy)=((c1+c4+Rand(dist)-hdist) / 2);
  If Genmap(x2,midy)=0 Then Genmap(x2,midy)=((c2+c3+Rand(dist)-hdist) / 2);
 
;  { Work out the middle point... }
  genmap(midx,midy) = ((c1+c2+c3+c4+Rand(dist)-hdist) / 4)
 ;  { Now divide this rectangle into 4, And call again For Each smaller
;   rectangle }
  SubDivide(x1,y1,midx,midy);
  SubDivide(midx,y1,x2,midy);
  SubDivide(x1,midy,midx,y2);
  SubDivide(midx,midy,x2,y2);
End Function

Function flashyoval_old(this.shape,dx,dy,w,h,offx,offy,dark#=2)
If w=<0 Then Return
If h=<0 Then Return
Local brrb = CreateImage(w,h)
SetBuffer ImageBuffer(brrb)
Color 255,255,255
Oval 0,0,w,h,True
For y = 0 To h-1
For x = 0 To w-1
GetColor x,y
If ColorRed()>0 Then
k = getcolormapcolor(x+offx,y+offy,dark)
kk = coppermap(0,y)
SetBuffer ImageBuffer(bmapgridmap)
GetColor x,y
zr = ColorRed()/2
zg = ColorGreen()/2
zb = ColorBlue()/2
SetBuffer ImageBuffer(brrb)
ar = k/2
ag = (k/2)+(kk/3)
ab = k+kk/3
;Color k/2,k/2+(kk/3),k+(kk/3)
qr = zr+ar
qg = zg+ag
qb = zb+ab
If qr>255 Then qr=255
If qg>255 Then qg=255
If qb>255 Then qb=255
If qr<0 Then qr = 0
If qg<0 Then qg = 0
If qb<0 Then qb = 0
Color qr,qg,qb
Plot x,y
End If
Next:Next

For i=0 To 5
Color k/2+(i*5),k/2+(kk/3),k+(kk/3)

Oval i,i,w-i*2,h-i*2,False
Oval i+1,i,w-i*2,h-i*2,False
Next
Color (k/2+(i*5))+20,(k/2+(kk/3))+20,(k+(kk/3))+20
Oval 0,0,w,h,False
 
;SetBuffer CanvasBuffer(can)
;SetBuffer ImageBuffer(bmap empmap)
;DrawImage brrb,dx,dy
thismap = CreateImage(thisw,thish)
SetBuffer ImageBuffer(thismap)
DrawImage brrb,0,0
FreeImage brrb
End Function
;
Function flashyoval(this.shape,dx,dy,w,h,offx,offy,dark#=2)
ms = MilliSecs()
If w=<0 Then Return
If h=<0 Then Return
Local brrb = CreateImage(w,h)
SetBuffer ImageBuffer(brrb)
Color 255,255,255
Oval 0,0,w,h,True
For y = 0 To h-1
For x = 0 To w-1
;GetColor x,y
LockBuffer ImageBuffer(brrb)
pff = ReadPixelFast(x,y)
;DebugLog getr(pff)
UnlockBuffer ImageBuffer(brrb)
;If ColorRed()>0 Then
;DebugLog getr(pff)
;DebugLog getr(pff)
If getr(pff) > 0 Then
;End
;DebugLog getr(pff)
k = getcolormapcolor(x+offx,y+offy,dark)
kk = coppermap(0,y)
SetBuffer ImageBuffer(bmapgridmap)
LockBuffer ImageBuffer(bmapgridmap)
krr = ReadPixelFast(x,y)
zr = getr(krr)/2
zg = getg(krr)/2
zb = getb(krr)/2
UnlockBuffer ImageBuffer(bmapgridmap)
;GetColor x,y
;zr = ColorRed()/2
;zg = ColorGreen()/2
;zb = ColorBlue()/2
SetBuffer ImageBuffer(brrb)
ar = k/2
ag = (k/2)+(kk/3)
ab = k+kk/3
;Color k/2,k/2+(kk/3),k+(kk/3)
qr = zr+ar
qg = zg+ag
qb = zb+ab
If qr>255 Then qr=255
If qg>255 Then qg=255
If qb>255 Then qb=255
If qr<0 Then qr = 0
If qg<0 Then qg = 0
If qb<0 Then qb = 0
;
;
LockBuffer ImageBuffer(brrb)
WritePixelFast x,y,getrgb(qr,qg,qb)
UnlockBuffer ImageBuffer(brrb)
;
;Color qr,qg,qb
;Plot x,y
End If
Next:Next

For i=0 To 5
Color k/2+(i*5),k/2+(kk/3),k+(kk/3)

Oval i,i,w-i*2,h-i*2,False
Oval i+1,i,w-i*2,h-i*2,False
Next
Color (k/2+(i*5))+20,(k/2+(kk/3))+20,(k+(kk/3))+20
Oval 0,0,w,h,False
 
;SetBuffer CanvasBuffer(can)
;SetBuffer ImageBuffer(bmap empmap)
;DrawImage brrb,dx,dy
thismap = CreateImage(thisw,thish)
SetBuffer ImageBuffer(thismap)
DrawImage brrb,0,0
FreeImage brrb
DebugLog MilliSecs()-ms
End Function

;
Function makecoppermap()
a# = 255
b# = 480
c# = a/b
For y=0 To 480-1
r# = r# + c
coppermap(0,y) = r
;DebugLog r
Next
End Function

Function blendcopypasteoval(xb,yb,w,h,div#);paste 1 , paste many
Local m = CreateImage(w,h)
Local mm = CreateImage(w,h)
Local aa#
Local bb#
Local cc#
Local cr#,cg#,cb#

MaskImage m,0,0,0
SetBuffer ImageBuffer(m)
Color 255,255,255
Oval 0,0,w,h,True
LockBuffer ImageBuffer(m)
For y=0 To h-1
For x=0 To w-1
pff = ReadPixelFast(x,y)
;GetColor x,y
If getr(pff) > 0 Then
;If ColorRed() > 0 Then
;Color 0,0,0
WritePixelFast x,y,getrgb(0,0,0)
;Plot x,y
Else
;Color 255,255,255
;Plot x,y
WritePixelFast x,y,getrgb(255,255,255)
End If
Next:Next
UnlockBuffer ImageBuffer(m)
MaskImage mm,255,255,255
SetBuffer ImageBuffer(bmap empmap)
GrabImage mm,xb,yb
SetBuffer ImageBuffer(mm)
For y=0 To ImageHeight(mm);
For x=0 To ImageWidth(mm)
GetColor x,y
cr# = ColorRed()
cg# = ColorGreen()
cb# = ColorBlue()
cr#=cr#*div#
cg#=cg#*div#
cb#=cb#*div#
If cr<0 Then cr=0
If cg<0 Then cg=0
If cb<0 Then cb=0
If cr>255 Then cr=255
If cg>255 Then cg=255
If cb>255 Then cb=255

;If aa<255
Color cr,cg,cb
Plot x,y

;End If

Next:Next
DrawImage m,0,0
;SetBuffer CanvasBuffer(can)
SetBuffer ImageBuffer(bmap empmap)
DrawImage mm,xb,yb
FreeImage m
FreeImage mm
End Function

Function flashyblendoval(this.shape)

; For this.shape = Each shape `
If this p = 1 Then
x=thisx
y=thisy
w=thisw
h=thish
div = thisdiv
flashyoval this,x,y,w,h,x,y,div
End If
; Next

SetBuffer ImageBuffer(bmapeffectmap)
For that.shape = Each shape
Select that p
Case 1
DrawImage thatmap,thatx,thaty
Case 2
drawcircrect that.shape
End Select
Next
;bmapeffectmap = CopyImage(bmap empmap)

End Function


Function ovalmouserect()
Color 255,255,0
mx = editorx1
my = editory1
mw = editorx2 - editorx1
mh = editory2 - editory1
;
If editorx2 < editorix1 Then mx = editorx2 : mw = editorx1 - editorx2
If editory2 < editoriy1 Then my = editory2 : mh = editory1 - editory2
;
Oval mx,my,mw,mh,False
Rect mx,my,mw,mh,False

End Function
Function setmouse()
a = editorx1
b = editory1
c = editorx2
d = editory2
e = editorw
f = editorh
;

;
End Function

;Standard functions for converting colour to RGB values, for WritePixelFast and ReadPixelFast
Function GetRGB(r,g,b)
Return b Or (g Shl 8) Or (r Shl 16)
End Function

Function GetR(rgb)
    Return rgb Shr 16 And %11111111
End Function

Function GetG(rgb)
Return rgb Shr 8 And %11111111
End Function

Function GetB(rgb)
Return rgb And %11111111
End Function

Function shapecount()
For this.shape = Each shape
cnt=cnt+1
Next
Return cnt
End Function

Function drawcircrect(this.shape)

Color 255,255,0
mx = thisx
my = thisy
mw = thisw
mh = thish
;If editorx2 < editorix1 Then mx = editorx2 : mw = editorx1 - editorx2
;If editory2 < editoriy1 Then my = editory2 : mh = editory1 - editory2
;
Oval mx,my,mw,mh,False
Rect mx,my,mw,mh,False

End Function

Function loadfoto(im$)
bmapim1 = LoadImage(im$)
End Function

Function dofoto(soort)
; Local myim = CreateImage(GadgetWidth(can),GadgetHeight(can))
ResizeImage bmapim1,GadgetWidth(can),600
bmapim = CopyImage(bmapim1)
SetBuffer ImageBuffer(bmapim)
For x=0 To ImageWidth(bmapim)
For y=0 To ImageHeight(bmapim)
k = getcolormapcolor(x,y,1)
pff = ReadPixel(x,y)
z1 = getr(pff)
z2 = getg(pff)
z3 = getb(pff)
z1=z1+k
z2=z2+k
z3=z3+k
If z1<0 Then z1=0
If z2<0 Then z2=0
If z3<0 Then z3=0
If z1>255 Then z1=255
If z2>255 Then z2=255
If z3>255 Then z3=255
;WritePixel x,y,getrgb(z1,z2,z3)
Color z1,z2,z3
Rect x-Rand(1,5),y-3,3,3,True
Next:Next
;Goto a11
For x=0 To ImageWidth(bmapim)
For y=0 To ImageHeight(bmapim)
SetBuffer ImageBuffer(bmapgridmap)
pff = ReadPixel(x,y)
z1 = getr(pff)
z2 = getg(pff)
z3 = getb(pff)
;
SetBuffer ImageBuffer(bmapim1)
pf = ReadPixel(x,y)
zz1 = getr(pf)
zz2 = getg(pf)
zz3 = getb(pf)
;
z1 = z1 / 100
z2 = z2 / 100
z3 = z3 / 100
zz1 = zz1 / 100
zz2 = zz2 / 100
zz3 = zz3 / 100
;
soort = 77
Select soort
Case 1
f1 = z1*30+zz1*70
f2 = z2*30+zz2*70
f3 = z3*30+zz3*70
Case 2
f1 = z1*50+zz1*50
f2 = z2*50+zz2*50
f3 = z3*50+zz3*50
Case 3
f1 = z1*190+zz1*10
f2 = z2*190+zz2*10
f3 = z3*190+zz3*10

Case 99
f1 = zz1 * 100
f2 = zz2 * 100
f3 = zz3 * 100
Default
f1 = z1*50+zz1*50
f2 = z2*50+zz2*50
f3 = z3*50+zz3*50
End Select
;
;f1 = getr(f1)
;f2 = getg(f2)
;f3 = getb(f3)
;
If f1>215 Then f1=215
If f2>215 Then f2=215
If f3>215 Then f3=215
If f1<0 Then f1=0
If f2<0 Then f2=0
If f3<0 Then f3=0


WritePixel x,y,getrgb(f1,f2,f3)
Next:Next
.a11
End Function

Comments : none...
Print
Go Up Pages1
User actions