FBB - FreeBasic Bézier

[Pitto]

Hi all,

FBB is an utility for learning the use of Bézier tool, a highly used tool in vector graphic programs.
Command and workarea will be pretty similar to mainstream vector editing programs.



It uses a single linked list to store points data, and an implementation of De Casteljau algorithm to render curves.
At the moment it's possible to draw only one path.

Here's the source (ver. 0.01): https://github.com/Pitto/FBB

A video where the official logo of FreeBasic is vectorized using this utility: https://youtu.be/yXZn_4P1ICA

FAST GUIDE

Left click to set a point;
Left click + drag to pull a curve handle;
Press ALT while drag to set a cuspid curve.

Kwown bugs:
If the mouse goes outside the window a curve is generated from top left corner, doesn't happen when in fullscreen mode.

I wish implement more functions as time allows (SVG export is on top of To Do list).
Any feedback is always welcome :)

[ike]

Nice work. But if you wish to continue work on this I recommend you to switch to FLTK lib (find it on this forum)

It has good drawing routines and then you can have real windows program

Look how easy is to draw and control events:

Code: Select all


#include once "fltk-c.bi"

function DrawCB cdecl (byval self as any ptr) as long
  dim as integer x  =  Fl_WidgetGetX(self)
  dim as integer y  =  Fl_WidgetGetY(self)
  dim as integer x2 =x+Fl_WidgetGetW(self)
  dim as integer y2 =y+Fl_WidgetGetH(self)

  DrawSetRGBColor 255,0,0
  for xx as integer = x to x2 step 30
    DrawYXLine xx,y,y2
  next
  DrawSetColor FL_BLUE
  for yy as integer = y to y2 step 30
    DrawXYLine x,yy,x2
  next
  DrawSetColor FL_GREEN
  DrawSetLineStyle FL_SOLID or FL_CAP_ROUND,3
  DrawRect(x,y,x2-x,y2-y)
  return 1
end function



FUNCTION BoxHandle CDECL (self AS ANY PTR, event AS Fl_Event) AS INTEGER   
DIM AS INTEGER butt = Fl_EventButton()
DIM AS LONG CT =  Fl_EventCtrl()
DIM AS LONG ALT =  Fl_EventAlt()
DIM AS LONG SFT = Fl_EventShift()
? "KEYS:",ct, alt, sft, butt
? "XY:", Fl_EventX(), Fl_EventY()
? "EVENT:", event
RETURN 1
END FUNCTION





'
' main
'
' for drawing it's a good idea to use a flicker free double buffered window
var win = Fl_Double_WindowNew(640,480,"")
var box = Fl_BoxExNew(5,5,Fl_WidgetGetW(win)-10,Fl_WidgetGetH(win)-10)
Fl_BoxExSetDrawCB box, @DrawCB
Fl_BoxExSetHandleCB box, @BoxHandle

Fl_GroupSetResizable win,box
Fl_WindowShow win
Fl_Run



[leopardpm]

nice work - I use vector drawing programs all day, everyday, for work... your routine gives a good foundation to creating a full-fledged drawing program

[Pitto]

@ike
Thank you for the very good tip. Maybe in future releases I'll implement this library. It can considerably speed up the development of some parts.

@leopardpm
Also I do a everyday use of vector drawing programs. Feedback from a colleague goes double. Thank you.

At his moment I wish implement:

· Pan & zoom
· Bitmap import of any size
· path closing
· node add & delete
· compund path
· Save option
· SVG export

Frankly speaking, some features are a bit far from my programming skills, but nothing prevents me from trying :)

[ike]

Zooming - try mousewheel

Code: Select all


#include once "fltk-c.bi"
namespace MAIN
    dim as double x1, y1, w, h, xc, yc, xx1, yy1, xx2, yy2, left
   DIM AS Fl_Window PTR win
   DIM AS Fl_BoxEx PTR box
    DIM AS Fl_Button PTR btn1
end namespace


SUB WH()
   MAIN.x1 = Fl_WidgetGetX(MAIN.box)
   MAIN.y1 = Fl_WidgetGetY(MAIN.box)
   MAIN.w = Fl_WidgetGetW(MAIN.box)
   MAIN.h = Fl_WidgetGetH(MAIN.box)
END SUB

PUBLIC SUB KALKSCALE(xxc AS DOUBLE, yyc AS DOUBLE, L AS DOUBLE)
WH
MAIN.xc = xxc: MAIN.yc= yyc: MAIN.left = L
MAIN.xx1 = xxc-L
MAIN.xx2 = xxc+L
MAIN.yy1 = yyc - L*(MAIN.h/MAIN.w)
MAIN.yy2 = yyc + L*(MAIN.h/MAIN.w)
END SUB

SUB ZOOMSQ(x1 AS DOUBLE, x2 AS DOUBLE, y1 AS DOUBLE, y2 AS DOUBLE)
KALKSCALE((x1+x2)/2, (y1+y2)/2, (x1+x2)/2-x1)
END SUB


FUNCTION SCALEY(x AS DOUBLE) AS INTEGER
DIM AS DOUBLE K, x1, y1, x2, y2, r
dim as integer ret
x1 = MAIN.yy1: x2 = MAIN.yy2: y1 = MAIN.y1+MAIN.h: y2 = MAIN.y1
K = (y2-y1)/(x2-x1)
r = k * (x-x1) + y1
ret = CINT(r)
RETURN ret
END FUNCTION
FUNCTION UNSCALEY(x AS INTEGER) AS DOUBLE
DIM AS DOUBLE K, x1, y1, x2, y2, r
DIM ret AS DOUBLE
x1 = MAIN.yy1: x2 = MAIN.yy2: y1 = MAIN.y1+MAIN.h: y2 = MAIN.y1
K = (y2-y1)/(x2-x1)
r=(x+k*x1-y1)/K
ret = r
RETURN ret
END FUNCTION

FUNCTION SCALEX(x AS DOUBLE) AS INTEGER
DIM AS DOUBLE K, x1, y1, x2, y2, r
DIM ret AS INTEGER
x1 = MAIN.xx1: x2 = MAIN.xx2: y1 = MAIN.x1: y2 = MAIN.x1 + MAIN.w
K = (y2-y1)/(x2-x1)
r = k * (x-x1) + y1
ret = CINT(r)
RETURN ret
END FUNCTION

FUNCTION UNSCALEX(x AS INTEGER) AS DOUBLE
DIM AS DOUBLE K, x1, y1, x2, y2, r
DIM ret AS DOUBLE
x1 = MAIN.xx1: x2 = MAIN.xx2: y1 = MAIN.x1: y2 = MAIN.x1 + MAIN.w
K = (y2-y1)/(x2-x1)
r=(x+k*x1-y1)/K
ret = r
RETURN ret
END FUNCTION
'''''''''''''''''''''''''''''''''''''''''''''''''
SUB DRAW_RECT_FILL(x1_ AS DOUBLE, x2_ AS DOUBLE, y1_ AS DOUBLE, y2_ AS DOUBLE, kolor AS UINTEGER)
DrawSetColor kolor
dim as double x1__, x2__, y1__, y2__

if x1_ < x2_ then
   x1__ = x1_
   x2__ = x2_
else
   x1__ = x2_
   x2__ = x1_
end if

if y1_ > y2_ then
   y1__ = y1_
   y2__ = y2_
else
   y1__ = y2_
   y2__ = y1_
end if

dim as long w = abs(scalex(x1__) -  scalex(x2__))
dim as long h = abs(scaley(y1__) -  scaley(y2__))

DrawRectFill (scalex(x1__), scaley(y1__), w,  h )

END SUB
'''''''''''''''''''''''''''''
SUB DRAW_RECT(x1_ AS DOUBLE, x2_ AS DOUBLE, y1_ AS DOUBLE, y2_ AS DOUBLE, kolor AS UINTEGER, wid AS INTEGER)
DrawSetColor kolor
DrawSetLineStyle FL_SOLID OR FL_CAP_FLAT, wid
DrawLine(scalex(x1_), scaley(y1_), scalex(x2_), scaley(y1_))
DrawLine(scalex(x1_), scaley(y2_), scalex(x2_), scaley(y2_))
DrawLine(scalex(x1_), scaley(y1_), scalex(x1_), scaley(y2_))
DrawLine(scalex(x2_), scaley(y1_), scalex(x2_), scaley(y2_))
END SUB
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

function DrawCB cdecl (byval self as any ptr) as long
drawpushclip(MAIN.x1,MAIN.y1,MAIN.w,MAIN.h)
DrawSetColor Fl_RGB_Color(96, 96, 96)
DrawRectFill MAIN.x1, MAIN.y1 ,MAIN.w, MAIN.h

DRAW_RECT(10, 44, 10, 44, FL_YELLOW, 1)
DrawPopClip
return 1
end function



FUNCTION BoxHandle CDECL (self AS ANY PTR, event AS Fl_Event) AS INTEGER   
DIM AS INTEGER butt = Fl_EventButton()
DIM AS LONG CT =  Fl_EventCtrl()
DIM AS LONG ALT =  Fl_EventAlt()
DIM AS LONG SFT = Fl_EventShift()
? "KEYS:",ct, alt, sft, butt

dim as integer iX, iY
dim as double dX, dY
iX=Fl_EventX():iY=Fl_EventY()
? "iXiY:", iX, iY
dX=unscalex(iX): dY=unscaley(iY)
? "dXdY:", dX, dY
? "EVENT:", event





IF event = FL_EVENT_MOUSEWHEEL THEN
iX=Fl_EventX() : iY=Fl_EventY()
dX=unscalex(iX): dY=unscaley(iY) '''
MAIN.left = MAIN.left * (1 + (CDBL(Fl_EventDY)/10))
KALKSCALE(MAIN.xc, MAIN.yc, MAIN.left)
Fl_WidgetRedraw MAIN.box
END IF







RETURN 1
END FUNCTION

'
' main
'
' for drawing it's a good idea to use a flicker free double buffered window
MAIN.win = Fl_Double_WindowNew(640,480,"Try MouseWheel")
MAIN.box = Fl_BoxExNew(100,5,640-110,480-10)
Fl_BoxExSetDrawCB MAIN.box, @DrawCB
Fl_BoxExSetHandleCB MAIN.box, @BoxHandle

MAIN.btn1 = Fl_ButtonNew(10, 10, 40, 40, "@#+21->")

Fl_GroupSetResizable MAIN.win, MAIN.box

KALKSCALE(20, 20, 50)

Fl_WindowShow MAIN.win
Fl_Run




[dodicat]

I did this a year or two ago.
(I stuck the horse on today).

1) Draw points with the mouse as normal
2) Use the wheel to magnify.(Press down on the wheel to re-set it if you want)
3) Right click anywhere on the screen to delete previous points.
4)The drag mode box (top left) can be clicked to toggle between drawing points or dragging points with the mouse.
5) Exit by pressing escape
6) You may save the points on exit, they are saved in polypoints.txt, which will run directly with freebasic to draw the saved points.
7) The file is shown on the console with shell (optional)
(Catmul Rom spline is used instead of Bezier in this code)

Code: Select all


Dim As String horse = _
"C0BM197,165M+5,-27M+3,-25M+4,-21M+6,-10M+15,-10"_
&"M+5,-4M+11,-4M+8,0M+2,4M+48,1M+15,7"_
&"M+15,7M+12,10M+12,13M+19,27M+7,15M+6,13"_
&"M+7,7M+23,5M+39,-9M+37,-10M+20,-1M+24,3"_
&"M+30,5M+18,-10M+34,-23M+15,-3M+18,6M+15,11"_
&"M+12,15M+2,28M+5,39M+-5,18M+-17,38M+-7,14"_
&"M+-20,34M+-12,21M+-4,9M+-2,3M+-1,37M+4,9"_
&"M+-4,1M+-9,-7M+-7,-17M+-3,-30M+6,-38M+23,-59"_
&"M+4,-29M+-3,-21M+-13,-17M+-10,-6M+-13,-4M+-17,0"_
&"M+-6,3M+5,18M+11,28M+0,27M+-3,15M+-7,13"_
&"M+-10,16M+-12,11M+-9,11M+-9,10M+6,19M+8,13"_
&"M+5,6M+6,12M+-4,11M+-12,17M+-14,13M+-10,13"_
&"M+-8,13M+-7,10M+-4,11M+-12,6M+-8,3M+-5,11"_
&"M+0,6M+-28,-9M+3,-12M+8,-8M+13,-7M+8,-5"_
&"M+12,-10M+9,-16M+10,-15M+12,-15M+0,-10M+-3,-13"_
&"M+-2,-8M+-5,1M+-3,12M+-8,9M+-12,13M+-10,13"_
&"M+-7,16M+-8,15M+-5,8M+-8,11M+-9,9M+-13,12"_
&"M+-3,9M+273,4M+0,13M+-382,-1M+-1,-12M+71,-3"_
&"M+20,-21M+27,-20M+28,-41M+6,-14M+5,-20M+-19,-35"_
&"M+-7,-10M+-8,-7M+-9,-4M+-16,7M+-12,3M+-29,0"_
&"M+-22,1M+-14,21M+-13,27M+-13,19M+-12,30M+-7,22"_
&"M+-4,19M+-7,22M+31,3M+-1,15M+-171,-1M+-2,-13"_
&"M+95,-2M+13,-8M+15,-9M+8,-13M+8,-21M+5,-32"_
&"M+5,-22M+9,-21M+8,-22M+8,-19M+-3,-4M+-17,5"_
&"M+-9,3M+-69,0M+-4,7M+-4,12M+5,17M+9,10"_
&"M+13,14M+11,10M+10,3M+12,4M+4,11M+-2,12"_
&"M+-8,7M+-8,-4M+-20,-14M+-15,-13M+-36,-56M+-2,-19"_
&"M+7,-14M+15,-8M+48,-20M+-7,-26M+5,-11M+1,-11"_
&"M+7,-7M+6,-11M+8,-18M+3,-18M+-1,-14M+-4,-10"_
&"M+-6,-11M+-8,1M+-14,12M+-7,10M+-3,15M+-6,8"_
&"M+-12,-2M+-16,-6M+-4,-17M+1,-16"_
&"BM+191,77P4294967295,0"


Dim As Integer xres,yres
Screeninfo xres,yres
Screenres .9*xres,.9*yres,32
Screeninfo xres,yres
Dim As Any Ptr i=Imagecreate(800,600,Rgb(0,200,0))
Draw i,horse

#define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
#define onscreen (mx>0) and (mx<xres) and (my>0) and (my<yres)
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius

Type Point
    As Long x,y
End Type

Type V2 As Point
Function ShortSpline(p() As V2,t As Single) As V2
    #macro set(n)
    0.5 *(     (2 * P(2).n) +_
    (-1*P(1).n + P(3).n) * t +_
    (2*P(1).n - 5*P(2).n + 4*P(3).n - P(4).n) * t*t +_
    (-1*P(1).n + 3*P(2).n- 3*P(3).n + P(4).n) * t*t*t)
    #endmacro
    Dim As V2 G
    G.x=set(x):G.y=set(y)':G.z=set(z)
    Return g
End Function

Sub GetSpline(v() As V2,outarray() As V2,arraysize As Long=1000)
    Dim As V2 p(1 To 4)
    Redim outarray(0)
    Dim As Single stepsize=(Ubound(v)-1)/(arraysize)
    If stepsize>1 Then stepsize=1
    For n As Long=Lbound(v)+1 To Ubound(v)-2
        p(1)=v(n-1):p(2)=v(n):p(3)=v(n+1):p(4)=v(n+2)
        For t As Single=0 To 1 Step stepsize
            Redim Preserve outarray(1 To Ubound(outarray)+1)
            outarray(Ubound(outarray))=ShortSpline(p(),t)
        Next t
    Next n
End Sub

Sub DrawCurve(a() As V2,ydisp As Long=0,col As Ulong)
    Pset(a(Lbound(a)).x,a(Lbound(a)).y+ydisp),col
    For z As Long=Lbound(a)+1 To Ubound(a)
        Line-(a(z).x,a(z).y+ydisp),col
    Next z
End Sub

Sub lineto(x1 As Single,y1 As Single,x2 As Single,y2 As Single,L As Single,Byref ox As Single,Byref oy As Single)
    Var dx=x2-x1,dy=y2-y1
    ox=x1+dx*L
    oy=y1+dy*L
End Sub

Sub Magnify()
    #define resetwheel(w,fl) fl=w
    #define wheel(w,f) w-f
    Dim As Long mx,my,mw,button:Getmouse mx,my,mw,button
    Static As Long flag,pmw
    mw=(mw/2)
    If button=4 Then  resetwheel(mw,flag)
    Dim As Ulong array(1 To 6561),count
    pmw=wheel(mw,flag)
    If pmw<=1 Then Exit Sub
    For z As Long=1 To 2
        For x As Long=mx-40 To mx+40
            For y As Long=my-40 To my+40
                count+=1
                If z=1 Then array(count)=Point(x,y)
                If z=2 Then
                    Var NewX=pmw*(x-mx)+mx:Var NewY=pmw*(y-my)+my
                    Line(newx-pmw/2,newy-pmw/2)-(newx+pmw/2,newy+pmw/2),array(count),bf
                End If
            Next y
        Next x
        count=0
    Next z
    Line(mx-pmw*40,my-pmw*40)-(mx+pmw*40,my+pmw*40),Rgb(100,0,0),B
End Sub
#macro display()
Screenlock
Cls
Put(100,100),i,Pset

'================= GRID =======================
For x As Long=0 To xres Step 50
    Line(x,0)-(x,yres),Rgb(155,155,155)
Next x
For y As Long=0 To yres Step 50
    Line(0,y)-(xres,y),Rgb(155,155,155)
Next y
Line(0,0)-(xres,20),Rgb(0,100,200),bf
If dragmode=1 Then
    Line(10,0)-(100,20),Rgb(200,0,0),bf
Else
    Line(10,0)-(100,20),Rgb(0,200,0),bf   
End If
Draw String(15,5),"Drag mode",Rgb(255,255,255)
Draw String(150,5),dragmessage,Rgb(255,255,255)
Draw String(xres/3,20),"mouse " & mx &"   " & my & "  " & Str(dragmode)  ,Rgb(200,200,200)

'firsst point
If Ubound(s) Then Circle(s(1).x,s(1).y),3,Rgb(200,100,0),,,,f
'========== Get the CatMull Rom spline ====================
If Ubound(s)>1 Then
    Dim As Single ox,oy
    lineto(s(2).x,s(2).y,s(1).x,s(1).y,1,ox,oy)
    Redim s2(0 To Ubound(s)+1)
    s2(0)=Type<v2>(ox,oy)
    For n As Long=1 To Ubound(s)
        s2(n)=s(n)
    Next n
    lineto(s(Ubound(s)-1).x,s(Ubound(s)-1).y,s(Ubound(s)).x,s(Ubound(s)).y,1,ox,oy)
    s2(Ubound(s2)).x=ox
    s2(Ubound(s2)).y=oy
    Dim As Long m
    If Ubound(s)<6-3 Then 'after fourth point the spline becomes curved
        m=0
    Else
        m=map(0,100,Ubound(s),0,(Ubound(s)*100))+20
    End If
    Draw String (10,30),"Number of spline points " +Str(Ubound(cmull)),Rgb(255,255,255)
    Draw String (10,40),"Number of mouse points " +Str(Ubound(s2)),Rgb(255,255,255)
    GetSpline(s2(),Cmull(),m)
    DrawCurve(CMull(),,Rgb(200,0,0))
End If
For n As Long=2 To Ubound(s)
    Circle (s(n).x,s(n).y),3,Rgb(200,0,0),,,,f
Next n
magnify()
Screenunlock
Sleep 1,1
#endmacro

#macro mouse(m)
Dim As Long x=mx,y=my,dx,dy
While mb = 1
    Display()
    Getmouse mx,my,,mb
    If onscreen Then
        If mx<>x Or my<>y  Then
            dx = mx - x
            dy = my - y
            x = mx
            y = my
            s(m).x=x+dx
            s(m).y=y+dy
        End If
    End If
Wend
#endmacro

Redim As Point s(0),s2()
Redim As V2 Cmull()

Dim As Long mx,my,mb,flag1,counter,flag2,dragmode=-1
Dim As String key,dragmessage
Screencontrol 100,50,50

Do
    Getmouse mx,my,,mb
    key=Inkey
   
    display()
   
    If my<20 Then
        If mx>10 And mx<100 And mb=1 And flag1=0 Then
            flag1=1
            dragmode=-dragmode
        End If
    End If
   
    If dragmode =1 Then
        For n As Long=Lbound(s) To Ubound(s)
            If incircle(s(n).x,s(n).y,10,mx,my) Then
                mouse(n)
            End If
        Next n
       
    End If
    '==============================================
    'insertion of points
    If my>20 And dragmode=-1 Then
        If mb=1 And flag1=0 Then
            flag1=1:counter+=1
            Redim Preserve s(1 To Ubound(s)+1)
            s(Ubound(s))=Type<Point>(mx,my)
        End If
       
        'deletion of points
        If mb=2 And flag2=0 Then
            flag2=1
            If counter>1 Then Redim Preserve s(1 To Ubound(s)-1):counter-=1
            If counter=1 Then Redim s(0):counter=0
        End If
    End If
    flag1=mb
    flag2=mb
    If dragmode=-1 Then dragmessage="YOU CAN DRAW POINTS"
    If dragmode=1 Then  dragmessage="YOU CAN DRAG POINTS WITH THE MOUSE"
   
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   
Loop Until key =Chr(27)

Draw String(10,100), "Do you want to save this  y/n ? ",Rgb(255,255,255)
Var g=Input(1)
If Lcase(g)<>"y" Then End

Open "polypoints.txt" For Output As #1
'====================================

Print #1,"type V2"
Print #1,  "As long x,y"
Print #1,"End Type"
'====================================

Print #1," "
Print #1,"X_values:"
Print #1," "
Print #1,"DATA _"
'================
Dim As String accum
Dim As Integer ctr


For n As Integer=Lbound(Cmull) To Ubound(Cmull)
    ctr+=1
    accum+=Str(Cmull(n).x)+ ","
    If ctr Mod 16 =0  Then accum+= " _"+Chr(13) + Chr(10)
Next n
accum=Rtrim(accum,",")
accum=Rtrim(accum,Chr(10))
accum=Rtrim(accum,Chr(13))
accum=Rtrim(accum,"_")
accum=Rtrim(accum," ")
accum=Rtrim(accum,",")
Print #1,accum
accum=""
ctr=0


Print #1," "
Print #1," "
Print #1,"Y_values:"
Print #1," "
Print #1,"DATA _"
For n As Integer=Lbound(Cmull) To Ubound(Cmull)
    ctr+=1
    accum+=Str(Cmull(n).y)+ ","
    If ctr Mod 16 =0  Then accum+= " _"+Chr(13) + Chr(10)
Next n
accum=Rtrim(accum,",")
accum=Rtrim(accum,Chr(10))
accum=Rtrim(accum,Chr(13))
accum=Rtrim(accum,"_")
accum=Rtrim(accum," ")
accum=Rtrim(accum,",")
Dim As Integer numpts=Ubound(cmull)-Lbound(Cmull)+1
Print #1,accum
Print #1," "
Print #1," "
Print #1,"'Number of points ";Ubound(cmull)-Lbound(Cmull)+1
Print #1,"screenres ";xres;",";yres
Print #1,"dim as v2 p(1 to ";numpts;")"
Print #1,"for n as long=lbound(p) to ubound(p)"
Print #1, "read p(n).x"
Print #1,"next n"

Print #1,"for n as long=lbound(p) to ubound(p)"
Print #1,"read p(n).y"
Print #1,"next n"

Print #1,"for n as long=lbound(p) to ubound(p)"
Print #1, "pset(p(n).x,p(n).y)"
Print #1,"next n"
Print #1,"sleep"
Close #1
Shell "type polypoints.txt"
Sleep
sleep
imagedestroy i
 

[D.J.Peters]

@ike you don't need all your caluclations simple use DrawScale() (if you like)

I won't hijack this thread and post it here: http://www.freebasic.net/forum/viewtopic.php?f=14&p=229450#p229450

Joshy

[ike]

Look at this:
https://www.youtube.com/watch?v=G32g1Ywo9vg

[leopardpm]

At his moment I wish implement:

· Pan & zoom
· Bitmap import of any size
· path closing
· node add & delete
· compund path
· Save option
· SVG export

how abort EPS export? I like your feature list!

Frankly speaking, some features are a bit far from my programming skills, but nothing prevents me from trying :)

I think you have the programming skills, just not the knowledge YET of how these things work... I have no doubt that you could cobble together a exquisite program that would rival the commercial ones, perhaps even introducing features that are useful but currently not available! There are many times that I wish there were a feature available which would make my life easier. Using your working knowledge of how you currently use these programs will lead you to making things better. Keep on programming, sir, the world is at your fingertips!

[Pitto]

Hi all,

version 0.02 released. Main function added: Pan & Zoom

Hold Spacebar to drag whole artwork
Press CRTL + "+" to zoom in
Press CRTL + "-" to zoom out
Press CRTL + "0" to zoom 100%

Main repository: https://github.com/pitto/fbb/

Video preview: https://youtu.be/KrQJxRD8rH8

The Bitmap upscale/downscale function has been written by noop
viewtopic.php?t=24586

@leopardpm
Thank you, I really appreciate for your feedback. It gives me motivation to improve.

There are many times that I wish there were a feature available which would make my life easier

I agree, but implement a particular feature maybe sometimes really difficult. And often the way I think to make a vector work and the tools I use are pretty different from the way of working of the other,even using the same software. All this reasoning to say that sometimes you can develop tools that are useful for themselves but not for others.

About EPS export… a little bit too difficult for the moment, I've examined a bit the specs of this format, they are much more complex of svg format.

@dodicat
I like your Catmul Rom spline implementation, maybe I'll study it a bit for another project in my mind.

@ike
Thank you for your tips.

[dodicat]

Instead of saving to file many data points, this saves only the original mouse clicks and passes the catmul and drawing subs instead.
Right click to delete points.
Switch to dragging mode top left.
(I skipped the horse)

Code: Select all



Dim As Integer xres,yres
Screeninfo xres,yres
Screenres .9*xres,.9*yres,32
Screeninfo xres,yres

'optional
'Dim As Any Ptr i=Imagecreate(800,600,Rgb(0,200,0))
'bload something to i

#define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
#define onscreen (mx>0) and (mx<xres) and (my>0) and (my<yres)
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius

Type Point
    As Long x,y
End Type

Type V2 As Point
Function ShortSpline(p() As V2,t As Single) As V2
    #macro set(n)
    0.5 *(     (2 * P(2).n) +_
    (-1*P(1).n + P(3).n) * t +_
    (2*P(1).n - 5*P(2).n + 4*P(3).n - P(4).n) * t*t +_
    (-1*P(1).n + 3*P(2).n- 3*P(3).n + P(4).n) * t*t*t)
    #endmacro
    Dim As V2 G
    G.x=set(x):G.y=set(y)':G.z=set(z)
    Return g
End Function

Sub GetSpline(v() As V2,outarray() As V2,arraysize As Long=1000)
    Dim As V2 p(1 To 4)
    Redim outarray(0)
    Dim As Single stepsize=(Ubound(v)-1)/(arraysize)
    If stepsize>1 Then stepsize=1
    For n As Long=Lbound(v)+1 To Ubound(v)-2
        p(1)=v(n-1):p(2)=v(n):p(3)=v(n+1):p(4)=v(n+2)
        For t As Single=0 To 1 Step stepsize
            Redim Preserve outarray(1 To Ubound(outarray)+1)
            outarray(Ubound(outarray))=ShortSpline(p(),t)
        Next t
    Next n
End Sub

Sub DrawCurve(a() As V2,ydisp As Long=0,col As Ulong)
    Pset(a(Lbound(a)).x,a(Lbound(a)).y+ydisp),col
    For z As Long=Lbound(a)+1 To Ubound(a)
        Line-(a(z).x,a(z).y+ydisp),col
    Next z
End Sub

Sub lineto(x1 As Single,y1 As Single,x2 As Single,y2 As Single,L As Single,Byref ox As Single,Byref oy As Single)
    Var dx=x2-x1,dy=y2-y1
    ox=x1+dx*L
    oy=y1+dy*L
End Sub

Sub Magnify()
    #define resetwheel(w,fl) fl=w
    #define wheel(w,f) w-f
    Dim As Long mx,my,mw,button:Getmouse mx,my,mw,button
    Static As Long flag,pmw
    mw=(mw/2)
    If button=4 Then  resetwheel(mw,flag)
    Dim As Ulong array(1 To 6561),count
    pmw=wheel(mw,flag)
    If pmw<=1 Then Exit Sub
    For z As Long=1 To 2
        For x As Long=mx-40 To mx+40
            For y As Long=my-40 To my+40
                count+=1
                If z=1 Then array(count)=Point(x,y)
                If z=2 Then
                    Var NewX=pmw*(x-mx)+mx:Var NewY=pmw*(y-my)+my
                    Line(newx-pmw/2,newy-pmw/2)-(newx+pmw/2,newy+pmw/2),array(count),bf
                End If
            Next y
        Next x
        count=0
    Next z
    Line(mx-pmw*40,my-pmw*40)-(mx+pmw*40,my+pmw*40),Rgb(100,0,0),B
End Sub
#macro display()
Screenlock
Cls
'put(0,0),i  optional
'================= GRID =======================
For x As Long=0 To xres Step 50
    Line(x,0)-(x,yres),Rgb(155,155,155)
Next x
For y As Long=0 To yres Step 50
    Line(0,y)-(xres,y),Rgb(155,155,155)
Next y
Line(0,0)-(xres,20),Rgb(0,100,200),bf
If dragmode=1 Then
    Line(10,0)-(100,20),Rgb(200,0,0),bf
Else
    Line(10,0)-(100,20),Rgb(0,200,0),bf   
End If
Draw String(15,5),"Drag mode",Rgb(255,255,255)
Draw String(150,5),dragmessage,Rgb(255,255,255)
Draw String(xres/3,20),"mouse " & mx &"   " & my   ,Rgb(200,200,200)

'firsst point
If Ubound(s) Then Circle(s(1).x,s(1).y),3,Rgb(200,100,0),,,,f
'========== Get the CatMull Rom spline ====================
If Ubound(s)>1 Then
    Dim As Single ox,oy
    lineto(s(2).x,s(2).y,s(1).x,s(1).y,1,ox,oy)
    Redim s2(0 To Ubound(s)+1)
    s2(0)=Type<v2>(ox,oy)
    For n As Long=1 To Ubound(s)
        s2(n)=s(n)
    Next n
    lineto(s(Ubound(s)-1).x,s(Ubound(s)-1).y,s(Ubound(s)).x,s(Ubound(s)).y,1,ox,oy)
    s2(Ubound(s2)).x=ox
    s2(Ubound(s2)).y=oy
    Dim As Long m
    If Ubound(s)<6-3 Then 'after fourth point the spline becomes curved
        m=0
    Else
        m=map(0,100,Ubound(s),0,(Ubound(s)*100))+20
    End If
    Draw String (10,30),"Number of spline points " +Str(Ubound(cmull)),Rgb(255,255,255)
    Draw String (10,40),"Number of mouse points " +Str(Ubound(s2)),Rgb(255,255,255)
    GetSpline(s2(),Cmull(),m)
    DrawCurve(CMull(),,Rgb(200,0,0))
End If
For n As Long=2 To Ubound(s)
    Circle (s(n).x,s(n).y),3,Rgb(200,0,0),,,,f
Next n
magnify()
Screenunlock
Sleep 1,1
#endmacro

#macro mouse(m)
Dim As Long x=mx,y=my,dx,dy
While mb = 1
    Display()
    Getmouse mx,my,,mb
    If onscreen Then
        If mx<>x Or my<>y  Then
            dx = mx - x
            dy = my - y
            x = mx
            y = my
            s(m).x=x+dx
            s(m).y=y+dy
        End If
    End If
Wend
#endmacro

Redim As Point s(0),s2()
Redim As V2 Cmull()

Dim As Long mx,my,mb,flag1,counter,flag2,dragmode=-1
Dim As String key,dragmessage
Screencontrol 100,50,50

Do
    Getmouse mx,my,,mb
    key=Inkey
   
    display()
   
    If my<20 Then
        If mx>10 And mx<100 And mb=1 And flag1=0 Then
            flag1=1
            dragmode=-dragmode
        End If
    End If
   
    If dragmode =1 Then
        For n As Long=Lbound(s) To Ubound(s)
            If incircle(s(n).x,s(n).y,10,mx,my) Then
                mouse(n)
            End If
        Next n
       
    End If
    '==============================================
    'insertion of points
    If my>20 And dragmode=-1 Then
        If mb=1 And flag1=0 Then
            flag1=1:counter+=1
            Redim Preserve s(1 To Ubound(s)+1)
            s(Ubound(s))=Type<Point>(mx,my)
        End If
       
        'deletion of points
        If mb=2 And flag2=0 Then
            flag2=1
            If counter>1 Then Redim Preserve s(1 To Ubound(s)-1):counter-=1
            If counter=1 Then Redim s(0):counter=0
        End If
    End If
    flag1=mb
    flag2=mb
    If dragmode=-1 Then dragmessage="YOU CAN DRAW POINTS"
    If dragmode=1 Then  dragmessage="YOU CAN DRAG POINTS WITH THE MOUSE"
   
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   
Loop Until key =Chr(27)

Draw String(10,100), "Do you want to save this  y/n ? ",Rgb(255,255,255)
Var g=Input(1)
If Lcase(g)<>"y" Then End

Open "polypoints.txt" For Output As #1
'====================================

Print #1,"type V2"
Print #1,  "As long x,y"
Print #1,"End Type"

Print #1,""
Print #1,"Function ShortSpline(p() As V2,t As Single) As V2"
Print #1,   " #macro set(n)"
Print #1, "0.5 *(     (2 * P(2).n) +_"
Print #1, "(-1*P(1).n + P(3).n) * t +_"
Print #1,    "(2*P(1).n - 5*P(2).n + 4*P(3).n - P(4).n) * t*t +_"
Print #1,"    (-1*P(1).n + 3*P(2).n- 3*P(3).n + P(4).n) * t*t*t)"
Print #1,    "#endmacro"
Print #1,    "Dim As V2 G"
Print #1,    "G.x=set(x):G.y=set(y)':G.z=set(z)"
Print #1,    "Return g"
Print #1,"End Function"
Print #1,""
Print #1,"Sub GetSpline(v() As V2,outarray() As V2,arraysize As Long=1000)"
Print #1,    "Dim As V2 p(1 To 4)"
Print #1,"    Redim outarray(0)"
Print #1,"    Dim As Single stepsize=(Ubound(v)-1)/(arraysize)"
Print #1,    "If stepsize>1 Then stepsize=1"
Print #1,    "For n As Long=Lbound(v)+1 To Ubound(v)-2"
Print #1,        "p(1)=v(n-1):p(2)=v(n):p(3)=v(n+1):p(4)=v(n+2)"
Print #1,"        For t As Single=0 To 1 Step stepsize"
Print #1,"            Redim Preserve outarray(1 To Ubound(outarray)+1)"
Print #1,"            outarray(Ubound(outarray))=ShortSpline(p(),t)"
Print #1,"        Next t"
Print #1,"    Next n"
Print #1,"End Sub"
Print #1,""
Print #1,"Sub DrawCurve(a() As V2,ydisp As Long=0,col As Ulong)"
Print #1,"    Pset(a(Lbound(a)).x,a(Lbound(a)).y+ydisp),col"
Print #1,"    For z As Long=Lbound(a)+1 To Ubound(a)"
Print #1,"        Line-(a(z).x,a(z).y+ydisp),col"
Print #1,"    Next z"
Print #1,"End Sub"
Print #1,""
Print #1,"sub drawpoints(p() as V2)"
Print #1,"    for n as long=lbound(p) to ubound(p)"
Print #1,"        circle(p(n).x,p(n).y),5"
Print #1,"        next n"
Print #1,"    end sub"
print #1,""

Print #1,"#define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)"


'====================================

Print #1," "
Print #1,"X_values:"
Print #1," "
Print #1,"DATA _"
'================
Dim As String accum
Dim As Integer ctr


For n As Integer=Lbound(s2) To Ubound(s2)
    ctr+=1
    accum+=Str(s2(n).x)+ ","
    If ctr Mod 16 =0  Then accum+= " _"+Chr(13) + Chr(10)
Next n
accum=Rtrim(accum,",")
accum=Rtrim(accum,Chr(10))
accum=Rtrim(accum,Chr(13))
accum=Rtrim(accum,"_")
accum=Rtrim(accum," ")
accum=Rtrim(accum,",")
Print #1,accum
accum=""
ctr=0


Print #1," "
Print #1," "
Print #1,"Y_values:"
Print #1," "
Print #1,"DATA _"
For n As Integer=Lbound(s2) To Ubound(s2)
    ctr+=1
    accum+=Str(s2(n).y)+ ","
    If ctr Mod 16 =0  Then accum+= " _"+Chr(13) + Chr(10)
Next n
accum=Rtrim(accum,",")
accum=Rtrim(accum,Chr(10))
accum=Rtrim(accum,Chr(13))
accum=Rtrim(accum,"_")
accum=Rtrim(accum," ")
accum=Rtrim(accum,",")
Dim As Integer numpts=Ubound(s2)-Lbound(s2)+1
Print #1,accum
Print #1," "
Print #1," "
Print #1,"'Number of points ";Ubound(s2)-Lbound(s2)+1
Print #1,"screenres ";xres;",";yres;",32"
Print #1,"dim as v2 p(1 to ";numpts;")"
Print #1,"for n as long=lbound(p) to ubound(p)"
Print #1, "read p(n).x"
Print #1,"next n"

Print #1,"for n as long=lbound(p) to ubound(p)"
Print #1,"read p(n).y"
Print #1,"next n"
Print #1,"dim as long m=map(0,100,Ubound(p),0,(Ubound(p)*100))+20"

Print #1,"Redim As V2 Cmull()"
Print #1,"GetSpline(p(),Cmull(),m)"
Print #1,"    DrawCurve(CMull(),,Rgb(200,0,0))"
print #1," drawpoints(p())"

Print #1,"sleep"
Close #1
Shell "type polypoints.txt"
Sleep
Sleep

 

[Pitto]

Hi all
https://github.com/pitto/fbb/
Version 0.03
New features:

Node delete using mouse right button click
Path delete if there is only one node
Zoom in/out using mouse wheel

Thanks to D.J. Peters for his tips and his fbGFXAddon

[owen]

Zoom should be relative to mouse pointer.
Ie. Mouse is at screen center zoom out window top left and bottom right increment proportionally. If mouse is other then center screen then top left and bottom right screen coordinates get shifted.

[owen]

Zooming in and out relative to the mouse might look something like this:
In your sub mouse_listener routine I changed the zoom factor from 2 and .5 to 1.1 and 0.9 and use *80 and *60 (ie. 10% or your screen res)
Effectively its a Zoom and Pan at the same time (relative to the mouse pointer)

Code: Select all

   if User_Mouse->old_wheel < User_Mouse->wheel and view_area->zoom < 4 then
      view_area->zoom *= 1.1f
      view_area->x += - Int(user_mouse->x/SCR_W*80)
      view_area->y += - Int(user_mouse->y/SCR_H*60)
   end if
   if User_Mouse->old_wheel > User_Mouse->wheel and view_area->zoom > 0.25 then
      view_area->zoom *= 0.9f
      view_area->x += Int(user_mouse->x/SCR_W*80)
      view_area->y += Int(user_mouse->y/SCR_H*60)
   end if