'Fbdebugger entirely written with FBC ' fbdebugger2 0.1 '==================================== Dim Shared As Long screenw=900,screenh=600 Screenres screenw,screenh,32 '07/02/2014 Color RGB(80,80,80),RGB(220,220,220) Width 800\8, 600\8 '' Use 8*8 font(0,0 Cls '=================== DECLARATIONS ==================================== Declare Sub code_display(file As Long,Linesel As Long=-1) '===================================================================== Dim txt As String Dim As long ps,dw,xm,ym,bm,xmold,ymold,curlig=5 'codes #Define KMAXCODES 10 'base index =0 Dim Shared As String codename(KMAXCODES) Dim Shared As String codesrc(KMAXCODES,500) '4 files / 501 lines max Dim Shared As Long linesnb(KMAXCODES) Dim Shared As Long codebeg(KMAXCODES) Dim Shared As Long codedecal(KMAXCODES) Dim Shared As Long codenb,codecur=0,codeshw=0,linecur=1'number of code sources, current executable, current show, current line executed (WARNING one by THREAD) 'proc/var Type tprcvar As String txt As Long level As Long closed '0 no / 1 yes As Long visible '0 no / 1 yes'13/02/2014 End Type Dim Shared As tprcvar prcvar(50) Dim Shared As Long prcvarnb=50 For i As Long =1 To 50 prcvar(i).txt="prcvar "+Str(i) If i<6 Then prcvar(i).level=0 ElseIf i>15 AndAlso i<20 then prcvar(i).level=3 Else prcvar(i).level=(i Mod 4) EndIf If prcvar(i).level=0 And i>4 Then prcvar(i).closed=1 prcvar(i).visible=1'13/02/2014 EndIf Next 'load data for test Read txt While txt<>"$$END$$" linesnb(0)+=1 codesrc(0,linesnb(0))=txt Read txt Wend codeshw=0:codebeg(0)=1:codename(0)="File name 0.bas" For j As Long =1 To 10 For i As Long =1 To 45 codesrc(j,i)="File "+Str(j)+" LIGNE LINE "+Str(i) Next linesnb(j)=45:codebeg(j)=1 If j>4 Then codename(j)="File"+Str(j) Else codename(j)="File name"+Str(j)+".bas" EndIf Next codenb=10 Sub message(msg As String) Line (2,0)-Step(800,9),RGB(220,220,220),BF Draw String (2,1),msg End Sub function window_fixed(manage As Long,xm As Long,ym As Long,txt() as String,typ as long=-1)as long '10 lines max, title in txt(0) 'typ '=-1 just the cross '=1 ok '=2 ok/no static as Any ptr imgptr Static as long lenmx,lenmy dim as long lasttxt,ps If manage=0 Then 'create window for i as long = 0 to UBound(txt(0)) if len(txt(i))<>0 then lasttxt=i lenmx=iif(lenmx>len(txt(i)),lenmx,len(txt(i))) Next lenmx=8*lenmx+10 'longer text lenmy=(lasttxt+1)*15 'number of lines + title If typ<>-1 Then lenmy+=15 ' + button area message("last"+Str(lasttxt)+" "+Str(lenmx)+" "+Str(lenmy)) imgptr = ImageCreate(lenmx+10,lenmy+10) 'save image on main screen Get ((screenw-lenmx)/2,(screenh-lenmy)/2)-Step(lenmx,lenmy),imgptr 'frame line((screenw-lenmx)/2,(screenh-lenmy)/2)-Step(lenmx,lenmy),RGB(220,220,220),Bf 'clear line((screenw-lenmx)/2,(screenh-lenmy)/2)-Step(lenmx,lenmy),RGB(255,0,255),B'surround line((screenw-lenmx)/2,(screenh-lenmy)/2+15)-Step(lenmx,0),RGB(0,0,255)'hori line((screenw-lenmx)/2+lenmx-15,(screenh-lenmy)/2)-step(0,15),RGB(0,0,255)'vert 'typ=-1 juste la croix 'typ=1 ok/no 'title draw String ((screenw-lenmx)/2+2,(screenh-lenmy)/2+4),txt(0) 'text ps=(screenh-lenmy)/2+19 for i as long = 1 to lasttxt draw string ((screenw-lenmx)/2+2,ps),txt(i) ps+=15 next ' Else 'manage of user 'si click sur croix 'returnvalue=0:exit while 'si typ=1 et si click sur ok 'returnvalue=1:exit while 'si typ=1 et si click sur no 'returnvalue=2:exit while 'for now no move and modal (obligatory to close before doing anything else) 'restore image Put ((screenw-lenmx)/2,(screenh-lenmy)/2),imgptr,PSet message("restore window"):Sleep 10000 ImageDestroy imgptr 'return returnvalue EndIf Return 0 end Function Sub button_load(nfile As String,psx As Long, psy As long) Dim pimage As Any Ptr = ImageCreate( 23, 19 ) BLoad nfile, pimage Put (psx,psy), pimage,pset ImageDestroy( pimage ) End Sub Sub var_tip(Linesel As Long,p As long) Dim As String text=UCase(codesrc(codeshw,linesel)) Dim vname(10) As String,varray As Integer,vnb As Integer =0 Dim As Long i,j,l,d 'select only var name characters For i =p-1 To 1 Step-1 Dim c As Integer c=Asc(text,i) If ( c>=Asc("0") And c<=Asc("9") ) OrElse ( c>=Asc("A") And c<=Asc("Z") ) OrElse c=Asc("_") OrElse c=Asc(".") Then Continue For Exit For Next i+=1 For j=p To Len(text) Dim c As Integer c=Asc(text,j) If ( c>=Asc("0") And c<=Asc("9") ) OrElse ( c>=Asc("A") And c<=Asc("Z") ) OrElse c=Asc("_") OrElse c=Asc(".") Then Continue For Exit For Next If Asc(text,j)<>Asc("(") Then j-=1 'if last character is a '(' take it in account (case array) If i>j Then text="" Else text=Mid(text,i,j-i+1) 'extract from text End If If text="" Or Left(text,1)="." Then message("Selection variable error"+""""+text+""" : Empty string or incomplete name (udt components)") Exit Sub EndIf message("searching var="+text) 'parsing text+=".":l=Len(text):d=1 While dbut OrElse ymbutpsy+butwidth Then Exit sub Select Case but Case 1 message("BUTTON STEP") Case 2 message("BUTTON RUN TO CURSOR") Case 3 message("BUTTON ") Dim As String txt(3)={"Test window","Line 1","VERY............... LONG LIGNE","Shorter one" } window_fixed(0,10,10,txt()) Case 4 message("BUTTON ") Dim As String txt2() message("APPEL window") window_fixed(1,xm,ym,txt2()) Case 5 message("BUTTON ") Case 6 message("BUTTON ") End Select xmold=xm:ymold=ym ' xmold=-99:ymold=-99 End Sub Sub but_help(xm As long,ym As Long,tim As double) Static timold As Double Dim As Long bm,xmold,ymold If Timer-timold<30 Then Exit sub While bm=0 GetMouse xm,ym,,bm message(Str(Timer-tim)) If Timer-tim>3 Then message("Help button"):timold=Timer:Exit sub Sleep 10 Wend End Sub Declare Sub code_tabmanage(xm As Long=-1,ym As Long=-1,ByVal cnb As Long=-1,linc As Long=-1) '======================================================================= 'current line #Define curlinewidth 600 #Define curlinepsx 15 #Define curlinepsy 42 #Define curlineheight 15 Declare Sub curline_update() Line(curlinepsx,curlinepsy)-step(curlinewidth,curlineheight),,B curline_update() Sub curline_manage code_tabmanage(,,codecur,linecur) End Sub Sub curline_update() Line(curlinepsx+1,curlinepsy+1)-step(curlinewidth-2,curlineheight-2),,B Draw String (curlinepsx+3,curlinepsy+4),"Current line : "+Trim(codesrc(codecur,linecur)),RGB(0,0,255) End Sub '======================================================================= 'code tabs #Define codetabwidth 600 #Define codetabpsx 15 #Define codetabpsy 60 #Define codetabheight 15 Line(codetabpsx,codetabpsy)-step(codetabwidth,codetabheight),,B 'full square code_tabmanage(,,0) Sub code_tabmanage(xm As Long=-1,ym As Long=-1,cnb As Long=-1,linc As Long=-1) Dim As Long ps=codetabpsx+codetabheight Dim As Long namelen,cpt Static As Long ctfirst=0,ctlast If xm>=codetabpsx AndAlso xm<=codetabpsx+codetabheight Then '- selected If ctfirst=0 Then Exit Sub Else ctfirst-=1 EndIf ElseIf xm>=codetabpsx+codetabwidth-codetabheight AndAlso xm-1 Then 'change by an other way (ie current line) ctfirst=cnb code_display(cnb,linc) Else message("here="+Str(ctfirst)+" "+Str(ctlast)) namelen=codetabpsx+codetabheight For i As Integer=ctfirst To ctlast If xm>namelen Then namelen+=Len(codename(i))*8+4 If xm<=namelen Then message("here bis="+Str(i)+" "+Str(ctfirst)+" "+Str(ctlast)) code_display(i) Exit For EndIf endif Next EndIf While ctfirst>0 ctfirst-=1 namelen=codetabheight*2 For i As Long =ctfirst To codenb namelen+=Len(codename(i))*8+4 Next If namelen>codetabwidth Then ctfirst+=1:Exit while Wend Line(codetabpsx+1,codetabpsy+1)-step(codetabwidth-2,codetabheight-2),RGB(220,220,220),Bf 'eraze area Line(codetabpsx,codetabpsy)-step(codetabheight,codetabheight),,B 'left square empty if no need to decal Line(codetabpsx+codetabwidth-codetabheight,codetabpsy)-step(codetabheight,codetabheight),,B 'right square empty if no need to decal For i As Integer=ctfirst To codenb namelen=Len(codename(i))*8 If ps+namelen+4>codetabwidth Then '6 Exit For EndIf Line(ps+namelen+4,codetabpsy)-step(0,codetabheight),,B 'end vertical line If i=codeshw Then 'write in red Line(ps+1,codetabpsy+1)-step(namelen+4-2,codetabheight-2),RGB(255,0,0),B draw String (ps+2,codetabpsy+5),codename(i),RGB(255,0,0) Else Draw String (ps+2,codetabpsy+5),codename(i) EndIf ps+=4+namelen cpt+=1 Next ctlast=ctfirst+cpt-1 If cpt<>codenb Then If ctfirst Then Draw String(codetabpsx+4,codetabpsy+5),"-" If ctlast<>codenb Then Draw String(codetabpsx+codetabwidth-codetabheight+4,codetabpsy+5),"+" endif End Sub '===================================================================== 'box code #Define codewidth 600 #Define codepsx 15 #Define codepsy 75 #Define codeheight 400 #Define codescroll 10 #Define maxline 26 #Define codecharheight 15 Line(codepsx,codepsy)-step(codewidth,codeheight),,B Line(codepsx+codewidth-codescroll,codepsy)-step(codescroll,codeheight),,B 'v scroll bar Line(codepsx+codewidth-codescroll,codepsy+codescroll)-step(codescroll,0) 'lines for v scrolling Line(codepsx+codewidth-codescroll,codepsy+codeheight-codescroll*2)-step(codescroll,0) Line(codepsx,codepsy+codeheight-codescroll)-step(codewidth,codescroll),,B 'h scroll bar Line(codepsx+codescroll,codepsy+codeheight-codescroll)-step(0,codescroll) Line(codepsx+codewidth-codescroll*2,codepsy+codeheight-codescroll)-step(0,codescroll) Sub code_display(file As Long,Linesel As Long=-1) Dim As Long ps=codepsy+4,dw,cptline,linelen,hscroll,vscroll,dscroll Dim As String txt Dim tostring As ZString Ptr If linesel<>-1 Then codebeg(file)=linesel-5 'show if possible the selected line as line 5 'clear area Line (codepsx+1,codepsy+1)-Step(codewidth-codescroll-2,codeheight-codescroll-2),RGB(220,220,220),bf ' display codeshw=file If codebeg(file)>linesnb(file)-maxline+1 Then codebeg(file)=linesnb(file)-maxline+1 If codebeg(file)<1 Then codebeg(file)=1 If codedecal(file)<0 Then codedecal(file)=0 For i As Integer =codebeg(file) To linesnb(file) txt=codesrc(file,i) linelen=Len(txt)-codedecal(file) If linelen>0 Then tostring=StrPtr(codesrc(file,i)) If linesel=i Then Line (codepsx+2,ps+8)-Step(linelen*8,-10),RGB (0,200,210),bf 'highlight line Draw String (codepsx+2,ps),*(tostring+codedecal(file)) dw=InStr(txt,"Draw String") 'If dw then draw String (17+(dw-1)*8,ps),"Draw String",RGB(0,0,255) dw=InStr(txt,"step") 'If dw then draw String (17+(dw-1)*8,ps),"step",RGB(0,0,255) dw=InStr(txt,"Line") 'If dw then draw String (17+(dw-1)*8,ps),"Line",RGB(0,0,255) If file=codecur AndAlso i=Linecur Then Line (codepsx+2,ps+9)-Step(linelen*8,0),RGB (255,0,0) EndIf ps+=codecharheight cptline+=1 If cptline=maxline Then Exit for Next Line(codepsx+codewidth-codescroll+1,codepsy+1)-step(codescroll-2,codeheight-codescroll-2),RGB (220,220,220),bf Line(codepsx+codewidth-codescroll,codepsy+codescroll)-step(codescroll,0) 'lines for v scrolling Line(codepsx+codewidth-codescroll,codepsy+codeheight-codescroll*2)-step(codescroll,0) If linesnb(file)>maxline Then 'vertical scrolling If codebeg(file)<>1 Then Draw String (codepsx+codewidth-codescroll+2,codepsy+2),"-" If codebeg(file)<>linesnb(file)-maxline+1 Then Draw String (codepsx+codewidth-codescroll+2,codepsy+codeheight-codescroll*2+2),"+" hscroll=codeheight-codescroll*3 vscroll=hscroll*maxline/linesnb(file) dscroll=hscroll*(codebeg(file)-1)/linesnb(file) Line(codepsx+codewidth-codescroll+1,codepsy+codescroll+dscroll+1)-step(codescroll-2,vscroll-2),RGB (0,200,210 ),bf EndIf Line(codepsx+1,codepsy+codeheight-codescroll+1)-step(codewidth-codescroll-2,codescroll-2),RGB (220,220,220),bf 'eraze h scroll bar Line(codepsx+codescroll,codepsy+codeheight-codescroll)-step(0,codescroll) Line(codepsx+codewidth-codescroll*2,codepsy+codeheight-codescroll)-step(0,codescroll) If codedecal(codeshw) Then 'horizontal scrolling Draw String(codepsx+2,codepsy+codeheight-codescroll+2),"-" EndIf Draw String(codepsx+codewidth-codescroll*2+2,codepsy+codeheight-codescroll+2),"+" End Sub Sub code_manage(xm As Long, ym As Long) Dim As Long hscroll,vscroll,dscroll hscroll=codeheight-codescroll*3 vscroll=hscroll*maxline/linesnb(codeshw) dscroll=hscroll*(codebeg(codeshw)-1)/linesnb(codeshw) If xm>=codepsx+codewidth-codescroll Then '- or + Andalso xm<=codepsx+codewidth If ym<=codepsy+codescroll Then 'ym>=codepsy andalso If codebeg(codeshw)=1 Then Exit Sub codebeg(codeshw)-=1 ElseIf ym>=codepsy+codeheight-codescroll*2 andalso ym<=codepsy+codeheight-codescroll Then If codebeg(codeshw)>=linesnb(codeshw)-maxline+1 Then Exit Sub codebeg(codeshw)+=1 ElseIf ym>=codepsy+codeheight-codescroll Then 'reset top/left codebeg(codeshw)=1 codedecal(codeshw)=0 ElseIf ym<=(codepsy+codescroll+dscroll+1) then codebeg(codeshw)-=maxline ElseIf ym>=(codepsy+codescroll+dscroll+1+vscroll-2) Then codebeg(codeshw)+=maxline EndIf code_display(codeshw) Exit Sub EndIf If ym>=codepsy+codeheight-codescroll Then 'horizontal scrolling If xm<=codepsx+codescroll Then If codedecal(codeshw)=0 Then Exit Sub codedecal(codeshw)-=1 ElseIf xm>=codepsx+codewidth-codescroll*2 AndAlso xm<=codepsx+codewidth-codescroll then codedecal(codeshw)+=1 EndIf code_display(codeshw) Exit Sub EndIf var_tip( Int((ym-76)/codecharheight)+1,int((xm-16)/8)+1 ) End Sub code_display(0) '====================================================================== 'proc/var tab #Define prctabwidth 250 #Define prctabpsx 620 #Define prctabpsy 10 #Define prctabheight 15 #Define prctabscroll 10 Line(prctabpsx,prctabpsy)-Step(prctabwidth,prctabheight),,b Line(prctabpsx+1,prctabpsy+1)-Step(66,prctabheight-2),RGB(255,0,0),b Draw String (prctabpsx+3,prctabpsy+4),"PROC/VAR",RGB(255,0,0) Line (prctabpsx+68,prctabpsy)-Step(0,prctabheight) Draw String (prctabpsx+71,prctabpsy+4),"PROC" Line (prctabpsx+104,prctabpsy)-Step(0,prctabheight) Draw String (prctabpsx+107,prctabpsy+4),"THREAD" Line (prctabpsx+156,prctabpsy)-Step(0,prctabheight) Draw String (prctabpsx+159,prctabpsy+4),"WATCHED" Line (prctabpsx+216,prctabpsy)-Step(0,prctabheight) '====================================================================== 'proc/var box #Define prcwidth 250 #Define prcpsx 620 #Define prcpsy 25 #Define prcheight 475 #Define prcscroll 10 #Define prcmaxline 31 #Define prccharheight 15 Dim Shared As Long prclines,prcbeg=1,prcdecal=0,prchlight Sub procvar_display()'13/02/2014 Dim As Long pslast(10) Dim As Long ps=prcpsy+4,cptline,linelen,levelclosed=99 Line (prcpsx+1,prcpsy+1)-Step(prcwidth-prcscroll-2,prcheight-prcscroll-2),RGB(220,220,220),bf For i As Long =prcbeg To prcvarnb If prcvar(i).level<=levelclosed Then levelclosed=99 'reset If i=prchlight Then Line (prcpsx+15+prcvar(i).level*15,ps+8)-Step(Len(prcvar(i).txt)*8,-10),RGB (0,200,210),bf 'highlight line EndIf draw String (prcpsx+15+prcvar(i).level*15,ps),prcvar(i).txt If i=1 Then pslast(prcvar(i).level)=ps+5 endif If pslast(prcvar(i).level)=0 Then Line (prcpsx+5+prcvar(i).level*15,ps+5)-Step(0,-10),,,&b1010101010101010 Else Line (prcpsx+5+prcvar(i).level*15,ps+5)-(prcpsx+5+prcvar(i).level*15,pslast(prcvar(i).level)),,,&b1010101010101010 ' End If Line (prcpsx+5+prcvar(i).level*15,ps+5)-Step(8,0),,,&b1010101010101010 'Hor If i=prcvarnb OrElse prcvar(i).level>prcvar(i+1).level OrElse prcvar(i).closed Then 'ver 12/02/2014 'last one or of a level For j As Long = prcvar(i+1).level+1 To 10 pslast(j)=0 Next If prcvar(i).level=0 Then pslast(prcvar(i).level)=ps+5 If prcvar(i).closed Then 'ver 12/02/2014 Line(prcpsx+2+prcvar(i).level*15,ps+1)-Step(7,7),,b Line(prcpsx+3+prcvar(i).level*15,ps+2)-Step(5,5),RGB(255,0,0),bf EndIf Else pslast(prcvar(i).level)=ps+5 If prcvar(i).level=prcpsx+prcwidth-prcscroll Then '- or + Andalso xm<=prcpsx+prcwidth If ym<=prcpsy+prcscroll Then 'ym>=prcpsy andalso message("- procvar") If prcbeg=1 Then Exit Sub prcbeg-=1 ElseIf ym>=prcpsy+prcheight-prcscroll*2 andalso ym<=prcpsy+prcheight-prcscroll Then message("+ procvar"+Str(prclines-prcmaxline+1)+" "+Str(prcbeg)) If prcbeg>=prclines-prcmaxline+1 Then Exit Sub prcbeg+=1 ElseIf ym>=prcpsy+prcheight-prcscroll Then 'reset top/left message("reset procvar") prcbeg=1 prcdecal=0 ElseIf ym<=(prcpsy+prcscroll+dscroll+1) then prcbeg-=prcmaxline ElseIf ym>=(prcpsy+prcscroll+dscroll+1+vscroll-2) Then prcbeg+=prcmaxline EndIf procvar_display Exit Sub EndIf If ym>=prcpsy+prcheight-prcscroll Then 'horizontal scrolling If xm<=prcpsx+prcscroll Then If prcdecal=0 Then Exit Sub prcdecal-=1 ElseIf xm>=prcpsx+prcwidth-prcscroll*2 AndAlso xm<=prcpsx+prcwidth-prcscroll then prcdecal+=1 EndIf procvar_display Exit Sub EndIf prclnb=1+Int((ym-prcpsy)/prccharheight) If prclnb>prclines Then 'no line here message("Dummy prclnb="+Str(prclnb)) Else message("prclnb="+Str(prclnb)+" "+Str((ym-prcpsy)/prccharheight)) For i As Long=prcbeg To prcvarnb If prcvar(i).visible Then cpt+=1 If cpt=prclnb Then 'corresponding line found prchlight=i 'highlight line If prcvar(i).closed<>-1 Then 'openable/closable If xm>=prcpsx AndAlso xmChr(27) GetMouse xm,ym,,bm If bm=1 AndAlso (xm<>xmold orelse ym<>ymold) Then If ym>=butpsy AndAlso ym<=butpsy+butwidth AndAlso xm>=butpsx AndAlso xm<=butpsx+butwidth*butnb Then message("Ok") but_manage(xm,ym) ElseIf xm>=codepsx AndAlso ym>=codepsy AndAlso xm<=codepsx+codewidth AndAlso ym<=codepsy+codeheight then message("In code source, ligne/character "+Str(int((ym-76)/15)+1)+" "+Str(int((xm-16)/8)+1)) code_manage(xm,ym) ElseIf xm>=codetabpsx AndAlso ym>=codetabpsy AndAlso xm<=codetabpsx+codetabwidth andAlso ym<=codetabpsy+codetabheight Then message("code tab") code_tabmanage(xm,ym) ElseIf ym>=curlinepsy AndAlso ym<=curlinepsy+curlineheight AndAlso xm>=curlinepsx AndAlso xm<=curlinepsx+curlinewidth Then message("curline") curline_manage ElseIf ym>=prcpsy AndAlso ym<=prcpsy+prcheight AndAlso xm>=prcpsx AndAlso xm<=prcpsx+prcwidth Then '13/02/2014 message("Proc/var") procvar_manage(xm,ym) ElseIf xm>=screenw/2-50 AndAlso xm=screenh/2-50 AndAlso ymxmold orelse ym<>ymold) Then message("Context menu") xmold=xm:ymold=ym Else If ym>=butpsy AndAlso ym<=butpsy+butwidth AndAlso xm>=butpsx AndAlso xm<=butpsx+butwidth*butnb Then 'message("begin wait for help") 'but_help(xm,ym,timer) EndIf EndIf Sleep 10 Wend Data "'watch" Data "Line(15,475)-step(300,15),,B" Data "Line(15,490)-step(300,15),,B" Data "Line(315,475)-step(300,15),,B" Data "Line(315,490)-step(300,15),,B" Data "'break on var" Data "Line(15,505)-step(600,15),,B" Data "'memory" Data "Line(15,525)-step(100,15),,B" Data "Draw String (17,529),Address',RGB(0,0,255)" Data "Line(115,525)-step(80,15),,B" Data "Draw String (117,529),+00',RGB(0,0,255)" Data "Line(195,525)-step(80,15),,B" Data "Draw String (197,529),+04',RGB(0,0,255)" Data "Line(275,525)-step(80,15),,B" Data "Draw String (277,529),+08',RGB(0,0,255)" Data "Line(355,525)-step(80,15),,B" Data "Draw String (357,529),+12',RGB(0,0,255)" Data "Line(435,525)-step(180,15),,B" Data "Draw String (437,529),ASCII',RGB(0,0,255)" Data "" Data "Line(15,540)-step(600,15),,B" Data "Draw String (17,544),1658984',RGB(0,0,255)" Data "Draw String (117,544),4867',RGB(0,0,255)" Data "Draw String (437,544),0A..............',RGB(0,0,255)" Data "$$END$$"