PureLibrary Creator - PB 6.20

[pf shadoko]

PB 6.20 allows library creation
but for the moment, managing optional procedure parameters is a bit tricky.
to remedy this problem I've made a little code
it also adds a “Quick help” giving the procedure syntax
a comment line above the procedure can be added for a quick description of the procedure

Code: Select all

EnableExplicit

Procedure.s lirefic(nom.s,nobom=1)
  Protected txt.s,n,sf
  n=ReadFile(-1,nom)
  sf=ReadStringFormat(n)
  txt=ReadString(n,#PB_File_IgnoreEOL)
  ;If sf<>#PB_Ascii:txt=Mid(txt,2):EndIf
  CloseFile(n)   
  ProcedureReturn txt
EndProcedure

Procedure ecrirefic(nom.s,txt.s,format=#PB_UTF8)
  Protected n
  If FileSize(nom)>=0:DeleteFile(nom):EndIf
  n=OpenFile(-1,nom,format):WriteString(n,txt,format):CloseFile(n)   
EndProcedure

#separateurs=" =:;,()[]{}+-/*.\<>?%|&"+#CR$+#LF$+Chr(34)

Declare.s Stringparse(t.s,before.s,after.s,pi=0)

Procedure.s Stringparse(t.s,before.s,after.s,pi=0)
    Protected pf
    pi=FindString(t,before,pi+1)
    If pi=0:ProcedureReturn:EndIf 
    pf=FindString(t,after,pi):If pf=0:pf=Len(t):EndIf
    pi+Len(before)
    ProcedureReturn Mid(t,pi,pf-pi)
EndProcedure

Procedure FindStringRev(t.s,find.s,p=0,mode=#PB_String_CaseSensitive)
    Protected l=Len(find)
    If p=0:p=Len(t):EndIf
    Repeat
        If p=0 Or Mid(t,p,L)=find:Break:EndIf
        p-1
    ForEver
    ProcedureReturn p
EndProcedure

Procedure.i FindStringww(txt.s,mot.s,p=1,mode=0); findstring whole word
    Repeat
        p=FindString(txt,mot,p,mode):If p=0:Break:EndIf
        If FindString(#separateurs,Mid(txt,p-1,1))>0 And FindString(#separateurs,Mid(txt,p+Len(mot),1))>0:ProcedureReturn p:EndIf
        p+Len(mot)
    ForEver
EndProcedure

Procedure.s ReplaceStringww(txt.s,mot.s,rep.s,p=1,mode=0); ReplaceString whole word
  Protected lm,lr
  
  lm=Len(mot)
  lr=Len(rep)
  Repeat
    p=FindStringww(txt,mot,p+1,mode):If p=0:Break:EndIf
    txt=Left(txt,p-1)+rep+Mid(txt,p+lm)
    p+lm-lr+1
  ForEver
  ProcedureReturn txt
EndProcedure


;####################################################################################################################################################
#g=Chr(34)

Procedure.s codefiltre(txt.s);----- crée une version du code contenant des ";"  à la place des commentaires et des """ dans les strings pour faciliter l'analyse du code
    Protected i,n,ch,co,  c.w
    
    n=Len(txt)
    Dim t.w(n-1)
    CopyMemory(@ txt,@ t(0),n*2)
    For i=0 To n-1
        c=t(i)
        Select c
            Case 34:ch=~ch
            Case 59:co=1
            Case 13:co=0
        EndSelect      
        If ch:c=34 :EndIf
        If co:c=59:EndIf
        t(i)=c
    Next
    CopyMemory(@ t(0),@ txt,n*2)
    ProcedureReturn txt
EndProcedure

Procedure.s listeparam(List p.s(),txt.s,pi=1);----- met les parametres de proc dans une liste et retourne un string contenant les parametres 
    Protected i,n,np,ch,pd,pdc,pfc,finc
    Protected.s c,fct
    ClearList(p())
    
    For i=pi To Len(txt)
        c=Mid(txt,i,1)
        If ch=0
            If c="(":np+1:If np=1:pd=i:pdc=i:EndIf:EndIf
            If c=")":np-1:If np=0:finc=1:EndIf:EndIf
            If c="," And np=1:finc=1:EndIf
            If finc:
              AddElement(p()):p()=Trim(Mid(txt,pdc+1,i-pdc-1)):pdc=i
              If finc And np=0:Break:EndIf
              finc=0
            EndIf
        EndIf
        If c=#g:ch=~ch:EndIf
      Next
      ;ForEach p():Debug p():Next:Debug "---"+Mid(txt,pd+1,i-pd-1):End
      ProcedureReturn Mid(txt,pd+1,i-pd-1)
EndProcedure

Procedure.s paramx(List p.s(), n, nval,declaration) ; <- retourne les parametres sous forme litérales
    Protected i, r.s,v.s
    ForEach p()
        i+1:If i>n:Break:EndIf
        v=StringField(p(),Bool(i>nval)+1,"=")
        If declaration=0 And FindString(v,"("):v=Stringparse(v," ","(")+"()":EndIf
        r+","+v
      Next
    ProcedureReturn Mid(r,2)
EndProcedure

Procedure.s parametres_optionels(fic.s) ;-------- gestion des parametres optionnels du fichier fic (il y a tjrs la possibilité de les gérer nous même (si on met les versions numerotées)
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows :#lgsep=#CRLF$
    CompilerCase #PB_OS_Linux   :#lgsep=#LF$
    CompilerCase #PB_OS_MacOS   :#lgsep=#CR$
  CompilerEndSelect
  
  Protected i,n,ni,p,pp,pi,pl,pf,ppi,ppf,num,npo,npf,ok,decl
  Protected.s dossier, fasm,flib,param,paramo, nom,nomnum,  proccode,proccodei,remplace,nums,ret,deb,QuickHelp
  NewList l.s() ; liste parametre
  NewList ll.s() ; liste parametre
  
  pf=1
  Repeat
    
    ;========================================== recup de la Proceduredll
    pi=FindString(fic,"ProcedureDLL",pf):If pi=0:Break:EndIf
    pf=FindString(fic,"EndProcedure",pi)+12:If pf=12:Break:EndIf
    proccode=Mid(fic,pi,pf-pi)
    proccodei=proccode
    
    pl=FindString(proccode,#lgsep)
    nom=Trim(Stringparse(proccode," ","("))
    ok=1:For i=1 To Len(nom):If FindString(#separateurs,Mid(nom,i,1)):ok=0:EndIf:Next:If ok=0 Or nom="":Continue:EndIf
    num=Val(Right(nom,1))
    param=listeparam(l(),proccode)
    
    ;========================================== QuickHelp 
    QuickHelp=" QuickHelp "+nom+"("+param+") - "
    p=FindStringRev(fic,#lgsep,pi-3)+Len(#lgsep)
    If Mid(fic,p,1)=";":p=p+1:Else:p=pi:QuickHelp=";"+QuickHelp+#lgsep:EndIf
    fic =Left(fic ,p-1)+QuickHelp+Mid(fic ,p)
    pi+Len(QuickHelp)
    pf+Len(QuickHelp)
   
    If num:Continue:EndIf; on abandonne si n° à la 1er occurence
       
    ;========================================== suppression de ses valeurs par defaut
    paramo=param
    While FindString(paramo,"="):paramo=ReplaceString(paramo,"="+Stringparse(paramo+",","=",","),""):Wend
    proccode=ReplaceString(proccode,param,paramo)
    
    npo=CountString(param,"="); !!!
    If npo=0:Continue:EndIf; on abandonne si nombre de param optionel=0
    
    ;========================================== creation des versions numérotées 
    npf=ListSize(l())-npo
    
    deb=Left(proccode,FindString(proccode,"(")-1)
    nomnum=nom+Str(npo+1)
    remplace=ReplaceString(proccode,nom,nomnum,0 ,1,1)
    If FindString(proccode,"ProcedureReturn")>0:ret="ProcedureReturn ":Else:ret="":EndIf
    For i=npo To 1 Step -1
      If i>1:nums=Str(i):Else:nums="":EndIf
      remplace+#lgsep+deb+nums+"("+paramx(l(),npf+i-1,100,1)+")"+#lgsep+ret+nomnum+"("+paramx(l(),npf+npo,npf+i-1,0)+")"+#lgsep+"EndProcedure"
    Next
        
    fic =Left(fic ,pi-1)+remplace+Mid(fic ,pf)
    pf+Len(remplace)-Len(proccodei)
    
    ;========================================== remplacement des appels de la Proceduredll (et DeclareDLL) par leur version numérotée
    p=0
    Repeat
      p=FindStringww(fic,nom,p+1,#PB_String_NoCase):If p=0:Break:EndIf
      pp=FindStringRev(fic,#lgsep,p)+Len(#lgsep)
      If Mid(fic,pp,12)="ProcedureDLL" Or Mid(fic,pp,1)=";" Or Mid(fic,p+Len(nom),1)<>"(":Continue:EndIf  ; !!!     
      
      paramo=listeparam(ll(),fic,p)
      If Bool(Mid(fic,pp,10)="DeclareDLL")
        param=paramx(l(),npf+npo,100,1)
      Else
        paramx(l(),npf+npo,npf,0)
        param=paramo       
        For i=ListSize(ll()) To ListSize(l()) -1
          SelectElement(l(),i)
          param+","+Mid(l(),FindString(l(),"=")+1)
        Next
      EndIf
      
      nums=Str(npo+1)
      fic=ReplaceString(fic,nom,nom+nums,#PB_String_NoCase,p,1)
      fic=ReplaceString(fic,paramo,param,#PB_String_NoCase,p,1)
      If p<pf:pf+Len(nums)+Len(param)-Len(paramo):EndIf
    ForEver
    
  ForEver
  
  ProcedureReturn fic
EndProcedure




Define.s code,fic,chd,chs,   s,libname,pg.i

chs=ProgramParameter(0)
fic=GetFilePart(chs)
libname=Left(fic,FindString(fic,".")-1)
code=parametres_optionels(lirefic(chs))
chd=GetTemporaryDirectory()+"tmp.pb"
ecrirefic(chd,code)

pg=RunProgram(#PB_Compiler_Home+"Compilers\pbcompilerc",chd+" /OPTIMIZER /PURELIBRARY /OUTPUT "+libname,"", #PB_Program_Open|#PB_Program_Read)
While ProgramRunning(pg):If AvailableProgramOutput(pg):s+ReadProgramString(pg) + #CRLF$:EndIf:Wend:CloseProgram(pg)
If s>""
  MessageRequester("Error :",s)
Else
  MessageRequester("Create Lib","Your lib has been created as "+#g+libname+#g+#CRLF$+"Resart your compiler to use it")
EndIf

- to use it as a custom tool:
create an executable

go to
tool -> configure tool
-> new
commandline : select the executable path
Arguments : %FILE
Name : Create Lib

all you have to do is Tools -> Create lib to create / update your lib

PS: this code is a bit messy, if you encounter a problem, please let me know and I'll fix it.

[pf shadoko]

To test a small example:

save this code as ext2D.pb

Code: Select all

DisablePureLibrary ext2D

;============================================================================================ color
;returns a color from its hue, saturation and luminosity
ProcedureDLL.l HSLToRGB(hue.a, saturation.a, lightness.a, alpha=255)
  Protected.f h=hue *6/256
  Protected.f s=saturation/255
  Protected.f l=lightness/255
  Protected.f c,x,r_,v_,b_,m
  c=(1-Abs(2*l-1))*s
  x=c*(1-Abs(Mod(h, 2) -1))
  Select Int(h)
    Case 0:r_=c:v_=x
    Case 1:r_=x:v_=c
    Case 2:v_=c:b_=x
    Case 3:v_=x:b_=c
    Case 4:r_=x:b_=c
    Case 5:r_=c:b_=x
  EndSelect
  m=l-c/2
  Protected r,v,b
  r=Int((r_+m)*255)
  v=Int((v_+m)*255)
  b=Int((b_+m)*255)
  ProcedureReturn RGBA(r,v,b,alpha)
EndProcedure

;returns the color resulting from the mixture of color1 and color2, blend between 0.0 and 1.0
ProcedureDLL.l ColorMix(color1.l, color2.l, blend.f)
  Protected r.w,g.w,b.w,a.w
  r=  Red(color1) + (Red(color2)     - Red(color1)) * blend
  g=Green(color1) + (Green(color2) - Green(color1)) * blend
  b= Blue(color1) + (Blue(color2) -   Blue(color1)) * blend
  a=Alpha(color1) + (Alpha(color2) - Alpha(color1)) * blend
  ProcedureReturn  RGBA(r,g,b,a)
EndProcedure

;============================================================================================ brush
;create a brush form image
ProcedureDLL InitBrush(image,centerx.w=-1,centery.w=-1)
  Structure sbrush
    x.b
    y.b
    col.l
  EndStructure
  
  Protected i,j,d,k,n,c,idx,idy,x,y
  idx=ImageWidth (image):If centerx=-1:centerx=idx/2:EndIf
  idy=ImageHeight(image):If centery=-1:centery=idy/2:EndIf
  Global Dim IFdata.sbrush(idx * idy-1)
  n=-1
  StartDrawing(ImageOutput(image))
  DrawingMode(#PB_2DDrawing_AllChannels)  
  Macro gplot(i,j):x=centerx+i:y=centery+j:If x>=0 And x<idx And y>=0 And y<idy:c=Point(x,y):If c<>0:n+1:IFdata(n)\x=x:IFdata(n)\y=y:IFdata(n)\col=c:EndIf:EndIf:EndMacro
  gplot(0,0)
  For d=1 To 30
    For k=0 To d-1
      gplot(-d+k,-k)
      gplot(k,-d+k)
      gplot(d-k, k)
      gplot(-k,d-k)
    Next
  Next
  ReDim IFdata(n)
  StopDrawing() 
EndProcedure

;Stroke Path with brush to vector drawing output  
ProcedureDLL StrokePathBrush()
  Protected x.f,y.f,j,n,path.s=PathSegments()
  x=PathCursorX()
  y=PathBoundsY()
  n=ArraySize(IFdata())
  For j=n To 0 Step -1
    MovePathCursor(IFdata(j)\x,IFdata(j)\y):VectorSourceColor(IFdata(j)\col):AddPathSegments(path,#PB_Path_Relative):StrokePath(1)
  Next   
EndProcedure

;Fill Path with brush to vector drawing output  
ProcedureDLL FillPathBrush()
  Protected x.f,y.f,j,n,path.s=PathSegments()
  x=PathCursorX()
  y=PathBoundsY()
  n=ArraySize(IFdata())
  For j=n To 0 Step -1
    MovePathCursor(IFdata(j)\x,IFdata(j)\y):VectorSourceColor(IFdata(j)\col):AddPathSegments(path,#PB_Path_Relative):FillPath()
  Next   
EndProcedure

;draw text with brush to vector drawing output  
ProcedureDLL DrawVectorTextBrush(text.s)
  Protected x.f,y.f,j,n
  x=PathCursorX()
  y=PathBoundsY()
  n=ArraySize(IFdata())
  For j=n To 0 Step -1
    MovePathCursor(x+IFdata(j)\x,y+IFdata(j)\y):VectorSourceColor(IFdata(j)\col):DrawVectorText(text)
  Next   
EndProcedure

;draw text with brush to drawing output  
ProcedureDLL DrawTextBrush(x,y,text.s)
  Protected j,n
  n=ArraySize(IFdata())
  For j=n To 0 Step -1
    DrawText(x+IFdata(j)\x,y+IFdata(j)\y,text,IFdata(j)\col,0)
  Next   
EndProcedure

now you have 7 new functions:

- returns a color from its hue, saturation and luminosity
HSLToRGB(hue.a, saturation.a, lightness.a, alpha=255)

- returns the color resulting from the mixture of color1 and color2, blend between 0.0 and 1.0
ColorMix(color1.l, color2.l, blend.f)

- create a brush form image
InitBrush(image,centerx.w=-1,centery.w=-1)

- Stroke Path with brush to vector drawing output
StrokePathBrush()

- Fill Path with brush to vector drawing output
FillPathBrush()

- draw text with brush to vector drawing output
DrawVectorTextBrush(text.s)

- draw text with brush to drawing output
DrawTextBrush(x,y,text.s)

an example of use:

Code: Select all

OpenWindow(0, 0, 0, 512, 256, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
LoadFont(0,"ink free",30)
;----------------------------- create the brush
CreateImage(100,8,8,32,#PB_Image_Transparent)
StartVectorDrawing(ImageVectorOutput(100))
VectorSourceCircularGradient(3,3,5)
VectorSourceGradientColor($ffffffff, 0.0)
VectorSourceGradientColor($ff0000ff, 0.5)
VectorSourceGradientColor($00000000, 1.0) 
AddPathCircle(4,4,4):FillPath()
StopVectorDrawing()
InitBrush(100)

;----------------------------- draw HSL rainbow
CreateImage(0, 512, 256,24,$888888)
StartDrawing(ImageOutput(0))
Box(0, 0, 256, 256, $ffffff)
For j=0 To 255
  For i = 0 To 255
    Plot(i,j, HSLToRGB(i,j,128))
  Next
Next

;----------------------------- draw spheres
DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AlphaBlend)

For j=1 To 4
  n=1<<j
  For i=0 To n-1
    h=(0.5+i)/n*256
    r=50/Sqr(n)
    r=120/n
    x=256+h
    y=16*(i & 1)+330-420/Sqr(n)
    ResetGradientColors()
    GradientColor(0.0,HSLToRGB(h,64,200))
    GradientColor(0.3,HSLToRGB(h,64,128))
    GradientColor(1.0,HSLToRGB(h,64,64))
    CircularGradient(x-r*0.3, y+r*1.2+r*0.5,r)    
    Circle(x,y+r*1.2,r)
    
    ResetGradientColors()
    GradientColor(0.0,HSLToRGB(h,255,255))
    GradientColor(0.3,HSLToRGB(h,255,128))
    GradientColor(1.0,HSLToRGB(h,255,64))
    CircularGradient(x-r*0.3, y-r*0.3,r)    
    Circle(x,y,r)
  Next
Next

DrawingMode(#PB_2DDrawing_AlphaBlend)
DrawingFont(FontID(0))
DrawTextBrush(50,100,"DrawTextBrush")
StopDrawing() 

StartVectorDrawing(ImageVectorOutput(0))
AddPathCircle(50,50,40):StrokePathBrush()
AddPathCircle(150,50,40):FillPathBrush()
StopVectorDrawing()

ImageGadget(0, 0, 0, 200, 200, ImageID(0))
Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow

[ChrisR]

Thank you very much for the Create Lib tool
I followed your tutorial and as expected, everything worked fine.

With AutoComplete and the help in the StatusBar: DrawTextBrush(x,y,text.s) - draw text with brush to drawing output
It would be nice to always have 1 space after each parameter DrawTextBrush(x, y, text.s)

[pf shadoko]

modify parameter spacing in lib code
"create lib” again
restarts compiler

[ChrisR]

Yes, thanks, I've seen in tmp.pb,:

Code: Select all

; QuickHelp HSLToRGB(hue.a, saturation.a, lightness.a, alpha=255) - returns a color from its hue, saturation and luminosity

It's a wink, to your style of writing full of space, otherwise, to nitpick, it could be done and optionaly with [ ] for optional parameters
By the way, beautiful ProcedureDLL sequence for optional parameters

[pf shadoko]

là ou j'habite, l'espace coute cher !
je trouve plus explicite comme ça: là, on connait les valeurs par défaut
(et surtout ça m'évite du code !)

[idle]

Thanks nice tool

I gave it a go with one of my modules that I'd unwrapped and then after a few attempts with it failing. I though well I only need to export the init function and use an interface which I could probably put in to a resident. It compiled but the linker borked when I came to test it.

[pf shadoko]

@Idle
my little tool needs to be improved (for the moment it doesn't handle includes)
you can retrieve the modified pg version in :
GetTemporaryDirectory()+“tmp.pb”.
run it and you'll see where the bug is
tell me what's wrong, I'll fix my tool

[idle]

@Idle
my little tool needs to be improved (for the moment it doesn't handle includes)
you can retrieve the modified pg version in :
GetTemporaryDirectory()+“tmp.pb”.
run it and you'll see where the bug is
tell me what's wrong, I'll fix my tool

There wasn't an issue with your tool, it works well. I'd suggest as an improvement we could add a comment tag to mark a Structure or Interface as ;External so they can be copied out and added into a resident file. I can add that if you want.

[pf shadoko]

it's planned

[idle]

try this

Code: Select all

EnableExplicit

Structure residents 
  *residents 
  len.i 
EndStructure   

Procedure.s lirefic(nom.s,nobom=1)
  Protected txt.s,n,sf
  n=ReadFile(-1,nom)
  sf=ReadStringFormat(n)
  txt=ReadString(n,#PB_File_IgnoreEOL)
  ;If sf<>#PB_Ascii:txt=Mid(txt,2):EndIf
  CloseFile(n)   
  ProcedureReturn txt
EndProcedure

Procedure ecrirefic(nom.s,txt.s,format=#PB_UTF8)
  Protected n
  If FileSize(nom)>=0:DeleteFile(nom):EndIf
  n=OpenFile(-1,nom,format):WriteString(n,txt,format):CloseFile(n)   
EndProcedure

#separateurs=" =:;,()[]{}+-/*.\<>?%|&"+#CR$+#LF$+Chr(34)

Declare.s Stringparse(t.s,before.s,after.s,pi=0)

Procedure.s Stringparse(t.s,before.s,after.s,pi=0)
  Protected pf
  pi=FindString(t,before,pi+1)
  If pi=0:ProcedureReturn:EndIf 
  pf=FindString(t,after,pi):If pf=0:pf=Len(t):EndIf
  pi+Len(before)
  ProcedureReturn Mid(t,pi,pf-pi)
EndProcedure

Procedure FindStringRev(t.s,find.s,p=0,mode=#PB_String_CaseSensitive)
  Protected l=Len(find)
  If p=0:p=Len(t):EndIf
  Repeat
    If p=0 Or Mid(t,p,L)=find:Break:EndIf
    p-1
  ForEver
  ProcedureReturn p
EndProcedure

Procedure.i FindStringww(txt.s,mot.s,p=1,mode=0); findstring whole word
  Repeat
    p=FindString(txt,mot,p,mode):If p=0:Break:EndIf
    If FindString(#separateurs,Mid(txt,p-1,1))>0 And FindString(#separateurs,Mid(txt,p+Len(mot),1))>0:ProcedureReturn p:EndIf
    p+Len(mot)
  ForEver
EndProcedure

Procedure.s ReplaceStringww(txt.s,mot.s,rep.s,p=1,mode=0); ReplaceString whole word
  Protected lm,lr
  
  lm=Len(mot)
  lr=Len(rep)
  Repeat
    p=FindStringww(txt,mot,p+1,mode):If p=0:Break:EndIf
    txt=Left(txt,p-1)+rep+Mid(txt,p+lm)
    p+lm-lr+1
  ForEver
  ProcedureReturn txt
EndProcedure


;####################################################################################################################################################
#g=Chr(34)

Procedure.s codefiltre(txt.s);----- crée une version du code contenant des ";"  à la place des commentaires et des """ dans les strings pour faciliter l'analyse du code
  Protected i,n,ch,co,  c.w
  
  n=Len(txt)
  Dim t.w(n-1)
  CopyMemory(@ txt,@ t(0),n*2)
  For i=0 To n-1
    c=t(i)
    Select c
      Case 34:ch=~ch
      Case 59:co=1
      Case 13:co=0
    EndSelect      
    If ch:c=34 :EndIf
    If co:c=59:EndIf
    t(i)=c
  Next
  CopyMemory(@ t(0),@ txt,n*2)
  ProcedureReturn txt
EndProcedure

Procedure.s listeparam(List p.s(),txt.s,pi=1);----- met les parametres de proc dans une liste et retourne un string contenant les parametres 
  Protected i,n,np,ch,pd,pdc,pfc,finc
  Protected.s c,fct
  ClearList(p())
  
  For i=pi To Len(txt)
    c=Mid(txt,i,1)
    If ch=0
      If c="(":np+1:If np=1:pd=i:pdc=i:EndIf:EndIf
      If c=")":np-1:If np=0:finc=1:EndIf:EndIf
      If c="," And np=1:finc=1:EndIf
      If finc:
        AddElement(p()):p()=Trim(Mid(txt,pdc+1,i-pdc-1)):pdc=i
        If finc And np=0:Break:EndIf
        finc=0
      EndIf
    EndIf
    If c=#g:ch=~ch:EndIf
  Next
  ;ForEach p():Debug p():Next:Debug "---"+Mid(txt,pd+1,i-pd-1):End
  ProcedureReturn Mid(txt,pd+1,i-pd-1)
EndProcedure

Procedure.s paramx(List p.s(), n, nval,declaration) ; <- retourne les parametres sous forme litérales
  Protected i, r.s,v.s
  ForEach p()
    i+1:If i>n:Break:EndIf
    v=StringField(p(),Bool(i>nval)+1,"=")
    If declaration=0 And FindString(v,"("):v=Stringparse(v," ","(")+"()":EndIf
    r+","+v
  Next
  ProcedureReturn Mid(r,2)
EndProcedure

Procedure.s parametres_optionels(fic.s,*Residents.residents) ;-------- gestion des parametres optionnels du fichier fic (il y a tjrs la possibilité de les gérer nous même (si on met les versions numerotées)
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows :#lgsep=#CRLF$
    CompilerCase #PB_OS_Linux   :#lgsep=#LF$
    CompilerCase #PB_OS_MacOS   :#lgsep=#CR$
  CompilerEndSelect
  
  Protected i,n,ni,p,pp,pi,pl,pf,ppi,ppf,num,npo,npf,ok,decl,rl,lr
  Protected.s dossier, fasm,flib,param,paramo, nom,nomnum,  proccode,proccodei,remplace,nums,ret,deb,QuickHelp,ts
  NewList l.s() ; liste parametre
  NewList ll.s(); liste parametre
  
  pf=1
  Repeat
    ;========================================== recup de la Residents
    pi=FindString(fic,"External",pf)
    If pi 
      pf = pi + 8  
      pi = FindString(fic,"Structure",pf) 
      If pi 
        pf=FindString(fic,"EndStructure",pf)+12:
        If pf=12
          Break 
        EndIf   
        ts.s = Mid(fic,pi,pf-pi) + #lgsep + #lgsep
        lr = rl 
        rl + PokeS(*Residents\residents+rl,ts,Len(ts))
        *residents\len = rl
      EndIf   
      pi = FindString(fic,"Interface",pf)  
      If pi 
        pf = pi + 9 
        pf=FindString(fic,"EndInterface",pi)+12:
        If pf =12 
          Break 
        EndIf   
        ts.s = Mid(fic,pi,pf-pi) + #lgsep + #lgsep
        lr = rl 
        rl + PokeS(*Residents\residents+rl,ts,Len(ts))
        *residents\len = rl
      EndIf  
      
    Else   
      
      ;========================================== recup de la Proceduredll
      pi=FindString(fic,"ProcedureDLL",pf):If pi=0:Break:EndIf
      pf=FindString(fic,"EndProcedure",pi)+12:If pf=12:Break:EndIf
      proccode=Mid(fic,pi,pf-pi)
      proccodei=proccode
      
      pl=FindString(proccode,#lgsep)
      nom=Trim(Stringparse(proccode," ","("))
      ok=1:For i=1 To Len(nom):If FindString(#separateurs,Mid(nom,i,1)):ok=0:EndIf:Next:If ok=0 Or nom="":Continue:EndIf
      num=Val(Right(nom,1))
      param=listeparam(l(),proccode)
      
      ;========================================== QuickHelp 
      QuickHelp=" QuickHelp "+nom+"("+param+") - "
      p=FindStringRev(fic,#lgsep,pi-3)+Len(#lgsep)
      If Mid(fic,p,1)=";":p=p+1:Else:p=pi:QuickHelp=";"+QuickHelp+#lgsep:EndIf
      fic =Left(fic ,p-1)+QuickHelp+Mid(fic ,p)
      pi+Len(QuickHelp)
      pf+Len(QuickHelp)
      
      If num:Continue:EndIf; on abandonne si n° à la 1er occurence
      
      ;========================================== suppression de ses valeurs par defaut
      paramo=param
      While FindString(paramo,"="):paramo=ReplaceString(paramo,"="+Stringparse(paramo+",","=",","),""):Wend
      proccode=ReplaceString(proccode,param,paramo)
      
      npo=CountString(param,"="); !!!
      If npo=0:Continue:EndIf   ; on abandonne si nombre de param optionel=0
      
      ;========================================== creation des versions numérotées 
      npf=ListSize(l())-npo
      
      deb=Left(proccode,FindString(proccode,"(")-1)
      nomnum=nom+Str(npo+1)
      remplace=ReplaceString(proccode,nom,nomnum,0 ,1,1)
      If FindString(proccode,"ProcedureReturn")>0:ret="ProcedureReturn ":Else:ret="":EndIf
      For i=npo To 1 Step -1
        If i>1:nums=Str(i):Else:nums="":EndIf
        remplace+#lgsep+deb+nums+"("+paramx(l(),npf+i-1,100,1)+")"+#lgsep+ret+nomnum+"("+paramx(l(),npf+npo,npf+i-1,0)+")"+#lgsep+"EndProcedure"
      Next
      
      fic =Left(fic ,pi-1)+remplace+Mid(fic ,pf)
      pf+Len(remplace)-Len(proccodei)
      
      ;========================================== remplacement des appels de la Proceduredll (et DeclareDLL) par leur version numérotée
      p=0
      Repeat
        p=FindStringww(fic,nom,p+1,#PB_String_NoCase):If p=0:Break:EndIf
        pp=FindStringRev(fic,#lgsep,p)+Len(#lgsep)
        If Mid(fic,pp,12)="ProcedureDLL" Or Mid(fic,pp,1)=";" Or Mid(fic,p+Len(nom),1)<>"(":Continue:EndIf  ; !!!     
        
        paramo=listeparam(ll(),fic,p)
        If Bool(Mid(fic,pp,10)="DeclareDLL")
          param=paramx(l(),npf+npo,100,1)
        Else
          paramx(l(),npf+npo,npf,0)
          param=paramo       
          For i=ListSize(ll()) To ListSize(l()) -1
            SelectElement(l(),i)
            param+","+Mid(l(),FindString(l(),"=")+1)
          Next
        EndIf
        
        nums=Str(npo+1)
        fic=ReplaceString(fic,nom,nom+nums,#PB_String_NoCase,p,1)
        fic=ReplaceString(fic,paramo,param,#PB_String_NoCase,p,1)
        If p<pf:pf+Len(nums)+Len(param)-Len(paramo):EndIf
      ForEver
      
    EndIf 
    
  ForEver
  
  ProcedureReturn fic
EndProcedure

Define.s code,fic,chd,chs,   s,libname,pg.i
Global residents.residents 

chs=ProgramParameter(0)
If FileSize(chs) 
  residents\residents=AllocateMemory(FileSize(chs))
EndIf 

fic=GetFilePart(chs)
libname=Left(fic,FindString(fic,".")-1)
code=parametres_optionels(lirefic(chs),@residents)
chd=GetTemporaryDirectory()+"tmp.pb"
ecrirefic(chd,code)


pg=RunProgram(#PB_Compiler_Home+"Compilers\pbcompilerc",chd+" /THREAD /OPTIMIZER /PURELIBRARY /OUTPUT "+libname,"", #PB_Program_Open|#PB_Program_Read)
While ProgramRunning(pg):If AvailableProgramOutput(pg):s+ReadProgramString(pg) + #CRLF$:EndIf:Wend:CloseProgram(pg)
If s>""
  MessageRequester("Error :",s)
Else
  MessageRequester("Create Lib","Your lib has been created as "+#g+libname+#g+#CRLF$+"Resart your comiler to use it")
EndIf

If residents\len > 0  
  chd=GetTemporaryDirectory()+"tmp.res"
  libname + ".res" 
  code = PeekS(residents\residents,residents\len>>1) 
  
  Debug libname 
  Debug code 
  
  ecrirefic(chd,code)
  
  pg=RunProgram(#PB_Compiler_Home+"Compilers\pbcompilerc",chd+" /RESIDENT "+libname,"", #PB_Program_Open|#PB_Program_Read)
  While ProgramRunning(pg):If AvailableProgramOutput(pg):s+ReadProgramString(pg) + #CRLF$:EndIf:Wend:CloseProgram(pg)
  If s>""
    MessageRequester("Error :",s)
  Else
    CopyFile(libname,#PB_Compiler_Home+"\residents\" + libname) 
    MessageRequester("Create Lib","Your resident has been created as "+#g+libname+#g+#CRLF$+"Resart your comiler to use it")
  EndIf
EndIf 

and example ringbuffer

Code: Select all

Macro RB_Commmnet
  ;  * Portable Audio I/O Library
  ;  * Ring Buffer utility.
  ;  *
  ;  * Author: Phil Burk, http://www.softsynth.com
  ;  * modified For SMP safety on Mac OS X by Bjorn Roche
  ;  * modified For SMP safety on Linux by Leland Lucius
  ;  * also, allowed For const where possible
  ;  * modified For multiple-byte-sized Data elements by Sven Fischer
  ;  *
  ;  * Note that this is safe only For a single-thread reader And a
  ;  * single-thread writer.
  ;  *
  ;  * This program uses the PortAudio Portable Audio Library.
  ;  * For more information see: http://www.portaudio.com
  ;  * Copyright (c) 1999-2000 Ross Bencina And Phil Burk
  ;  *
  ;  * Permission is hereby granted, free of charge, To any person obtaining
  ;  * a copy of this software And associated documentation files
  ;  * (the "Software"), To deal in the Software without restriction,
  ;  * including without limitation the rights To use, copy, modify, merge,
  ;  * publish, distribute, sublicense, And/Or sell copies of the Software,
  ;  * And To permit persons To whom the Software is furnished To do so,
  ;  * subject To the following conditions:
  ;  *
  ;  * The above copyright notice And this permission notice shall be
  ;  * included in all copies Or substantial portions of the Software.
  ;  *
  ;  * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  ;  * EXPRESS Or IMPLIED, INCLUDING BUT Not LIMITED To THE WARRANTIES OF
  ;  * MERCHANTABILITY, FITNESS For A PARTICULAR PURPOSE And NONINFRINGEMENT.
  ;  * IN NO EVENT SHALL THE AUTHORS Or COPYRIGHT HOLDERS BE LIABLE For
  ;  * ANY CLAIM, DAMAGES Or OTHER LIABILITY, WHETHER IN AN ACTION OF
  ;  * CONTRACT, TORT Or OTHERWISE, ARISING FROM, OUT OF Or IN CONNECTION
  ;  * With THE SOFTWARE Or THE USE Or OTHER DEALINGS IN THE SOFTWARE.
  ;  */
  ; 
  ; /*
  ;  * The text above constitutes the entire PortAudio license; however,
  ;  * the PortAudio community also makes the following non-binding requests:
  ;  *
  ;  * Any person wishing To distribute modifications To the Software is
  ;  * requested To send the modifications To the original developer so that
  ;  * they can be incorporated into the canonical version. It is also
  ;  * requested that these non-binding requests be included along With the
  ;  * license above.
  ;  */
  ;  
  ;  Ported and adapted by Idle for PB 6.0 x86/x64 asm and cbackend 
EndMacro 

DisablePureLibrary TTimer

Structure RingBuffer_Ar 
  e.a[0]   
EndStructure

;External 
Structure RingBuffer 
  stop.i
  bufferSize.i
  writeIndex.i
  readIndex.i
  bigMask.i
  smallMask.i
  elementSizeBytes.i 
  *buffer.Ringbuffer_Ar 
EndStructure   

Macro FullMemoryBarrier() 
  CompilerIf #PB_Compiler_Backend = #PB_Backend_Asm     
    !mfence 
  CompilerElse 
    !__sync_synchronize(); 
  CompilerEndIf   
EndMacro 

Macro WriteMemoryBarrier()
  CompilerIf #PB_Compiler_Backend = #PB_Backend_Asm  
    !sfence 
  CompilerElse  
    !__sync_synchronize(); 
  CompilerEndIf   
EndMacro 

Macro ReadMemoryBarrier() 
  CompilerIf #PB_Compiler_Backend = #PB_Backend_Asm   
    !lfence
  CompilerElse  
    !__sync_synchronize();
  CompilerEndIf    
EndMacro 

ProcedureCDLL RB_Initialize(*rb.RingBuffer,elementSizeBytes,elementCount)
  
  If(((elementCount-1) & elementCount) <> 0) ;element count must be power of 2 
    ProcedureReturn -1
  EndIf  
  
  *rb\bufferSize = elementCount
  *rb\buffer = AllocateMemory(elementCount*elementSizeBytes)  
  *rb\bigMask = (elementCount*2)-1
  *rb\smallMask = (elementCount)-1
  *rb\elementSizeBytes = elementSizeBytes
  
  ProcedureReturn *rb\buffer 
  
EndProcedure 

ProcedureCDLL RB_Free(*rb.RingBuffer) 
  
  If *rb 
    If *rb\buffer 
      FreeMemory(*rb\buffer) 
      *rb\buffer = #Null 
    EndIf 
  EndIf
  
EndProcedure   

Procedure RB_GetReadAvailable(*rb.RingBuffer)
  
  ProcedureReturn((*rb\writeIndex - *rb\readIndex) & *rb\bigMask)
  
EndProcedure 

Procedure RB_GetWriteAvailable(*rb.RingBuffer)
  
  ProcedureReturn(*rb\bufferSize - RB_GetReadAvailable(*rb))
  
EndProcedure 

Procedure RB_Flush(*rb.RingBuffer)
  
  *rb\writeIndex = 0 
  *rb\readIndex = 0
  
EndProcedure 

Procedure RB_GetWriteRegions(*rb.RingBuffer,elementCount,*dataPtr1.integer,*sizePtr1.integer,*dataPtr2.integer,*sizePtr2.integer )
  Protected index.i, available.i
  
  available.i = RB_GetWriteAvailable(*rb)
  
  If elementCount > available 
    elementCount = available
  EndIf   
  
  index = (*rb\writeIndex & *rb\smallMask)
  
  If(index + elementCount) > *rb\bufferSize 
    firstHalf = *rb\bufferSize - index
    *dataPtr1\i = @*rb\buffer\e[index * *rb\elementSizeBytes]
    *sizePtr1\i = firstHalf
    *dataPtr2\i = @*rb\buffer\e[0]
    *sizePtr2\i = elementCount - firstHalf
  Else
    *dataPtr1\i = @*rb\buffer\e[index * *rb\elementSizeBytes]
    *sizePtr1\i = elementCount
    *dataPtr2\i = #Null
    *sizePtr2\i = 0
  EndIf 
  
  If available 
    FullMemoryBarrier() 
  EndIf 
  
  ProcedureReturn elementCount
  
EndProcedure 

Procedure RB_AdvanceWriteIndex(*rb.RingBuffer,elementCount.i)
  Protected index,*ptr  
  
  WriteMemoryBarrier()
  *rb\writeIndex = (*rb\writeIndex + elementCount) & *rb\bigMask
  
  ProcedureReturn *rb\writeIndex
  
EndProcedure 

Procedure RB_GetReadRegions(*Rb.RingBuffer,elementCount,*dataPtr1.integer,*sizePtr1.integer,*dataPtr2.integer,*sizePtr2.integer)
  Protected index.i,firsthalf.i,available.i
  
  available.i = RB_GetReadAvailable(*rb)
  
  If( elementCount > available ) 
    elementCount = available
  EndIf   
  
  index = (*rb\readIndex & *rb\smallMask)
  
  If((index + elementCount) > *rb\bufferSize )
    firstHalf = *rb\bufferSize - index
    *dataPtr1\i = @*rb\buffer\e[index * *rb\elementSizeBytes]
    *sizePtr1\i = firstHalf
    *dataPtr2\i = @*rb\buffer\e[0]
    *sizePtr2\i = elementCount - firstHalf
  Else
    *dataPtr1\i = @*rb\buffer\e[index * *rb\elementSizeBytes]
    *sizePtr1\i = elementCount
    *dataPtr2\i = 0
    *sizePtr2\i = 0
  EndIf 
  
  If( available )
    ReadMemoryBarrier() 
  EndIf 
  
  ProcedureReturn elementCount
  
EndProcedure 

Procedure RB_AdvanceReadIndex(*rb.RingBuffer,elementCount)
  
  FullMemoryBarrier()
  
  *rb\readIndex = (*rb\readIndex + elementCount) & *rb\bigMask
  
  ProcedureReturn *rb\readIndex
  
EndProcedure 

ProcedureCDLL RB_Write(*rb.RingBuffer,*Data,elementCount)
  Protected size1, size2, numWritten
  Protected data1, data2
  
  numWritten = RB_GetWriteRegions(*rb,elementCount,@data1, @size1, @data2, @size2)
  
  If( size2 > 0 )
    CopyMemory(*Data,data1,size1 * *rb\elementSizeBytes)
    *data + (size1 * *rb\elementSizeBytes)
    CopyMemory(*Data,data2,size2 * *rb\elementSizeBytes)
  Else
    CopyMemory(*Data,data1, size1 * *rb\elementSizeBytes )
  EndIf 
  
  RB_AdvanceWriteIndex(*rb,numWritten)
  
  ProcedureReturn numWritten                 
  
EndProcedure 

ProcedureCDLL RB_Read(*rb.RingBuffer,*Data,elementCount)
  Protected size1, size2, numRead
  Protected data1, data2
  
  numRead = RB_GetReadRegions(*rb,elementCount,@data1,@size1,@data2,@size2 )
  
  If( size2 > 0 )
    CopyMemory(data1,*data,size1 * *rb\elementSizeBytes )
    *Data + size1 * *rb\elementSizeBytes
    CopyMemory(data2,*Data,size2 * *rb\elementSizeBytes )
  Else
    CopyMemory(data1,*Data,size1 * *rb\elementSizeBytes )
  EndIf 
  
  RB_AdvanceReadIndex(*rb,numRead)
  
  ProcedureReturn numRead                
  
EndProcedure 

CompilerIf #PB_Compiler_Debugger
  
  Procedure Producer(*RB.RingBuffer) 
    
    Protected num 
    Dim inputs.f(64) 
    
    Repeat 
      
      For a = 0 To 63
        inputs(a) = ct 
        ct+1 
      Next 
      
      num = RB_Write(*RB,@inputs(0),64) ;write 64 elements to the ring if full it will return 0  
      
      Debug "num write " + Str(num) 
      
      Delay(Random(100,20))  
      
    Until *RB\stop 
    
  EndProcedure 
  
  
  Procedure Consumer(*RB.RingBuffer) 
    
    et= ElapsedMilliseconds() + 10000
    Dim outputs.f(64) 
    
    Repeat 
      
      num = RB_Read(*RB,@outputs(0),64)  ;read 64 elements off ring if empty it will return 0 
      
      Debug "num read " + Str(num) + " " + StrF(outputs(0),3)      
      
      Delay(Random(100,20))  
      
    Until ElapsedMilliseconds() > et       
    
    *rb\stop = 1 ;stop buffering  
    
  EndProcedure   
  
  
  Global RB.RingBuffer                  ;decalre a RB              
  RB_Initialize(@RB,SizeOf(float),1024) ;set the size in bytes of elements and the number or elements 
  
  t1 = CreateThread(@Producer(),@RB)    ;create writer thread 
  t2 = CreateThread(@consumer(),@RB)    ;create reader thread 
  
  WaitThread(t2) 
  
CompilerEndIf 

Once prototypes and constants are added it should be complete

I just tested it with squint and it works but only with the c backend since it's got c specific code.

Tip if you use an interface you can just export the new function that allocates and initializes your interface and then it will compile the whole lib irrespective of optional parameters. However the interface is borked as it shows unhelpful parameters such as squint\set(a.i,b.i,c.i,d.i) so probably need to add quick help to the fields?

[pf shadoko]

great,
can we add macros too?

[idle]

Yes absolutely that's a must have.

[ChrisR]

Nice addition
Could we add constants to the resident file as well, using the flag ;External before each constant to add

[idle]

macros added and untested enumerations which might need the enumerations stripped and preprocessed ?

Code: Select all

EnableExplicit

Structure residents 
  *residents 
  len.i 
EndStructure   

Procedure.s lirefic(nom.s,nobom=1)
  Protected txt.s,n,sf
  n=ReadFile(-1,nom)
  sf=ReadStringFormat(n)
  txt=ReadString(n,#PB_File_IgnoreEOL)
  ;If sf<>#PB_Ascii:txt=Mid(txt,2):EndIf
  CloseFile(n)   
  ProcedureReturn txt
EndProcedure

Procedure ecrirefic(nom.s,txt.s,format=#PB_UTF8)
  Protected n
  If FileSize(nom)>=0:DeleteFile(nom):EndIf
  n=OpenFile(-1,nom,format):WriteString(n,txt,format):CloseFile(n)   
EndProcedure

#separateurs=" =:;,()[]{}+-/*.\<>?%|&"+#CR$+#LF$+Chr(34)

Declare.s Stringparse(t.s,before.s,after.s,pi=0)

Procedure.s Stringparse(t.s,before.s,after.s,pi=0)
  Protected pf
  pi=FindString(t,before,pi+1)
  If pi=0:ProcedureReturn:EndIf 
  pf=FindString(t,after,pi):If pf=0:pf=Len(t):EndIf
  pi+Len(before)
  ProcedureReturn Mid(t,pi,pf-pi)
EndProcedure

Procedure FindStringRev(t.s,find.s,p=0,mode=#PB_String_CaseSensitive)
  Protected l=Len(find)
  If p=0:p=Len(t):EndIf
  Repeat
    If p=0 Or Mid(t,p,L)=find:Break:EndIf
    p-1
  ForEver
  ProcedureReturn p
EndProcedure

Procedure.i FindStringww(txt.s,mot.s,p=1,mode=0); findstring whole word
  Repeat
    p=FindString(txt,mot,p,mode):If p=0:Break:EndIf
    If FindString(#separateurs,Mid(txt,p-1,1))>0 And FindString(#separateurs,Mid(txt,p+Len(mot),1))>0:ProcedureReturn p:EndIf
    p+Len(mot)
  ForEver
EndProcedure

Procedure.s ReplaceStringww(txt.s,mot.s,rep.s,p=1,mode=0); ReplaceString whole word
  Protected lm,lr
  
  lm=Len(mot)
  lr=Len(rep)
  Repeat
    p=FindStringww(txt,mot,p+1,mode):If p=0:Break:EndIf
    txt=Left(txt,p-1)+rep+Mid(txt,p+lm)
    p+lm-lr+1
  ForEver
  ProcedureReturn txt
EndProcedure


;####################################################################################################################################################
#g=Chr(34)

Procedure.s codefiltre(txt.s);----- crée une version du code contenant des ";"  à la place des commentaires et des """ dans les strings pour faciliter l'analyse du code
  Protected i,n,ch,co,  c.w
  
  n=Len(txt)
  Dim t.w(n-1)
  CopyMemory(@ txt,@ t(0),n*2)
  For i=0 To n-1
    c=t(i)
    Select c
      Case 34:ch=~ch
      Case 59:co=1
      Case 13:co=0
    EndSelect      
    If ch:c=34 :EndIf
    If co:c=59:EndIf
    t(i)=c
  Next
  CopyMemory(@ t(0),@ txt,n*2)
  ProcedureReturn txt
EndProcedure

Procedure.s listeparam(List p.s(),txt.s,pi=1);----- met les parametres de proc dans une liste et retourne un string contenant les parametres 
  Protected i,n,np,ch,pd,pdc,pfc,finc
  Protected.s c,fct
  ClearList(p())
  
  For i=pi To Len(txt)
    c=Mid(txt,i,1)
    If ch=0
      If c="(":np+1:If np=1:pd=i:pdc=i:EndIf:EndIf
      If c=")":np-1:If np=0:finc=1:EndIf:EndIf
      If c="," And np=1:finc=1:EndIf
      If finc:
        AddElement(p()):p()=Trim(Mid(txt,pdc+1,i-pdc-1)):pdc=i
        If finc And np=0:Break:EndIf
        finc=0
      EndIf
    EndIf
    If c=#g:ch=~ch:EndIf
  Next
  ;ForEach p():Debug p():Next:Debug "---"+Mid(txt,pd+1,i-pd-1):End
  ProcedureReturn Mid(txt,pd+1,i-pd-1)
EndProcedure

Procedure.s paramx(List p.s(), n, nval,declaration) ; <- retourne les parametres sous forme litérales
  Protected i, r.s,v.s
  ForEach p()
    i+1:If i>n:Break:EndIf
    v=StringField(p(),Bool(i>nval)+1,"=")
    If declaration=0 And FindString(v,"("):v=Stringparse(v," ","(")+"()":EndIf
    r+","+v
  Next
  ProcedureReturn Mid(r,2)
EndProcedure

Procedure.s parametres_optionels(fic.s,*Residents.residents) ;-------- gestion des parametres optionnels du fichier fic (il y a tjrs la possibilité de les gérer nous même (si on met les versions numerotées)
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows :#lgsep=#CRLF$
    CompilerCase #PB_OS_Linux   :#lgsep=#LF$
    CompilerCase #PB_OS_MacOS   :#lgsep=#CR$
  CompilerEndSelect
  
  Protected i,n,ni,p,pp,pi,pl,pf,ppi,ppf,num,npo,npf,ok,decl,rl,lr
  Protected.s dossier, fasm,flib,param,paramo, nom,nomnum,  proccode,proccodei,remplace,nums,ret,deb,QuickHelp,ts
  NewList l.s() ; liste parametre
  NewList ll.s(); liste parametre
  
  pf=1
  Repeat
    ;========================================== recup de la Residents
    pi=FindString(fic,"External",pf)
    If pi 
      pf = pi + 8  
      pi = FindString(fic,"Structure",pf) 
      If pi 
        pf=FindString(fic,"EndStructure",pf)+12:
        If pf=12
          Break 
        EndIf   
        ts.s = Mid(fic,pi,pf-pi) + #lgsep + #lgsep
        lr = rl 
        rl + PokeS(*Residents\residents+rl,ts,Len(ts))
        *residents\len = rl
      EndIf   
      pi = FindString(fic,"Interface",pf)  
      If pi 
        pf = pi + 9 
        pf=FindString(fic,"EndInterface",pi)+12:
        If pf =12 
          Break 
        EndIf   
        ts.s = Mid(fic,pi,pf-pi) + #lgsep + #lgsep
        lr = rl 
        rl + PokeS(*Residents\residents+rl,ts,Len(ts))
        *residents\len = rl
      EndIf  
      pi = FindString(fic,"Macro",pf)  
      If pi 
        pf = pi + 9 
        pf=FindString(fic,"EndMacro",pi)+8
        If pf =8 
          Break 
        EndIf   
        ts.s = Mid(fic,pi,pf-pi) + #lgsep + #lgsep
        lr = rl 
        rl + PokeS(*Residents\residents+rl,ts,Len(ts))
        *residents\len = rl
      EndIf  
      pi = FindString(fic,"Enumeration",pf)  
      If pi 
        pf = pi + 9 
        pf=FindString(fic,"EndEnumeration",pi)+14
        If pf =14 
          Break 
        EndIf   
        ts.s = Mid(fic,pi,pf-pi) + #lgsep + #lgsep
        lr = rl 
        rl + PokeS(*Residents\residents+rl,ts,Len(ts))
        *residents\len = rl
      EndIf  
      pi = FindString(fic,"EnumerationBinary",pf)  
      If pi 
        pf = pi + 9 
        pf=FindString(fic,"EndEnumeration",pi)+14
        If pf =14 
          Break 
        EndIf   
        ts.s = Mid(fic,pi,pf-pi) + #lgsep + #lgsep
        lr = rl 
        rl + PokeS(*Residents\residents+rl,ts,Len(ts))
        *residents\len = rl
      EndIf  
           
      
    Else   
      
      ;========================================== recup de la Proceduredll
      pi=FindString(fic,"ProcedureDLL",pf):If pi=0:Break:EndIf
      pf=FindString(fic,"EndProcedure",pi)+12:If pf=12:Break:EndIf
      proccode=Mid(fic,pi,pf-pi)
      proccodei=proccode
      
      pl=FindString(proccode,#lgsep)
      nom=Trim(Stringparse(proccode," ","("))
      ok=1:For i=1 To Len(nom):If FindString(#separateurs,Mid(nom,i,1)):ok=0:EndIf:Next:If ok=0 Or nom="":Continue:EndIf
      num=Val(Right(nom,1))
      param=listeparam(l(),proccode)
      
      ;========================================== QuickHelp 
      QuickHelp=" QuickHelp "+nom+"("+param+") - "
      p=FindStringRev(fic,#lgsep,pi-3)+Len(#lgsep)
      If Mid(fic,p,1)=";":p=p+1:Else:p=pi:QuickHelp=";"+QuickHelp+#lgsep:EndIf
      fic =Left(fic ,p-1)+QuickHelp+Mid(fic ,p)
      pi+Len(QuickHelp)
      pf+Len(QuickHelp)
      
      If num:Continue:EndIf; on abandonne si n° à la 1er occurence
      
      ;========================================== suppression de ses valeurs par defaut
      paramo=param
      While FindString(paramo,"="):paramo=ReplaceString(paramo,"="+Stringparse(paramo+",","=",","),""):Wend
      proccode=ReplaceString(proccode,param,paramo)
      
      npo=CountString(param,"="); !!!
      If npo=0:Continue:EndIf   ; on abandonne si nombre de param optionel=0
      
      ;========================================== creation des versions numérotées 
      npf=ListSize(l())-npo
      
      deb=Left(proccode,FindString(proccode,"(")-1)
      nomnum=nom+Str(npo+1)
      remplace=ReplaceString(proccode,nom,nomnum,0 ,1,1)
      If FindString(proccode,"ProcedureReturn")>0:ret="ProcedureReturn ":Else:ret="":EndIf
      For i=npo To 1 Step -1
        If i>1:nums=Str(i):Else:nums="":EndIf
        remplace+#lgsep+deb+nums+"("+paramx(l(),npf+i-1,100,1)+")"+#lgsep+ret+nomnum+"("+paramx(l(),npf+npo,npf+i-1,0)+")"+#lgsep+"EndProcedure"
      Next
      
      fic =Left(fic ,pi-1)+remplace+Mid(fic ,pf)
      pf+Len(remplace)-Len(proccodei)
      
      ;========================================== remplacement des appels de la Proceduredll (et DeclareDLL) par leur version numérotée
      p=0
      Repeat
        p=FindStringww(fic,nom,p+1,#PB_String_NoCase):If p=0:Break:EndIf
        pp=FindStringRev(fic,#lgsep,p)+Len(#lgsep)
        If Mid(fic,pp,12)="ProcedureDLL" Or Mid(fic,pp,1)=";" Or Mid(fic,p+Len(nom),1)<>"(":Continue:EndIf  ; !!!     
        
        paramo=listeparam(ll(),fic,p)
        If Bool(Mid(fic,pp,10)="DeclareDLL")
          param=paramx(l(),npf+npo,100,1)
        Else
          paramx(l(),npf+npo,npf,0)
          param=paramo       
          For i=ListSize(ll()) To ListSize(l()) -1
            SelectElement(l(),i)
            param+","+Mid(l(),FindString(l(),"=")+1)
          Next
        EndIf
        
        nums=Str(npo+1)
        fic=ReplaceString(fic,nom,nom+nums,#PB_String_NoCase,p,1)
        fic=ReplaceString(fic,paramo,param,#PB_String_NoCase,p,1)
        If p<pf:pf+Len(nums)+Len(param)-Len(paramo):EndIf
      ForEver
      
    EndIf 
    
  ForEver
  
  ProcedureReturn fic
EndProcedure

Define.s code,fic,chd,chs,   s,libname,pg.i
Global residents.residents 

chs=ProgramParameter(0)
If FileSize(chs) 
  residents\residents=AllocateMemory(FileSize(chs))
EndIf 

fic=GetFilePart(chs)
libname=Left(fic,FindString(fic,".")-1)
code=parametres_optionels(lirefic(chs),@residents)
chd=GetTemporaryDirectory()+"tmp.pb"
ecrirefic(chd,code)


pg=RunProgram(#PB_Compiler_Home+"Compilers\pbcompilerc",chd+" /THREAD /OPTIMIZER /PURELIBRARY /OUTPUT "+libname,"", #PB_Program_Open|#PB_Program_Read)
While ProgramRunning(pg):If AvailableProgramOutput(pg):s+ReadProgramString(pg) + #CRLF$:EndIf:Wend:CloseProgram(pg)
If s>""
  MessageRequester("Error :",s)
Else
  MessageRequester("Create Lib","Your lib has been created as "+#g+libname+#g+#CRLF$+"Resart your comiler to use it")
EndIf

If residents\len > 0  
  chd=GetTemporaryDirectory()+"tmp.res"
  libname + ".res" 
  code = PeekS(residents\residents,residents\len>>1) 
  
  Debug libname 
  Debug code 
  
  ecrirefic(chd,code)
  
  pg=RunProgram(#PB_Compiler_Home+"Compilers\pbcompilerc",chd+" /RESIDENT "+libname,"", #PB_Program_Open|#PB_Program_Read)
  While ProgramRunning(pg):If AvailableProgramOutput(pg):s+ReadProgramString(pg) + #CRLF$:EndIf:Wend:CloseProgram(pg)
  If s>""
    MessageRequester("Error :",s)
  Else
    CopyFile(libname,#PB_Compiler_Home+"\residents\" + libname) 
    MessageRequester("Create Lib","Your resident has been created as "+#g+libname+#g+#CRLF$+"Resart your comiler to use it")
  EndIf
EndIf 

I'm pondering how to better do this better for constants and prototypes you don't really want to write External before every constant or prototype so maybe better to add a block Externals EndExternals so it can make the resident file
Also I want to work out how to get the parameters for the interfaces, the whole point of using an interface is to make it easy for the users of a lib, no messing around looking for functions as they appear under the autocomplete

it might make more sense to generate a header so it can be imported with xIncludeFile but you need to use the full path to open it in the ide. So by adding XIncludeFile "C:\PureBasic\PureLibraries\UserLibraries\squintlib.pbi"
I get all that's needed for the ide once I open it. I thought the ide scanned xinclude files for their symbols without having to open them, maybe I was mistaken.