|
Post by Rod on Apr 26, 2020 9:11:03 GMT
OK, back at work on SpriteCreator. New task is a blended fill. Blend from 100% color A to 100% color B in say 64 steps. So I can see that going left to right it is the difference between the RGB contents / 64 to give a color delta. Then x times delta defines the color of each line.
Now to make it super complex I introduce an angle. So now the blend can be horizontal, vertical, 45o etc etc. So I need two vector deltas?
|
|
|
Post by B+ on Apr 26, 2020 15:14:30 GMT
OK, back at work on SpriteCreator. New task is a blended fill. Blend from 100% color A to 100% color B in say 64 steps. So I can see that going left to right it is the difference between the RGB contents / 64 to give a color delta. Then x times delta defines the color of each line. Now to make it super complex I introduce an angle. So now the blend can be horizontal, vertical, 45o etc etc. So I need two vector deltas? Great idea and variation! How are you reading pixel colors to find borders, LB's .dll or the slow pixel reading through .bmp file point reads (which probably is fine for sprite editor) or doing something else?
|
|
|
Post by Rod on Apr 26, 2020 16:29:33 GMT
Currently the Color array is held in a simple array(x,y) which holds the color string, “255 255 255” for example. I am avoiding .dll and api because we are less likely to have them available in v5
So I have a two dimensional array holding color strings which define a 64x64 pixels.
It’s quite fast actually and just as fast as getpixel()
So I am also using the flood fill routine from Rosetta Stone which recursively fills an area of targeted color.
But the color is driven by x,y and should fade from color a to color b in day 64 steps:
I should code a small working example.
|
|
|
Post by B+ on Apr 26, 2020 18:38:57 GMT
Ah! the virtual screen technique, you track the lines and circles you make by recording the colors drawn in an 2d array as a virtual screen.
|
|
|
Post by Rod on Apr 26, 2020 19:06:24 GMT
Yes and a similar array as the undo function. All works well. I can get left to right color fading working but I need to be able to color fade st any angle. I will try and get a small demo up tomorrow.
|
|
|
Post by B+ on Apr 26, 2020 19:29:45 GMT
I finally found an old favorite that uses a vScreen array to save colors with a vLine Routine for drawing lines and recording colors on vScreen. It is a great way to get around needing old QB POINT function. Here is a demo of that plus review of one of my favorites: 'Persian Carpets.txt for Just Basic v1.01 [B+=MGA] 2017-10-01 'based on orig by Anne M Burns '2017-10-04 bi-lateral symmetry fixed! thanks tsh73 for help! '2017-10-05 add varaibles report at bottom of screen, ask for help finding bad combos
global H$, XMAX, YMAX H$ = "gr" : XMAX = 532 : YMAX = 562
nomainwin
WindowWidth = XMAX + 8 WindowHeight = YMAX + 32 UpperLeftX = (1200 - XMAX) / 2 UpperLeftY = (700 - YMAX) / 2
open "Persian Carpets" for graphics_nsb_nf as #gr #gr "setfocus" #gr "trapclose quit" #gr "down" #gr "fill black"
xo = (XMAX - 512) / 2 : yo = (532 - 512) / 2 c = 3 while 1 #gr "fill black" Dim vScreen(XMAX, YMAX) lft = xo : rght = 512 + xo : top = yo: bot = 512 + yo a = int(rnd(0)*16) 'a = c b = int(rnd(0)*16) 'b = c c = int(rnd(0)*16) #gr "color black" call ctext 552, " b1 = ";a;", b2 = ";b;", and c (shifter) = ";c;" " call vLINE lft+1, top, rght-1, top, a call vLINE lft+1, bot, rght-1, bot, a call vLINE lft, top, lft, bot, b call vLINE rght, top, rght, bot, b call DetermineColr lft, rght, top, bot, c call pause 2500 'c = c + 1 : if c = 16 then c = 0
wend
' Determine the color based on function f sub DetermineColr lft, rght, top, bot, a scan IF lft < rght -2 THEN '<<<< if you like intricate paterns go -1, for speed go -5 c = findClr(lft, rght, top, bot, a) middlecol = int((lft + rght) / 2) middlerow = int((top + bot) / 2) call vLINE lft, middlerow, rght, middlerow, c call vLINE middlecol, top, middlecol, bot, c call DetermineColr lft, middlecol, top, middlerow, a call DetermineColr middlecol, rght, top, middlerow, a call DetermineColr lft, middlecol, middlerow, bot, a call DetermineColr middlecol, rght, middlerow, bot, a else exit sub end if end sub
function findClr(lft, rght, top, bot, a) 'dang no POINT(x, y) oh well... p = (vScreen(lft, top) + vScreen(rght, top) + vScreen(lft, bot) + vScreen(rght, bot))*33 'Try values of b = 4 or b = 7 'b = 4 'findClr = int(p + a) mod 16 'too much 'findClr = int(p/13 + a) mod 8 * 2 'less is more, yellow, green, red, brown theme findClr = int(p/13 + a) mod 8 * 2 + 1 'less is more, blue and white theme end function
'============================== sets drawing #gr "flush" wait
sub QBcolr colrNum select case colrNum case 0 : #gr "color black" case 1 : #gr "color darkblue" case 2 : #gr "color brown" case 3 : #gr "color darkcyan" case 4 : #gr "color darkred" case 5 : #gr "color darkpink" case 6 : #gr "color darkgreen" case 7 : #gr "color lightgray" case 8 : #gr "color darkgray" case 9 : #gr "color blue" case 10 : #gr "color green" case 11 : #gr "color cyan" case 12 : #gr "color red" case 13 : #gr "color pink" case 14 : #gr "color yellow" case 15 : #gr "color white" end select end sub
sub vLINE x0, y0, x1, y1, QBc 'record our line on the virtual screen if x0 = x1 then if y0 > y1 then start = y1 : fini = y0 else start = y0 : fini = y1 for i = start+1 to fini-1 vScreen(x0, i) = QBc next else if x0 > x1 then start = x1 : fini = x0 else start = x0 : fini = x1 for i = start+1 to fini-1 vScreen(i, y0) = QBc next end if call QBcolr QBc #gr "line ";x0;" ";y0;" ";x1;" ";y1 'add 1 to end point? end sub
sub quit H$ close #H$ end end sub
sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
sub stext x, y, message$ 'note: have to reset fore or back color after ink #gr "place ";x;" ";y;";|";message$ end sub
sub ctext y, message$ 'uses const XMAX and sub stext call stext (XMAX - len(message$) * 6) /2, y, message$ end sub
|
|
|
Post by Rod on Apr 27, 2020 9:04:30 GMT
Thanks I will have a browse at that. This is an extract of the blended fill as it is now. Very rough and buggy. The ultimate aim is to take X,Y and angle A and fill any target color shaded in the direction of angle A.
Right now this just shades right to left and not even very well! There may be a much better way to achieve this.
dim frame$(64,64) WindowWidth = 500 WindowHeight = 500 UpperLeftX = int((DisplayWidth-WindowWidth)/2) UpperLeftY = 10 graphicbox #1.gb, 10, 30, 386, 386 open "Sprite Creator" for graphics_nsb_nf as #1 #1 "trapclose [quit]"
global fcol$,bcol$,pix,npix fcol$="255 255 0" bcol$="0 255 255" pix=6 npix=64
[clear] #1.gb "cls ; down ; fill black ; flush" redim frame$(npix,npix) for x=0 to npix-1 for y= 0 to npix-1 frame$(x,y)="0 0 0" next next
[blendfill] 'get the box/pixel clicked 'set the angle x=int(MouseX/pix) y=int(MouseY/pix) x=63 y=31 a=90 'get target color tcol$=frame$(x,y) 'remember original forecolor ocol$=fcol$
'color delta Ra=val(word$(fcol$,1," ")) Ga=val(word$(fcol$,2," ")) Ba=val(word$(fcol$,3," ")) Rb=val(word$(bcol$,1," ")) Gb=val(word$(bcol$,2," ")) Bb=val(word$(bcol$,3," ")) Rd=(Ra-Rb)/npix Gd=(Ga-Gb)/npix Bd=(Ba-Bb)/npix
for n= 0 to npix-1 print Ra;" ";Ga;" ";Ba,Rb;" ";Gb;" ";Bb, (Ra-Rb)/npix;" ";(Ga-Gb)/npix;" ";(Ba-Bb)/npix,int(Ra-n*Rd);" ";int(Ga-n*Gd);" ";int(Ba-n*Bd) next nul=blendfill(x,y,Ra,Ga,Ba,Rd,Gd,Bd,tcol$) null=color(ocol$) wait
[quit] close #1 end
function color(c$) fcol$=c$ #1.gb "backcolor ";fcol$;" ; color ";fcol$ end function
function paint(x,y) 'clips and paints pixel square to size, updating frame array if x>=0 and x<npix and y>=0 and y<npix then #1.gb "place ";x*pix;" ";y*pix #1.gb "boxfilled ";x*pix+pix;" ";y*pix+pix frame$(x,y)=fcol$ end if end function
function blendfill(x,y,Ra,Ga,Ba,Rd,Gd,Bd,tcol$)
'recursive flood fill function see rosetta code if tcol$ = fcol$ then exit function if x>=npix or y >=npix or x<0 or y<0 then exit function if frame$(x,y) <> tcol$ then exit function else null=color(str$(int(Ra-x*Rd))+" "+str$(int(Ga-x*Gd))+" "+str$(int(Ba-x*Bd))) null=paint(x,y) end if nul=blendfill(x,y+1,Ra,Ga,Ba,Rd,Gd,Bd,tcol$) nul=blendfill(x,y-1,Ra,Ga,Ba,Rd,Gd,Bd,tcol$) nul=blendfill(x-1,y,Ra,Ga,Ba,Rd,Gd,Bd,tcol$) nul=blendfill(x+1,y,Ra,Ga,Ba,Rd,Gd,Bd,tcol$)
end function
Update with less buggy version
|
|
|
Post by B+ on Apr 27, 2020 16:05:10 GMT
Hi Rod, Nice start, curious why you chose function instead of sub which forces dummy variables you don't use (yet?). I just realized my vLine for above demo is only for vertical or horizontal lines. I did work up code for drawing circles and lines for recording in a virtual screen array (for a 'sprite' editor in Naalaa). Maybe I can dig up the code if you need an even way to distribute the increments in an angled line drawing. It's probably on Rosetta Code or John T is likely to have worked this exercise as well I also have a MidInk function that mixes the color blend according to the fraction you are between one color on one end and another on the other, using RGB's. So going down a line in any direction is just a fraction of distance to start over dist start to end. Ah but it looks like you have that mixed in with drawing.
|
|
|
Post by Rod on Apr 28, 2020 12:11:23 GMT
Ok, some progress. This handles most angles but has a bug or two I need to better understand. It is just a habit using functions, mostly I keep subs for large digressions. Nul= is no more typing than Call.
So I have yet to integrate this to the SpriteCreator code but it looks promising. Mathematicians will recoil in horror but I just used an xy vector which I "normalised" so the xy pair stay within 1 and then used those in combination with the color delta. Et Voila.
nomainwin dim frame$(64,64) WindowWidth = 500 WindowHeight = 500 UpperLeftX = int((DisplayWidth-WindowWidth)/2) UpperLeftY = 10 graphicbox #1.gb, 10, 30, 386, 386 open "Sprite Creator" for graphics_nsb_nf as #1 #1 "trapclose [quit]"
global fcol$,bcol$,pix,npix fcol$="255 255 0" bcol$="0 255 255" pix=6 npix=64
[clear] #1.gb "cls ; down ; fill black ; flush" redim frame$(npix,npix) for x=0 to npix-1 for y= 0 to npix-1 frame$(x,y)="0 0 0" next next
[blendfill] 'set starting point x,y x=31 y=31
'set angle a=45 '225 has bug ,180 has bug
'get target color tcol$=frame$(x,y)
'remember original forecolor ocol$=fcol$
'color delta Ra=val(word$(fcol$,1," ")) Ga=val(word$(fcol$,2," ")) Ba=val(word$(fcol$,3," ")) Rb=val(word$(bcol$,1," ")) Gb=val(word$(bcol$,2," ")) Bb=val(word$(bcol$,3," ")) Rd=(Ra-Rb)/npix Gd=(Ga-Gb)/npix Bd=(Ba-Bb)/npix 'get vectors Ax=1*cos(a/57.29577951) Ay=1*sin(a/57.29577951) 'normalise Axx=Ax/(Ax+Ay)*Ax Ayy=Ay/(Ax+Ay)*Ay 'blend fill from color A to color B at angle A nul=blendfill(x,y,Ra,Ga,Ba,Rd,Gd,Bd,Axx,Ayy,tcol$)
'set original forecolor null=color(ocol$) wait
[quit] close #1 end
function color(c$) fcol$=c$ #1.gb "backcolor ";fcol$;" ; color ";fcol$ end function
function paint(x,y) 'clips and paints pixel square to size, updating frame array if x>=0 and x<npix and y>=0 and y<npix then #1.gb "place ";x*pix;" ";y*pix #1.gb "boxfilled ";x*pix+pix;" ";y*pix+pix frame$(x,y)=fcol$ end if end function
function blendfill(x,y,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$)
'recursive flood fill function see rosetta code if tcol$ = fcol$ then exit function if x>=npix or y >=npix or x<0 or y<0 then exit function if frame$(x,y) <> tcol$ then exit function else null=color(str$(int(Ra-(x*Ax*Rd+y*Ay*Rd)))+" "+str$(int(Ga-(x*Ax*Gd+y*Ay*Gd)))+" "+str$(int(Ba-(x*Ax*Bd+y*Ay*Bd)))) null=paint(x,y) end if nul=blendfill(x,y+1,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$) nul=blendfill(x,y-1,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$) nul=blendfill(x-1,y,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$) nul=blendfill(x+1,y,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$)
end function
|
|
|
Post by Rod on Apr 28, 2020 13:19:14 GMT
Ah celebrating too soon. I see my color values are way off. Only thanks to Just BASIC's tolerance am I getting anything. This line just after the else in the blendfill function shows the problem. Surprised it worked at all!
print x,y,str$(int(Ra-(x*Ax*Rd+y*Ay*Rd)))+" "+str$(int(Ga-(x*Ax*Gd+y*Ay*Gd)))+" "+str$(int(Ba-(x*Ax*Bd+y*Ay*Bd)))
|
|
|
Post by Rod on Apr 29, 2020 7:46:08 GMT
Right, having slept on it I realised that I needed to use ABS() when creating Axx and Ayy. Now my numbers are in the range and the bugs have gone. Quite pleased with this, its a useful fill effect. Pesky angles! still bugged.
nomainwin dim frame$(64,64) WindowWidth = 500 WindowHeight = 500 UpperLeftX = int((DisplayWidth-WindowWidth)/2) UpperLeftY = 10 graphicbox #1.gb, 10, 30, 386, 386 open "Sprite Creator" for graphics_nsb_nf as #1 #1 "trapclose [quit]"
global fcol$,bcol$,pix,npix fcol$="255 255 0" bcol$="0 255 255" pix=6 npix=64
[clear] #1.gb "cls ; down ; fill black ; flush"
[blendfill] 'set starting point x,y x=31 y=31
'set angle a=180 '225 has bug ,180 has bug
'get target color tcol$=frame$(x,y)
'remember original forecolor ocol$=fcol$
'color delta Ra=val(word$(fcol$,1," ")) Ga=val(word$(fcol$,2," ")) Ba=val(word$(fcol$,3," ")) Rb=val(word$(bcol$,1," ")) Gb=val(word$(bcol$,2," ")) Bb=val(word$(bcol$,3," ")) Rd=(Ra-Rb)/npix Gd=(Ga-Gb)/npix Bd=(Ba-Bb)/npix 'get vectors Ax=1*cos(a/57.29577951) Ay=1*sin(a/57.29577951) 'normalise Axx=abs(Ax/(Ax+Ay)*Ax) Ayy=abs(Ay/(Ax+Ay)*Ay)
'blend fill from color A to color B at angle A nul=blendfill(x,y,Ra,Ga,Ba,Rd,Gd,Bd,Axx,Ayy,tcol$)
'set original forecolor null=color(ocol$) wait
[quit] close #1 end
function color(c$) fcol$=c$ #1.gb "backcolor ";fcol$;" ; color ";fcol$ end function
function paint(x,y) 'clips and paints pixel square to size, updating frame array if x>=0 and x<npix and y>=0 and y<npix then #1.gb "place ";x*pix;" ";y*pix #1.gb "boxfilled ";x*pix+pix;" ";y*pix+pix frame$(x,y)=fcol$ end if end function
function blendfill(x,y,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$)
'recursive flood fill function see rosetta code if tcol$ = fcol$ then exit function if x>=npix or y >=npix or x<0 or y<0 then exit function if frame$(x,y) <> tcol$ then exit function else print x,y,str$(int(Ra-(x*Ax*Rd+y*Ay*Rd)))+" "+str$(int(Ga-(x*Ax*Gd+y*Ay*Gd)))+" "+str$(int(Ba-(x*Ax*Bd+y*Ay*Bd))) null=color(str$(int(Ra-(x*Ax*Rd+y*Ay*Rd)))+" "+str$(int(Ga-(x*Ax*Gd+y*Ay*Gd)))+" "+str$(int(Ba-(x*Ax*Bd+y*Ay*Bd)))) null=paint(x,y) end if nul=blendfill(x,y+1,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$) nul=blendfill(x,y-1,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$) nul=blendfill(x-1,y,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$) nul=blendfill(x+1,y,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$)
end function
|
|
|
Post by Rod on Apr 29, 2020 10:52:31 GMT
I have changed the normalise routine to this
'normalise Axx=Ax/(abs(Ax)+abs(Ay)) Ayy=Ay/(abs(Ax)+abs(Ay))
However it only works up to 90o above that it all goes pear shaped. I need to work on my attention span, I also should have read those trig books at high school!
|
|
|
Post by tsh73 on Apr 30, 2020 11:52:33 GMT
Hello there
I did something that might be of interest, I think I made a program that computes gradient color in any point given, by two base points (so (almost) any angle - I cut some corners and it supposed to die on vertical line - could be fixed as special case) and two base colors
It looks working so far
First it draws two base colors in base points then it connect them with linear gradient next it make 100 random point and for each point deduces a color - and draws small circle No, then wandering outside of base points interval color continue to change It color coordinate (R, G or B) clips over 0 or 255, this circle is outlined red.
It uses "vector 2d lib" library I made long ago (2013) - I need to find projection of a random point to a base line This is only place this library is used (surely) with some tinkering it could be coded without this library.
'linear gradient 'tsh73, April 2020 nomainwin open "test" for graphics_nsb_nf as #gr #gr "home; down; posxy cx cy; trapclose [quit]"
global clipped
R=30
x1 = R+int(rnd(1)*(2*cx-2*R)) y1 = R+int(rnd(1)*(2*cy-2*R))
x2 = R+int(rnd(1)*(2*cx-2*R)) y2 = R+int(rnd(1)*(2*cy-2*R))
print x1, y1, x2, y2
'make sure x1 < x2 if x1>x2 then tmp=x1:x1=x2:x2=tmp tmp=y1:y1=y2:y2=tmp end if print x1, y1, x2, y2
col1$= RandByte();" ";RandByte();" ";RandByte() col2$= RandByte();" ";RandByte();" ";RandByte()
#gr "size 1"
#gr "place ";x1;" ";y1 #gr "backcolor ";col1$ #gr "circlefilled ";R
#gr "place ";x2;" ";y2 #gr "backcolor ";col2$ #gr "circlefilled ";R
for x = x1 to x2 a=(x-x1)/(x2-x1) '0..1 y = linterp(y1, y2, a) col3$ = interpCol$(col1$, col2$, a) #gr "color ";col3$ #gr "line " ;x;" " ;y-10;" ";x;" ";y+10 next
nPt = 100 #gr "size 1" #gr "color black" R=7 for i = 1 to nPt 'random x = R+int(rnd(1)*(2*cx-2*R)) y = R+int(rnd(1)*(2*cy-2*R)) 'diagonal 'x = 2*cx/nPt*i 'y = x
base$= vectSub$(x2;" ";y2, x1;" ";y1) projectedPt$ = vectTangent$(vectSub$(x;" ";y, x1;" ";y1),base$) a = vectX(projectedPt$)/vectX(base$) 'need to preserve sign so vectLen will not do 'but as is, it will die in vertical lines (x of base$ is 0)
col3$ = interpCol$(col1$, col2$, a) if clipped then #gr "color red" else #gr "color black" end if #gr "backcolor ";col3$ #gr "place ";x;" ";y #gr "circlefilled ";R next
wait
[quit] close #gr end
function RandByte() RandByte = int(rnd(0)*255) end function
function interpCol$(col1$, col2$, a) for i = 1 to 3 interpCol$ = interpCol$;clip(linterp( val(word$(col1$, i)), val(word$(col2$, i)), a));" " next end function
function clip(c) 'limits to 0..255 clip=int(c) clipped=0 if clip <0 then clip = 0: clipped=1 if clip >255 then clip = 255: clipped=1 end function
function linterp(r1, r2, a) linterp = (1-a)*r1+a*r2 '0..1 goes from r1 to r2 end function
'================================= 'vector 2d lib 'vectors as "x y" pairs, to be splitted by Word$ 'by tsh73, Feb 2013 function vect$(x,y) vect$=x;" ";y end function
function vectX(v$) vectX=val(word$(v$,1)) end function
function vectY(v$) vectY=val(word$(v$,2)) end function
function vectLen(v$) x=val(word$(v$,1)) y=val(word$(v$,2)) vectLen=sqr(x*x+y*y) end function
function vectUnit$(v$) x=val(word$(v$,1)) y=val(word$(v$,2)) vectLen=sqr(x*x+y*y) vectUnit$=x/vectLen;" ";y/vectLen end function
function vectAdd$(v1$,v2$) x1=val(word$(v1$,1)) y1=val(word$(v1$,2)) x2=val(word$(v2$,1)) y2=val(word$(v2$,2)) vectAdd$=x1+x2;" ";y1+y2 end function
function vectSub$(v1$,v2$) x1=val(word$(v1$,1)) y1=val(word$(v1$,2)) x2=val(word$(v2$,1)) y2=val(word$(v2$,2)) vectSub$=x1-x2;" ";y1-y2 end function
function vectDotProduct(v1$,v2$) x1=val(word$(v1$,1)) y1=val(word$(v1$,2)) x2=val(word$(v2$,1)) y2=val(word$(v2$,2)) vectDotProduct=x1*x2+y1*y2 end function
function vectScale$(a,v$) 'a * vector v$ x=val(word$(v$,1)) y=val(word$(v$,2)) vectScale$=a*x;" ";a*y end function
function vectTangent$(v$,base$) n$=vectUnit$(base$) vectTangent$=vectScale$(vectDotProduct(n$,v$),n$) end function
function vectNorm$(v$,base$) vectNorm$=vectSub$(v$,vectTangent$(v$,base$)) end function
function vectAngle(v$) x=val(word$(v$,1)) y=val(word$(v$,2)) vectAngle=atan2(y,x) end function
function vectFromPolar$(rho, phi) vectFromPolar$=rho*cos(phi);" ";rho*sin(phi) end function
function vectRotate$(v$,alpha) x=val(word$(v$,1)) y=val(word$(v$,2)) rho=sqr(x*x+y*y) phi=atan2(y,x)+alpha vectRotate$=rho*cos(phi);" ";rho*sin(phi) end function
function dePi$(x) 'pure aestetics pi = acs(-1) dePi$=x/pi;"Pi" end function
'--------------------------- function atan2(y,x) pi = acs(-1) 'could be made global to save some ticks if x <> 0 then arctan = atn(y/x)
select case case x > 0 atan2 = arctan
case y>=0 and x<0 atan2 = pi + arctan
case y<0 and x<0 atan2 = arctan - pi
case y>0 and x=0 atan2 = pi / 2
case y<0 and x=0 atan2 = pi / -2 end select end function
|
|
|
Post by Rod on Apr 30, 2020 12:23:53 GMT
Thank you Anatoly. I will study the solution. I have had a few false starts but this code now hangs together and blends from one color to the next. It was the negative vector values that I found difficult to deal with. In the end I inverted x or y to get the desired outcome. There is probably a smarter maths routine.
nomainwin dim frame$(64,64) WindowWidth = 500 WindowHeight = 500 UpperLeftX = int((DisplayWidth-WindowWidth)/2) UpperLeftY = 10 graphicbox #1.gb, 10, 30, 386, 386 open "Sprite Creator" for graphics_nsb_nf as #1 #1 "trapclose [quit]"
global fcol$,bcol$,pix,npix fcol$="255 0 255" bcol$="0 255 0" pix=6 npix=64
[clear] #1.gb "cls ; down ; fill black ; flush"
[blendfill] 'set starting point x,y x=31 y=31
'set angle a=45
'get target color tcol$=frame$(x,y)
'get starting colors ocol$=fcol$
'get vectors Ax=1*cos(a/57.29577951) Ay=1*sin(a/57.29577951) 'normalise Axx=Ax/(abs(Ax)+abs(Ay)) Ayy=Ay/(abs(Ax)+abs(Ay))
'color delta Ra=val(word$(fcol$,1," ")) Ga=val(word$(fcol$,2," ")) Ba=val(word$(fcol$,3," ")) Rb=val(word$(bcol$,1," ")) Gb=val(word$(bcol$,2," ")) Bb=val(word$(bcol$,3," ")) Rd=(Rb-Ra)/npix Gd=(Gb-Ga)/npix Bd=(Bb-Ba)/npix
'blend from color A to color B at angle A nul=blendfill(x,y,Ra,Ga,Ba,Rd,Gd,Bd,Axx,Ayy,tcol$)
'set original forecolor null=color(ocol$) wait
[quit] close #1 end
function color(c$) fcol$=c$ #1.gb "backcolor ";fcol$;" ; color ";fcol$ end function
function paint(x,y) 'clips and paints pixel square to size, updating frame array if x>=0 and x<npix and y>=0 and y<npix then #1.gb "place ";x*pix;" ";y*pix #1.gb "boxfilled ";x*pix+pix;" ";y*pix+pix frame$(x,y)=fcol$ end if end function
function blendfill(x,y,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$)
'recursive flood fill function see rosetta code if tcol$ = fcol$ then exit function if x>=npix or y >=npix or x<0 or y<0 then exit function if frame$(x,y) <> tcol$ then exit function else
if Ay<0 and Ax>=0 then r$=str$(int(Ra+x*Ax*Rd+(npix-y)*abs(Ay)*Rd)) g$=str$(int(Ga+x*Ax*Gd+(npix-y)*abs(Ay)*Gd)) b$=str$(int(Ba+x*Ax*Bd+(npix-y)*abs(Ay)*Bd)) null=color(r$+" "+g$+" "+b$) end if if Ax<0 and Ay>=0 then r$=str$(int(Ra+(npix-x)*abs(Ax)*Rd+y*Ay*Rd)) g$=str$(int(Ga+(npix-x)*abs(Ax)*Gd+y*Ay*Gd)) b$=str$(int(Ba+(npix-x)*abs(Ax)*Bd+y*Ay*Bd)) null=color(r$+" "+g$+" "+b$) end if if Ay<0 and Ax<0 then r$=str$(int(Ra+(npix-x)*abs(Ax)*Rd+(npix-y)*abs(Ay)*Rd)) g$=str$(int(Ga+(npix-x)*abs(Ax)*Gd+(npix-y)*abs(Ay)*Gd)) b$=str$(int(Ba+(npix-x)*abs(Ax)*Bd+(npix-y)*abs(Ay)*Bd)) null=color(r$+" "+g$+" "+b$) end if if Ay>=0 and Ax>=0 then r$=str$(int(Ra+(x*Ax*Rd+y*Ay*Rd))) g$=str$(int(Ga+(x*Ax*Gd+y*Ay*Gd))) b$=str$(int(Ba+(x*Ax*Bd+y*Ay*Bd))) null=color(r$+" "+g$+" "+b$) end if
null=paint(x,y) end if nul=blendfill(x,y+1,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$) nul=blendfill(x,y-1,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$) nul=blendfill(x-1,y,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$) nul=blendfill(x+1,y,Ra,Ga,Ba,Rd,Gd,Bd,Ax,Ay,tcol$)
end function
|
|
|
Post by Rod on Apr 30, 2020 12:31:47 GMT
Nice demo Anatoly, vector maths, my favourite . Works well. So that was a lot of effort to shade a few sprite pixels! Never mind, it filled a week.
|
|