PureBasic Forums - English

Posted: **Sat Jun 05, 2010 9:22 am**

Here they are:

Structure PointF
x.f
y.f
EndStructure

Structure RectF
x.f
y.f
w.f
h.f
EndStructure

Posted: **Sat Jun 05, 2010 12:12 pm**

Hi Seymour,

I just tried your v6a... and I gave up

After I add several Macros (c13, c32, c34)
and add several procedures (Beat, Defeat ...)
I came to a point where I didn't know what a missing procedure does. So I stopped.

I think an includefile or any other stuff is missing.
If you load your pbi and try to compile it, it will result in a lot off errors.
If you have any hint for me, please tell it to me.

Best regards,

Bernd

Posted: **Sat Jun 05, 2010 12:31 pm**

And me too please!

By the way: I just replaced c32 with " ", c13 with #CR$ and c34 with #DQOUTE$. Maybe I'll find more of them.

Posted: **Sat Jun 05, 2010 4:44 pm**

Sorry everyone!

You're right, infratec. When I uploaded PureSVG, I forgot to include a bunch of stock procedures/macros that I use all the time. Here is the necessary code:

Code: Select all

CompilerIf Defined(White,#PB_Constant)=0
#White = 16777215
CompilerEndIf
CompilerIf Defined(Black,#PB_Constant)=0
#Black = 0
CompilerEndIf
CompilerIf Defined(Purple,#PB_Constant)=0
#Purple = 16711808
CompilerEndIf
CompilerIf Defined(Orange,#PB_Constant)=0
#Orange = 33023
CompilerEndIf

CompilerIf Defined(cma,#PB_Constant)=0
#cma = ","
CompilerEndIf


Macro R(t)
  MessageRequester("Report",t,0)
EndMacro

Global c10.s = Chr(10)
Global c13.s = Chr(13)
Global c32.s = Chr(32)
Global c34.s = Chr(34)
Global c39.s = Chr(39)


;CompilerIf Defined(RectF,#PB_Structure)=0
Structure PointF
  x.f
  y.f
EndStructure
Structure RectF
  x.f
  y.f
  w.f
  h.f
EndStructure
;CompilerEndIf

Macro EnsureThisNotEnd(txt,dontendd)
  
  If Right(txt,Len(dontendd)) = dontendd
      ;snipped.s = Len(t)-Len(endd)
      ;t = Left(t,snipped)
      txt = Left(txt,Len(txt)-Len(dontendd))
  EndIf
  
EndMacro

CompilerIf Defined(Beat,#PB_Procedure)=0
Procedure.f Beat(a.f,b.f)
  
  If a>b
      ProcedureReturn a
  Else
      ProcedureReturn b
  EndIf
  
EndProcedure

Procedure.f Defeat(a.f,b.f)
  
  If a<b
      ProcedureReturn a
  Else
      ProcedureReturn b
  EndIf
  
EndProcedure

Macro DefeatThis(a,b)
  a = Defeat(a,b)
EndMacro
Macro BeatThis(a,b)
  a = Beat(a,b)
EndMacro

Procedure.f Difference(a.f,b.f)
  
  If a=b
      ProcedureReturn 0
  EndIf
  
  ProcedureReturn Beat(a,b)-Defeat(a,b)
  
EndProcedure
CompilerEndIf



Macro EnsureThisEnd(t,endd)
  
  If endd<>""
      If Right(t,Len(endd)) <> endd
          t+endd
      EndIf
  EndIf
  
EndMacro

Procedure.s EnsureEnd(t.s,e.s)
  EnsureThisEnd(t,e)
  ProcedureReturn t
EndProcedure

Macro EnsureThisStart(t,endd)
  
  If endd<>""
      If Left(t,Len(endd)) <> endd
          t=endd+t
      EndIf
  EndIf
  
EndMacro

Procedure.s EnsureStart(t.s,e.s)
  EnsureThisStart(t,e)
  ProcedureReturn t
EndProcedure

Macro EnsureThisNotStart(t,start)
  
  If Left(t,Len(start)) = start
      t = Mid(t,Len(start)+1,Len(t))
  EndIf
  
EndMacro

Procedure.s EnsureNotStart(t.s,start.s)
  
  EnsureThisNotStart(t,start)
  ProcedureReturn t
  
EndProcedure


Procedure.s EnsureNotEnd(t.s,endd.s)
  
  EnsureThisNotEnd(t,endd)
  ProcedureReturn t
  
EndProcedure




Procedure.s GetFieldsFromStart(str.s,level.l,d.s)
  
  fields = CountString(str,d)
  accum.s
  
  For a = 1 To Defeat(level,fields)
      accum+StringField(str,a,d)+d
  Next a
  
  ProcedureReturn accum
  
EndProcedure



Macro FileExists(filename)
  (FileSize(filename) > -1)
EndMacro

Macro FolderExists(foldername)
  (FileSize(foldername) = -2)
EndMacro


Procedure.b EnsureFolder(folder.s)
  
  If FolderExists(folder)
      ProcedureReturn #True
  Else
      ProcedureReturn CreateDirectory(folder)
  EndIf
  
EndProcedure

Procedure.b IsDrivePath(path.s)
  If Len(path)=3 And Right(path,2)=":\"
      ProcedureReturn #True
  EndIf
EndProcedure

Procedure.b EnsureFolderPath(path.s)
  
  If FolderExists(path)
      ProcedureReturn #True
  EndIf
  
  EnsureThisEnd(path,"\")
  shortpath.s
  levels = CountString(path,"\")
  If levels>1
      For f = 1 To levels
          shortpath = GetFieldsFromStart(path,f,"\")
          If IsDrivePath(shortpath)
              success+1
              Continue
          EndIf
          success+EnsureFolder(shortpath)
      Next f
  EndIf
  
  If success=levels
      ProcedureReturn #True
  Else
      ProcedureReturn #False
  EndIf
  
EndProcedure


Procedure.s RandomLetters(length.i)
  
  t.s
  For a = 1 To length
      t + Chr(65+Random(25))
  Next a
  
  ProcedureReturn t
  
EndProcedure


Procedure.i RandomRGB(minlevel.w,maxlevel.w)
  
  r = Random(maxlevel-minlevel)+minlevel
  g = Random(maxlevel-minlevel)+minlevel
  b = Random(maxlevel-minlevel)+minlevel
  
  ProcedureReturn RGB(r,g,b)
  
EndProcedure


Procedure.s RemoveFieldsFromStart(arr.s,d.s,preremove.l)
  
  fields=CountString(arr,d)
  
  If preremove<fields
      r.s
      For f = (preremove+1) To fields
          r+StringField(arr,f,d)+d
      Next
      ProcedureReturn r
  Else
      ProcedureReturn ""
      ;ProcedureReturn arr
  EndIf
  
EndProcedure


Procedure.s RecursiveReplaceString(t.s,a.s,b.s,mode.b=0)
  
  While FindString(t,a,1)
      t = ReplaceString(t,a,b,mode)
  Wend
  
  ProcedureReturn t
  
EndProcedure


Procedure.i StringArrayToRealArray(sarr.s,Array arr.s(1),d.s,shrinkiftoobig.b=#False)
  
  ;QuickConformThisArray(sarr,d)
  items = CountString(sarr,d)
  
  arrsize = ArraySize(arr(),1)
  If arrsize<items
      ReDim arr(items)
  Else
      If shrinkiftoobig And arrsize>items
          ReDim arr(items)
      EndIf
  EndIf
  
  buildup.s
  sarrlen = Len(sarr)
  Repeat
      a+1
      ltr.s = Mid(sarr,a,1)
      If ltr=d
          builditems+1
          arr(builditems) = buildup
          buildup=""
      Else
          buildup+ltr
      EndIf
  Until builditems=items Or a=>sarrlen
  
  ProcedureReturn items
  
EndProcedure


Procedure.b FileFromString(filename.s,t.s)
  
  If Not filename : ProcedureReturn #False : EndIf
  ;If Not EnsureFolderPath(GetPathPart(filename)) : ProcedureReturn #False : EndIf
  
  t = RemoveString(t,Chr(10))
  If FindString(t,Chr(13),0)
      EnsureThisNotEnd(t,Chr(13)) ; this removes final linebreak
      t = ReplaceString(t,Chr(13),Chr(13)+Chr(10))
  EndIf
  
  file = CreateFile(#PB_Any,filename)
  If IsFile(file)
      WriteString(file,t)
      CloseFile(file)
      ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
  
EndProcedure

Procedure.s FileToString(filename.s)
  
  info.s = ""
  file = ReadFile(#PB_Any,filename)
  If file
      While Not Eof(file)
          info + ReadString(file)+c13
      Wend
      CloseFile(file)
  EndIf
  
  ProcedureReturn info
  
EndProcedure



Macro Degrees2Radians(degrees)
  degrees*#PI/180
EndMacro

Macro Radians2Degrees(radians)
  (radians/#PI*180)
EndMacro

Procedure.f DistanceBetweenTwoPoints(*a.PointF,*b.PointF)
  
  xdif.f = Difference(*a\x,*b\x)
  ydif.f = Difference(*a\y,*b\y)
  
  ProcedureReturn Sqr((xdif*xdif)+(ydif*ydif))
  
EndProcedure

Procedure.b CoordsFromPoint(*base.PointF,radia.f,distance.f,*c.PointF)
  *c\x = (Cos(radia)*distance)+*base\x
  *c\y = (Sin(radia)*distance)+*base\y
EndProcedure

Macro DegreeCoordsFromPoint(base,degrees,distance,c)
  CoordsFromPoint(base,Degrees2Radians(degrees),distance,c)
EndMacro


Procedure.f RadianAngleBetweenTwoPoints(*o.PointF,*p.PointF)
  
  x.f = Beat(*p\x,*o\x)
  y.f = Defeat(*p\y,*o\y)
  ProcedureReturn ATan(x/y)
  
EndProcedure

Procedure.b RotatePointAroundPoint(*p.PointF,*rc.PointF,degrees.f,*np.PointF)
  
  Protected.f x, y, radians
  
  radians = Degrees2Radians(degrees)
  
  x = *rc\x + ( Cos(radians) * (*p\x - *rc\x) - Sin(radians) * (*p\y - *rc\y) )
  y = *rc\y + ( Sin(radians) * (*p\x - *rc\x) + Cos(radians) * (*p\y - *rc\y) )
  
  *np\x = x
  *np\y = y
  
EndProcedure


Macro DegreeAngleBetweenTwoPoints(a,b)
  Radians2Degrees(RadianAngleBetweenTwoPoints(a,b))
EndMacro






Procedure.i Hex2Dec(hex.s)
  
  For r=1 To Len(hex)
      d<<4
      asc=Asc(Mid(hex,r,1))
      If asc>60
          d+asc-55
      Else
          d+asc-48
      EndIf
  Next
  ProcedureReturn d
  
EndProcedure

Procedure.i Hex2RGB(hex.s)
  
  hex = UCase(RemoveString(hex,"#"))
  
  third = Len(hex)/3
  r.s = Left(hex,third)
  g.s = Mid(hex,1+third,third)
  b.s = Right(hex,third)
  
  If third=1
      r+r
      g+g
      b+b
  EndIf
  
  ProcedureReturn RGB(Hex2Dec(r),Hex2Dec(g),Hex2Dec(b))
  
EndProcedure


Procedure.s RGB2Hex(rgb.i,omithash.b=#False,minimise.b=#True)
  
  hex.s
  hex + RSet(Hex(Red(rgb)), 2, "0")
  hex + RSet(Hex(Green(rgb)), 2, "0")
  hex + RSet(Hex(Blue(rgb)), 2, "0")
  
  If minimise
      If Left(hex,1)=Mid(hex,2,1) And Mid(hex,3,1)=Mid(hex,4,1) And Mid(hex,5,1)=Mid(hex,6,1)
          hex = Left(hex,1) + Mid(hex,4,1) + Mid(hex,6,1)
      EndIf
  EndIf
  
  If Not omithash
      hex = "#"+hex
  EndIf
  
  ProcedureReturn LCase(hex)
  
EndProcedure





CompilerIf Defined(ByteLumpMax,#PB_Constant)=0
#ByteLumpMax=127
CompilerEndIf

CompilerIf Defined(ByteLump,#PB_Structure)=0
Structure ByteLump
  maximum.f;=#ByteLumpMax
  lines.w
  line.s[#ByteLumpMax]
EndStructure
CompilerEndIf

CompilerIf Defined(LumpLinesFromString,#PB_Procedure)=0
Macro LumpLinesFromString(t)
  Defeat(#ByteLumpMax,CountString(t,c13))
EndMacro
CompilerEndIf

CompilerIf Defined(LumpToEG,#PB_Procedure)=0
Macro LumpToEG(lp,gad)
  
  If IsGadget(gad) And lp\lines
      For a = 1 To lp\lines
          AddGadgetItem(gad, a, lp\line[a])
      Next
  EndIf
  
EndMacro
CompilerEndIf

CompilerIf Defined(LumpFromEG,#PB_Procedure)=0
Macro LumpFromEG(gad,lp)
  
  If IsGadget(gad)
      lp\lines = CountGadgetItems(gad)
      For a = 1 To lp\lines
          lp\line[a] = GetGadgetItemText(gad, a-1, 0)
      Next
  EndIf
  
EndMacro
CompilerEndIf

Procedure.b LumpFromString(str.s,*dest.ByteLump)
  
  str=RemoveString(str,c10)
  EnsureThisEnd(str,c13)
  *dest\lines = LumpLinesFromString(str)
  ;R("Revised lump lines: "+Str(*dest\lines))
  
  If *dest\lines
      For a = 1 To *dest\lines
          *dest\line[a] = StringField(str,a,c13)
      Next a
  EndIf
  
  ProcedureReturn #True
  
EndProcedure

Add that to the top of PureSVG and everything should work. If not, please let me know!

Sorry again,
Seymour.

Posted: **Sun Jun 06, 2010 11:22 am**

Hi Seymour,

thank you very much, I saved it as Seymour.pbi and included the file.

But:
The simple Demo was running awful long.
After a few tries, I figured out, that I have to disable the debugger.

Than suddenly I got an memory access error, than my wife disturbed me and I was not able
to reproduce it for now.

But I'll try it again

Bernd

Posted: **Sun Jun 06, 2010 11:31 am**

Hi again,

I use PureBASIC 4.50RC2 X86 and you code snippet

Code: Select all

XIncludeFile "PureSVG.pbi"

s = CreateSVG(#PB_Any)
SVG_StartDrawing(s)
SVG_Box(0,0,100,100,#Blue)
SVG_Circle(50,50,25,#Yellow)
SVG_StopDrawing()
SaveSVG(s,"PurSVGTest.svg")

Without debug it runs only 2 times before I get an
'error in your application'

Can you test this please.

Bernd

Posted: **Tue Jun 08, 2010 12:37 pm**

I can't reproduce that error myself, Infratec.

However, it sounds like a memory issue. That example code should have included a check (ie If s<>0).

Thankfully v4.5 of PB is out now, so I'll make a new version of PureSVG that uses dynamic arrays instead of huge static ones that take up loads of memory.

Posted: **Mon Jul 19, 2010 7:06 am**

It seems to be incomplete. Here with Mac OS include don't work.
Some structures, procedures/macros seem to be missing....

Posted: **Tue Jul 27, 2010 11:01 pm**

Lebostein,

Sorry for taking so long to respond. I've been away on holiday.

The missing stuff should be in this post.

I will upload a new, complete version of PureSVG once the bugs in v4.5 of PB have been ironed out. I want to change it to use dynamic lists and arrays, and I don't see much point updating the old version that used static arrays.

Posted: **Sat Oct 09, 2010 4:51 pm**

Hi Seymour,

currently no version of your PureSVG is available through the links posted in this topic. Has this project died? If so, it would be really cool if you could make an older version available for download again!

Thanks and best regards,
Christian

Posted: **Sat Oct 09, 2010 6:03 pm**

that would be my fault, I have just rebuilt on a new server and forgot to upload the file. Try it again.

Posted: **Tue Jul 19, 2011 3:32 am**

Any more advancements on this project Seymour.

Posted: **Tue Jul 19, 2011 8:21 pm**

I'll have to do quite a bit of testing before I can release the next version. Are you looking for it in a hurry?

Posted: **Wed Jul 20, 2011 4:02 am**

No hurry,
I was playing around with a program called eve and checked if PB forum had worked on svg and found your good and extensive work on this format.

So I was just wondering if you were still working on the project, anyway I am looking forward to your next update.

Posted: **Wed Jul 20, 2011 7:34 pm**

I have a version of PureSVG which uses much less memory (it uses the arrays-within-structures that came with PB v4.5) and has a few new functions too. But I haven't used it for ages so I'll have to do a lot of testing before "releasing it to the public".

I had wanted to add new functions to support SVG filters and canvas drawing, but if you want PureSVG now, I can postpone those functions for a later version and just work on getting a stable version out.

PureBasic Forums - English

PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !

Re: PureSVG - now with LoadSVG() !