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)

Postby kiyotewolf » Apr 03, 2011 21:27

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 longint

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 sub
vdecampo
Posts: 2982
Joined: Aug 07, 2007 23:20
Location: Maryland, USA
Contact:

Postby vdecampo » Apr 03, 2011 22:21

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:

Postby kiyotewolf » Apr 03, 2011 22:55

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

Postby Richard » Apr 03, 2011 23:14

@ 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 Sub

Screen 19
RoundBox (100, 100, 700, 500, 15, 0)

Sleep

kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Postby kiyotewolf » Apr 03, 2011 23:16

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

Postby Richard » Apr 04, 2011 0:25

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

Postby dodicat » Apr 04, 2011 21:47

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 squares
Sub 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 x
End Sub
'EXAMPLES
dim as integer xres,yres
 screen 19,32
 screeninfo xres,yres
for y as integer=0 to yres
 line(0,y)-(xres,y),rgb(rnd*200,rnd*200,rnd*200), 'paint random background
next 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

Postby rolliebollocks » Apr 04, 2011 22:41

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

Postby dodicat » Apr 04, 2011 23:46

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 x
End Sub

dim as integer x1,y1,x2,y2
screen 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:

Postby kiyotewolf » Apr 05, 2011 5:12

"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!

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests