## LINE (foo,bar)-(bar,foo), B(rounded edges)

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

### LINE (foo,bar)-(bar,foo), B(rounded edges)

Code: Select all

`declare sub RoundBox (xin as integer, yin as integer, xin2 as integer, yin2 as integer,clrin as longint, eraser as integer = 0)sub RoundBox (xin as integer, yin as integer, xin2 as integer, yin2 as integer,clrin as longint, eraser as integer = 0)dim xin3 as integer, yin3 as integer, xin4 as integer, yin4 as integer, clrin2 as longintxin3 = xinxin4 = xin2if xin3 > xin4 then swap xin3, xin4yin3 = yinyin4 = yin2if yin3 > yin4 then swap yin3, yin4if eraser then  clrin2 = rgb(0,0,0)    else  clrin2 = clrinend if    line(xin3 + 1, yin3) - (xin4 - 1, yin3), clrin2 'top of box  line(xin3, yin3 + 1) - (xin3, yin4 - 1), clrin2 'left side of box  line(xin3 + 1, yin4) - (xin4 - 1, yin4), clrin2 'bottom of box  line(xin4, yin3 + 1) - (xin4, yin4 - 1), clrin2 'left side of box  'fill corners so it's rounded & pretty  pset(xin3 + 1, yin3 + 1), clrin2  pset(xin3 + 1, yin4 - 1), clrin2  pset(xin4 - 1, yin3 + 1), clrin2  pset(xin4 - 1, yin4 - 1), clrin2end sub`
vdecampo
Posts: 2982
Joined: Aug 07, 2007 23:20
Location: Maryland, USA
Contact:
Here is mine from a while ago...

Drawing Rounded Rectangles

If you want to compare notes! ;)

-Vince
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:
I'm going to put together routines which draw little colored ASCII art of rounded boxes, along with glyphs/icons, and lets you typeface text in, like a beautiful premade button for web pages.

I hate posting ugly plain HTML, cause it's never pretty.
In Firefox, I can embed images directly into the HTML via a special BASE64 flavored tag, as an embedded image, or as part of a hyperlink.

When I add links to my web pages, I want a little icon of a disk, or whatever, along with a pretty bow on top.

~Kiyote!

Thanks for posting your version of the same thing. I will compare notes in due time.
Richard
Posts: 2984
Joined: Jan 15, 2007 20:44
Location: Australia
@ kiyotewolf. RGB() is a Uinteger not a Longint.

Code: Select all

`Declare Sub RoundBox(Byval xin As Integer, Byval yin As Integer,_Byval xin2 As Integer, Byval yin2 As Integer, Byval clrin As Uinteger,_Byval eraser As Integer = 0)Sub RoundBox(_    Byval xin As Integer,_    Byval yin As Integer,_    Byval xin2 As Integer,_    Byval yin2 As Integer,_    Byval clrin As Uinteger,_    Byval eraser As Integer = 0)        Dim As Integer xin3, yin3, xin4, yin4    Dim As Uinteger clrin2        xin3 = xin    xin4 = xin2    If xin3 > xin4 Then Swap xin3, xin4    yin3 = yin    yin4 = yin2    If yin3 > yin4 Then Swap yin3, yin4        If eraser Then        clrin2 = Rgb(0,0,0)    Else        clrin2 = clrin    End If        Line(xin3 + 1, yin3) - (xin4 - 1, yin3), clrin2 'top of box    Line(xin3, yin3 + 1) - (xin3, yin4 - 1), clrin2 'left side of box    Line(xin3 + 1, yin4) - (xin4 - 1, yin4), clrin2 'bottom of box    Line(xin4, yin3 + 1) - (xin4, yin4 - 1), clrin2 'left side of box    'fill corners so it's rounded & pretty    Pset(xin3 + 1, yin3 + 1), clrin2    Pset(xin3 + 1, yin4 - 1), clrin2    Pset(xin4 - 1, yin3 + 1), clrin2    Pset(xin4 - 1, yin4 - 1), clrin2    End SubScreen 19RoundBox (100, 100, 700, 500, 15, 0)Sleep`
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:
Basically an unsigned LONGINT.
I will try to modify how I write stuff in the future on that note.
Richard
Posts: 2984
Joined: Jan 15, 2007 20:44
Location: Australia
There need be no 64 bit LONGINT or ULONGINT involved.
RGB returns a unsigned integer, UINTEGER, since it is used with 32 bit graphics.
dodicat
Posts: 6231
Joined: Jan 10, 2006 20:30
Location: Scotland
Hi kiyotewolf
I've thrashed out a more general rounded square just using geometry, I thought that it would be plane sailing, but I ended up farting about to get it running.
1) Independent of background colour
2) Draws the square in the same direction of the input points.
3) Always draws a square, never a rectangle.
4) Can draw from pure square to pure circle, depending on grade parameter.
5) Always fills the square with required colour.
6) Can draw over previous squares with no adverse effects.

It's just a little fiddle about really, probably not much use for anything.

Code: Select all

`'Blunt squaresSub boxfill(x1 As Single,y1 As Single,x2 As Single,y2 As Single,col As Uinteger,grade as single)    if grade>1 then grade=1:if grade<0 then grade=0    Dim As Single dx=x2-x1,dy=y2-y1,length=Sqr(dx*dx+dy*dy),ratio=.5*grade,r=.5*length    dim as single cx,cy,cenx=(x1+x2)/2,ceny=(y1+y2)/2,rad=ratio*length        Swap dx,dy:dx=-dx    Dim As Single p1x=x1+dx/2,p1y=y1+dy/2    Dim As Single p2x=x1-dx/2,p2y=y1-dy/2    Dim As Single p3x=x2+dx/2,p3y=y2+dy/2    Dim As Single p4x=x2-dx/2,p4y=y2-dy/2    Dim As Uinteger c=Rgb(255,255,254)    dim as single mm=(1-ratio/.5)    dim as single mp1x,mp1y,mp2x,mp2y,mp3x,mp3y,mp4x,mp4y    For x As Integer=1 To 2        cx=p1x+(cenx-p1x)*rad/r:cy=p1y+(ceny-p1y)*rad/r        circle(cx,cy),rad*1,c,,,,f        cx=p2x+(cenx-p2x)*rad/r:cy=p2y+(ceny-p2y)*rad/r        circle (cx,cy),rad*1,c,,,,f        cx=p3x+(cenx-p3x)*rad/r:cy=p3y+(ceny-p3y)*rad/r        circle(cx,cy),rad*1,c,,,,f        cx=p4x+(cenx-p4x)*rad/r:cy=p4y+(ceny-p4y)*rad/r        circle(cx,cy),rad*1,c,,,,f        mp1x=(p1x+p2x)/2:mp1y=(p1y+p2y)/2        line (mp1x+mm*(p1x-mp1x),mp1y+mm*(p1y-mp1y))-(mp1x-mm*(p1x-mp1x),mp1y-mm*(p1y-mp1y)),c        mp2x=(p3x+p4x)/2:mp2y=(p3y+p4y)/2        line (mp2x+mm*(p3x-mp2x),mp2y+mm*(p3y-mp2y))-(mp2x-mm*(p3x-mp2x),mp2y-mm*(p3y-mp2y)),c        mp3x=(p1x+p3x)/2:mp3y=(p1y+p3y)/2        line (mp3x+mm*(p3x-mp3x),mp3y+mm*(p3y-mp3y))-(mp3x-mm*(p3x-mp3x),mp3y-mm*(p3y-mp3y)),c        mp4x=(p2x+p4x)/2:mp4y=(p2y+p4y)/2        line (mp4x+mm*(p4x-mp4x),mp4y+mm*(p4y-mp4y))-(mp4x-mm*(p4x-mp4x),mp4y-mm*(p4y-mp4y)),c        Paint(cenx,ceny),c,c       if ratio>=.24 then           dim z as single=.025            paint(mp1x +z*(cenx-mp1x),mp1y+z*(ceny-mp1y)),c,c            paint(mp2x +z*(cenx-mp2x),mp2y+z*(ceny-mp2y)),c,c            paint(mp3x +z*(cenx-mp3x),mp3y+z*(ceny-mp3y)),c,c            paint(mp4x +z*(cenx-mp4x),mp4y+z*(ceny-mp4y)),c,c            end if        c=col    Next xEnd Sub'EXAMPLESdim as integer xres,yres screen 19,32 screeninfo xres,yresfor y as integer=0 to yres line(0,y)-(xres,y),rgb(rnd*200,rnd*200,rnd*200), 'paint random backgroundnext y'usage boxfill(firstx,firsty,secondx,secondy,colour,grade)'n.b. 0<= grade<=1, 0 makes square box, 1 makes a circle boxfill(100,110,300,110,rgb(0,200,0),.2) boxfill(350,110,400,130,rgb(200,0,0),.5) boxfill(500,110,550,150,rgb(0,0,200),.75) boxfill(600,120,700,220,rgb(0,0,0),.1)  'square to circle for x as integer=0 to 100     boxfill(100+3*x,350-x,300+3*x,450-x,rgb(2.5*x,0,255-2.5*x),x/100)     next x     sleep     `
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
Hey Dodicat!

That's awesome. Can you explain the algo by which you transmorph a square into a circle, or provide a link or something. I'd love to make one of my own. That's awesome!
dodicat
Posts: 6231
Joined: Jan 10, 2006 20:30
Location: Scotland
rolliebollocks wrote:Hey Dodicat!

Can you explain the algo by which you transmorph a square into a circle, or provide a link or something. I'd love to make one of my own.

Hi Rollie~
I needed a boxfill macro for the text rotator because line ()-(),~,BF only draws horizontal boxes which is no good for rotated fonts, a little box replaces a pixel when the character is enlarged, the bigger the enlargment, the bigger the box.
I just modified the boxfill, if you comment out the paint bits in the previous code, you'll see the skeleton.It took a bit of messing around to draw exact tangents from circle to circle, Must've smoked at least 10 ciggies at this stage.

Here's the boxfill macro made into a sub.
It simply guarantees a square box in the direction of the underlying line, each side is the same length as the line.
If the direction numbers of a line are dx and dy, then a perpendicular line has direction numbers dy and -dx.
Also, the boxes are painted twice, first time in white, so that paint goes right to the edges on the second run.

Code: Select all

`Sub boxfill(x1 As Single,y1 As Single,x2 As Single,y2 As Single,col As Uinteger)    Dim As Single dx=x2-x1,dy=y2-y1    Swap dx,dy:dx=-dx    Dim As Single p1x=x1+dx/2,p1y=y1+dy/2    Dim As Single p2x=x1-dx/2,p2y=y1-dy/2    Dim As Single p3x=x2+dx/2,p3y=y2+dy/2    Dim As Single p4x=x2-dx/2,p4y=y2-dy/2    Dim As Uinteger c=Rgb(255,255,254)    For x As Integer=1 To 2        line(p1x,p1y)-(p2x,p2y),c        Line(p3x,p3y)-(p4x,p4y),c        Line(p1x,p1y)-(p3x,p3y),c        Line(p2x,p2y)-(p4x,p4y),c        Paint((p1x+p2x+p3x+p4x)/4,(p1y+p2y+p3y+p4y)/4),c,c        c=col    Next xEnd Subdim as integer x1,y1,x2,y2screen 19,32    do        screenlock    x1=Rnd*700:x2=x1+Rnd*100    y1=Rnd*500:y2=y1+Rnd*100    boxfill(x1,y1,x2,y2,Rgb(Rnd*255,Rnd*255,Rnd*255))    screenunlock    sleep 1,1    loop until inkey=chr(27)Sleep`
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:
"Must've smoked at least 10 ciggies at this stage." I need to invest in some cigarettes for myself again. I'm a casual smoker, and I miss my once every 3 months nicotine fix.

That's really clever work you've got here Dodicat. To sit there through 10 cigs just to get it to work, that's just awesome. You're as dedicated as I am if not more.

~Kiyote!