Multicolor Procedure List

Anwendungen, Tools, Userlibs und anderes nützliches.
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Multicolor Procedure List

Beitrag von RSBasic »

Später heißt für mich aber morgen. Heute habe ich frei.^^

Ich werde wahrscheinlich den Vorschlag von Kurzer umsetzen, indem ich nicht wie im originalen Code von Kiffi Zeichen für Zeichen rückwärts ermittle, sondern stattdessen mit ReverseString() und FindString() arbeite. Das sollte auf jeden Fall schneller sein.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
Josh
Beiträge: 1028
Registriert: 04.08.2009 17:24

Re: Multicolor Procedure List

Beitrag von Josh »

RSBasic hat geschrieben:Ich werde wahrscheinlich den Vorschlag von Kurzer umsetzen, indem ich nicht wie im originalen Code von Kiffi Zeichen für Zeichen rückwärts ermittle, sondern stattdessen mit ReverseString() und FindString() arbeite. Das sollte auf jeden Fall schneller sein.
Kann ich mir nicht vorstellen, dass das schneller sein sollte. Wenn du bei der Rückwärtssuche nicht gerade die Pb-Stringfunktionen verwendest, macht Pb auch nicht viel anders, als Zeichen für Zeichen durchsuchen. Vielleicht holt sich PB ein bischen was mit ASM, aber wenn ich mir den Aufwand vorstelle, der mit ReverseString() entsteht, ist jeder Vorteil schnell wieder beseitigt. Wenn du für so einen Fall die Pb-Stringfunktionen verwendest, ist das natürlich der programmiertechnische Supergau.

Bin gespannt auf dein Ergebnis.
Benutzeravatar
Kurzer
Beiträge: 1617
Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg

Re: Multicolor Procedure List

Beitrag von Kurzer »

Ich habe mal einen unoptimierten Vergleichtstest geschrieben.
Die Version mit ReverseString ist ca. 4 mal schneller. Aber da geht bestimmt noch was, weil... bin gerade aus dem Bett gefallen, habe das noch mit dicken Klüsen schnell eingehackt und wie gesagt nicht weiter optimiert.

Als zu analysierende Source-Grundlage habe ich den Code aus diesem Beitrag benutzt ("Date64 written by Wilbert"):
https://www.purebasic.fr/english/viewto ... df#p478507
Also genau den Date64 Code, der in meinem Beitrag dort eingebunden ist.

Den müsstest ihr euch runterladen und als D:\source.txt speichern. Oder halt woanders hin und den Pfad im folgenden Codeschnippsel anpassen. Nicht vergessen den Debugger zu deaktivieren, sonst wird die Zeitmessung ungenau.

Kiffis Version braucht bei mir ca. 1,1 Sekunden. Die mit ReverseString ca. 0,27 Sekunden (bei jeweils 1000 Durchläufen)

Ach so: Ein wichtiger Unterschied ist allerdings, dass Kiffis Version die aktuelle Zeilennummer benötigt, die ReverseString()-Version aber die aktuelle Cursorposition!

Die ReverseString()-Version spiegelt den Source bei diesem Test in jedem Durchlauf erneut. Das kann RSBasic vermutlich optimieren, denn wenn sich die Länge des Source nicht verändert, dann wird sich darin wahrscheinlich auch nichts verändert haben. In dem Fall muss man den bereits gespiegelt vorliegenden Source nicht erneut spiegeln.

Gruß Kurzer

Code: Alles auswählen

EnableExplicit

Define.s sSourcecode.s, sProcedure
Define.i iStartTime, iCount

CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
	#LineFeed = #CRLF$
CompilerDefault
	#LineFeed = #LF$
CompilerEndSelect

Procedure.s RemoveLeadingWhitespaceFromString(InString.s)
	
	While Left(InString, 1) = Chr(32) Or Left(InString, 1) = Chr(9)
		InString = LTrim(InString, Chr(32))
		InString = LTrim(InString, Chr(9))
	Wend
	
	ProcedureReturn InString
	
EndProcedure
Procedure.s Kiffi(sText.s, iCursorLine)
	Protected.s Line
	Protected.i LineCounter
	
	For LineCounter = iCursorLine - 1 To 1 Step - 1
		
		Line = RemoveLeadingWhitespaceFromString(StringField(sText, LineCounter, #LineFeed))
		
		If Left(LCase(Line), Len("endprocedure")) = "endprocedure"
			Break
		EndIf
		
		If Left(LCase(Line), Len("procedure")) = "procedure" 
			If Left(LCase(Line), Len("procedurereturn")) <> "procedurereturn"
				;MessageRequester("You are here:", Line)
				ProcedureReturn Line
				Break
			EndIf
		EndIf
		
	Next	
EndProcedure

Procedure.s Kurzer(sText.s, iCursorPosition)
	Protected.i iPos, iTextLen = Len(sText)
	Protected.s sReversText
	
	sReversText = ReverseString(sText)
	iPos = FindString(sReversText, "erudecorP", iTextLen - iCursorPosition)
	If iPos > 0
		iPos = iTextLen - iPos - 9 ; 9 damit "Procedure" noch mit eingeschlossen wird
		ProcedureReturn Mid(sText, iPos, FindString(sText, #LineFeed, iPos) - iPos)
	EndIf
EndProcedure


; source.txt sollte der PB Code aus diesem Beitrag sein:
; https://www.purebasic.fr/english/viewtopic.php?p=478507&sid=5017a3101a227e8c633c827f390b9cdf#p478507
; Also bitte vorher aus dem Forum kopieren und als Datei speichern

If ReadFile(0, "D:\source.txt")
  sSourcecode =  ReadString(0, #PB_File_IgnoreEOL)
  CloseFile(0)
Else
  MessageRequester("Laden des Sourcecodes", "Kann die Datei nicht finden!", 0)
EndIf

; Kiffi
iStartTime.i = ElapsedMilliseconds()
For iCount = 0 To 1000
	sProcedure = Kiffi(sSourcecode, 600)
Next iCount
MessageRequester("Kiffi", sProcedure + #LineFeed + Str(ElapsedMilliseconds() - iStartTime))


;Kurzer
iStartTime.i = ElapsedMilliseconds()
For iCount = 0 To 1000
	sProcedure = Kurzer(sSourcecode, 27418)
Next iCount
MessageRequester("Kurzer", sProcedure + #LineFeed + Str(ElapsedMilliseconds() - iStartTime))
"Never run a changing system!" | "Unterhalten sich zwei Alleinunterhalter... Paradox, oder?"
PB 6.02 x64, OS: Win 7 Pro x64 & Win 11 x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520
Useralter in 2024: 56 Jahre.
Benutzeravatar
#NULL
Beiträge: 2235
Registriert: 20.04.2006 09:50

Re: Multicolor Procedure List

Beitrag von #NULL »

Ich habe das mal mit Pointern umgesetzt. die erste Funktion Null() geht einfach den string von vorne durch, merkt sich die letzte Procedure, und spuckt sie aus wenn an Cursorposition. Die zweite Null_reverse() sucht rückwärts von der Cursorposition.
PeekS() könnt man auch noch wegoptimieren, sodass kein String kopiert wird.
Ach so: Ein wichtiger Unterschied ist allerdings, dass Kiffis Version die aktuelle Zeilennummer benötigt, die ReverseString()-Version aber die aktuelle Cursorposition!
Meine Funktionen nehmen auch die Characterposition. Man kann das dadurch leider schlecht vergleichen, da RSBasic vermutlich die Zeilennummer von der IDE erhält, und diese in char-pos umzurechnen würde ein zusätzliches Durchlaufen des Strings erfordern, was in den Beispielen nicht mit drin ist.
Auch größtenteils nicht bedacht werden Groß-/Kleinschreibung, Vorkommen in Kommentaren/Stringliteralen, Word-Boundaries (z.B. ProcedureReturn) etc.

Code: Alles auswählen

EnableExplicit

Define.s sSourcecode.s, sProcedure
Define.i iStartTime, iCount

CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
   #LineFeed = #CRLF$
CompilerDefault
   #LineFeed = #LF$
CompilerEndSelect

Procedure.s RemoveLeadingWhitespaceFromString(InString.s)
   
   While Left(InString, 1) = Chr(32) Or Left(InString, 1) = Chr(9)
      InString = LTrim(InString, Chr(32))
      InString = LTrim(InString, Chr(9))
   Wend
   
   ProcedureReturn InString
   
EndProcedure
Procedure.s Kiffi(sText.s, iCursorLine)
   Protected.s Line
   Protected.i LineCounter
   
   For LineCounter = iCursorLine - 1 To 1 Step - 1
      
      Line = RemoveLeadingWhitespaceFromString(StringField(sText, LineCounter, #LineFeed))
      
      If Left(LCase(Line), Len("endprocedure")) = "endprocedure"
         Break
      EndIf
      
      If Left(LCase(Line), Len("procedure")) = "procedure"
         If Left(LCase(Line), Len("procedurereturn")) <> "procedurereturn"
            ;MessageRequester("You are here:", Line)
            ProcedureReturn Line
            Break
         EndIf
      EndIf
      
   Next   
EndProcedure

Procedure.s Kurzer(sText.s, iCursorPosition)
   Protected.i iPos, iTextLen = Len(sText)
   Protected.s sReversText
   
   sReversText = ReverseString(sText)
   iPos = FindString(sReversText, "erudecorP", iTextLen - iCursorPosition)
   If iPos > 0
      iPos = iTextLen - iPos - 9 ; 9 damit "Procedure" noch mit eingeschlossen wird
      ProcedureReturn Mid(sText, iPos, FindString(sText, #LineFeed, iPos) - iPos)
   EndIf
EndProcedure

Procedure.s Null(sText.s, iCursorPosition)
  Protected.Character *c = @sText
  Protected.Character *cProc = 0
  Protected.Character *cEnd = 0
  Protected.i charNb = 0
  While *c\c <> 0
    If (*c\c = 'p' Or *c\c = 'P')
      If PeekS(*c, 9) = "Procedure"
        *cProc = *c
      EndIf
    EndIf
    If (charNb = iCursorPosition) And *cProc
      *cEnd = *cProc
      While (*cEnd\c) And (*cEnd\c <> #LF)
        *cEnd + SizeOf(Character)
      Wend
      ProcedureReturn PeekS(*cProc, (*cEnd - *cProc) / SizeOf(Character))
    EndIf
    *c + SizeOf(Character)
    charNb + 1
  Wend
  ProcedureReturn ""
EndProcedure

Procedure.s Null_reverse(sText.s, iCursorPosition)
  Protected.Character *c = @sText + iCursorPosition * SizeOf(Character)
  Protected.Character *cEnd = 0
  Protected.i charNb = iCursorPosition
  While charNb > 0
    If (*c\c = 'p' Or *c\c = 'P')
      If PeekS(*c, 9) = "Procedure"
        *cEnd = *c
        While (*cEnd\c) And (*cEnd\c <> #LF)
          *cEnd + SizeOf(Character)
        Wend
        ProcedureReturn PeekS(*c, (*cEnd - *c) / SizeOf(Character))
      EndIf
    EndIf
    *c - SizeOf(Character)
    charNb - 1
  Wend
  ProcedureReturn ""
EndProcedure


; source.txt sollte der PB Code aus diesem Beitrag sein:
; https://www.purebasic.fr/english/viewtopic.php?p=478507&sid=5017a3101a227e8c633c827f390b9cdf#p478507
; Also bitte vorher aus dem Forum kopieren und als Datei speichern

;If ReadFile(0, "D:\source.txt")
If ReadFile(0, "tmp13.pb.txt")
  sSourcecode =  ReadString(0, #PB_File_IgnoreEOL)
  CloseFile(0)
Else
  MessageRequester("Laden des Sourcecodes", "Kann die Datei nicht finden!", 0)
EndIf

; Kiffi
iStartTime.i = ElapsedMilliseconds()
For iCount = 0 To 1000
   sProcedure = Kiffi(sSourcecode, 600)
Next iCount
MessageRequester("Kiffi", sProcedure + #LineFeed + Str(ElapsedMilliseconds() - iStartTime))


;Kurzer
iStartTime.i = ElapsedMilliseconds()
For iCount = 0 To 1000
   sProcedure = Kurzer(sSourcecode, 27418)
Next iCount
MessageRequester("Kurzer", sProcedure + #LineFeed + Str(ElapsedMilliseconds() - iStartTime))


;Null
iStartTime.i = ElapsedMilliseconds()
For iCount = 0 To 1000
   sProcedure = Null(sSourcecode, 27418)
Next iCount
MessageRequester("Null", sProcedure + #LineFeed + Str(ElapsedMilliseconds() - iStartTime))


;Null_reverse
iStartTime.i = ElapsedMilliseconds()
For iCount = 0 To 1000
   sProcedure = Null_reverse(sSourcecode, 27418)
Next iCount
MessageRequester("Null_reverse", sProcedure + #LineFeed + Str(ElapsedMilliseconds() - iStartTime))

my pb stuff..
Bild..jedenfalls war das mal so.
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Multicolor Procedure List

Beitrag von RSBasic »

Vielen Dank erstmal für eure Antworten. Ich habe euch nicht vergessen.
Ich wollte eigentlich vorgestern mit der Umsetzung anfangen, leider kam meine Erkältung dazwischen. Es dauert noch etwas. Sorry
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
Kurzer
Beiträge: 1617
Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg

Re: Multicolor Procedure List

Beitrag von Kurzer »

Gute Besserung von meiner Seite aus. Stress dich nicht, sondern kurier dich aus. ;-)
"Never run a changing system!" | "Unterhalten sich zwei Alleinunterhalter... Paradox, oder?"
PB 6.02 x64, OS: Win 7 Pro x64 & Win 11 x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520
Useralter in 2024: 56 Jahre.
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Multicolor Procedure List

Beitrag von RSBasic »

Hi ihr lieben, ich bin wieder zurück. :D

Vielen Dank nochmal für eure Codes. Eure Codes sind auf jeden Fall schneller und ich habe mich für den schnellsten Code entschieden und zwar für den Code von #NULL mit der Pointer-Variante.
Ich habe es mit einer PB-Datei mit 4.000 Zeilen (enthält 1 Module und 60 Prozeduren) getestet. Da ich wie gesagt auch den Modulnamen ermitteln muss, geht die Rückwärtssuche über Prozeduren hinaus bis zum Anfang des aktuellen Moduls.

Die alte Version benötigte vorher circa 2,5 Sekunden für die von mir erstellte PB-Datei.
Mit dem optimierten Code von #NULL, den ich mit der Module-Suche erweitert habe, benötigt der Vorgang stattdessen nur 1-5 Millisekunden.
Vielen Dank Kurzer und #NULL für eure Mithilfe und Optimierung. :)
Um einen besseren Vergleich zu haben, habe ich meine PB-Testdatei auf 10.000 Zeilen (enthält 1 Module und 112 Prozeduren) vergrößert.
Vorher: 19 Sekunden
Nachher: Immer noch 1-5 Millisekunden abzüglich der Delay-Zeit pro Durchlauf :allright:
#NULL hat geschrieben:Meine Funktionen nehmen auch die Characterposition. Man kann das dadurch leider schlecht vergleichen, da RSBasic vermutlich die Zeilennummer von der IDE erhält, und diese in char-pos umzurechnen würde ein zusätzliches Durchlaufen des Strings erfordern, was in den Beispielen nicht mit drin ist.
Ich kann auch die aktuelle Cursorposition mit #SCI_GETCURRENTPOS ermitteln. Von daher kompatibel mit euren Codes ohne zusätzliche Umrechnung.
Kurzer hat geschrieben:Dein Tool habe ich so eingebunden, dass es mit dem Start der IDE startet. Ruft man es dann aber nochmals manuell über das Werkzeug-Menü der PB IDE auf, dann hat man lt. Taskmanager zwei Instanzen davon laufen. Das ist sicherlich nicht so gedacht, oder?
Erledigt
Kurzer hat geschrieben:Dabei ist mir dann auch aufgefallen, dass man das Suchfeld manuell wieder löschen muss, wenn man die gesamte Prozedurliste wieder sehen möchte. Hier wäre ein [x] Button zum löschen des Suchfelds sehr nützlich.
Erledigt



Multicolor Procedure List 1.2.3 wurde veröffentlicht.

Changelog:
  • Optimiert: Die Performance für das Ermitteln der aktuellen Prozedur und des aktuellen Moduls wurde deutlich verbessert.
  • Hinzugefügt: Button zum Löschen des Suchfilters
  • Geändert: Der Code zum Ermitteln der aktuellen Prozedur und des aktuellen Moduls wurde angepasst.
  • Geändert: Es wird jetzt überprüft, ob die Werkzeug-Instanz bereits läuft.
  • Bugfix: Fokus-Problem nach dem Klicken auf einen Prozedureintrag.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
Kurzer
Beiträge: 1617
Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg

Re: Multicolor Procedure List

Beitrag von Kurzer »

RSBasic hat geschrieben: Um einen besseren Vergleich zu haben, habe ich meine PB-Testdatei auf 10.000 Zeilen (enthält 1 Module und 112 Prozeduren) vergrößert.
Vorher: 19 Sekunden
Nachher: Immer noch 1-5 Millisekunden abzüglich der Delay-Zeit pro Durchlauf :allright:
Wow! Hammer Zeiten. :allright:

Vielen Dank für die Erweiterung des Tools.
Ich werde es gleich mal aktualisieren.

Nachtrag: Eine optische Sache fällt mir leider noch auf.

Das Tool erkennt jetzt zwar auch Prozedurnamen, wen die Prozedur zugeklappt ist, aber der Name wird dabei nur bis zur aktuellen Cursorposition ermittelt. Steht der Cursor also in einer Zeile namens "Procedure GetIrgendwas()" direkt hinter "Get", also zwischen dem "t" und dem "I", dann zeigt dein Tool in der Zeile oben "Aktuell: Get" an. Der Rest des Prozedurnamens wird nicht angezeigt.

Hier mal ein kleiner Gif-Mitschnitt der das Problem illustriert:

Bild

PS: Hier noch ein weiterer Optimierungsversuch von mir.
67 zu 102 Millisekunden im Vergleich zur Null_reverse Version unter den ursprünglichen Testbedingungen.

Die Optimierung besteht darin, dass nicht mit einem Character Pointer nach dem Auftreten eines 'P' gesucht wird, sondern mit einem Quad Pointer nach dem Auftreten eines 'Proc' Strings. Der nachfolgende Vergleich wird also vermutlich seltener ausgeführt, da er nicht bei jeden 'P' durchgeführt wird.

Code: Alles auswählen

Structure QC
	StructureUnion
		q.Quad
		c.Character
	EndStructureUnion
EndStructure

Procedure.s Kurzer(sText.s, iCursorPosition)
  Protected.QC *p = @sText + iCursorPosition * SizeOf(Character)
  Protected.i iStart, iLen = 5
  
  While *p > @sText
  	If *p\q\q = $0063006F00720050 ; "corP" 8 Bytes
  		iStart = *p
  		*p + 4 * SizeOf(Character)
  		If *p\q\q = $0072007500640065 ; "rude" 8 Bytes
	  		Repeat
	  			iLen + 1
	  			*p + SizeOf(Character)
	  		Until *p\c\c = ')' Or *p\c\c = #LF
	      ProcedureReturn PeekS(iStart, iLen, #PB_Unicode)
	    EndIf
	    *p - 4 * SizeOf(Character)
    EndIf
    *p - SizeOf(Character)
  Wend
  ProcedureReturn ""
EndProcedure
"Never run a changing system!" | "Unterhalten sich zwei Alleinunterhalter... Paradox, oder?"
PB 6.02 x64, OS: Win 7 Pro x64 & Win 11 x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520
Useralter in 2024: 56 Jahre.
DePe
Beiträge: 153
Registriert: 26.11.2017 16:17
Wohnort: Wien
Kontaktdaten:

Re: Multicolor Procedure List

Beitrag von DePe »

Das Tool ist auch jetzt mit der PIII 450 MHz CPU verwendbar, funtkioniert schnell genug.
Aber es stimmt mit der Berechnung der Cursorposition etwas nicht, wie Kurzer schon angemerkt hat. Die Position ist ungefähr pro 10 Zeilen um ein Zeichen falsch. Es wird also die nächste Prozedur im Tool schon angezeigt, wobei der Cursor noch in der vorherigen Prozedur steht.
Z.B. Cursor steht in der Zeile 4.830, die nächste Prozedur ist erst in 20 Zeilen, wird aber schon angezeigt.

Peter
DePe
Beiträge: 153
Registriert: 26.11.2017 16:17
Wohnort: Wien
Kontaktdaten:

Re: Multicolor Procedure List

Beitrag von DePe »

Könntest du für die Anzeige der aktuellen Prozedur die selbe Schrift verwenden, wie bei den Einstellungen 'Tool Panel -> Options' eingestellt ist?

Peter
Antworten