- Resident management (thanks to ChrisR)
- “IncludeFile” management (which may contain “ProcedureDLL”)
- Modification by Fred for multi-platform (among other things)
- bug fix for the procedureDLL in comment
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
OpenConsole()
#separateurs=" =:;,()[]{}+-/*.\<>?%|&"+#CR$+#LF$+Chr(34)
Procedure.s ReadTextFile(name.s,nobom=1,EOLvbcr=1)
Protected txt.s,n,sf
n=ReadFile(-1,name)
sf=ReadStringFormat(n)
txt=ReadString(n,sf|#PB_File_IgnoreEOL)
If EOLvbcr:txt=ReplaceString(txt,#CRLF$,#LF$):txt=ReplaceString(txt,#CR$,#LF$):txt=ReplaceString(txt,#LF$,#CRLF$):EndIf
CloseFile(n)
ProcedureReturn txt
EndProcedure
Procedure WriteTextFile(name.s,txt.s,format=#PB_UTF8)
Protected n
If FileSize(name)>=0:DeleteFile(name):EndIf
n=OpenFile(-1,name,format):WriteString(n,txt,format):CloseFile(n)
EndProcedure
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); reverse
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
;####################################################################################################################################################
Global.s src,code,rsdt,fic,chd,chs,s,libname,Flag,msg,pg.i
Define Parameter$, NoGUI, NoResident, CompilerC$, ExitCode
Procedure.s codefiltre(txt.s) ;-------- creates a version of the code containing “;” instead of comments and “”" in strings to facilitate code analysis
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) ;-------- puts the procedure parameters in a list and returns a string containing the parameters
Protected i,np,ch,pd,pdc,finc,c.s
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=#DQUOTE$: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) ;-------- returns the parameters as literals
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 resident(fic.s) ;-------- extract the resident part of the code (between ";Residents" and ";EndResidents")
Protected.s rl,lr,ts
Protected pi,pf
pf=1
Repeat
pi=FindString(fic,";Residents",pf,#PB_String_NoCase):If pi=0:Break:EndIf
pf=FindString(fic,";EndResidents",pi+10,#PB_String_NoCase)+13:If pf=13:Break: EndIf
ts=Mid(fic,pi,pf-pi)
fic=ReplaceString(fic,ts,"") ; the extracted code must be deleted in fic to avoid the error: xxx already declared: xxx (in a resident file)
pf=pi
ts=Mid(ts,11,Len(ts)-10-13) ; extracted code without both flags
rl+ts
ForEver
ProcedureReturn rl
EndProcedure
Procedure.s parametres_optionels(fic.s) ;-------- management of optional parameters (it is always possible to manage them ourselves (if we use numbered versions)
#lgsep=#CRLF$
Protected i,p,pp,pi,pl,pdl,pf,num,npo,npf,ok
Protected.s param,paramo,nom,nomnum,proccode,proccodei,remplace,nums,ret,deb,QuickHelp,ts
NewList l.s() ; liste parametre
NewList ll.s()
pf=1
Repeat
;========================================== recovery of the ProcedureDLL
pi=FindString(fic,"ProcedureDLL",pf):If pi=0:Break:EndIf
pf=FindString(fic,"EndProcedure",pi)+12:If pf=12:Break:EndIf
pdl=FindStringRev(fic,#lgsep,pi):If FindString(Mid(fic,pdl+1,pi-pdl),";"):Continue:EndIf ; if it's a comment, continue
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
p=FindStringRev(fic,#lgsep,pi-3)+Len(#lgsep)
If Mid(fic,p,11)="; QuickHelp"
QuickHelp=""
Else
QuickHelp=" QuickHelp "+nom+"("+param+") - "
If Mid(fic,p,1)=";":p=p+1:Else:p=pi:QuickHelp=";"+QuickHelp+#lgsep:EndIf
EndIf
fic =Left(fic ,p-1)+QuickHelp+Mid(fic ,p)
pi+Len(QuickHelp)
pf+Len(QuickHelp)
If num:Continue:EndIf; we give up if number at the first occurrence
;========================================== removal of its default values
paramo=param
While FindString(paramo,"="):paramo=ReplaceString(paramo,"="+Stringparse(paramo+",","=",","),""):Wend
proccode=ReplaceString(proccode,param,paramo)
npo=CountString(param,"="); !!!
If npo=0:Continue:EndIf ; we give up if no optional parameter
;========================================== creation of numbered versions
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)
;========================================== Replacement of ProcedureDLL (and DeclareDLL) calls with their numbered versions
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
Procedure.s include(src.s) ;-------- includes the include files
Protected p,pg1,pg2,fici.s,g.s=Chr(34)
Static.s linclude=",", srcinc
Macro minclude(inctype,verif)
p=0
Repeat
p=FindStringww(src,inctype,p+1)
If p=0:ProcedureReturn src:EndIf
pg1=FindString(src,g,p)+1
pg2=FindString(src,g,pg1)
fici= Mid(src,pg1,pg2-pg1)
srcinc=ReadTextFile(fici):include(srcinc)
If verif And FindString(linclude,","+fici+","):Continue:EndIf
src=Left(src,p-1)+srcinc+Mid(src,pg2+1)
linclude+fici+","
ForEver
EndMacro
minclude("IncludeFile",0)
minclude("XIncludeFile",1)
ProcedureReturn src
EndProcedure
; Parse the commandline parameters
;
Repeat
Parameter$ = ProgramParameter()
Select UCase(Parameter$)
Case "/NORESIDENT", "--NORESIDENT"
NoResident = 1
Case "/NOGUI", "--NOGUI"
NoGUI = 1
Case "/?", "--HELP"
PrintN("PureLibrary helper:")
PrintN("")
PrintN("/NORESIDENT, --noresident: don't create specific resident file.")
PrintN("/NOGUI, --nogui : disable message requesters for errors.")
PrintN("")
End 0
Default
If Parameter$ <> ""
If chs = ""
chs=Parameter$
Else ; Invalid commandline option
ConsoleError("Invalid commandline option specified: " + Parameter$)
End 1
EndIf
EndIf
EndSelect
Until Parameter$ = ""
CompilerIf #PB_Compiler_Debugger ; for test
;chs="C:\PureBasic-code\shader\CreateMaterialEx.pb"
;chs="C:\PureBasic-code\lib\ext2d.pb"
chs="C:\purebasic-fred\v6.30\PB-divers\ScreenGadget\screengadget.pb"
CompilerEndIf
; Ensures we have a filename to process
If chs = ""
ConsoleError("A source file name needs to be specified.")
End 1
EndIf
fic=GetFilePart(chs)
libname=Left(fic,FindString(fic,".")-1)
SetCurrentDirectory(GetPathPart(chs))
src=ReadTextFile(chs)
src=include(src)
code=parametres_optionels(src)
rsdt=resident(src)
If NoResident = 0 And rsdt <>"" ;-------- write resident and compile
chd=GetTemporaryDirectory()+"tmp.res"
WriteTextFile(chd,rsdt)
pg=RunProgram(#PB_Compiler_Home+"Compilers\pbcompiler",chd+" /IGNORERESIDENT "+libname+" /RESIDENT "+#PB_Compiler_Home+"\residents\"+libname+".res","", #PB_Program_Open|#PB_Program_Read)
While ProgramRunning(pg):If AvailableProgramOutput(pg):s+ReadProgramString(pg)+#CRLF$:EndIf:Wend
ExitCode = ProgramExitCode(pg)
CloseProgram(pg)
If ExitCode <> 0
If NoGUI
PrintN("Create Resident Error: Resident Source File: %Temp%\tmp.res: " + s)
Else
MessageRequester("Create Resident Error:","Resident Source File: %Temp%\tmp.res"+#CRLF$+#CRLF$+s)
EndIf
End 1
Else
msg="Your Resident has been Created as "+#DQUOTE$+libname+#DQUOTE$+#CRLF$+#CRLF$
EndIf
EndIf
;-------- write library and compile
chd=GetTemporaryDirectory()+"tmp.pb"
WriteTextFile(chd,code)
;Debug libname+#CRLF$+"==>"+#CRLF$+code+#CRLF$+"----------"
pg = FindString(code,"; IDE Options = PureBasic",2) ;Get compiler options, If Save Settings is to the end of the source file
If pg
code=Mid(code,pg);+50
; These options makes no sense for a pure library creation
;If FindString(code,"EnableThread",2) :Flag+" /THREAD" :EndIf
;If FindString(code,"EnableOnError",2):Flag+" /LINENUMBERING":EndIf
EndIf
; Use the Linux/MacOS flag style which also works on Windows
Flag+" --optimizer --purelibrary --output "
;Debug "Flag: "+Flag
; Only Windows x86 and x64 and Linux x86 and x64 have the ASM backend as default
CompilerIf (#PB_Compiler_Processor = #PB_Processor_x64 Or #PB_Compiler_Processor = #PB_Processor_x86) And (#PB_Compiler_OS = #PB_OS_Windows Or #PB_Compiler_OS = #PB_OS_Linux)
CompilerC$ = "pbcompilerc"
CompilerElse
CompilerC$ = "pbcompiler"
CompilerEndIf
pg=RunProgram(#PB_Compiler_Home+"compilers/"+CompilerC$,chd+Flag+libname,"", #PB_Program_Open|#PB_Program_Read)
While ProgramRunning(pg):If AvailableProgramOutput(pg):s+ReadProgramString(pg)+#CRLF$:EndIf:Wend
ExitCode = ProgramExitCode(pg)
CloseProgram(pg)
If ExitCode <> 0
If NoGUI
PrintN("Create Lib Error: Library Source File: %Temp%\tmp.pb: "+s)
Else
MessageRequester("Create Lib Error:","Library Source File: %Temp%\tmp.pb"+#CRLF$+#CRLF$+s)
EndIf
End 1
Else
msg + "The Library has been created as " + #DQUOTE$+libname+#DQUOTE$
If NoGUI
PrintN(msg)
Else
msg + #CRLF$+#CRLF$+"Restart the Compiler to use it."
MessageRequester("Create Lib",msg)
EndIf
EndIf
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.
