diff options
Diffstat (limited to '')
120 files changed, 16005 insertions, 4323 deletions
diff --git a/unicode/ChangeLog.german.txt b/unicode/ChangeLog.GERMAN.txt index 6c2e1cd9..cf9b3391 100644 --- a/unicode/ChangeLog.german.txt +++ b/unicode/ChangeLog.GERMAN.txt @@ -1,202 +1,202 @@ -UltraStar Deluxe 1.00 (by Ultrastar Deluxe Team) ------------------------------ - --------------- -Theme System --------------- -Upd: Neues Skin/Theme System aus Ultrastar 0.5.1 -Upd: Laden von selbsterstellten Themes ermöglicht -Upd: Covereigenschaften in Theme.ini ausgelagert (z.B. Position) -Upd: Optionale Coverspiegelungen hinzugefügt -Upd: Neue Coveranordnung (Bessereres Aussehen mit vielen Songs). (Kann im Theme an und ausgeschaltet werden) -Upd: SongScreen Equalizer Objekt hinzugefügt -Upd: Optionale Spiegelungen zu Buttons und Statics hinzugefügt. (Reflection = 1) -Upd: Buttons können nun im Theme zu Gruppen zusammengefasst werden.z.B. Deluxe Theme Main Menu Tools Collection. -Upd: Buttons könen vom Theme ausgeblendet werden. z.B. für den Exit Button, oder falls Hotkeys existieren. -Upd: Texte können nun eine Länge (w= ..) erhalten. Sie werden dann bei der gegebenen Länge umgebrochen. - --------------- -Aufnahme Optionen --------------- -Upd: Ultrastar 0.5.2 Recording Optionen hinzugefügt -Fix: Soundcard Einträge wurden mehrmals in die Config.Ini eingetragen -Fix: Mehr als ein Singstaradapter sind jetzt möglich(2 Soundkarten mit dem selben Namen) - --------------- -Song Screen --------------- -Upd: Playlist Support hinzugefügt - -Upd: Song Suche (mit Interface) -Upd: Jump to Letter Hotkey -Upd: Songscreen Menu ähnlich wie bei Singstar -Upd: Spielernamen können nun vor dem Singen geändert werden -Upd: Song Vorschau Lautstärke kann nun geändert werden -Upd: Song Vorschau kann eingefadet werden - --------------- -Party Modus --------------- -Upd: Party Modus hinzugefügt: - 3 Teams mit bis zu 4 Spielern möglich - => insgesamt 12 Spieler -Upd: Modi SDK: Party Modi können mit etwas Programmiererfahrung leicht erstellt werden. -Upd: 4 Standard Party Modi Plugins: Duell, Hold the Line, Until 5000, Blind Mode - --------------- -Effekte --------------- -Upd: Neue Perfect Note Effekte -Upd: Effekt bei perfekt gesungenem Satz hinzugefügt -Upd: Goldene Noten haben jetzt einen Singstar ähnlichen Glitzereffekt, und sind nicht mehr gelb. -Upd: Neuer Effekt bei getroffenen Goldenen Noten -Upd: Neuer Menü-Übergangs-Effekt: Screen verschwimmt und "fliegt aus dem Bild heraus". Neue Möglichkeiten für Theme-Ersteller - --------------- -Sonstiges --------------- -Upd: Deluxe Theme hinzugefügt: Theme mit PS3 ähnlichem Aussehen -Upd: Neues Score Speicherungssystem (basierend auf SQLite) -Upd: Statistiken hinzugefügt. Generelle Statistiken und - Beste Scores, Beste Sänger, beliebteste Songs, beliebteste Bands -Upd: Einige On Screen Fehler Benachrichtigungen hinzugefügt, die neuen Spielern helfen sollten. -Upd: Neuer Erweiterter Options Screen hinzugefügt -Upd: Abfrage vor dem Beenden hinzugefügt -Upd: Song Hintergrundbilder können jetzt auch auf voller Bildschrimfläche dargestellt werden. -Upd: Im Editor werden jetzt zusätzlich die richtigen Notennamen ausgegeben (C, F#, etc.) -Upd: Neue Schriftarten -Upd: Bessere Unterstützung für Kommandozeilen Parameter -Fix: Nahezu keine Abstürze mehr wegen fehlerhaften TXT-Dateien. - In Game Popup hinzugefügt und einen Rücksprunk zum Songscreen. - Selbst der Partymodus wird nicht unterbrochen. -Fix: Workaround für Cover und Hintergrund JPEG-Errors -Fix: Videosize kann wieder geändert werden. -Fix: Bug in LineBonus Popup behoben das zu Speicherüberläufen führen kann. -Fix: Bug in SelectSlide behoben der zu Fehlern mit weniger als 3 optionen führen kann. - Automatisches Resizing hinzugefügt -Fix: Backgrounds can be used now in option Screens, too -Fix: Unnützer Speicherverbauch wenn ein Song mit Video abgespielt wird. Einige Videodaten blieben im Speicher nachdem der Song beendet wurde. - Dies könnte zu einem Out Of Memory Error führen wenn viele Songs mit Video gespielt werden. -Fix: Einige Speichernutzungs und Ladezeit Updates -Fix: Falsche Satzübergänge wenn T im Editor benutzt wurde und sich 2 Noten von verschiedenen - Sätzen überlagerten. -Fix: Editor stürzte ab wenn die letzte Note eines Satzes gelöscht wurde. -Fix: [Midi Converter]Noten wurden mehrmals hinzugefügt wenn eine Datei mehrmals geöffnet wurde - oder der Save Button mehrmals gedrückt wurde. -Fix: [Midi Converter]Satzübergänge werden nun vom Mide Converter automatisch berechnet. - -UltraStar 0.5.0 ultra-star.dl.am Mod X-Mas Edition (by Mota und Whiteshark) ------------------------------ -Upd: Neue schnellerer und fehlerresistenter Headereinlesefunktion -Upd: Bewertungs Bar (Singstar Like) -Upd: PhrasenBonus + Popups - -Upd: Skin verschönert - -UltraStar 0.5.0 ultra-star.dl.am Mod r10 (by Mota und Whiteshark) ------------------------------ -Fix: Ein kleiner Bug bei der Pause Funktion wurde gefixt. -Fix: Ein Bug im Theme System wurde behoben. (SelectSlide konnte nicht weniger als 3 Einträge enthalten.) -Fix: Skin, Beschränkung auf 4 Skins aufgehoben -Fix: Noten Texturen werden anders/besser eingelesen - -Upd: Zahlen bei der Songauswahl sind jetzt sinnvoller. -Upd: Anzahl der Songs die eine Kategorie beinhaltet wird in der Übersicht angezeigt -Upd: Neuer Notenskin - -Upd: LanguageTag + Sortierung -Upd: Unterstützung der Covers.ini aus 0.5.1 - Für alle Sortier-Funtionen. Die alte Möglichkeit ohne die Covers.ini ist weiterhin möglich, genauso wie eine Kombination beider Methoden. - -UltraStar 0.5.0 ultra-star.dl.am Mod r9 (Release by Whiteshark) ------------------------------ - -Upd: BPM und VideoGap Angaben mit Punkt werden jetzt auch eingelesen. Es wird aber in diesem Fall in der Error.log eine meldung mit dem Namen des Fehlerhaften Songs ausgegeben. -Upd: Sollte beim Einlesen eines Songs(speziell beim Header) ein Fehler auftreten wird in der Error.log der Songname + Zeile ausgegeben. - -Upd, Beta: Pause. P drücken und der Song wird pausiert, nocheinmal P und es kann wieder gesungen werden. Noch keine Anzeige ob Pause aktiviert wird, und noch kein Pause Menü. - -bekannte Probleme: -Stellt man die Aufnahme Funktion ein, kommt es zu einem extremen CPU-Zeit verbrauch und es fängt an zu Laggen - -UltraStar 0.5.0 ultra-star.dl.am Mod r8b (Release by Whiteshark) ------------------------------ -Fix: Random Funktionen funktionieren alle ohne Fehler -Fix: In der Kategorieauswahl wird jetzt beim Start immer die erste Kategorie angezeigt -Fix: Musik wird nach Kategoriewechsel korrekt abgespielt -Fix: Richtiger Text wird jetzt nicht mehr zu falscher Musik abgespielt -Fix: Nach Beenden eines Songs ist dieser jetzt wieder in der Übersicht angewählt -Fix: Midi-konvertor Bug behoben (Nur Freestyle Noten anstatt Normalen) - -Thx to: dennisthemenace und mota für die super Bug-Reports :P - -Upd: doomhammers Cover sind Integriert: thx to doomhammer - -UltraStar 0.5.0 ultra-star.dl.am Mod r8a (Release by Whiteshark) ------------------------------ -Fix: Theme System konnte nicht ausgewählt werden (workaround: Nur bis zu 4 Themes möglich) -Fix: Richtige Kategorie wird angezeigt nach Druck von Escape - -Upd: Neue Random Funktionen: R + [Strg]: Random in allen Kategorien (Hier wird die Kategorie oben noch falsch angezeigt); R + [Shift]: Zufällige Kategorie -Upd: Gerade gewählte Kategorie wird oben links in der Ecke gezeigt - -UltraStar 0.5.0 ultra-star.dl.am Mod r8 (Release by Whiteshark) ------------------------------ -Fix: Creatorbug behoben -Fix: Wenn Tabs=on kam es manchmal vor das der angewählte Song nicht mit dem Angezeigten übereingestimmt hat - -Upd: Theme System komplett - -Bei Start nach Themes Suchen - -Den ThemeOptions Screen ändern -Upd: Neue Farben für Themes :) -Upd: kleine änderungen am Editor - -Leerzeichen im Header werden automatisch korrigiert - -Header ist nicht mehr Case Sensitive - -Upd: Skin Ordner gesäubert, Es gibt jetzt 2 Skins: Motas und der Original Skin -Upd: Ordner haben ihr eigenes Cover, welches angezeigt wird falls kein spezielles Cover vorhanden ist -Upd: Der BewertungsText (Ultrastar, Singstar, etc.) kann jetzt übersetzt werden - -Upd: Falls eine Sprache nicht komplett ist werden die nicht übersetzten Texte, mit der Englischen Sprachdatei übersetzt. (Falls es zu nicht kompletten Sprachdateien kommt) - -Upd: neues Kategorie System: - -Wenn eine Kategorie angewählt wird, werden nur die enthaltenden Songs angezeigt. - -Mit Escape gehts zurück in die Kategorie Auswahl - -Mit Hoch und Runter kann die Kategorie gewechselt werden. - -UltraStar 0.5.0 mota patch r7 (Release by Mota) ------------------------------ -- Neues Notendesign. -- versch. Neue Grafiken. -- Neue Bewertung "Ultrastar" ab 9810 Punkte. -- Textgröße-Bug im Editor behoben. - -UltraStar 0.5.0 mota patch r6 - 17.11.06 (Release by Mota) ----------------------------------------- -- Editiorfunktionen für Goldene/Freestyle-Noten. (Tasten [G] und [F]) -- Speicherfunktion des Editors angepasst. -- Verändertes Theme "SingStar". - -UltraStar 0.5.0 mota patch r5 - 16.11.06 (Release by Mota) ----------------------------------------- -- Goldene Noten werden dargestellt -- Zufallsauswahl verbessert - -UltraStar 0.5.0 mota patch r4 (Release by Mota) ------------------------------ -- Perfekt-Stern animation - -UltraStar 0.5.0 mota patch r3 (Release by Mota) ------------------------------ -- Sortierung Title2 und Artist2 -> Zahlen in Ordner "#" - -UltraStar 0.5.0 mota patch r2 (Release by Mota) ------------------------------ -- Eigene Cover für alle Sortierungen - -UltraStar 0.5.0 mota patch (Release by Mota) --------------------------- -- Eigene Cover für Sortierung nach Edition. - -UltraStar 0.5.0 (by Corvus5) --------------------------- +UltraStar Deluxe 1.00 (by Ultrastar Deluxe Team)
+-----------------------------
+
+--------------
+Theme System
+--------------
+Upd: Neues Skin/Theme System aus Ultrastar 0.5.1
+Upd: Laden von selbsterstellten Themes ermöglicht
+Upd: Covereigenschaften in Theme.ini ausgelagert (z.B. Position)
+Upd: Optionale Coverspiegelungen hinzugefügt
+Upd: Neue Coveranordnung (Bessereres Aussehen mit vielen Songs). (Kann im Theme an und ausgeschaltet werden)
+Upd: SongScreen Equalizer Objekt hinzugefügt
+Upd: Optionale Spiegelungen zu Buttons und Statics hinzugefügt. (Reflection = 1)
+Upd: Buttons können nun im Theme zu Gruppen zusammengefasst werden.z.B. Deluxe Theme Main Menu Tools Collection.
+Upd: Buttons könen vom Theme ausgeblendet werden. z.B. für den Exit Button, oder falls Hotkeys existieren.
+Upd: Texte können nun eine Länge (w= ..) erhalten. Sie werden dann bei der gegebenen Länge umgebrochen.
+
+--------------
+Aufnahme Optionen
+--------------
+Upd: Ultrastar 0.5.2 Recording Optionen hinzugefügt
+Fix: Soundcard Einträge wurden mehrmals in die Config.Ini eingetragen
+Fix: Mehr als ein Singstaradapter sind jetzt möglich(2 Soundkarten mit dem selben Namen)
+
+--------------
+Song Screen
+--------------
+Upd: Playlist Support hinzugefügt
+
+Upd: Song Suche (mit Interface)
+Upd: Jump to Letter Hotkey
+Upd: Songscreen Menu ähnlich wie bei Singstar
+Upd: Spielernamen können nun vor dem Singen geändert werden
+Upd: Song Vorschau Lautstärke kann nun geändert werden
+Upd: Song Vorschau kann eingefadet werden
+
+--------------
+Party Modus
+--------------
+Upd: Party Modus hinzugefügt:
+ 3 Teams mit bis zu 4 Spielern möglich
+ => insgesamt 12 Spieler
+Upd: Modi SDK: Party Modi können mit etwas Programmiererfahrung leicht erstellt werden.
+Upd: 4 Standard Party Modi Plugins: Duell, Hold the Line, Until 5000, Blind Mode
+
+--------------
+Effekte
+--------------
+Upd: Neue Perfect Note Effekte
+Upd: Effekt bei perfekt gesungenem Satz hinzugefügt
+Upd: Goldene Noten haben jetzt einen Singstar ähnlichen Glitzereffekt, und sind nicht mehr gelb.
+Upd: Neuer Effekt bei getroffenen Goldenen Noten
+Upd: Neuer Menü-Übergangs-Effekt: Screen verschwimmt und "fliegt aus dem Bild heraus". Neue Möglichkeiten für Theme-Ersteller
+
+--------------
+Sonstiges
+--------------
+Upd: Deluxe Theme hinzugefügt: Theme mit PS3 ähnlichem Aussehen
+Upd: Neues Score Speicherungssystem (basierend auf SQLite)
+Upd: Statistiken hinzugefügt. Generelle Statistiken und
+ Beste Scores, Beste Sänger, beliebteste Songs, beliebteste Bands
+Upd: Einige On Screen Fehler Benachrichtigungen hinzugefügt, die neuen Spielern helfen sollten.
+Upd: Neuer Erweiterter Options Screen hinzugefügt
+Upd: Abfrage vor dem Beenden hinzugefügt
+Upd: Song Hintergrundbilder können jetzt auch auf voller Bildschrimfläche dargestellt werden.
+Upd: Im Editor werden jetzt zusätzlich die richtigen Notennamen ausgegeben (C, F#, etc.)
+Upd: Neue Schriftarten
+Upd: Bessere Unterstützung für Kommandozeilen Parameter
+Fix: Nahezu keine Abstürze mehr wegen fehlerhaften TXT-Dateien.
+ In Game Popup hinzugefügt und einen Rücksprunk zum Songscreen.
+ Selbst der Partymodus wird nicht unterbrochen.
+Fix: Workaround für Cover und Hintergrund JPEG-Errors
+Fix: Videosize kann wieder geändert werden.
+Fix: Bug in LineBonus Popup behoben das zu Speicherüberläufen führen kann.
+Fix: Bug in SelectSlide behoben der zu Fehlern mit weniger als 3 optionen führen kann.
+ Automatisches Resizing hinzugefügt
+Fix: Backgrounds can be used now in option Screens, too
+Fix: Unnützer Speicherverbauch wenn ein Song mit Video abgespielt wird. Einige Videodaten blieben im Speicher nachdem der Song beendet wurde.
+ Dies könnte zu einem Out Of Memory Error führen wenn viele Songs mit Video gespielt werden.
+Fix: Einige Speichernutzungs und Ladezeit Updates
+Fix: Falsche Satzübergänge wenn T im Editor benutzt wurde und sich 2 Noten von verschiedenen
+ Sätzen überlagerten.
+Fix: Editor stürzte ab wenn die letzte Note eines Satzes gelöscht wurde.
+Fix: [Midi Converter]Noten wurden mehrmals hinzugefügt wenn eine Datei mehrmals geöffnet wurde
+ oder der Save Button mehrmals gedrückt wurde.
+Fix: [Midi Converter]Satzübergänge werden nun vom Mide Converter automatisch berechnet.
+
+UltraStar 0.5.0 ultra-star.dl.am Mod X-Mas Edition (by Mota und Whiteshark)
+-----------------------------
+Upd: Neue schnellerer und fehlerresistenter Headereinlesefunktion
+Upd: Bewertungs Bar (Singstar Like)
+Upd: PhrasenBonus + Popups
+
+Upd: Skin verschönert
+
+UltraStar 0.5.0 ultra-star.dl.am Mod r10 (by Mota und Whiteshark)
+-----------------------------
+Fix: Ein kleiner Bug bei der Pause Funktion wurde gefixt.
+Fix: Ein Bug im Theme System wurde behoben. (SelectSlide konnte nicht weniger als 3 Einträge enthalten.)
+Fix: Skin, Beschränkung auf 4 Skins aufgehoben
+Fix: Noten Texturen werden anders/besser eingelesen
+
+Upd: Zahlen bei der Songauswahl sind jetzt sinnvoller.
+Upd: Anzahl der Songs die eine Kategorie beinhaltet wird in der Übersicht angezeigt
+Upd: Neuer Notenskin
+
+Upd: LanguageTag + Sortierung
+Upd: Unterstützung der Covers.ini aus 0.5.1 - Für alle Sortier-Funtionen. Die alte Möglichkeit ohne die Covers.ini ist weiterhin möglich, genauso wie eine Kombination beider Methoden.
+
+UltraStar 0.5.0 ultra-star.dl.am Mod r9 (Release by Whiteshark)
+-----------------------------
+
+Upd: BPM und VideoGap Angaben mit Punkt werden jetzt auch eingelesen. Es wird aber in diesem Fall in der Error.log eine meldung mit dem Namen des Fehlerhaften Songs ausgegeben.
+Upd: Sollte beim Einlesen eines Songs(speziell beim Header) ein Fehler auftreten wird in der Error.log der Songname + Zeile ausgegeben.
+
+Upd, Beta: Pause. P drücken und der Song wird pausiert, nocheinmal P und es kann wieder gesungen werden. Noch keine Anzeige ob Pause aktiviert wird, und noch kein Pause Menü.
+
+bekannte Probleme:
+Stellt man die Aufnahme Funktion ein, kommt es zu einem extremen CPU-Zeit verbrauch und es fängt an zu Laggen
+
+UltraStar 0.5.0 ultra-star.dl.am Mod r8b (Release by Whiteshark)
+-----------------------------
+Fix: Random Funktionen funktionieren alle ohne Fehler
+Fix: In der Kategorieauswahl wird jetzt beim Start immer die erste Kategorie angezeigt
+Fix: Musik wird nach Kategoriewechsel korrekt abgespielt
+Fix: Richtiger Text wird jetzt nicht mehr zu falscher Musik abgespielt
+Fix: Nach Beenden eines Songs ist dieser jetzt wieder in der Übersicht angewählt
+Fix: Midi-konvertor Bug behoben (Nur Freestyle Noten anstatt Normalen)
+
+Thx to: dennisthemenace und mota für die super Bug-Reports :P
+
+Upd: doomhammers Cover sind Integriert: thx to doomhammer
+
+UltraStar 0.5.0 ultra-star.dl.am Mod r8a (Release by Whiteshark)
+-----------------------------
+Fix: Theme System konnte nicht ausgewählt werden (workaround: Nur bis zu 4 Themes möglich)
+Fix: Richtige Kategorie wird angezeigt nach Druck von Escape
+
+Upd: Neue Random Funktionen: R + [Strg]: Random in allen Kategorien (Hier wird die Kategorie oben noch falsch angezeigt); R + [Shift]: Zufällige Kategorie
+Upd: Gerade gewählte Kategorie wird oben links in der Ecke gezeigt
+
+UltraStar 0.5.0 ultra-star.dl.am Mod r8 (Release by Whiteshark)
+-----------------------------
+Fix: Creatorbug behoben
+Fix: Wenn Tabs=on kam es manchmal vor das der angewählte Song nicht mit dem Angezeigten übereingestimmt hat
+
+Upd: Theme System komplett
+ -Bei Start nach Themes Suchen
+ -Den ThemeOptions Screen ändern
+Upd: Neue Farben für Themes :)
+Upd: kleine änderungen am Editor
+ -Leerzeichen im Header werden automatisch korrigiert
+ -Header ist nicht mehr Case Sensitive
+
+Upd: Skin Ordner gesäubert, Es gibt jetzt 2 Skins: Motas und der Original Skin
+Upd: Ordner haben ihr eigenes Cover, welches angezeigt wird falls kein spezielles Cover vorhanden ist
+Upd: Der BewertungsText (Ultrastar, Singstar, etc.) kann jetzt übersetzt werden
+
+Upd: Falls eine Sprache nicht komplett ist werden die nicht übersetzten Texte, mit der Englischen Sprachdatei übersetzt. (Falls es zu nicht kompletten Sprachdateien kommt)
+
+Upd: neues Kategorie System:
+ -Wenn eine Kategorie angewählt wird, werden nur die enthaltenden Songs angezeigt.
+ -Mit Escape gehts zurück in die Kategorie Auswahl
+ -Mit Hoch und Runter kann die Kategorie gewechselt werden.
+
+UltraStar 0.5.0 mota patch r7 (Release by Mota)
+-----------------------------
+- Neues Notendesign.
+- versch. Neue Grafiken.
+- Neue Bewertung "Ultrastar" ab 9810 Punkte.
+- Textgröße-Bug im Editor behoben.
+
+UltraStar 0.5.0 mota patch r6 - 17.11.06 (Release by Mota)
+----------------------------------------
+- Editiorfunktionen für Goldene/Freestyle-Noten. (Tasten [G] und [F])
+- Speicherfunktion des Editors angepasst.
+- Verändertes Theme "SingStar".
+
+UltraStar 0.5.0 mota patch r5 - 16.11.06 (Release by Mota)
+----------------------------------------
+- Goldene Noten werden dargestellt
+- Zufallsauswahl verbessert
+
+UltraStar 0.5.0 mota patch r4 (Release by Mota)
+-----------------------------
+- Perfekt-Stern animation
+
+UltraStar 0.5.0 mota patch r3 (Release by Mota)
+-----------------------------
+- Sortierung Title2 und Artist2 -> Zahlen in Ordner "#"
+
+UltraStar 0.5.0 mota patch r2 (Release by Mota)
+-----------------------------
+- Eigene Cover für alle Sortierungen
+
+UltraStar 0.5.0 mota patch (Release by Mota)
+--------------------------
+- Eigene Cover für Sortierung nach Edition.
+
+UltraStar 0.5.0 (by Corvus5)
+--------------------------
- Original Code
\ No newline at end of file diff --git a/unicode/Makefile.in b/unicode/Makefile.in index 7dd84313..ad94259d 100644 --- a/unicode/Makefile.in +++ b/unicode/Makefile.in @@ -182,7 +182,7 @@ Makefile: $(srcdir)/Makefile.in $(USDX_SRC_DIR)/Makefile.in $(USDX_SRC_DIR)/conf config.status: configure ./config.status --recheck -.PHONE: reconf +.PHONY: reconf reconf: ./autogen.sh @@ -364,20 +364,21 @@ macosx-app: all @echo "Creating the Mac OS X application" @echo "" - $(MKDIR) $(macosx_bundle_path)/Resources + $(MKDIR) $(macosx_bundle_path) # Put the icon file into its particular place. # Must be done BEFORE info.plist is created. - $(INSTALL_DATA) icons/ultrastardx.icns $(macosx_bundle_path)/Resources/ + $(MKDIR) $(macosx_bundle_path)/resources + $(INSTALL_DATA) icons/ultrastardx.icns $(macosx_bundle_path)/resources/ # the info.plist file $(INSTALL_DATA) $(USDX_SRC_DIR)/macosx/Info.plist $(macosx_bundle_path)/ # Copy the resources. - $(MAKE) install-all INSTALL_DATADIR=$(macosx_bundle_path)/Resources bindir=$(macosx_bundle_path)/MacOS + $(MAKE) install-all INSTALL_DATADIR=$(macosx_bundle_path) bindir=$(macosx_bundle_path)/MacOS # Create the song directory. - $(MKDIR) $(macosx_bundle_path)/Resources/songs + $(MKDIR) $(macosx_bundle_path)/songs # final messages @echo "" @@ -430,7 +431,7 @@ endef .PHONY: macosx-dmg macosx-dmg: macosx-standalone-app $(RM) UltraStarDeluxe.dmg - $(HDIUTIL) create -type SPARSE -size 30m -fs HFS+ -volname UltraStarDeluxe -ov -attach UltraStarDeluxe.sparseimage + $(HDIUTIL) create -type SPARSE -size 40m -fs HFS+ -volname UltraStarDeluxe -ov -attach UltraStarDeluxe.sparseimage /bin/cp -R UltraStarDeluxe.app /Volumes/UltraStarDeluxe # /bin/cp ultrastardx/icons/UltraStarDeluxeVolumeIcon.icns /Volumes/UltraStarDeluxe/.VolumeIcon.icns # /Developer/Tools/SetFile -a C /Volumes/UltraStarDeluxe/.VolumeIcon.icns /Volumes/UltraStarDeluxe diff --git a/unicode/dists/autogen/m4/fpc.m4 b/unicode/dists/autogen/m4/fpc.m4 index f7bf9e20..740071cb 100644 --- a/unicode/dists/autogen/m4/fpc.m4 +++ b/unicode/dists/autogen/m4/fpc.m4 @@ -89,7 +89,7 @@ AC_ARG_ENABLE(gprof, AC_ARG_ENABLE(valgrind, [AS_HELP_STRING([--enable-valgrind], [Enable debugging with valgrind @<:@default=no@:>@])], - [test x$enableval = xyes && PFLAGS_EXTRA="$PFLAGS_EXTRA -pv"], []) + [test x$enableval = xyes && PFLAGS_EXTRA="$PFLAGS_EXTRA -gv"], []) # heaptrace AC_ARG_ENABLE(heaptrace, diff --git a/unicode/dists/code.svnprops b/unicode/dists/code.svnprops Binary files differnew file mode 100644 index 00000000..51db6183 --- /dev/null +++ b/unicode/dists/code.svnprops diff --git a/unicode/game/languages/English.ini b/unicode/game/languages/English.ini index e69ead4a..05559c1a 100644 --- a/unicode/game/languages/English.ini +++ b/unicode/game/languages/English.ini @@ -14,7 +14,7 @@ SING_STATS=stats SING_STATS_DESC=view the statistics SING_EDITOR=editor -SING_EDITOR_DESC=create your own songs +SING_EDITOR_DESC=create your own song SING_GAME_OPTIONS=game options SING_GAME_OPTIONS_DESC=change game settings @@ -96,6 +96,18 @@ SING_OPTIONS_ADVANCED_COUNT_HOW_OFTEN_SUNG= SING_OPTIONS_ADVANCED_ONSONGCLICK=after Song Select SING_OPTIONS_ADVANCED_PARTYPOPUP=Auto PartyMenu +SING_EDIT=Editor +SING_EDIT_MENU_DESCRIPTION=create your own song + +SING_EDIT_BUTTON_DESCRIPTION_CONVERT=Import text from midi file +SING_EDIT_BUTTON_DESCRIPTION_EXIT=back +SING_EDIT_BUTTON_CONVERT=Import +SING_EDIT_BUTTON_EXIT=back + +SING_EDIT_NAVIGATE=navigate +SING_EDIT_SELECT=select +SING_EDIT_EXIT=back + SING_LEGEND_SELECT=select SING_LEGEND_NAVIGATE=navigate SING_LEGEND_CONTINUE=continue diff --git a/unicode/game/languages/Finnish.ini b/unicode/game/languages/Finnish.ini new file mode 100644 index 00000000..40be8dc5 --- /dev/null +++ b/unicode/game/languages/Finnish.ini @@ -0,0 +1,322 @@ +[Text]
+SING_LOADING=Ladataan...
+
+SING_CHOOSE_MODE=valitse pelimuoto
+SING_SING=laula
+SING_SING_DESC=pikapeli - laula soolo tai duetto
+
+SING_MULTI=bileet
+SING_MULTI_DESC=Oletko valmis joukkuetaistoon?
+
+SING_TOOLS=asetukset
+
+SING_STATS=tilastot
+SING_STATS_DESC=näytä tilastot
+
+SING_EDITOR=kappale-editori
+SING_EDITOR_DESC=luo omia kappaleita
+
+SING_GAME_OPTIONS=peliasetukset
+SING_GAME_OPTIONS_DESC=muokkaa peliasetuksia
+
+SING_EXIT=lopeta
+SING_EXIT_DESC=lopeta peli
+
+SING_OPTIONS=asetukset
+SING_OPTIONS_DESC=muuta asetuksia
+SING_OPTIONS_WHEREAMI=Asetukset
+
+SING_OPTIONS_GAME=peli
+SING_OPTIONS_GRAPHICS=grafiikka
+SING_OPTIONS_SOUND=ääni
+SING_OPTIONS_LYRICS=lyriikat
+SING_OPTIONS_THEMES=ulkoasut
+SING_OPTIONS_RECORD=äänitys
+SING_OPTIONS_ADVANCED=lisäasetukset
+SING_OPTIONS_EXIT=takaisin
+
+SING_OPTIONS_GAME_WHEREAMI=Peliasetukset
+SING_OPTIONS_GAME_DESC=yleiset peliasetukset
+SING_OPTIONS_GAME_PLAYERS=Pelaajat
+SING_OPTIONS_GAME_DIFFICULTY=Vaikeustaso
+SING_OPTIONS_GAME_LANGUAGE=Kieli
+SING_OPTIONS_GAME_TABS=Kansiot
+SING_OPTIONS_GAME_SORTING=Lajittelu
+SING_OPTIONS_GAME_DEBUG=Debuggaus
+
+SING_OPTIONS_GRAPHICS_WHEREAMI=Grafiikka-asetukset
+SING_OPTIONS_GRAPHICS_DESC=grafiikka-asetukset
+SING_OPTIONS_GRAPHICS_RESOLUTION=Resoluutio
+SING_OPTIONS_GRAPHICS_FULLSCREEN=Koko ruutu
+SING_OPTIONS_GRAPHICS_DEPTH=Värisyvyys
+SING_OPTIONS_GRAPHICS_VISUALIZER=Visualisointi
+SING_OPTIONS_GRAPHICS_OSCILLOSCOPE=Värähtelijä
+SING_OPTIONS_GRAPHICS_LINEBONUS=Viivabonukset
+SING_OPTIONS_GRAPHICS_MOVIE_SIZE=Videon koko
+
+SING_OPTIONS_SOUND_WHEREAMI=Ääniasetukset
+SING_OPTIONS_SOUND_DESC=ääniasetukset
+SING_OPTIONS_SOUND_VOICEPASSTHROUGH=Oma ääni kuuluvissa
+SING_OPTIONS_SOUND_BACKGROUNDMUSIC=Taustamusiikki
+SING_OPTIONS_SOUND_MIC_BOOST=Mikin voimakkuus
+SING_OPTIONS_SOUND_CLICK_ASSIST=Klikkausapu
+SING_OPTIONS_SOUND_BEAT_CLICK=Tahti-apu
+SING_OPTIONS_SOUND_THRESHOLD=Kynnystaso
+SING_OPTIONS_SOUND_TWO_PLAYERS_MODE=Kaksinpelitila
+SING_OPTIONS_SOUND_PREVIEWVOLUME=Esikatselun voimakkuus
+SING_OPTIONS_SOUND_PREVIEWFADING=Esikatselun feidaus
+
+SING_OPTIONS_LYRICS_WHEREAMI=Lyriikka-asetukset
+SING_OPTIONS_LYRICS_DESC=lyriikka-asetukset
+SING_OPTIONS_LYRICS_FONT=Fontti
+SING_OPTIONS_LYRICS_EFFECT=Tehoste
+SING_OPTIONS_LYRICS_SOLMIZATION=Solmisaatio
+SING_OPTIONS_LYRICS_NOTELINES=Nuottiviivasto
+
+SING_OPTIONS_THEMES_WHEREAMI=Ulkoasu-asetukset
+SING_OPTIONS_THEMES_DESC=ulkoasu-asetukset
+SING_OPTIONS_THEMES_THEME=Ulkoasu
+SING_OPTIONS_THEMES_SKIN=Tausta
+SING_OPTIONS_THEMES_COLOR=Väri
+
+SING_OPTIONS_RECORD_WHEREAMI=Äänitys-asetukset
+SING_OPTIONS_RECORD_DESC=mikrofonin asetukset
+SING_OPTIONS_RECORD_CARD=Äänikortti
+SING_OPTIONS_RECORD_INPUT=Sisääntulo
+SING_OPTIONS_RECORD_CHANNEL=Kanava
+
+SING_OPTIONS_ADVANCED_WHEREAMI=Lisäasetukset
+SING_OPTIONS_ADVANCED_DESC=lisäasetukset
+SING_OPTIONS_ADVANCED_EFFECTSING=Kappaletehosteet
+SING_OPTIONS_ADVANCED_SCREENFADE=Ruudun feidaus
+SING_OPTIONS_ADVANCED_LOADANIMATION=Latausanimaatio
+SING_OPTIONS_ADVANCED_ASKBEFOREDEL=Poiston vahvistus
+SING_OPTIONS_ADVANCED_LINEBONUS=Rivibonus
+SING_OPTIONS_ADVANCED_COUNT_HOW_OFTEN_SUNG=
+SING_OPTIONS_ADVANCED_ONSONGCLICK=Kappaleen jälkeen
+SING_OPTIONS_ADVANCED_PARTYPOPUP=Autom. bilevalikko
+
+SING_EDIT=kappale-editori
+SING_EDIT_MENU_DESCRIPTION=luo omia kappaleita
+
+SING_EDIT_BUTTON_DESCRIPTION_CONVERT=Luo .txt midi-tiedostosta
+SING_EDIT_BUTTON_DESCRIPTION_EXIT=takaisin
+SING_EDIT_BUTTON_CONVERT=Luo
+SING_EDIT_BUTTON_EXIT=takaisin
+
+SING_EDIT_NAVIGATE=liiku
+SING_EDIT_SELECT=valitse
+SING_EDIT_EXIT=takaisin
+
+SING_LEGEND_SELECT=valitse
+SING_LEGEND_NAVIGATE=liiku
+SING_LEGEND_CONTINUE=jatka
+SING_LEGEND_ESC=takaisin
+
+SING_PLAYER_DESC=syötä pelaajan nimi
+SING_PLAYER_WHEREAMI=Pelaajien nimet
+SING_PLAYER_ENTER_NAME=syötä nimi
+
+SING_DIFFICULTY_DESC=valitse vaikeustaso
+SING_DIFFICULTY_WHEREAMI=Vaikeustaso
+SING_DIFFICULTY_CONTINUE=kappalevalinta
+SING_EASY=Helppo
+SING_MEDIUM=Keskitaso
+SING_HARD=Vaikea
+
+SING_SONG_SELECTION_DESC=valitse kappale
+SING_SONG_SELECTION_WHEREAMI=Kappalevalinta
+SING_SONG_SELECTION_GOTO=mene ...
+SING_SONG_SELECTION=kappalevalinta
+SING_SONG_SELECTION_MENU=valikko
+SING_SONG_SELECTION_PLAYLIST=soittolista
+SING_SONGS_IN_CAT=kappaletta
+PLAYLIST_CATTEXT=Soittolista: %s
+
+SING_TIME=KESTO
+SING_TOTAL=yhteensä
+SING_MODE=laula soolo
+SING_NOTES=nuotit
+SING_GOLDEN_NOTES=kultanuotit
+SING_PHRASE_BONUS=rivibonus
+
+SING_MENU=Päävalikko
+
+SONG_SCORE=kappaleen pisteet
+SONG_SCORE_WHEREAMI=Pisteet
+
+SING_SCORE_TONE_DEAF=Sävelkorvaton
+SING_SCORE_AMATEUR=Amatööri
+SING_SCORE_WANNABE=Wannabe
+SING_SCORE_HOPEFUL=Toiveita herättävä
+SING_SCORE_RISING_STAR=Nouseva tähti
+SING_SCORE_LEAD_SINGER=Päälaulaja
+SING_SCORE_SUPERSTAR=Supertähti
+SING_SCORE_ULTRASTAR=Ultratähti
+
+SING_TOP_5_CHARTS=top 5 pelaajat
+SING_TOP_5_CHARTS_WHEREAMI=top 5
+SING_TOP_5_CHARTS_CONTINUE=kappalevalintaan
+
+POPUP_PERFECT=täydellistä!
+POPUP_AWESOME=loistavaa!
+POPUP_GREAT=mahtavaa!
+POPUP_GOOD=hyvä!
+POPUP_NOTBAD=menettelee!
+POPUP_BAD=huonoa!
+POPUP_POOR=heikkoa!
+POPUP_AWFUL=kauheaa!
+
+IMPLODE_GLUE1=,
+IMPLODE_GLUE2= ja
+
+SONG_MENU_NAME_MAIN=kappalevalikko
+SONG_MENU_PLAY=Laula
+SONG_MENU_CHANGEPLAYERS=Vaihda pelaajia
+SONG_MENU_EDIT=Muokkaa
+SONG_MENU_MODI=Laula muunneltu kappale
+SONG_MENU_CANCEL=Peruuta
+
+SONG_MENU_NAME_PLAYLIST=Kappalevalikko
+SONG_MENU_PLAYLIST_ADD=Lisää kappale
+SONG_MENU_PLAYLIST_DEL=Poista kappale
+
+SONG_MENU_NAME_PLAYLIST_ADD=Lisää kappale
+SONG_MENU_PLAYLIST_ADD_NEW=uuteen soittolistaan
+SONG_MENU_PLAYLIST_ADD_EXISTING=luotuun soittolistaan
+SONG_MENU_PLAYLIST_NOEXISTING=Soittolistaa ei saatavilla
+
+SONG_MENU_NAME_PLAYLIST_NEW=Uusi soittolista
+SONG_MENU_PLAYLIST_NEW_CREATE=Luo
+SONG_MENU_PLAYLIST_NEW_UNNAMED=Nimetön
+
+SONG_MENU_NAME_PLAYLIST_DEL=Vahvista poisto?
+SONG_MENU_YES=Kyllä
+SONG_MENU_NO=Ei
+
+SONG_MENU_NAME_PLAYLIST_LOAD=Avaa soittolista
+SONG_MENU_PLAYLIST_LOAD=Avaa
+SONG_MENU_PLAYLIST_DELCURRENT=poista nykyinen soittolista
+
+SONG_MENU_NAME_PLAYLIST_DEL=Poista soittolista?
+
+SONG_MENU_NAME_PARTY_MAIN=Bilevalikko
+SONG_MENU_JOKER=Jokeri
+
+SONG_MENU_NAME_PARTY_JOKER=käytä jokeri
+
+SONG_JUMPTO_DESC=etsi kappale
+SONG_JUMPTO_TYPE_DESC=Etsi:
+SONG_JUMPTO_TYPE1=Kaikki
+SONG_JUMPTO_TYPE2=Nimen mukaan
+SONG_JUMPTO_TYPE3=Artistin mukaan
+SONG_JUMPTO_SONGSFOUND=Löytyi %d kappaletta
+SONG_JUMPTO_NOSONGSFOUND=Kappaletta ei löytynyt
+SONG_JUMPTO_HELP=Syötä hakuteksti
+SONG_JUMPTO_CATTEXT=Etsi: %s
+
+PARTY_MODE=biletila
+PARTY_DIFFICULTY=Vaikeustaso
+PARTY_PLAYLIST=Soittolistan valinta
+PARTY_PLAYLIST_ALL=Kaikki kappaleet
+PARTY_PLAYLIST_CATEGORY=Kansio
+PARTY_PLAYLIST_PLAYLIST=Soittolista
+PARTY_ROUNDS=Kierrokset
+PARTY_TEAMS=Joukkueet
+PARTY_TEAMS_PLAYER1=Pelaajat Joukkue1
+PARTY_TEAMS_PLAYER2=Pelaajat Joukkue2
+PARTY_TEAMS_PLAYER3=Pelaajat Joukkue3
+
+PARTY_LEGEND_CONTINUE=jatka
+
+PARTY_OPTIONS_DESC=bilepelin asetukset
+PARTY_OPTIONS_WHEREAMI=Bile-asetukset
+
+PARTY_PLAYER_DESC=Syötä pelaajien ja joukkueiden nimet!
+PARTY_PLAYER_WHEREAMI=Bilepelaajien nimet
+PARTY_PLAYER_ENTER_NAME=syötä nimet
+PARTY_PLAYER_LEGEND_CONTINUE=aloita bileet
+
+PARTY_ROUND_DESC=seuraavat pelaajat mikkeihin
+PARTY_ROUND_WHEREAMI=Seuraava kierros
+PARTY_ROUND_LEGEND_CONTINUE=aloita
+
+PARTY_SONG_WHEREAMI=Bilekappaleen valinta
+PARTY_SONG_LEGEND_CONTINUE=laula
+PARTY_SONG_MENU=bilevalikko
+
+PARTY_SCORE_DESC=kierroksen pisteet
+PARTY_SCORE_WHEREAMI=Bilepisteet
+
+PARTY_WIN_DESC=bilepelin voittaja
+PARTY_WIN_WHEREAMI=Bilepelin voittaja
+PARTY_WIN_LEGEND_CONTINUE=takaisin päävalikkoon
+
+PARTY_ROUND=Kierros
+PARTY_ROUND_WINNER=Voittaja
+PARTY_NOTPLAYEDYET=pelaamatta
+PARTY_NOBODY=ei kukaan
+NEXT_ROUND=Seuraava kierros:
+
+PARTY_DISMISSED=Diskattu!
+PARTY_SCORE_WINS=%s
+PARTY_SCORE_WINS2=voittaa!
+
+PLUGIN_HDL_NAME=Pidä pintasi!
+PLUGIN_HDL_DESC=Älä putoa palkin alapuolelle.
+
+PLUGIN_UNTIL5000_NAME=Viistonnia
+PLUGIN_UNTIL5000_DESC=Ensimmäisenä 5000 pistettä saanut voittaa.
+
+PLUGIN_DUELL_NAME=Kymppitonni
+PLUGIN_DUELL_DESC=Kaksintaistelu 10000 pisteeseen.
+
+PLUGIN_TEAMDUELL_NAME=Mikit kiertoon!
+PLUGIN_TEAMDUELL_DESC=Mikki kiertää joukkueen sisällä... Varaudu siis laulamaan!
+
+PLUGIN_BLIND_NAME=Sokkona
+PLUGIN_BLIND_DESC=Et näe nuotteja.
+
+STAT_MAIN=Tilastot
+STAT_MAIN_DESC=Yleiset
+STAT_MAIN_WHEREAMI=Tilasto
+
+STAT_OVERVIEW_INTRO=%0:s \n Pelattu viimeksi %1:.2d.%2:.2d.%3:d
+STAT_OVERVIEW_SONG=%0:d kappaletta(%3:d musiikkivideota), joista %1:d pelattu ja %2:d joita ei vielä kokeiltu.\n Suosituin kappale: %4:s :n %5:s
+STAT_OVERVIEW_PLAYER=Viimeksi %0:d eri pelaajaa,\n joista paras oli %1:s keskipisteillä %2:d pistettä.\n %3:s sai korkeimmat pisteet, %4:d pistettä.
+
+STAT_DETAIL=Tilasto
+STAT_DETAIL_WHEREAMI=Yksityiskohtainen tilasto
+
+STAT_NEXT=Seuraava sivu
+STAT_PREV=Edellinen sivu
+STAT_REVERSE=Paras/huonoin
+STAT_PAGE=Sivu %0:d / %1:d\n (%2:d / %3:d)
+
+STAT_DESC_SCORES=Parhaat laulajat
+STAT_DESC_SCORES_REVERSED=Huonoimmat laulajat
+STAT_FORMAT_SCORES=%0:s - %1:d [%2:s] \n (%3:s - %4:s)
+
+STAT_DESC_SINGERS=Parhaat laulajat
+STAT_DESC_SINGERS_REVERSED=Huonoimmat laulajat
+STAT_FORMAT_SINGERS=%0:s \n Keskipisteet: %1:d
+
+STAT_DESC_SONGS=Suosituimmat biisit
+STAT_DESC_SONGS_REVERSED=Vähiten lauletut biisit
+STAT_FORMAT_SONGS=%0:s - %1:s \n %2:dx laulettu
+
+STAT_DESC_BANDS=Suosituimmat bändit
+STAT_DESC_BANDS_REVERSED=Vähiten lauletut bändit
+STAT_FORMAT_BANDS=%0:s \n %1:dx laulettu
+
+MSG_ERROR_TITLE=Virhe
+MSG_QUESTION_TITLE= o_0
+MSG_QUIT_USDX=Poistutaanko UltraStarista?
+MSG_END_PARTY=Poistutaanko biletilasta?
+ERROR_NO_SONGS=Kappaleita ei saatavilla
+ERROR_NO_PLUGINS=Lisäosia ei saatavilla
+ERROR_CORRUPT_SONG=Kappaletta ei voi ladata.
+ERROR_CORRUPT_SONG_FILE_NOT_FOUND=Kappaletta ei voi ladata: Tiedostoa ei löytynyt
+ERROR_CORRUPT_SONG_NO_NOTES=Kappaletta ei voi ladata: Nuotteja ei löytynyt
+ERROR_CORRUPT_SONG_NO_BREAKS=Kappaletta ei voi ladata: Rivikatko(j)a ei löytynyt
+ERROR_CORRUPT_SONG_UNKNOWN_IN_LINE=Kappaletta ei voi ladata: Virhe txt:n rivillä %0:d
\ No newline at end of file diff --git a/unicode/game/languages/French.ini b/unicode/game/languages/French.ini index 8cae0a80..8531b640 100644 --- a/unicode/game/languages/French.ini +++ b/unicode/game/languages/French.ini @@ -92,6 +92,18 @@ SING_OPTIONS_ADVANCED_COUNT_HOW_OFTEN_SUNG=Compteur de titres chantés SING_OPTIONS_ADVANCED_ONSONGCLICK=Choix ap. chanson SING_OPTIONS_ADVANCED_PARTYPOPUP=Menu multi auto +SING_EDIT=Éditeur +SING_EDIT_MENU_DESCRIPTION=Créer vos propre chansons + +SING_EDIT_BUTTON_DESCRIPTION_CONVERT=Importer texte à une dossier de midi file +SING_EDIT_BUTTON_DESCRIPTION_EXIT=Retour +SING_EDIT_BUTTON_CONVERT=Importer +SING_EDIT_BUTTON_EXIT=Retour + +SING_EDIT_NAVIGATE=Naviguer +SING_EDIT_SELECT=Valider +SING_EDIT_EXIT=Retour + SING_LEGEND_SELECT=Valider SING_LEGEND_NAVIGATE=Naviguer SING_LEGEND_CONTINUE=Valider @@ -179,7 +191,6 @@ SONG_MENU_NO=Non SONG_MENU_NAME_PLAYLIST_DEL=Supprimer la playlist ? - SONG_MENU_NAME_PLAYLIST_LOAD=Ouvrir une playlist SONG_MENU_PLAYLIST_LOAD=Ouvrir SONG_MENU_PLAYLIST_DELCURRENT=Supprimer la playlist actuel diff --git a/unicode/game/languages/German.ini b/unicode/game/languages/German.ini index 9b41b61b..97a31d57 100644 --- a/unicode/game/languages/German.ini +++ b/unicode/game/languages/German.ini @@ -6,7 +6,7 @@ SING_SING=Singen SING_SING_DESC=Singen SING_MULTI=Party -SING_MULTI_DESC=Ein rundenbasierendes Teamspiel spielen +SING_MULTI_DESC=Ein rundenbasiertes Teamspiel spielen SING_TOOLS=Tools @@ -14,7 +14,7 @@ SING_STATS=Statistiken SING_STATS_DESC=Die Statistiken anschauen SING_EDITOR=Editor -SING_EDITOR_DESC=Mach deinen eigenen Song +SING_EDITOR_DESC=Erstelle deinen eigenen Song SING_GAME_OPTIONS=Spiel-Optionen SING_GAME_OPTIONS_DESC=Verändere die Spieleinstellungen @@ -96,6 +96,18 @@ SING_OPTIONS_ADVANCED_COUNT_HOW_OFTEN_SUNG=Wie oft gesungen mitzählen SING_OPTIONS_ADVANCED_ONSONGCLICK=nach Song-Wahl SING_OPTIONS_ADVANCED_PARTYPOPUP=Auto Party-Menü +SING_EDIT=Editor +SING_EDIT_MENU_DESCRIPTION=Erstelle deinen eigenen Song + +SING_EDIT_BUTTON_DESCRIPTION_CONVERT=Text aus Midi-Datei in Text importieren +SING_EDIT_BUTTON_DESCRIPTION_EXIT=zurück +SING_EDIT_BUTTON_CONVERT=Import +SING_EDIT_BUTTON_EXIT=zurück + +SING_EDIT_NAVIGATE=Navigieren +SING_EDIT_SELECT=Auswählen +SING_EDIT_EXIT=zurück + SING_LEGEND_SELECT=Auswählen SING_LEGEND_NAVIGATE=Navigieren SING_LEGEND_CONTINUE=Weiter diff --git a/unicode/game/languages/Italian.ini b/unicode/game/languages/Italian.ini index 669deedb..1d319203 100644 --- a/unicode/game/languages/Italian.ini +++ b/unicode/game/languages/Italian.ini @@ -92,6 +92,18 @@ SING_OPTIONS_ADVANCED_COUNT_HOW_OFTEN_SUNG= SING_OPTIONS_ADVANCED_ONSONGCLICK=se Sel. Canzone SING_OPTIONS_ADVANCED_PARTYPOPUP=Auto MenuParty +SING_EDIT=editor +SING_EDIT_MENU_DESCRIPTION=crea nuove canzoni + +SING_EDIT_BUTTON_DESCRIPTION_CONVERT=importa il testo da uno schedario di midi +SING_EDIT_BUTTON_DESCRIPTION_EXIT=indietro +SING_EDIT_BUTTON_CONVERT=importa +SING_EDIT_BUTTON_EXIT=indietro + +SING_EDIT_NAVIGATE=naviga +SING_EDIT_SELECT=seleziona +SING_EDIT_EXIT=indietro + SING_LEGEND_SELECT=seleziona SING_LEGEND_NAVIGATE=naviga SING_LEGEND_CONTINUE=continua diff --git a/unicode/game/languages/Slovenian.ini b/unicode/game/languages/Slovenian.ini new file mode 100644 index 00000000..3006141c --- /dev/null +++ b/unicode/game/languages/Slovenian.ini @@ -0,0 +1,322 @@ +[Text]
+SING_LOADING=Nalaganje...
+
+SING_CHOOSE_MODE=izberi nacin
+SING_SING=poj
+SING_SING_DESC=poj sam ali v duetu
+
+SING_MULTI=zabava
+SING_MULTI_DESC=poj v nacinu zabave
+
+SING_TOOLS=orodja
+
+SING_STATS=statistika
+SING_STATS_DESC=poglej statistiko
+
+SING_EDITOR=urednik
+SING_EDITOR_DESC=izdelaj svoje pesmi
+
+SING_GAME_OPTIONS=nastavitve igre
+SING_GAME_OPTIONS_DESC=spremeni nastavitve igre
+
+SING_EXIT=izhod
+SING_EXIT_DESC=izhod iz igre
+
+SING_OPTIONS=nastavitve
+SING_OPTIONS_DESC=spremeni nastavitve
+SING_OPTIONS_WHEREAMI=Nastavitve
+
+SING_OPTIONS_GAME=igra
+SING_OPTIONS_GRAPHICS=izgled
+SING_OPTIONS_SOUND=zvok
+SING_OPTIONS_LYRICS=besedilo
+SING_OPTIONS_THEMES=tema
+SING_OPTIONS_RECORD=snemanje
+SING_OPTIONS_ADVANCED=napredno
+SING_OPTIONS_EXIT=nazaj
+
+SING_OPTIONS_GAME_WHEREAMI=Nastavitve Igre
+SING_OPTIONS_GAME_DESC=osnovne nastavitve
+SING_OPTIONS_GAME_PLAYERS=Igralci
+SING_OPTIONS_GAME_DIFFICULTY=Težavnost
+SING_OPTIONS_GAME_LANGUAGE=Jezik
+SING_OPTIONS_GAME_TABS=Mape
+SING_OPTIONS_GAME_SORTING=Sortiranje
+SING_OPTIONS_GAME_DEBUG=Odpravljanje hrošcev
+
+SING_OPTIONS_GRAPHICS_WHEREAMI=Nastavitve prikaza
+SING_OPTIONS_GRAPHICS_DESC=nastavitve prikaza
+SING_OPTIONS_GRAPHICS_RESOLUTION=Locljivost
+SING_OPTIONS_GRAPHICS_FULLSCREEN=Celozaslonski nacin
+SING_OPTIONS_GRAPHICS_DEPTH=Globina
+SING_OPTIONS_GRAPHICS_VISUALIZER=Vizualizacija
+SING_OPTIONS_GRAPHICS_OSCILLOSCOPE=Osciloskop
+SING_OPTIONS_GRAPHICS_LINEBONUS=Vrsticni bonus
+SING_OPTIONS_GRAPHICS_MOVIE_SIZE=Velikost videa
+
+SING_OPTIONS_SOUND_WHEREAMI=Nastavitve zvoka
+SING_OPTIONS_SOUND_DESC=nastavitve zvoka
+SING_OPTIONS_SOUND_VOICEPASSTHROUGH=Mikrofonski Playback
+SING_OPTIONS_SOUND_BACKGROUNDMUSIC=Glasbena podlaga
+SING_OPTIONS_SOUND_MIC_BOOST=Ojacitev mikrofona
+SING_OPTIONS_SOUND_CLICK_ASSIST=Asistent klikanja
+SING_OPTIONS_SOUND_BEAT_CLICK=Klikanje po ritmu
+SING_OPTIONS_SOUND_THRESHOLD=Prag
+SING_OPTIONS_SOUND_TWO_PLAYERS_MODE=Nacin za dva igralca
+SING_OPTIONS_SOUND_PREVIEWVOLUME=Glasnost predogleda
+SING_OPTIONS_SOUND_PREVIEWFADING=narašcanje glasnosti
+
+SING_OPTIONS_LYRICS_WHEREAMI=Nastavitve besedila
+SING_OPTIONS_LYRICS_DESC=nastavitve besedila
+SING_OPTIONS_LYRICS_FONT=Pisava
+SING_OPTIONS_LYRICS_EFFECT=Ucinek
+SING_OPTIONS_LYRICS_SOLMIZATION=Solmizacija
+SING_OPTIONS_LYRICS_NOTELINES=Notno crtovje
+
+SING_OPTIONS_THEMES_WHEREAMI=Nastavitve tem
+SING_OPTIONS_THEMES_DESC=nastavitve teme
+SING_OPTIONS_THEMES_THEME=Tema
+SING_OPTIONS_THEMES_SKIN=Izgled
+SING_OPTIONS_THEMES_COLOR=Barva
+
+SING_OPTIONS_RECORD_WHEREAMI=Nastavitve snemanja
+SING_OPTIONS_RECORD_DESC=nastavitve mikrofona
+SING_OPTIONS_RECORD_CARD=Vir zvoka
+SING_OPTIONS_RECORD_INPUT=Vhod
+SING_OPTIONS_RECORD_CHANNEL=Kanal
+
+SING_OPTIONS_ADVANCED_WHEREAMI=Napredne nastavitve
+SING_OPTIONS_ADVANCED_DESC=Napredne nastavitve
+SING_OPTIONS_ADVANCED_EFFECTSING=Pevski efekt
+SING_OPTIONS_ADVANCED_SCREENFADE=Zamegljevanje prikaza
+SING_OPTIONS_ADVANCED_LOADANIMATION=Zacetna animacija
+SING_OPTIONS_ADVANCED_ASKBEFOREDEL=Zašcitno vprašanje
+SING_OPTIONS_ADVANCED_LINEBONUS=Bonus za vrstico
+SING_OPTIONS_ADVANCED_COUNT_HOW_OFTEN_SUNG=
+SING_OPTIONS_ADVANCED_ONSONGCLICK=Po izboru pesmi
+SING_OPTIONS_ADVANCED_PARTYPOPUP=Samodejni nacin Zabava
+
+SING_EDIT=Urednik
+SING_EDIT_MENU_DESCRIPTION=Izdelaj lastno pesem
+
+SING_EDIT_BUTTON_DESCRIPTION_CONVERT=Izvozi besedilo iz midi datoteke
+SING_EDIT_BUTTON_DESCRIPTION_EXIT=Nazaj
+SING_EDIT_BUTTON_CONVERT=Uvozi
+SING_EDIT_BUTTON_EXIT=Nazaj
+
+SING_EDIT_NAVIGATE=Navigacija
+SING_EDIT_SELECT=Izberi
+SING_EDIT_EXIT=Nazaj
+
+SING_LEGEND_SELECT=izberi
+SING_LEGEND_NAVIGATE=premik
+SING_LEGEND_CONTINUE=nadaljuj
+SING_LEGEND_ESC=nazaj
+
+SING_PLAYER_DESC=vpiši imena igralcev
+SING_PLAYER_WHEREAMI=Imena igralcev
+SING_PLAYER_ENTER_NAME=vnesi ime
+
+SING_DIFFICULTY_DESC=izberi težavnost
+SING_DIFFICULTY_WHEREAMI=Težavnost
+SING_DIFFICULTY_CONTINUE=k izbiri pesmi
+SING_EASY=Enostavno
+SING_MEDIUM=Srednje
+SING_HARD=Težko
+
+SING_SONG_SELECTION_DESC=izberi svojo pesem
+SING_SONG_SELECTION_WHEREAMI=Izbira pesmi
+SING_SONG_SELECTION_GOTO=pojdi na...
+SING_SONG_SELECTION=izbira pesmi
+SING_SONG_SELECTION_MENU=meni
+SING_SONG_SELECTION_PLAYLIST=seznam predvajanja
+SING_SONGS_IN_CAT=Pesmi
+PLAYLIST_CATTEXT=Lista: %s
+
+SING_TIME=CAS
+SING_TOTAL=skupaj
+SING_MODE=Petje
+SING_NOTES=note
+SING_GOLDEN_NOTES=zlate note
+SING_PHRASE_BONUS=bonus za vrstico
+
+SING_MENU=Glavni meni
+
+SONG_SCORE=rezultat petja
+SONG_SCORE_WHEREAMI=Rezultat
+
+SING_SCORE_TONE_DEAF=Gluhonem
+SING_SCORE_AMATEUR=Amater
+SING_SCORE_WANNABE=Igralec
+SING_SCORE_HOPEFUL=Nadebudnež
+SING_SCORE_RISING_STAR=Vzhajajoca zvezda
+SING_SCORE_LEAD_SINGER=Vodilni pevec
+SING_SCORE_SUPERSTAR=Superzvezda
+SING_SCORE_ULTRASTAR=Ultrazvezda
+
+SING_TOP_5_CHARTS=najboljših 5 pevcev
+SING_TOP_5_CHARTS_WHEREAMI=najboljših 5
+SING_TOP_5_CHARTS_CONTINUE=k izbiri pesmi
+
+POPUP_PERFECT=popolno!
+POPUP_AWESOME=odlicno!
+POPUP_GREAT=zelo dobro!
+POPUP_GOOD=dobro!
+POPUP_NOTBAD=ni slabo!
+POPUP_BAD=slabo!
+POPUP_POOR=zelo slabo!
+POPUP_AWFUL=obupno!
+
+IMPLODE_GLUE1=,
+IMPLODE_GLUE2= in
+
+SONG_MENU_NAME_MAIN=meni pesmi
+SONG_MENU_PLAY=Poj
+SONG_MENU_CHANGEPLAYERS=Spremeni igralca
+SONG_MENU_EDIT=Uredi
+SONG_MENU_MODI=Poj "a Modi"
+SONG_MENU_CANCEL=Preklici
+
+SONG_MENU_NAME_PLAYLIST=Meni Pesem
+SONG_MENU_PLAYLIST_ADD=Dodaj pesem
+SONG_MENU_PLAYLIST_DEL=Izbriši pesem
+
+SONG_MENU_NAME_PLAYLIST_ADD=Dodaj pesem
+SONG_MENU_PLAYLIST_ADD_NEW=dodaj nov seznam
+SONG_MENU_PLAYLIST_ADD_EXISTING=dodaj shranjen seznam
+SONG_MENU_PLAYLIST_NOEXISTING=Ni seznamov
+
+SONG_MENU_NAME_PLAYLIST_NEW=Nov seznam
+SONG_MENU_PLAYLIST_NEW_CREATE=Ustvari
+SONG_MENU_PLAYLIST_NEW_UNNAMED=Neimenovan
+
+SONG_MENU_NAME_PLAYLIST_DEL=Res izbrišem?
+SONG_MENU_YES=Da
+SONG_MENU_NO=Ne
+
+SONG_MENU_NAME_PLAYLIST_LOAD=Odpri seznam
+SONG_MENU_PLAYLIST_LOAD=odpri
+SONG_MENU_PLAYLIST_DELCURRENT=izbriši trenuten seznam
+
+SONG_MENU_NAME_PLAYLIST_DEL=Izbrišem seznam?
+
+SONG_MENU_NAME_PARTY_MAIN=Meni Zabava
+SONG_MENU_JOKER=Joker
+
+SONG_MENU_NAME_PARTY_JOKER=izkoristi jokerja
+
+SONG_JUMPTO_DESC=poišci pesem
+SONG_JUMPTO_TYPE_DESC=Isci po:
+SONG_JUMPTO_TYPE1=Vse
+SONG_JUMPTO_TYPE2=Naslov
+SONG_JUMPTO_TYPE3=Avtor
+SONG_JUMPTO_SONGSFOUND=%d pesmi najdenih
+SONG_JUMPTO_NOSONGSFOUND=Ne najdem
+SONG_JUMPTO_HELP=Vpiši besedilo za iskanje
+SONG_JUMPTO_CATTEXT=Išci po: %s
+
+PARTY_MODE=zabava
+PARTY_DIFFICULTY=Težavnost
+PARTY_PLAYLIST=Izbor
+PARTY_PLAYLIST_ALL=Vse pesmi
+PARTY_PLAYLIST_CATEGORY=Mapa
+PARTY_PLAYLIST_PLAYLIST=Seznam
+PARTY_ROUNDS=Število rund
+PARTY_TEAMS=Ekipe
+PARTY_TEAMS_PLAYER1=Igralec Ekipa1
+PARTY_TEAMS_PLAYER2=Igralec Ekipa2
+PARTY_TEAMS_PLAYER3=Igralec Ekipa3
+
+PARTY_LEGEND_CONTINUE=nadaljuj
+
+PARTY_OPTIONS_DESC=nastavitve za nacin zabave
+PARTY_OPTIONS_WHEREAMI=nastavitve zabave
+
+PARTY_PLAYER_DESC=vpiši igralce in imena ekip!
+PARTY_PLAYER_WHEREAMI=Imena
+PARTY_PLAYER_ENTER_NAME=vpiši imena
+PARTY_PLAYER_LEGEND_CONTINUE=zacni zabavo
+
+PARTY_ROUND_DESC=naslednji igralec k mikrofonu
+PARTY_ROUND_WHEREAMI=Naslednja runda
+PARTY_ROUND_LEGEND_CONTINUE=zacni rundo
+
+PARTY_SONG_WHEREAMI=Izbor pesmi - Zabava
+PARTY_SONG_LEGEND_CONTINUE=poj
+PARTY_SONG_MENU=meni Zabava
+
+PARTY_SCORE_DESC=tocke zadnje runde
+PARTY_SCORE_WHEREAMI=Tocke v zabavi
+
+PARTY_WIN_DESC=Zmagovalec
+PARTY_WIN_WHEREAMI=Zmagovalec
+PARTY_WIN_LEGEND_CONTINUE=nazaj k glavnemu meniju
+
+PARTY_ROUND=Runda
+PARTY_ROUND_WINNER=Zmagovalec
+PARTY_NOTPLAYEDYET=neizvedeno
+PARTY_NOBODY=nobeden
+NEXT_ROUND=Naslednja runda:
+
+PARTY_DISMISSED=Zakljucena!
+PARTY_SCORE_WINS=%s
+PARTY_SCORE_WINS2=zmaga!
+
+PLUGIN_HDL_NAME=Zdrži nivo
+PLUGIN_HDL_DESC=Ne poj slabše, kot kaže kazalnik na števcu za ocenjevanje.
+
+PLUGIN_UNTIL5000_NAME=Do 5000
+PLUGIN_UNTIL5000_DESC=Kdor prvi doseže 5000 tock, zmaga.
+
+PLUGIN_DUELL_NAME=Dvoboj
+PLUGIN_DUELL_DESC=Tekmovanje do 10000 tock.
+
+PLUGIN_TEAMDUELL_NAME=Ekipni dvoboj
+PLUGIN_TEAMDUELL_DESC=Podaj mikrofon!
+
+PLUGIN_BLIND_NAME=Slepi dvoboj
+PLUGIN_BLIND_DESC=Dvoboj brez prikaza not.
+
+STAT_MAIN=Statika
+STAT_MAIN_DESC=Splošno
+STAT_MAIN_WHEREAMI=Statistika
+
+STAT_OVERVIEW_INTRO=%0:s Statistika. \n Nazadnje ponastavljeno %2:.2d.%1:.2d.%3:d
+STAT_OVERVIEW_SONG=%0:d Pesmi(%3:d z videom), od katerih je bilo %1:d že zapetih in %2:d ne.\n Najbolj priljubljena pesem je %5:s od %4:s.
+STAT_OVERVIEW_PLAYER=Od zadnje ponastavitve statistike je igro igralo %0:d igralcev.\n Najboljši/a je %1:s s povprecnim rezultatom %2:d tock.\n %3:s je dosegel/la najboljši rezultat s %4:d tockami.
+
+STAT_DETAIL=Statistika
+STAT_DETAIL_WHEREAMI=Podrobna statistika
+
+STAT_NEXT=Naslednja stran
+STAT_PREV=Prejšnja stran
+STAT_REVERSE=Obratni vrstni red
+STAT_PAGE=Stran %0:d od %1:d strani\n (%2:d od %3:d zapisov)
+
+STAT_DESC_SCORES=Najboljši rezultati
+STAT_DESC_SCORES_REVERSED=Najslabši rezultati
+STAT_FORMAT_SCORES=%0:s - %1:d [%2:s] \n (%3:s - %4:s)
+
+STAT_DESC_SINGERS=Najboljši igralec
+STAT_DESC_SINGERS_REVERSED=Najslabši igralec
+STAT_FORMAT_SINGERS=%0:s \n povprecni rezultat: %1:d
+
+STAT_DESC_SONGS=Najbolj popularne pesmi
+STAT_DESC_SONGS_REVERSED=Najmanj popularne pesmi
+STAT_FORMAT_SONGS=%0:s - %1:s \n %2:dx igrano
+
+STAT_DESC_BANDS=Najbolj popularen izvajalec
+STAT_DESC_BANDS_REVERSED=Najmanj popularen izvajalec
+STAT_FORMAT_BANDS=%0:s \n %1:dx igrano
+
+MSG_ERROR_TITLE=Napaka
+MSG_QUESTION_TITLE=Vprašanje
+MSG_QUIT_USDX=Želite zapustiti Ultrastar?
+MSG_END_PARTY=Koncam zabavo?
+ERROR_NO_SONGS=Ni pesmi: Naloži jih v mapo Songs
+ERROR_NO_PLUGINS=Ni vkljuckov
+ERROR_CORRUPT_SONG=Ne morem naložiti pesmi.
+ERROR_CORRUPT_SONG_FILE_NOT_FOUND=Ne morem naložiti pesmi: Ne najdem datoteke
+ERROR_CORRUPT_SONG_NO_NOTES=Ne morem naloziti pesmi: Ne najdem not.
+ERROR_CORRUPT_SONG_NO_BREAKS=Ne morem naložiti pesmi: Ne najdem prelomov vrstic.
+ERROR_CORRUPT_SONG_UNKNOWN_IN_LINE=Ne morem naložiti pesmi: Napaka v parsanju vrstice %0:d
\ No newline at end of file diff --git a/unicode/game/languages/readme.txt b/unicode/game/languages/readme.txt index 270406dc..83ba6cd6 100644 --- a/unicode/game/languages/readme.txt +++ b/unicode/game/languages/readme.txt @@ -1,24 +1,22 @@ -.o0 Ultrastar Deluxe in your Language 0o. +.o0 Ultrastar Deluxe in your language 0o. ----------------------- Table of Contents ----------------------- 1. Introduction -2. Statistic Wild-Cards -3. Texts to Add - - +2. Statistic wildcards +3. Texts to add ----------------------- 1. Introduction: ----------------------- -To translate USD to a new language, take the English Language File, or another one that is up to date and Edit the Texts behind the Equal Mark(=). +To translate USD to a new language, take the English language file, or another one that is up to date and edit the texts behind the equal mark(=). ----------------------- 2. Statistic Wild-Cards: ----------------------- -Here are some Information about the Wild-Cars in the Language Texts for the Statistic Screens (STAT_...): -Information that will replace the Wild-Cards: +Here are some informations about the wildcards in the language texts for the statistic screens (STAT_...): +Information that will replace the wildcards: STAT_OVERVIEW_INTRO: Format: @@ -68,19 +66,19 @@ STAT_FORMAT_BANDS: %0:s Artist Name %1:d Times Sung -Some further Explantation about the Wild-Cards: +Some further explanations about the wildcards: %x:[.y]z -Where X is the Number of the Wildcard, -Y is optional, it is the number of digits for Decimal Numbers (Z=d). So if y is 2 there and the number is only 0 to 9 there will be a Zero added in front of the number. -z can be d for Numbers and s for texts +Where X is the number of the wildcard, +Y is optional, it is the number of digits for deciaml numbers (Z=d). So, if y is 2 there and the number is only 0 to 9 there will be a zero added in front of the number. +z can be d for numbers and s for texts -For the date thing in STAT_OVERVIEW_INTRO you may use %1:.2d for the day and %2:.2d for the Month. +For the date thing in STAT_OVERVIEW_INTRO you may use %1:.2d for the day and %2:.2d for the month. ----------------------- 3. Texts to Add: ----------------------- -To port a LanguageFile from Ultrastar 0.5.2 or Higher add the following Texts to the end of the file: +To port a language file from Ultrastar 0.5.2 or higher add the following texts to the end of the file: #Main Screen SING_MENU=Main Menu @@ -126,17 +124,17 @@ POPUP_BAD=bad! POPUP_POOR=poor! POPUP_AWFUL=awful! -#To connect Strigns with, e.g.: He, you and I +#To connect strings with, e.g.: He, you and I IMPLODE_GLUE1=, IMPLODE_GLUE2= and #Song Screen Legend PLAYLIST_CATTEXT=Playlist: %s -#Text for the Legend Bar at the bottom +#Text for the legend bar at the bottom SING_LEGEND_CONTINUE=Continue -#Texts of the Menu that appears when M is Pressed at the SongSelection +#Texts of the menu that appears when M is pressed at the song selection SONG_MENU_NAME_MAIN=Song Menu SONG_MENU_PLAY=Sing SONG_MENU_EDIT=Edit @@ -181,7 +179,7 @@ SONG_MENU_JOKER=Joker SONG_MENU_NAME_PARTY_JOKER=take Joker -#Texts of the jumpto Window +#Texts of the jump to window SONG_JUMPTO_DESC=Jump to Song SONG_JUMPTO_TYPE_DESC=Search for: SONG_JUMPTO_TYPE1=All @@ -233,7 +231,7 @@ PARTY_SCORE_WINS2=wins! PARTY_SONG_WHEREAMI=Party Song-Selection PARTY_SONG_LEGEND_CONTINUE=Party-Menu -#Texts that descripts Plugins or Modis +#Texts describing Plugins or Modi PLUGIN_HDL_NAME=Hold the Line PLUGIN_HDL_DESC=Don't get worse than the pointer at the rating bar shows you. PLUGIN_UNTIL5000_NAME=Until 5000 @@ -246,7 +244,7 @@ PLUGIN_TEAMDUELL_NAME=Team Duell PLUGIN_TEAMDUELL_DESC=Pass The Mic! #Statistics Screen -#For more Info about the Format Strings look at the SorceCode (UScreenStatMain) +#For more info about the format strings look at the source code (UScreenStatMain) STAT_MAIN=Statistics STAT_MAIN_DESC=General STAT_MAIN_WHEREAMI=Statistics diff --git a/unicode/game/themes/Classic.ini b/unicode/game/themes/Classic.ini index d29ce968..144448f2 100644 --- a/unicode/game/themes/Classic.ini +++ b/unicode/game/themes/Classic.ini @@ -510,10 +510,8 @@ Size = 21 Align=0 Text=SING_SONG_SELECTION_PLAYLIST - #and theese are the ones for partymode - [SongStaticParty1] X =187 Y =553 @@ -1748,6 +1746,7 @@ TexX1=0 TexY1=0 TexX2=1 TexY2=1 + [ScorePlayer4Static2] X=20 Y=345 @@ -1760,6 +1759,7 @@ TexX1=0 TexY1=0 TexX2=1 TexY2=1 + [ScorePlayer4Static3] X=20 Y=410 @@ -2361,7 +2361,6 @@ Texts = 3 [OptionsBackground] Tex=OptionsBG - [OptionsText1] X = 50 Y = 170 @@ -2723,7 +2722,6 @@ SBGDColor = Gray STColor = White STDColor = GrayDark - [OptionsGameSelectSlideLanguage] Tex = MainBar TexSBG = MainBar @@ -2814,7 +2812,6 @@ Color = ColorDark DColor = Gray Type = Font Black - [OptionsGraphics] Texts = 3 @@ -2978,7 +2975,6 @@ Color = ColorDark DColor = Gray Type = Font Black - [OptionsSound] Texts = 3 @@ -3567,7 +3563,6 @@ SBGDColor = Gray STColor = White STDColor = GrayDark - [OptionsRecordButtonExit] X = 40 Y = 305 @@ -3841,7 +3836,6 @@ Size = 30 Align =1 Text =easy - [Top5TextArtistTitle] X =100 Y =120 @@ -3896,7 +3890,6 @@ Size = 33 Align =0 Text =5. Player5 - [Top5TextScore1] X =680 Y =195 @@ -4052,9 +4045,134 @@ TexY1=0 TexX2=1 TexY2=1 +[Edit] +Texts = 1 + +[EditBackground] +Tex = EditBG + +# main title +[EditText1] +X = 50 +Y = 170 +Color = GrayLight +Font = 1 +Size = 75 +Text = SING_EDIT + +# main icon +[EditStatic1] +X = 40 +Y = 250 +W = 32 +H = 32 +Color = ColorDark +Tex = MainIcon +Type = Font Black + +# Navigate button text +[EditText2] +X = 226 +Y = 553 +Color = Gray +Font = 1 +Size = 21 +Align = 0 +Text = SING_EDIT_NAVIGATE + +# Select button text +[EditText3] +X = 380 +Y = 553 +Color = Gray +Font = 1 +Size = 21 +Align = 0 +Text = SING_EDIT_SELECT + +# Escape button text +[EditText4] +X = 540 +Y = 553 +Color = Gray +Font = 1 +Size = 21 +Align = 0 +Text = SING_EDIT_EXIT + +[EditTextDescription] +X = 72 +Y = 248 +Color = GrayDark +Font = 1 +Size = 30 +#Text = SING_EDIT_TEXTDESCRIPTION + +[EditStatic2] +X = 196 +Y = 553 +W = 22 +H = 22 +Tex = ButtonNavi +Color = White +Type = Plain +TexX1=0 +TexY1=0 +TexX2=1 +TexY2=1 + +[EditStatic3] +X = 350 +Y = 552 +W = 22 +H = 22 +Tex = ButtonEnter +Color = White +Type = Plain +TexX1=0 +TexY1=0 +TexX2=1 +TexY2=1 + +[EditStatic4] +X = 510 +Y = 553 +W = 22 +H = 22 +Tex = ButtonEsc +Color = White +Type = Plain +TexX1=0 +TexY1=0 +TexX2=1 +TexY2=1 + +[EditButtonConvert] +X = 40 +Y = 310 +W = 250 +H = 70 +Tex = Button +Color = ColorDark +Int = 1 +DColor = White +DInt = 0.5 +Type = Font Black +Texts = 1 + +[EditButtonConvertText1] +X = 115 +Y = 20 +Font = 1 +Size = 27 +Align = 1 +Text = SING_EDIT_BUTTON_CONVERT +Color = White + [Level] Texts=2 + [LevelBackground] Tex=MainBG @@ -5509,7 +5627,6 @@ Color =P1Dark Reflection=1 ReflectionSpacing=2 - [PartyWinStaticTeam1Deco] Tex =PartyWinDeco1 X = 91 @@ -6824,7 +6941,6 @@ Color =ColorDark Tex =MainIcon Type=Font Black - [StatMainStatic2] X =40 Y =120 @@ -7166,7 +7282,6 @@ Tex=StatMainBG3 Color =ColorLight Type=Font Black - [StatDetailText1] X =40 Y =6 diff --git a/unicode/game/themes/Deluxe.ini b/unicode/game/themes/Deluxe.ini index e013a75a..5f47c215 100644 --- a/unicode/game/themes/Deluxe.ini +++ b/unicode/game/themes/Deluxe.ini @@ -4312,7 +4312,6 @@ SBGDColor = LightBlue STColor = White STDColor = GrayDark - [OptionsAdvancedButtonExit] X = 40 Y = 415 @@ -4605,6 +4604,199 @@ H = 40 Color = P1Dark Type = Colorized +[Edit] +Texts = 5 + +[EditBackground] +Tex = EditBG + +# main icon +[EditStatic1] +X = 65 +Y = 150 +W = 25 +H = 25 +Color = White +Tex = IconEdit +Type = Transparent +# Type = Colorized + +# main icon title +[EditText1] +X = 95 +Y = 135 +Color = White +Font = 0 +Size = 54 +Align = 0 +Text = SING_EDIT + +# main icon subtitle +[EditText2] +X = 95 +Y = 175 +Color = ColorLightest +Font = 0 +Size = 30 +Align = 0 +Text = SING_EDIT_MENU_DESCRIPTION + +# Navigate button text +[EditText3] +X = 300 +Y = 548 +Color = Black +Font = 0 +Size = 24 +Align = 0 +Text = SING_EDIT_NAVIGATE +Reflection = 1 +ReflectionSpacing = 20 + +# Select button text +[EditText4] +X = 440 +Y = 548 +Color = Black +Font = 0 +Size = 24 +Align = 0 +Text = SING_EDIT_SELECT +Reflection=1 +ReflectionSpacing=20 + +# Esc button text +[EditText5] +X = 590 +Y = 548 +Color = Black +Font = 0 +Size = 24 +Align = 0 +Text = SING_EDIT_EXIT +Reflection=1 +ReflectionSpacing=20 + +[EditTextDescription] +X = 95 +Y = 195 +Color = White +Font = 0 +Size = 30 +Align = 0 +Text = SING_EDIT_TEXTDESCRIPTION + +[EditStatic2] +X = 0 +Y = 545 +W = 250 +H = 30 +Tex = Leiste1 +Color = ColorLight +Type = Colorized +Reflection = 1 +ReflectionSpacing = 2 + +[EditStatic3] +X = 250 +Y = 545 +W = 550 +H = 30 +Tex = Leiste2 +Color = White +Type = Transparent +Reflection = 1 +ReflectionSpacing = 2 + +[EditStatic4] +X = 260 +Y = 545 +W = 32 +H = 30 +Tex = ButtonNavi +Color = White +Type = Transparent +Reflection = 1 +ReflectionSpacing = 2 + +[EditStatic5] +X = 400 +Y = 545 +W = 32 +H = 30 +Tex = ButtonEnter +Color = White +Type = Transparent +Reflection = 1 +ReflectionSpacing = 2 + +[EditStatic6] +X = 550 +Y = 545 +W = 32 +H = 30 +Tex = ButtonEsc +Color = White +Type = Transparent +Reflection = 1 +ReflectionSpacing = 2 + +[EditButtonConvert] +X = 250 +Y = 270 +W = 150 +H = 50 +Tex = Button +Color = ColorLight +DColor = ColorDark +Type = Transparent +Texts = 1 +Reflection = 1 +ReflectionSpacing = 15 +DeSelectReflectionSpacing = 280 +Fade = 1 +FadeText = 1 +SelectH = 150 +FadeTex = ButtonFade +FadeTexPos = 0 + +[EditButtonConvertText1] +X = 75 +Y = 10 +Font = 0 +Size = 30 +Align = 1 +Text = SING_EDIT_BUTTON_CONVERT +Color = White + +[EditButtonExit] +X = 405 +Y = 270 +W = 150 +H = 50 +Tex = Button +Color = ColorLight +DColor = ColorDark +Type = Transparent +Texts = 1 +Reflection = 1 +ReflectionSpacing = 15 +DeSelectReflectionSpacing = 280 +Fade = 1 +FadeText = 1 +SelectH = 150 +FadeTex = ButtonFade +FadeTexPos = 0 + +[EditButtonExitText1] +X = 75 +Y = 10 +Font = 0 +Size = 30 +Align = 1 +Text = SING_EDIT_BUTTON_EXIT +Color = White + [Level] Texts = 5 diff --git a/unicode/game/themes/Deluxe/Blue.ini b/unicode/game/themes/Deluxe/Blue.ini index 6f3c1e55..30c68e3e 100644 --- a/unicode/game/themes/Deluxe/Blue.ini +++ b/unicode/game/themes/Deluxe/Blue.ini @@ -36,12 +36,14 @@ SongBG = [bg-main]blue.jpg ScoreScreenBG = [bg-main]blue.jpg Top5BG = [bg-main]blue.jpg OptionsBG = [bg-main]blue.jpg +EditBG = [bg-main]blue.jpg PartyBG = [bg-main]blue.jpg #Icons on screen SongCD = [icon]cd.png MainIcon = [icon]main.png IconOption = [icon]options.png +IconEdit = [icon]options.png ScoreIcon = [icon]score.png PartyIcon = [icon]party.png diff --git a/unicode/game/themes/Deluxe/Fall.ini b/unicode/game/themes/Deluxe/Fall.ini index 57bf6539..72d9021b 100644 --- a/unicode/game/themes/Deluxe/Fall.ini +++ b/unicode/game/themes/Deluxe/Fall.ini @@ -22,6 +22,7 @@ SongBG = [bg-main]fall.jpg ScoreScreenBG = [bg-main]fall.jpg Top5BG = [bg-main]fall.jpg OptionsBG = [bg-main]fall.jpg +EditBG = [bg-main]fall.jpg PartyBG = [bg-main]fall.jpg #Icons on screen @@ -29,6 +30,7 @@ SongCD = [icon]cd.png MainIcon = [icon]main.png MainSearch = [icon]search.png IconOption = [icon]options.png +IconEdit = [icon]options.png IconSongMenu = [icon]songmenu.png ScoreIcon = [icon]score.png PartyIcon = [icon]party.png diff --git a/unicode/game/themes/Deluxe/Ribbon.ini b/unicode/game/themes/Deluxe/Ribbon.ini index 0165a596..1631183e 100644 --- a/unicode/game/themes/Deluxe/Ribbon.ini +++ b/unicode/game/themes/Deluxe/Ribbon.ini @@ -23,6 +23,7 @@ SongBG = [bg-video]ribbon.mov ScoreScreenBG = [bg-video]ribbon.mov
Top5BG = [bg-video]ribbon.mov
OptionsBG = [bg-video]ribbon.mov
+EditBG = [bg-video]ribbon.mov
PartyBG = [bg-video]ribbon.mov
#Icons on screen
@@ -30,6 +31,7 @@ SongCD = [icon]cd.png MainIcon = [icon]main.png
MainSearch = [icon]search.png
IconOption = [icon]options.png
+IconEdit = [icon]options.png
IconSongMenu = [icon]songmenu.png
ScoreIcon = [icon]score.png
PartyIcon = [icon]party.png
diff --git a/unicode/game/themes/Deluxe/Summer.ini b/unicode/game/themes/Deluxe/Summer.ini index 85dc8e3f..3d40c2f8 100644 --- a/unicode/game/themes/Deluxe/Summer.ini +++ b/unicode/game/themes/Deluxe/Summer.ini @@ -22,6 +22,7 @@ SongBG = [bg-main]summer.jpg ScoreScreenBG = [bg-main]summer.jpg Top5BG = [bg-main]summer.jpg OptionsBG = [bg-main]summer.jpg +EditBG = [bg-main]summer.jpg PartyBG = [bg-main]summer.jpg #Icons on screen @@ -29,6 +30,7 @@ SongCD = [icon]cd.png MainIcon = [icon]main.png MainSearch = [icon]search.png IconOption = [icon]options.png +IconEdit = [icon]options.png IconSongMenu = [icon]songmenu.png ScoreIcon = [icon]score.png PartyIcon = [icon]party.png diff --git a/unicode/game/themes/Deluxe/Winter.ini b/unicode/game/themes/Deluxe/Winter.ini index 0ececd74..32c37a02 100644 --- a/unicode/game/themes/Deluxe/Winter.ini +++ b/unicode/game/themes/Deluxe/Winter.ini @@ -22,6 +22,7 @@ SongBG = [bg-main]winter.jpg ScoreScreenBG = [bg-main]winter.jpg Top5BG = [bg-main]winter.jpg OptionsBG = [bg-main]winter.jpg +EditBG = [bg-main]winter.jpg PartyBG = [bg-main]winter.jpg #Icons on screen @@ -29,6 +30,7 @@ SongCD = [icon]cd.png MainIcon = [icon]main.png MainSearch = [icon]search.png IconOption = [icon]options.png +IconEdit = [icon]options.png IconSongMenu = [icon]songmenu.png ScoreIcon = [icon]score.png PartyIcon = [icon]party.png diff --git a/unicode/game/themes/Deluxe/ocean.ini b/unicode/game/themes/Deluxe/ocean.ini index 82701c41..d18c7a60 100644 --- a/unicode/game/themes/Deluxe/ocean.ini +++ b/unicode/game/themes/Deluxe/ocean.ini @@ -22,6 +22,7 @@ SongBG = [bg-video]_ocean.avi ScoreScreenBG = [bg-video]_ocean.avi Top5BG = [bg-video]_ocean.avi OptionsBG = [bg-video]_ocean.avi +EditBG = [bg-video]_ocean.avi PartyBG = [bg-video]_ocean.avi #Icons on screen @@ -29,6 +30,7 @@ SongCD = [icon]cd.png MainIcon = [icon]main.png MainSearch = [icon]search.png IconOption = [icon]options.png +IconEdit = [icon]options.png IconSongMenu = [icon]songmenu.png ScoreIcon = [icon]score.png PartyIcon = [icon]party.png diff --git a/unicode/installer/UltraStar Deluxe.nsi b/unicode/installer/UltraStar Deluxe.nsi index 1e71e28c..c8df95dd 100644 --- a/unicode/installer/UltraStar Deluxe.nsi +++ b/unicode/installer/UltraStar Deluxe.nsi @@ -334,7 +334,521 @@ Section /o "Dead Smiling Pirates - I 18" g2Section1 SectionEnd
;
-; Steven Dunston - Northern Star
+; Jonathan Coulton Songs
+;
+
+SectionGroup $(name_s2_sub1) s2_sub1
+
+Section /o "Monkey Shines" s2_sub1_Section1
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song1} $TEMP\Song-JC-MS.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-MS.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-MS.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "I Crush Everything" s2_sub1_Section2
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song2} $TEMP\Song-JC-ICE.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-ICE.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-ICE.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Not About You" s2_sub1_Section3
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song3} $TEMP\Song-JC-NAY.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-NAY.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-NAY.zip"
+
+ SetOutPath "$INSTDIR"
+
+
+SectionEnd
+
+Section /o "Mr. Fancy Pants" s2_sub1_Section4
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song4} $TEMP\Song-JC-MFP.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-MFP.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-MFP.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Big Bad World One" s2_sub1_Section5
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song5} $TEMP\Song-JC-BBWO.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-BBWO.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-BBWO.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Flickr" s2_sub1_Section6
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song6} $TEMP\Song-JC-Flickr.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-Flickr.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-Flickr.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "My Beige Bear" s2_sub1_Section7
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song7} $TEMP\Song-JC-MBB.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-MBB.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-MBB.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "The Future Soon" s2_sub1_Section8
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song8} $TEMP\Song-JC-TFS.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-TFS.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-TFS.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Ikea" s2_sub1_Section9
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song9} $TEMP\Song-JC-Ikea.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-Ikea.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-Ikea.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Furry Old Lobster" s2_sub1_Section10
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song10} $TEMP\Song-JC-FOL.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-FOL.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-FOL.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Code Monkey" s2_sub1_Section11
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song11} $TEMP\Song-JC-CM.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-CM.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-CM.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "I´m Your Moon" s2_sub1_Section12
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song12} $TEMP\Song-JC-IYM.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-IYM.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-IYM.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "First Of May" s2_sub1_Section13
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song13} $TEMP\Song-JC-FOM.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-FOM.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-FOM.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Dance, Soterious Johnson, Dance" s2_sub1_Section14
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song14} $TEMP\Song-JC-DSJD.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-DSJD.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-DSJD.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "A Walk With George" s2_sub1_Section15
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song15} $TEMP\Song-JC-AWWG.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-AWWG.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-AWWG.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Creepy Doll" s2_sub1_Section16
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song16} $TEMP\Song-JC-CD.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-CD.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-CD.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "That Spells DNA" s2_sub1_Section17
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song17} $TEMP\Song-JC-TSDNA.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-TSDNA.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-TSDNA.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "When You Go" s2_sub1_Section18
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song18} $TEMP\Song-JC-WYG.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-WYG.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-WYG.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Better" s2_sub1_Section19
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song19} $TEMP\Song-JC-Better.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-Better.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-Better.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Shop Vac" s2_sub1_Section20
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song20} $TEMP\Song-JC-SV.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-SV.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-SV.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "I Feel Fantastic" s2_sub1_Section21
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song21} $TEMP\Song-JC-IFF.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-IFF.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-IFF.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Re: Your Brains" s2_sub1_Section22
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song22} $TEMP\Song-JC-ReYB.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-ReYB.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-ReYB.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Skullcrusher Mountain" s2_sub1_Section23
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song23} $TEMP\Song-JC-SCM.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-SCM.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-SCM.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+Section /o "Chiron Beta Prime" s2_sub1_Section24
+
+; AddSize 1400
+ SetOverwrite try
+ SetOutPath "$INSTDIR\Songs\"
+
+; Download song:
+ NSISdl::download /TIMEOUT=30000 ${download_sub1_song24} $TEMP\Song-JC-CBP.zip
+
+ Pop $R0
+ StrCmp $R0 "success" dlok
+ MessageBox MB_OK|MB_ICONEXCLAMATION "Download Error, click OK to Continue" /SD IDOK
+ dlok:
+ nsisunz::Unzip "$TEMP\Song-JC-CBP.zip" "$INSTDIR\Songs\"
+
+ Delete "$TEMP\Song-JC-CBP.zip"
+
+ SetOutPath "$INSTDIR"
+
+SectionEnd
+
+
+SectionGroupEnd
+
+;
+; Joshua Morin - On The Run
;
Section /o "Joshua Morin - On The Run" g2Section2
@@ -558,6 +1072,7 @@ SectionEnd !insertmacro MUI_DESCRIPTION_TEXT ${Section1} $(DESC_Section1)
!insertmacro MUI_DESCRIPTION_TEXT ${Section2} $(DESC_Section2)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1} $(DESC_Section2_sub1)
!insertmacro MUI_DESCRIPTION_TEXT ${Section3} $(DESC_Section3)
!insertmacro MUI_DESCRIPTION_TEXT ${g2Section1} $(DESC_g2Section1)
@@ -565,6 +1080,31 @@ SectionEnd !insertmacro MUI_DESCRIPTION_TEXT ${g2Section3} $(DESC_g2Section3)
!insertmacro MUI_DESCRIPTION_TEXT ${g2Section4} $(DESC_g2Section4)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section1} $(DESC_s2_sub1_Section1)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section2} $(DESC_s2_sub1_Section2)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section3} $(DESC_s2_sub1_Section3)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section4} $(DESC_s2_sub1_Section4)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section5} $(DESC_s2_sub1_Section5)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section6} $(DESC_s2_sub1_Section6)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section7} $(DESC_s2_sub1_Section7)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section8} $(DESC_s2_sub1_Section8)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section9} $(DESC_s2_sub1_Section9)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section10} $(DESC_s2_sub1_Section10)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section11} $(DESC_s2_sub1_Section11)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section12} $(DESC_s2_sub1_Section12)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section13} $(DESC_s2_sub1_Section13)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section14} $(DESC_s2_sub1_Section14)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section15} $(DESC_s2_sub1_Section15)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section16} $(DESC_s2_sub1_Section16)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section17} $(DESC_s2_sub1_Section17)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section18} $(DESC_s2_sub1_Section18)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section19} $(DESC_s2_sub1_Section19)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section20} $(DESC_s2_sub1_Section20)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section21} $(DESC_s2_sub1_Section21)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section22} $(DESC_s2_sub1_Section22)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section23} $(DESC_s2_sub1_Section23)
+ !insertmacro MUI_DESCRIPTION_TEXT ${s2_sub1_Section24} $(DESC_s2_sub1_Section24)
+
!insertmacro MUI_DESCRIPTION_TEXT ${g3Section1} $(DESC_g3Section1)
!insertmacro MUI_DESCRIPTION_TEXT ${g3Section2} $(DESC_g3Section2)
!insertmacro MUI_DESCRIPTION_TEXT ${g3Section3} $(DESC_g3Section3)
diff --git a/unicode/installer/Update.nsi b/unicode/installer/Update.nsi new file mode 100644 index 00000000..b8e5a458 --- /dev/null +++ b/unicode/installer/Update.nsi @@ -0,0 +1,215 @@ +; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+; UltraStar Deluxe Installer: Update
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+
+!include MUI2.nsh
+!include WinVer.nsh
+!include LogicLib.nsh
+!include nsDialogs.nsh
+
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+; Variables
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+
+; Installer Paths:
+
+!define path_settings ".\settings"
+!define path_languages ".\languages"
+!define path_images "..\installerdependencies\images"
+!define path_plugins "..\installerdependencies\plugins"
+!define path_gdf "$WINDIR\gdf.dll"
+
+!addPluginDir "${path_plugins}\"
+
+!include "${path_settings}\variables.nsh"
+!include "${path_settings}\GameExplorer.nsh"
+!include "${path_settings}\functions.nsh"
+
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+; Export Settings
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+
+SetCompress Auto
+SetCompressor /SOLID lzma
+SetCompressorDictSize 32
+SetDatablockOptimize On
+
+Var /GLOBAL CHECKBOX
+Var /GLOBAL label_update_information
+Var /GLOBAL checkbox_state
+
+XPStyle on
+
+Name "${name} - Update"
+Brandingtext "${name} Update"
+OutFile "ultrastardx-update.exe"
+
+InstallDir "$PROGRAMFILES\${name}"
+
+; Windows Vista:
+
+RequestExecutionLevel user
+
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+; Interface Settings
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+
+; Icons:
+
+!define MUI_ICON "${path_images}\${img_install}"
+!define MUI_UNICON "${path_images}\${img_uninstall}"
+
+; Header and Side Images:
+
+!define MUI_HEADERIMAGE
+!define MUI_HEADERIMAGE_BITMAP "${path_images}\${img_header}"
+!define MUI_HEADERIMAGE_UNBITMAP "${path_images}\${img_header}"
+
+!define MUI_WELCOMEFINISHPAGE_BITMAP "${path_images}\${img_side}"
+!define MUI_UNWELCOMEFINISHPAGE_BITMAP "${path_images}\${img_side}"
+
+; Abort Warnings:
+
+!define MUI_ABORTWARNING
+!define MUI_ABORTWARNING_TEXT "$(abort_install)"
+!define MUI_ABORTWARNING_CANCEL_DEFAULT
+
+!define MUI_UNABORTWARNING
+!define MUI_UNABORTWARNING_TEXT "$(abort_uninstall)"
+!define MUI_UNABORTWARNING_CANCEL_DEFAULT
+
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+; Pages Installation Routine Settings
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+
+; Welcome Page:
+
+!define MUI_WELCOMEPAGE_TITLE_3LINES
+!define MUI_WELCOMEPAGE_TITLE "$(page_welcome_title_update)"
+!define MUI_WELCOMEPAGE_TEXT "$(page_welcome_txt_update)"
+
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+; Pages Installation Routine
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+
+!insertmacro MUI_PAGE_WELCOME
+
+; USDX Update Page
+
+Page custom Update Download
+
+Function Update
+
+nsDialogs::Create /NOUNLOAD 1018
+
+ Pop $0
+
+ ${NSD_CreateCheckbox} 0 -150 100% 8u "$(update_connect)"
+ Pop $CHECKBOX
+ GetFunctionAddress $0 OnCheckbox
+ nsDialogs::OnClick /NOUNLOAD $CHECKBOX $0
+
+ ${NSD_CreateLabel} 0 0 100% 30u "$(update_information)"
+ Pop $label_update_information
+
+nsDialogs::Show
+
+
+FunctionEnd ; Update page End
+
+Function Download
+
+${NSD_GetState} $CHECKBOX $checkbox_state
+
+${If} $checkbox_state == "1"
+
+NSISdl::download /TIMEOUT=50000 http://ultrastardeluxe.xtremeweb-hosting.net/version.txt $TEMP\version.txt
+
+Push 1
+Push "$TEMP\version.txt"
+ Call ReadFileLine
+Pop $1
+
+ReadRegStr $R0 HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${name}" 'DisplayVersion'
+
+${VersionCompare} "$R0" "$1" $R1
+
+${If} $R1 == "0"
+
+messageBox MB_OK|MB_ICONINFORMATION "$(update_check_equal)"
+
+${Else}
+ ${If} $R1 == "1"
+
+ IfFileExists $TEMP\version.txt FileExists
+ SetErrors
+ Goto Failed
+
+ FileExists:
+ messageBox MB_OK|MB_ICONINFORMATION "$(update_check_newer)"
+
+ ${Else}
+
+ ${If} $R1 == "2"
+ messageBox MB_YESNO|MB_ICONQUESTION \
+ "$(update_check_older)" IDNO +6
+
+ Push 2
+ Push "$TEMP\version.txt"
+ Call ReadFileLine
+ Pop $2
+
+ ExecShell Open $2
+
+ ${Else}
+
+ Failed:
+ messageBox MB_YESNO|MB_ICONQUESTION \
+ "$(update_check_failed)" IDNO +2
+
+ ExecShell Open http://www.ultrastardeluxe.org
+
+ ${EndIf}
+ ${EndIf}
+${EndIf}
+${Else}
+
+; If checkbox_state = 0
+
+
+${EndIf}
+
+Delete "$TEMP\version.txt"
+
+
+FunctionEnd
+
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+; UPDATE (Section 1)
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+
+Section $(name_section1) Section1
+ SectionIn RO
+ SetOutPath $INSTDIR
+ SetOverwrite try
+
+SectionEnd
+
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+; Language Support
+; ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~ ~+~
+
+!insertmacro MUI_LANGUAGE "English"
+!insertmacro MUI_LANGUAGE "German"
+
+!insertmacro MUI_RESERVEFILE_LANGDLL
+
+!include "${path_languages}\*.nsh"
+
+Function .onInit
+
+ !insertmacro MUI_LANGDLL_DISPLAY
+
+
+
+FunctionEnd
diff --git a/unicode/installer/languages/English.nsh b/unicode/installer/languages/English.nsh index f74e5c75..e5d8dccf 100644 --- a/unicode/installer/languages/English.nsh +++ b/unicode/installer/languages/English.nsh @@ -10,8 +10,21 @@ LangString oninit_alreadyinstalled ${LANG_ENGLISH} "is already installed" LangString oninit_closeusdx ${LANG_ENGLISH} "cannot be uninstalled while its running! Do you want to close it?"
LangString oninit_updateusdx ${LANG_ENGLISH} "Do you want to update the installation from:"
+LangString update_connect ${LANG_ENGLISH} "Establish internet connection and check for new version"
+LangString button_next ${LANG_ENGLISH} "Next >"
+LangString button_close ${LANG_ENGLISH} "Close"
+LangString update_information ${LANG_ENGLISH} "You can check if a new version of 'UltraStar Deluxe' is available. Thereto an internet connection will be established. If a new version is found, it can be installed afterwards."
+
+LangString update_check_older ${LANG_ENGLISH} "Your version $R0 is outdated. The new version $1 of UltraStar Deluxe is available. Do you want to update?"
+LangString update_check_equal ${LANG_ENGLISH} "Your currently installed version $R0 is up-to-date. No update needed."
+LangString update_check_newer ${LANG_ENGLISH} "Your installed version $R0 is newer than the $\n$\rcurrent release version $1 of UltraStar Deluxe. No update needed."
+LangString update_check_failed ${LANG_ENGLISH} "The check for a new version failed. Do you want to visit website to check manually ?"
+
; Welcome Page:
+LangString page_welcome_title_update ${LANG_ENGLISH} "Welcome to the UltraStar Deluxe Update Wizard"
+LangString page_welcome_txt_update ${LANG_ENGLISH} "This wizard will guide you through the Update process of UltraStar Deluxe. UltraStar Deluxe is a free open source Karaoke game, which can be compared with Singstar.$\n$\r$\n$\rThe UltraStar Deluxe Team wishes you fun.$\n$\rProject website: http://www.ultrastardeluxe.org$\n$\rSupport Forum: http://forum.ultrastardeluxe.org"
+
LangString page_welcome_title ${LANG_ENGLISH} "Welcome to the UltraStar Deluxe Setup Wizard"
LangString page_welcome_txt ${LANG_ENGLISH} "This wizard will guide you through the Installation of UltraStar Deluxe. UltraStar Deluxe is a free open source Karaoke game, which can be compared with Singstar.$\n$\r$\n$\rThe UltraStar Deluxe Team wishes you fun.$\n$\rProject website: http://www.ultrastardeluxe.org$\n$\rSupport Forum: http://forum.ultrastardeluxe.org"
@@ -46,10 +59,12 @@ LangString sc_desktop ${LANG_ENGLISH} "Create Desktop Shortcut?" LangString name_section1 ${LANG_ENGLISH} "Main components"
LangString name_section2 ${LANG_ENGLISH} "Optional songs"
+LangString name_s2_sub1 ${LANG_ENGLISH} "Jonathan Coulton"
LangString name_section3 ${LANG_ENGLISH} "Optional themes"
LangString DESC_Section1 ${LANG_ENGLISH} "These are the basic files needed by UltraStar Deluxe"
LangString DESC_Section2 ${LANG_ENGLISH} "You can choose which songs should be installed."
+LangString DESC_Section2_sub1 ${LANG_ENGLISH} "You can choose which Jonathan Coulton Songs (CC by-nc 3.0) should be installed."
LangString DESC_Section3 ${LANG_ENGLISH} "You can choose which optional themes should be installed."
LangString DESC_g2Section1 ${LANG_ENGLISH} "This will install the song 'Dead Smiling Pirates - I 18' (CC by-nc-nd 2.5)."
@@ -57,6 +72,31 @@ LangString DESC_g2Section2 ${LANG_ENGLISH} "This will install the song 'Joshua M LangString DESC_g2Section3 ${LANG_ENGLISH} "This will install the song 'Pornophonique - Space Invaders' (CC by-nc-nd 2.0)."
LangString DESC_g2Section4 ${LANG_ENGLISH} "This will install the song 'Steven Dunston - Northern Star' (CC by-nc-sa 2.5)."
+LangString DESC_s2_sub1_Section1 ${LANG_ENGLISH} "This will install the song 'Monkey Shines'."
+LangString DESC_s2_sub1_Section2 ${LANG_ENGLISH} "This will install the song 'I Crush Everything'."
+LangString DESC_s2_sub1_Section3 ${LANG_ENGLISH} "This will install the song 'Not About You'."
+LangString DESC_s2_sub1_Section4 ${LANG_ENGLISH} "This will install the song 'Mr. Fancy Pants'."
+LangString DESC_s2_sub1_Section5 ${LANG_ENGLISH} "This will install the song 'Big Bad World One'."
+LangString DESC_s2_sub1_Section6 ${LANG_ENGLISH} "This will install the song 'Flickr'."
+LangString DESC_s2_sub1_Section7 ${LANG_ENGLISH} "This will install the song 'My Beige Bear'."
+LangString DESC_s2_sub1_Section8 ${LANG_ENGLISH} "This will install the song 'The Future Soon'."
+LangString DESC_s2_sub1_Section9 ${LANG_ENGLISH} "This will install the song 'Ikea'."
+LangString DESC_s2_sub1_Section10 ${LANG_ENGLISH} "This will install the song 'Furry Old Lobster'."
+LangString DESC_s2_sub1_Section11 ${LANG_ENGLISH} "This will install the song 'Code Monkey'."
+LangString DESC_s2_sub1_Section12 ${LANG_ENGLISH} "This will install the song 'I´m Your Moon'."
+LangString DESC_s2_sub1_Section13 ${LANG_ENGLISH} "This will install the song 'First Of May'."
+LangString DESC_s2_sub1_Section14 ${LANG_ENGLISH} "This will install the song 'Dance, Soterios Johnson, Dance'."
+LangString DESC_s2_sub1_Section15 ${LANG_ENGLISH} "This will install the song 'A Talk With George'."
+LangString DESC_s2_sub1_Section16 ${LANG_ENGLISH} "This will install the song 'Creepy Doll'."
+LangString DESC_s2_sub1_Section17 ${LANG_ENGLISH} "This will install the song 'That Spells DNA'."
+LangString DESC_s2_sub1_Section18 ${LANG_ENGLISH} "This will install the song 'When You Go'."
+LangString DESC_s2_sub1_Section19 ${LANG_ENGLISH} "This will install the song 'Better'."
+LangString DESC_s2_sub1_Section20 ${LANG_ENGLISH} "This will install the song 'Shop Vac'."
+LangString DESC_s2_sub1_Section21 ${LANG_ENGLISH} "This will install the song 'I Feel Fantastic'."
+LangString DESC_s2_sub1_Section22 ${LANG_ENGLISH} "This will install the song 'Re: Your Brains'."
+LangString DESC_s2_sub1_Section23 ${LANG_ENGLISH} "This will install the song 'Skullcrusher Mountain'."
+LangString DESC_s2_sub1_Section24 ${LANG_ENGLISH} "This will install the song 'Chiron Beta Prime'."
+
LangString DESC_g3Section1 ${LANG_ENGLISH} "This will install the optional theme 'Orange' by Skar"
LangString DESC_g3Section2 ${LANG_ENGLISH} "This will install the optional theme 'Streetlight' by Skar"
LangString DESC_g3Section3 ${LANG_ENGLISH} "This will install the optional theme 'Vistar' by Skar"
diff --git a/unicode/installer/languages/German.nsh b/unicode/installer/languages/German.nsh index 1027b8e0..642257ee 100644 --- a/unicode/installer/languages/German.nsh +++ b/unicode/installer/languages/German.nsh @@ -10,8 +10,21 @@ LangString oninit_alreadyinstalled ${LANG_GERMAN} "ist bereits installiert" LangString oninit_closeusdx ${LANG_GERMAN} "kann nicht während der Laufzeit deinstalliert werden. Soll es geschlossen werden?"
LangString oninit_updateusdx ${LANG_GERMAN} "Möchten Sie das Programm aktualisieren von"
+LangString update_connect ${LANG_GERMAN} "Mit dem Internet verbinden und nach aktueller Version suchen"
+LangString button_next ${LANG_GERMAN} "Weiter >"
+LangString button_close ${LANG_GERMAN} "Beenden"
+LangString update_information ${LANG_GERMAN} "Du kannst nach einer aktuelleren Version von 'UltraStar Deluxe' suchen. Dazu wird eine Verbindung mit dem Internet hergestellt. Wurde eine aktuellere Version gefunden, kann diese anschließend installiert werden."
+
+LangString update_check_older ${LANG_GERMAN} "Deine aktuelle Version $R0 ist veraltet. Die neue Version $1 von UltraStar Deluxe ist verfügbar. Möchtest du sie runterladen?"
+LangString update_check_equal ${LANG_GERMAN} "Deine aktuelle Version $R0 ist auf dem neusten Stand.$\n$\rKein Update benötigt."
+LangString update_check_newer ${LANG_GERMAN} "Deine aktuelle Version $R0 ist neuer als die zurzeit veröffentlichte$\n$\rVersion $1 von UltraStar Deluxe. Kein Update benötigt."
+LangString update_check_failed ${LANG_GERMAN} "Die Aktualisierungsprüfung ist fehlgeschlagen. Willst du manuell nach Updates suchen?"
+
; Welcome Page:
+LangString page_welcome_title_update ${LANG_GERMAN} "Willkommen beim Aktualisierungsassistenten von UltraStar Deluxe"
+LangString page_welcome_txt_update ${LANG_GERMAN} "Dieser Assistent wird Sie durch die Aktualisierung von UltraStar Deluxe begleiten. UltraStar Deluxe ist ein kostenloses quelloffenes Karaokespiel, welches Singstar ähnelt. $\n$\r$\n$\rDas UltraStar Deluxe Team wünscht viel Spaß.$\n$\rProjekthomepage: http://www.ultrastardeluxe.org$\n$\rSupport Forum: http://forum.ultrastardeluxe.org"
+
LangString page_welcome_title ${LANG_GERMAN} "Willkommen zur Installationsroutine von UltraStar Deluxe"
LangString page_welcome_txt ${LANG_GERMAN} "Dieser Assistent wird Sie durch die Installation von UltraStar Deluxe begleiten. UltraStar Deluxe ist ein kostenloses quelloffenes Karaokespiel, welches Singstar ähnelt. $\n$\r$\n$\rDas UltraStar Deluxe Team wünscht viel Spaß.$\n$\rProjekthomepage: http://www.ultrastardeluxe.org$\n$\rSupport Forum: http://forum.ultrastardeluxe.org"
@@ -46,10 +59,12 @@ LangString sc_desktop ${LANG_GERMAN} "Verknüpfung auf dem Desktop erstellen?" LangString name_section1 ${LANG_GERMAN} "Hauptkomponenten"
LangString name_section2 ${LANG_GERMAN} "Optionale Songs"
+LangString name_s2_sub1 ${LANG_GERMAN} "Jonathan Coulton"
LangString name_section3 ${LANG_GERMAN} "Optionale Themen"
LangString DESC_Section1 ${LANG_GERMAN} "Dies sind die von UltraStar Deluxe benötigten Grunddateien"
LangString DESC_Section2 ${LANG_GERMAN} "Hier können Songs zum Installieren gewählt werden."
+LangString DESC_Section2_sub1 ${LANG_GERMAN} "Hier können Jonathan Coulton Songs (CC by-nc 3.0) zum Installieren gewählt werden."
LangString DESC_Section3 ${LANG_GERMAN} "Hier können alternative Motive zum Installieren gewählt werden."
LangString DESC_g2Section1 ${LANG_GERMAN} "Installiert das Beispiellied 'Dead Smiling Pirates - I 18' (CC by-nc-nd 2.5)."
@@ -57,6 +72,31 @@ LangString DESC_g2Section2 ${LANG_GERMAN} "Installiert das Beispiellied 'Joshua LangString DESC_g2Section3 ${LANG_GERMAN} "Installiert das Beispiellied 'Pornophonique - Space Invaders' (CC by-nc-nd 2.0)."
LangString DESC_g2Section4 ${LANG_GERMAN} "Installiert das Beispiellied 'Steven Dunston - Northern Star' (CC by-nc-sa 2.5)."
+LangString DESC_s2_sub1_Section1 ${LANG_GERMAN} "Installiert das Beispiellied 'Monkey Shines'."
+LangString DESC_s2_sub1_Section2 ${LANG_GERMAN} "Installiert das Beispiellied 'I Crush Everything'."
+LangString DESC_s2_sub1_Section3 ${LANG_GERMAN} "Installiert das Beispiellied 'Not About You'."
+LangString DESC_s2_sub1_Section4 ${LANG_GERMAN} "Installiert das Beispiellied 'Mr. Fancy Pants'."
+LangString DESC_s2_sub1_Section5 ${LANG_GERMAN} "Installiert das Beispiellied 'Big Bad World One'."
+LangString DESC_s2_sub1_Section6 ${LANG_GERMAN} "Installiert das Beispiellied 'Flickr'."
+LangString DESC_s2_sub1_Section7 ${LANG_GERMAN} "Installiert das Beispiellied 'My Beige Bear'."
+LangString DESC_s2_sub1_Section8 ${LANG_GERMAN} "Installiert das Beispiellied 'The Future Soon'."
+LangString DESC_s2_sub1_Section9 ${LANG_GERMAN} "Installiert das Beispiellied 'Ikea'."
+LangString DESC_s2_sub1_Section10 ${LANG_GERMAN} "Installiert das Beispiellied 'Furry Old Lobster'."
+LangString DESC_s2_sub1_Section11 ${LANG_GERMAN} "Installiert das Beispiellied 'Code Monkey'."
+LangString DESC_s2_sub1_Section12 ${LANG_GERMAN} "Installiert das Beispiellied 'I´m Your Moon'."
+LangString DESC_s2_sub1_Section13 ${LANG_GERMAN} "Installiert das Beispiellied 'First Of May'."
+LangString DESC_s2_sub1_Section14 ${LANG_GERMAN} "Installiert das Beispiellied 'Dance, Soterios Johnson, Dance'."
+LangString DESC_s2_sub1_Section15 ${LANG_GERMAN} "Installiert das Beispiellied 'A Talk With George'."
+LangString DESC_s2_sub1_Section16 ${LANG_GERMAN} "Installiert das Beispiellied 'Creepy Doll'."
+LangString DESC_s2_sub1_Section17 ${LANG_GERMAN} "Installiert das Beispiellied 'That Spells DNA'."
+LangString DESC_s2_sub1_Section18 ${LANG_GERMAN} "Installiert das Beispiellied 'When You Go'."
+LangString DESC_s2_sub1_Section19 ${LANG_GERMAN} "Installiert das Beispiellied 'Better'."
+LangString DESC_s2_sub1_Section20 ${LANG_GERMAN} "Installiert das Beispiellied 'Shop Vac'."
+LangString DESC_s2_sub1_Section21 ${LANG_GERMAN} "Installiert das Beispiellied 'I Feel Fantastic'."
+LangString DESC_s2_sub1_Section22 ${LANG_GERMAN} "Installiert das Beispiellied 'Re: Your Brains'."
+LangString DESC_s2_sub1_Section23 ${LANG_GERMAN} "Installiert das Beispiellied 'Skullcrusher Mountain'."
+LangString DESC_s2_sub1_Section24 ${LANG_GERMAN} "Installiert das Beispiellied 'Chiron Beta Prime'."
+
LangString DESC_g3Section1 ${LANG_GERMAN} "Installiert das Motiv 'Orange' von Skar"
LangString DESC_g3Section2 ${LANG_GERMAN} "Installiert das Motiv 'Streetlight' von Skar"
LangString DESC_g3Section3 ${LANG_GERMAN} "Installiert das Motiv 'Vistar' von Skar"
diff --git a/unicode/installer/settings/files_main_install.nsh b/unicode/installer/settings/files_main_install.nsh index 00fd3f8e..605725aa 100644 --- a/unicode/installer/settings/files_main_install.nsh +++ b/unicode/installer/settings/files_main_install.nsh @@ -43,11 +43,7 @@ File ..\game\covers\NoCover.jpg ; Plugins dir:
SetOutPath "$INSTDIR\Plugins\"
- File "..\Plugins\Blind.dll"
- File "..\Plugins\Duell.dll"
- File "..\Plugins\Hold_The_Line.dll"
- File "..\Plugins\TeamDuell.dll"
- File "..\Plugins\Until5000.dll"
+ File "..\Plugins\*.dll"
${If} ${AtLeastWinVista}
diff --git a/unicode/installer/settings/functions.nsh b/unicode/installer/settings/functions.nsh index 8345c4cc..bbd4fea2 100644 --- a/unicode/installer/settings/functions.nsh +++ b/unicode/installer/settings/functions.nsh @@ -74,4 +74,126 @@ FunctionEnd !macro nsProcess::Unload
nsProcess::_Unload
-!macroend
\ No newline at end of file +!macroend
+
+Function OnCheckbox
+ GetDlgItem $R0 $HWNDPARENT 1
+ Pop $0 # HWND
+ ${NSD_GetState} $0 $1
+ IntCmp $1 1 _Next _Close
+ _Next:
+ SendMessage $R0 ${WM_SETTEXT} 0 "STR:$(button_next)"
+ goto _done
+ _Close:
+ SendMessage $R0 ${WM_SETTEXT} 0 "STR:$(button_close)"
+ _done:
+FunctionEnd
+
+Function VersionCompare
+ !define VersionCompare `!insertmacro VersionCompareCall`
+
+ !macro VersionCompareCall _VER1 _VER2 _RESULT
+ Push `${_VER1}`
+ Push `${_VER2}`
+ Call VersionCompare
+ Pop ${_RESULT}
+ !macroend
+
+ Exch $1
+ Exch
+ Exch $0
+ Exch
+ Push $2
+ Push $3
+ Push $4
+ Push $5
+ Push $6
+ Push $7
+
+ begin:
+ StrCpy $2 -1
+ IntOp $2 $2 + 1
+ StrCpy $3 $0 1 $2
+ StrCmp $3 '' +2
+ StrCmp $3 '.' 0 -3
+ StrCpy $4 $0 $2
+ IntOp $2 $2 + 1
+ StrCpy $0 $0 '' $2
+
+ StrCpy $2 -1
+ IntOp $2 $2 + 1
+ StrCpy $3 $1 1 $2
+ StrCmp $3 '' +2
+ StrCmp $3 '.' 0 -3
+ StrCpy $5 $1 $2
+ IntOp $2 $2 + 1
+ StrCpy $1 $1 '' $2
+
+ StrCmp $4$5 '' equal
+
+ StrCpy $6 -1
+ IntOp $6 $6 + 1
+ StrCpy $3 $4 1 $6
+ StrCmp $3 '0' -2
+ StrCmp $3 '' 0 +2
+ StrCpy $4 0
+
+ StrCpy $7 -1
+ IntOp $7 $7 + 1
+ StrCpy $3 $5 1 $7
+ StrCmp $3 '0' -2
+ StrCmp $3 '' 0 +2
+ StrCpy $5 0
+
+ StrCmp $4 0 0 +2
+ StrCmp $5 0 begin newer2
+ StrCmp $5 0 newer1
+ IntCmp $6 $7 0 newer1 newer2
+
+ StrCpy $4 '1$4'
+ StrCpy $5 '1$5'
+ IntCmp $4 $5 begin newer2 newer1
+
+ equal:
+ StrCpy $0 0
+ goto end
+ newer1:
+ StrCpy $0 1
+ goto end
+ newer2:
+ StrCpy $0 2
+
+ end:
+ Pop $7
+ Pop $6
+ Pop $5
+ Pop $4
+ Pop $3
+ Pop $2
+ Pop $1
+ Exch $0
+FunctionEnd
+
+Function ReadFileLine
+Exch $0 ;file
+Exch
+Exch $1 ;line number
+Push $2
+Push $3
+
+ FileOpen $2 $0 r
+ StrCpy $3 0
+
+Loop:
+ IntOp $3 $3 + 1
+ ClearErrors
+ FileRead $2 $0
+ IfErrors +2
+ StrCmp $3 $1 0 loop
+ FileClose $2
+
+Pop $3
+Pop $2
+Pop $1
+Exch $0
+FunctionEnd
\ No newline at end of file diff --git a/unicode/installer/settings/variables.nsh b/unicode/installer/settings/variables.nsh index b6ffc022..bf5668d7 100644 --- a/unicode/installer/settings/variables.nsh +++ b/unicode/installer/settings/variables.nsh @@ -43,6 +43,31 @@ !define download_song3 "http://downloads.sourceforge.net/ultrastardx/usdx_song-pornophonique_-_space_-_invaders.zip"
!define download_song4 "http://downloads.sourceforge.net/ultrastardx/usdx_song-steven_dunston_-_northern_star.zip"
+!define download_sub1_song1 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_monkey_shines.zip"
+!define download_sub1_song2 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_i_crush_everything.zip"
+!define download_sub1_song3 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_not_about_you.zip"
+!define download_sub1_song4 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_mr_fancy_pants.zip"
+!define download_sub1_song5 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_big_bad_world_one.zip"
+!define download_sub1_song6 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_flickr.zip"
+!define download_sub1_song7 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_my_beige_bear.zip"
+!define download_sub1_song8 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_the_future_soon.zip"
+!define download_sub1_song9 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_ikea.zip"
+!define download_sub1_song10 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_furry_old_lobster.zip"
+!define download_sub1_song11 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_code_monkey.zip"
+!define download_sub1_song12 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_im_your_moon.zip"
+!define download_sub1_song13 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_first_of_may.zip"
+!define download_sub1_song14 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_dance_soterios_johnson_dance.zip"
+!define download_sub1_song15 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_a_talk_with_george.zip"
+!define download_sub1_song16 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_creepy_doll.zip"
+!define download_sub1_song17 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_that_spells_dna.zip"
+!define download_sub1_song18 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_when_you_go.zip"
+!define download_sub1_song19 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_better.zip"
+!define download_sub1_song20 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_shop_vac.zip"
+!define download_sub1_song21 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_i_feel_fantastic.zip"
+!define download_sub1_song22 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_re-_your_brains.zip"
+!define download_sub1_song23 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_skullcrusher_mountain.zip"
+!define download_sub1_song24 "http://downloads.sourceforge.net/ultrastardx/usdx_song-jonathan_coulton_-_chiron_beta_prime.zip"
+
!define download_theme1 "http://downloads.sourceforge.net/ultrastardx/usdx_skin-orange_by_Skar.zip"
!define download_theme2 "http://downloads.sourceforge.net/ultrastardx/usdx_skin-Streetlight_by_Skar.zip"
!define download_theme3 "http://downloads.sourceforge.net/ultrastardx/usdx_skin-Vistar_by_Skar.zip"
diff --git a/unicode/installerdependencies/images/install.ico b/unicode/installerdependencies/images/install.ico Binary files differindex f3214d1a..af1b9372 100644 --- a/unicode/installerdependencies/images/install.ico +++ b/unicode/installerdependencies/images/install.ico diff --git a/unicode/plugins/5000Points/Until5000.dpr b/unicode/plugins/5000Points/Until5000.dpr index 507159ff..df79bfe2 100644 --- a/unicode/plugins/5000Points/Until5000.dpr +++ b/unicode/plugins/5000Points/Until5000.dpr @@ -4,8 +4,6 @@ library Until5000; {$MODE Delphi} {$ENDIF} -{$I ../../Game/Code/switches.inc} - uses ModiSDK in '..\SDK\ModiSDK.pas'; @@ -90,7 +88,10 @@ for I := 0 to PlayerInfo.NumPlayers-1 do end; exports -PluginInfo, Init, Draw, Finish; + PluginInfo, + Init, + Draw, + Finish; begin diff --git a/unicode/plugins/Blind/Blind.dpr b/unicode/plugins/Blind/Blind.dpr index 2f94229c..d2824587 100644 --- a/unicode/plugins/Blind/Blind.dpr +++ b/unicode/plugins/Blind/Blind.dpr @@ -1,5 +1,9 @@ library Blind; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + uses ModiSDK in '..\SDK\ModiSDK.pas'; @@ -95,7 +99,10 @@ begin end; exports -PluginInfo, Init, Draw, Finish; + PluginInfo, + Init, + Draw, + Finish; begin diff --git a/unicode/plugins/Don't_Get_Worse/Hold_The_Line.dpr b/unicode/plugins/Don't_Get_Worse/Hold_The_Line.dpr index a197d51b..8bfb292c 100644 --- a/unicode/plugins/Don't_Get_Worse/Hold_The_Line.dpr +++ b/unicode/plugins/Don't_Get_Worse/Hold_The_Line.dpr @@ -1,10 +1,15 @@ library Hold_The_Line; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + uses - ModiSDK in '..\SDK\ModiSDK.pas', + ModiSDK in '..\SDK\ModiSDK.pas', StrUtils in '..\SDK\StrUtils.pas', - OpenGL12, - Windows; + sdl in '..\..\src\lib\JEDI-SDL\SDL\Pas\sdl.pas', + moduleloader in '..\..\src\lib\JEDI-SDL\SDL\Pas\moduleloader.pas', + gl in '..\..\src\lib\JEDI-SDL\OpenGL\Pas\gl.pas'; var PointerTex: TSmallTexture; @@ -84,8 +89,6 @@ begin PlayerTimes[I] := 0; end; - LoadOpenGL; - Result := True; end; @@ -102,7 +105,7 @@ begin //Aktivate Blink If (CurSentence = CountSentences div 5 * 2 - 1) OR (CurSentence = CountSentences div 3 * 2 - 1) then begin - Tick := Gettickcount div 400; + Tick := SDL_GetTicks() div 400; If (Tick <> LastTick) then begin LastTick := Tick; @@ -172,7 +175,7 @@ begin glColor4f (0.8, 0.8, 0.8, 1); - MethodRec.Print (1, 6, PlayerInfo.Playerinfo[I].PosX, PlayerInfo.Playerinfo[I].PosY-8, Text); + MethodRec.Print (1, 18, PlayerInfo.Playerinfo[I].PosX, PlayerInfo.Playerinfo[I].PosY-8, Text); FreeStr(Text); end; end; diff --git a/unicode/plugins/Duell/Duell.dpr b/unicode/plugins/Duell/Duell.dpr index 3aff4d3e..93c87d0e 100644 --- a/unicode/plugins/Duell/Duell.dpr +++ b/unicode/plugins/Duell/Duell.dpr @@ -1,5 +1,9 @@ library Duell; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + uses ModiSDK in '..\SDK\ModiSDK.pas'; @@ -92,7 +96,10 @@ begin end; exports -PluginInfo, Init, Draw, Finish; + PluginInfo, + Init, + Draw, + Finish; begin diff --git a/unicode/plugins/SDK/ModiSDK.pas b/unicode/plugins/SDK/ModiSDK.pas index 76dcf8ea..c0e66387 100644 --- a/unicode/plugins/SDK/ModiSDK.pas +++ b/unicode/plugins/SDK/ModiSDK.pas @@ -6,8 +6,6 @@ interface {$MODE Delphi} {$ENDIF} -{$I switches.inc} - type //PluginInfo, for Init TPluginInfo = record //Info diff --git a/unicode/plugins/SDK/StrUtils.pas b/unicode/plugins/SDK/StrUtils.pas index a5735b8f..069c89c3 100644 --- a/unicode/plugins/SDK/StrUtils.pas +++ b/unicode/plugins/SDK/StrUtils.pas @@ -2,7 +2,9 @@ unit StrUtils; interface -{$I switches.inc} +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} uses ModiSDK; @@ -12,6 +14,10 @@ procedure FreeStr(Str: PChar); implementation +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} + {function StrToAChar(Str: String): AChar; var L, I: Integer; @@ -70,4 +76,4 @@ begin FreeMem(Str); end; -end.
\ No newline at end of file +end. diff --git a/unicode/plugins/SDK/UPluginDefs.pas b/unicode/plugins/SDK/UPluginDefs.pas index 4cd094f7..45bae864 100644 --- a/unicode/plugins/SDK/UPluginDefs.pas +++ b/unicode/plugins/SDK/UPluginDefs.pas @@ -1,8 +1,8 @@ unit uPluginDefs; {********************* uPluginDefs - Some Basic Structures and Functions used to communicate with Plugins - Usable as Delphi Plugin SDK + Some basic structures and functions used to communicate with plugins + Usable as Delphi plugin SDK *********************} interface @@ -14,60 +14,60 @@ interface {$I switches.inc} type - DWORD = LongWord; + dword = LongWord; //Compatibility with 64 Bit Systems {$IFDEF CPU32} - TwParam = Integer; - TlParam = Pointer; //lParam is Used for 32 Bit addresses DWord is large enough + TwParam = integer; + TlParam = pointer; //lParam is used for 32 bit addresses. dword is large enough {$ELSE} - TwParam = Int64; - TlParam = Pointer; //lParam used for 64Bit addresses in 64 Bit Systems(FreePascal) + TwParam = int64; + TlParam = pointer; //lParam used for 64 bit addresses in 64 bit systems (FreePascal) {$ENDIF} - //wParam is mainly used for Ordninals - //lParam is mainly used for Pointers + //wParam is mainly used for ordinals + //lparam is mainly used for pointers //---------------- - // TUS_PluginInfo - Some Infos from Plugin to Core. - // Send when Plugininfo procedure is Called + // TUS_PluginInfo - some infos from plugin to core. + // Send when Plugininfo procedure is called // --- - // Version Structure: - // First Byte: Head Revison - // Second Byte: Sub Revison - // Third Byte: Sub Revision 2 - // Fourth Byte: Letter (For Bug Fix releases. 0 or 'a' .. 'z') + // Version structure: + // First byte: Head Revison + // Second byte: Sub Revison + // Third byte: Sub Revision 2 + // Fourth byte: Letter (For Bug Fix releases. 0 or 'a' .. 'z') //---------------- PUS_PluginInfo = ^TUS_PluginInfo; TUS_PluginInfo = record - cbSize: Integer; //Size of this record (usefull if record will be extended in the future) - - Name: Array [0..31] of Char; //Name of the Plugin - Version: DWord; //Version of the Plugin - Description: Array [0..127] of Char; //Description, what does this Plugin do - Author: Array [0..31] of Char; //Author of this Plugin - AuthorEmail: Array [0..63] of Char; //Authors Email - Homepage: Array [0..63] of Char; //Homepage of Plugin/Author + cbSize: integer; //Size of this record (usefull if record will be extended in the future) + + Name: array [0..31] of char; //Name of the Plugin + Version: dword; //Version of the Plugin + Description: array [0..127] of char; //Description, what does this Plugin do + Author: array [0..31] of char; //Author of this Plugin + AuthorEmail: array [0..63] of char; //Authors Email + Homepage: array [0..63] of char; //Homepage of Plugin/Author end; - AUS_PluginInfo = Array of TUS_PluginInfo; + AUS_PluginInfo = array of TUS_PluginInfo; PAUS_PluginInfo = ^AUS_PluginInfo; //---------------- - // TUS_Hook - Structure of the Hook Function + // TUS_Hook - Structure of the Hook function // Return 0 if the Hook should be continue, // or a non zero Value, if the Hook should be Interuped // In this Case the Caller of the Notifier gets the Return Value // Return Value Should not be -1 //---------------- - TUS_Hook = Function (wParam: TwParam; lParam: TlParam): integer; stdcall; - TUS_Hook_of_Object = Function (wParam: TwParam; lParam: TlParam): integer of Object; + TUS_Hook = function (wParam: TwParam; lParam: TlParam): integer; stdcall; + TUS_Hook_of_Object = function (wParam: TwParam; lParam: TlParam): integer of Object; //---------------- - // TUS_Service - Structure of the Service Function - // This Function is called if the Registered Service is Called + // TUS_Service - Structure of the Service function + // This function is called if the Registered Service is Called // Return Value Should not be SERVICE_NOT_FOUND //---------------- - TUS_Service = Function (wParam: TwParam; lParam: TlParam): integer; stdcall; - TUS_Service_of_Object = Function (wParam: TwParam; lParam: TlParam): integer of Object; + TUS_Service = function (wParam: TwParam; lParam: TlParam): integer; stdcall; + TUS_Service_of_Object = function (wParam: TwParam; lParam: TlParam): integer of Object; //---------------- // TUS_PluginInterface - Structure that Includes all Methods callable @@ -78,45 +78,45 @@ type {******** Hook specific Methods ********} {Function Creates a new Hookable Event and Returns the Handle or 0 on Failure. (Name already exists)} - CreateHookableEvent: Function (EventName: PChar): THandle; stdcall; + CreateHookableEvent: function (EventName: PChar): THandle; stdcall; {Function Destroys an Event and Unhooks all Hooks to this Event. 0 on success, not 0 on Failure} - DestroyHookableEvent: Function (hEvent: THandle): integer; stdcall; + DestroyHookableEvent: function (hEvent: THandle): integer; stdcall; {Function start calling the Hook Chain 0 if Chain is called until the End, -1 if Event Handle is not valid otherwise Return Value of the Hook that breaks the Chain} - NotivyEventHooks: Function (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; + NotivyEventHooks: function (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; {Function Hooks an Event by Name. Returns Hook Handle on Success, otherwise 0} - HookEvent: Function (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; + HookEvent: function (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; {Function Removes the Hook from the Chain Returns 0 on Success} - UnHookEvent: Function (hHook: THandle): Integer; stdcall; + UnHookEvent: function (hHook: THandle): integer; stdcall; {Function Returns Non Zero if a Event with the given Name Exists, otherwise 0} - EventExists: Function (EventName: PChar): Integer; stdcall; + EventExists: function (EventName: PChar): integer; stdcall; {******** Service specific Methods ********} {Function Creates a new Service and Returns the Services Handle or 0 on Failure. (Name already exists)} - CreateService: Function (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; + CreateService: function (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; {Function Destroys a Service. 0 on success, not 0 on Failure} - DestroyService: Function (hService: THandle): integer; stdcall; + DestroyService: function (hService: THandle): integer; stdcall; {Function Calls a Services Proc Returns Services Return Value or SERVICE_NOT_FOUND on Failure} - CallService: Function (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; + CallService: function (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; {Function Returns Non Zero if a Service with the given Name Exists, otherwise 0} - ServiceExists: Function (ServiceName: PChar): Integer; stdcall; + ServiceExists: function (ServiceName: PChar): integer; stdcall; end; //---------------- @@ -124,9 +124,9 @@ type //---------------- PModuleInfo = ^TModuleInfo; TModuleInfo = record - Name: String; + Name: string; Version: LongWord; - Description: String; + Description: string; end; AModuleInfo = array of TModuleInfo; @@ -139,11 +139,11 @@ type //Called on Plugins Load. If Non Zero is Returned => abort Loading //PInterface is Pointer to PluginInterface - Func_Load = function (const PInterface: PUS_PluginInterface): Integer; stdcall; + Func_Load = function (const PInterface: PUS_PluginInterface): integer; stdcall; //Called on Plugins Init. If Non Zero is Returned => abort Loading //PInterface is Pointer to PluginInterface - Func_Init = function (const PInterface: PUS_PluginInterface): Integer; stdcall; + Func_Init = function (const PInterface: PUS_PluginInterface): integer; stdcall; //Called on Plugins Deinit. //PInterface is Pointer to PluginInterface @@ -162,32 +162,30 @@ const CORE_SM_WARNING = 2; CORE_SM_INFO = 3; - //---------------- -// Some Functions to Handle Version DWords +// Some functions to Handle Version dwords //---------------- -Function MakeVersion(const HeadRevision, SubVersion, SubVersion2: Byte; Letter: Char): DWord; -Function VersiontoSting(const Version: DWord): String; - +function MakeVersion(const HeadRevision, SubVersion, SubVersion2: byte; Letter: char): dword; +function VersionToString(const Version: dword): string; implementation //-------------- -// MakeVersion - Converts 4 Values to a valid Version DWord +// MakeVersion - converts 4 values to a valid version dword //-------------- -Function MakeVersion(const HeadRevision, SubVersion, SubVersion2: Byte; Letter: Char): DWord; +function MakeVersion(const HeadRevision, SubVersion, SubVersion2: byte; Letter: char): dword; begin - If (letter < 'a') or (Letter > 'z') then + if(letter < 'a') or (Letter > 'z') then letter := chr(0); Result := (HeadRevision shl 24) or (SubVersion shl 16) or (SubVersion2 shl 8) or Ord(Letter); end; //-------------- -// VersiontoString - Returns some beauty '1.0.2a' like String +// VersiontoString - Returns some beauty '1.0.2a' like string //-------------- -Function VersiontoSting(const Version: DWord): String; -begin // to-do : Write VersiontoString without SysUtils depencies +function VersionToString(const Version: dword): string; +begin // to-do : Write VersiontoString without SysUtils dependence //Result := InttoStr((ver and $FF000000) shr 24); Result := '1.0.1' end; diff --git a/unicode/plugins/Team_Duell/TeamDuell.dpr b/unicode/plugins/Team_Duell/TeamDuell.dpr index 20db2b2e..cb0e6349 100644 --- a/unicode/plugins/Team_Duell/TeamDuell.dpr +++ b/unicode/plugins/Team_Duell/TeamDuell.dpr @@ -1,11 +1,16 @@ library TeamDuell ; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + uses - ModiSDK in '..\SDK\ModiSDK.pas', - StrUtils in '..\SDK\StrUtils.pas', - sysutils, - OpenGL12, - Windows; + ModiSDK in '..\SDK\ModiSDK.pas', + StrUtils in '..\SDK\StrUtils.pas', + sdl in '..\..\src\lib\JEDI-SDL\SDL\Pas\sdl.pas', + moduleloader in '..\..\src\lib\JEDI-SDL\SDL\Pas\moduleloader.pas', + gl in '..\..\src\lib\JEDI-SDL\OpenGL\Pas\gl.pas', + sysutils; var TeamPlayer: array of array of String; @@ -80,12 +85,11 @@ begin until NOT(NextSinger[I] = CurSinger[I]) OR (SPT[I] = 1) ; end; ChangeOnSentence := 8; - starttick := GetTickCount; + starttick := SDL_GetTicks(); firsttime := true; secondtime := true; bps := 1; MethodRec := Methods; - LoadOpenGL; Result := True; end; @@ -100,23 +104,23 @@ begin If (CurSentence = ChangeOnSentence - 7) AND (firsttime) then begin firsttime := false; - starttick := GetTickCount; + starttick := SDL_GetTicks(); end; start := false; // show first singers for 5sec - if (CurSentence < 1) AND ((starttick + 5000) > GetTickCount) then begin start := true; end; + if (CurSentence < 1) AND ((starttick + 5000) > SDL_GetTicks()) then begin start := true; end; // TickCount(thirdSentence) If (CurSentence = 3) AND (secondtime) then begin secondtime := false; firsttime := true; - endtick := GetTickCount; + endtick := SDL_GetTicks(); bps := (Startpoints[3]-Startpoints[1]) * 1000 / (endtick-starttick); // BeatsPerSecond end; // Time to next Change - RTtoNextChange := ((Startpoints[ChangeOnSentence]-Startpoints[ChangeOnSentence - 7]) / bps) - ((GetTickCount - starttick) / 1000); + RTtoNextChange := ((Startpoints[ChangeOnSentence]-Startpoints[ChangeOnSentence - 7]) / bps) - ((SDL_GetTicks() - starttick) / 1000); TtoNextChange := Trunc(RTtoNextChange) +1; // Next Singer for Team I @@ -176,11 +180,11 @@ begin // Names, Timer if (TtoNextChange <= 9) Then begin display := PChar(TeamPlayer[I,NextSinger[I]]); glColor4f (0.8, 0.1, 0.2, 1); - MethodRec.Print (1, 6, PlayerInfo.Playerinfo[I].PosX+85, PlayerInfo.Playerinfo[I].PosY+10, CreateStr(PChar(IntToStr(Trunc(TtoNextChange))))); + MethodRec.Print (1, 18, PlayerInfo.Playerinfo[I].PosX+85, PlayerInfo.Playerinfo[I].PosY+10, CreateStr(PChar(IntToStr(Trunc(TtoNextChange))))); end; glColor4f (0.8, 0.8, 0.8, 1); if (CurSentence = 0) then display := PChar(TeamPlayer[I,CurSinger[I]]); - if (TtoNextChange <= 11) OR (start) Then MethodRec.Print (1, 6, PlayerInfo.Playerinfo[I].PosX+5, PlayerInfo.Playerinfo[I].PosY+10, display); + if (TtoNextChange <= 11) OR (start) Then MethodRec.Print (1, 18, PlayerInfo.Playerinfo[I].PosX+5, PlayerInfo.Playerinfo[I].PosY+10, display); end; if (CurSentence = ChangeOnSentence) then begin ChangeOnSentence := CurSentence + 7; firsttime := true; end; Result := True; diff --git a/unicode/src/base/TextGL.pas b/unicode/src/base/TextGL.pas index 28c3c6b6..667a224f 100644 --- a/unicode/src/base/TextGL.pas +++ b/unicode/src/base/TextGL.pas @@ -68,11 +68,12 @@ procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables t implementation uses - UMain, - UCommon, UTextEncoding, SysUtils, - IniFiles; + IniFiles, + UCommon, + UMain, + UPath; function FindFontFile(FontIni: TCustomIniFile; Font: string): string; var diff --git a/unicode/src/base/UCatCovers.pas b/unicode/src/base/UCatCovers.pas index 4fc54199..6ef81b68 100644 --- a/unicode/src/base/UCatCovers.pas +++ b/unicode/src/base/UCatCovers.pas @@ -64,8 +64,9 @@ uses SysUtils, Classes, // UFiles, + ULog, UMain, - ULog; + UPath; constructor TCatCovers.Create; begin diff --git a/unicode/src/base/UCore.pas b/unicode/src/base/UCore.pas index 901f2f96..a7f9e56e 100644 --- a/unicode/src/base/UCore.pas +++ b/unicode/src/base/UCore.pas @@ -42,20 +42,20 @@ uses {********************* TCore - Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process - Also it does some Error Handling, and maybe sometime multithreaded Loading ;) + Class manages all CoreModules, the StartUp, the MainLoop and the shutdown process + Also, it does some error handling, and maybe sometime multithreaded loading ;) *********************} type TModuleListItem = record - Module: TCoreModule; //Instance of the Modules Class - Info: TModuleInfo; //ModuleInfo returned by Modules Modulinfo Proc - NeedsDeInit: Boolean; //True if Module was succesful inited + Module: TCoreModule; // Instance of the modules class + Info: TModuleInfo; // ModuleInfo returned by modules modulinfo proc + NeedsDeInit: boolean; // True if module was succesful inited end; TCore = class private - //Some Hook Handles. See Plugin SDKs Hooks.txt for Infos + // Some Hook Handles. See Plugin SDKs Hooks.txt for Infos hLoadingFinished: THandle; hMainLoop: THandle; hTranslate: THandle; @@ -72,71 +72,71 @@ type sGetModuleInfo: THandle; sGetApplicationHandle: THandle; - Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; + Modules: array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; - //Cur + Last Executed Setting and Getting ;) - iCurExecuted: Integer; - iLastExecuted: Integer; + // Cur + Last Executed Setting and Getting ;) + iCurExecuted: integer; + iLastExecuted: integer; - procedure SetCurExecuted(Value: Integer); + procedure SetCurExecuted(Value: integer); - //Function Get all Modules and Creates them - function GetModules: Boolean; + // Function Get all Modules and Creates them + function GetModules: boolean; - //Loads Core and all Modules - function Load: Boolean; + // Loads Core and all Modules + function Load: boolean; - //Inits Core and all Modules - function Init: Boolean; + // Inits Core and all Modules + function Init: boolean; - //DeInits Core and all Modules - function DeInit: Boolean; + // DeInits Core and all Modules + function DeInit: boolean; - //Load the Core - function LoadCore: Boolean; + // Load the Core + function LoadCore: boolean; - //Init the Core - function InitCore: Boolean; + // Init the Core + function InitCore: boolean; - //DeInit the Core - function DeInitCore: Boolean; + // DeInit the Core + function DeInitCore: boolean; - //Called one Time per Frame - function MainLoop: Boolean; + // Called one time per frame + function MainLoop: boolean; public - Hooks: THookManager; //Teh Hook Manager ;) - Services: TServiceManager;//The Service Manager + Hooks: THookManager; // The Hook Manager ;) + Services: TServiceManager; // The Service Manager - Name: String; //Name of this Application - Version: LongWord; //Version of this ". For Info Look PluginDefs Functions + Name: string; // Name of this application + Version: LongWord; // Version of this ". For info look plugindefs functions - LastErrorReporter:String; //Who Reported the Last Error String - LastErrorString: String; //Last Error String reported + LastErrorReporter: string; // Who reported the last error string + LastErrorString: string; // Last error string reported - property CurExecuted: Integer read iCurExecuted write SetCurExecuted; //ID of Plugin or Module curently Executed - property LastExecuted: Integer read iLastExecuted; + property CurExecuted: integer read iCurExecuted write SetCurExecuted; //ID of plugin or module curently executed + property LastExecuted: integer read iLastExecuted; //--------------- - //Main Methods to control the Core: + // Main methods to control the core: //--------------- - constructor Create(const cName: String; const cVersion: LongWord); + constructor Create(const cName: string; const cVersion: LongWord); - //Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown + // Starts loading and init process. Then runs MainLoop. DeInits on shutdown procedure Run; - //Method for other Classes to get Pointer to a specific Module - function GetModulebyName(const Name: String): PCoreModule; + // Method for other classes to get pointer to a specific module + function GetModulebyName(const Name: string): PCoreModule; //-------------- - // Hook and Service Procs: + // Hook and service procs: //-------------- function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook - function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam + function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle end; @@ -154,7 +154,7 @@ uses //------------- // Create - Creates Class + Hook and Service Manager //------------- -constructor TCore.Create(const cName: String; const cVersion: LongWord); +constructor TCore.Create(const cName: string; const cVersion: LongWord); begin inherited Create; @@ -171,11 +171,11 @@ begin end; //------------- -//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown +// Starts Loading and Init process. Then runs MainLoop. DeInits on shutdown //------------- procedure TCore.Run; var - Success: Boolean; + Success: boolean; procedure HandleError(const ErrorMsg: string); begin @@ -184,16 +184,16 @@ var else Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg)); - //DeInit + // DeInit DeInit; end; begin - //Get Modules + // Get modules try Success := GetModules(); except - Success := False; + Success := false; end; if (not Success) then @@ -202,11 +202,11 @@ begin Exit; end; - //Loading + // Loading try Success := Load(); except - Success := False; + Success := false; end; if (not Success) then @@ -215,11 +215,11 @@ begin Exit; end; - //Init + // Init try Success := Init(); except - Success := False; + Success := false; end; if (not Success) then @@ -228,28 +228,28 @@ begin Exit; end; - //Call Translate Hook + // Call Translate Hook if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then begin HandleError('Error translating'); Exit; end; - //Calls LoadTextures Hook + // Calls LoadTextures Hook if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then begin HandleError('Error loading textures'); Exit; end; - //Calls Loading Finished Hook + // Calls Loading Finished Hook if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then begin HandleError('Error calling LoadingFinished Hook'); Exit; end; - //Start MainLoop + // Start MainLoop while Success do begin Success := MainLoop(); @@ -258,41 +258,41 @@ begin end; //------------- -//Called one Time per Frame +// Called one time per frame //------------- -function TCore.MainLoop: Boolean; +function TCore.MainLoop: boolean; begin - Result := False; + Result := false; end; //------------- -//Function Get all Modules and Creates them +// Function get all modules and creates them //------------- -function TCore.GetModules: Boolean; +function TCore.GetModules: boolean; var - i: Integer; + i: integer; begin - Result := False; + Result := false; for i := 0 to high(Modules) do begin try - Modules[i].NeedsDeInit := False; + Modules[i].NeedsDeInit := false; Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create; Modules[i].Module.Info(@Modules[i].Info); except - ReportError(Integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + ReportError(integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); Exit; end; end; - Result := True; + Result := true; end; //------------- -//Loads Core and all Modules +// Loads core and all modules //------------- -function TCore.Load: Boolean; +function TCore.Load: boolean; var - i: Integer; + i: integer; begin Result := LoadCore; @@ -301,23 +301,23 @@ begin try Result := Modules[i].Module.Load; except - Result := False; + Result := false; end; if (not Result) then begin - ReportError(Integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + ReportError(integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); break; end; end; end; //------------- -//Inits Core and all Modules +// Inits core and all modules //------------- -function TCore.Init: Boolean; +function TCore.Init: boolean; var - i: Integer; + i: integer; begin Result := InitCore; @@ -326,12 +326,12 @@ begin try Result := Modules[i].Module.Init; except - Result := False; + Result := false; end; if (not Result) then begin - ReportError(Integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + ReportError(integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); break; end; @@ -340,7 +340,7 @@ begin end; //------------- -//DeInits Core and all Modules +// DeInits core and all modules //------------- function TCore.DeInit: boolean; var @@ -362,9 +362,9 @@ begin end; //------------- -//Load the Core +// Load the Core //------------- -function TCore.LoadCore: Boolean; +function TCore.LoadCore: boolean; begin hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished'); hMainLoop := Hooks.AddEvent('Core/MainLoop'); @@ -383,35 +383,35 @@ begin sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo); sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle); - //A little Test + // A little Test Hooks.AddSubscriber('Core/NewError', HookTest); result := true; end; //------------- -//Init the Core +// Init the Core //------------- -function TCore.InitCore: Boolean; +function TCore.InitCore: boolean; begin //Don not init something atm. result := true; end; //------------- -//DeInit the Core +// DeInit the Core //------------- -function TCore.DeInitCore: Boolean; +function TCore.DeInitCore: boolean; begin - // TODO: write TService-/HookManager.Free and call it here + // TODO: write TService-/HookManager. Free and call it here Result := true; end; //------------- -//Method for other classes to get pointer to a specific module +// Method for other classes to get pointer to a specific module //------------- -function TCore.GetModuleByName(const Name: String): PCoreModule; -var i: Integer; +function TCore.GetModuleByName(const Name: string): PCoreModule; +var i: integer; begin Result := nil; for i := 0 to High(Modules) do @@ -444,7 +444,7 @@ begin CORE_SM_INFO: Params := Params or MB_ICONINFORMATION; end; - //Show: + // Show: Result := Messagebox(0, lParam, PChar(Name), Params); end; {$ENDIF} @@ -458,8 +458,8 @@ end; function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer; begin //Update LastErrorReporter and LastErrorString - LastErrorReporter := String(PChar(lParam)); - LastErrorString := String(PChar(Pointer(wParam))); + LastErrorReporter := string(PChar(lParam)); + LastErrorString := string(PChar(Pointer(wParam))); Hooks.CallEventChain(hError, wParam, lParam); @@ -501,7 +501,7 @@ begin end; //------------- -// If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam +// If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam //------------- function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; var @@ -538,12 +538,12 @@ end; //------------- // Called when setting CurExecuted //------------- -procedure TCore.SetCurExecuted(Value: Integer); +procedure TCore.SetCurExecuted(Value: integer); begin - //Set Last Executed + // Set Last Executed iLastExecuted := iCurExecuted; - //Set Cur Executed + // Set Cur Executed iCurExecuted := Value; end; diff --git a/unicode/src/base/UDraw.pas b/unicode/src/base/UDraw.pas index d3f19019..8a66d271 100644 --- a/unicode/src/base/UDraw.pas +++ b/unicode/src/base/UDraw.pas @@ -55,7 +55,6 @@ procedure SingDrawTimeBar(); //Draw Editor NoteLines procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); - type TRecR = record Top: real; @@ -67,7 +66,6 @@ type WMid: real; Height: real; HMid: real; - Mid: real; end; @@ -75,51 +73,45 @@ var NotesW: real; NotesH: real; Starfr: integer; - StarfrG: integer; + StarfrG: integer; //SingBar - TickOld: cardinal; - TickOld2:cardinal; - -const - Przedz = 32; + TickOld: cardinal; + TickOld2: cardinal; implementation uses + SysUtils, + Math, gl, + TextGL, + UDLLManager, + UDrawTexture, UGraphic, - SysUtils, + UIni, + ULog, + ULyrics, + UNote, UMusic, URecord, - ULog, UScreenSing, UScreenSingModi, - ULyrics, - UMain, - TextGL, - UTexture, - UDrawTexture, - UIni, - Math, - UDLLManager; + UTexture; procedure SingDrawBackground; var - Rec: TRecR; - TexRec: TRecR; + Rec: TRecR; + TexRec: TRecR; begin - if (ScreenSing.Tex_Background.TexNum > 0) then begin - - glClearColor (1, 1, 1, 1); - glColor4f (1, 1, 1, 1); - + if (ScreenSing.Tex_Background.TexNum > 0) then + begin if (Ini.MovieSize <= 1) then //HalfSize BG begin (* half screen + gradient *) Rec.Top := 110; // 80 Rec.Bottom := Rec.Top + 20; - Rec.Left := 0; + Rec.Left := 0; Rec.Right := 800; TexRec.Top := (Rec.Top / 600) * ScreenSing.Tex_Background.TexH; @@ -185,16 +177,17 @@ end; procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); var SampleIndex: integer; - Sound: TCaptureBuffer; - MaxX, MaxY: real; + Sound: TCaptureBuffer; + MaxX, MaxY: real; begin; Sound := AudioInputProcessor.Sound[NrSound]; // Log.LogStatus('Oscilloscope', 'SingDraw'); glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); - {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then - glColor3f(1, 1, 1); } - +{ + if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then + glColor3f(1, 1, 1); +} MaxX := W-1; MaxY := (H-1) / 2; @@ -211,16 +204,15 @@ begin; Sound.UnlockAnalysisBuffer(); end; - - procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); var - Count: integer; + Count: integer; begin glEnable(GL_BLEND); glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); glBegin(GL_LINES); - for Count := 0 to 9 do begin + for Count := 0 to 9 do + begin glVertex2f(Left, Top + Count * Space); glVertex2f(Right, Top + Count * Space); end; @@ -230,13 +222,14 @@ end; procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer); var - Count: integer; - TempR: real; + Count: integer; + TempR: real; begin TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); glEnable(GL_BLEND); glBegin(GL_LINES); - for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do begin + for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do + begin if (Count mod Lines[NrLines].Resolution) = Lines[NrLines].NotesGAP then glColor4f(0, 0, 0, 1) else @@ -251,18 +244,17 @@ end; // draw blank Notebars procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); var - Rec: TRecR; - Count: integer; - TempR: real; + Rec: TRecR; + Count: integer; + TempR: real; - PlayerNumber: Integer; + PlayerNumber: integer; - GoldenStarPos : real; - - lTmpA , - lTmpB : real; + GoldenStarPos: real; + + lTmpA, lTmpB : real; begin -// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it's always set to zero +// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it is always set to zero // So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero // This could also come quite in handy when we do the duet mode, cause just the notes for the player that has to sing should be drawn then // BUT this is not implemented yet, all notes are drawn! :D @@ -280,23 +272,19 @@ begin lTmpA := (Right-Left); lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - if ( lTmpA > 0 ) AND - ( lTmpB > 0 ) THEN - begin - TempR := lTmpA / lTmpB; - end + if ( lTmpA > 0 ) and ( lTmpB > 0 ) then + TempR := lTmpA / lTmpB else - begin TempR := 0; - end; - - - with Lines[NrLines].Line[Lines[NrLines].Current] do begin - for Count := 0 to HighNote do begin - with Note[Count] do begin - if NoteType <> ntFreestyle then begin - + with Lines[NrLines].Line[Lines[NrLines].Current] do + begin + for Count := 0 to HighNote do + begin + with Note[Count] do + begin + if NoteType <> ntFreestyle then + begin if Ini.EffectSing = 0 then // If Golden note Effect of then Change not Color begin @@ -307,9 +295,9 @@ begin end //Else all Notes same Color else glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself - // Czesci == teil, element == piece, element | koniec == end / ending - // lewa czesc - left part - Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; + + // left part + Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; Rec.Right := Rec.Left + NotesW; Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; Rec.Bottom := Rec.Top + 2 * NotesH; @@ -326,8 +314,8 @@ begin //done // middle part - Rec.Left := Rec.Right; - Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == length + Rec.Left := Rec.Right; + Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum); glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); @@ -340,7 +328,7 @@ begin glEnd; // right part - Rec.Left := Rec.Right; + Rec.Left := Rec.Right; Rec.Right := Rec.Right + NotesW; glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum); @@ -352,7 +340,7 @@ begin glEnd; // Golden Star Patch - if (NoteType = ntGolden) AND (Ini.EffectSing=1) then + if (NoteType = ntGolden) and (Ini.EffectSing=1) then begin GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); end; @@ -366,22 +354,23 @@ begin glDisable(GL_TEXTURE_2D); end; - // draw sung notes procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer); var TempR: real; Rec: TRecR; N: integer; - //R, G, B, A: real; +// R, G, B, A: real; NotesH2: real; begin //Log.LogStatus('Player notes', 'SingDraw'); - - //if NrGracza = 0 then LoadColor(R, G, B, 'P1Light') - //else LoadColor(R, G, B, 'P2Light'); - - //R := 71/255; +{ + if NrGracza = 0 then + LoadColor(R, G, B, 'P1Light') + else + LoadColor(R, G, B, 'P2Light'); +} + //R := 71/255; //G := 175/255; //B := 247/255; @@ -398,7 +387,7 @@ begin with Player[PlayerIndex].Note[N] do begin // Left part of note - Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX; + Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX; Rec.Right := Rec.Left + NotesW; // Draw it in half size, if not hit @@ -412,7 +401,7 @@ begin end; Rec.Top := Y - (Tone-Lines[0].Line[Lines[0].Current].BaseNote)*Space/2 - NotesH2; - Rec.Bottom := Rec.Top + 2 *NotesH2; + Rec.Bottom := Rec.Top + 2 * NotesH2; // draw the left part glColor3f(1, 1, 1); @@ -425,10 +414,10 @@ begin glEnd; // Middle part of the note - Rec.Left := Rec.Right; + Rec.Left := Rec.Right; Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX; - // (nowe) - dunno + // new if (Start+Length-1 = LyricsState.CurrentBeatD) then Rec.Right := Rec.Right - (1-Frac(LyricsState.MidBeatD)) * TempR; // the left note is more right than the right note itself, sounds weird - so we fix that xD @@ -448,7 +437,7 @@ begin glColor3f(1, 1, 1); // the right part of the note - Rec.Left := Rec.Right; + Rec.Left := Rec.Right; Rec.Right := Rec.Right + NotesW; glBindTexture(GL_TEXTURE_2D, Tex_Right[PlayerIndex+1].TexNum); @@ -485,14 +474,12 @@ end; //draw Note glow procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer); var - Rec: TRecR; - Count: integer; - TempR: real; + Rec: TRecR; + Count: integer; + TempR: real; X1, X2, X3, X4: real; - W, H: real; - - lTmpA , - lTmpB : real; + W, H: real; + lTmpA, lTmpB: real; begin if (Player[PlayerIndex].ScoreTotalInt >= 0) then begin @@ -504,15 +491,10 @@ begin lTmpA := (Right-Left); lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - if ( lTmpA > 0 ) and - ( lTmpB > 0 ) then - begin - TempR := lTmpA / lTmpB; - end + if ( lTmpA > 0 ) and ( lTmpB > 0 ) then + TempR := lTmpA / lTmpB else - begin TempR := 0; - end; with Lines[NrLines].Line[Lines[NrLines].Current] do begin @@ -527,14 +509,14 @@ begin W := NotesW * 2 + 2; H := NotesH * 1.5 + 3.5; - X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie + X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; X1 := X2-W; - X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie + X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4; X4 := X3+W; // left - Rec.Left := X1; + Rec.Left := X1; Rec.Right := X2; Rec.Top := Top - (Tone-BaseNote)*Space/2 - H; Rec.Bottom := Rec.Top + 2 * H; @@ -547,8 +529,8 @@ begin glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; - // srodkowa czesc - Rec.Left := X2; + // middle part + Rec.Left := X2; Rec.Right := X3; glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[PlayerIndex+1].TexNum); @@ -559,8 +541,8 @@ begin glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; - // prawa czesc - Rec.Left := X3; + // right part + Rec.Left := X3; Rec.Right := X4; glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[PlayerIndex+1].TexNum); @@ -608,7 +590,7 @@ begin // FIXME: accessing ScreenSing is not that generic LyricEngine := ScreenSing.Lyrics; - + // do not draw the lyrics helper if the current line does not contain any note if (Length(CurLine.Note) > 0) then begin @@ -696,27 +678,25 @@ begin // FIXME: accessing ScreenSing is not that generic LyricEngine := ScreenSing.Lyrics; - // background //BG Fullsize Mod - //SingDrawBackground; - // draw time-bar SingDrawTimeBar(); // draw note-lines if (PlayersPlay = 1) and (Ini.NoteLines = 1) then - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); end; - if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); + if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then + begin + SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12); + SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12); + SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12); end; // draw Lyrics @@ -724,39 +704,48 @@ begin SingDrawLyricHelper(NR.Left, NR.WMid); // oscilloscope - if Ini.Oscilloscope = 1 then begin + if Ini.Oscilloscope = 1 then + begin if PlayersPlay = 1 then SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - if PlayersPlay = 2 then begin + if PlayersPlay = 2 then + begin SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); end; - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin + if PlayersPlay = 4 then + begin + if ScreenAct = 1 then + begin SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3); end; end; - if PlayersPlay = 3 then begin - SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); + if PlayersPlay = 3 then + begin + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); end; - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin + if PlayersPlay = 6 then + begin + if ScreenAct = 1 then + begin SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4); SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5); @@ -785,104 +774,121 @@ begin end; // Draw the Notes - if PlayersPlay = 1 then begin + if PlayersPlay = 1 then + begin SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 0, 15); // imho the sung notes end; - if (PlayersPlay = 2) then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + if PlayersPlay = 2 then + begin + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); end; - if PlayersPlay = 3 then begin + if PlayersPlay = 3 then + begin NotesW := NotesW * 0.8; NotesH := NotesH * 0.8; - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); end; - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + if PlayersPlay = 4 then + begin + if ScreenAct = 1 then + begin + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); end; - if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + if ScreenAct = 2 then + begin + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 2, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 3, 15); end; - if ScreenAct = 1 then begin + if ScreenAct = 1 then + begin SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); end; - if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + if ScreenAct = 1 then + begin + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); end; - if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); + if ScreenAct = 2 then + begin + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 2, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 3, 15); end; end; - if PlayersPlay = 6 then begin + if PlayersPlay = 6 then + begin NotesW := NotesW * 0.8; NotesH := NotesH * 0.8; - if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + if ScreenAct = 1 then + begin + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); end; - if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + if ScreenAct = 2 then + begin + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 3, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 4, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 5, 12); end; - if ScreenAct = 1 then begin + if ScreenAct = 1 then + begin SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); end; - if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + if ScreenAct = 1 then + begin + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); end; - if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); + if ScreenAct = 2 then + begin + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 3, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 4, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 5, 12); end; end; glDisable(GL_BLEND); @@ -892,12 +898,15 @@ end; // q'n'd for using the game mode dll's procedure SingModiDraw (PlayerInfo: TPlayerInfo); var - NR: TRecR; + NR: TRecR; begin // positions - if Ini.SingWindow = 0 then begin + if Ini.SingWindow = 0 then + begin NR.Left := 120; - end else begin + end + else + begin NR.Left := 20; end; @@ -912,16 +921,18 @@ begin if DLLMan.Selected.ShowNotes then begin if PlayersPlay = 1 then - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); - if (PlayersPlay = 2) or (PlayersPlay = 4) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); + if (PlayersPlay = 2) or (PlayersPlay = 4) then + begin + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); end; - if (PlayersPlay = 3) or (PlayersPlay = 6) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); + if (PlayersPlay = 3) or (PlayersPlay = 6) then + begin + SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12); + SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12); + SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12); end; end; @@ -930,26 +941,31 @@ begin // TODO: Lyrics helper // oscilloscope | the thing that moves when you yell into your mic (imho) - if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then begin + if (((Ini.Oscilloscope = 1) and (DLLMan.Selected.ShowRateBar_O)) and (not DLLMan.Selected.ShowRateBar)) then + begin if PlayersPlay = 1 then if PlayerInfo.Playerinfo[0].Enabled then SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - if PlayersPlay = 2 then begin + if PlayersPlay = 2 then + begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); if PlayerInfo.Playerinfo[1].Enabled then SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); end; - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin + if PlayersPlay = 4 then + begin + if ScreenAct = 1 then + begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); if PlayerInfo.Playerinfo[1].Enabled then SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin if PlayerInfo.Playerinfo[2].Enabled then SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); if PlayerInfo.Playerinfo[3].Enabled then @@ -957,17 +973,20 @@ begin end; end; - if PlayersPlay = 3 then begin + if PlayersPlay = 3 then + begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); if PlayerInfo.Playerinfo[1].Enabled then SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); if PlayerInfo.Playerinfo[2].Enabled then SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); end; - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin + if PlayersPlay = 6 then + begin + if ScreenAct = 1 then + begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); if PlayerInfo.Playerinfo[1].Enabled then @@ -975,7 +994,8 @@ begin if PlayerInfo.Playerinfo[2].Enabled then SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin if PlayerInfo.Playerinfo[3].Enabled then SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); if PlayerInfo.Playerinfo[4].Enabled then @@ -1006,107 +1026,120 @@ begin end; end; - if (DLLMAn.Selected.ShowNotes And DLLMan.Selected.LoadSong) then + if (DLLMAn.Selected.ShowNotes and DLLMan.Selected.LoadSong) then begin - if (PlayersPlay = 1) And PlayerInfo.Playerinfo[0].Enabled then begin + if (PlayersPlay = 1) and PlayerInfo.Playerinfo[0].Enabled then + begin SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 0, 15); end; - if (PlayersPlay = 2) then begin + if PlayersPlay = 2 then + begin if PlayerInfo.Playerinfo[0].Enabled then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); end; if PlayerInfo.Playerinfo[1].Enabled then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); end; end; - if PlayersPlay = 3 then begin + if PlayersPlay = 3 then + begin NotesW := NotesW * 0.8; NotesH := NotesH * 0.8; if PlayerInfo.Playerinfo[0].Enabled then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); end; if PlayerInfo.Playerinfo[1].Enabled then begin - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); end; if PlayerInfo.Playerinfo[2].Enabled then begin - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); end; end; - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + if PlayersPlay = 4 then + begin + if ScreenAct = 1 then + begin + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); end; - if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + if ScreenAct = 2 then + begin + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 2, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 3, 15); end; SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + if ScreenAct = 1 then + begin + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); end; - if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); + if ScreenAct = 2 then + begin + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 2, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 3, 15); end; end; - if PlayersPlay = 6 then begin + if PlayersPlay = 6 then + begin NotesW := NotesW * 0.8; NotesH := NotesH * 0.8; - if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + if ScreenAct = 1 then + begin + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); end; - if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + if ScreenAct = 2 then + begin + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 3, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 4, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 5, 12); end; SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + if ScreenAct = 1 then + begin + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); end; - if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); + if ScreenAct = 2 then + begin + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 3, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 4, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 5, 12); end; end; end; @@ -1115,15 +1148,14 @@ begin glDisable(GL_TEXTURE_2D); end; - {//SingBar Mod procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); var - R: Real; - G: Real; - B: Real; - A: cardinal; - I: Integer; + R: real; + G: real; + B: real; + A: cardinal; + I: integer; begin; @@ -1141,7 +1173,7 @@ begin; glEnd; //SingBar coloured Bar - Case Percent of + case Percent of 0..22: begin R := 1; G := 0; @@ -1167,7 +1199,7 @@ begin; G := 1; B := 0; end; - End; //Case + end; //case glColor4f(R, G, B, 1); glEnable(GL_TEXTURE_2D); @@ -1198,99 +1230,103 @@ end; //end Singbar Mod //PhrasenBonus - Line Bonus Pop Up -procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); +procedure SingDrawLineBonus(const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: integer); var -Length, X2: Real; //Length of Text -Size: Integer; //Size of Popup -begin -if Alpha <> 0 then + Length, X2: real; //Length of Text + Size: integer; //Size of Popup begin + if Alpha <> 0 then + begin //Set Font Propertys -SetFontStyle(2); //Font: Outlined1 -if Age < 5 then SetFontSize((Age + 1) * 3) else SetFontSize(18); -SetFontItalic(False); + SetFontStyle(2); //Font: Outlined1 + if Age < 5 then + SetFontSize((Age + 1) * 3) + else + SetFontSize(18); + SetFontItalic(False); //Check Font Size -Length := glTextWidth (Text) + 3; //Little Space for a Better Look ^^ + Length := glTextWidth (Text) + 3; //Little Space for a Better Look ^^ //Text -SetFontPos (X + 50 - (Length / 2), Y + 12); //Position + SetFontPos (X + 50 - (Length / 2), Y + 12); //Position + if Age < 5 then + Size := Age * 10 + else + Size := 50; -if Age < 5 then Size := Age * 10 else Size := 50; - - //Draw Background - //glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color - glColor4f(1, 1, 1, Alpha); - - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - //glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - +//Draw Background +// glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color + glColor4f(1, 1, 1, Alpha); - //New Method, Not Variable - glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); +// glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); - glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2)); - glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2)); - glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2)); - glEnd; +//New Method, Not Variable + glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum); - glColor4f(1, 1, 1, Alpha); //Set Color - //Draw Text - glPrint (Text); -end; + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); + glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2)); + glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2)); + glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2)); + glEnd; + + glColor4f(1, 1, 1, Alpha); //Set Color +//Draw Text + glPrint (Text); + end; end; //PhrasenBonus - Line Bonus Mod} // Draw Note Bars for Editor -//There are 11 Resons for a new Procdedure: (nice binary :D ) -// 1. It don't look good when you Draw the Golden Note Star Effect in the Editor -// 2. You can see the Freestyle Notes in the Editor SemiTransparent -// 3. Its easier and Faster then changing the old Procedure +// There are 11 reasons for a new procedure: (nice binary :D ) +// 1. It does not look good when you draw the golden note star effect in the editor +// 2. You can see the freestyle notes in the editor semitransparent +// 3. It is easier and faster then changing the old procedure procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); var - Rec: TRecR; - Count: integer; - TempR: real; + Rec: TRecR; + Count: integer; + TempR: real; begin glColor3f(1, 1, 1); glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - with Lines[NrLines].Line[Lines[NrLines].Current] do begin - for Count := 0 to HighNote do begin - with Note[Count] do begin - - // Golden Note Patch - case NoteType of - ntFreestyle: glColor4f(1, 1, 1, 0.35); - ntNormal: glColor4f(1, 1, 1, 0.85); - ntGolden: Glcolor4f(1, 1, 0.3, 0.85); - end; // case - + with Lines[NrLines].Line[Lines[NrLines].Current] do + begin + for Count := 0 to HighNote do + begin + with Note[Count] do + begin + // Golden Note Patch + case NoteType of + ntFreestyle: glColor4f(1, 1, 1, 0.35); + ntNormal: glColor4f(1, 1, 1, 0.85); + ntGolden: Glcolor4f(1, 1, 0.3, 0.85); + end; // case - // lewa czesc - left part - Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; - Rec.Bottom := Rec.Top + 2 * NotesH; - glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; + // left part + Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; + Rec.Bottom := Rec.Top + 2 * NotesH; + glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; - // srodkowa czesc - middle part - Rec.Left := Rec.Right; + // middle part + Rec.Left := Rec.Right; Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); @@ -1301,8 +1337,8 @@ begin glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; - // prawa czesc - right part - Rec.Left := Rec.Right; + // right part + Rec.Left := Rec.Right; Rec.Right := Rec.Right + NotesW; glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum); @@ -1323,7 +1359,7 @@ end; procedure SingDrawTimeBar(); var - x,y: real; + x, y: real; width, height: real; LyricsProgress: real; CurLyricsTime: real; diff --git a/unicode/src/base/UEditorLyrics.pas b/unicode/src/base/UEditorLyrics.pas index d06fc891..fe8c3ee5 100644 --- a/unicode/src/base/UEditorLyrics.pas +++ b/unicode/src/base/UEditorLyrics.pas @@ -40,48 +40,50 @@ uses UTexture; type + alignment = (left, center, right); + TWord = record - X: real; - Y: real; - Size: real; - Width: real; - Text: string; - ColR: real; - ColG: real; - ColB: real; - FontStyle: integer; - Italic: boolean; - Selected: boolean; + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; end; TEditorLyrics = class private - AlignI: integer; - XR: real; - YR: real; - SizeR: real; - SelectedI: integer; - FontStyleI: integer; // font number - Word: array of TWord; + AlignI: alignment; + XR: real; + YR: real; + SizeR: real; + SelectedI: integer; + FontStyleI: integer; // font number + Word: array of TWord; procedure SetX(Value: real); procedure SetY(Value: real); function GetClientX: real; - procedure SetAlign(Value: integer); + procedure SetAlign(Value: alignment); function GetSize: real; procedure SetSize(Value: real); procedure SetSelected(Value: integer); - procedure SetFStyle(Value: integer); + procedure SetFontStyle(Value: integer); procedure AddWord(Text: string); procedure Refresh; public - ColR: real; - ColG: real; - ColB: real; - ColSR: real; - ColSG: real; - ColSB: real; - Italic: boolean; + ColR: real; + ColG: real; + ColB: real; + ColSR: real; + ColSG: real; + ColSB: real; + Italic: boolean; constructor Create; destructor Destroy; override; @@ -94,16 +96,20 @@ type property X: real write SetX; property Y: real write SetY; property ClientX: real read GetClientX; - property Align: integer write SetAlign; + property Align: alignment write SetAlign; property Size: real read GetSize write SetSize; property Selected: integer read SelectedI write SetSelected; - property FontStyle: integer write SetFStyle; + property FontStyle: integer write SetFontStyle; end; implementation uses - TextGL, UGraphic, UDrawTexture, Math, USkins; + TextGL, + UGraphic, + UDrawTexture, + Math, + USkins; constructor TEditorLyrics.Create; begin @@ -131,7 +137,7 @@ begin Result := Word[0].X; end; -procedure TEditorLyrics.SetAlign(Value: integer); +procedure TEditorLyrics.SetAlign(Value: alignment); begin AlignI := Value; end; @@ -148,7 +154,7 @@ end; procedure TEditorLyrics.SetSelected(Value: integer); begin - if (SelectedI > -1) and (SelectedI <= High(Word)) then + if (-1 < SelectedI) and (SelectedI <= High(Word)) then begin Word[SelectedI].Selected := false; Word[SelectedI].ColR := ColR; @@ -157,7 +163,7 @@ begin end; SelectedI := Value; - if (Value > -1) and (Value <= High(Word)) then + if (-1 < Value) and (Value <= High(Word)) then begin Word[Value].Selected := true; Word[Value].ColR := ColSR; @@ -168,22 +174,21 @@ begin Refresh; end; -procedure TEditorLyrics.SetFStyle(Value: integer); +procedure TEditorLyrics.SetFontStyle(Value: integer); begin FontStyleI := Value; end; procedure TEditorLyrics.AddWord(Text: string); var - WordNum: integer; + WordNum: integer; begin WordNum := Length(Word); SetLength(Word, WordNum + 1); - if WordNum = 0 then begin - Word[WordNum].X := XR; - end else begin + if WordNum = 0 then + Word[WordNum].X := XR + else Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; - end; Word[WordNum].Y := YR; Word[WordNum].Size := SizeR; @@ -202,12 +207,13 @@ end; procedure TEditorLyrics.AddLine(NrLine: integer); var - N: integer; + NoteIndex: integer; begin Clear; - for N := 0 to Lines[0].Line[NrLine].HighNote do begin - Italic := Lines[0].Line[NrLine].Note[N].NoteType = ntFreestyle; - AddWord(Lines[0].Line[NrLine].Note[N].Text); + for NoteIndex := 0 to Lines[0].Line[NrLine].HighNote do + begin + Italic := Lines[0].Line[NrLine].Note[NoteIndex].NoteType = ntFreestyle; + AddWord(Lines[0].Line[NrLine].Note[NoteIndex].Text); end; Selected := -1; end; @@ -220,32 +226,33 @@ end; procedure TEditorLyrics.Refresh; var - W: integer; - TotWidth: real; + WordIndex: integer; + TotalWidth: real; begin - if AlignI = 1 then begin - TotWidth := 0; - for W := 0 to High(Word) do - TotWidth := TotWidth + Word[W].Width; - - Word[0].X := XR - TotWidth / 2; - for W := 1 to High(Word) do - Word[W].X := Word[W - 1].X + Word[W - 1].Width; + if AlignI = center then + begin + TotalWidth := 0; + for WordIndex := 0 to High(Word) do + TotalWidth := TotalWidth + Word[WordIndex].Width; + + Word[0].X := XR - TotalWidth / 2; + for WordIndex := 1 to High(Word) do + Word[WordIndex].X := Word[WordIndex - 1].X + Word[WordIndex - 1].Width; end; end; procedure TEditorLyrics.Draw; var - W: integer; + WordIndex: integer; begin - for W := 0 to High(Word) do + for WordIndex := 0 to High(Word) do begin - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(Word[W].Text); + SetFontStyle(Word[WordIndex].FontStyle); + SetFontPos(Word[WordIndex].X + 10*ScreenX, Word[WordIndex].Y); + SetFontSize(Word[WordIndex].Size); + SetFontItalic(Word[WordIndex].Italic); + glColor3f(Word[WordIndex].ColR, Word[WordIndex].ColG, Word[WordIndex].ColB); + glPrint(Word[WordIndex].Text); end; end; diff --git a/unicode/src/base/UFiles.pas b/unicode/src/base/UFiles.pas index 463801c7..ee6f660a 100644 --- a/unicode/src/base/UFiles.pas +++ b/unicode/src/base/UFiles.pas @@ -58,8 +58,8 @@ implementation uses TextGL, UIni, - UPlatform, - UMain; + UNote, + UPlatform; //-------------------- // Resets the temporary Sentence Arrays for each Player and some other Variables @@ -73,7 +73,6 @@ begin SetLength(Lines[Count].Line, 1); SetLength(Lines[Count].Line[0].Note, 0); Lines[Count].Line[0].Lyric := ''; - Lines[Count].Line[0].LyricWidth := 0; Player[Count].Score := 0; Player[Count].LengthNote := 0; Player[Count].HighNote := -1; diff --git a/unicode/src/base/UGraphic.pas b/unicode/src/base/UGraphic.pas index b525c170..17175d02 100644 --- a/unicode/src/base/UGraphic.pas +++ b/unicode/src/base/UGraphic.pas @@ -280,11 +280,12 @@ function LoadingThreadFunction: integer; implementation uses + Classes, UMain, UIni, UDisplay, UCommandLine, - Classes; + UPath; procedure LoadFontTextures; begin @@ -294,17 +295,19 @@ end; procedure LoadTextures; - var - P: integer; - R, G, B: real; - Col: integer; + P: integer; + R, G, B: real; + Col: integer; begin Log.LogStatus('Loading Textures', 'LoadTextures'); - - Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch? - Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); //brauch man die noch? - Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch? + + // FIXME: do we need this? (REMOVE otherwise) + Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); + // FIXME: do we need this? (REMOVE otherwise) + Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); + // FIXME: do we need this? (REMOVE otherwise) + Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); Log.LogStatus('Loading Textures - A', 'LoadTextures'); diff --git a/unicode/src/base/UGraphicClasses.pas b/unicode/src/base/UGraphicClasses.pas index 3fbe262f..cdaa238e 100644 --- a/unicode/src/base/UGraphicClasses.pas +++ b/unicode/src/base/UGraphicClasses.pas @@ -124,16 +124,16 @@ var implementation uses - sysutils, + SysUtils, + Math, gl, + UCommon, + UDrawTexture, + UGraphic, UIni, - UMain, - UThemes, + UNote, USkins, - UGraphic, - UDrawTexture, - UCommon, - math; + UThemes; //TParticle constructor TParticle.Create(cX, cY : real; diff --git a/unicode/src/base/UHooks.pas b/unicode/src/base/UHooks.pas index ab830090..acf2bba7 100644 --- a/unicode/src/base/UHooks.pas +++ b/unicode/src/base/UHooks.pas @@ -46,23 +46,23 @@ type //Record that saves info from Subscriber PSubscriberInfo = ^TSubscriberInfo; TSubscriberInfo = record - Self: THandle; //ID of this Subscription (First word: ID of Subscription; 2nd word: ID of Hook) - Next: PSubscriberInfo; //Pointer to next Item in HookChain + Self: THandle; // ID of this Subscription (First word: ID of Subscription; 2nd word: ID of Hook) + Next: PSubscriberInfo; // Pointer to next Item in HookChain Owner: integer; //For Error Handling and Plugin Unloading. - //Here is s/t tricky - //To avoid writing of Wrapping Functions to Hook an Event with a Class - //We save a Normal Proc or a Method of a Class + // Here is s/t tricky + // To avoid writing of Wrapping Functions to Hook an Event with a Class + // We save a Normal Proc or a Method of a Class case isClass: boolean of - False: (Proc: TUS_Hook); //Proc that will be called on Event - True: (ProcOfClass: TUS_Hook_of_Object); + false: (Proc: TUS_Hook); //Proc that will be called on Event + true: (ProcOfClass: TUS_Hook_of_Object); end; TEventInfo = record - Name: string[60]; //Name of Event - FirstSubscriber: PSubscriberInfo; //First subscriber in chain - LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding + Name: string[60]; // Name of Event + FirstSubscriber: PSubscriberInfo; // First subscriber in chain + LastSubscriber: PSubscriberInfo; // Last " (for easier subscriber adding) end; THookManager = class @@ -101,7 +101,8 @@ uses // Create - Creates Class and Set Standard Values //------------ constructor THookManager.Create(const SpacetoAllocate: word); -var I: integer; +var + I: integer; begin inherited Create(); @@ -121,7 +122,8 @@ end; // AddEvent - Adds an Event and return the Events Handle or 0 on Failure //------------ function THookManager.AddEvent (const EventName: Pchar): THandle; -var I: integer; +var + I: integer; begin Result := 0; @@ -177,7 +179,6 @@ begin hEvent := hEvent - 1; //Arrayindex is Handle - 1 Result := -1; - if (Length(Events) > hEvent) and (Events[hEvent].Name[1] <> chr(0)) then begin //Event exists //Free the Space for all Subscribers @@ -212,8 +213,8 @@ end; function THookManager.AddSubscriber (const EventName: Pchar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; var EventHandle: THandle; - EventIndex: Cardinal; - Cur: PSubscriberInfo; + EventIndex: integer; + Cur: PSubscriberInfo; begin Result := 0; @@ -224,7 +225,7 @@ begin if (EventHandle <> 0) then begin EventIndex := EventHandle - 1; - + //Get Memory GetMem(Cur, SizeOf(TSubscriberInfo)); @@ -236,12 +237,12 @@ begin if (@Proc = nil) then begin //Use the ProcofClass Method - Cur.isClass := True; + Cur.isClass := true; Cur.ProcOfClass := ProcofClass; end else //Use the normal Proc begin - Cur.isClass := False; + Cur.isClass := false; Cur.Proc := Proc; end; @@ -306,8 +307,8 @@ end; //------------ function THookManager.DelSubscriber (const hSubscriber: THandle): integer; var - EventIndex: Cardinal; - Cur, Last: PSubscriberInfo; + EventIndex: integer; + Cur, Last: PSubscriberInfo; begin Result := -1; EventIndex := ((hSubscriber and (High(THandle) xor High(word))) SHR 16) - 1; @@ -344,16 +345,15 @@ begin end; end; - //------------ // CallEventChain - Calls the Chain of a specified EventHandle // Returns: -1: Handle doesn't Exist, 0 Chain is called until the End //------------ function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): integer; var - EventIndex: Cardinal; - Cur: PSubscriberInfo; - CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute + EventIndex: integer; + Cur: PSubscriberInfo; + CurExecutedBackup: integer; // backup of Core.CurExecuted Attribute begin Result := -1; EventIndex := hEvent - 1; @@ -393,7 +393,7 @@ end; //------------ function THookManager.EventExists (const EventName: Pchar): integer; var - I: integer; + I: integer; Name: string[60]; begin Result := 0; @@ -418,7 +418,7 @@ end; //------------ procedure THookManager.DelbyOwner(const Owner: integer); var - I: integer; + I: integer; Cur, Last: PSubscriberInfo; begin //Search for Owner in all Hooks Chains @@ -426,7 +426,7 @@ begin begin if (Events[I].Name[1] <> chr(0)) then begin - + Last := nil; Cur := Events[I].FirstSubscriber; //Went Through Chain @@ -451,7 +451,6 @@ begin end; end; - function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; begin Result := 0; //Don't break the chain diff --git a/unicode/src/base/UImage.pas b/unicode/src/base/UImage.pas index 18b0035c..8dc38495 100644 --- a/unicode/src/base/UImage.pas +++ b/unicode/src/base/UImage.pas @@ -151,10 +151,9 @@ function LoadImage(const Filename: string): PSDL_Surface; *******************************************************) function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; -procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); -procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); -procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); - +procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal); +procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal); +procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); implementation @@ -185,7 +184,6 @@ uses UCommon, ULog; - function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean; begin Result := (pixelFmt.BitsPerPixel = 24) and @@ -266,7 +264,6 @@ begin end; end; - (******************************************************* * Image saving *******************************************************) @@ -759,12 +756,10 @@ end; {$ENDIF} - (******************************************************* * Image loading *******************************************************) - (* * Loads an image from the given file *) @@ -793,12 +788,10 @@ begin end; end; - (******************************************************* * Image manipulation *******************************************************) - function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; begin if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and @@ -814,7 +807,7 @@ begin Result := false; end; -procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal); var TempSurface: PSDL_Surface; begin @@ -825,10 +818,10 @@ begin SDL_FreeSurface(TempSurface); end; -procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal); var TempSurface: PSDL_Surface; - ImgFmt: PSDL_PixelFormat; + ImgFmt: PSDL_PixelFormat; begin TempSurface := ImgSurface; @@ -849,12 +842,12 @@ end; (* // Old slow floating point version of ColorizeTexture. // For an easier understanding of the faster fixed point version below. -procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); +procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: cardinal); var - clr: array[0..2] of Double; // [0: R, 1: G, 2: B] - hsv: array[0..2] of Double; // [0: H(ue), 1: S(aturation), 2: V(alue)] - delta, f, p, q, t: Double; - max: Double; + clr: array[0..2] of double; // [0: R, 1: G, 2: B] + hsv: array[0..2] of double; // [0: H(ue), 1: S(aturation), 2: V(alue)] + delta, f, p, q, t: double; + max: double; begin clr[0] := PixelColors[0]/255; clr[1] := PixelColors[1]/255; @@ -892,90 +885,175 @@ begin end; *) -procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); +procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); - //returns hue within range [0.0-6.0) - function col2hue(Color:Cardinal): double; + // First, the rgb colors are converted to hsv, second hue is replaced by + // the NewColor, saturation and value remain unchanged, finally this + // hsv color is converted back to rgb space. + // For the conversion algorithms of colors from rgb to hsv space + // and back simply check the wikipedia. + // In order to speed up starting time of USDX the division of reals is + // replaced by division of longwords, shifted by 10 bits to keep + // digits. + + function ColorToHue(const Color: longword): longword; + // returns hue within the range [0.0-6.0] but shl 10, ie. times 1024 var - clr: array[0..2] of double; - hue, max, delta: double; + Red, Green, Blue: longword; + Min, Max, Delta: longword; + Hue: double; begin - clr[0] := ((Color and $ff0000) shr 16)/255; // R - clr[1] := ((Color and $ff00) shr 8)/255; // G - clr[2] := (Color and $ff) /255; // B - max := maxvalue(clr); - delta := max - minvalue(clr); + // extract the colors + // division by 255 is omitted, since it is implicitly done + // when deviding by delta + Red := ((Color and $ff0000) shr 16); // R + Green := ((Color and $ff00) shr 8); // G + Blue := (Color and $ff) ; // B + + Min := Red; + if Green < Min then Min := Green; + if Blue < Min then Min := Blue; + + Max := Red; + if Green > Max then Max := Green; + if Blue > Max then Max := Blue; + // calc hue - if (delta = 0.0) then hue := 0 - else if (clr[0] = max) then hue := (clr[1]-clr[2])/delta - else if (clr[1] = max) then hue := 2.0+(clr[2]-clr[0])/delta - else if (clr[2] = max) then hue := 4.0+(clr[0]-clr[1])/delta; - if (hue < 0.0) then - hue := hue + 6.0; - Result := hue; + Delta := Max - Min; + if (Delta = 0) then + Result := 0 + else + begin + // The division by Delta is done separately afterwards. + // Necessary because Delphi did not do the type conversion from + // longword to double as expected. + if (Max = Red ) then Hue := Green - Blue + else if (Max = Green) then Hue := 2.0*Delta + Blue - Red + else if (Max = Blue ) then Hue := 4.0*Delta + Red - Green; + Hue := Hue / Delta; + if (Hue < 0.0) then + Hue := Hue + 6.0; + Result := trunc(Hue*1024); // '*1024' is shl 10 + end; end; var - DestinationHue: Double; - PixelIndex: Cardinal; + PixelIndex: longword; Pixel: PByte; PixelColors: PByteArray; - clr: array[0..2] of UInt32; // [0: R, 1: G, 2: B] - hsv: array[0..2] of UInt32; // [0: H(ue), 1: S(aturation), 2: V(alue)] - dhue: UInt32; - h_int: Cardinal; - delta, f, p, q, t: Longint; - max: Uint32; + Red, Green, Blue: longword; + Hue, Sat: longword; + Min, Max, Delta: longword; + HueInteger: longword; + f, p, q, t: longword; begin - DestinationHue := col2hue(NewColor); - - dhue := Trunc(DestinationHue*1024); Pixel := ImgSurface^.Pixels; + // check of the size of a pixel in bytes. + // It should be always 4, but this + // additional safeguard will show, + // whether something went wrong up to here. + + if ImgSurface^.format.BytesPerPixel <> 4 then + Log.LogError ('ColorizeImage: The pixel size should be 4, but it is ' + + IntToStr(ImgSurface^.format.BytesPerPixel)); + + Hue := ColorToHue(NewColor); // Hue is shl 10 + f := Hue and $3ff; // f is the dezimal part of hue + HueInteger := Hue shr 10; + for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do begin PixelColors := PByteArray(Pixel); // inlined colorize per pixel // uses fixed point math + // shl 10 is used for divisions + // get color values - clr[0] := PixelColors[0] shl 10; - clr[1] := PixelColors[1] shl 10; - clr[2] := PixelColors[2] shl 10; + + {$IFDEF FPC_BIG_ENDIAN} + Red := PixelColors[3]; + Green := PixelColors[2]; + Blue := PixelColors[1]; + // PixelColors[0] is alpha and remains untouched + {$ELSE} + Red := PixelColors[0]; + Green := PixelColors[1]; + Blue := PixelColors[2]; + // PixelColors[3] is alpha and remains untouched + {$ENDIF} + //calculate luminance and saturation from rgb - max := clr[0]; - if clr[1] > max then max := clr[1]; - if clr[2] > max then max := clr[2]; - delta := clr[0]; - if clr[1] < delta then delta := clr[1]; - if clr[2] < delta then delta := clr[2]; - delta := max-delta; - hsv[0] := dhue; // shl 8 - hsv[2] := max; // shl 8 - if (max = 0) then - hsv[1] := 0 + Max := Red; + if Green > Max then Max := Green; + if Blue > Max then Max := Blue ; + + if (Max = 0) then // the color is black + begin + {$IFDEF FPC_BIG_ENDIAN} + PixelColors[3] := 0; + PixelColors[2] := 0; + PixelColors[1] := 0; + {$ELSE} + PixelColors[0] := 0; + PixelColors[1] := 0; + PixelColors[2] := 0; + {$ENDIF} + end else - hsv[1] := (delta shl 10) div max; // shl 8 - h_int := hsv[0] and $fffffC00; - f := hsv[0]-h_int; //shl 10 - p := (hsv[2]*(1024-hsv[1])) shr 10; - q := (hsv[2]*(1024-(hsv[1]*f) shr 10)) shr 10; - t := (hsv[2]*(1024-(hsv[1]*(1024-f)) shr 10)) shr 10; - h_int := h_int shr 10; - case h_int of - 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p) - 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p) - 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t) - 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v) - 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v) - 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q) - end; + begin + Min := Red; + if Green < Min then Min := Green; + if Blue < Min then Min := Blue ; + + if (Min = 255) then // the color is white + begin + {$IFDEF FPC_BIG_ENDIAN} + PixelColors[3] := 255; + PixelColors[2] := 255; + PixelColors[1] := 255; + {$ELSE} + PixelColors[0] := 255; + PixelColors[1] := 255; + PixelColors[2] := 255; + {$ENDIF} + end + else // all colors except black and white + begin + Delta := Max - Min; + Sat := (Delta shl 10) div Max; // shl 10 + + // shr 10 corrects that sat and f are shl 10 + // the resulting p, q and t are unshifted + + p := (Max*(1024-Sat)) shr 10; + q := (Max*(1024-(Sat*f) shr 10)) shr 10; + t := (Max*(1024-(Sat*(1024-f)) shr 10)) shr 10; + + case HueInteger of + 0: begin Red := Max; Green := t; Blue := p; end; // (v,t,p) + 1: begin Red := q; Green := Max; Blue := p; end; // (q,v,p) + 2: begin Red := p; Green := Max; Blue := t; end; // (p,v,t) + 3: begin Red := p; Green := q; Blue := Max; end; // (p,q,v) + 4: begin Red := t; Green := p; Blue := Max; end; // (t,p,v) + 5: begin Red := Max; Green := p; Blue := q; end; // (v,p,q) + end; + + {$IFDEF FPC_BIG_ENDIAN} + PixelColors[3] := Red; + PixelColors[2] := Green; + PixelColors[1] := Blue + {$ELSE} + PixelColors[0] := Red; + PixelColors[1] := Green; + PixelColors[2] := Blue; + {$ENDIF} - PixelColors[0] := clr[0] shr 10; - PixelColors[1] := clr[1] shr 10; - PixelColors[2] := clr[2] shr 10; + end; + end; Inc(Pixel, ImgSurface^.format.BytesPerPixel); end; diff --git a/unicode/src/base/UIni.pas b/unicode/src/base/UIni.pas index e90ae31c..241b34e8 100644 --- a/unicode/src/base/UIni.pas +++ b/unicode/src/base/UIni.pas @@ -74,7 +74,7 @@ type function RemoveFileExt(FullName: string): string; function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; - function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: Boolean = False): integer; + function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: boolean = false): integer; function ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; IniSection: string; IniProperty: string; Default: integer): integer; @@ -99,7 +99,7 @@ type Difficulty: integer; Language: integer; Tabs: integer; - Tabs_at_startup:integer; //Tabs at Startup fix + TabsAtStartup: integer; //Tabs at Startup fix Sorting: integer; Debug: integer; @@ -107,7 +107,7 @@ type Screens: integer; Resolution: integer; Depth: integer; - VisualizerOption:integer; + VisualizerOption: integer; FullScreen: integer; TextureSize: integer; SingWindow: integer; @@ -122,8 +122,8 @@ type BeatClick: integer; SavePlayback: integer; ThresholdIndex: integer; - AudioOutputBufferSizeIndex:integer; - VoicePassthrough:integer; + AudioOutputBufferSizeIndex: integer; + VoicePassthrough: integer; //Song Preview PreviewVolume: integer; @@ -139,8 +139,8 @@ type Theme: integer; SkinNo: integer; Color: integer; - BackgroundMusicOption:integer; - + BackgroundMusicOption: integer; + // Record InputDeviceConfig: array of TInputDeviceConfig; @@ -166,22 +166,20 @@ type end; var - Ini: TIni; - IResolution: array of string; - ILanguage: array of string; - ITheme: array of string; - ISkin: array of string; - - + Ini: TIni; + IResolution: array of string; + ILanguage: array of string; + ITheme: array of string; + ISkin: array of string; const - IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); - IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 ); + IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); + IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 ); - IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); - ITabs: array[0..1] of string = ('Off', 'On'); + IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); + ITabs: array[0..1] of string = ('Off', 'On'); - ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); sEdition = 0; sGenre = 1; sLanguage = 2; @@ -191,51 +189,49 @@ const sTitle2 = 6; sArtist2 = 7; - IDebug: array[0..1] of string = ('Off', 'On'); + IDebug: array[0..1] of string = ('Off', 'On'); - IScreens: array[0..1] of string = ('1', '2'); - IFullScreen: array[0..1] of string = ('Off', 'On'); - IDepth: array[0..1] of string = ('16 bit', '32 bit'); - IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On'); + IScreens: array[0..1] of string = ('1', '2'); + IFullScreen: array[0..1] of string = ('Off', 'On'); + IDepth: array[0..1] of string = ('16 bit', '32 bit'); + IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On'); - IBackgroundMusic: array[0..1] of string = ('Off', 'On'); + IBackgroundMusic: array[0..1] of string = ('Off', 'On'); + ITextureSize: array[0..2] of string = ('128', '256', '512'); + ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512); - ITextureSize: array[0..2] of string = ('128', '256', '512'); - ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512); - - ISingWindow: array[0..1] of string = ('Small', 'Big'); + ISingWindow: array[0..1] of string = ('Small', 'Big'); //SingBar Mod - IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); -//IOscilloscope: array[0..1] of string = ('Off', 'On'); + IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); +//IOscilloscope: array[0..1] of string = ('Off', 'On'); - ISpectrum: array[0..1] of string = ('Off', 'On'); - ISpectrograph: array[0..1] of string = ('Off', 'On'); - IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + ISpectrum: array[0..1] of string = ('Off', 'On'); + ISpectrograph: array[0..1] of string = ('Off', 'On'); + IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); - IClickAssist: array[0..1] of string = ('Off', 'On'); - IBeatClick: array[0..1] of string = ('Off', 'On'); - ISavePlayback: array[0..1] of string = ('Off', 'On'); + IClickAssist: array[0..1] of string = ('Off', 'On'); + IBeatClick: array[0..1] of string = ('Off', 'On'); + ISavePlayback: array[0..1] of string = ('Off', 'On'); - IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); - IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20); + IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); + IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20); - IVoicePassthrough: array[0..1] of string = ('Off', 'On'); + IVoicePassthrough: array[0..1] of string = ('Off', 'On'); IAudioOutputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); - IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); - IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); + IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); //Song Preview - IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); - IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 ); - - IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); - IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 ); + IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 ); + IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 ); ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); ILyricsEffect: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); @@ -247,7 +243,7 @@ const // Advanced ILoadAnimation: array[0..1] of string = ('Off', 'On'); IEffectSing: array[0..1] of string = ('Off', 'On'); - IScreenFade: array[0..1] of string =('Off', 'On'); + IScreenFade: array[0..1] of string = ('Off', 'On'); IAskbeforeDel: array[0..1] of string = ('Off', 'On'); IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); @@ -270,6 +266,7 @@ uses USkins, URecord, UCommandLine, + UPath, UUnicodeUtils; (** @@ -288,17 +285,22 @@ function TIni.ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; var Value: string; Start: integer; + PrefixPos, SuffixPos: integer; begin Result := -1; - if Pos(Prefix, Key) > -1 then - begin - Start := Pos(Prefix, Key) + Length(Prefix); + PrefixPos := Pos(Prefix, Key); + if (PrefixPos <= 0) then + Exit; + SuffixPos := Pos(Suffix, Key); + if (SuffixPos <= 0) then + Exit; - // copy all between prefix and suffix - Value := Copy(Key, Start, Pos(Suffix, Key)-1 - Start); - Result := StrToIntDef(Value, -1); - end; + Start := PrefixPos + Length(Prefix); + + // copy all between prefix and suffix + Value := Copy(Key, Start, SuffixPos - Start); + Result := StrToIntDef(Value, -1); end; (** @@ -308,7 +310,7 @@ end; *) function TIni.GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; var - i: integer; + i: integer; KeyIndex: integer; begin Result := -1; @@ -326,7 +328,7 @@ end; * or -1 if Value is not in SearchArray. *) function TIni.GetArrayIndex(const SearchArray: array of string; Value: string; - CaseInsensitiv: Boolean = False): integer; + CaseInsensitiv: boolean = false): integer; var i: integer; begin @@ -362,15 +364,14 @@ begin end; end; - procedure TIni.LoadInputDeviceCfg(IniFile: TMemIniFile); var - DeviceCfg: PInputDeviceConfig; - DeviceIndex: integer; + DeviceCfg: PInputDeviceConfig; + DeviceIndex: integer; ChannelCount: integer; ChannelIndex: integer; - RecordKeys: TStringList; - i: integer; + RecordKeys: TStringList; + i: integer; begin RecordKeys := TStringList.Create(); @@ -419,15 +420,15 @@ begin RecordKeys.Free(); // MicBoost - //MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off')); + MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off')); // Threshold - // ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1])); + ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1])); end; procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile); var - DeviceIndex: integer; - ChannelIndex: integer; + DeviceIndex: integer; + ChannelIndex: integer; begin for DeviceIndex := 0 to High(InputDeviceConfig) do begin @@ -436,7 +437,7 @@ begin InputDeviceConfig[DeviceIndex].Name); IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]), InputDeviceConfig[DeviceIndex].Input); - + // Channel-to-Player Mapping for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do begin @@ -447,15 +448,15 @@ begin end; // MicBoost - //IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]); + IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]); // Threshold - //IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]); + IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]); end; procedure TIni.LoadPaths(IniFile: TCustomIniFile); var PathStrings: TStringList; - I: integer; + I: integer; begin PathStrings := TStringList.Create; IniFile.ReadSection('Directories', PathStrings); @@ -513,7 +514,7 @@ begin Theme := GetArrayIndex(ITheme, IniFile.ReadString('Themes', 'Theme', 'DELUXE'), true); if (Theme = -1) then - Theme := 0; + Theme := 0; // Skin Skin.onThemeChange; @@ -535,25 +536,25 @@ procedure TIni.LoadScreenModes(IniFile: TCustomIniFile); var Modes: PPSDL_Rect; - I: integer; + I: integer; begin // Screens Screens := GetArrayIndex(IScreens, IniFile.ReadString('Graphics', 'Screens', IScreens[0])); - + // FullScreen FullScreen := GetArrayIndex(IFullScreen, IniFile.ReadString('Graphics', 'FullScreen', 'On')); // Resolution SetLength(IResolution, 0); - + // Check if there are any modes available // TODO: we should seperate windowed and fullscreen modes. Otherwise it is not // possible to select a reasonable fullscreen mode when in windowed mode if IFullScreen[FullScreen] = 'On' then Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN) - else + else Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ; - + if (Modes = nil) then begin Log.LogStatus( 'No resolutions Found' , 'Video'); @@ -572,7 +573,7 @@ begin IResolution[7] := '1440x900'; IResolution[8] := '1600x1200'; IResolution[9] := '1680x1050'; - + Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); if Resolution = -1 then begin @@ -628,7 +629,7 @@ end; procedure TIni.Load(); var IniFile: TMemIniFile; - I: integer; + I: integer; begin GamePath := Platform.GetGameUserPath; @@ -655,24 +656,24 @@ begin NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); for I := 0 to 11 do NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); - + // Players Players := GetArrayIndex(IPlayers, IniFile.ReadString('Game', 'Players', IPlayers[0])); - + // Difficulty Difficulty := GetArrayIndex(IDifficulty, IniFile.ReadString('Game', 'Difficulty', 'Easy')); - + // Language Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English')); //Language.ChangeLanguage(ILanguage[Language]); - + // Tabs Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0])); - Tabs_at_startup := Tabs; //Tabs at Startup fix - + TabsAtStartup := Tabs; //Tabs at Startup fix + // Song Sorting Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0])); - + // Debug Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0])); @@ -710,7 +711,7 @@ begin //Preview Volume PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7])); - + //Preview Fading PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1])); @@ -778,13 +779,13 @@ begin Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0])); LoadPaths(IniFile); - + IniFile.Free; end; procedure TIni.Save; var - IniFile: TIniFile; + IniFile: TIniFile; begin if (FileExists(Filename) and FileIsReadOnly(Filename)) then begin @@ -859,7 +860,7 @@ begin // Song Preview IniFile.WriteString('Sound', 'PreviewVolume', IPreviewVolume[PreviewVolume]); - + // PreviewFading IniFile.WriteString('Sound', 'PreviewFading', IPreviewFading[PreviewFading]); diff --git a/unicode/src/base/ULanguage.pas b/unicode/src/base/ULanguage.pas index a89ded2d..f79f4165 100644 --- a/unicode/src/base/ULanguage.pas +++ b/unicode/src/base/ULanguage.pas @@ -78,7 +78,8 @@ uses IniFiles, Classes, SysUtils, - ULog; + ULog, + UPath; {** * LoadList, set default language, set standard implode glues diff --git a/unicode/src/base/ULog.pas b/unicode/src/base/ULog.pas index 582120bc..a872729a 100644 --- a/unicode/src/base/ULog.pas +++ b/unicode/src/base/ULog.pas @@ -132,7 +132,8 @@ uses UMain, UTime, UCommon, - UCommandLine; + UCommandLine, + UPath; (* * Write to console if in debug mode (Thread-safe). diff --git a/unicode/src/base/UMain.pas b/unicode/src/base/UMain.pas index ce25d16e..8d11b91d 100644 --- a/unicode/src/base/UMain.pas +++ b/unicode/src/base/UMain.pas @@ -35,109 +35,15 @@ interface uses SysUtils, - Classes, - SDL, - UMusic, - URecord, - UTime, - UDisplay, - UIni, - ULog, - ULyrics, - UScreenSing, - USong, - gl; - -type - PPLayerNote = ^TPlayerNote; - TPlayerNote = record - Start: integer; - Length: integer; - Detect: real; // accurate place, detected in the note - Tone: real; - Perfect: boolean; // true if the note matches the original one, lit the star - Hit: boolean; // true if the note Hits the Line - end; - - PPLayer = ^TPlayer; - TPlayer = record - Name: string; - - // Index in Teaminfo record - TeamID: Byte; - PlayerID: Byte; - - // Scores - Score: real; - ScoreLine: real; - ScoreGolden: real; - - ScoreInt: integer; - ScoreLineInt: integer; - ScoreGoldenInt: integer; - ScoreTotalInt: integer; - - // LineBonus - ScoreLast: Real;//Last Line Score - - // PerfectLineTwinkle (effect) - LastSentencePerfect: Boolean; - - HighNote: integer; // index of last note (= High(Note)?) - LengthNote: integer; // number of notes (= Length(Note)?). - Note: array of TPlayerNote; - end; - + SDL; var - // Absolute Paths - GamePath: string; - SoundPath: string; - SongPaths: TStringList; - LogPath: string; - ThemePath: string; - SkinsPath: string; - ScreenshotsPath: string; - CoverPaths: TStringList; - LanguagesPath: string; - PluginPath: string; - VisualsPath: string; - FontPath: string; - ResourcesPath: string; - PlayListPath: string; - - Done: Boolean; - // FIXME: ConversionFileName should not be global - ConversionFileName: string; - Restart: boolean; - - // player and music info - Player: array of TPlayer; - PlayersPlay: integer; - - CurrentSong : TSong; - -const - MAX_SONG_SCORE = 10000; // max. achievable points per song - MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song - - -function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; -procedure InitializePaths; -procedure AddSongPath(const Path: string); + Done: boolean; + Restart: boolean; procedure Main; procedure MainLoop; procedure CheckEvents; -procedure Sing(Screen: TScreenSing); -procedure NewSentence(Screen: TScreenSing); -procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click -procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection -procedure NewNote(Screen: TScreenSing); // detect note -function GetMidBeat(Time: real): real; -function GetTimeFromBeat(Beat: integer): real; -procedure ClearScores(PlayerNum: integer); - type TMainThreadExecProc = procedure(Data: Pointer); @@ -155,48 +61,51 @@ const *} procedure MainThreadExec(Proc: TMainThreadExecProc; Data: Pointer); - implementation uses Math, - StrUtils, - USongs, - UJoystick, + gl, +{ + SDL_ttf, + UParty, + UCore, +} + UCatCovers, UCommandLine, - ULanguage, - //SDL_ttf, - USkins, + UCommon, + UConfig, UCovers, - UCatCovers, UDataBase, - UPlaylist, + UDisplay, UDLLManager, - UParty, - UConfig, - UCore, - UCommon, UGraphic, UGraphicClasses, - UPluginDefs, + UIni, + UJoystick, + ULanguage, + ULog, + UPath, + UPlaylist, + UMusic, UPlatform, - UThemes; - - - + USkins, + USongs, + UThemes, + UTime; procedure Main; var - WndTitle: string; + WindowTitle: string; begin {$IFNDEF Debug} try {$ENDIF} - WndTitle := USDXVersionStr; + WindowTitle := USDXVersionStr; Platform.Init; - if Platform.TerminateIfAlreadyRunning(WndTitle) then + if Platform.TerminateIfAlreadyRunning(WindowTitle) then Exit; // fix floating-point exceptions (FPE) @@ -210,11 +119,11 @@ begin DecimalSeparator := '.'; //------------------------------ - //StartUp - Create Classes and Load Files + // StartUp - create classes and load files //------------------------------ - // Initialize SDL - // Without SDL_INIT_TIMER SDL_GetTicks() might return strange values + // initialize SDL + // without SDL_INIT_TIMER SDL_GetTicks() might return strange values SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER); SDL_EnableUnicode(1); @@ -226,7 +135,7 @@ begin // Log + Benchmark Log := TLog.Create; - Log.Title := WndTitle; + Log.Title := WindowTitle; Log.FileOutputEnabled := not Params.NoLog; Log.BenchmarkStart(0); @@ -237,19 +146,19 @@ begin Log.LogStatus('Load Language', 'Initialization'); Language := TLanguage.Create; - // Add Const Values: + // add const values: Language.AddConst('US_VERSION', USDXVersionStr); Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Language', 1); - { +{ // SDL_ttf (Not used yet, maybe in version 1.5) Log.BenchmarkStart(1); Log.LogStatus('Initialize SDL_ttf', 'Initialization'); TTF_Init(); Log.BenchmarkEnd(1); Log.LogBenchmark('Initializing SDL_ttf', 1); - } +} // Skin Log.BenchmarkStart(1); @@ -264,7 +173,7 @@ begin Ini := TIni.Create; Ini.Load; - //it's possible that this is the first run, create a .ini file if neccessary + // it is possible that this is the first run, create a .ini file if neccessary Log.LogStatus('Write Ini', 'Initialization'); Ini.Save; @@ -327,18 +236,19 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading PluginManager', 1); - {// Party Mode Manager +{ + // Party Mode Manager Log.BenchmarkStart(1); Log.LogStatus('PartySession Manager', 'Initialization'); PartySession := TPartySession.Create; //Load PartySession - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PartySession Manager', 1); } + Log.LogBenchmark('Loading PartySession Manager', 1); +} // Graphics Log.BenchmarkStart(1); Log.LogStatus('Initialize 3D', 'Initialization'); - Initialize3D(WndTitle); + Initialize3D(WindowTitle); Log.BenchmarkEnd(1); Log.LogBenchmark('Initializing 3D', 1); @@ -370,7 +280,7 @@ begin Log.LogBenchmark('Loading Particle System', 1); // Joypad - if (Ini.Joypad = 1) OR (Params.Joypad) then + if (Ini.Joypad = 1) or (Params.Joypad) then begin Log.BenchmarkStart(1); Log.LogStatus('Initialize Joystick', 'Initialization'); @@ -383,19 +293,21 @@ begin Log.LogBenchmark('Loading Time', 0); Log.LogStatus('Creating Core', 'Initialization'); - {Core := TCore.Create( +{ + Core := TCore.Create( USDXShortVersionStr, MakeVersion(USDX_VERSION_MAJOR, USDX_VERSION_MINOR, USDX_VERSION_RELEASE, chr(0)) - ); } + ); +} Log.LogStatus('Running Core', 'Initialization'); //Core.Run; //------------------------------ - //Start- Mainloop + // Start Mainloop //------------------------------ Log.LogStatus('Main Loop', 'Initialization'); MainLoop; @@ -404,12 +316,12 @@ begin finally {$ENDIF} //------------------------------ - //Finish Application + // Finish Application //------------------------------ // TODO: // call an uninitialize routine for every initialize step - // or at least use the corresponding Free-Methods + // or at least use the corresponding Free methods FinalizeMedia(); @@ -428,7 +340,7 @@ end; procedure MainLoop; var - Delay: integer; + Delay: integer; const MAX_FPS = 100; begin @@ -445,7 +357,7 @@ begin CheckEvents; // display - done := not Display.Draw; + Done := not Display.Draw; SwapBuffers; // delay @@ -466,7 +378,7 @@ begin end; end; -End; +end; procedure CheckEvents; var @@ -474,7 +386,7 @@ var begin if Assigned(Display.NextScreen) then Exit; - + while (SDL_PollEvent(@Event) <> 0) do begin case Event.type_ of @@ -482,19 +394,19 @@ begin begin Display.Fade := 0; Display.NextScreenWithCheck := nil; - Display.CheckOK := True; + Display.CheckOK := true; end; SDL_MOUSEBUTTONDOWN: begin - { +{ with Event.button do begin - if State = SDL_BUTTON_LEFT Then + if State = SDL_BUTTON_LEFT then begin // end; end; - } +} end; SDL_VIDEORESIZE: begin @@ -503,7 +415,7 @@ begin // Note: do NOT call SDL_SetVideoMode on Windows and MacOSX here. // This would create a new OpenGL render-context and all texture data // would be invalidated. - // On Linux the mode MUST be resetted, otherwise graphics will be corrupted. + // On Linux the mode MUST be reset, otherwise graphics will be corrupted. {$IF Defined(Linux) or Defined(FreeBSD)} if boolean( Ini.FullScreen ) then SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN) @@ -525,7 +437,7 @@ begin // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to // reload all texture data (-> whitescreen bug). - // Only Linux (and FreeBSD) is able to handle screen-switching this way. + // Only Linux and FreeBSD are able to handle screen-switching this way. {$IF Defined(Linux) or Defined(FreeBSD)} if boolean( Ini.FullScreen ) then begin @@ -547,16 +459,16 @@ begin // if there is a visible popup then let it handle input instead of underlying screen // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + Done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True) + Done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else begin // check if screen wants to exit - done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True); + Done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); // if screen wants to exit - if done then + if Done then begin // if question option is enabled then show exit popup if (Ini.AskbeforeDel = 1) then @@ -567,7 +479,7 @@ begin begin Display.Fade := 0; Display.NextScreenWithCheck := nil; - Display.CheckOK := True; + Display.CheckOK := true; end; end; @@ -604,573 +516,4 @@ begin SDL_PushEvent(@Event); end; -function GetTimeForBeats(BPM, Beats: real): real; -begin - Result := 60 / BPM * Beats; -end; - -function GetBeats(BPM, msTime: real): real; -begin - Result := BPM * msTime / 60; -end; - -procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); -var - NewTime: real; -begin - if High(CurrentSong.BPM) = BPMNum then - begin - // last BPM - CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); - Time := 0; - end - else - begin - // not last BPM - // count how much time is it for start of the new BPM and store it in NewTime - NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); - - // compare it to remaining time - if (Time - NewTime) > 0 then - begin - // there is still remaining time - CurBeat := CurrentSong.BPM[BPMNum].StartBeat; - Time := Time - NewTime; - end - else - begin - // there is no remaining time - CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); - Time := 0; - end; // if - end; // if -end; - -function GetMidBeat(Time: real): real; -var - CurBeat: real; - CurBPM: integer; -begin - // static BPM - if Length(CurrentSong.BPM) = 1 then - begin - Result := Time * CurrentSong.BPM[0].BPM / 60; - end - // variable BPM - else if Length(CurrentSong.BPM) > 1 then - begin - CurBeat := 0; - CurBPM := 0; - while (Time > 0) do - begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - - Result := CurBeat; - end - // invalid BPM - else - begin - Result := 0; - end; -end; - -function GetTimeFromBeat(Beat: integer): real; -var - CurBPM: integer; -begin - // static BPM - if Length(CurrentSong.BPM) = 1 then - begin - Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; - end - // variable BPM - else if Length(CurrentSong.BPM) > 1 then - begin - Result := CurrentSong.GAP / 1000; - CurBPM := 0; - while (CurBPM <= High(CurrentSong.BPM)) and - (Beat > CurrentSong.BPM[CurBPM].StartBeat) do - begin - if (CurBPM < High(CurrentSong.BPM)) and - (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then - begin - // full range - Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * - (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); - end; - - if (CurBPM = High(CurrentSong.BPM)) or - (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then - begin - // in the middle - Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * - (Beat - CurrentSong.BPM[CurBPM].StartBeat); - end; - Inc(CurBPM); - end; - - { - while (Time > 0) do - begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - } - end - // invalid BPM - else - begin - Result := 0; - end; -end; - -procedure Sing(Screen: TScreenSing); -var - Count: integer; - CountGr: integer; - CP: integer; - N: integer; -begin - LyricsState.UpdateBeats(); - - // sentences routines - for CountGr := 0 to 0 do //High(Lines) - begin; - CP := CountGr; - // old parts - LyricsState.OldLine := Lines[CP].Current; - - // choose current parts - for Count := 0 to Lines[CP].High do - begin - if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then - Lines[CP].Current := Count; - end; - - // clean player note if there is a new line - // (optimization on halfbeat time) - if Lines[CP].Current <> LyricsState.OldLine then - NewSentence(Screen); - - end; // for CountGr - - // make some operations on clicks - if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then - NewBeatClick(Screen); - - // make some operations when detecting new voice pitch - if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then - NewBeatDetect(Screen); -end; - -procedure NewSentence(Screen: TScreenSing); -var - i: Integer; -begin - // clean note of player - for i := 0 to High(Player) do - begin - Player[i].LengthNote := 0; - Player[i].HighNote := -1; - SetLength(Player[i].Note, 0); - end; - - // on sentence change... - Screen.onSentenceChange(Lines[0].Current); -end; - -procedure NewBeatClick; -var - Count: integer; -begin - // beat click - if ((Ini.BeatClick = 1) and - ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then - begin - AudioPlayback.PlaySound(SoundLib.Click); - end; - - for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do - begin - if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then - begin - // click assist - if Ini.ClickAssist = 1 then - AudioPlayback.PlaySound(SoundLib.Click); - - // drum machine - (* - TempBeat := LyricsState.CurrentBeat;// + 2; - if (TempBeat mod 8 = 0) then Music.PlayDrum; - if (TempBeat mod 8 = 4) then Music.PlayClap; - //if (TempBeat mod 4 = 2) then Music.PlayHihat; - if (TempBeat mod 4 <> 0) then Music.PlayHihat; - *) - end; - end; -end; - -procedure NewBeatDetect(Screen: TScreenSing); -begin - NewNote(Screen); -end; - -procedure NewNote(Screen: TScreenSing); -var - LineFragmentIndex: integer; - CurrentLineFragment: PLineFragment; - PlayerIndex: integer; - CurrentSound: TCaptureBuffer; - CurrentPlayer: PPlayer; - LastPlayerNote: PPlayerNote; - Line: PLine; - SentenceIndex: integer; - SentenceMin: integer; - SentenceMax: integer; - SentenceDetected: integer; // sentence of detected note - NoteAvailable: boolean; - NewNote: boolean; - Range: integer; - NoteHit: boolean; - MaxSongPoints: integer; // max. points for the song (without line bonus) - MaxLinePoints: Real; // max. points for the current line -begin - // TODO: add duet mode support - // use Lines[LineSetIndex] with LineSetIndex depending on the current player - - // count min and max sentence range for checking (detection is delayed to the notes we see on the screen) - SentenceMin := Lines[0].Current-1; - if (SentenceMin < 0) then - SentenceMin := 0; - SentenceMax := Lines[0].Current; - - // check for an active note at the current time defined in the lyrics - NoteAvailable := false; - SentenceDetected := SentenceMin; - for SentenceIndex := SentenceMin to SentenceMax do - begin - Line := @Lines[0].Line[SentenceIndex]; - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - // check if line is active - if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and - (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and - (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes - (CurrentLineFragment.Length > 0) then // and make sure the note lengths is at least 1 - begin - SentenceDetected := SentenceIndex; - NoteAvailable := true; - Break; - end; - end; - // TODO: break here, if NoteAvailable is true? We would then use the first instead - // of the last note matching the current beat if notes overlap. But notes - // should not overlap at all. - //if (NoteAvailable) then - // Break; - end; - - // analyze player signals - for PlayerIndex := 0 to PlayersPlay-1 do - begin - CurrentPlayer := @Player[PlayerIndex]; - CurrentSound := AudioInputProcessor.Sound[PlayerIndex]; - - // At the beginning of the song there is no previous note - if (Length(CurrentPlayer.Note) > 0) then - LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote] - else - LastPlayerNote := nil; - - // analyze buffer - CurrentSound.AnalyzeBuffer; - - // add some noise - // TODO: do we need this? - //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1; - - // add note if possible - if (CurrentSound.ToneValid and NoteAvailable) then - begin - Line := @Lines[0].Line[SentenceDetected]; - - // process until last note - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and - (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then - begin - // compare notes (from song-file and from player) - - // move players tone to proper octave - while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do - CurrentSound.Tone := CurrentSound.Tone - 12; - - while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do - CurrentSound.Tone := CurrentSound.Tone + 12; - - // half size notes patch - NoteHit := false; - - //if Ini.Difficulty = 0 then Range := 2; - //if Ini.Difficulty = 1 then Range := 1; - //if Ini.Difficulty = 2 then Range := 0; - Range := 2 - Ini.Difficulty; - - // check if the player hit the correct tone within the tolerated range - if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then - begin - // adjust the players tone to the correct one - // TODO: do we need to do this? - CurrentSound.Tone := CurrentLineFragment.Tone; - - // half size notes patch - NoteHit := true; - - if (Ini.LineBonus > 0) then - MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS - else - MaxSongPoints := MAX_SONG_SCORE; - - // Note: ScoreValue is the sum of all note values of the song - MaxLinePoints := MaxSongPoints / Lines[0].ScoreValue; - - // FIXME: is this correct? Why do we add the points for a whole line - // if just one note is correct? - case CurrentLineFragment.NoteType of - ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints; - ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints; - end; - - CurrentPlayer.ScoreInt := Floor(CurrentPlayer.Score / 10) * 10; - CurrentPlayer.ScoreGoldenInt := Floor(CurrentPlayer.ScoreGolden / 10) * 10; - - CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt + - CurrentPlayer.ScoreGoldenInt + - CurrentPlayer.ScoreLineInt; - end; - - end; // operation - end; // for - - // check if we have to add a new note or extend the note's length - if (SentenceDetected = SentenceMax) then - begin - // we will add a new note - NewNote := true; - - // if previous note (if any) was the same, extend prrevious note - if ((CurrentPlayer.LengthNote > 0) and - (LastPlayerNote <> nil) and - (LastPlayerNote.Tone = CurrentSound.Tone) and - ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then - begin - NewNote := false; - end; - - // if is not as new note to control - for LineFragmentIndex := 0 to Line.HighNote do - begin - if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then - NewNote := true; - end; - - // add new note - if NewNote then - begin - // new note - Inc(CurrentPlayer.LengthNote); - Inc(CurrentPlayer.HighNote); - SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote); - - // update player's last note - LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; - with LastPlayerNote^ do - begin - Start := LyricsState.CurrentBeatD; - Length := 1; - Tone := CurrentSound.Tone; // Tone || ToneAbs - Detect := LyricsState.MidBeat; - Hit := NoteHit; // half note patch - end; - end - else - begin - // extend note length - if (LastPlayerNote <> nil) then - Inc(LastPlayerNote.Length); - end; - - // check for perfect note and then lit the star (on Draw) - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - if (CurrentLineFragment.Start = LastPlayerNote.Start) and - (CurrentLineFragment.Length = LastPlayerNote.Length) and - (CurrentLineFragment.Tone = LastPlayerNote.Tone) then - begin - LastPlayerNote.Perfect := true; - end; - end; - end; // if SentenceDetected = SentenceMax - - end; // if Detected - end; // for PlayerIndex - - //Log.LogStatus('EndBeat', 'NewBeat'); - - // on sentence end -> for LineBonus and display of SingBar (rating pop-up) - if (SentenceDetected >= Low(Lines[0].Line)) and - (SentenceDetected <= High(Lines[0].Line)) then - begin - Line := @Lines[0].Line[SentenceDetected]; - CurrentLineFragment := @Line.Note[Line.HighNote]; - if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then - begin - if assigned(Screen) then - Screen.OnSentenceEnd(SentenceDetected); - end; - end; - -end; - -procedure ClearScores(PlayerNum: integer); -begin - with Player[PlayerNum] do - begin - Score := 0; - ScoreLine := 0; - ScoreGolden := 0; - - ScoreInt := 0; - ScoreLineInt := 0; - ScoreGoldenInt:= 0; - ScoreTotalInt := 0; - - ScoreLast := 0; - - LastSentencePerfect := False; - end; -end; - -procedure AddSpecialPath(var PathList: TStringList; const Path: string); -var - I: integer; - PathAbs, OldPathAbs: string; -begin - if (PathList = nil) then - PathList := TStringList.Create; - - if (Path = '') or not ForceDirectories(Path) then - Exit; - - PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path)); - - // check if path or a part of the path was already added - for I := 0 to PathList.Count-1 do - begin - OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[I])); - // check if the new directory is a sub-directory of a previously added one. - // This is also true, if both paths point to the same directories. - if (AnsiStartsText(OldPathAbs, PathAbs)) then - begin - // ignore the new path - Exit; - end; - - // check if a previously added directory is a sub-directory of the new one. - if (AnsiStartsText(PathAbs, OldPathAbs)) then - begin - // replace the old with the new one. - PathList[I] := PathAbs; - Exit; - end; - end; - - PathList.Add(PathAbs); -end; - -procedure AddSongPath(const Path: string); -begin - AddSpecialPath(SongPaths, Path); -end; - -procedure AddCoverPath(const Path: string); -begin - AddSpecialPath(CoverPaths, Path); -end; - -(** - * Initialize a path variable - * After setting paths, make sure that paths exist - *) -function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; -begin - Result := false; - - if (RequestedPath = '') then - Exit; - - // Make sure the directory exists - if (not ForceDirectories(RequestedPath)) then - begin - PathResult := ''; - Exit; - end; - - PathResult := IncludeTrailingPathDelimiter(RequestedPath); - - if (NeedsWritePermission) and - (FileIsReadOnly(RequestedPath)) then - begin - Exit; - end; - - Result := true; -end; - -(** - * Function sets all absolute paths e.g. song path and makes sure the directorys exist - *) -procedure InitializePaths; -begin - // Log directory (must be writable) - if (not FindPath(LogPath, Platform.GetLogPath, true)) then - begin - Log.FileOutputEnabled := false; - Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths'); - end; - - FindPath(SoundPath, Platform.GetGameSharedPath + 'sounds', false); - FindPath(ThemePath, Platform.GetGameSharedPath + 'themes', false); - FindPath(SkinsPath, Platform.GetGameSharedPath + 'themes', false); - FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false); - FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false); - FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false); - FindPath(FontPath, Platform.GetGameSharedPath + 'fonts', false); - FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false); - - // Playlists are not shared as we need one directory to write too - FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true); - - // Screenshot directory (must be writable) - if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then - begin - Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths'); - end; - - // Add song paths - AddSongPath(Params.SongPath); - AddSongPath(Platform.GetGameSharedPath + 'songs'); - AddSongPath(Platform.GetGameUserPath + 'songs'); - - // Add category cover paths - AddCoverPath(Platform.GetGameSharedPath + 'covers'); - AddCoverPath(Platform.GetGameUserPath + 'covers'); -end; - end. diff --git a/unicode/src/base/UMusic.pas b/unicode/src/base/UMusic.pas index 70e8d63c..19c3b942 100644 --- a/unicode/src/base/UMusic.pas +++ b/unicode/src/base/UMusic.pas @@ -35,11 +35,21 @@ interface uses UTime, + SysUtils, Classes; type TNoteType = (ntFreestyle, ntNormal, ntGolden); +const + // ScoreFactor defines how a notehit of a specified notetype is + // measured in comparison to the other types + // 0 means this notetype is not rated at all + // 2 means a hit of this notetype will be rated w/ twice as much + // points as a hit of a notetype w/ ScoreFactor 1 + ScoreFactor: array[TNoteType] of integer = (0, 1, 2); + +type (** * TLineFragment represents a fragment of a lyrics line. * This is a text-fragment (e.g. a syllable) assigned to a note pitch, @@ -63,7 +73,7 @@ type TLine = record Start: integer; // the start beat of this line (<> start beat of the first note of this line) Lyric: UTF8String; - LyricWidth: real; // @deprecated: width of the line in pixels. + //LyricWidth: real; // @deprecated: width of the line in pixels. // Do not use this as the width is not correct. // Use TLyricsEngine.GetUpperLine().Width instead. End_: integer; @@ -81,7 +91,7 @@ type *) TLines = record Current: integer; // for drawing of current line - High: integer; // (= High(Line)?) + High: integer; // = High(Line)! Number: integer; Resolution: integer; NotesGAP: integer; @@ -212,12 +222,12 @@ type TSoundEffect = class public EngineData: Pointer; // can be used for engine-specific data - procedure Callback(Buffer: PChar; BufSize: integer); virtual; abstract; + procedure Callback(Buffer: PByteArray; BufSize: integer); virtual; abstract; end; TVoiceRemoval = class(TSoundEffect) public - procedure Callback(Buffer: PChar; BufSize: integer); override; + procedure Callback(Buffer: PByteArray; BufSize: integer); override; end; type @@ -262,7 +272,7 @@ type function IsEOF(): boolean; virtual; abstract; function IsError(): boolean; virtual; abstract; public - function ReadData(Buffer: PChar; BufferSize: integer): integer; virtual; abstract; + function ReadData(Buffer: PByteArray; BufferSize: integer): integer; virtual; abstract; property EOF: boolean read IsEOF; property Error: boolean read IsError; @@ -292,7 +302,7 @@ type function GetVolume(): single; virtual; abstract; procedure SetVolume(Volume: single); virtual; abstract; function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; - procedure FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer); + procedure FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer); public (** * Opens a SourceStream for playback. @@ -335,7 +345,7 @@ type function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual; procedure Close(); override; - procedure WriteData(Buffer: PChar; BufferSize: integer); virtual; abstract; + procedure WriteData(Buffer: PByteArray; BufferSize: integer); virtual; abstract; function GetAudioFormatInfo(): TAudioFormatInfo; override; function GetLength(): real; override; @@ -468,7 +478,7 @@ type * input-buffer bytes used. * Returns the number of bytes written to the output-buffer or -1 if an error occured. *) - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; virtual; abstract; + function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; virtual; abstract; (** * Destination/Source size ratio @@ -561,13 +571,13 @@ procedure DumpMediaInterfaces(); implementation uses - sysutils, math, UIni, - UMain, + UNote, UCommandLine, URecord, - ULog; + ULog, + UPath; var DefaultVideoPlayback : IVideoPlayback; @@ -942,7 +952,7 @@ end; { TVoiceRemoval } -procedure TVoiceRemoval.Callback(Buffer: PChar; BufSize: integer); +procedure TVoiceRemoval.Callback(Buffer: PByteArray; BufSize: integer); var FrameIndex, FrameSize: integer; Value: integer; @@ -1180,7 +1190,7 @@ end; (* * Fills a buffer with copies of the given frame or with 0 if frame. *) -procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer); +procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer); var i: integer; FrameCopyCount: integer; diff --git a/unicode/src/base/UNote.pas b/unicode/src/base/UNote.pas new file mode 100644 index 00000000..5e70bfe1 --- /dev/null +++ b/unicode/src/base/UNote.pas @@ -0,0 +1,593 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/UNote.pas $ + * $Id: UNote.pas 1626 2009-03-07 19:53:00Z k-m_schindler $ + *} + +unit UNote; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes, + SDL, + UMusic, + URecord, + UTime, + UDisplay, + UIni, + ULog, + ULyrics, + UScreenSing, + USong, + gl; + +type + PPLayerNote = ^TPlayerNote; + TPlayerNote = record + Start: integer; + Length: integer; + Detect: real; // accurate place, detected in the note + Tone: real; + Perfect: boolean; // true if the note matches the original one, light the star + Hit: boolean; // true if the note hits the line + end; + + PPLayer = ^TPlayer; + TPlayer = record + Name: string; + + // Index in Teaminfo record + TeamID: byte; + PlayerID: byte; + + // Scores + Score: real; + ScoreLine: real; + ScoreGolden: real; + + ScoreInt: integer; + ScoreLineInt: integer; + ScoreGoldenInt: integer; + ScoreTotalInt: integer; + + // LineBonus + ScoreLast: real; // Last Line Score + + // PerfectLineTwinkle (effect) + LastSentencePerfect: boolean; + + HighNote: integer; // index of last note (= High(Note)?) + LengthNote: integer; // number of notes (= Length(Note)?). + Note: array of TPlayerNote; + end; + +var + + // player and music info + Player: array of TPlayer; + PlayersPlay: integer; + + CurrentSong: TSong; + +const + MAX_SONG_SCORE = 10000; // max. achievable points per song + MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song + +procedure Sing(Screen: TScreenSing); +procedure NewSentence(Screen: TScreenSing); +procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click +procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection +procedure NewNote(Screen: TScreenSing); // detect note +function GetMidBeat(Time: real): real; +function GetTimeFromBeat(Beat: integer): real; + +implementation + +uses + Math, + StrUtils, + USongs, + UJoystick, + UCommandLine, + ULanguage, + //SDL_ttf, + USkins, + UCovers, + UCatCovers, + UDataBase, + UPlaylist, + UDLLManager, + UParty, + UConfig, + UCore, + UCommon, + UGraphic, + UGraphicClasses, + UPath, + UPluginDefs, + UPlatform, + UThemes; + +function GetTimeForBeats(BPM, Beats: real): real; +begin + Result := 60 / BPM * Beats; +end; + +function GetBeats(BPM, msTime: real): real; +begin + Result := BPM * msTime / 60; +end; + +procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); +var + NewTime: real; +begin + if High(CurrentSong.BPM) = BPMNum then + begin + // last BPM + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); + Time := 0; + end + else + begin + // not last BPM + // count how much time is it for start of the new BPM and store it in NewTime + NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); + + // compare it to remaining time + if (Time - NewTime) > 0 then + begin + // there is still remaining time + CurBeat := CurrentSong.BPM[BPMNum].StartBeat; + Time := Time - NewTime; + end + else + begin + // there is no remaining time + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); + Time := 0; + end; // if + end; // if +end; + +function GetMidBeat(Time: real): real; +var + CurBeat: real; + CurBPM: integer; +begin + // static BPM + if Length(CurrentSong.BPM) = 1 then + begin + Result := Time * CurrentSong.BPM[0].BPM / 60; + end + // variable BPM + else if Length(CurrentSong.BPM) > 1 then + begin + CurBeat := 0; + CurBPM := 0; + while (Time > 0) do + begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + + Result := CurBeat; + end + // invalid BPM + else + begin + Result := 0; + end; +end; + +function GetTimeFromBeat(Beat: integer): real; +var + CurBPM: integer; +begin + // static BPM + if Length(CurrentSong.BPM) = 1 then + begin + Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; + end + // variable BPM + else if Length(CurrentSong.BPM) > 1 then + begin + Result := CurrentSong.GAP / 1000; + CurBPM := 0; + while (CurBPM <= High(CurrentSong.BPM)) and + (Beat > CurrentSong.BPM[CurBPM].StartBeat) do + begin + if (CurBPM < High(CurrentSong.BPM)) and + (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then + begin + // full range + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * + (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); + end; + + if (CurBPM = High(CurrentSong.BPM)) or + (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then + begin + // in the middle + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * + (Beat - CurrentSong.BPM[CurBPM].StartBeat); + end; + Inc(CurBPM); + end; + + { + while (Time > 0) do + begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + } + end + // invalid BPM + else + begin + Result := 0; + end; +end; + +procedure Sing(Screen: TScreenSing); +var + Count: integer; + CountGr: integer; + CP: integer; +begin + LyricsState.UpdateBeats(); + + // sentences routines + for CountGr := 0 to 0 do //High(Lines) + begin; + CP := CountGr; + // old parts + LyricsState.OldLine := Lines[CP].Current; + + // choose current parts + for Count := 0 to Lines[CP].High do + begin + if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then + Lines[CP].Current := Count; + end; + + // clean player note if there is a new line + // (optimization on halfbeat time) + if Lines[CP].Current <> LyricsState.OldLine then + NewSentence(Screen); + + end; // for CountGr + + // make some operations on clicks + if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then + NewBeatClick(Screen); + + // make some operations when detecting new voice pitch + if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then + NewBeatDetect(Screen); +end; + +procedure NewSentence(Screen: TScreenSing); +var + i: integer; +begin + // clean note of player + for i := 0 to High(Player) do + begin + Player[i].LengthNote := 0; + Player[i].HighNote := -1; + SetLength(Player[i].Note, 0); + end; + + // on sentence change... + Screen.onSentenceChange(Lines[0].Current); +end; + +procedure NewBeatClick; +var + Count: integer; +begin + // beat click + if ((Ini.BeatClick = 1) and + ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then + begin + AudioPlayback.PlaySound(SoundLib.Click); + end; + + for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do + begin + if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then + begin + // click assist + if Ini.ClickAssist = 1 then + AudioPlayback.PlaySound(SoundLib.Click); + + // drum machine + (* + TempBeat := LyricsState.CurrentBeat; // + 2; + if (TempBeat mod 8 = 0) then Music.PlayDrum; + if (TempBeat mod 8 = 4) then Music.PlayClap; + //if (TempBeat mod 4 = 2) then Music.PlayHihat; + if (TempBeat mod 4 <> 0) then Music.PlayHihat; + *) + end; + end; +end; + +procedure NewBeatDetect(Screen: TScreenSing); +begin + NewNote(Screen); +end; + +procedure NewNote(Screen: TScreenSing); +var + LineFragmentIndex: integer; + CurrentLineFragment: PLineFragment; + PlayerIndex: integer; + CurrentSound: TCaptureBuffer; + CurrentPlayer: PPlayer; + LastPlayerNote: PPlayerNote; + Line: PLine; + SentenceIndex: integer; + SentenceMin: integer; + SentenceMax: integer; + SentenceDetected: integer; // sentence of detected note + NoteAvailable: boolean; + NewNote: boolean; + Range: integer; + NoteHit: boolean; + MaxSongPoints: integer; // max. points for the song (without line bonus) + CurNotePoints: real; // Points for the cur. Note (PointsperNote * ScoreFactor[CurNote]) +begin + // TODO: add duet mode support + // use Lines[LineSetIndex] with LineSetIndex depending on the current player + + // count min and max sentence range for checking + // (detection is delayed to the notes we see on the screen) + SentenceMin := Lines[0].Current-1; + if (SentenceMin < 0) then + SentenceMin := 0; + SentenceMax := Lines[0].Current; + + // check for an active note at the current time defined in the lyrics + NoteAvailable := false; + SentenceDetected := SentenceMin; + for SentenceIndex := SentenceMin to SentenceMax do + begin + Line := @Lines[0].Line[SentenceIndex]; + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + // check if line is active + if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and + (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and + (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes + (CurrentLineFragment.Length > 0) then // and make sure the note length is at least 1 + begin + SentenceDetected := SentenceIndex; + NoteAvailable := true; + Break; + end; + end; + // TODO: break here, if NoteAvailable is true? We would then use the first instead + // of the last note matching the current beat if notes overlap. But notes + // should not overlap at all. + // if (NoteAvailable) then + // Break; + end; + + // analyze player signals + for PlayerIndex := 0 to PlayersPlay-1 do + begin + CurrentPlayer := @Player[PlayerIndex]; + CurrentSound := AudioInputProcessor.Sound[PlayerIndex]; + + // at the beginning of the song there is no previous note + if (Length(CurrentPlayer.Note) > 0) then + LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote] + else + LastPlayerNote := nil; + + // analyze buffer + CurrentSound.AnalyzeBuffer; + + // add some noise + // TODO: do we need this? + //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1; + + // add note if possible + if (CurrentSound.ToneValid and NoteAvailable) then + begin + Line := @Lines[0].Line[SentenceDetected]; + + // process until last note + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and + (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then + begin + // compare notes (from song-file and from player) + + // move players tone to proper octave + while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do + CurrentSound.Tone := CurrentSound.Tone - 12; + + while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do + CurrentSound.Tone := CurrentSound.Tone + 12; + + // half size notes patch + NoteHit := false; + + // if Ini.Difficulty = 0 then Range := 2; + // if Ini.Difficulty = 1 then Range := 1; + // if Ini.Difficulty = 2 then Range := 0; + Range := 2 - Ini.Difficulty; + + // check if the player hit the correct tone within the tolerated range + if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then + begin + // adjust the players tone to the correct one + // TODO: do we need to do this? + // Philipp: I think we do, at least when we draw the notes. + // Otherwise the notehit thing would be shifted to the + // correct unhit note. I think this will look kind of strange. + CurrentSound.Tone := CurrentLineFragment.Tone; + + // half size notes patch + NoteHit := true; + + if (Ini.LineBonus > 0) then + MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS + else + MaxSongPoints := MAX_SONG_SCORE; + + // Note: ScoreValue is the sum of all note values of the song + // (MaxSongPoints / ScoreValue) is the points that a player + // gets for a hit of one beat of a normal note + // CurNotePoints is the amount of points that is meassured + // for a hit of the note per full beat + CurNotePoints := (MaxSongPoints / Lines[0].ScoreValue) * ScoreFactor[CurrentLineFragment.NoteType]; + + case CurrentLineFragment.NoteType of + ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + CurNotePoints; + ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + CurNotePoints; + end; + + // a problem if we use floor instead of round is that a score of + // 10000 points is only possible if the last digit of the total points + // for golden and normal notes is 0. + // if we use round, the max score is 10000 for most songs + // but a score of 10010 is possible if the last digit of the total + // points for golden and normal notes is 5 + // the best solution is to use round for one of these scores + // and round the other score in the opposite direction + // so we assure that the highest possible score is 10000 in every case. + CurrentPlayer.ScoreInt := round(CurrentPlayer.Score / 10) * 10; + + if (CurrentPlayer.ScoreInt < CurrentPlayer.Score) then + //normal score is floored so we have to ceil golden notes score + CurrentPlayer.ScoreGoldenInt := ceil(CurrentPlayer.ScoreGolden / 10) * 10 + else + //normal score is ceiled so we have to floor golden notes score + CurrentPlayer.ScoreGoldenInt := floor(CurrentPlayer.ScoreGolden / 10) * 10; + + + CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt + + CurrentPlayer.ScoreGoldenInt + + CurrentPlayer.ScoreLineInt; + end; + + end; // operation + end; // for + + // check if we have to add a new note or extend the note's length + if (SentenceDetected = SentenceMax) then + begin + // we will add a new note + NewNote := true; + + // if previous note (if any) was the same, extend previous note + if ((CurrentPlayer.LengthNote > 0) and + (LastPlayerNote <> nil) and + (LastPlayerNote.Tone = CurrentSound.Tone) and + ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then + begin + NewNote := false; + end; + + // if is not as new note to control + for LineFragmentIndex := 0 to Line.HighNote do + begin + if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then + NewNote := true; + end; + + // add new note + if NewNote then + begin + // new note + Inc(CurrentPlayer.LengthNote); + Inc(CurrentPlayer.HighNote); + SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote); + + // update player's last note + LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; + with LastPlayerNote^ do + begin + Start := LyricsState.CurrentBeatD; + Length := 1; + Tone := CurrentSound.Tone; // Tone || ToneAbs + Detect := LyricsState.MidBeat; + Hit := NoteHit; // half note patch + end; + end + else + begin + // extend note length + if (LastPlayerNote <> nil) then + Inc(LastPlayerNote.Length); + end; + + // check for perfect note and then light the star (on Draw) + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + if (CurrentLineFragment.Start = LastPlayerNote.Start) and + (CurrentLineFragment.Length = LastPlayerNote.Length) and + (CurrentLineFragment.Tone = LastPlayerNote.Tone) then + begin + LastPlayerNote.Perfect := true; + end; + end; + end; // if SentenceDetected = SentenceMax + + end; // if Detected + end; // for PlayerIndex + + //Log.LogStatus('EndBeat', 'NewBeat'); + + // on sentence end -> for LineBonus and display of SingBar (rating pop-up) + if (SentenceDetected >= Low(Lines[0].Line)) and + (SentenceDetected <= High(Lines[0].Line)) then + begin + Line := @Lines[0].Line[SentenceDetected]; + CurrentLineFragment := @Line.Note[Line.HighNote]; + if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then + begin + if assigned(Screen) then + Screen.OnSentenceEnd(SentenceDetected); + end; + end; + +end; + +end. diff --git a/unicode/src/base/UParty.pas b/unicode/src/base/UParty.pas index 36ab33fb..937aab78 100644 --- a/unicode/src/base/UParty.pas +++ b/unicode/src/base/UParty.pas @@ -39,76 +39,82 @@ uses UPluginDefs; type - ARounds = Array [0..252] of Integer; //0..252 needed for + ARounds = array [0..252] of integer; //0..252 needed for PARounds = ^ARounds; TRoundInfo = record - Modi: Cardinal; - Winner: Byte; + Modi: cardinal; + Winner: byte; end; TeamOrderEntry = record - Teamnum: Byte; - Score: Byte; + Teamnum: byte; + Score: byte; end; - TeamOrderArray = Array[0..5] of Byte; + TeamOrderArray = array[0..5] of byte; TUS_ModiInfoEx = record - Info: TUS_ModiInfo; - Owner: Integer; - TimesPlayed: Byte; //Helper for setting Round Plugins + Info: TUS_ModiInfo; + Owner: integer; + TimesPlayed: byte; //Helper for setting round plugins end; TPartySession = class (TCoreModule) private - bPartyMode: Boolean; //Is this Party or Singleplayer - CurRound: Byte; + bPartyMode: boolean; //Is this party or single player + CurRound: byte; - Modis: Array of TUS_ModiInfoEx; + Modis: array of TUS_ModiInfoEx; Teams: TTeamInfo; - function IsWinner(Player, Winner: Byte): boolean; + function IsWinner(Player, Winner: byte): boolean; procedure GenScores; - function GetRandomPlugin(TeamMode: Boolean): Cardinal; - function GetRandomPlayer(Team: Byte): Byte; + function GetRandomPlugin(TeamMode: boolean): cardinal; + function GetRandomPlayer(Team: byte): byte; public //Teams: TTeamInfo; Rounds: array of TRoundInfo; //TCoreModule methods to inherit - Constructor Create; override; - Procedure Info(const pInfo: PModuleInfo); override; - Function Load: Boolean; override; - Function Init: Boolean; override; - Procedure DeInit; override; - Destructor Destroy; override; + constructor Create; override; + procedure Info(const pInfo: PModuleInfo); override; + function Load: boolean; override; + function Init: boolean; override; + procedure DeInit; override; + destructor Destroy; override; - //Register Modi Service - Function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo + //Register modus service + function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new modus. wParam: Pointer to TUS_ModiInfo //Start new Party - Function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new Party Mode. Returns Non Zero on Success - Function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen) - Function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before. - Function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played + function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new party mode. Returns non zero on success + function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns pointer to cur. Modis TUS_ModiInfo (to Use with Singscreen) + function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops party mode. Returns 1 if party mode was enabled before. + function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases curround by 1; Returns num of round or -1 if last round is already played - Function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading - Function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and does the RoundEnding + function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls curmodis init proc. If an error occurs, returns nonzero. In this case a new plugin was selected. Please renew loading + function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and ends the round - Function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success - Function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success + function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo record to pointer at lParam. Returns zero on success + function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo record from pointer at lParam. Returns zero on success - Function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... - Function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam + function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns team order. Structure: Bits 1..3: Team at place1; Bits 4..6: Team at place2 ... + function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is roundnum. If (Pointer = nil) then return length of the string. Otherwise write the string to address at lParam end; const - StandardModi = 0; //Modi ID that will be played in non party Mode + StandardModus = 0; //Modus ID that will be played in non-party mode implementation -uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils; +uses + UCore, + UGraphic, + ULanguage, + ULog, + UNote, + SysUtils; {********************* TPluginLoader @@ -116,85 +122,84 @@ uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils; *********************} //------------- -// Function that gives some Infos about the Module to the Core +// function that gives some infos about the module to the core //------------- -Procedure TPartySession.Info(const pInfo: PModuleInfo); +procedure TPartySession.Info(const pInfo: PModuleInfo); begin pInfo^.Name := 'TPartySession'; pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Manages Party Modi and Party Game'; + pInfo^.Description := 'Manages party modi and party game'; end; //------------- -// Just the Constructor +// Just the constructor //------------- -Constructor TPartySession.Create; +constructor TPartySession.Create; begin inherited; //UnSet PartyMode - bPartyMode := False; + bPartyMode := false; end; //------------- -//Is Called on Loading. -//In this Method only Events and Services should be created -//to offer them to other Modules or Plugins during the Init process -//If False is Returned this will cause a Forced Exit +//Is called on loading. +//In this method only events and services should be created +//to offer them to other modules or plugins during the init process +//If false is returned this will cause a forced exit //------------- -Function TPartySession.Load: Boolean; +function TPartySession.Load: boolean; begin - //Add Register Party Modi Service - Result := True; + //Add register party modus service + Result := true; Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi); Core.Services.AddService('Party/StartParty', nil, Self.StartParty); Core.Services.AddService('Party/GetCurModi', nil, Self.GetCurModi); end; //------------- -//Is Called on Init Process -//In this Method you can Hook some Events and Create + Init -//your Classes, Variables etc. -//If False is Returned this will cause a Forced Exit +//Is called on init process +//In this method you can hook some events and create + init +//your classes, variables etc. +//If false is returned this will cause a forced exit //------------- -Function TPartySession.Init: Boolean; +function TPartySession.Init: boolean; begin - //Just set Prvate Var to true. + //Just set private var to true. Result := true; end; //------------- -//Is Called if this Module has been Inited and there is a Exit. -//Deinit is in backwards Initing Order +//Is called if this module has been inited and there is an exit. +//Deinit is in reverse initing order //------------- -Procedure TPartySession.DeInit; +procedure TPartySession.DeInit; begin //Force DeInit - end; //------------- -//Is Called if this Module will be unloaded and has been created -//Should be used to Free Memory +//Is called if this module will be unloaded and has been created +//Should be used to free memory //------------- -Destructor TPartySession.Destroy; +destructor TPartySession.Destroy; begin - //Just save some Memory if it wasn't done now.. + //Just save some memory if it wasn't done now.. SetLength(Modis, 0); inherited; end; //------------- -// Registers a new Modi. wParam: Pointer to TUS_ModiInfo -// Service for Plugins +// Registers a new modus. wParam: Pointer to TUS_ModiInfo +// Service for plugins //------------- -Function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; +function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; var - Len: Integer; + Len: integer; Info: PUS_ModiInfo; begin Info := PModiInfo; //Copy Info if cbSize is correct - If (Info.cbSize = SizeOf(TUS_ModiInfo)) then + if (Info.cbSize = SizeOf(TUS_ModiInfo)) then begin Len := Length(Modis); SetLength(Modis, Len + 1); @@ -202,49 +207,49 @@ begin Modis[Len].Info := Info^; end else - Core.ReportError(Integer(PChar('Plugins try to Register Modi with wrong Pointer, or wrong TUS_ModiInfo Record.')), PChar('TPartySession')); + Core.ReportError(integer(PChar('Plugins try to register modus with wrong pointer, or wrong TUS_ModiInfo record.')), PChar('TPartySession')); // FIXME: return a valid result Result := 0; end; //---------- -// Returns a Number of a Random Plugin +// Returns a number of a random plugin //---------- -Function TPartySession.GetRandomPlugin(TeamMode: Boolean): Cardinal; +function TPartySession.GetRandomPlugin(TeamMode: boolean): cardinal; var - LowestTP: Byte; - NumPwithLTP: Word; - I: Integer; - R: Word; + LowestTP: byte; + NumPwithLTP: word; + I: integer; + R: word; begin - Result := StandardModi; //If there are no matching Modis, Play StandardModi - LowestTP := high(Byte); + Result := StandardModus; //If there are no matching modi, play standard modus + LowestTP := high(byte); NumPwithLTP := 0; //Search for Plugins not often played yet - For I := 0 to high(Modis) do + for I := 0 to high(Modis) do begin - if (Modis[I].TimesPlayed < lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + if (Modis[I].TimesPlayed < lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then begin lowestTP := Modis[I].TimesPlayed; NumPwithLTP := 1; end - else if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + else if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then begin Inc(NumPwithLTP); end; end; - //Create Random No + //Create random no R := Random(NumPwithLTP); - //Search for Random Plugin - For I := 0 to high(Modis) do + //Search for random plugin + for I := 0 to high(Modis) do begin - if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then begin - //Plugin Found + //Plugin found if (R = 0) then begin Result := I; @@ -258,79 +263,79 @@ begin end; //---------- -// Starts new Party Mode. Returns Non Zero on Success +// Starts new party mode. Returns non zero on success //---------- -Function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; +function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; var - I: Integer; + I: integer; aiRounds: PARounds; - TeamMode: Boolean; + TeamMode: boolean; begin Result := 0; - If (Teams.NumTeams >= 1) AND (NumRounds < High(Byte)-1) then + if (Teams.NumTeams >= 1) and (NumRounds < High(byte)-1) then begin bPartyMode := false; aiRounds := PAofIRounds; - Try - //Is this Teammode(More then one Player per Team) ? - TeamMode := True; - For I := 0 to Teams.NumTeams-1 do - TeamMode := TeamMode AND (Teams.Teaminfo[I].NumPlayers > 1); + try + //Is this team mode (More than one player per team) ? + TeamMode := true; + for I := 0 to Teams.NumTeams-1 do + TeamMode := TeamMode and (Teams.Teaminfo[I].NumPlayers > 1); //Set Rounds SetLength(Rounds, NumRounds); - For I := 0 to High(Rounds) do - begin //Set Plugins - If (aiRounds[I] = -1) then + for I := 0 to High(Rounds) do + begin //Set plugins + if (aiRounds[I] = -1) then Rounds[I].Modi := GetRandomPlugin(TeamMode) - Else If (aiRounds[I] >= 0) AND (aiRounds[I] <= High(Modis)) AND (TeamMode OR ((Modis[aiRounds[I]].Info.LoadingSettings AND MLS_TeamOnly) = 0)) then + else if (aiRounds[I] >= 0) and (aiRounds[I] <= High(Modis)) and (TeamMode or ((Modis[aiRounds[I]].Info.LoadingSettings and MLS_TeamOnly) = 0)) then Rounds[I].Modi := aiRounds[I] - Else - Rounds[I].Modi := StandardModi; + else + Rounds[I].Modi := StandardModus; - Rounds[I].Winner := High(Byte); //Set Winner to Not Played + Rounds[I].Winner := High(byte); //Set winner to not played end; - CurRound := High(Byte); //Set CurRound to not defined + CurRound := High(byte); //Set CurRound to not defined - //Return teh true and Set PartyMode - bPartyMode := True; + //Return true and set party mode + bPartyMode := true; Result := 1; - Except - Core.ReportError(Integer(PChar('Can''t start PartyMode.')), PChar('TPartySession')); + except + Core.ReportError(integer(PChar('Can''t start party mode.')), PChar('TPartySession')); end; end; end; //---------- -// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen) +// Returns pointer to Cur. ModiInfoEx (to use with sing screen) //---------- -Function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer; begin - If (bPartyMode) AND (CurRound <= High(Rounds)) then + if (bPartyMode) and (CurRound <= High(Rounds)) then begin //If PartyMode is enabled: //Return the Plugin of the Cur Round - Result := Integer(@Modis[Rounds[CurRound].Modi]); + Result := integer(@Modis[Rounds[CurRound].Modi]); end else - begin //Return StandardModi - Result := Integer(@Modis[StandardModi]); + begin //Return standard modus + Result := integer(@Modis[StandardModus]); end; end; //---------- -// Stops Party Mode. Returns 1 If Partymode was enabled before. And -1 if Change was not possible +// Stops party mode. Returns 1 if party mode was enabled before and -1 if change was not possible //---------- -Function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer; begin Result := -1; - If (bPartyMode) then + if (bPartyMode) then begin - // to-do : Whitü: Check here if SingScreen is not Shown atm. - bPartyMode := False; + // to-do : Whitü: Check here if sing screen is not shown atm. + bPartyMode := false; Result := 1; end else @@ -338,59 +343,60 @@ begin end; //---------- -//GetRandomPlayer - Gives back a Random Player to Play next Round +//GetRandomPlayer - gives back a random player to play next round //---------- -function TPartySession.GetRandomPlayer(Team: Byte): Byte; +function TPartySession.GetRandomPlayer(Team: byte): byte; var - I, R: Integer; - lowestTP: Byte; - NumPwithLTP: Byte; + I, R: integer; + lowestTP: byte; + NumPwithLTP: byte; begin - LowestTP := high(Byte); - NumPwithLTP := 0; - Result := 0; + LowestTP := high(byte); + NumPwithLTP := 0; + Result := 0; - //Search for Players that have not often played yet - For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + //Search for players that have not often played yet + for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then begin - if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then - begin - lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then - begin - Inc(NumPwithLTP); - end; + lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then + begin + Inc(NumPwithLTP); end; + end; - //Create Random No - R := Random(NumPwithLTP); + //Create random no + R := Random(NumPwithLTP); - //Search for Random Player - For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + //Search for random player + for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then begin - if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then + //Player found + if (R = 0) then begin - //Player Found - if (R = 0) then - begin - Result := I; - Break; - end; - - Dec(R); + Result := I; + Break; end; + + Dec(R); end; + end; end; //---------- -// NextRound - Increases CurRound by 1; Returns num of Round or -1 if last Round is already played +// NextRound - Increases CurRound by 1; Returns num of round or -1 if last round is already played //---------- -Function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer; -var I: Integer; +function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer; +var + I: integer; begin - If ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then + if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then begin //everythings OK! -> Start the Round, maaaaan Inc(CurRound); @@ -406,23 +412,23 @@ begin end; //---------- -//IsWinner - Returns True if the Players Bit is set in the Winner Byte +//IsWinner - returns true if the players bit is set in the winner byte //---------- -function TPartySession.IsWinner(Player, Winner: Byte): boolean; +function TPartySession.IsWinner(Player, Winner: byte): boolean; var - Bit: Byte; + Bit: byte; begin Bit := 1 shl Player; - Result := ((Winner AND Bit) = Bit); + Result := ((Winner and Bit) = Bit); end; //---------- -//GenScores - Inc Scores for Cur. Round +//GenScores - inc scores for cur. round //---------- procedure TPartySession.GenScores; var - I: Byte; + I: byte; begin for I := 0 to Teams.NumTeams-1 do begin @@ -432,86 +438,86 @@ begin end; //---------- -// CallModiInit - Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading +// CallModiInit - calls CurModis Init Proc. If an error occurs, returns nonzero. In this case a new plugin was selected. Please renew loading //---------- -Function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer; begin - If (not bPartyMode) then - begin //Set Rounds if not in PartyMode + if (not bPartyMode) then + begin //Set rounds if not in party mode SetLength(Rounds, 1); - Rounds[0].Modi := StandardModi; - Rounds[0].Winner := High(Byte); + Rounds[0].Modi := StandardModus; + Rounds[0].Winner := High(byte); CurRound := 0; end; - Try + try //Core. - Except + except on E : Exception do begin - Core.ReportError(Integer(PChar('Error starting Modi: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession')); - If (Rounds[CurRound].Modi = StandardModi) then + Core.ReportError(integer(PChar('Error starting modus: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession')); + if (Rounds[CurRound].Modi = StandardModus) then begin - Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), PChar('TPartySession')); + Core.ReportError(integer(PChar('Can''t start standard modus, will exit now!')), PChar('TPartySession')); Halt; end - Else //Select StandardModi + else //Select standard modus begin - Rounds[CurRound].Modi := StandardModi + Rounds[CurRound].Modi := StandardModus end; end; - End; + end; // FIXME: return a valid result Result := 0; end; //---------- -// CallModiDeInit - Calls DeInitProc and does the RoundEnding +// CallModiDeInit - calls DeInitProc and ends the round //---------- -Function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; var - I: Integer; - MaxScore: Word; + I: integer; + MaxScore: word; begin - If (bPartyMode) then + if (bPartyMode) then begin //Get Winner Byte! - if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get Winners from Plugin + if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get winners from plugin Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID) else - begin //Create winners by Score :/ + begin //Create winners by score :/ Rounds[CurRound].Winner := 0; MaxScore := 0; for I := 0 to Teams.NumTeams-1 do begin - // to-do : recode Percentage stuff + // to-do : recode percentage stuff //PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999; if (Player[I].ScoreTotalInt > MaxScore) then begin MaxScore := Player[I].ScoreTotalInt; Rounds[CurRound].Winner := 1 shl I; end - else if (Player[I].ScoreTotalInt = MaxScore) AND (Player[I].ScoreTotalInt <> 0) then + else if (Player[I].ScoreTotalInt = MaxScore) and (Player[I].ScoreTotalInt <> 0) then begin Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I); end; end; - //When nobody has Points -> Everybody loose + //When nobody has points -> everybody looses if (MaxScore = 0) then Rounds[CurRound].Winner := 0; end; - //Generate teh Scores + //Generate the scores GenScores; - //Inc Players TimesPlayed - If ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings AND MLS_IncTP) = MLS_IncTP) then + //Inc players TimesPlayed + if ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings and MLS_IncTP) = MLS_IncTP) then begin - For I := 0 to Teams.NumTeams-1 do + for I := 0 to Teams.NumTeams-1 do Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed); end; end @@ -523,69 +529,70 @@ begin end; //---------- -// GetTeamInfo - Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success +// GetTeamInfo - writes TTeamInfo record to pointer at lParam. Returns zero on success //---------- -Function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; -var Info: ^TTeamInfo; +function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; +var + Info: ^TTeamInfo; begin Result := -1; Info := pTeamInfo; - If (Info <> nil) then + if (Info <> nil) then begin - Try + try // to - do : Check Delphi memory management in this case //Not sure if i had to copy PChars to a new address or if delphi manages this o0 Info^ := Teams; Result := 0; - Except + except Result := -2; - End; + end; end; end; //---------- -// SetTeamInfo - Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success +// SetTeamInfo - read TTeamInfo record from pointer at lParam. Returns zero on success //---------- -Function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; +function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; var TeamInfobackup: TTeamInfo; Info: ^TTeamInfo; begin Result := -1; Info := pTeamInfo; - If (Info <> nil) then + if (Info <> nil) then begin - Try + try TeamInfoBackup := Teams; // to - do : Check Delphi memory management in this case //Not sure if i had to copy PChars to a new address or if delphi manages this o0 Teams := Info^; Result := 0; - Except + except Teams := TeamInfoBackup; Result := -2; - End; + end; end; end; //---------- -// GetTeamOrder - Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... +// GetTeamOrder - returns team order. Structure: Bits 1..3: Team at place1; Bits 4..6: Team at place2 ... //---------- -Function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; var - I, J: Integer; + I, J: integer; ATeams: array [0..5] of TeamOrderEntry; TempTeam: TeamOrderEntry; begin - // to-do : PartyMode: Write this in another way, so that teams with the same scire get the same Placing - //Fill Team Array - For I := 0 to Teams.NumTeams-1 do + // to-do : PartyMode: Write this in another way, so that teams with the same score get the same place + //Fill Team array + for I := 0 to Teams.NumTeams-1 do begin ATeams[I].Teamnum := I; ATeams[I].Score := Teams.Teaminfo[I].Score; end; - //Sort Teams + //Sort teams for J := 0 to Teams.NumTeams-1 do for I := 1 to Teams.NumTeams-1 do if ATeams[I].Score > ATeams[I-1].Score then @@ -597,17 +604,17 @@ begin //Copy to Result Result := 0; - For I := 0 to Teams.NumTeams-1 do + for I := 0 to Teams.NumTeams-1 do Result := Result or (ATeams[I].TeamNum Shl I*3); end; //---------- -// GetWinnerString - wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam +// GetWinnerString - wParam is Roundnum. If (pointer = nil) then return length of the string. Otherwise write the string to address at lParam //---------- -Function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer; var Winners: array of UTF8String; - I: Integer; + I: integer; ResultStr: String; S: ^String; begin @@ -637,21 +644,21 @@ begin end; end; - //Now Return what we have got - If (lParam = nil) then - begin //ReturnString Length + //Now return what we have got + if (lParam = nil) then + begin //Return string length Result := Length(ResultStr); end - Else - begin //Return String - Try + else + begin //Return string + try S := lParam; S^ := ResultStr; Result := 0; - Except + except Result := -1; - End; + end; end; end; diff --git a/unicode/src/base/UPath.pas b/unicode/src/base/UPath.pas new file mode 100644 index 00000000..2316ac02 --- /dev/null +++ b/unicode/src/base/UPath.pas @@ -0,0 +1,188 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/UPath.pas $ + * $Id: UPath.pas 1624 2009-03-06 23:45:10Z k-m_schindler $ + *} + +unit UPath; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes; + +var + // Absolute Paths + GamePath: string; + SoundPath: string; + SongPaths: TStringList; + LogPath: string; + ThemePath: string; + SkinsPath: string; + ScreenshotsPath: string; + CoverPaths: TStringList; + LanguagesPath: string; + PluginPath: string; + VisualsPath: string; + FontPath: string; + ResourcesPath: string; + PlayListPath: string; + +function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; +procedure InitializePaths; +procedure AddSongPath(const Path: string); + +implementation + +uses + StrUtils, + UPlatform, + UCommandLine, + ULog; + +procedure AddSpecialPath(var PathList: TStringList; const Path: string); +var + Index: integer; + PathAbs, OldPathAbs: string; +begin + if (PathList = nil) then + PathList := TStringList.Create; + + if (Path = '') or not ForceDirectories(Path) then + Exit; + + PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path)); + + // check if path or a part of the path was already added + for Index := 0 to PathList.Count-1 do + begin + OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[Index])); + // check if the new directory is a sub-directory of a previously added one. + // This is also true, if both paths point to the same directories. + if (AnsiStartsText(OldPathAbs, PathAbs)) then + begin + // ignore the new path + Exit; + end; + + // check if a previously added directory is a sub-directory of the new one. + if (AnsiStartsText(PathAbs, OldPathAbs)) then + begin + // replace the old with the new one. + PathList[Index] := PathAbs; + Exit; + end; + end; + + PathList.Add(PathAbs); +end; + +procedure AddSongPath(const Path: string); +begin + AddSpecialPath(SongPaths, Path); +end; + +procedure AddCoverPath(const Path: string); +begin + AddSpecialPath(CoverPaths, Path); +end; + +(** + * Initialize a path variable + * After setting paths, make sure that paths exist + *) +function FindPath(out PathResult: string; + const RequestedPath: string; + NeedsWritePermission: boolean) + : boolean; +begin + Result := false; + + if (RequestedPath = '') then + Exit; + + // Make sure the directory exists + if (not ForceDirectories(RequestedPath)) then + begin + PathResult := ''; + Exit; + end; + + PathResult := IncludeTrailingPathDelimiter(RequestedPath); + + if (NeedsWritePermission) and + (FileIsReadOnly(RequestedPath)) then + begin + Exit; + end; + + Result := true; +end; + +(** + * Function sets all absolute paths e.g. song path and makes sure the directorys exist + *) +procedure InitializePaths; +begin + // Log directory (must be writable) + if (not FindPath(LogPath, Platform.GetLogPath, true)) then + begin + Log.FileOutputEnabled := false; + Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths'); + end; + + FindPath(SoundPath, Platform.GetGameSharedPath + 'sounds', false); + FindPath(ThemePath, Platform.GetGameSharedPath + 'themes', false); + FindPath(SkinsPath, Platform.GetGameSharedPath + 'themes', false); + FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false); + FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false); + FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false); + FindPath(FontPath, Platform.GetGameSharedPath + 'fonts', false); + FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false); + + // Playlists are not shared as we need one directory to write too + FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true); + + // Screenshot directory (must be writable) + if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then + begin + Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths'); + end; + + // Add song paths + AddSongPath(Params.SongPath); + AddSongPath(Platform.GetGameSharedPath + 'songs'); + AddSongPath(Platform.GetGameUserPath + 'songs'); + + // Add category cover paths + AddCoverPath(Platform.GetGameSharedPath + 'covers'); + AddCoverPath(Platform.GetGameUserPath + 'covers'); +end; + +end. diff --git a/unicode/src/base/UPlatformMacOSX.pas b/unicode/src/base/UPlatformMacOSX.pas index 1aa37cd4..96e4bc63 100644 --- a/unicode/src/base/UPlatformMacOSX.pas +++ b/unicode/src/base/UPlatformMacOSX.pas @@ -47,19 +47,21 @@ type * (Note for non-Maccies: "folder" is the Mac name for directory.) * * Note on the resource folders: - * 1. Installation of an application on the mac works as follows: Extract and copy an application - * and if you don't like or need the application anymore you move the folder - * to the trash - and you're done. - * 2. The use folders in the user's home directory is against Apple's guidelines - * and strange to an average user. + * 1. Installation of an application on the mac works as follows: Extract and + * copy an application and if you don't like or need the application + * anymore you move the folder to the trash - and you're done. + * 2. The use of folders in the user's home directory is against Apple's + * guidelines and strange to an average user. * 3. Even worse is using /usr/local/... since all lowercase folders in / are - * not visible to an average user in the Finder, at least not without some "tricks". + * not visible to an average user in the Finder, at least not without some + * "tricks". * - * The best way would be to store everything within the application bundle. However, this - * requires USDX to offer the handling of the resources. Until this is implemented, the - * second best solution is as follows: + * The best way would be to store everything within the application bundle. + * However, this requires USDX to offer the handling of the resources. Until + * this is implemented, the second best solution is as follows: * - * According to Aple guidelines handling of resources and folders should follow these lines: + * According to Aple guidelines handling of resources and folders should follow + * these lines: * * Acceptable places for files are folders named UltraStarDeluxe either in * /Library/Application Support/ @@ -68,19 +70,19 @@ type * * So * GetGameSharedPath could return - * /Library/Application Support/UltraStarDeluxe/Resources/. + * /Library/Application Support/UltraStarDeluxe/. * GetGameUserPath could return - * ~/Library/Application Support/UltraStarDeluxe/Resources/. + * ~/Library/Application Support/UltraStarDeluxe/. * - * Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources + * Right now, only $HOME/Library/Application Support/UltraStarDeluxe * is used. So every user needs the complete set of files and folders. * Future versions may also use shared resources in - * /Library/Application Support/UltraStarDeluxe/Resources. However, this is not - * treated yet in the code outside this unit. + * /Library/Application Support/UltraStarDeluxe. However, this is + * not treated yet in the code outside this unit. * * USDX checks, whether GetGameUserPath exists. If not, USDX creates it. * The existence of needed files is then checked and if a file is missing - * it is copied to there from within the Resources folder in the Application + * it is copied to there from within the folder Contents in the Application * bundle, which contains the default files. USDX should not delete files or * folders in Application Support/UltraStarDeluxe automatically or without * user confirmation. @@ -88,13 +90,14 @@ type TPlatformMacOSX = class(TPlatform) private {** - * GetBundlePath returns the path to the application bundle UltraStarDeluxe.app. + * GetBundlePath returns the path to the application bundle + * UltraStarDeluxe.app. *} function GetBundlePath: WideString; {** * GetApplicationSupportPath returns the path to - * $HOME/Library/Application Support/UltraStarDeluxe/Resources. + * $HOME/Library/Application Support/UltraStarDeluxe. *} function GetApplicationSupportPath: WideString; @@ -102,38 +105,38 @@ type * see the description of @link(Init). *} procedure CreateUserFolders(); - + public {** - * Init simply calls @link(CreateUserFolders), which in turn scans the folder - * UltraStarDeluxe.app/Contents/Resources for all files and folders. - * $HOME/Library/Application Support/UltraStarDeluxe/Resources is then checked - * for their presence and missing ones are copied. + * Init simply calls @link(CreateUserFolders), which in turn scans the + * folder UltraStarDeluxe.app/Contents for all files and + * folders. $HOME/Library/Application Support/UltraStarDeluxe + * is then checked for their presence and missing ones are copied. *} procedure Init; override; {** - * DirectoryFindFiles returns all entries of a folder with names and booleans - * about their type, i.e. file or directory. + * DirectoryFindFiles returns all entries of a folder with names and + * booleans about their type, i.e. file or directory. *} function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; override; {** * GetLogPath returns the path for log messages. Currently it is set to - * $HOME/Library/Application Support/UltraStarDeluxe/Resources/Log. + * $HOME/Library/Application Support/UltraStarDeluxe/Log. *} function GetLogPath : WideString; override; {** - * GetGameSharedPath returns the path for shared resources. Currently it is set to - * /Library/Application Support/UltraStarDeluxe/Resources. + * GetGameSharedPath returns the path for shared resources. Currently it + * is set to /Library/Application Support/UltraStarDeluxe. * However it is not used. *} function GetGameSharedPath : WideString; override; {** - * GetGameUserPath returns the path for user resources. Currently it is set to - * $HOME/Library/Application Support/UltraStarDeluxe/Resources. + * GetGameUserPath returns the path for user resources. Currently it is + * set to $HOME/Library/Application Support/UltraStarDeluxe. * This is where a user can add songs, themes, .... *} function GetGameUserPath : WideString; override; @@ -151,6 +154,9 @@ begin end; procedure TPlatformMacOSX.CreateUserFolders(); +const + // used to construct the @link(UserPathName) + PathName: string = '/Library/Application Support/UltraStarDeluxe'; var RelativePath: string; // BaseDir contains the path to the folder, where a search is performed. @@ -169,22 +175,23 @@ var // searched for additional files and folders. DirectoryIsFinished: longint; Counter: longint; + // These three are for creating directories, due to possible symlinks + CreatedDirectory: boolean; + FileAttrs: integer; + DirectoryPath: string; - UserPathName: string; -const - // used to construct the @link(UserPathName) - PathName: string = '/Library/Application Support/UltraStarDeluxe/Resources'; + UserPathName: string; begin // Get the current folder and save it in OldBaseDir for returning to it, when // finished. GetDir(0, OldBaseDir); - // UltraStarDeluxe.app/Contents/Resources contains all the default files and + // UltraStarDeluxe.app/Contents contains all the default files and // folders. - BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents/Resources'; + BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents'; ChDir(BaseDir); - // Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources + // Right now, only $HOME/Library/Application Support/UltraStarDeluxe // is used. UserPathName := GetEnvironmentVariable('HOME') + PathName; @@ -192,7 +199,7 @@ begin DirectoryList := TStringList.Create(); FileList := TStringList.Create(); DirectoryList.Add('.'); - + // create the folder and file lists repeat @@ -203,7 +210,7 @@ begin repeat if DirectoryExists(SearchInfo.Name) then begin - if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then + if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then DirectoryList.Add(RelativePath + '/' + SearchInfo.Name); end else @@ -218,7 +225,12 @@ begin ForceDirectories(UserPathName); // should not be necessary since (UserPathName+'/.') is created. for Counter := 0 to DirectoryList.Count-1 do begin - if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then + DirectoryPath := UserPathName + '/' + DirectoryList[Counter]; + CreatedDirectory := ForceDirectories(DirectoryPath); + FileAttrs := FileGetAttr(DirectoryPath); + // Don't know how to analyse the target of the link. + // Let's assume the symlink is pointing to an existing directory. + if (not CreatedDirectory) and (FileAttrs and faSymLink > 0) then Log.LogError('Failed to create the folder "'+ UserPathName + '/' + DirectoryList[Counter] +'"', 'TPlatformMacOSX.CreateUserFolders'); end; @@ -241,8 +253,7 @@ var i, pos : integer; begin // Mac applications are packaged in folders. - // We have to cut the last two folders - // to get the application folder. + // Cutting the last two folders yields the application folder. Result := GetExecutionDir(); for i := 1 to 2 do @@ -257,7 +268,7 @@ end; function TPlatformMacOSX.GetApplicationSupportPath: WideString; const - PathName : string = '/Library/Application Support/UltraStarDeluxe/Resources'; + PathName : string = '/Library/Application Support/UltraStarDeluxe'; begin Result := GetEnvironmentVariable('HOME') + PathName + '/'; end; @@ -287,7 +298,7 @@ begin i := 0; Filter := LowerCase(Filter); - TheDir := FPOpenDir(Dir); + TheDir := FPOpenDir(Dir); if Assigned(TheDir) then repeat ADirent := FPReadDir(TheDir); diff --git a/unicode/src/base/UPlaylist.pas b/unicode/src/base/UPlaylist.pas index 47ade154..744f4ce8 100644 --- a/unicode/src/base/UPlaylist.pas +++ b/unicode/src/base/UPlaylist.pas @@ -34,7 +34,8 @@ interface {$I switches.inc} uses - USong; + USong, + UPath; type TPlaylistItem = record diff --git a/unicode/src/base/UPluginLoader.pas b/unicode/src/base/UPluginLoader.pas index 5e581c23..8836cb78 100644 --- a/unicode/src/base/UPluginLoader.pas +++ b/unicode/src/base/UPluginLoader.pas @@ -41,14 +41,15 @@ interface uses UPluginDefs, - UCoreModule; + UCoreModule, + UPath; type TPluginListItem = record Info: TUS_PluginInfo; - State: Byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error - Path: String; // path to this plugin - NeedsDeInit: Boolean; // if this is inited correctly this should be true + State: byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error + Path: string; // path to this plugin + NeedsDeInit: boolean; // if this is inited correctly this should be true hLib: THandle; // handle of loaded libary Procs: record // procs offered by plugin. Don't call this directly use wrappers of TPluginLoader Load: Func_Load; @@ -63,13 +64,13 @@ type PPluginLoader = ^TPluginLoader; TPluginLoader = class (TCoreModule) private - LoadingProcessFinished: Boolean; + LoadingProcessFinished: boolean; sUnloadPlugin: THandle; sLoadPlugin: THandle; sGetPluginInfo: THandle; sGetPluginState: THandle; - procedure FreePlugin(Index: Cardinal); + procedure FreePlugin(Index: integer); public PluginInterface: TUS_PluginInterface; Plugins: array of TPluginListItem; @@ -77,19 +78,19 @@ type // TCoreModule methods to inherit constructor Create; override; procedure Info(const pInfo: PModuleInfo); override; - function Load: Boolean; override; - function Init: Boolean; override; + function Load: boolean; override; + function Init: boolean; override; procedure DeInit; override; Destructor Destroy; override; // New methods - procedure BrowseDir(Path: String); // browses the path at _Path_ for plugins - function PluginExists(Name: String): integer; // if plugin exists: Index of plugin, else -1 - procedure AddPlugin(Filename: String); // adds plugin to the array + procedure BrowseDir(Path: string); // browses the path at _Path_ for plugins + function PluginExists(Name: string): integer; // if plugin exists: Index of plugin, else -1 + procedure AddPlugin(Filename: string); // adds plugin to the array - function CallLoad(Index: Cardinal): integer; - function CallInit(Index: Cardinal): integer; - procedure CallDeInit(Index: Cardinal); + function CallLoad(Index: integer): integer; + function CallInit(Index: integer): integer; + procedure CallDeInit(Index: integer); //Services offered function LoadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin @@ -110,10 +111,10 @@ type public // TCoreModule methods to inherit constructor Create; override; - + procedure Info(const pInfo: PModuleInfo); override; - function Load: Boolean; override; - function Init: Boolean; override; + function Load: boolean; override; + function Init: boolean; override; procedure DeInit; override; end; @@ -176,7 +177,7 @@ begin PluginInterface.ServiceExists := ServiceExists; // UnSet private var - LoadingProcessFinished := False; + LoadingProcessFinished := false; end; //------------- @@ -185,15 +186,15 @@ end; // to offer them to other modules or plugins during the init process // if false is returned this will cause a forced exit //------------- -function TPluginLoader.Load: Boolean; +function TPluginLoader.Load: boolean; begin - Result := True; + Result := true; try // Start searching for plugins BrowseDir(PluginPath); except - Result := False; + Result := false; Core.ReportError(integer(PChar('Error browsing and loading.')), PChar('TPluginLoader')); end; end; @@ -204,11 +205,11 @@ end; // your classes, variables etc. // If false is returned this will cause a forced exit //------------- -function TPluginLoader.Init: Boolean; +function TPluginLoader.Init: boolean; begin // Just set private var to true. - LoadingProcessFinished := True; - Result := True; + LoadingProcessFinished := true; + Result := true; end; //------------- @@ -244,7 +245,7 @@ end; //-------------- // Browses the path at _Path_ for plugins //-------------- -procedure TPluginLoader.BrowseDir(Path: String); +procedure TPluginLoader.BrowseDir(Path: string); var SR: TSearchRec; begin @@ -256,7 +257,7 @@ begin until FindNext(SR) <> 0; end; FindClose(SR); - + // Search for plugins at path if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then begin @@ -266,11 +267,11 @@ begin end; FindClose(SR); end; - + //-------------- // If plugin exists: Index of plugin, else -1 //-------------- -function TPluginLoader.PluginExists(Name: String): integer; +function TPluginLoader.PluginExists(Name: string): integer; var I: integer; begin @@ -286,11 +287,11 @@ begin end; end; end; - + //-------------- // Adds plugin to the array //-------------- -procedure TPluginLoader.AddPlugin(Filename: String); +procedure TPluginLoader.AddPlugin(Filename: string); var hLib: THandle; PInfo: Proc_PluginInfo; @@ -332,7 +333,7 @@ begin Plugins[PluginID].Info := Info; Plugins[PluginID].State := 0; Plugins[PluginID].Path := Filename; - Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].NeedsDeInit := false; Plugins[PluginID].hLib := hLib; // Try to get procs @@ -340,7 +341,7 @@ begin Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); - if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + if (@Plugins[PluginID].Procs.Load = nil) or (@Plugins[PluginID].Procs.Init = nil) or (@Plugins[PluginID].Procs.DeInit = nil) then begin Plugins[PluginID].State := 255; FreeLibrary(hLib); @@ -354,11 +355,11 @@ begin CallInit(PluginID); end; end - else if (LoadingProcessFinished = False) then + else if (LoadingProcessFinished = false) then begin if (Plugins[PluginID].Info.Version < Info.Version) then begin // Found newer version of this plugin - Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + String(Info.Name))), PChar('TPluginLoader')); + Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + string(Info.Name))), PChar('TPluginLoader')); // Unload old plugin UnloadPlugin(PluginID, nil); @@ -367,7 +368,7 @@ begin Plugins[PluginID].Info := Info; Plugins[PluginID].State := 0; Plugins[PluginID].Path := Filename; - Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].NeedsDeInit := false; Plugins[PluginID].hLib := hLib; // Try to get procs @@ -375,7 +376,7 @@ begin Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); - if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + if (@Plugins[PluginID].Procs.Load = nil) or (@Plugins[PluginID].Procs.Init = nil) or (@Plugins[PluginID].Procs.DeInit = nil) then begin FreeLibrary(hLib); Plugins[PluginID].State := 255; @@ -390,7 +391,7 @@ begin else begin FreeLibrary(hLib); - Core.ReportError(integer(PChar('Plugin with this name already exists: ' + String(Info.Name))), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Plugin with this name already exists: ' + string(Info.Name))), PChar('TPluginLoader')); end; end else @@ -413,7 +414,7 @@ end; //-------------- // Calls load func of plugin with the given index //-------------- -function TPluginLoader.CallLoad(Index: Cardinal): integer; +function TPluginLoader.CallLoad(Index: integer): integer; begin Result := -2; if(Index < Length(Plugins)) then @@ -424,7 +425,7 @@ begin Result := Plugins[Index].Procs.Load(@PluginInterface); except Result := -3; - End; + end; if (Result = 0) then Plugins[Index].State := 1 @@ -432,7 +433,7 @@ begin begin FreePlugin(Index); Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling load function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Error calling load function from plugin: ' + string(Plugins[Index].Info.Name))), PChar('TPluginLoader')); end; end; end; @@ -441,7 +442,7 @@ end; //-------------- // Calls init func of plugin with the given index //-------------- -function TPluginLoader.CallInit(Index: Cardinal): integer; +function TPluginLoader.CallInit(Index: integer): integer; begin Result := -2; if(Index < Length(Plugins)) then @@ -452,18 +453,18 @@ begin Result := Plugins[Index].Procs.Init(@PluginInterface); except Result := -3; - End; - + end; + if (Result = 0) then begin Plugins[Index].State := 2; - Plugins[Index].NeedsDeInit := True; + Plugins[Index].NeedsDeInit := true; end else begin FreePlugin(Index); Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling init function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Error calling init function from plugin: ' + string(Plugins[Index].Info.Name))), PChar('TPluginLoader')); end; end; end; @@ -472,7 +473,7 @@ end; //-------------- // Calls deinit proc of plugin with the given index //-------------- -procedure TPluginLoader.CallDeInit(Index: Cardinal); +procedure TPluginLoader.CallDeInit(Index: integer); begin if(Index < Length(Plugins)) then begin @@ -483,7 +484,7 @@ begin Plugins[Index].Procs.DeInit(@PluginInterface); except - End; + end; // Don't forget to remove services and subscriptions by this plugin Core.Hooks.DelbyOwner(-1 - Index); @@ -496,7 +497,7 @@ end; //-------------- // Frees all plugin sources (procs and handles) - helper for deiniting functions //-------------- -procedure TPluginLoader.FreePlugin(Index: Cardinal); +procedure TPluginLoader.FreePlugin(Index: integer); begin Plugins[Index].State := 4; Plugins[Index].Procs.Load := nil; @@ -507,15 +508,13 @@ begin FreeLibrary(Plugins[Index].hLib); end; - - //-------------- // wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin //-------------- function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; var Index: integer; - sFile: String; + sFile: string; begin Result := -1; sFile := ''; @@ -527,9 +526,9 @@ begin else begin //lParam is PChar try - sFile := String(PChar(lParam)); + sFile := string(PChar(lParam)); Index := PluginExists(sFile); - if (Index < 0) And FileExists(sFile) then + if (Index < 0) and FileExists(sFile) then begin // Is filename AddPlugin(sFile); Result := Plugins[High(Plugins)].State; @@ -539,7 +538,6 @@ begin end; end; - if (Index >= 0) and (Index < Length(Plugins)) then begin AddPlugin(Plugins[Index].Path); @@ -553,7 +551,7 @@ end; function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; var Index: integer; - sName: String; + sName: string; begin Result := -1; // lParam is ID @@ -564,14 +562,13 @@ begin else begin // wParam is PChar try - sName := String(PChar(lParam)); + sName := string(PChar(lParam)); Index := PluginExists(sName); except Index := -2; end; end; - if (Index >= 0) and (Index < Length(Plugins)) then CallDeInit(Index) end; @@ -592,7 +589,7 @@ begin PUS_PluginInfo(lParam)^ := Plugins[wParam].Info; except - End; + end; end; end else if (lParam = nil) then @@ -607,13 +604,13 @@ begin Result := Length(Plugins); except Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader')); - End; + end; end; end; //-------------- -// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of Byte to address at lparam) else (return state of plugin with index(wParam)) +// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of byte to address at lparam) else (return state of plugin with index(wParam)) //-------------- function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; var I: integer; @@ -634,15 +631,14 @@ begin begin try for I := 0 to high(Plugins) do - Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; + byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; Result := Length(Plugins); except Core.ReportError(integer(PChar('Could not write pluginstate array')), PChar('TPluginLoader')); - End; + end; end; end; - {********************* TtehPlugins Implementation @@ -673,7 +669,7 @@ end; // to offer them to other modules or plugins during the init process // if false is returned this will cause a forced exit //------------- -function TtehPlugins.Load: Boolean; +function TtehPlugins.Load: boolean; var i: integer; // Counter CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute @@ -703,11 +699,11 @@ begin begin PluginLoader.CallDeInit(i); PluginLoader.Plugins[i].State := 254; // Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end else begin - Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end; except // Plugin could not be loaded. @@ -721,7 +717,7 @@ begin end; end; - // Reset CurExecuted + // Reset CurExecuted Core.CurExecuted := CurExecutedBackup; end; end; @@ -732,7 +728,7 @@ end; // your classes, variables etc. // if false is returned this will cause a forced exit //------------- -function TtehPlugins.Init: Boolean; +function TtehPlugins.Init: boolean; var i: integer; // Counter CurExecutedBackup: integer; // backup of Core.CurExecuted attribute @@ -752,16 +748,16 @@ begin begin PluginLoader.CallDeInit(i); PluginLoader.Plugins[i].State := 254; //Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end else - Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); except // Plugin could not be loaded. // => Show error message, then shut down plugin PluginLoader.CallDeInit(i); PluginLoader.Plugins[i].State := 255; //Plugin causes Error - Core.ReportError(integer(PChar('Plugin causes error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportError(integer(PChar('Plugin causes error during init process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end; // Reset CurExecuted @@ -781,7 +777,7 @@ begin CurExecutedBackup := Core.CurExecuted; // Start loop - + for i := 0 to High(PluginLoader.Plugins) do begin try diff --git a/unicode/src/base/URecord.pas b/unicode/src/base/URecord.pas index 132bafd5..8f37262d 100644 --- a/unicode/src/base/URecord.pas +++ b/unicode/src/base/URecord.pas @@ -36,26 +36,26 @@ interface uses Classes, Math, - SysUtils, sdl, + SysUtils, UCommon, UMusic, UIni; const BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz) - NumHalftones = 36; // C2-B4 (for Whitney and my high voice) + NumHalftones = 36; // C2-B4 (for Whitney and my high voice) type TCaptureBuffer = class private - VoiceStream: TAudioVoiceStream; // stream for voice passthrough + VoiceStream: TAudioVoiceStream; // stream for voice passthrough AnalysisBufferLock: PSDL_Mutex; function GetToneString: string; // converts a tone to its string represenatation; - procedure BoostBuffer(Buffer: PChar; Size: Cardinal); - procedure ProcessNewBuffer(Buffer: PChar; BufferSize: integer); + procedure BoostBuffer(Buffer: PByteArray; Size: cardinal); + procedure ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer); // we call it to analyze sound by checking Autocorrelation procedure AnalyzeByAutocorrelation; @@ -86,7 +86,7 @@ type procedure LockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} procedure UnlockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} - function MaxSampleVolume: Single; + function MaxSampleVolume: single; property ToneString: string READ GetToneString; end; @@ -95,17 +95,17 @@ const type TAudioInputSource = record - Name: string; + Name: string; end; // soundcard input-devices information TAudioInputDevice = class public - CfgIndex: integer; // index of this device in Ini.InputDeviceConfig - Name: string; // soundcard name - Source: array of TAudioInputSource; // soundcard input-sources - SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected) - MicSource: integer; // source-index of mic (-1: none detected) + CfgIndex: integer; // index of this device in Ini.InputDeviceConfig + Name: string; // soundcard name + Source: array of TAudioInputSource; // soundcard input-sources + SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected) + MicSource: integer; // source-index of mic (-1: none detected) AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo) CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data @@ -115,10 +115,10 @@ type procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); // TODO: add Open/Close functions so Start/Stop becomes faster - //function Open(): boolean; virtual; abstract; - //function Close(): boolean; virtual; abstract; - function Start(): boolean; virtual; abstract; - function Stop(): boolean; virtual; abstract; + //function Open(): boolean; virtual; abstract; + //function Close(): boolean; virtual; abstract; + function Start(): boolean; virtual; abstract; + function Stop(): boolean; virtual; abstract; function GetVolume(): single; virtual; abstract; procedure SetVolume(Volume: single); virtual; abstract; @@ -135,7 +135,7 @@ type procedure UpdateInputDeviceConfig; // handle microphone input - procedure HandleMicrophoneData(Buffer: PChar; Size: Cardinal; + procedure HandleMicrophoneData(Buffer: PByteArray; Size: cardinal; InputDevice: TAudioInputDevice); end; @@ -153,7 +153,6 @@ type procedure CaptureStop; end; - TSmallIntArray = array [0..(MaxInt div SizeOf(SmallInt))-1] of SmallInt; PSmallIntArray = ^TSmallIntArray; @@ -163,12 +162,11 @@ implementation uses ULog, - UMain; + UNote; var singleton_AudioInputProcessor : TAudioInputProcessor = nil; - { Global } function AudioInputProcessor(): TAudioInputProcessor; @@ -179,7 +177,6 @@ begin result := singleton_AudioInputProcessor; end; - { TAudioInputDevice } destructor TAudioInputDevice.Destroy; @@ -268,11 +265,11 @@ begin UnlockAnalysisBuffer(); end; -procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PChar; BufferSize: integer); +procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer); var BufferOffset: integer; - SampleCount: integer; - i: integer; + SampleCount: integer; + i: integer; begin // apply software boost BoostBuffer(Buffer, BufferSize); @@ -299,7 +296,6 @@ begin SampleCount := Length(AnalysisBuffer); end; - LockAnalysisBuffer(); try @@ -315,7 +311,6 @@ begin UnlockAnalysisBuffer(); end; - // save capture-data to BufferLong if enabled if (Ini.SavePlayback = 1) then begin @@ -329,10 +324,10 @@ end; procedure TCaptureBuffer.AnalyzeBuffer; var - Volume: single; - MaxVolume: single; + Volume: single; + MaxVolume: single; SampleIndex: integer; - Threshold: single; + Threshold: single; begin ToneValid := false; ToneAbs := -1; @@ -431,10 +426,10 @@ begin Result := 1 - AccumDist / AnalysisBufferSize; end; -function TCaptureBuffer.MaxSampleVolume: Single; +function TCaptureBuffer.MaxSampleVolume: single; var - lSampleIndex: Integer; - lMaxVol : Longint; + lSampleIndex: integer; + lMaxVol: longint; begin; LockAnalysisBuffer(); try @@ -464,13 +459,13 @@ begin Result := '-'; end; -procedure TCaptureBuffer.BoostBuffer(Buffer: PChar; Size: Cardinal); +procedure TCaptureBuffer.BoostBuffer(Buffer: PByteArray; Size: cardinal); var - i: integer; - Value: Longint; - SampleCount: integer; + i: integer; + Value: longint; + SampleCount: integer; SampleBuffer: PSmallIntArray; // buffer handled as array of samples - Boost: byte; + Boost: byte; begin // TODO: set boost per device case Ini.MicBoost of @@ -504,7 +499,6 @@ begin end; end; - { TAudioInputProcessor } constructor TAudioInputProcessor.Create; @@ -531,14 +525,14 @@ end; // See: TIni.LoadInputDeviceCfg() procedure TAudioInputProcessor.UpdateInputDeviceConfig; var - deviceIndex: integer; - newDevice: boolean; + deviceIndex: integer; + newDevice: boolean; deviceIniIndex: integer; - deviceCfg: PInputDeviceConfig; - device: TAudioInputDevice; - channelCount: integer; - channelIndex: integer; - i: integer; + deviceCfg: PInputDeviceConfig; + device: TAudioInputDevice; + channelCount: integer; + channelIndex: integer; + i: integer; begin // Input devices - append detected soundcards for deviceIndex := 0 to High(DeviceList) do @@ -608,18 +602,18 @@ end; * Length - number of bytes in Buffer * Input - Soundcard-Input used for capture *} -procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PChar; Size: Cardinal; InputDevice: TAudioInputDevice); +procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PByteArray; Size: cardinal; InputDevice: TAudioInputDevice); var - MultiChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel) - SingleChannelBuffer: PChar; // temporary buffer for new samples per channel + MultiChannelBuffer: PByteArray; // buffer handled as array of bytes (offset relative to channel) + SingleChannelBuffer: PByteArray; // temporary buffer for new samples per channel SingleChannelBufferSize: integer; - ChannelIndex: integer; - CaptureChannel: TCaptureBuffer; - AudioFormat: TAudioFormatInfo; - SampleSize: integer; - SampleCount: integer; - SamplesPerChannel: integer; - i: integer; + ChannelIndex: integer; + CaptureChannel: TCaptureBuffer; + AudioFormat: TAudioFormatInfo; + SampleSize: integer; + SampleCount: integer; + SamplesPerChannel: integer; + i: integer; begin AudioFormat := InputDevice.AudioFormat; SampleSize := AudioSampleSize[AudioFormat.Format]; @@ -638,7 +632,7 @@ begin begin // set offset according to channel index MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize]; - // seperate channel-data from interleaved multi-channel (e.g. stereo) data + // separate channel-data from interleaved multi-channel (e.g. stereo) data for i := 0 to SamplesPerChannel-1 do begin Move(MultiChannelBuffer[i*AudioFormat.FrameSize], @@ -652,7 +646,6 @@ begin FreeMem(SingleChannelBuffer); end; - { TAudioInputBase } function TAudioInputBase.FinalizeRecord: boolean; @@ -670,13 +663,13 @@ end; *} procedure TAudioInputBase.CaptureStart; var - S: integer; - DeviceIndex: integer; + S: integer; + DeviceIndex: integer; ChannelIndex: integer; - Device: TAudioInputDevice; - DeviceCfg: PInputDeviceConfig; - DeviceUsed: boolean; - Player: integer; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; + DeviceUsed: boolean; + Player: integer; begin if (Started) then CaptureStop(); @@ -728,10 +721,10 @@ end; *} procedure TAudioInputBase.CaptureStop; var - DeviceIndex: integer; + DeviceIndex: integer; ChannelIndex: integer; - Device: TAudioInputDevice; - DeviceCfg: PInputDeviceConfig; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; begin for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do begin @@ -758,17 +751,18 @@ var var i: integer; begin - Result := False; + Result := false; // search devices with same description - For i := 0 to deviceIndex-1 do + for i := 0 to deviceIndex-1 do begin if (AudioInputProcessor.DeviceList[i].Name = name) then begin - Result := True; + Result := true; Break; end; end; end; + begin count := 1; result := name; @@ -783,6 +777,3 @@ begin end; end. - - - diff --git a/unicode/src/base/URingBuffer.pas b/unicode/src/base/URingBuffer.pas index 515d0efb..684c13ee 100644 --- a/unicode/src/base/URingBuffer.pas +++ b/unicode/src/base/URingBuffer.pas @@ -39,7 +39,7 @@ uses type TRingBuffer = class private - RingBuffer: PChar; + RingBuffer: PByteArray; BufferCount: integer; BufferSize: integer; WritePos: integer; @@ -47,8 +47,10 @@ type public constructor Create(Size: integer); destructor Destroy; override; - function Read(Buffer: PChar; Count: integer): integer; - function Write(Buffer: PChar; Count: integer): integer; + function Read(Buffer: PByteArray; Count: integer): integer; + function Write(Buffer: PByteArray; Count: integer): integer; + function Size(): integer; + function Available(): integer; procedure Flush(); end; @@ -71,7 +73,7 @@ begin FreeMem(RingBuffer); end; -function TRingBuffer.Read(Buffer: PChar; Count: integer): integer; +function TRingBuffer.Read(Buffer: PByteArray; Count: integer): integer; var PartCount: integer; begin @@ -106,7 +108,7 @@ begin Result := Count; end; -function TRingBuffer.Write(Buffer: PChar; Count: integer): integer; +function TRingBuffer.Write(Buffer: PByteArray; Count: integer): integer; var PartCount: integer; begin @@ -143,6 +145,16 @@ begin Result := Count; end; +function TRingBuffer.Available(): integer; +begin + Result := BufferCount; +end; + +function TRingBuffer.Size(): integer; +begin + Result := BufferSize; +end; + procedure TRingBuffer.Flush(); begin ReadPos := 0; @@ -150,4 +162,4 @@ begin BufferCount := 0; end; -end.
\ No newline at end of file +end. diff --git a/unicode/src/base/USkins.pas b/unicode/src/base/USkins.pas index df736684..a4722d95 100644 --- a/unicode/src/base/USkins.pas +++ b/unicode/src/base/USkins.pas @@ -35,23 +35,23 @@ interface type TSkinTexture = record - Name: string; - FileName: string; + Name: string; + FileName: string; end; TSkinEntry = record - Theme: string; - Name: string; - Path: string; - FileName: string; - Creator: string; // not used yet + Theme: string; + Name: string; + Path: string; + FileName: string; + Creator: string; // not used yet end; TSkin = class - Skin: array of TSkinEntry; - SkinTexture: array of TSkinTexture; - SkinPath: string; - Color: integer; + Skin: array of TSkinEntry; + SkinTexture: array of TSkinTexture; + SkinPath: string; + Color: integer; constructor Create; procedure LoadList; procedure ParseDir(Dir: string); @@ -63,30 +63,33 @@ type end; var - Skin: TSkin; + Skin: TSkin; implementation -uses IniFiles, - Classes, - SysUtils, - UMain, - ULog, - UIni; +uses + IniFiles, + Classes, + SysUtils, + UIni, + ULog, + UMain, + UPath; constructor TSkin.Create; begin inherited; LoadList; -// LoadSkin('Lisek'); +// LoadSkin('...'); // SkinColor := Color; end; procedure TSkin.LoadList; var - SR: TSearchRec; + SR: TSearchRec; begin - if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then begin + if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then + begin repeat if (SR.Name <> '.') and (SR.Name <> '..') then ParseDir(SkinsPath + SR.Name + PathDelim); @@ -97,9 +100,10 @@ end; procedure TSkin.ParseDir(Dir: string); var - SR: TSearchRec; + SR: TSearchRec; begin - if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin + if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then + begin repeat if (SR.Name <> '.') and (SR.Name <> '..') then @@ -111,8 +115,8 @@ end; procedure TSkin.LoadHeader(FileName: string); var - SkinIni: TMemIniFile; - S: integer; + SkinIni: TMemIniFile; + S: integer; begin SkinIni := TMemIniFile.Create(FileName); @@ -130,10 +134,10 @@ end; procedure TSkin.LoadSkin(Name: string); var - SkinIni: TMemIniFile; - SL: TStringList; - T: integer; - S: integer; + SkinIni: TMemIniFile; + SL: TStringList; + T: integer; + S: integer; begin S := GetSkinNumber(Name); SkinPath := Skin[S].Path; @@ -156,39 +160,43 @@ end; function TSkin.GetTextureFileName(TextureName: string): string; var - T: integer; + T: integer; begin Result := ''; for T := 0 to High(SkinTexture) do begin - if ( SkinTexture[T].Name = TextureName ) AND + if ( SkinTexture[T].Name = TextureName ) and ( SkinTexture[T].FileName <> '' ) then begin Result := SkinPath + SkinTexture[T].FileName; end; end; - if ( TextureName <> '' ) AND - ( Result <> '' ) THEN + if ( TextureName <> '' ) and + ( Result <> '' ) then begin //Log.LogError('', '-----------------------------------------'); //Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName'); end; { Result := SkinPath + 'Bar.jpg'; - if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} + if TextureName = 'Ball' then + Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 4) = 'Gray' then + Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 6) = 'NoteBG' then + Result := SkinPath + 'Ball.bmp';} end; function TSkin.GetSkinNumber(Name: string): integer; var - S: integer; + S: integer; begin Result := 0; // set default to the first available skin for S := 0 to High(Skin) do - if Skin[S].Name = Name then Result := S; + if Skin[S].Name = Name then + Result := S; end; procedure TSkin.onThemeChange; @@ -200,7 +208,8 @@ begin SetLength(ISkin, 0); Name := Uppercase(ITheme[Ini.Theme]); for S := 0 to High(Skin) do - if Name = Uppercase(Skin[S].Theme) then begin + if Name = Uppercase(Skin[S].Theme) then + begin SetLength(ISkin, Length(ISkin)+1); ISkin[High(ISkin)] := Skin[S].Name; end; diff --git a/unicode/src/base/USong.pas b/unicode/src/base/USong.pas index 69c6615d..a547a077 100644 --- a/unicode/src/base/USong.pas +++ b/unicode/src/base/USong.pas @@ -74,7 +74,7 @@ type end; TSong = class - FileLineNo : integer; //Line which is readed at Last, for error reporting + FileLineNo : integer; // line, which is read last, for error reporting function EncodeFilename(Filename: string): string; function Solmizate(Note: integer; Type_: integer): string; @@ -135,8 +135,8 @@ type MultBPM : integer; LastError: AnsiString; - Function GetErrorLineNo: Integer; - Property ErrorLineNo: Integer read GetErrorLineNo; + function GetErrorLineNo: integer; + property ErrorLineNo: integer read GetErrorLineNo; constructor Create(); overload; @@ -151,17 +151,54 @@ type implementation uses + StrUtils, TextGL, UIni, + UPath, UMusic, //needed for Lines - UMain; //needed for Player + UNote; //needed for Player constructor TSong.Create(); begin inherited; end; -constructor TSong.Create( const aFileName : WideString ); +constructor TSong.Create( const aFileName: WideString ); + // This may be changed, when we rewrite song select code. + // it is some kind of dirty, but imho the best possible + // solution as we do atm not support nested categorys. + // it works like the folder sorting in 1.0.1a + // folder is set to the first folder under the songdir + // so songs ~/.ultrastardx/songs/punk is in the same + // category as songs in shared/ultrastardx/songs are. + // note: folder is just the name of a category it has + // nothing to do with the path used for file loading + function GetFolderCategory: WideString; + var + I: Integer; + P: Integer; //position of next path delimiter + begin + Result := 'Unknown'; //default folder category, if we can't locate the song dir + + for I := 0 to SongPaths.Count-1 do + if (AnsiStartsText(SongPaths.Strings[I], aFilename)) then + begin + P := PosEx(PathDelim, aFilename, Length(SongPaths.Strings[I]) + 1); + + If (P > 0) then + begin + // we have found the category name => get it + Result := copy(self.Path, Length(SongPaths.Strings[I]) + 1, P - Length(SongPaths.Strings[I]) - 1); + end + else + begin + // songs are in the "root" of the songdir => use songdir for the categorys name + Result := SongPaths.Strings[I]; + end; + + Exit; + end; + end; begin inherited Create(); @@ -174,7 +211,7 @@ begin if fileexists( aFileName ) then begin self.Path := ExtractFilePath( aFileName ); - self.Folder := ExtractFilePath( aFileName ); + self.Folder := GetFolderCategory; self.FileName := ExtractFileName( aFileName ); (* if ReadTXTHeader( aFileName ) then @@ -229,9 +266,6 @@ begin MultBPM := 4; // multiply beat-count of note by 4 Mult := 1; // accuracy of measurement of note - Base[0] := 100; // high number - Lines[0].ScoreValue := 0; - self.Relative := false; Rel[0] := 0; CP := 0; Both := false; @@ -271,20 +305,24 @@ begin SetLength(Lines, 2); for Count := 0 to High(Lines) do begin - SetLength(Lines[Count].Line, 1); Lines[Count].High := 0; Lines[Count].Number := 1; Lines[Count].Current := 0; Lines[Count].Resolution := self.Resolution; Lines[Count].NotesGAP := self.NotesGAP; + Lines[Count].ScoreValue := 0; + + //Add first line and set some standard values to fields + //see procedure NewSentence for further explantation + //concerning most of these values + SetLength(Lines[Count].Line, 1); Lines[Count].Line[0].HighNote := -1; - Lines[Count].Line[0].LastLine := False; + Lines[Count].Line[0].LastLine := false; + Lines[Count].Line[0].BaseNote := High(Integer); + Lines[Count].Line[0].TotalNotes := 0; end; - //TempC := ':'; - //TempC := Text[1]; // read from backup variable, don't use default ':' value - - while (TempC <> 'E') AND (not EOF(SongFile)) do + while (TempC <> 'E') and (not EOF(SongFile)) do begin if (TempC = ':') or (TempC = '*') or (TempC = 'F') then @@ -296,13 +334,16 @@ begin Read(SongFile, ParamS); //Check for ZeroNote - if Param2 = 0 then Log.LogError('Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamS+'" -> Note ignored!') else + if Param2 = 0 then + Log.LogError('Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamS+'" -> Note ignored!') + else begin // add notes if not Both then // P1 ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) - else begin + else + begin // P1 + P2 ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); @@ -310,24 +351,26 @@ begin end; //Zeronote check end // if - Else if TempC = '-' then + else if TempC = '-' then begin // reads sentence Read(SongFile, Param1); - if self.Relative then Read(SongFile, Param2); // read one more data for relative system + if self.Relative then + Read(SongFile, Param2); // read one more data for relative system // new sentence if not Both then // P1 NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) - else begin + else + begin // P1 + P2 NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); end; end // if - Else if TempC = 'B' then + else if TempC = 'B' then begin SetLength(self.BPM, Length(self.BPM) + 1); Read(SongFile, self.BPM[High(self.BPM)].StartBeat); @@ -338,42 +381,7 @@ begin self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM; end; - - if not Both then - begin - Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP]; - Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(Lines[CP].Line[Lines[CP].High].Lyric); - //Total Notes Patch - Lines[CP].Line[Lines[CP].High].TotalNotes := 0; - for I := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do - begin - if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; - - if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; - end; - //Total Notes Patch End - end - else - begin - for Count := 0 to High(Lines) do - begin - Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count]; - Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(Lines[Count].Line[Lines[Count].High].Lyric); - //Total Notes Patch - Lines[Count].Line[Lines[Count].High].TotalNotes := 0; - for I := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do - begin - if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length; - if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length; - end; - //Total Notes Patch End - end; - end; - ReadLn(SongFile); //Jump to next line in File, otherwise the next Read would catch the linebreak(e.g. #13 #10 on win32) + ReadLn(SongFile); //Jump to next line in File, otherwise the next Read would catch the linebreak(e.g. #13 #10 on win32) Read(SongFile, TempC); Inc(FileLineNo); @@ -381,18 +389,18 @@ begin CloseFile(SongFile); - For I := 0 to High(Lines) do + for I := 0 to High(Lines) do begin - If ((Both) or (I = 0)) then + if ((Both) or (I = 0)) then begin - If (Length(Lines[I].Line) < 2) then + if (Length(Lines[I].Line) < 2) then begin LastError := 'ERROR_CORRUPT_SONG_NO_BREAKS'; Log.LogError('Error Loading File, Can''t find any Linebreaks: "' + fFileName + '"'); exit; end; - If (Lines[I].Line[Lines[I].High].HighNote < 0) then + if (Lines[I].Line[Lines[I].High].HighNote < 0) then begin SetLength(Lines[I].Line, Lines[I].Number - 1); Lines[I].High := Lines[I].High - 1; @@ -404,8 +412,8 @@ begin for Count := 0 to High(Lines) do begin - If (High(Lines[Count].Line) >= 0) then - Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; + if (High(Lines[Count].Line) >= 0) then + Lines[Count].Line[High(Lines[Count].Line)].LastLine := true; end; except try @@ -452,7 +460,6 @@ begin MultBPM := 4; // multiply beat-count of note by 4 Mult := 1; // accuracy of measurement of note - Base[0] := 100; // high number Lines[0].ScoreValue := 0; self.Relative := false; Rel[0] := 0; @@ -467,14 +474,21 @@ begin for Count := 0 to High(Lines) do begin - SetLength(Lines[Count].Line, 1); Lines[Count].High := 0; - Lines[Count].Number := 1; - Lines[Count].Current := 0; - Lines[Count].Resolution := self.Resolution; - Lines[Count].NotesGAP := self.NotesGAP; - Lines[Count].Line[0].HighNote := -1; - Lines[Count].Line[0].LastLine := False; + Lines[Count].Number := 1; + Lines[Count].Current := 0; + Lines[Count].Resolution := self.Resolution; + Lines[Count].NotesGAP := self.NotesGAP; + Lines[Count].ScoreValue := 0; + + //Add first line and set some standard values to fields + //see procedure NewSentence for further explantation + //concerning most of these values + SetLength(Lines[Count].Line, 1); + Lines[Count].Line[0].HighNote := -1; + Lines[Count].Line[0].LastLine := false; + Lines[Count].Line[0].BaseNote := High(Integer); + Lines[Count].Line[0].TotalNotes := 0; end; //Try to Parse the Song @@ -482,7 +496,7 @@ begin if Parser.ParseSong(Path + PathDelim + FileName) then begin //Writeln('XML Inputfile Parsed succesful'); - + //Start write parsed information to Song //Notes Part for I := 0 to High(Parser.SongInfo.Sentences) do @@ -491,8 +505,8 @@ begin for J := 0 to High(Parser.SongInfo.Sentences[I].Notes) do begin case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of - NT_Normal: NoteType := ':'; - NT_Golden: NoteType := '*'; + NT_Normal: NoteType := ':'; + NT_Golden: NoteType := '*'; NT_Freestyle: NoteType := 'F'; end; @@ -511,42 +525,6 @@ begin ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); end; - if not Both then - begin - Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP]; - Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(Lines[CP].Line[Lines[CP].High].Lyric); - //Total Notes Patch - Lines[CP].Line[Lines[CP].High].TotalNotes := 0; - for NoteIndex := 0 to high(Lines[CP].Line[Lines[CP].High].Note) do - begin - if (Lines[CP].Line[Lines[CP].High].Note[NoteIndex].NoteType = ntGolden) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[NoteIndex].Length; - - if (Lines[CP].Line[Lines[CP].High].Note[NoteIndex].NoteType <> ntFreestyle) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[NoteIndex].Length; - end; - //Total Notes Patch End - end - else - begin - for Count := 0 to High(Lines) do - begin - Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count]; - Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(Lines[Count].Line[Lines[Count].High].Lyric); - //Total Notes Patch - Lines[Count].Line[Lines[Count].High].TotalNotes := 0; - for NoteIndex := 0 to high(Lines[Count].Line[Lines[Count].High].Note) do - begin - if (Lines[Count].Line[Lines[Count].High].Note[NoteIndex].NoteType = ntGolden) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[NoteIndex].Length; - if (Lines[Count].Line[Lines[Count].High].Note[NoteIndex].NoteType <> ntFreestyle) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[NoteIndex].Length; - - end; - //Total Notes Patch End - end; - end; { end of for loop } - end; //J Forloop //Add Sentence break @@ -558,8 +536,8 @@ begin //Calculate Time case Rest of 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; - 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1; - 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2; + 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1; + 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2; else if (Rest >= 4) then Time := SentenceEnd + 2 @@ -588,7 +566,7 @@ begin for Count := 0 to High(Lines) do begin - Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; + Lines[Count].Line[High(Lines[Count].Line)].LastLine := true; end; Result := true; @@ -670,7 +648,8 @@ begin //Language Sorting self.Language := Parser.SongInfo.Header.Language; - end else + end + else Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName); Parser.Free; @@ -678,7 +657,7 @@ begin //Check if all Required Values are given if (Done <> 15) then begin - Result := False; + Result := false; if (Done and 8) = 0 then //No BPM Flag Log.LogError('BPM Tag Missing: ' + self.FileName) else if (Done and 4) = 0 then //No MP3 Flag @@ -700,7 +679,7 @@ function TSong.ReadTXTHeader(const aFileName : WideString): boolean; * "International" StrToFloat variant. Uses either ',' or '.' as decimal * separator. *} - function StrToFloatI18n(const Value: string): Extended; + function StrToFloatI18n(const Value: string): extended; var TempValue : string; begin @@ -727,7 +706,7 @@ begin begin Log.LogError('File Starts with Empty Line: ' + Path + PathDelim + aFileName, 'TSong.ReadTXTHeader'); - Result := False; + Result := false; Exit; end; @@ -736,8 +715,7 @@ begin Encoding := encUTF8; //Read Lines while Line starts with # or its empty - while (Length(Line) = 0) or - (Line[1] = '#') do + while (Length(Line) = 0) or (Line[1] = '#') do begin //Increase Line Number Inc (FileLineNo); @@ -898,7 +876,7 @@ begin else if (Identifier = 'RELATIVE') then begin if (UpperCase(Value) = 'YES') then - self.Relative := True; + self.Relative := true; end // File encoding @@ -912,7 +890,7 @@ begin // check for end of file if Eof(SongFile) then begin - Result := False; + Result := false; Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName); Break; end; @@ -927,7 +905,7 @@ begin //Check if all Required Values are given if (Done <> 15) then begin - Result := False; + Result := false; if (Done and 8) = 0 then //No BPM Flag Log.LogError('BPM Tag Missing: ' + self.FileName) else if (Done and 4) = 0 then //No MP3 Flag @@ -942,11 +920,11 @@ begin end; -Function TSong.GetErrorLineNo: Integer; +function TSong.GetErrorLineNo: integer; begin - If (LastError='ERROR_CORRUPT_SONG_ERROR_IN_LINE') then + if (LastError='ERROR_CORRUPT_SONG_ERROR_IN_LINE') then Result := FileLineNo - Else + else Result := -1; end; @@ -1001,7 +979,7 @@ begin begin SetLength(Note, Length(Note) + 1); HighNote := High(Note); - + Note[HighNote].Start := StartP; if HighNote = 0 then begin @@ -1019,18 +997,28 @@ begin '*': Note[HighNote].NoteType := ntGolden; end; - if (Note[HighNote].NoteType = ntGolden) then - Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; - - if (Note[HighNote].NoteType <> ntFreestyle) then - Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; + //add this notes value ("notes length" * "notes scorefactor") to the current songs entire value + Inc(Lines[LineNumber].ScoreValue, Note[HighNote].Length * ScoreFactor[Note[HighNote].NoteType]); + + //and to the current lines entire value + Inc(TotalNotes, Note[HighNote].Length * ScoreFactor[Note[HighNote].NoteType]); + Note[HighNote].Tone := NoteP; - if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone; - Note[HighNote].Text := RecodeStringUTF8( - Copy(LyricS, 2, Length(LyricS)-1), - Encoding); + //if a note w/ a deeper pitch then the current basenote is found + //we replace the basenote w/ the current notes pitch + if Note[HighNote].Tone < BaseNote then + BaseNote := Note[HighNote].Tone; + + //delete the space that seperates the notes pitch from its lyrics + //it is left in the LyricS string because Read("some ordinal type") will + //set the files pointer to the first whitespace character after the + //ordinal string. Trim is no solution because it would cut the spaces + //that seperate the words of the lyrics, too. + Delete(LyricS, 1, 1); + + Note[HighNote].Text := RecodeStringUTF8(LyricS, Encoding); Lyric := Lyric + Note[HighNote].Text; End_ := Note[HighNote].Start + Note[HighNote].Length; @@ -1042,37 +1030,30 @@ var I: integer; begin - If (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then - begin //Update old Sentence if it has notes and create a new sentence - // stara czesc //Alter Satz //Update Old Part - Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP]; - Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric); - - //Total Notes Patch - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0; - for I := low(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) to high(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) do - begin - if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType = ntGolden) then - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; - - if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType <> ntFreestyle) then - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; - end; - //Total Notes Patch End - - - // nowa czesc //Neuer Satz //Update New Part + if (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then + begin //create a new line SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1); - Lines[LineNumberP].High := Lines[LineNumberP].High + 1; - Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1; + Inc(Lines[LineNumberP].High); + Inc(Lines[LineNumberP].Number); end else - begin //Use old Sentence if it has no notes + begin //use old line if it there were no notes added since last call of NewSentence Log.LogError('Error loading Song, sentence w/o note found in line ' + InttoStr(FileLineNo) + ': ' + Filename); end; Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1; + //set the current lines value to zero + //it will be incremented w/ the value of every added note + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0; + + //basenote is the pitch of the deepest note, it is used for note drawing. + //if a note with a less value than the current sentences basenote is found, + //basenote will be set to this notes pitch. Therefore the initial value of + //this field has to be very high. + Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := High(Integer); + + if self.Relative then begin Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; @@ -1081,9 +1062,7 @@ begin else Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; - Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := False; - - Base[LineNumberP] := 100; // high number + Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := false; end; procedure TSong.clear(); @@ -1122,13 +1101,13 @@ begin Resolution := 4; Creator := ''; + Relative := false; end; - function TSong.Analyse(): boolean; begin - Result := False; + Result := false; //Reset LineNo FileLineNo := 0; @@ -1155,7 +1134,7 @@ end; function TSong.AnalyseXML(): boolean; begin - Result := False; + Result := false; //Reset LineNo FileLineNo := 0; diff --git a/unicode/src/base/USongs.pas b/unicode/src/base/USongs.pas index ac67eed0..852ccfc4 100644 --- a/unicode/src/base/USongs.pas +++ b/unicode/src/base/USongs.pas @@ -158,11 +158,13 @@ implementation uses StrUtils, - UGraphic, UCovers, UFiles, + UGraphic, UMain, UIni, + UPath, + UNote, UUnicodeUtils; constructor TSongs.Create(); @@ -282,7 +284,11 @@ var lSong : TSong; begin - Files := Platform.DirectoryFindFiles( Dir, '.txt', true); + try + Files := Platform.DirectoryFindFiles( Dir, '.txt', true) + except + Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseTXTFiles') + end; for i := 0 to Length(Files)-1 do begin @@ -315,7 +321,11 @@ var lSong : TSong; begin - Files := Platform.DirectoryFindFiles( Dir, '.xml', true); + try + Files := Platform.DirectoryFindFiles( Dir, '.xml', true) + except + Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseXMLFiles') + end; for i := 0 to Length(Files)-1 do begin @@ -670,7 +680,7 @@ begin end; // set CatNumber of last category - if (Ini.Tabs_at_startup = 1) and (High(Song) >= 1) then + if (Ini.TabsAtStartup = 1) and (High(Song) >= 1) then begin // set number of songs in previous category SongIndex := CatIndex - CatNumber; diff --git a/unicode/src/base/UTexture.pas b/unicode/src/base/UTexture.pas index 4f33b78a..962bd2b0 100644 --- a/unicode/src/base/UTexture.pas +++ b/unicode/src/base/UTexture.pas @@ -93,7 +93,7 @@ type TTextureEntry = record Name: string; Typ: TTextureType; - Color: Cardinal; + Color: cardinal; // we use normal TTexture, it's easier to implement and if needed - we copy ready data Texture: TTexture; // Full-size texture @@ -104,8 +104,8 @@ type private Texture: array of TTextureEntry; public - procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); - function FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer; + procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean); + function FindTexture(const Name: string; Typ: TTextureType; Color: cardinal): integer; end; TTextureUnit = class @@ -115,7 +115,7 @@ type Limit: integer; procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload; - procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean = false); overload; + procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean = false); overload; function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload; function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload; function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload; @@ -123,7 +123,7 @@ type function LoadTexture(const Identifier: string): TTexture; overload; function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload; - procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload; + procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: cardinal; FromCache: boolean); overload; //procedure FlushTextureDatabase(); constructor Create; @@ -164,10 +164,10 @@ begin SDL_FreeSurface(TempSurface); end; end; - + { TTextureDatabase } -procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); +procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean); var TextureIndex: integer; begin @@ -188,7 +188,7 @@ begin Texture[TextureIndex].Texture := Tex; end; -function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer; +function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: cardinal): integer; var TextureIndex: integer; CurrentTexture: PTextureEntry; @@ -211,7 +211,6 @@ begin end; end; - { TTextureUnit } constructor TTextureUnit.Create; @@ -226,13 +225,12 @@ begin inherited Destroy; end; - procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean); begin TextureDatabase.AddTexture(Tex, Typ, 0, Cache); end; -procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); +procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean); begin TextureDatabase.AddTexture(Tex, Typ, Color, Cache); end; @@ -251,8 +249,8 @@ end; function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; var TexSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; + newWidth, newHeight: integer; + oldWidth, oldHeight: integer; ActTex: GLuint; begin // zero texture data @@ -431,8 +429,8 @@ begin {$ELSE} glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data); {$ENDIF} - - { + +{ if Mipmapping then begin Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); @@ -440,8 +438,8 @@ begin if Error > 0 then Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture'); end; - } - +} + Result.X := 0; Result.Y := 0; Result.Z := 0; @@ -474,14 +472,14 @@ begin UnloadTexture(Name, Typ, 0, FromCache); end; -procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); +procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: cardinal; FromCache: boolean); var T: integer; TexNum: GLuint; begin T := TextureDatabase.FindTexture(Name, Typ, Col); - if not FromCache then + if not FromCache then begin TexNum := TextureDatabase.Texture[T].Texture.TexNum; if TexNum > 0 then @@ -529,20 +527,20 @@ end; function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType; var - TexType: TTextureType; + TextureType: TTextureType; UpCaseStr: string; begin UpCaseStr := UpperCase(TypeStr); - for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do + for TextureType := Low(TextureTypeStr) to High(TextureTypeStr) do begin - if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then + if (UpCaseStr = UpperCase(TextureTypeStr[TextureType])) then begin - Result := TexType; + Result := TextureType; Exit; end; end; - Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType'); - Result := TEXTURE_TYPE_PLAIN; + Log.LogWarn('Unknown texture type: "' + TypeStr + '". Using default texture type "' + TextureTypeToStr(Default) + '"', 'ParseTextureType'); + Result := Default; end; end. diff --git a/unicode/src/base/UThemes.pas b/unicode/src/base/UThemes.pas index 361ed87d..9bf858ed 100644 --- a/unicode/src/base/UThemes.pas +++ b/unicode/src/base/UThemes.pas @@ -484,6 +484,16 @@ type ButtonExit: TThemeButton; end; + TThemeEdit = class(TThemeBasic) + ButtonConvert: TThemeButton; + ButtonExit: TThemeButton; + + TextDescription: TThemeText; + TextDescriptionLong: TThemeText; + Description: array[0..5] of string; + DescriptionLong: array[0..5] of string; + end; + //Error- and Check-Popup TThemeError = class(TThemeBasic) Button1: TThemeButton; @@ -723,6 +733,8 @@ type OptionsThemes: TThemeOptionsThemes; OptionsRecord: TThemeOptionsRecord; OptionsAdvanced: TThemeOptionsAdvanced; + //edit + Edit: TThemeEdit; //error and check popup ErrorPopup: TThemeError; CheckPopup: TThemeCheck; @@ -852,6 +864,8 @@ begin OptionsRecord := TThemeOptionsRecord.Create; OptionsAdvanced := TThemeOptionsAdvanced.Create; + Edit := TThemeEdit.Create; + ErrorPopup := TThemeError.Create; CheckPopup := TThemeCheck.Create; @@ -1246,6 +1260,18 @@ begin ThemeLoadSelectSlide(OptionsAdvanced.SelectPartyPopup, 'OptionsAdvancedSelectPartyPopup'); ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit'); + //Edit Menu + ThemeLoadBasic (Edit, 'Edit'); + + ThemeLoadButton(Edit.ButtonConvert, 'EditButtonConvert'); + ThemeLoadButton(Edit.ButtonExit, 'EditButtonExit'); + + Edit.Description[0] := Language.Translate('SING_EDIT_BUTTON_DESCRIPTION_CONVERT'); + Edit.Description[1] := Language.Translate('SING_EDIT_BUTTON_DESCRIPTION_EXIT'); + + ThemeLoadText(Edit.TextDescription, 'EditTextDescription'); + Edit.TextDescription.Text := Edit.Description[0]; + //error and check popup ThemeLoadBasic (ErrorPopup, 'ErrorPopup'); ThemeLoadButton(ErrorPopup.Button1, 'ErrorPopupButton1'); @@ -2310,6 +2336,9 @@ begin freeandnil(OptionsAdvanced); OptionsAdvanced := TThemeOptionsAdvanced.Create; + freeandnil(Edit); + Edit := TThemeEdit.Create; + freeandnil(ErrorPopup); ErrorPopup := TThemeError.Create; diff --git a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas index 2dc99df5..d1231cdd 100644 --- a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas +++ b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas @@ -131,7 +131,7 @@ const {$IFDEF DARWIN} GLLibName = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; {$ELSE} - GLLibName = 'libGL.so'; + GLLibName = 'libGL.so.1'; {$ENDIF} {$ENDIF} diff --git a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas index 29647d12..876270ff 100644 --- a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas +++ b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas @@ -140,7 +140,7 @@ const {$IFDEF DARWIN} GLuLibName = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGLU.dylib'; {$ELSE} - GLuLibName = 'libGLU.so'; + GLuLibName = 'libGLU.so.1'; {$ENDIF} {$ENDIF} diff --git a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas index f43a4e4c..9f36d2b5 100644 --- a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas +++ b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas @@ -266,8 +266,7 @@ end; function InitGLX: Boolean; begin - Result := InitGLXFromLibrary('libGL.so') or - InitGLXFromLibrary('libGL.so.1') or + Result := InitGLXFromLibrary('libGL.so.1') or InitGLXFromLibrary('libMesaGL.so') or InitGLXFromLibrary('libMesaGL.so.3'); end; diff --git a/unicode/src/lib/collections/CollArray.pas b/unicode/src/lib/collections/CollArray.pas new file mode 100644 index 00000000..a10ba905 --- /dev/null +++ b/unicode/src/lib/collections/CollArray.pas @@ -0,0 +1,183 @@ +unit CollArray; + +(***************************************************************************** + * Copyright 2003 by Matthew Greet + * This library is free software; you can redistribute it and/or modify it + * under the terms of the GNU Lesser General Public License as published by the + * Free Software Foundation; either version 2.1 of the License, or (at your + * option) any later version. + * + * This library is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + * details. (http://opensource.org/licenses/lgpl-license.php) + * + * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads. + * + * $Version: v1.0.3 $ + * $Revision: 1.2 $ + * $Log: D:\QVCS Repositories\Delphi Collections\CollArray.qbt $ + * + * Colllection implementations based on arrays. + * + * Revision 1.2 by: Matthew Greet Rev date: 12/06/04 20:02:16 + * Capacity property. + * + * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:30:36 + * Size property dropped. + * Unused abstract functions still implemented. + * + * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02 + * Initial revision. + * + * FPC compatibility fixes by: UltraStar Deluxe Team + * + * $Endlog$ + *****************************************************************************) + +{$IFDEF FPC} + {$MODE Delphi}{$H+} +{$ENDIF} + +interface + +uses + Collections; + +type + TArray = class(TAbstractList) + private + FArray: array of ICollectable; + protected + function TrueGetItem(Index: Integer): ICollectable; override; + procedure TrueSetItem(Index: Integer; const Value: ICollectable); override; + procedure TrueAppend(const Item: ICollectable); override; + procedure TrueClear; override; + function TrueDelete(Index: Integer): ICollectable; override; + procedure TrueInsert(Index: Integer; const Item: ICollectable); override; + public + constructor Create(NaturalItemsOnly: Boolean); override; + constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean = false); override; + constructor Create(Size: Integer; NaturalItemsOnly: Boolean = false); overload; virtual; + constructor Create(const Collection: ICollection); override; + destructor Destroy; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + function GetFixedSize: Boolean; override; + function GetSize: Integer; override; + end; + +implementation + +constructor TArray.Create(NaturalItemsOnly: Boolean); +begin + Create(0, NaturalItemsOnly); +end; + +constructor TArray.Create(Size: Integer; NaturalItemsOnly: Boolean = false); +begin + inherited Create(NaturalItemsOnly); + SetLength(FArray, Size); +end; + +constructor TArray.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); +var + Item: ICollectable; + ItemError: TCollectionError; + I: Integer; +begin + inherited Create(ItemArray, NaturalItemsOnly); + SetLength(FArray, Length(ItemArray)); + for I := Low(ItemArray) to High(ItemArray) do + begin + Item := ItemArray[I]; + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + end + else + Items[I] := Item; + end; +end; + +constructor TArray.Create(const Collection: ICollection); +var + Iterator: IIterator; + I: Integer; +begin + inherited Create(Collection); + SetLength(FArray, Collection.GetSize); + Iterator := Collection.GetIterator; + I := 0; + while not Iterator.EOF do + begin + Items[I] := Iterator.CurrentItem; + Inc(I); + Iterator.Next; + end; +end; + +destructor TArray.Destroy; +var + I: Integer; +begin + // Delete interface references to all items + for I := Low(FArray) to High(FArray) do + begin + FArray[I] := nil; + end; + inherited Destroy; +end; + +function TArray.TrueGetItem(Index: Integer): ICollectable; +begin + Result := FArray[Index]; +end; + +procedure TArray.TrueSetItem(Index: Integer; const Value: ICollectable); +begin + FArray[Index] := Value; +end; + +procedure TArray.TrueAppend(const Item: ICollectable); +begin + // Ignored as collection is fixed size +end; + +procedure TArray.TrueClear; +begin + // Ignored as collection is fixed size +end; + +function TArray.TrueDelete(Index: Integer): ICollectable; +begin + // Ignored as collection is fixed size +end; + +procedure TArray.TrueInsert(Index: Integer; const Item: ICollectable); +begin + // Ignored as collection is fixed size +end; + +function TArray.GetCapacity: Integer; +begin + Result := Size; +end; + +procedure TArray.SetCapacity(Value: Integer); +begin + // Ignored +end; + +function TArray.GetFixedSize: Boolean; +begin + Result := true; +end; + +function TArray.GetSize: Integer; +begin + Result := Length(FArray); +end; + +end. diff --git a/unicode/src/lib/collections/CollHash.pas b/unicode/src/lib/collections/CollHash.pas new file mode 100644 index 00000000..796fc740 --- /dev/null +++ b/unicode/src/lib/collections/CollHash.pas @@ -0,0 +1,1497 @@ +unit CollHash; + +(***************************************************************************** + * Copyright 2003 by Matthew Greet + * This library is free software; you can redistribute it and/or modify it + * under the terms of the GNU Lesser General Public License as published by the + * Free Software Foundation; either version 2.1 of the License, or (at your + * option) any later version. + * + * This library is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + * details. (http://opensource.org/licenses/lgpl-license.php) + * + * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads. + * + * $Version: v1.0.3 $ + * $Revision: 1.1.1.2 $ + * $Log: D:\QVCS Repositories\Delphi Collections\CollHash.qbt $ + * + * Collection implementations based on hash tables. + * + * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:04:30 + * Capacity property. + * + * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16 + * v1.0 branch. + * + * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:40:16 + * Added integer map and string map versions. + * THashSet uses its own implementation, not THashMap. + * DefaulMaxLoadFactor changed. + * + * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02 + * Initial revision. + * + * FPC compatibility fixes by: UltraStar Deluxe Team + * + * $Endlog$ + *****************************************************************************) + +{$IFDEF FPC} + {$MODE Delphi}{$H+} +{$ENDIF} + +interface + +uses + Classes, Math, + Collections; + +const + DefaultTableSize = 100; + MaxLoadFactorMin = 0.01; // Minimum allowed value for MaxLoadFactor property. + DefaultMaxLoadFactor = 5.0; + +type + THashMap = class(TAbstractMap) + private + FArray: TListArray; + FCapacity: Integer; + FMaxLoadFactor: Double; + FSize: Integer; + FTableSize: Integer; + protected + function GetAssociationIterator: IMapIterator; override; + procedure SetMaxLoadFactor(Value: Double); virtual; + procedure SetTableSize(Value: Integer); virtual; + procedure ChangeCapacity(Value: TListArray); virtual; + procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual; + function GetHash(const Key: ICollectable): Integer; virtual; + function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override; + procedure Rehash; + procedure TrueClear; override; + function TrueGet(Position: TCollectionPosition): IAssociation; override; + function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override; + function TrueRemove2(Position: TCollectionPosition): IAssociation; override; + public + constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override; + destructor Destroy; override; + class function GetAlwaysNaturalKeys: Boolean; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + function GetNaturalKeyIID: TGUID; override; + function GetSize: Integer; override; + property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor; + property TableSize: Integer read FTableSize write SetTableSize; + end; + + THashSet = class(TAbstractSet) + private + FArray: TListArray; + FCapacity: Integer; + FMaxLoadFactor: Double; + FSize: Integer; + FTableSize: Integer; + protected + procedure SetMaxLoadFactor(Value: Double); virtual; + procedure SetTableSize(Value: Integer); virtual; + procedure ChangeCapacity(Value: TListArray); virtual; + procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual; + function GetHash(const Item: ICollectable): Integer; virtual; + function GetPosition(const Item: ICollectable): TCollectionPosition; override; + procedure Rehash; + procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override; + procedure TrueClear; override; + function TrueGet(Position: TCollectionPosition): ICollectable; override; + procedure TrueRemove2(Position: TCollectionPosition); override; + public + constructor Create(NaturalItemsOnly: Boolean); override; + destructor Destroy; override; + class function GetAlwaysNaturalItems: Boolean; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + function GetIterator: IIterator; override; + function GetNaturalItemIID: TGUID; override; + function GetSize: Integer; override; + property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor; + property TableSize: Integer read FTableSize write SetTableSize; + end; + + THashIntegerMap = class(TAbstractIntegerMap) + private + FArray: TListArray; + FCapacity: Integer; + FMaxLoadFactor: Double; + FSize: Integer; + FTableSize: Integer; + protected + function GetAssociationIterator: IIntegerMapIterator; override; + procedure SetMaxLoadFactor(Value: Double); virtual; + procedure SetTableSize(Value: Integer); virtual; + procedure ChangeCapacity(Value: TListArray); virtual; + procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual; + function GetHash(const Key: Integer): Integer; virtual; + function GetKeyPosition(const Key: Integer): TCollectionPosition; override; + procedure Rehash; + procedure TrueClear; override; + function TrueGet(Position: TCollectionPosition): IIntegerAssociation; override; + function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; override; + function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; override; + public + constructor Create; override; + constructor Create(NaturalItemsOnly: Boolean); override; + constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual; + destructor Destroy; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + function GetSize: Integer; override; + property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor; + property TableSize: Integer read FTableSize write SetTableSize; + end; + + THashStringMap = class(TAbstractStringMap) + private + FArray: TListArray; + FCapacity: Integer; + FMaxLoadFactor: Double; + FSize: Integer; + FTableSize: Integer; + protected + function GetAssociationIterator: IStringMapIterator; override; + procedure SetMaxLoadFactor(Value: Double); virtual; + procedure SetTableSize(Value: Integer); virtual; + procedure ChangeCapacity(Value: TListArray); virtual; + procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual; + function GetHash(const Key: String): Integer; virtual; + function GetKeyPosition(const Key: String): TCollectionPosition; override; + procedure Rehash; + procedure TrueClear; override; + function TrueGet(Position: TCollectionPosition): IStringAssociation; override; + function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; override; + function TrueRemove2(Position: TCollectionPosition): IStringAssociation; override; + public + constructor Create; override; + constructor Create(NaturalItemsOnly: Boolean); override; + constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual; + destructor Destroy; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + function GetSize: Integer; override; + property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor; + property TableSize: Integer read FTableSize write SetTableSize; + end; + +implementation + +const + (* (sqrt(5) - 1)/2 + See Introduction to Algorithms in Pascal, 1995, by Thomas W. Parsons, + published by John Wiley & Sons, Inc, ISBN 0-471-11600-9 + *) + HashFactor = 0.618033988749894848204586834365638; + +type + THashIterator = class(TAbstractIterator) + private + FHashSet: THashSet; + FHash: Integer; + FChainIndex: Integer; + protected + constructor Create(HashSet: THashSet); + function TrueFirst: ICollectable; override; + function TrueNext: ICollectable; override; + procedure TrueRemove; override; + end; + + THashAssociationIterator = class(TAbstractAssociationIterator) + private + FHashMap: THashMap; + FHash: Integer; + FChainIndex: Integer; + protected + constructor Create(HashMap: THashMap); + function TrueFirst: IAssociation; override; + function TrueNext: IAssociation; override; + procedure TrueRemove; override; + end; + + THashIntegerIterator = class(TAbstractIntegerAssociationIterator) + private + FHashIntegerMap: THashIntegerMap; + FHash: Integer; + FChainIndex: Integer; + protected + constructor Create(HashIntegerMap: THashIntegerMap); + function TrueFirst: IIntegerAssociation; override; + function TrueNext: IIntegerAssociation; override; + procedure TrueRemove; override; + end; + + THashStringIterator = class(TAbstractStringAssociationIterator) + private + FHashStringMap: THashStringMap; + FHash: Integer; + FChainIndex: Integer; + protected + constructor Create(HashStringMap: THashStringMap); + function TrueFirst: IStringAssociation; override; + function TrueNext: IStringAssociation; override; + procedure TrueRemove; override; + end; + + THashPosition = class(TCollectionPosition) + private + FChain: TList; + FIndex: Integer; + public + constructor Create(Found: Boolean; Chain: TList; Index: Integer); + property Chain: TList read FChain; + property Index: Integer read FIndex; + end; + +{ THashMap } +constructor THashMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); +var + I: Integer; +begin + // Force use of natural keys + inherited Create(NaturalItemsOnly, true); + FTableSize := DefaultTableSize; + FMaxLoadFactor := DefaultMaxLoadFactor; + SetLength(FArray, FTableSize); + for I := Low(FArray) to High(FArray) do + FArray[I] := TList.Create; + FCapacity := 0; + FSize := 0; + ChangeCapacity(FArray); +end; + +destructor THashMap.Destroy; +var + I: Integer; +begin + for I := Low(FArray) to High(FArray) do + FArray[I].Free; + FArray := nil; + inherited Destroy; +end; + +class function THashMap.GetAlwaysNaturalKeys: Boolean; +begin + Result := true; +end; + +function THashMap.GetNaturalKeyIID: TGUID; +begin + Result := HashableIID; +end; + +function THashMap.GetAssociationIterator: IMapIterator; +begin + Result := THashAssociationIterator.Create(Self); +end; + +procedure THashMap.SetTableSize(Value: Integer); +begin + if (FTableSize <> Value) and (Value >= 1) then + begin + FTableSize := Value; + Rehash; + end; +end; + +procedure THashMap.SetMaxLoadFactor(Value: Double); +begin + if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then + begin + FMaxLoadFactor := Value; + CheckLoadFactor(false); + end; +end; + +procedure THashMap.ChangeCapacity(Value: TListArray); +var + Chain: TList; + I, Total, ChainCapacity: Integer; +begin + if FCapacity mod FTableSize = 0 then + ChainCapacity := Trunc(FCapacity / FTableSize) + else + ChainCapacity := Trunc(FCapacity / FTableSize) + 1; + Total := 0; + for I := Low(Value) to High(Value) do + begin + Chain := Value[I]; + Chain.Capacity := ChainCapacity; + Total := Total + Chain.Capacity; + end; + FCapacity := Total; +end; + +procedure THashMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean); +var + LoadFactor: Double; +begin + LoadFactor := Capacity / TableSize; + if LoadFactor > MaxLoadFactor then + TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin)) + else if AlwaysChangeCapacity then + ChangeCapacity(FArray); +end; + +function THashMap.GetHash(const Key: ICollectable): Integer; +var + Hashable: IHashable; + HashCode: Cardinal; +begin + Key.QueryInterface(IHashable, Hashable); + HashCode := Hashable.HashCode; + Result := Trunc(Frac(HashCode * HashFactor) * TableSize); +end; + +function THashMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition; +var + Chain: TList; + I: Integer; + Success: Boolean; +begin + Chain := FArray[GetHash(Key)]; + Success := false; + for I := 0 to Chain.Count - 1 do + begin + Success := KeyComparator.Equals(Key, IAssociation(Chain[I]).GetKey); + if Success then + Break; + end; + Result := THashPosition.Create(Success, Chain, I); +end; + +procedure THashMap.Rehash; +var + NewArray: TListArray; + OldChain, NewChain: TList; + Association: IAssociation; + Total: Integer; + I, J: Integer; + Hash: Integer; +begin + // Create new chains + SetLength(NewArray, TableSize); + for I := Low(NewArray) to High(NewArray) do + begin + NewChain := TList.Create; + NewArray[I] := NewChain; + end; + ChangeCapacity(NewArray); + + // Transfer from old chains to new and drop old + for I := Low(FArray) to High(FArray) do + begin + OldChain := FArray[I]; + for J := 0 to OldChain.Count - 1 do + begin + Association := IAssociation(OldChain[J]); + Hash := GetHash(Association.GetKey); + NewArray[Hash].Add(Pointer(Association)); + end; + OldChain.Free; + end; + FArray := NewArray; + + // Find actual, new capacity + Total := 0; + for I := Low(FArray) to High(FArray) do + begin + NewChain := FArray[I]; + Total := Total + NewChain.Capacity; + end; + FCapacity := Total; +end; + +procedure THashMap.TrueClear; +var + Association: IAssociation; + Chain: TList; + I, J: Integer; +begin + for I := Low(FArray) to High(FArray) do + begin + Chain := FArray[I]; + for J := 0 to Chain.Count - 1 do + begin + Association := IAssociation(Chain[J]); + Chain[J] := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; + end; + Chain.Clear; + end; + FSize := 0; +end; + +function THashMap.TrueGet(Position: TCollectionPosition): IAssociation; +var + HashPosition: THashPosition; +begin + HashPosition := THashPosition(Position); + Result := IAssociation(HashPosition.Chain.Items[HashPosition.Index]); +end; + +function THashMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; +var + HashPosition: THashPosition; + OldAssociation: IAssociation; +begin + HashPosition := THashPosition(Position); + if HashPosition.Found then + begin + OldAssociation := IAssociation(HashPosition.Chain.Items[HashPosition.Index]); + HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association); + Result := OldAssociation; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._AddRef; + OldAssociation._Release; + end + else + begin + HashPosition.Chain.Add(Pointer(Association)); + Inc(FSize); + Result := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._AddRef; + end; +end; + +function THashMap.TrueRemove2(Position: TCollectionPosition): IAssociation; +var + Association: IAssociation; + HashPosition: THashPosition; +begin + HashPosition := THashPosition(Position); + Association := IAssociation(TrueGet(Position)); + HashPosition.Chain.Delete(HashPosition.Index); + Dec(FSize); + Result := Association; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; +end; + +function THashMap.GetCapacity; +begin + Result := FCapacity; +end; + +procedure THashMap.SetCapacity(Value: Integer); +begin + FCapacity := Value; + CheckLoadFactor(true); +end; + +function THashMap.GetSize: Integer; +begin + Result := FSize; +end; + +{ THashSet } +constructor THashSet.Create(NaturalItemsOnly: Boolean); +var + I: Integer; +begin + // Force use of natural items + inherited Create(true); + FTableSize := DefaultTableSize; + FMaxLoadFactor := DefaultMaxLoadFactor; + SetLength(FArray, FTableSize); + for I := Low(FArray) to High(FArray) do + FArray[I] := TList.Create; + FSize := 0; +end; + +destructor THashSet.Destroy; +var + I: Integer; +begin + for I := Low(FArray) to High(FArray) do + FArray[I].Free; + FArray := nil; + inherited Destroy; +end; + +procedure THashSet.SetTableSize(Value: Integer); +begin + if (FTableSize <> Value) and (Value >= 1) then + begin + FTableSize := Value; + Rehash; + end; +end; + +procedure THashSet.SetMaxLoadFactor(Value: Double); +begin + if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then + begin + FMaxLoadFactor := Value; + CheckLoadFactor(false); + end; +end; + +procedure THashSet.ChangeCapacity(Value: TListArray); +var + Chain: TList; + I, Total, ChainCapacity: Integer; +begin + if FCapacity mod FTableSize = 0 then + ChainCapacity := Trunc(FCapacity / FTableSize) + else + ChainCapacity := Trunc(FCapacity / FTableSize) + 1; + Total := 0; + for I := Low(Value) to High(Value) do + begin + Chain := Value[I]; + Chain.Capacity := ChainCapacity; + Total := Total + Chain.Capacity; + end; + FCapacity := Total; +end; + +procedure THashSet.CheckLoadFactor(AlwaysChangeCapacity: Boolean); +var + LoadFactor: Double; +begin + LoadFactor := Capacity / TableSize; + if LoadFactor > MaxLoadFactor then + TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin)) + else if AlwaysChangeCapacity then + ChangeCapacity(FArray); +end; + +function THashSet.GetHash(const Item: ICollectable): Integer; +var + Hashable: IHashable; + HashCode: Cardinal; +begin + Item.QueryInterface(IHashable, Hashable); + HashCode := Hashable.HashCode; + Result := Trunc(Frac(HashCode * HashFactor) * TableSize); +end; + +function THashSet.GetPosition(const Item: ICollectable): TCollectionPosition; +var + Chain: TList; + I: Integer; + Success: Boolean; +begin + Chain := FArray[GetHash(Item)]; + Success := false; + for I := 0 to Chain.Count - 1 do + begin + Success := Comparator.Equals(Item, ICollectable(Chain[I])); + if Success then + Break; + end; + Result := THashPosition.Create(Success, Chain, I); +end; + +procedure THashSet.Rehash; +var + NewArray: TListArray; + OldChain, NewChain: TList; + Item: ICollectable; + Total: Integer; + I, J: Integer; + Hash: Integer; +begin + // Create new chains + SetLength(NewArray, TableSize); + for I := Low(NewArray) to High(NewArray) do + begin + NewChain := TList.Create; + NewArray[I] := NewChain; + end; + ChangeCapacity(NewArray); + + // Transfer from old chains to new and drop old + for I := Low(FArray) to High(FArray) do + begin + OldChain := FArray[I]; + for J := 0 to OldChain.Count - 1 do + begin + Item := ICollectable(OldChain[J]); + Hash := GetHash(Item); + NewArray[Hash].Add(Pointer(Item)); + end; + OldChain.Free; + end; + FArray := NewArray; + + // Find actual, new capacity + Total := 0; + for I := Low(FArray) to High(FArray) do + begin + NewChain := FArray[I]; + Total := Total + NewChain.Capacity; + end; + FCapacity := Total; +end; + +procedure THashSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); +var + HashPosition: THashPosition; +begin + HashPosition := THashPosition(Position); + HashPosition.Chain.Add(Pointer(Item)); + Inc(FSize); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Item._AddRef; +end; + +procedure THashSet.TrueClear; +var + Item: ICollectable; + Chain: TList; + I, J: Integer; +begin + for I := Low(FArray) to High(FArray) do + begin + Chain := FArray[I]; + for J := 0 to Chain.Count - 1 do + begin + Item := ICollectable(Chain[J]); + Chain[J] := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Item._Release; + end; + Chain.Clear; + end; + FSize := 0; +end; + +function THashSet.TrueGet(Position: TCollectionPosition): ICollectable; +var + HashPosition: THashPosition; +begin + HashPosition := THashPosition(Position); + Result := ICollectable(HashPosition.Chain.Items[HashPosition.Index]); +end; + +procedure THashSet.TrueRemove2(Position: TCollectionPosition); +var + Item: ICollectable; + HashPosition: THashPosition; +begin + HashPosition := THashPosition(Position); + Item := TrueGet(Position); + HashPosition.Chain.Delete(HashPosition.Index); + Dec(FSize); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Item._Release; +end; + +class function THashSet.GetAlwaysNaturalItems: Boolean; +begin + Result := true; +end; + +function THashSet.GetIterator: IIterator; +begin + Result := THashIterator.Create(Self); +end; + +function THashSet.GetNaturalItemIID: TGUID; +begin + Result := HashableIID; +end; + +function THashSet.GetCapacity; +begin + Result := FCapacity; +end; + +procedure THashSet.SetCapacity(Value: Integer); +begin + FCapacity := Value; + CheckLoadFactor(true); +end; + +function THashSet.GetSize: Integer; +begin + Result := FSize; +end; + +{ THashIntegerMap } +constructor THashIntegerMap.Create; +begin + Create(false, DefaultTableSize, DefaultMaxLoadFactor); +end; + +constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean); +begin + Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor); +end; + +constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); +var + I: Integer; +begin + inherited Create(NaturalItemsOnly); + SetLength(FArray, TableSize); + for I := Low(FArray) to High(FArray) do + FArray[I] := TList.Create; + FTableSize := TableSize; + FMaxLoadFactor := MaxLoadFactor; + FSize := 0; +end; + +destructor THashIntegerMap.Destroy; +var + I: Integer; +begin + for I := Low(FArray) to High(FArray) do + FArray[I].Free; + FArray := nil; + inherited Destroy; +end; + +function THashIntegerMap.GetAssociationIterator: IIntegerMapIterator; +begin + Result := THashIntegerIterator.Create(Self); +end; + +procedure THashIntegerMap.SetTableSize(Value: Integer); +begin + if (FTableSize <> Value) and (Value >= 1) then + begin + FTableSize := Value; + Rehash; + end; +end; + +procedure THashIntegerMap.SetMaxLoadFactor(Value: Double); +begin + if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then + begin + FMaxLoadFactor := Value; + CheckLoadFactor(false); + end; +end; + +procedure THashIntegerMap.ChangeCapacity; +var + Chain: TList; + I, Total, ChainCapacity: Integer; +begin + if FCapacity mod FTableSize = 0 then + ChainCapacity := Trunc(FCapacity / FTableSize) + else + ChainCapacity := Trunc(FCapacity / FTableSize) + 1; + Total := 0; + for I := Low(Value) to High(Value) do + begin + Chain := Value[I]; + Chain.Capacity := ChainCapacity; + Total := Total + Chain.Capacity; + end; + FCapacity := Total; +end; + +procedure THashIntegerMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean); +var + LoadFactor: Double; +begin + LoadFactor := Capacity / TableSize; + if LoadFactor > MaxLoadFactor then + TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin)) + else if AlwaysChangeCapacity then + ChangeCapacity(FArray); +end; + +function THashIntegerMap.GetHash(const Key: Integer): Integer; +begin + Result := Trunc(Frac(Cardinal(Key) * HashFactor) * TableSize); +end; + +function THashIntegerMap.GetKeyPosition(const Key: Integer): TCollectionPosition; +var + Chain: TList; + I: Integer; + Success: Boolean; +begin + Chain := FArray[GetHash(Key)]; + Success := false; + for I := 0 to Chain.Count - 1 do + begin + Success := (Key = IIntegerAssociation(Chain[I]).GetKey); + if Success then + Break; + end; + Result := THashPosition.Create(Success, Chain, I); +end; + +procedure THashIntegerMap.Rehash; +var + NewArray: TListArray; + OldChain, NewChain: TList; + Association: IIntegerAssociation; + Total: Integer; + I, J: Integer; + Hash: Integer; +begin + // Create new chains + SetLength(NewArray, TableSize); + for I := Low(NewArray) to High(NewArray) do + begin + NewChain := TList.Create; + NewArray[I] := NewChain; + end; + ChangeCapacity(NewArray); + + // Transfer from old chains to new and drop old + for I := Low(FArray) to High(FArray) do + begin + OldChain := FArray[I]; + for J := 0 to OldChain.Count - 1 do + begin + Association := IIntegerAssociation(OldChain[J]); + Hash := GetHash(Association.GetKey); + NewArray[Hash].Add(Pointer(Association)); + end; + OldChain.Free; + end; + FArray := NewArray; + + // Find actual, new capacity + Total := 0; + for I := Low(FArray) to High(FArray) do + begin + NewChain := FArray[I]; + Total := Total + NewChain.Capacity; + end; + FCapacity := Total; +end; + +procedure THashIntegerMap.TrueClear; +var + Association: IIntegerAssociation; + Chain: TList; + I, J: Integer; +begin + for I := Low(FArray) to High(FArray) do + begin + Chain := FArray[I]; + for J := 0 to Chain.Count - 1 do + begin + Association := IIntegerAssociation(Chain[J]); + Chain[J] := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; + end; + Chain.Clear; + end; + FSize := 0; +end; + +function THashIntegerMap.TrueGet(Position: TCollectionPosition): IIntegerAssociation; +var + HashPosition: THashPosition; +begin + HashPosition := THashPosition(Position); + Result := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]); +end; + +function THashIntegerMap.TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; +var + HashPosition: THashPosition; + OldAssociation: IIntegerAssociation; +begin + HashPosition := THashPosition(Position); + if HashPosition.Found then + begin + OldAssociation := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]); + HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association); + Result := OldAssociation; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._AddRef; + OldAssociation._Release; + end + else + begin + HashPosition.Chain.Add(Pointer(Association)); + Inc(FSize); + Result := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._AddRef; + end; +end; + +function THashIntegerMap.TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; +var + Association: IIntegerAssociation; + HashPosition: THashPosition; +begin + HashPosition := THashPosition(Position); + Association := IIntegerAssociation(TrueGet(Position)); + HashPosition.Chain.Delete(HashPosition.Index); + Dec(FSize); + Result := Association; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; +end; + +function THashIntegerMap.GetCapacity; +begin + Result := FCapacity; +end; + +procedure THashIntegerMap.SetCapacity(Value: Integer); +begin + FCapacity := Value; + CheckLoadFactor(true); +end; + +function THashIntegerMap.GetSize: Integer; +begin + Result := FSize; +end; + +{ THashStringMap } +constructor THashStringMap.Create; +begin + Create(false, DefaultTableSize, DefaultMaxLoadFactor); +end; + +constructor THashStringMap.Create(NaturalItemsOnly: Boolean); +begin + Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor); +end; + +constructor THashStringMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); +var + I: Integer; +begin + inherited Create(NaturalItemsOnly); + SetLength(FArray, TableSize); + for I := Low(FArray) to High(FArray) do + FArray[I] := TList.Create; + FTableSize := TableSize; + FMaxLoadFactor := MaxLoadFactor; + FSize := 0; +end; + +destructor THashStringMap.Destroy; +var + I: Integer; +begin + for I := Low(FArray) to High(FArray) do + FArray[I].Free; + FArray := nil; + inherited Destroy; +end; + +function THashStringMap.GetAssociationIterator: IStringMapIterator; +begin + Result := THashStringIterator.Create(Self); +end; + +procedure THashStringMap.SetTableSize(Value: Integer); +begin + if (FTableSize <> Value) and (Value >= 1) then + begin + FTableSize := Value; + Rehash; + end; +end; + +procedure THashStringMap.SetMaxLoadFactor(Value: Double); +begin + if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then + begin + FMaxLoadFactor := Value; + CheckLoadFactor(false); + end; +end; + +procedure THashStringMap.ChangeCapacity; +var + Chain: TList; + I, Total, ChainCapacity: Integer; +begin + if FCapacity mod FTableSize = 0 then + ChainCapacity := Trunc(FCapacity / FTableSize) + else + ChainCapacity := Trunc(FCapacity / FTableSize) + 1; + Total := 0; + for I := Low(Value) to High(Value) do + begin + Chain := Value[I]; + Chain.Capacity := ChainCapacity; + Total := Total + Chain.Capacity; + end; + FCapacity := Total; +end; + +procedure THashStringMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean); +var + LoadFactor: Double; +begin + LoadFactor := Capacity / TableSize; + if LoadFactor > MaxLoadFactor then + TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin)) + else if AlwaysChangeCapacity then + ChangeCapacity(FArray); +end; + +function THashStringMap.GetHash(const Key: String): Integer; +var + HashCode: Cardinal; + I: Integer; +begin + HashCode := 0; + for I := 1 to Length(Key) do + HashCode := (HashCode shl 1) xor Ord(Key[I]); + Result := Trunc(Frac(HashCode * HashFactor) * TableSize); +end; + +function THashStringMap.GetKeyPosition(const Key: String): TCollectionPosition; +var + Chain: TList; + I: Integer; + Success: Boolean; +begin + Chain := FArray[GetHash(Key)]; + Success := false; + for I := 0 to Chain.Count - 1 do + begin + Success := (Key = IStringAssociation(Chain[I]).GetKey); + if Success then + Break; + end; + Result := THashPosition.Create(Success, Chain, I); +end; + +procedure THashStringMap.Rehash; +var + NewArray: TListArray; + OldChain, NewChain: TList; + Association: IStringAssociation; + Total: Integer; + I, J: Integer; + Hash: Integer; +begin + // Create new chains + SetLength(NewArray, TableSize); + for I := Low(NewArray) to High(NewArray) do + begin + NewChain := TList.Create; + NewArray[I] := NewChain; + end; + ChangeCapacity(NewArray); + + // Transfer from old chains to new and drop old + for I := Low(FArray) to High(FArray) do + begin + OldChain := FArray[I]; + for J := 0 to OldChain.Count - 1 do + begin + Association := IStringAssociation(OldChain[J]); + Hash := GetHash(Association.GetKey); + NewArray[Hash].Add(Pointer(Association)); + end; + OldChain.Free; + end; + FArray := NewArray; + + // Find actual, new capacity + Total := 0; + for I := Low(FArray) to High(FArray) do + begin + NewChain := FArray[I]; + Total := Total + NewChain.Capacity; + end; + FCapacity := Total; +end; + +procedure THashStringMap.TrueClear; +var + Association: IStringAssociation; + Chain: TList; + I, J: Integer; +begin + for I := Low(FArray) to High(FArray) do + begin + Chain := FArray[I]; + for J := 0 to Chain.Count - 1 do + begin + Association := IStringAssociation(Chain[J]); + Chain[J] := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; + end; + Chain.Clear; + end; + FSize := 0; +end; + +function THashStringMap.TrueGet(Position: TCollectionPosition): IStringAssociation; +var + HashPosition: THashPosition; +begin + HashPosition := THashPosition(Position); + Result := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]); +end; + +function THashStringMap.TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; +var + HashPosition: THashPosition; + OldAssociation: IStringAssociation; +begin + HashPosition := THashPosition(Position); + if HashPosition.Found then + begin + OldAssociation := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]); + HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association); + Result := OldAssociation; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._AddRef; + OldAssociation._Release; + end + else + begin + HashPosition.Chain.Add(Pointer(Association)); + Inc(FSize); + Result := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._AddRef; + end; +end; + +function THashStringMap.TrueRemove2(Position: TCollectionPosition): IStringAssociation; +var + Association: IStringAssociation; + HashPosition: THashPosition; +begin + HashPosition := THashPosition(Position); + Association := IStringAssociation(TrueGet(Position)); + HashPosition.Chain.Delete(HashPosition.Index); + Dec(FSize); + Result := Association; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; +end; + +function THashStringMap.GetCapacity; +begin + Result := FCapacity; +end; + +procedure THashStringMap.SetCapacity(Value: Integer); +begin + FCapacity := Value; + CheckLoadFactor(true); +end; + +function THashStringMap.GetSize: Integer; +begin + Result := FSize; +end; + +{ THashPosition } +constructor THashPosition.Create(Found: Boolean; Chain: TList; Index: Integer); +begin + inherited Create(Found); + FChain := Chain; + FIndex := Index; +end; + +{ THashIterator } +constructor THashIterator.Create(HashSet: THashSet); +begin + inherited Create(true); + FHashSet := HashSet; + First; +end; + +function THashIterator.TrueFirst: ICollectable; +var + Chain: TList; + Success: Boolean; +begin + FHash := 0; + FChainIndex := 0; + Success := false; + while FHash < FHashSet.TableSize do + begin + Chain := FHashSet.FArray[FHash]; + Success := Chain.Count > 0; + if Success then + Break; + Inc(FHash); + end; + if Success then + Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex]) + else + Result := nil; +end; + +function THashIterator.TrueNext: ICollectable; +var + Chain: TList; + Success: Boolean; +begin + Success := false; + Chain := FHashSet.FArray[FHash]; + repeat + Inc(FChainIndex); + if FChainIndex >= Chain.Count then + begin + Inc(FHash); + FChainIndex := -1; + if FHash < FHashSet.TableSize then + Chain := FHashSet.FArray[FHash]; + end + else + Success := true; + until Success or (FHash >= FHashSet.TableSize); + if Success then + Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex]) + else + Result := nil; +end; + +procedure THashIterator.TrueRemove; +var + Item: ICollectable; +begin + Item := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex]); + FHashSet.FArray[FHash].Delete(FChainIndex); + Dec(FChainIndex); + Dec(FHashSet.FSize); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Item._Release; +end; + + +{ THashAssociationIterator } +constructor THashAssociationIterator.Create(HashMap: THashMap); +begin + inherited Create(true); + FHashMap := HashMap; + First; +end; + +function THashAssociationIterator.TrueFirst: IAssociation; +var + Chain: TList; + Success: Boolean; +begin + FHash := 0; + FChainIndex := 0; + Success := false; + while FHash < FHashMap.TableSize do + begin + Chain := FHashMap.FArray[FHash]; + Success := Chain.Count > 0; + if Success then + Break; + Inc(FHash); + end; + if Success then + Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex]) + else + Result := nil; +end; + +function THashAssociationIterator.TrueNext: IAssociation; +var + Chain: TList; + Success: Boolean; +begin + Success := false; + Chain := FHashMap.FArray[FHash]; + repeat + Inc(FChainIndex); + if FChainIndex >= Chain.Count then + begin + Inc(FHash); + FChainIndex := -1; + if FHash < FHashMap.TableSize then + Chain := FHashMap.FArray[FHash]; + end + else + Success := true; + until Success or (FHash >= FHashMap.TableSize); + if Success then + Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex]) + else + Result := nil; +end; + +procedure THashAssociationIterator.TrueRemove; +var + Association: IAssociation; +begin + Association := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex]); + FHashMap.FArray[FHash].Delete(FChainIndex); + Dec(FChainIndex); + Dec(FHashMap.FSize); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; +end; + + +{ THashIntegerIterator } +constructor THashIntegerIterator.Create(HashIntegerMap: THashIntegerMap); +begin + inherited Create(true); + FHashIntegerMap := HashIntegerMap; + First; +end; + +function THashIntegerIterator.TrueFirst: IIntegerAssociation; +var + Chain: TList; + Success: Boolean; +begin + FHash := 0; + FChainIndex := 0; + Success := false; + while FHash < FHashIntegerMap.TableSize do + begin + Chain := FHashIntegerMap.FArray[FHash]; + Success := Chain.Count > 0; + if Success then + Break; + Inc(FHash); + end; + if Success then + Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex]) + else + Result := nil; +end; + +function THashIntegerIterator.TrueNext: IIntegerAssociation; +var + Chain: TList; + Success: Boolean; +begin + Success := false; + Chain := FHashIntegerMap.FArray[FHash]; + repeat + Inc(FChainIndex); + if FChainIndex >= Chain.Count then + begin + Inc(FHash); + FChainIndex := -1; + if FHash < FHashIntegerMap.TableSize then + Chain := FHashIntegerMap.FArray[FHash]; + end + else + Success := true; + until Success or (FHash >= FHashIntegerMap.TableSize); + if Success then + Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex]) + else + Result := nil; +end; + +procedure THashIntegerIterator.TrueRemove; +var + Association: IIntegerAssociation; +begin + Association := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex]); + FHashIntegerMap.FArray[FHash].Delete(FChainIndex); + Dec(FChainIndex); + Dec(FHashIntegerMap.FSize); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; +end; + +{ THashStringIterator } +constructor THashStringIterator.Create(HashStringMap: THashStringMap); +begin + inherited Create(true); + FHashStringMap := HashStringMap; + First; +end; + +function THashStringIterator.TrueFirst: IStringAssociation; +var + Chain: TList; + Success: Boolean; +begin + FHash := 0; + FChainIndex := 0; + Success := false; + while FHash < FHashStringMap.TableSize do + begin + Chain := FHashStringMap.FArray[FHash]; + Success := Chain.Count > 0; + if Success then + Break; + Inc(FHash); + end; + if Success then + Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex]) + else + Result := nil; +end; + +function THashStringIterator.TrueNext: IStringAssociation; +var + Chain: TList; + Success: Boolean; +begin + Success := false; + Chain := FHashStringMap.FArray[FHash]; + repeat + Inc(FChainIndex); + if FChainIndex >= Chain.Count then + begin + Inc(FHash); + FChainIndex := -1; + if FHash < FHashStringMap.TableSize then + Chain := FHashStringMap.FArray[FHash]; + end + else + Success := true; + until Success or (FHash >= FHashStringMap.TableSize); + if Success then + Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex]) + else + Result := nil; +end; + +procedure THashStringIterator.TrueRemove; +var + Association: IStringAssociation; +begin + Association := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex]); + FHashStringMap.FArray[FHash].Delete(FChainIndex); + Dec(FChainIndex); + Dec(FHashStringMap.FSize); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; +end; + + +end. diff --git a/unicode/src/lib/collections/CollLibrary.pas b/unicode/src/lib/collections/CollLibrary.pas new file mode 100644 index 00000000..b7e3d268 --- /dev/null +++ b/unicode/src/lib/collections/CollLibrary.pas @@ -0,0 +1,131 @@ +unit CollLibrary; + +(***************************************************************************** + * Copyright 2003 by Matthew Greet + * This library is free software; you can redistribute it and/or modify it + * under the terms of the GNU Lesser General Public License as published by the + * Free Software Foundation; either version 2.1 of the License, or (at your + * option) any later version. + * + * This library is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + * details. (http://opensource.org/licenses/lgpl-license.php) + * + * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads. + * + * $Version: v1.0.3 $ + * $Revision: 1.0.1.1 $ + * $Log: D:\QVCS Repositories\Delphi Collections\CollLibrary.qbt $ + * + * Initial version. + * + * Revision 1.0.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16 + * v1.0 branch. + * + * Revision 1.0 by: Matthew Greet Rev date: 06/04/03 10:40:32 + * Initial revision. + * + * FPC compatibility fixes by: UltraStar Deluxe Team + * + * $Endlog$ + *****************************************************************************) + +{$IFDEF FPC} + {$MODE Delphi}{$H+} +{$ENDIF} + +interface + +uses + Collections, CollArray, CollHash, CollList, CollPArray, CollWrappers; + +type + TMiscCollectionLibrary = class + public + class function ClassNameToClassType(ClassName: String): TAbstractCollectionClass; + class function EqualIID(const IID1, IID2: TGUID): Boolean; + class function HashCode(Value: String): Integer; + class procedure ShuffleArray(var ItemArray: array of ICollectable); + class procedure ShuffleList(const List: IList); + end; + +implementation + +{ TMiscCollectionLibrary } +class function TMiscCollectionLibrary.ClassNameToClassType(ClassName: String): TAbstractCollectionClass; +begin + if ClassName = 'TArray' then + Result := TArray + else if ClassName = 'THashSet' then + Result := THashSet + else if ClassName = 'THashMap' then + Result := THashMap + else if ClassName = 'THashIntegerMap' then + Result := THashIntegerMap + else if ClassName = 'THashStringMap' then + Result := THashStringMap + else if ClassName = 'TListSet' then + Result := TListSet + else if ClassName = 'TListMap' then + Result := TListMap + else if ClassName = 'TPArrayBag' then + Result := TPArrayBag + else if ClassName = 'TPArraySet' then + Result := TPArraySet + else if ClassName = 'TPArrayList' then + Result := TPArrayList + else if ClassName = 'TPArrayMap' then + Result := TPArrayMap + else + Result := nil; +end; + +class function TMiscCollectionLibrary.EqualIID(const IID1, IID2: TGUID): Boolean; +begin + Result := (IID1.D1 = IID2.D1) and (IID1.D2 = IID2.D2) and (IID1.D3 = IID2.D3) and + (IID1.D4[0] = IID2.D4[0]) and (IID1.D4[1] = IID2.D4[1]) and + (IID1.D4[2] = IID2.D4[2]) and (IID1.D4[3] = IID2.D4[3]) and + (IID1.D4[4] = IID2.D4[4]) and (IID1.D4[5] = IID2.D4[5]) and + (IID1.D4[6] = IID2.D4[6]) and (IID1.D4[7] = IID2.D4[7]); +end; + +class function TMiscCollectionLibrary.HashCode(Value: String): Integer; +var + I: Integer; +begin + Result := 0; + for I := 1 to Length(Value) do + Result := (Result shl 1) xor Ord(Value[I]); +end; + +class procedure TMiscCollectionLibrary.ShuffleArray(var ItemArray: array of ICollectable); +var + Item: ICollectable; + ArraySize, I, Index: Integer; +begin + Randomize; + ArraySize := Length(ItemArray); + for I := 0 to ArraySize - 1 do + begin + Index := (I + Random(ArraySize - 1) + 1) mod ArraySize; + Item := ItemArray[I]; + ItemArray[I] := ItemArray[Index]; + ItemArray[Index] := Item; + end; +end; + +class procedure TMiscCollectionLibrary.ShuffleList(const List: IList); +var + ListSize, I: Integer; +begin + Randomize; + ListSize := List.GetSize; + for I := 0 to ListSize - 1 do + begin + List.Exchange(I, (I + Random(ListSize - 1) + 1) mod ListSize); + end; +end; + + +end. diff --git a/unicode/src/lib/collections/CollList.pas b/unicode/src/lib/collections/CollList.pas new file mode 100644 index 00000000..68aa0d66 --- /dev/null +++ b/unicode/src/lib/collections/CollList.pas @@ -0,0 +1,270 @@ +unit CollList; + +(***************************************************************************** + * Copyright 2003 by Matthew Greet + * This library is free software; you can redistribute it and/or modify it + * under the terms of the GNU Lesser General Public License as published by the + * Free Software Foundation; either version 2.1 of the License, or (at your + * option) any later version. + * + * This library is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + * details. (http://opensource.org/licenses/lgpl-license.php) + * + * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads. + * + * $Version: v1.0.3 $ + * $Revision: 1.1.1.2 $ + * $Log: D:\QVCS Repositories\Delphi Collections\CollList.qbt $ + * + * Collection implementations based on sorted TPArrayList instances. + * + * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:05:54 + * Capacity property. + * + * Revision 1.1.1.1 by: Matthew Greet Rev date: 14/02/04 17:45:38 + * v1.0 branch. + * + * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:41:52 + * Uses TExposedPArrayList to improve performance. + * + * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02 + * Initial revision. + * + * FPC compatibility fixes by: UltraStar Deluxe Team + * + * $Endlog$ + *****************************************************************************) + +interface + +{$IFDEF FPC} + {$MODE Delphi}{$H+} +{$ENDIF} + +uses + Collections, CollPArray; + +type + TListSet = class(TAbstractSet) + private + FList: TExposedPArrayList; + protected + function GetPosition(const Item: ICollectable): TCollectionPosition; override; + procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override; + procedure TrueClear; override; + function TrueGet(Position: TCollectionPosition): ICollectable; override; + procedure TrueRemove2(Position: TCollectionPosition); override; + public + constructor Create(NaturalItemsOnly: Boolean); override; + destructor Destroy; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + function GetIterator: IIterator; override; + function GetNaturalItemIID: TGUID; override; + function GetSize: Integer; override; + end; + + TListMap = class(TAbstractMap) + private + FList: TExposedPArrayList; + protected + function GetAssociationIterator: IMapIterator; override; + function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override; + procedure TrueClear; override; + function TrueGet(Position: TCollectionPosition): IAssociation; override; + function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override; + function TrueRemove2(Position: TCollectionPosition): IAssociation; override; + public + constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override; + destructor Destroy; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + procedure SetKeyComparator(const Value: IComparator); override; + function GetNaturalKeyIID: TGUID; override; + function GetSize: Integer; override; + end; + +implementation + +type + TListPosition = class(TCollectionPosition) + private + FSearchResult: TSearchResult; + public + constructor Create(Found: Boolean; SearchResult: TSearchResult); + property SearchResult: TSearchResult read FSearchResult; + end; + +constructor TListSet.Create(NaturalItemsOnly: Boolean); +begin + inherited Create(NaturalItemsOnly); + FList := TExposedPArrayList.Create(NaturalItemsOnly); + FList.Comparator := Comparator; + FList.Sort; +end; + +destructor TListSet.Destroy; +begin + FList.Free; + inherited Destroy; +end; + +function TListSet.GetPosition(const Item: ICollectable): TCollectionPosition; +var + SearchResult: TSearchResult; +begin + SearchResult := FList.Search(Item); + Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult); +end; + +procedure TListSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); +var + SearchResult: TSearchResult; + Index: Integer; +begin + SearchResult := TListPosition(Position).SearchResult; + Index := SearchResult.Index; + if SearchResult.ResultType = srBeforeIndex then + FList.TrueInsert(Index, Item) + else + FList.TrueAppend(Item); +end; + +procedure TListSet.TrueClear; +begin + FList.Clear; +end; + +function TListSet.TrueGet(Position: TCollectionPosition): ICollectable; +begin + Result := FList.Items[TListPosition(Position).SearchResult.Index]; +end; + +procedure TListSet.TrueRemove2(Position: TCollectionPosition); +begin + FList.Delete(TListPosition(Position).SearchResult.Index); +end; + +function TListSet.GetCapacity: Integer; +begin + Result := FList.Capacity; +end; + +procedure TListSet.SetCapacity(Value: Integer); +begin + FList.Capacity := Value; +end; + +function TListSet.GetIterator: IIterator; +begin + Result := FList.GetIterator; +end; + +function TListSet.GetNaturalItemIID: TGUID; +begin + Result := ComparableIID; +end; + +function TListSet.GetSize: Integer; +begin + Result := FList.Size; +end; + +constructor TListMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); +begin + inherited Create(NaturalItemsOnly, NaturalKeysOnly); + FList := TExposedPArrayList.Create(false); + FList.Comparator := AssociationComparator; + FList.Sort; +end; + +destructor TListMap.Destroy; +begin + FList.Free; + inherited Destroy; +end; + +function TListMap.GetAssociationIterator: IMapIterator; +begin + Result := TAssociationIterator.Create(FList.GetIterator); +end; + +function TListMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition; +var + Association: IAssociation; + SearchResult: TSearchResult; +begin + Association := TAssociation.Create(Key, nil); + SearchResult := FList.Search(Association); + Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult); +end; + +procedure TListMap.TrueClear; +begin + FList.Clear; +end; + +function TListMap.TrueGet(Position: TCollectionPosition): IAssociation; +begin + Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation; +end; + +function TListMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; +var + SearchResult: TSearchResult; + Index: Integer; +begin + SearchResult := TListPosition(Position).SearchResult; + Index := SearchResult.Index; + if SearchResult.ResultType = srFoundAtIndex then + begin + Result := (FList.Items[Index]) as IAssociation; + FList.Items[Index] := Association; + end + else if SearchResult.ResultType = srBeforeIndex then + FList.TrueInsert(Index, Association) + else + FList.TrueAppend(Association); +end; + +function TListMap.TrueRemove2(Position: TCollectionPosition): IAssociation; +begin + Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation; + FList.Delete(TListPosition(Position).SearchResult.Index); +end; + +procedure TListMap.SetKeyComparator(const Value: IComparator); +begin + inherited SetKeyComparator(Value); + FList.Sort; +end; + +function TListMap.GetCapacity: Integer; +begin + Result := FList.Capacity; +end; + +procedure TListMap.SetCapacity(Value: Integer); +begin + FList.Capacity := Value; +end; + +function TListMap.GetNaturalKeyIID: TGUID; +begin + Result := ComparableIID; +end; + +function TListMap.GetSize: Integer; +begin + Result := FList.Size; +end; + +constructor TListPosition.Create(Found: Boolean; SearchResult: TSearchResult); +begin + inherited Create(Found); + FSearchResult := SearchResult; +end; + +end. diff --git a/unicode/src/lib/collections/CollPArray.pas b/unicode/src/lib/collections/CollPArray.pas new file mode 100644 index 00000000..5ebd534b --- /dev/null +++ b/unicode/src/lib/collections/CollPArray.pas @@ -0,0 +1,689 @@ +unit CollPArray; + +(***************************************************************************** + * Copyright 2003 by Matthew Greet + * This library is free software; you can redistribute it and/or modify it + * under the terms of the GNU Lesser General Public License as published by the + * Free Software Foundation; either version 2.1 of the License, or (at your + * option) any later version. + * + * This library is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + * details. (http://opensource.org/licenses/lgpl-license.php) + * + * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads. + * + * $Version: v1.0.3 $ + * $Revision: 1.2.1.2 $ + * $Log: D:\QVCS Repositories\Delphi Collections\CollPArray.qbt $ + * + * Collection implementations based on TList. + * + * Revision 1.2.1.2 by: Matthew Greet Rev date: 12/06/04 20:08:30 + * Capacity property. + * + * Revision 1.2.1.1 by: Matthew Greet Rev date: 14/02/04 17:46:10 + * v1.0 branch. + * + * Revision 1.2 by: Matthew Greet Rev date: 28/04/03 15:07:14 + * Correctly handles nil items. + * + * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:43:16 + * Added TPArrayMap and TExposedPArrayList. + * + * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02 + * Initial revision. + * + * FPC compatibility fixes by: UltraStar Deluxe Team + * + * $Endlog$ + *****************************************************************************) + +{$IFDEF FPC} + {$MODE Delphi}{$H+} +{$ENDIF} + +interface + +uses + Classes, + Collections; + +type + TPArrayBag = class(TAbstractBag) + private + FList: TList; + protected + function TrueAdd(const Item: ICollectable): Boolean; override; + procedure TrueClear; override; + function TrueRemove(const Item: ICollectable): ICollectable; override; + function TrueRemoveAll(const Item: ICollectable): ICollection; override; + public + constructor Create(NaturalItemsOnly: Boolean); override; + destructor Destroy; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + function GetIterator: IIterator; override; + function GetSize: Integer; override; + function TrueContains(const Item: ICollectable): Boolean; override; + end; + + TPArraySet = class(TAbstractSet) + private + FList: TList; + protected + function GetPosition(const Item: ICollectable): TCollectionPosition; override; + procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override; + procedure TrueClear; override; + function TrueGet(Position: TCollectionPosition): ICollectable; override; + procedure TrueRemove2(Position: TCollectionPosition); override; + public + constructor Create(NaturalItemsOnly: Boolean); override; + destructor Destroy; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + function GetIterator: IIterator; override; + function GetSize: Integer; override; + end; + + TPArrayList = class(TAbstractList) + private + FList: TList; + protected + function TrueGetItem(Index: Integer): ICollectable; override; + procedure TrueSetItem(Index: Integer; const Item: ICollectable); override; + procedure TrueAppend(const Item: ICollectable); override; + procedure TrueClear; override; + function TrueDelete(Index: Integer): ICollectable; override; + procedure TrueInsert(Index: Integer; const Item: ICollectable); override; + public + constructor Create(NaturalItemsOnly: Boolean); override; + destructor Destroy; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + function GetIterator: IIterator; override; + function GetSize: Integer; override; + end; + + TPArrayMap = class(TAbstractMap) + private + FList: TList; + protected + function GetAssociationIterator: IMapIterator; override; + function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override; + procedure TrueClear; override; + function TrueGet(Position: TCollectionPosition): IAssociation; override; + function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override; + function TrueRemove2(Position: TCollectionPosition): IAssociation; override; + public + constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override; + destructor Destroy; override; + function GetCapacity: Integer; override; + procedure SetCapacity(Value: Integer); override; + function GetSize: Integer; override; + end; + + // Same as TPArrayList but raises method visibilities so items can be manually + // appended or inserted without resetting sort flag. + TExposedPArrayList = class(TPArrayList) + public + procedure TrueAppend(const Item: ICollectable); override; + procedure TrueInsert(Index: Integer; const Item: ICollectable); override; + end; + + +implementation + +type + TPArrayIterator = class(TAbstractIterator) + private + FList: TList; + FIndex: Integer; + protected + constructor Create(List: TList; AllowRemove: Boolean); + function TrueFirst: ICollectable; override; + function TrueNext: ICollectable; override; + procedure TrueRemove; override; + end; + + TPArrayAssociationIterator = class(TAbstractAssociationIterator) + private + FList: TList; + FIndex: Integer; + protected + constructor Create(List: TList; AllowRemove: Boolean); + function TrueFirst: IAssociation; override; + function TrueNext: IAssociation; override; + procedure TrueRemove; override; + end; + + TPArrayPosition = class(TCollectionPosition) + private + FIndex: Integer; + public + constructor Create(Found: Boolean; Index: Integer); + property Index: Integer read FIndex; + end; + +constructor TPArrayBag.Create(NaturalItemsOnly: Boolean); +begin + inherited Create(NaturalItemsOnly); + FList := TList.Create; +end; + +destructor TPArrayBag.Destroy; +begin + FList.Free; + inherited Destroy; +end; + +function TPArrayBag.TrueAdd(const Item: ICollectable): Boolean; +begin + FList.Add(Pointer(Item)); + Result := true; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + if Item <> nil then + Item._AddRef; +end; + +procedure TPArrayBag.TrueClear; +var + Item: ICollectable; + I: Integer; +begin + // Delete all interface references + for I := 0 to FList.Count - 1 do + begin + Item := ICollectable(FList[I]); + FList[I] := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + if Item <> nil then + Item._Release; + end; + FList.Clear; +end; + +function TPArrayBag.TrueContains(const Item: ICollectable): Boolean; +var + I: Integer; + Success: Boolean; +begin + // Sequential search + I := 0; + Success := false; + while (I < FList.Count) and not Success do + begin + Success := Comparator.Equals(Item, ICollectable(FList[I])); + Inc(I); + end; + Result := Success; +end; + +function TPArrayBag.TrueRemove(const Item: ICollectable): ICollectable; +var + Item2: ICollectable; + I: Integer; + Found: Boolean; +begin + // Sequential search + I := 0; + Found := false; + Result := nil; + while (I < FList.Count) and not Found do + begin + Item2 := ICollectable(FList[I]); + if Comparator.Equals(Item, Item2) then + begin + Found := true; + Result := Item2; + FList.Delete(I); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + if Item2 <> nil then + Item2._Release; + end + else + Inc(I); + end; +end; + +function TPArrayBag.TrueRemoveAll(const Item: ICollectable): ICollection; +var + ResultCollection: TPArrayBag; + Item2: ICollectable; + I: Integer; +begin + // Sequential search + I := 0; + ResultCollection := TPArrayBag.Create; + while I < FList.Count do + begin + Item2 := ICollectable(FList[I]); + if Comparator.Equals(Item, Item2) then + begin + ResultCollection.Add(Item2); + FList.Delete(I); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + if Item <> nil then + Item._Release; + end + else + Inc(I); + end; + Result := ResultCollection; +end; + +function TPArrayBag.GetCapacity: Integer; +begin + Result := FList.Capacity; +end; + +procedure TPArrayBag.SetCapacity(Value: Integer); +begin + FList.Capacity := Value; +end; + +function TPArrayBag.GetIterator: IIterator; +begin + Result := TPArrayIterator.Create(FList, true); +end; + +function TPArrayBag.GetSize: Integer; +begin + Result := FList.Count; +end; + +constructor TPArraySet.Create(NaturalItemsOnly: Boolean); +begin + inherited Create(NaturalItemsOnly); + FList := TList.Create; +end; + +destructor TPArraySet.Destroy; +begin + FList.Free; + inherited Destroy; +end; + +function TPArraySet.GetPosition(const Item: ICollectable): TCollectionPosition; +var + I: Integer; + Success: Boolean; +begin + // Sequential search + I := 0; + Success := false; + while (I < FList.Count) do + begin + Success := Comparator.Equals(Item, ICollectable(FList[I])); + if Success then + break; + Inc(I); + end; + Result := TPArrayPosition.Create(Success, I); +end; + +procedure TPArraySet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); +begin + FList.Add(Pointer(Item)); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Item._AddRef; +end; + +procedure TPArraySet.TrueClear; +var + Item: ICollectable; + I: Integer; +begin + // Delete all interface references + for I := 0 to FList.Count - 1 do + begin + Item := ICollectable(FList[I]); + FList[I] := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Item._Release; + end; + FList.Clear; +end; + +function TPArraySet.TrueGet(Position: TCollectionPosition): ICollectable; +begin + Result := ICollectable(FList.Items[TPArrayPosition(Position).Index]); +end; + +procedure TPArraySet.TrueRemove2(Position: TCollectionPosition); +var + Item: ICollectable; +begin + Item := ICollectable(FList[TPArrayPosition(Position).Index]); + FList.Delete(TPArrayPosition(Position).Index); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Item._Release; +end; + +function TPArraySet.GetCapacity: Integer; +begin + Result := FList.Capacity; +end; + +procedure TPArraySet.SetCapacity(Value: Integer); +begin + FList.Capacity := Value; +end; + +function TPArraySet.GetIterator: IIterator; +begin + Result := TPArrayIterator.Create(FList, true); +end; + +function TPArraySet.GetSize: Integer; +begin + Result := FList.Count; +end; + +constructor TPArrayList.Create(NaturalItemsOnly: Boolean); +begin + inherited Create(NaturalItemsOnly); + FList := TList.Create; +end; + +destructor TPArrayList.Destroy; +begin + FList.Free; + inherited Destroy; +end; + +function TPArrayList.TrueGetItem(Index: Integer): ICollectable; +begin + Result := ICollectable(FList.Items[Index]); +end; + +procedure TPArrayList.TrueSetItem(Index: Integer; const Item: ICollectable); +var + OldItem: ICollectable; +begin + OldItem := ICollectable(FList[Index]); + FList[Index] := Pointer(Item); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + if Item <> nil then + Item._AddRef; + if OldItem <> nil then + OldItem._Release; +end; + +procedure TPArrayList.TrueAppend(const Item: ICollectable); +begin + FList.Add(Pointer(Item)); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + if Item <> nil then + Item._AddRef; +end; + +procedure TPArrayList.TrueClear; +var + Item: ICollectable; + I: Integer; +begin + // Delete all interface references + for I := 0 to FList.Count - 1 do + begin + Item := ICollectable(FList[I]); + FList[I] := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + if Item <> nil then + Item._Release; + end; + FList.Clear; +end; + +function TPArrayList.TrueDelete(Index: Integer): ICollectable; +begin + Result := ICollectable(FList[Index]); + FList.Delete(Index); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + if Result <> nil then + Result._Release; +end; + +procedure TPArrayList.TrueInsert(Index: Integer; const Item: ICollectable); +begin + FList.Insert(Index, Pointer(Item)); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + if Item <> nil then + Item._AddRef; +end; + +function TPArrayList.GetCapacity: Integer; +begin + Result := FList.Capacity; +end; + +procedure TPArrayList.SetCapacity(Value: Integer); +begin + FList.Capacity := Value; +end; + +function TPArrayList.GetIterator: IIterator; +begin + Result := TPArrayIterator.Create(FList, true); +end; + +function TPArrayList.GetSize: Integer; +begin + Result := FList.Count; +end; + +constructor TPArrayMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); +begin + inherited Create(NaturalItemsOnly, NaturalKeysOnly); + FList := TList.Create; +end; + +destructor TPArrayMap.Destroy; +begin + FList.Free; + inherited Destroy; +end; + +function TPArrayMap.GetAssociationIterator: IMapIterator; +begin + Result := TPArrayAssociationIterator.Create(FList, true); +end; + +function TPArrayMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition; +var + I: Integer; + Success: Boolean; +begin + // Sequential search + I := 0; + Success := false; + while (I < FList.Count) do + begin + Success := KeyComparator.Equals(Key, IAssociation(FList[I]).GetKey); + if Success then + break; + Inc(I); + end; + Result := TPArrayPosition.Create(Success, I); +end; + +procedure TPArrayMap.TrueClear; +var + Association: IAssociation; + I: Integer; +begin + // Delete all interface references + for I := 0 to FList.Count - 1 do + begin + Association := IAssociation(FList[I]); + FList[I] := nil; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; + end; + FList.Clear; +end; + +function TPArrayMap.TrueGet(Position: TCollectionPosition): IAssociation; +begin + Result := IAssociation(FList.Items[TPArrayPosition(Position).Index]); +end; + +function TPArrayMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; +var + OldAssociation: IAssociation; + Index: Integer; +begin + if Position.Found then + begin + Index := (Position as TPArrayPosition).Index; + OldAssociation := IAssociation(FList[Index]); + FList[Index] := Pointer(Association); + end + else + begin + OldAssociation := nil; + FList.Add(Pointer(Association)); + end; + Result := OldAssociation; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._AddRef; + if OldAssociation <> nil then + OldAssociation._Release; +end; + +function TPArrayMap.TrueRemove2(Position: TCollectionPosition): IAssociation; +var + OldAssociation: IAssociation; +begin + OldAssociation := IAssociation(FList[TPArrayPosition(Position).Index]); + FList.Delete(TPArrayPosition(Position).Index); + Result := OldAssociation; + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + OldAssociation._Release; +end; + +function TPArrayMap.GetCapacity: Integer; +begin + Result := FList.Capacity; +end; + +procedure TPArrayMap.SetCapacity(Value: Integer); +begin + FList.Capacity := Value; +end; + +function TPArrayMap.GetSize: Integer; +begin + Result := FList.Count; +end; + +procedure TExposedPArrayList.TrueAppend(const Item: ICollectable); +begin + inherited TrueAppend(Item); +end; + +procedure TExposedPArrayList.TrueInsert(Index: Integer; const Item: ICollectable); +begin + inherited TrueInsert(Index, Item); +end; + +{ TPArrayIterator } +constructor TPArrayIterator.Create(List: TList; AllowRemove: Boolean); +begin + inherited Create(AllowRemove); + FList := List; + FIndex := -1; +end; + +function TPArrayIterator.TrueFirst: ICollectable; +begin + FIndex := 0; + if FIndex < FList.Count then + Result := ICollectable(FList[FIndex]) + else + Result := nil; +end; + +function TPArrayIterator.TrueNext: ICollectable; +begin + Inc(FIndex); + if FIndex < FList.Count then + Result := ICollectable(FList[FIndex]) + else + Result := nil; +end; + +procedure TPArrayIterator.TrueRemove; +var + Item: ICollectable; +begin + Item := ICollectable(FList[FIndex]); + FList.Delete(FIndex); + Dec(FIndex); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Item._Release; +end; + +{ TPArrayAssociationIterator } +constructor TPArrayAssociationIterator.Create(List: TList; AllowRemove: Boolean); +begin + inherited Create(AllowRemove); + FList := List; + FIndex := -1; +end; + +function TPArrayAssociationIterator.TrueFirst: IAssociation; +begin + FIndex := 0; + if FIndex < FList.Count then + Result := IAssociation(FList[FIndex]) + else + Result := nil; +end; + +function TPArrayAssociationIterator.TrueNext: IAssociation; +begin + Inc(FIndex); + if FIndex < FList.Count then + Result := IAssociation(FList[FIndex]) + else + Result := nil; +end; + +procedure TPArrayAssociationIterator.TrueRemove; +var + Association: IAssociation; +begin + Association := IAssociation(FList[FIndex]); + FList.Delete(FIndex); + Dec(FIndex); + // Storing interface reference as a pointer does not update reference + // count automatically, so this must be done manually + Association._Release; +end; + +{ TPArrayPosition } +constructor TPArrayPosition.Create(Found: Boolean; Index: Integer); +begin + inherited Create(Found); + FIndex := Index; +end; + +end. diff --git a/unicode/src/lib/collections/CollWrappers.pas b/unicode/src/lib/collections/CollWrappers.pas new file mode 100644 index 00000000..513103a2 --- /dev/null +++ b/unicode/src/lib/collections/CollWrappers.pas @@ -0,0 +1,876 @@ +unit CollWrappers; + +(***************************************************************************** + * Copyright 2003 by Matthew Greet + * This library is free software; you can redistribute it and/or modify it + * under the terms of the GNU Lesser General Public License as published by the + * Free Software Foundation; either version 2.1 of the License, or (at your + * option) any later version. + * + * This library is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + * details. (http://opensource.org/licenses/lgpl-license.php) + * + * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads. + * + * $Version: v1.0.3 $ + * $Revision: 1.1.1.1 $ + * $Log: D:\QVCS Repositories\Delphi Collections\CollWrappers.qbt $ + * + * Various primitive type wrappers, adapters and abstract base classes for + * natural items. + * + * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16 + * v1.0 branch. + * + * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:51:04 + * Primitive type wrapper interfaces added. + * Abstract, template classes added. + * All classes implement reference counting by descending from + * TInterfacedObject. + * + * + * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02 + * Initial revision. + * + * FPC compatibility fixes by: UltraStar Deluxe Team + * + * $Endlog$ + *****************************************************************************) + +{$IFDEF FPC} + {$MODE Delphi}{$H+} +{$ENDIF} + +interface + +uses + SysUtils, + Collections; + +type + IAssociationWrapper = interface + ['{54DF42E0-64F2-11D7-8120-0002E3165EF8}'] + function GetAutoDestroy: Boolean; + procedure SetAutoDestroy(Value: Boolean); + function GetKey: ICollectable; + function GetValue: TObject; + property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; + property Key: ICollectable read GetKey; + property Value: TObject read GetValue; + end; + + IBoolean = interface + ['{62D1D160-64F2-11D7-8120-0002E3165EF8}'] + function GetValue: Boolean; + property Value: Boolean read GetValue; + end; + + ICardinal = interface + ['{6AF7B1C0-64F2-11D7-8120-0002E3165EF8}'] + function GetValue: Cardinal; + property Value: Cardinal read GetValue; + end; + + IChar = interface + ['{73AD00E0-64F2-11D7-8120-0002E3165EF8}'] + function GetValue: Char; + property Value: Char read GetValue; + end; + + IClass = interface + ['{7A84B660-64F2-11D7-8120-0002E3165EF8}'] + function GetValue: TClass; + property Value: TClass read GetValue; + end; + + IDouble = interface + ['{815C6BE0-64F2-11D7-8120-0002E3165EF8}'] + function GetValue: Double; + property Value: Double read GetValue; + end; + + IInteger = interface + ['{88ECC300-64F2-11D7-8120-0002E3165EF8}'] + function GetValue: Integer; + property Value: Integer read GetValue; + end; + + IIntegerAssociationWrapper = interface + ['{8F582220-64F2-11D7-8120-0002E3165EF8}'] + function GetAutoDestroy: Boolean; + procedure SetAutoDestroy(Value: Boolean); + function GetKey: Integer; + function GetValue: TObject; + property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; + property Key: Integer read GetKey; + property Value: TObject read GetValue; + end; + + IInterfaceWrapper = interface + ['{962E5100-64F2-11D7-8120-0002E3165EF8}'] + function GetValue: IUnknown; + property Value: IUnknown read GetValue; + end; + + IObject = interface + ['{9C675580-64F2-11D7-8120-0002E3165EF8}'] + function GetAutoDestroy: Boolean; + procedure SetAutoDestroy(Value: Boolean); + function GetValue: TObject; + property Value: TObject read GetValue; + end; + + IString = interface + ['{A420DF80-64F2-11D7-8120-0002E3165EF8}'] + function GetValue: String; + property Value: String read GetValue; + end; + + IStringAssociationWrapper = interface + ['{AB98CCA0-64F2-11D7-8120-0002E3165EF8}'] + function GetAutoDestroy: Boolean; + procedure SetAutoDestroy(Value: Boolean); + function GetKey: String; + function GetValue: TObject; + property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; + property Key: String read GetKey; + property Value: TObject read GetValue; + end; + + TAbstractItem = class(TInterfacedObject, ICollectable) + public + function GetInstance: TObject; virtual; + end; + + TAbstractIntegerMappable = class(TAbstractItem, IEquatable, IIntegerMappable) + private + FKey: Integer; + protected + function MakeKey: Integer; virtual; abstract; + public + procedure AfterConstruction; override; + function Equals(const Item: ICollectable): Boolean; virtual; + function GetKey: Integer; virtual; + end; + + TAbstractMappable = class(TAbstractItem, IEquatable, IMappable) + private + FKey: ICollectable; + protected + function MakeKey: ICollectable; virtual; abstract; + public + destructor Destroy; override; + procedure AfterConstruction; override; + function Equals(const Item: ICollectable): Boolean; virtual; + function GetKey: ICollectable; virtual; + end; + + TAbstractStringMappable = class(TAbstractItem, IEquatable, IStringMappable) + private + FKey: String; + protected + function MakeKey: String; virtual; abstract; + public + procedure AfterConstruction; override; + function Equals(const Item: ICollectable): Boolean; virtual; + function GetKey: String; virtual; + end; + + TAssociationWrapper = class(TAbstractItem, IEquatable, IMappable, IAssociationWrapper) + private + FAutoDestroy: Boolean; + FKey: ICollectable; + FValue: TObject; + public + constructor Create(const Key: ICollectable; Value: TObject); overload; + constructor Create(Key: Integer; Value: TObject); overload; + constructor Create(Key: String; Value: TObject); overload; + constructor Create(Key, Value: TObject; AutoDestroyKey: Boolean = true); overload; + destructor Destroy; override; + function GetAutoDestroy: Boolean; + procedure SetAutoDestroy(Value: Boolean); + function GetKey: ICollectable; + function GetValue: TObject; + function Equals(const Item: ICollectable): Boolean; + property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; + property Key: ICollectable read GetKey; + property Value: TObject read GetValue; + end; + + TBooleanWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IBoolean) + private + FValue: Boolean; + public + constructor Create(Value: Boolean); + function GetValue: Boolean; + function CompareTo(const Item: ICollectable): Integer; + function Equals(const Item: ICollectable): Boolean; + function HashCode: Integer; + property Value: Boolean read GetValue; + end; + + TCardinalWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, ICardinal) + private + FValue: Cardinal; + public + constructor Create(Value: Cardinal); + function GetValue: Cardinal; + function Equals(const Item: ICollectable): Boolean; + function HashCode: Integer; + function CompareTo(const Item: ICollectable): Integer; + property Value: Cardinal read GetValue; + end; + + TCharWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IChar) + private + FValue: Char; + public + constructor Create(Value: Char); + function GetValue: Char; + function Equals(const Item: ICollectable): Boolean; + function HashCode: Integer; + function CompareTo(const Item: ICollectable): Integer; + property Value: Char read GetValue; + end; + + TClassWrapper = class(TAbstractItem, IEquatable, IHashable, IClass) + private + FValue: TClass; + public + constructor Create(Value: TClass); + function GetValue: TClass; + function Equals(const Item: ICollectable): Boolean; + function HashCode: Integer; + property Value: TClass read GetValue; + end; + + TDoubleWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IDouble) + private + FValue: Double; + public + constructor Create(Value: Double); + function GetValue: Double; + function Equals(const Item: ICollectable): Boolean; + function HashCode: Integer; + function CompareTo(const Item: ICollectable): Integer; + property Value: Double read GetValue; + end; + + TIntegerWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IInteger) + private + FValue: Integer; + public + constructor Create(Value: Integer); + function GetValue: Integer; + function Equals(const Item: ICollectable): Boolean; + function HashCode: Integer; + function CompareTo(const Item: ICollectable): Integer; + property Value: Integer read GetValue; + end; + + TIntegerAssociationWrapper = class(TAbstractItem, IEquatable, IIntegerMappable, IIntegerAssociationWrapper) + private + FAutoDestroy: Boolean; + FKey: Integer; + FValue: TObject; + public + constructor Create(const Key: Integer; Value: TObject); overload; + destructor Destroy; override; + function Equals(const Item: ICollectable): Boolean; + function GetAutoDestroy: Boolean; + procedure SetAutoDestroy(Value: Boolean); + function GetKey: Integer; + function GetValue: TObject; + property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; + property Key: Integer read GetKey; + property Value: TObject read GetValue; + end; + + TInterfaceWrapper = class(TAbstractItem, IHashable, IEquatable, IInterfaceWrapper) + private + FValue: IUnknown; + public + constructor Create(const Value: IUnknown); + destructor Destroy; override; + function GetValue: IUnknown; + function Equals(const Item: ICollectable): Boolean; + function HashCode: Integer; + property Value: IUnknown read GetValue; + end; + + TObjectWrapper = class(TAbstractItem, IEquatable, IComparable, IHashable, IObject) + private + FAutoDestroy: Boolean; + FValue: TObject; + public + constructor Create(Value: TObject); overload; + destructor Destroy; override; + function GetAutoDestroy: Boolean; + procedure SetAutoDestroy(Value: Boolean); + function GetValue: TObject; + function CompareTo(const Item: ICollectable): Integer; + function Equals(const Item: ICollectable): Boolean; + function HashCode: Integer; + property AutoDestroy: Boolean read FAutoDestroy write FAutoDestroy; + property Value: TObject read GetValue; + end; + + TStringWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IString) + private + FValue: String; + public + constructor Create(Value: String); + function GetValue: String; + function Equals(const Item: ICollectable): Boolean; + function HashCode: Integer; + function CompareTo(const Item: ICollectable): Integer; + property Value: String read FValue; + end; + + TStringAssociationWrapper = class(TAbstractItem, IEquatable, IStringMappable, IStringAssociationWrapper) + private + FAutoDestroy: Boolean; + FKey: String; + FValue: TObject; + public + constructor Create(const Key: String; Value: TObject); overload; + destructor Destroy; override; + function GetAutoDestroy: Boolean; + procedure SetAutoDestroy(Value: Boolean); + function GetKey: String; + function GetValue: TObject; + function Equals(const Item: ICollectable): Boolean; + property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; + property Key: String read GetKey; + property Value: TObject read GetValue; + end; + +implementation + +{ TAbstractItem } +function TAbstractItem.GetInstance: TObject; +begin + Result := Self; +end; + + +{ TAbstractIntegerMappable } +procedure TAbstractIntegerMappable.AfterConstruction; +begin + inherited AfterConstruction; + FKey := MakeKey; +end; + +function TAbstractIntegerMappable.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self = Item.GetInstance); +end; + +function TAbstractIntegerMappable.GetKey: Integer; +begin + Result := FKey; +end; + +{ TAbstractMappable } +destructor TAbstractMappable.Destroy; +begin + FKey := nil; + inherited Destroy; +end; + +procedure TAbstractMappable.AfterConstruction; +begin + inherited AfterConstruction; + FKey := MakeKey; +end; + +function TAbstractMappable.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self = Item.GetInstance); +end; + +function TAbstractMappable.GetKey: ICollectable; +begin + Result := FKey; +end; + +{ TAbstractStringMappable } +procedure TAbstractStringMappable.AfterConstruction; +begin + inherited AfterConstruction; + FKey := MakeKey; +end; + +function TAbstractStringMappable.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self = Item.GetInstance); +end; + +function TAbstractStringMappable.GetKey: String; +begin + Result := FKey; +end; + +{ TAssociationWrapper } +constructor TAssociationWrapper.Create(const Key: ICollectable; Value: TObject); +begin + inherited Create; + FAutoDestroy := true; + FKey := Key; + FValue := Value; +end; + +constructor TAssociationWrapper.Create(Key: Integer; Value: TObject); +begin + Create(TIntegerWrapper.Create(Key) as ICollectable, Value); +end; + +constructor TAssociationWrapper.Create(Key: String; Value: TObject); +begin + Create(TStringWrapper.Create(Key) as ICollectable, Value); +end; + +constructor TAssociationWrapper.Create(Key, Value: TObject; AutoDestroyKey: Boolean); +var + KeyWrapper: TObjectWrapper; +begin + KeyWrapper := TObjectWrapper.Create(Key); + KeyWrapper.AutoDestroy := AutoDestroyKey; + Create(KeyWrapper as ICollectable, Value); +end; + +destructor TAssociationWrapper.Destroy; +begin + if FAutoDestroy then + FValue.Free; + FKey := nil; + inherited Destroy; +end; + +function TAssociationWrapper.GetAutoDestroy: Boolean; +begin + Result := FAutoDestroy; +end; + +procedure TAssociationWrapper.SetAutoDestroy(Value: Boolean); +begin + FAutoDestroy := Value; +end; + +function TAssociationWrapper.GetKey: ICollectable; +begin + Result := FKey; +end; + +function TAssociationWrapper.GetValue: TObject; +begin + Result := FValue; +end; + +function TAssociationWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TAssociationWrapper).Value) +end; + +{ TCardinalWrapper } +constructor TCardinalWrapper.Create(Value: Cardinal); +begin + inherited Create; + FValue := Value; +end; + +function TCardinalWrapper.GetValue: Cardinal; +begin + Result := FValue; +end; + +function TCardinalWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TCardinalWrapper).Value) +end; + +function TCardinalWrapper.HashCode: Integer; +begin + Result := FValue; +end; + +function TCardinalWrapper.CompareTo(const Item: ICollectable): Integer; +var + Value2: Cardinal; +begin + Value2 := (Item.GetInstance as TCardinalWrapper).Value; + if Value < Value2 then + Result := -1 + else if Value > Value2 then + Result := 1 + else + Result := 0; +end; + +{ TBooleanWrapper } +constructor TBooleanWrapper.Create(Value: Boolean); +begin + inherited Create; + FValue := Value; +end; + +function TBooleanWrapper.GetValue: Boolean; +begin + Result := FValue; +end; + +function TBooleanWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TBooleanWrapper).Value) +end; + +function TBooleanWrapper.HashCode: Integer; +begin + Result := Ord(FValue); +end; + +function TBooleanWrapper.CompareTo(const Item: ICollectable): Integer; +var + Value2: Boolean; +begin + Value2 := (Item.GetInstance as TBooleanWrapper).Value; + if not Value and Value2 then + Result := -1 + else if Value and not Value2 then + Result := 1 + else + Result := 0; +end; + +{ TCharWrapper } +constructor TCharWrapper.Create(Value: Char); +begin + inherited Create; + FValue := Value; +end; + +function TCharWrapper.GetValue: Char; +begin + Result := FValue; +end; + +function TCharWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TCharWrapper).Value) +end; + +function TCharWrapper.HashCode: Integer; +begin + Result := Integer(FValue); +end; + +function TCharWrapper.CompareTo(const Item: ICollectable): Integer; +var + Value2: Char; +begin + Value2 := (Item.GetInstance as TCharWrapper).Value; + if Value < Value2 then + Result := -1 + else if Value > Value2 then + Result := 1 + else + Result := 0; +end; + +{ TClassWrapper } +constructor TClassWrapper.Create(Value: TClass); +begin + inherited Create; + FValue := Value; +end; + +function TClassWrapper.GetValue: TClass; +begin + Result := FValue; +end; + +function TClassWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TClassWrapper).Value) +end; + +function TClassWrapper.HashCode: Integer; +begin + Result := Integer(FValue.ClassInfo); +end; + +{ TDoubleWrapper } +constructor TDoubleWrapper.Create(Value: Double); +begin + inherited Create; + FValue := Value; +end; + +function TDoubleWrapper.GetValue: Double; +begin + Result := FValue; +end; + +function TDoubleWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TDoubleWrapper).Value) +end; + +function TDoubleWrapper.HashCode: Integer; +var + DblAsInt: array[0..1] of Integer; +begin + Double(DblAsInt) := Value; + Result := DblAsInt[0] xor DblAsInt[1]; +end; + +function TDoubleWrapper.CompareTo(const Item: ICollectable): Integer; +var + Value2: Double; +begin + Value2 := (Item.GetInstance as TDoubleWrapper).Value; + if Value < Value2 then + Result := -1 + else if Value > Value2 then + Result := 1 + else + Result := 0; +end; + +{ TIntegerWrapper } +constructor TIntegerWrapper.Create(Value: Integer); +begin + inherited Create; + FValue := Value; +end; + +function TIntegerWrapper.GetValue: Integer; +begin + Result := FValue; +end; + +function TIntegerWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TIntegerWrapper).Value) +end; + +function TIntegerWrapper.HashCode: Integer; +begin + Result := FValue; +end; + +function TIntegerWrapper.CompareTo(const Item: ICollectable): Integer; +var + Value2: Integer; +begin + Value2 := (Item.GetInstance as TIntegerWrapper).Value; + if Value < Value2 then + Result := -1 + else if Value > Value2 then + Result := 1 + else + Result := 0; +end; + +{ TIntegerAssociationWrapper } +constructor TIntegerAssociationWrapper.Create(const Key: Integer; Value: TObject); +begin + inherited Create; + FAutoDestroy := true; + FKey := Key; + FValue := Value; +end; + +destructor TIntegerAssociationWrapper.Destroy; +begin + if FAutoDestroy then + FValue.Free; + inherited Destroy; +end; + +function TIntegerAssociationWrapper.GetAutoDestroy: Boolean; +begin + Result := FAutoDestroy; +end; + +procedure TIntegerAssociationWrapper.SetAutoDestroy(Value: Boolean); +begin + FAutoDestroy := Value; +end; + +function TIntegerAssociationWrapper.GetValue: TObject; +begin + Result := FValue; +end; + +function TIntegerAssociationWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TIntegerAssociationWrapper).Value) +end; + +function TIntegerAssociationWrapper.GetKey: Integer; +begin + Result := FKey; +end; + +{ TStringAssociationWrapper } +constructor TStringAssociationWrapper.Create(const Key: String; Value: TObject); +begin + inherited Create; + FAutoDestroy := true; + FKey := Key; + FValue := Value; +end; + +destructor TStringAssociationWrapper.Destroy; +begin + if FAutoDestroy then + FValue.Free; + inherited Destroy; +end; + +function TStringAssociationWrapper.GetAutoDestroy: Boolean; +begin + Result := FAutoDestroy; +end; + +procedure TStringAssociationWrapper.SetAutoDestroy(Value: Boolean); +begin + FAutoDestroy := Value; +end; + +function TStringAssociationWrapper.GetValue: TObject; +begin + Result := FValue; +end; + +function TStringAssociationWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TStringAssociationWrapper).Value) +end; + +function TStringAssociationWrapper.GetKey: String; +begin + Result := FKey; +end; + +{ TInterfaceWrapper } +constructor TInterfaceWrapper.Create(const Value: IUnknown); +begin + inherited Create; + FValue := Value; +end; + +destructor TInterfaceWrapper.Destroy; +begin + FValue := nil; + inherited Destroy; +end; + +function TInterfaceWrapper.GetValue: IUnknown; +begin + Result := FValue; +end; + +function TInterfaceWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TInterfaceWrapper).Value) +end; + +function TInterfaceWrapper.HashCode: Integer; +begin + Result := Integer(Pointer(FValue)); +end; + +{ TObjectWrapper } +constructor TObjectWrapper.Create(Value: TObject); +begin + inherited Create; + FAutoDestroy := true; + FValue := Value; +end; + +destructor TObjectWrapper.Destroy; +begin + if FAutoDestroy then + FValue.Free; + inherited Destroy; +end; + +function TObjectWrapper.GetAutoDestroy: Boolean; +begin + Result := FAutoDestroy; +end; + +procedure TObjectWrapper.SetAutoDestroy(Value: Boolean); +begin + FAutoDestroy := Value; +end; + +function TObjectWrapper.GetValue: TObject; +begin + Result := FValue; +end; + +function TObjectWrapper.CompareTo(const Item: ICollectable): Integer; +var + Value1, Value2: Integer; +begin + Value1 := Integer(Pointer(Self)); + if Item <> nil then + Value2 := Integer(Pointer(Item)) + else + Value2 := Low(Integer); + if (Value1 < Value2) then + Result := -1 + else if (Value1 > Value2) then + Result := 1 + else + Result := 0; +end; + +function TObjectWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TObjectWrapper).Value) +end; + +function TObjectWrapper.HashCode: Integer; +begin + Result := Integer(Pointer(FValue)); +end; + +{ TStringWrapper } +constructor TStringWrapper.Create(Value: String); +begin + inherited Create; + FValue := Value; +end; + +function TStringWrapper.GetValue: String; +begin + Result := FValue; +end; + +function TStringWrapper.Equals(const Item: ICollectable): Boolean; +begin + Result := (Self.Value = (Item.GetInstance as TStringWrapper).Value) +end; + +function TStringWrapper.HashCode: Integer; +var + I: Integer; +begin + Result := 0; + for I := 1 to Length(FValue) do + Result := (Result shl 1) xor Ord(FValue[I]); +end; + +function TStringWrapper.CompareTo(const Item: ICollectable): Integer; +begin + Result := CompareStr(Self.Value, (Item.GetInstance as TStringWrapper).Value) +end; + + +end. diff --git a/unicode/src/lib/collections/Collections.pas b/unicode/src/lib/collections/Collections.pas new file mode 100644 index 00000000..0c94173d --- /dev/null +++ b/unicode/src/lib/collections/Collections.pas @@ -0,0 +1,5318 @@ +unit Collections; +(***************************************************************************** + * Copyright 2003 by Matthew Greet + * This library is free software; you can redistribute it and/or modify it + * under the terms of the GNU Lesser General Public License as published by the + * Free Software Foundation; either version 2.1 of the License, or (at your + * option) any later version. + * + * This library is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + * details. (http://opensource.org/licenses/lgpl-license.php) + * + * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads. + * + * $Version: v1.0 $ + * $Revision: 1.1.1.4 $ + * $Log: D:\QVCS Repositories\Delphi Collections\Collections.qbt $ + * + * Main unit containing all interface and abstract class definitions. + * + * Revision 1.1.1.4 by: Matthew Greet Rev date: 14/03/05 23:26:32 + * Fixed RemoveAll for TAbstractList for sorted lists. + * + * Revision 1.1.1.3 by: Matthew Greet Rev date: 14/10/04 16:31:18 + * Fixed memory lean in ContainsKey of TAbstractStringMap and + * TAbstractIntegerMap. + * + * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:03:26 + * Capacity property. + * Memory leak fixed. + * + * Revision 1.1.1.1 by: Matthew Greet Rev date: 13/02/04 16:12:10 + * v1.0 branch. + * + * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:36:30 + * Added integer map and string map collection types with supporting + * classes. + * Add clone and filter functions with supporting classes. + * Added nil not allowed collection error. + * Properties appear in collection interfaces as well as abstract + * classes. + * + * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02 + * Initial revision. + * + * FPC compatibility fixes by: UltraStar Deluxe Team + * + * $Endlog$ + *****************************************************************************) + +{$IFDEF FPC} + {$MODE Delphi}{$H+} +{$ENDIF} + +interface + +uses + Classes, SysUtils; + +const + EquatableIID: TGUID = '{EAC823A7-0B90-11D7-8120-0002E3165EF8}'; + HashableIID: TGUID = '{98998440-4C3E-11D7-8120-0002E3165EF8}'; + ComparableIID: TGUID = '{9F4C96C0-0CF0-11D7-8120-0002E3165EF8}'; + MappableIID: TGUID = '{DAEC8CA0-0DBB-11D7-8120-0002E3165EF8}'; + StringMappableIID: TGUID = '{3CC61F40-5F92-11D7-8120-0002E3165EF8}'; + IntegerMappableIID: TGUID = '{774FC760-5F92-11D7-8120-0002E3165EF8}'; + +type + TDefaultComparator = class; + TNaturalComparator = class; + ICollectable = interface; + + TCollectableArray = array of ICollectable; + TIntegerArray = array of Integer; + TStringArray = array of String; + TListArray = array of TList; + + TCollectionError = (ceOK, ceDuplicate, ceDuplicateKey, ceFixedSize, ceNilNotAllowed, ceNotNaturalItem, ceOutOfRange); + TCollectionErrors = set of TCollectionError; + + TSearchResultType = (srNotFound, srFoundAtIndex, srBeforeIndex, srAfterEnd); + + TCollectionType = (ctBag, ctSet, ctList, ctMap, ctIntegerMap, ctStringMap); + + TCollectionFilterFunc = function (const Item: ICollectable): Boolean of object; + TCollectionCompareFunc = function (const Item1, Item2: ICollectable): Integer of object; + + TSearchResult = record + ResultType: TSearchResultType; + Index: Integer; + end; + + ICollectable = interface + ['{98998441-4C3E-11D7-8120-0002E3165EF8}'] + function GetInstance: TObject; + end; + + IEquatable = interface + ['{EAC823A7-0B90-11D7-8120-0002E3165EF8}'] + function GetInstance: TObject; + function Equals(const Item: ICollectable): Boolean; + end; + + IHashable = interface(IEquatable) + ['{98998440-4C3E-11D7-8120-0002E3165EF8}'] + function HashCode: Integer; + end; + + IComparable = interface(IEquatable) + ['{9F4C96C0-0CF0-11D7-8120-0002E3165EF8}'] + function CompareTo(const Item: ICollectable): Integer; + end; + + IMappable = interface(IEquatable) + ['{DAEC8CA0-0DBB-11D7-8120-0002E3165EF8}'] + function GetKey: ICollectable; + end; + + IStringMappable = interface(IEquatable) + ['{3CC61F40-5F92-11D7-8120-0002E3165EF8}'] + function GetKey: String; + end; + + IIntegerMappable = interface(IEquatable) + ['{774FC760-5F92-11D7-8120-0002E3165EF8}'] + function GetKey: Integer; + end; + + IComparator = interface + ['{1F20CD60-10FE-11D7-8120-0002E3165EF8}'] + function GetInstance: TObject; + function Compare(const Item1, Item2: ICollectable): Integer; + function Equals(const Item1, Item2: ICollectable): Boolean; overload; + function Equals(const Comparator: IComparator): Boolean; overload; + end; + + IFilter = interface + ['{27FE44C0-638E-11D7-8120-0002E3165EF8}'] + function Accept(const Item: ICollectable): Boolean; + end; + + IIterator = interface + ['{F6930500-1113-11D7-8120-0002E3165EF8}'] + function GetAllowRemoval: Boolean; + function CurrentItem: ICollectable; + function EOF: Boolean; + function First: ICollectable; + function Next: ICollectable; + function Remove: Boolean; + end; + + IMapIterator = interface(IIterator) + ['{848CC0E0-2A31-11D7-8120-0002E3165EF8}'] + function CurrentKey: ICollectable; + end; + + IIntegerMapIterator = interface(IIterator) + ['{C7169780-606C-11D7-8120-0002E3165EF8}'] + function CurrentKey: Integer; + end; + + IStringMapIterator = interface(IIterator) + ['{1345ED20-5F93-11D7-8120-0002E3165EF8}'] + function CurrentKey: String; + end; + + IAssociation = interface(ICollectable) + ['{556CD700-4DB3-11D7-8120-0002E3165EF8}'] + function GetKey: ICollectable; + function GetValue: ICollectable; + end; + + IIntegerAssociation = interface(ICollectable) + ['{ED954420-5F94-11D7-8120-0002E3165EF8}'] + function GetKey: Integer; + function GetValue: ICollectable; + end; + + IStringAssociation = interface(ICollectable) + ['{FB87D2A0-5F94-11D7-8120-0002E3165EF8}'] + function GetKey: String; + function GetValue: ICollectable; + end; + + IAssociationComparator = interface(IComparator) + ['{EA9BE6E0-A852-11D8-B93A-0002E3165EF8}'] + function GetKeyComparator: IComparator; + procedure SetKeyComparator(Value: IComparator); + property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator; + end; + + IIntegerAssociationComparator = interface(IComparator) + ['{EA9BE6E1-A852-11D8-B93A-0002E3165EF8}'] + end; + + IStringAssociationComparator = interface(IComparator) + ['{EA9BE6E2-A852-11D8-B93A-0002E3165EF8}'] + end; + + ICollection = interface + ['{EAC823AC-0B90-11D7-8120-0002E3165EF8}'] + function GetAsArray: TCollectableArray; + function GetCapacity: Integer; + procedure SetCapacity(Value: Integer); + function GetComparator: IComparator; + procedure SetComparator(const Value: IComparator); + function GetDuplicates: Boolean; + function GetFixedSize: Boolean; + function GetIgnoreErrors: TCollectionErrors; + procedure SetIgnoreErrors(Value: TCollectionErrors); + function GetInstance: TObject; + function GetIterator: IIterator; overload; + function GetIterator(const Filter: IFilter): IIterator; overload; + function GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; overload; + function GetNaturalItemIID: TGUID; + function GetNaturalItemsOnly: Boolean; + function GetSize: Integer; + function GetType: TCollectionType; + function Add(const Item: ICollectable): Boolean; overload; + function Add(const ItemArray: array of ICollectable): Integer; overload; + function Add(const Collection: ICollection): Integer; overload; + function Clear: Integer; + function Clone: ICollection; + function Contains(const Item: ICollectable): Boolean; overload; + function Contains(const ItemArray: array of ICollectable): Boolean; overload; + function Contains(const Collection: ICollection): Boolean; overload; + function Equals(const Collection: ICollection): Boolean; + function Find(const Filter: IFilter): ICollectable; overload; + function Find(FilterFunc: TCollectionFilterFunc): ICollectable; overload; + function FindAll(const Filter: IFilter = nil): ICollection; overload; + function FindAll(FilterFunc: TCollectionFilterFunc): ICollection; overload; + function IsEmpty: Boolean; + function IsNaturalItem(const Item: ICollectable): Boolean; + function IsNilAllowed: Boolean; + function ItemAllowed(const Item: ICollectable): TCollectionError; + function ItemCount(const Item: ICollectable): Integer; overload; + function ItemCount(const ItemArray: array of ICollectable): Integer; overload; + function ItemCount(const Collection: ICollection): Integer; overload; + function Matching(const ItemArray: array of ICollectable): ICollection; overload; + function Matching(const Collection: ICollection): ICollection; overload; + function Remove(const Item: ICollectable): ICollectable; overload; + function Remove(const ItemArray: array of ICollectable): ICollection; overload; + function Remove(const Collection: ICollection): ICollection; overload; + function RemoveAll(const Item: ICollectable): ICollection; overload; + function RemoveAll(const ItemArray: array of ICollectable): ICollection; overload; + function RemoveAll(const Collection: ICollection): ICollection; overload; + function Retain(const ItemArray: array of ICollectable): ICollection; overload; + function Retain(const Collection: ICollection): ICollection; overload; + property AsArray: TCollectableArray read GetAsArray; + property Capacity: Integer read GetCapacity write SetCapacity; + property Comparator: IComparator read GetComparator write SetComparator; + property FixedSize: Boolean read GetFixedSize; + property IgnoreErrors: TCollectionErrors read GetIgnoreErrors write SetIgnoreErrors; + property NaturalItemIID: TGUID read GetNaturalItemIID; + property NaturalItemsOnly: Boolean read GetNaturalItemsOnly; + property Size: Integer read GetSize; + end; + + IBag = interface(ICollection) + ['{C29C9560-2D59-11D7-8120-0002E3165EF8}'] + function CloneAsBag: IBag; + end; + + ISet = interface(ICollection) + ['{DD7888E2-0BB1-11D7-8120-0002E3165EF8}'] + function CloneAsSet: ISet; + function Complement(const Universe: ISet): ISet; + function Intersect(const Set2: ISet): ISet; + function Union(const Set2: ISet): ISet; + end; + + IList = interface(ICollection) + ['{EE81AB60-0B9F-11D7-8120-0002E3165EF8}'] + function GetDuplicates: Boolean; + procedure SetDuplicates(Value: Boolean); + function GetItem(Index: Integer): ICollectable; + procedure SetItem(Index: Integer; const Item: ICollectable); + function GetSorted: Boolean; + procedure SetSorted(Value: Boolean); + function CloneAsList: IList; + function Delete(Index: Integer): ICollectable; + procedure Exchange(Index1, Index2: Integer); + function First: ICollectable; + function IndexOf(const Item: ICollectable): Integer; + function Insert(Index: Integer; const Item: ICollectable): Boolean; overload; + function Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; overload; + function Insert(Index: Integer; const Collection: ICollection): Integer; overload; + function Last: ICollectable; + procedure Sort(const Comparator: IComparator); overload; + procedure Sort(CompareFunc: TCollectionCompareFunc); overload; + property Duplicates: Boolean read GetDuplicates write SetDuplicates; + property Items[Index: Integer]: ICollectable read GetItem write SetItem; default; + property Sorted: Boolean read GetSorted write SetSorted; + end; + + IMap = interface(ICollection) + ['{AD458280-2A6B-11D7-8120-0002E3165EF8}'] + function GetItem(const Key: ICollectable): ICollectable; + procedure SetItem(const Key, Item: ICollectable); + function GetKeyComparator: IComparator; + procedure SetKeyComparator(const Value: IComparator); + function GetKeyIterator: IIterator; + function GetKeys: ISet; + function GetMapIterator: IMapIterator; + function GetMapIteratorByKey(const Filter: IFilter): IMapIterator; overload; + function GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; overload; + function GetNaturalKeyIID: TGUID; + function GetNaturalKeysOnly: Boolean; + function GetValues: ICollection; + function CloneAsMap: IMap; + function ContainsKey(const Key: ICollectable): Boolean; overload; + function ContainsKey(const KeyArray: array of ICollectable): Boolean; overload; + function ContainsKey(const Collection: ICollection): Boolean; overload; + function Get(const Key: ICollectable): ICollectable; + function IsNaturalKey(const Key: ICollectable): Boolean; + function KeyAllowed(const Key: ICollectable): TCollectionError; + function MatchingKey(const KeyArray: array of ICollectable): ICollection; overload; + function MatchingKey(const Collection: ICollection): ICollection; overload; + function Put(const Item: ICollectable): ICollectable; overload; + function Put(const Key, Item: ICollectable): ICollectable; overload; + function Put(const ItemArray: array of ICollectable): ICollection; overload; + function Put(const Collection: ICollection): ICollection; overload; + function Put(const Map: IMap): ICollection; overload; + function RemoveKey(const Key: ICollectable): ICollectable; overload; + function RemoveKey(const KeyArray: array of ICollectable): ICollection; overload; + function RemoveKey(const Collection: ICollection): ICollection; overload; + function RetainKey(const KeyArray: array of ICollectable): ICollection; overload; + function RetainKey(const Collection: ICollection): ICollection; overload; + property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator; + property Items[const Key: ICollectable]: ICollectable read GetItem write SetItem; default; + property NaturalKeyIID: TGUID read GetNaturalKeyIID; + property NaturalKeysOnly: Boolean read GetNaturalKeysOnly; + end; + + IIntegerMap = interface(ICollection) + ['{93DBA9A0-606C-11D7-8120-0002E3165EF8}'] + function GetItem(const Key: Integer): ICollectable; + procedure SetItem(const Key: Integer; const Item: ICollectable); + function GetKeys: ISet; + function GetMapIterator: IIntegerMapIterator; + function GetValues: ICollection; + function CloneAsIntegerMap: IIntegerMap; + function ContainsKey(const Key: Integer): Boolean; overload; + function ContainsKey(const KeyArray: array of Integer): Boolean; overload; + function Get(const Key: Integer): ICollectable; + function Put(const Item: ICollectable): ICollectable; overload; + function Put(const Key: Integer; const Item: ICollectable): ICollectable; overload; + function Put(const ItemArray: array of ICollectable): ICollection; overload; + function Put(const Collection: ICollection): ICollection; overload; + function Put(const Map: IIntegerMap): ICollection; overload; + function RemoveKey(const Key: Integer): ICollectable; overload; + function RemoveKey(const KeyArray: array of Integer): ICollection; overload; + function RetainKey(const KeyArray: array of Integer): ICollection; overload; + property Items[const Key: Integer]: ICollectable read GetItem write SetItem; default; + end; + + IStringMap = interface(ICollection) + ['{20531A20-5F92-11D7-8120-0002E3165EF8}'] + function GetItem(const Key: String): ICollectable; + procedure SetItem(const Key: String; const Item: ICollectable); + function GetKeys: ISet; + function GetMapIterator: IStringMapIterator; + function GetValues: ICollection; + function CloneAsStringMap: IStringMap; + function ContainsKey(const Key: String): Boolean; overload; + function ContainsKey(const KeyArray: array of String): Boolean; overload; + function Get(const Key: String): ICollectable; + function Put(const Item: ICollectable): ICollectable; overload; + function Put(const Key: String; const Item: ICollectable): ICollectable; overload; + function Put(const ItemArray: array of ICollectable): ICollection; overload; + function Put(const Collection: ICollection): ICollection; overload; + function Put(const Map: IStringMap): ICollection; overload; + function RemoveKey(const Key: String): ICollectable; overload; + function RemoveKey(const KeyArray: array of String): ICollection; overload; + function RetainKey(const KeyArray: array of String): ICollection; overload; + property Items[const Key: String]: ICollectable read GetItem write SetItem; default; + end; + + TCollectionPosition = class + private + FFound: Boolean; + public + constructor Create(Found: Boolean); + property Found: Boolean read FFound; + end; + + TAbstractComparator = class(TInterfacedObject, IComparator) + public + class function GetDefaultComparator: IComparator; + class function GetNaturalComparator: IComparator; + class function GetReverseNaturalComparator: IComparator; + function GetInstance: TObject; + function Compare(const Item1, Item2: ICollectable): Integer; virtual; abstract; + function Equals(const Item1, Item2: ICollectable): Boolean; overload; virtual; abstract; + function Equals(const Comparator: IComparator): Boolean; overload; virtual; + end; + + TDefaultComparator = class(TAbstractComparator) + protected + constructor Create; + public + function Compare(const Item1, Item2: ICollectable): Integer; override; + function Equals(const Item1, Item2: ICollectable): Boolean; override; + end; + + TNaturalComparator = class(TAbstractComparator) + protected + constructor Create; + public + function Compare(const Item1, Item2: ICollectable): Integer; override; + function Equals(const Item1, Item2: ICollectable): Boolean; override; + end; + + TReverseNaturalComparator = class(TAbstractComparator) + protected + constructor Create; + public + function Compare(const Item1, Item2: ICollectable): Integer; override; + function Equals(const Item1, Item2: ICollectable): Boolean; override; + end; + + TAssociation = class(TInterfacedObject, ICollectable, IAssociation) + private + FKey: ICollectable; + FValue: ICollectable; + public + constructor Create(const Key, Value: ICollectable); virtual; + destructor Destroy; override; + function GetInstance: TObject; virtual; + function GetKey: ICollectable; + function GetValue: ICollectable; + end; + + TIntegerAssociation = class(TInterfacedObject, ICollectable, IIntegerAssociation) + private + FKey: Integer; + FValue: ICollectable; + public + constructor Create(const Key: Integer; const Value: ICollectable); virtual; + destructor Destroy; override; + function GetInstance: TObject; virtual; + function GetKey: Integer; + function GetValue: ICollectable; + end; + + TStringAssociation = class(TInterfacedObject, ICollectable, IStringAssociation) + private + FKey: String; + FValue: ICollectable; + public + constructor Create(const Key: String; const Value: ICollectable); virtual; + destructor Destroy; override; + function GetInstance: TObject; virtual; + function GetKey: String; + function GetValue: ICollectable; + end; + + TAssociationComparator = class(TAbstractComparator, IAssociationComparator) + private + FKeyComparator: IComparator; + public + constructor Create(NaturalKeys: Boolean = false); + destructor Destroy; override; + function GetKeyComparator: IComparator; + procedure SetKeyComparator(Value: IComparator); + function Compare(const Item1, Item2: ICollectable): Integer; override; + function Equals(const Item1, Item2: ICollectable): Boolean; override; + property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator; + end; + + TIntegerAssociationComparator = class(TAbstractComparator, IIntegerAssociationComparator) + public + constructor Create; + destructor Destroy; override; + function Compare(const Item1, Item2: ICollectable): Integer; override; + function Equals(const Item1, Item2: ICollectable): Boolean; override; + end; + + TStringAssociationComparator = class(TAbstractComparator, IStringAssociationComparator) + public + constructor Create; + destructor Destroy; override; + function Compare(const Item1, Item2: ICollectable): Integer; override; + function Equals(const Item1, Item2: ICollectable): Boolean; override; + end; + + + + TAbstractCollection = class(TInterfacedObject, ICollection) + private + FCreated: Boolean; // Required to avoid passing destroyed object reference to exception + FComparator: IComparator; + FIgnoreErrors: TCollectionErrors; + FNaturalItemsOnly: Boolean; + protected + procedure CollectionError(ErrorType: TCollectionError); + procedure InitFrom(const Collection: ICollection); overload; virtual; + function TrueAdd(const Item: ICollectable): Boolean; virtual; abstract; + procedure TrueClear; virtual; abstract; + function TrueContains(const Item: ICollectable): Boolean; virtual; abstract; + function TrueItemCount(const Item: ICollectable): Integer; virtual; + function TrueRemove(const Item: ICollectable): ICollectable; virtual; abstract; + function TrueRemoveAll(const Item: ICollectable): ICollection; virtual; abstract; + public + constructor Create; overload; virtual; + constructor Create(NaturalItemsOnly: Boolean); overload; virtual; + constructor Create(const ItemArray: array of ICollectable); overload; virtual; + constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual; + constructor Create(const Collection: ICollection); overload; virtual; + destructor Destroy; override; + class function GetAlwaysNaturalItems: Boolean; virtual; + function GetAsArray: TCollectableArray; virtual; + function GetCapacity: Integer; virtual; abstract; + procedure SetCapacity(Value: Integer); virtual; abstract; + function GetComparator: IComparator; virtual; + procedure SetComparator(const Value: IComparator); virtual; + function GetDuplicates: Boolean; virtual; + function GetFixedSize: Boolean; virtual; + function GetIgnoreErrors: TCollectionErrors; + procedure SetIgnoreErrors(Value: TCollectionErrors); + function GetInstance: TObject; + function GetIterator: IIterator; overload; virtual; abstract; + function GetIterator(const Filter: IFilter): IIterator; overload; virtual; + function GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; overload; virtual; + function GetNaturalItemIID: TGUID; virtual; abstract; + function GetNaturalItemsOnly: Boolean; virtual; + function GetSize: Integer; virtual; abstract; + function GetType: TCollectionType; virtual; abstract; + function Add(const Item: ICollectable): Boolean; overload; virtual; + function Add(const ItemArray: array of ICollectable): Integer; overload; virtual; + function Add(const Collection: ICollection): Integer; overload; virtual; + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + function Clear: Integer; virtual; + function Clone: ICollection; virtual; + function Contains(const Item: ICollectable): Boolean; overload; virtual; + function Contains(const ItemArray: array of ICollectable): Boolean; overload; virtual; + function Contains(const Collection: ICollection): Boolean; overload; virtual; + function Equals(const Collection: ICollection): Boolean; virtual; + function Find(const Filter: IFilter): ICollectable; overload; virtual; + function Find(FilterFunc: TCollectionFilterFunc): ICollectable; overload; virtual; + function FindAll(const Filter: IFilter): ICollection; overload; virtual; + function FindAll(FilterFunc: TCollectionFilterFunc): ICollection; overload; virtual; + function IsEmpty: Boolean; virtual; + function IsNaturalItem(const Item: ICollectable): Boolean; virtual; + function IsNilAllowed: Boolean; virtual; abstract; + function ItemAllowed(const Item: ICollectable): TCollectionError; virtual; + function ItemCount(const Item: ICollectable): Integer; overload; virtual; + function ItemCount(const ItemArray: array of ICollectable): Integer; overload; virtual; + function ItemCount(const Collection: ICollection): Integer; overload; virtual; + function Matching(const ItemArray: array of ICollectable): ICollection; overload; virtual; + function Matching(const Collection: ICollection): ICollection; overload; virtual; + function Remove(const Item: ICollectable): ICollectable; overload; virtual; + function Remove(const ItemArray: array of ICollectable): ICollection; overload; virtual; + function Remove(const Collection: ICollection): ICollection; overload; virtual; + function RemoveAll(const Item: ICollectable): ICollection; overload; virtual; + function RemoveAll(const ItemArray: array of ICollectable): ICollection; overload; virtual; + function RemoveAll(const Collection: ICollection): ICollection; overload; virtual; + function Retain(const ItemArray: array of ICollectable): ICollection; overload; virtual; + function Retain(const Collection: ICollection): ICollection; overload; virtual; + property AsArray: TCollectableArray read GetAsArray; + property Capacity: Integer read GetCapacity write SetCapacity; + property Comparator: IComparator read GetComparator write SetComparator; + property FixedSize: Boolean read GetFixedSize; + property IgnoreErrors: TCollectionErrors read GetIgnoreErrors write SetIgnoreErrors; + property NaturalItemIID: TGUID read GetNaturalItemIID; + property NaturalItemsOnly: Boolean read GetNaturalItemsOnly; + property Size: Integer read GetSize; + end; + + TAbstractBag = class(TAbstractCollection, IBag) + public + function CloneAsBag: IBag; virtual; + function GetNaturalItemIID: TGUID; override; + function GetType: TCollectionType; override; + function IsNilAllowed: Boolean; override; + end; + + TAbstractSet = class (TAbstractCollection, ISet) + protected + function GetPosition(const Item: ICollectable): TCollectionPosition; virtual; abstract; + function TrueAdd(const Item: ICollectable): Boolean; override; + procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); virtual; abstract; + function TrueContains(const Item: ICollectable): Boolean; override; + function TrueGet(Position: TCollectionPosition): ICollectable; virtual; abstract; + function TrueRemove(const Item: ICollectable): ICollectable; override; + procedure TrueRemove2(Position: TCollectionPosition); virtual; abstract; + function TrueRemoveAll(const Item: ICollectable): ICollection; override; + public + function GetDuplicates: Boolean; override; + function GetNaturalItemIID: TGUID; override; + function GetType: TCollectionType; override; + function CloneAsSet: ISet; virtual; + function Complement(const Universe: ISet): ISet; overload; virtual; + function Intersect(const Set2: ISet): ISet; overload; virtual; + function IsNilAllowed: Boolean; override; + function Union(const Set2: ISet): ISet; overload; virtual; + end; + + TAbstractList = class(TAbstractCollection, IList) + private + FDuplicates: Boolean; + FSorted: Boolean; + protected + function BinarySearch(const Item: ICollectable): TSearchResult; virtual; + procedure InitFrom(const Collection: ICollection); override; + procedure QuickSort(Lo, Hi: Integer; const Comparator: IComparator); overload; virtual; + procedure QuickSort(Lo, Hi: Integer; CompareFunc: TCollectionCompareFunc); overload; virtual; + function SequentialSearch(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; virtual; + function TrueContains(const Item: ICollectable): Boolean; override; + function TrueGetItem(Index: Integer): ICollectable; virtual; abstract; + procedure TrueSetItem(Index: Integer; const Item: ICollectable); virtual; abstract; + function TrueAdd(const Item: ICollectable): Boolean; override; + procedure TrueAppend(const Item: ICollectable); virtual; abstract; + function TrueDelete(Index: Integer): ICollectable; virtual; abstract; + procedure TrueInsert(Index: Integer; const Item: ICollectable); virtual; abstract; + function TrueItemCount(const Item: ICollectable): Integer; override; + function TrueRemove(const Item: ICollectable): ICollectable; override; + function TrueRemoveAll(const Item: ICollectable): ICollection; override; + public + constructor Create(NaturalItemsOnly: Boolean); override; + function GetDuplicates: Boolean; override; + procedure SetDuplicates(Value: Boolean); virtual; + function GetItem(Index: Integer): ICollectable; virtual; + procedure SetItem(Index: Integer; const Item: ICollectable); virtual; + function GetIterator: IIterator; override; + function GetNaturalItemIID: TGUID; override; + function GetSorted: Boolean; virtual; + procedure SetSorted(Value: Boolean); virtual; + function GetType: TCollectionType; override; + function CloneAsList: IList; virtual; + function Delete(Index: Integer): ICollectable; virtual; + procedure Exchange(Index1, Index2: Integer); virtual; + function First: ICollectable; virtual; + function IndexOf(const Item: ICollectable): Integer; virtual; + function Insert(Index: Integer; const Item: ICollectable): Boolean; overload; virtual; + function Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; overload; virtual; + function Insert(Index: Integer; const Collection: ICollection): Integer; overload; virtual; + function IsNilAllowed: Boolean; override; + function Last: ICollectable; virtual; + function Search(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; virtual; + procedure Sort(const SortComparator: IComparator = nil); overload; virtual; + procedure Sort(CompareFunc: TCollectionCompareFunc); overload; virtual; + property Duplicates: Boolean read GetDuplicates write SetDuplicates; + property Items[Index: Integer]: ICollectable read GetItem write SetItem; default; + property Sorted: Boolean read GetSorted write SetSorted; + end; + + TAbstractMap = class(TAbstractCollection, IMap) + private + FAssociationComparator: IAssociationComparator; + FKeyComparator: IComparator; + FNaturalKeysOnly: Boolean; + protected + function GetAssociationIterator: IMapIterator; virtual; abstract; + function GetKeyPosition(const Key: ICollectable): TCollectionPosition; virtual; abstract; + procedure InitFrom(const Collection: ICollection); override; + function TrueAdd(const Item: ICollectable): Boolean; override; + function TrueContains(const Item: ICollectable): Boolean; override; + function TrueGet(Position: TCollectionPosition): IAssociation; virtual; abstract; + function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; virtual; abstract; + function TrueRemove(const Item: ICollectable): ICollectable; override; + function TrueRemove2(Position: TCollectionPosition): IAssociation; virtual; abstract; + function TrueRemoveAll(const Item: ICollectable): ICollection; override; + property AssociationComparator: IAssociationComparator read FAssociationComparator; + public + constructor Create; override; + constructor Create(NaturalItemsOnly: Boolean); override; + constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual; + constructor Create(const ItemArray: array of ICollectable); overload; override; + constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override; + constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual; + constructor Create(const KeyArray, ItemArray: array of ICollectable); overload; virtual; + constructor Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual; + constructor Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual; +// Don't use this parameter signature as it hits a compiler bug in D5. +// constructor Create(const KeyArray, ItemArray: TCollectableArray; NaturalItemsOnly: Boolean = false; NaturalKeysOnly: Boolean = true); overload; virtual; + constructor Create(const Map: IMap); overload; virtual; + destructor Destroy; override; + class function GetAlwaysNaturalKeys: Boolean; virtual; + function GetItem(const Key: ICollectable): ICollectable; virtual; + procedure SetItem(const Key, Item: ICollectable); virtual; + function GetIterator: IIterator; override; + function GetKeyComparator: IComparator; virtual; + procedure SetKeyComparator(const Value: IComparator); virtual; + function GetKeyIterator: IIterator; virtual; + function GetKeys: ISet; virtual; + function GetMapIterator: IMapIterator; virtual; + function GetMapIteratorByKey(const Filter: IFilter): IMapIterator; overload; virtual; + function GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; overload; virtual; + function GetNaturalItemIID: TGUID; override; + function GetNaturalKeyIID: TGUID; virtual; + function GetNaturalKeysOnly: Boolean; virtual; + function GetType: TCollectionType; override; + function GetValues: ICollection; virtual; + function Clone: ICollection; override; + function CloneAsMap: IMap; virtual; + function ContainsKey(const Key: ICollectable): Boolean; overload; virtual; + function ContainsKey(const KeyArray: array of ICollectable): Boolean; overload; virtual; + function ContainsKey(const Collection: ICollection): Boolean; overload; virtual; + function Get(const Key: ICollectable): ICollectable; virtual; + function KeyAllowed(const Key: ICollectable): TCollectionError; virtual; + function IsNaturalKey(const Key: ICollectable): Boolean; virtual; + function IsNilAllowed: Boolean; override; + function MatchingKey(const KeyArray: array of ICollectable): ICollection; overload; virtual; + function MatchingKey(const Collection: ICollection): ICollection; overload; virtual; + function Put(const Item: ICollectable): ICollectable; overload; virtual; + function Put(const Key, Item: ICollectable): ICollectable; overload; virtual; + function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual; + function Put(const Collection: ICollection): ICollection; overload; virtual; + function Put(const Map: IMap): ICollection; overload; virtual; + function RemoveKey(const Key: ICollectable): ICollectable; overload; virtual; + function RemoveKey(const KeyArray: array of ICollectable): ICollection; overload; virtual; + function RemoveKey(const Collection: ICollection): ICollection; overload; virtual; + function RetainKey(const KeyArray: array of ICollectable): ICollection; overload; virtual; + function RetainKey(const Collection: ICollection): ICollection; overload; virtual; + property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator; + property Items[const Key: ICollectable]: ICollectable read GetItem write SetItem; default; + property NaturalKeyIID: TGUID read GetNaturalKeyIID; + property NaturalKeysOnly: Boolean read GetNaturalKeysOnly; + end; + + TAbstractIntegerMap = class(TAbstractCollection, IIntegerMap) + private + FAssociationComparator: IIntegerAssociationComparator; + protected + function GetAssociationIterator: IIntegerMapIterator; virtual; abstract; + function GetKeyPosition(const Key: Integer): TCollectionPosition; virtual; abstract; + function TrueAdd(const Item: ICollectable): Boolean; override; + function TrueContains(const Item: ICollectable): Boolean; override; + function TrueGet(Position: TCollectionPosition): IIntegerAssociation; virtual; abstract; + function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; virtual; abstract; + function TrueRemove(const Item: ICollectable): ICollectable; override; + function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; virtual; abstract; + function TrueRemoveAll(const Item: ICollectable): ICollection; override; + property AssociationComparator: IIntegerAssociationComparator read FAssociationComparator; + public + constructor Create(NaturalItemsOnly: Boolean); override; + constructor Create(const ItemArray: array of ICollectable); overload; override; + constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override; + constructor Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable); overload; virtual; + constructor Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual; + constructor Create(const Map: IIntegerMap); overload; virtual; + destructor Destroy; override; + function GetItem(const Key: Integer): ICollectable; virtual; + procedure SetItem(const Key: Integer; const Item: ICollectable); virtual; + function GetIterator: IIterator; override; + function GetKeys: ISet; virtual; + function GetMapIterator: IIntegerMapIterator; virtual; + function GetNaturalItemIID: TGUID; override; + function GetType: TCollectionType; override; + function GetValues: ICollection; virtual; + function Clone: ICollection; override; + function CloneAsIntegerMap: IIntegerMap; virtual; + function ContainsKey(const Key: Integer): Boolean; overload; virtual; + function ContainsKey(const KeyArray: array of Integer): Boolean; overload; virtual; + function Get(const Key: Integer): ICollectable; virtual; + function IsNilAllowed: Boolean; override; + function Put(const Item: ICollectable): ICollectable; overload; virtual; + function Put(const Key: Integer; const Item: ICollectable): ICollectable; overload; virtual; + function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual; + function Put(const Collection: ICollection): ICollection; overload; virtual; + function Put(const Map: IIntegerMap): ICollection; overload; virtual; + function RemoveKey(const Key: Integer): ICollectable; overload; virtual; + function RemoveKey(const KeyArray: array of Integer): ICollection; overload; virtual; + function RetainKey(const KeyArray: array of Integer): ICollection; overload; virtual; + property Items[const Key: Integer]: ICollectable read GetItem write SetItem; default; + end; + + TAbstractStringMap = class(TAbstractCollection, IStringMap) + private + FAssociationComparator: IStringAssociationComparator; + protected + function GetAssociationIterator: IStringMapIterator; virtual; abstract; + function GetKeyPosition(const Key: String): TCollectionPosition; virtual; abstract; + function TrueAdd(const Item: ICollectable): Boolean; override; + function TrueContains(const Item: ICollectable): Boolean; override; + function TrueGet(Position: TCollectionPosition): IStringAssociation; virtual; abstract; + function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; virtual; abstract; + function TrueRemove(const Item: ICollectable): ICollectable; override; + function TrueRemove2(Position: TCollectionPosition): IStringAssociation; virtual; abstract; + function TrueRemoveAll(const Item: ICollectable): ICollection; override; + property AssociationComparator: IStringAssociationComparator read FAssociationComparator; + public + constructor Create(NaturalItemsOnly: Boolean); override; + constructor Create(const ItemArray: array of ICollectable); overload; override; + constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override; + constructor Create(const KeyArray: array of String; const ItemArray: array of ICollectable); overload; virtual; + constructor Create(const KeyArray: array of String; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual; + constructor Create(const Map: IStringMap); overload; virtual; + destructor Destroy; override; + function GetItem(const Key: String): ICollectable; virtual; + procedure SetItem(const Key: String; const Item: ICollectable); virtual; + function GetIterator: IIterator; override; + function GetKeys: ISet; virtual; + function GetMapIterator: IStringMapIterator; virtual; + function GetNaturalItemIID: TGUID; override; + function GetType: TCollectionType; override; + function GetValues: ICollection; virtual; + function Clone: ICollection; override; + function CloneAsStringMap: IStringMap; virtual; + function ContainsKey(const Key: String): Boolean; overload; virtual; + function ContainsKey(const KeyArray: array of String): Boolean; overload; virtual; + function Get(const Key: String): ICollectable; virtual; + function IsNilAllowed: Boolean; override; + function Put(const Item: ICollectable): ICollectable; overload; virtual; + function Put(const Key: String; const Item: ICollectable): ICollectable; overload; virtual; + function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual; + function Put(const Collection: ICollection): ICollection; overload; virtual; + function Put(const Map: IStringMap): ICollection; overload; virtual; + function RemoveKey(const Key: String): ICollectable; overload; virtual; + function RemoveKey(const KeyArray: array of String): ICollection; overload; virtual; + function RetainKey(const KeyArray: array of String): ICollection; overload; virtual; + property Items[const Key: String]: ICollectable read GetItem write SetItem; default; + end; + + TAbstractCollectionClass = class of TAbstractCollection; + TAbstractBagClass = class of TAbstractBag; + TAbstractSetClass = class of TAbstractSet; + TAbstractListClass = class of TAbstractList; + TAbstractMapClass = class of TAbstractMap; + TAbstractIntegerMapClass = class of TAbstractIntegerMap; + TAbstractStringMapClass = class of TAbstractStringMap; + + TAbstractIterator = class(TInterfacedObject, IIterator) + private + FAllowRemoval: Boolean; + FEOF: Boolean; + FItem: ICollectable; + protected + constructor Create(AllowRemoval: Boolean = true); + function TrueFirst: ICollectable; virtual; abstract; + function TrueNext: ICollectable; virtual; abstract; + procedure TrueRemove; virtual; abstract; + public + procedure AfterConstruction; override; + function GetAllowRemoval: Boolean; virtual; + function CurrentItem: ICollectable; virtual; + function EOF: Boolean; virtual; + function First: ICollectable; virtual; + function Next: ICollectable; virtual; + function Remove: Boolean; virtual; + property AllowRemoval: Boolean read GetAllowRemoval; + end; + + TAbstractListIterator = class(TAbstractIterator) + private + FCollection: TAbstractList; + FIndex: Integer; + protected + constructor Create(Collection: TAbstractList); + function TrueFirst: ICollectable; override; + function TrueNext: ICollectable; override; + procedure TrueRemove; override; + end; + + TAbstractMapIterator = class(TAbstractIterator, IMapIterator) + public + function CurrentKey: ICollectable; virtual; abstract; + end; + + TAbstractAssociationIterator = class(TInterfacedObject, IIterator, IMapIterator) + private + FAllowRemoval: Boolean; + FEOF: Boolean; + FAssociation: IAssociation; + protected + constructor Create(AllowRemoval: Boolean = true); + function TrueFirst: IAssociation; virtual; abstract; + function TrueNext: IAssociation; virtual; abstract; + procedure TrueRemove; virtual; abstract; + public + procedure AfterConstruction; override; + function GetAllowRemoval: Boolean; virtual; + function CurrentKey: ICollectable; virtual; + function CurrentItem: ICollectable; virtual; + function EOF: Boolean; virtual; + function First: ICollectable; virtual; + function Next: ICollectable; virtual; + function Remove: Boolean; virtual; + property AllowRemoval: Boolean read GetAllowRemoval; + end; + + TAbstractIntegerAssociationIterator = class(TInterfacedObject, IIterator, IIntegerMapIterator) + private + FAllowRemoval: Boolean; + FEOF: Boolean; + FAssociation: IIntegerAssociation; + protected + constructor Create(AllowRemoval: Boolean = true); + function TrueFirst: IIntegerAssociation; virtual; abstract; + function TrueNext: IIntegerAssociation; virtual; abstract; + procedure TrueRemove; virtual; abstract; + public + procedure AfterConstruction; override; + function GetAllowRemoval: Boolean; virtual; + function CurrentKey: Integer; virtual; + function CurrentItem: ICollectable; virtual; + function EOF: Boolean; virtual; + function First: ICollectable; virtual; + function Next: ICollectable; virtual; + function Remove: Boolean; virtual; + property AllowRemoval: Boolean read GetAllowRemoval; + end; + + TAbstractStringAssociationIterator = class(TInterfacedObject, IIterator, IStringMapIterator) + private + FAllowRemoval: Boolean; + FEOF: Boolean; + FAssociation: IStringAssociation; + protected + constructor Create(AllowRemoval: Boolean = true); + function TrueFirst: IStringAssociation; virtual; abstract; + function TrueNext: IStringAssociation; virtual; abstract; + procedure TrueRemove; virtual; abstract; + public + procedure AfterConstruction; override; + function GetAllowRemoval: Boolean; virtual; + function CurrentKey: String; virtual; + function CurrentItem: ICollectable; virtual; + function EOF: Boolean; virtual; + function First: ICollectable; virtual; + function Next: ICollectable; virtual; + function Remove: Boolean; virtual; + property AllowRemoval: Boolean read GetAllowRemoval; + end; + + TAssociationIterator = class(TAbstractIterator, IMapIterator) + private + FIterator: IIterator; + protected + function TrueFirst: ICollectable; override; + function TrueNext: ICollectable; override; + procedure TrueRemove; override; + public + constructor Create(const Iterator: IIterator); + destructor Destroy; override; + function CurrentItem: ICollectable; override; + function CurrentKey: ICollectable; virtual; + end; + + TAssociationKeyIterator = class(TAbstractIterator) + private + FIterator: IMapIterator; + protected + function TrueFirst: ICollectable; override; + function TrueNext: ICollectable; override; + procedure TrueRemove; override; + public + constructor Create(const Iterator: IMapIterator); + destructor Destroy; override; + end; + + TAbstractFilter = class(TInterfacedObject, IFilter) + public + function Accept(const Item: ICollectable): Boolean; virtual; abstract; + end; + + TFilterIterator = class(TAbstractIterator) + private + FIterator: IIterator; + FFilter: IFilter; + protected + function TrueFirst: ICollectable; override; + function TrueNext: ICollectable; override; + procedure TrueRemove; override; + public + constructor Create(const Iterator: IIterator; const Filter: IFilter; AllowRemoval: Boolean = true); virtual; + destructor Destroy; override; + end; + + TFilterFuncIterator = class(TAbstractIterator) + private + FIterator: IIterator; + FFilterFunc: TCollectionFilterFunc; + protected + function TrueFirst: ICollectable; override; + function TrueNext: ICollectable; override; + procedure TrueRemove; override; + public + constructor Create(const Iterator: IIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); virtual; + destructor Destroy; override; + end; + + TKeyFilterMapIterator = class(TAbstractMapIterator) + private + FIterator: IMapIterator; + FFilter: IFilter; + protected + function TrueFirst: ICollectable; override; + function TrueNext: ICollectable; override; + procedure TrueRemove; override; + public + constructor Create(const Iterator: IMapIterator; const Filter: IFilter; AllowRemoval: Boolean = true); virtual; + destructor Destroy; override; + function CurrentKey: ICollectable; override; + end; + + TKeyFilterFuncMapIterator = class(TAbstractMapIterator) + private + FIterator: IMapIterator; + FFilterFunc: TCollectionFilterFunc; + protected + function TrueFirst: ICollectable; override; + function TrueNext: ICollectable; override; + procedure TrueRemove; override; + public + constructor Create(const Iterator: IMapIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); virtual; + destructor Destroy; override; + function CurrentKey: ICollectable; override; + end; + + + ECollectionError = class(Exception) + private + FCollection: ICollection; + FErrorType: TCollectionError; + public + constructor Create(const Msg: String; const Collection: ICollection; ErrorType: TCollectionError); + property Collection: ICollection read FCollection; + property ErrorType: TCollectionError read FErrorType; + end; + +implementation + +uses + Math, + CollArray, CollHash, CollList, CollPArray, CollWrappers; + +var + FDefaultComparator: IComparator; + FNaturalComparator: IComparator; + FReverseNaturalComparator: IComparator; + +{ TCollectionPosition } +constructor TCollectionPosition.Create(Found: Boolean); +begin + FFound := Found; +end; + +{ TAbstractComparator } +class function TAbstractComparator.GetDefaultComparator: IComparator; +begin + if FDefaultComparator = nil then + FDefaultComparator := TDefaultComparator.Create; + Result := FDefaultComparator; +end; + +class function TAbstractComparator.GetNaturalComparator: IComparator; +begin + if FNaturalComparator = nil then + FNaturalComparator := TNaturalComparator.Create; + Result := FNaturalComparator; +end; + +class function TAbstractComparator.GetReverseNaturalComparator: IComparator; +begin + if FReverseNaturalComparator = nil then + FReverseNaturalComparator := TReverseNaturalComparator.Create; + Result := FReverseNaturalComparator; +end; + +function TAbstractComparator.GetInstance: TObject; +begin + Result := Self; +end; + +function TAbstractComparator.Equals(const Comparator: IComparator): Boolean; +begin + Result := (Self = Comparator.GetInstance); +end; + +{ TDefaultComparator } +constructor TDefaultComparator.Create; +begin + // Empty +end; + +function TDefaultComparator.Compare(const Item1, Item2: ICollectable): Integer; +var + Value1, Value2: Integer; +begin + if Item1 <> nil then + Value1 := Integer(Pointer(Item1)) + else + Value1 := Low(Integer); + if Item2 <> nil then + Value2 := Integer(Pointer(Item2)) + else + Value2 := Low(Integer); + if (Value1 < Value2) then + Result := -1 + else if (Value1 > Value2) then + Result := 1 + else + Result := 0; +end; + +function TDefaultComparator.Equals(const Item1, Item2: ICollectable): Boolean; +begin + Result := (Item1 = Item2); +end; + +{ TNaturalComparator } +constructor TNaturalComparator.Create; +begin + // Empty +end; + +function TNaturalComparator.Compare(const Item1, Item2: ICollectable): Integer; +begin + if (Item1 = nil) and (Item2 <> nil) then + Result := -1 + else if (Item1 <> nil) and (Item2 = nil) then + Result := 1 + else if (Item1 = nil) and (Item2 = nil) then + Result := 0 + else + Result := (Item1 as IComparable).CompareTo(Item2); +end; + +function TNaturalComparator.Equals(const Item1, Item2: ICollectable): Boolean; +begin + if (Item1 = nil) or (Item2 = nil) then + Result := (Item1 = Item2) + else + begin + Result := (Item1 as IEquatable).Equals(Item2); + end; +end; + +{ TReverseNaturalComparator } +constructor TReverseNaturalComparator.Create; +begin + // Empty +end; + +function TReverseNaturalComparator.Compare(const Item1, Item2: ICollectable): Integer; +begin + if (Item1 = nil) and (Item2 <> nil) then + Result := 1 + else if (Item1 <> nil) and (Item2 = nil) then + Result := -1 + else if (Item1 = nil) and (Item2 = nil) then + Result := 0 + else + Result := -(Item1 as IComparable).CompareTo(Item2); +end; + +function TReverseNaturalComparator.Equals(const Item1, Item2: ICollectable): Boolean; +begin + if (Item1 = nil) or (Item2 = nil) then + Result := (Item1 = Item2) + else + Result := (Item1 as IEquatable).Equals(Item2); +end; + +{ TAssociation } +constructor TAssociation.Create(const Key, Value: ICollectable); +begin + FKey := Key; + FValue := Value; +end; + +destructor TAssociation.Destroy; +begin + FKey := nil; + FValue := nil; + inherited Destroy; +end; + +function TAssociation.GetInstance: TObject; +begin + Result := Self; +end; + +function TAssociation.GetKey: ICollectable; +begin + Result := FKey; +end; + +function TAssociation.GetValue: ICollectable; +begin + Result := FValue; +end; + + +{ TIntegerAssociation } +constructor TIntegerAssociation.Create(const Key: Integer; const Value: ICollectable); +begin + FKey := Key; + FValue := Value; +end; + +destructor TIntegerAssociation.Destroy; +begin + FValue := nil; + inherited Destroy; +end; + +function TIntegerAssociation.GetInstance: TObject; +begin + Result := Self; +end; + +function TIntegerAssociation.GetKey: Integer; +begin + Result := FKey; +end; + +function TIntegerAssociation.GetValue: ICollectable; +begin + Result := FValue; +end; + + +{ TStringAssociation } +constructor TStringAssociation.Create(const Key: String; const Value: ICollectable); +begin + FKey := Key; + FValue := Value; +end; + +destructor TStringAssociation.Destroy; +begin + FValue := nil; + inherited Destroy; +end; + +function TStringAssociation.GetInstance: TObject; +begin + Result := Self; +end; + +function TStringAssociation.GetKey: String; +begin + Result := FKey; +end; + +function TStringAssociation.GetValue: ICollectable; +begin + Result := FValue; +end; + + +{ TAbstractIterator } +constructor TAbstractIterator.Create(AllowRemoval: Boolean); +begin + inherited Create; + FAllowRemoval := AllowRemoval; + FEOF := true; + FItem := nil; +end; + +procedure TAbstractIterator.AfterConstruction; +begin + inherited AfterConstruction; + First; +end; + +function TAbstractIterator.GetAllowRemoval: Boolean; +begin + Result := FAllowRemoval; +end; + +function TAbstractIterator.CurrentItem: ICollectable; +begin + Result := FItem; +end; + +function TAbstractIterator.EOF: Boolean; +begin + Result := FEOF; +end; + +function TAbstractIterator.First: ICollectable; +begin + FEOF := false; + FItem := TrueFirst; + if FItem = nil then + FEOF := true; + Result := FItem; +end; + +function TAbstractIterator.Next: ICollectable; +begin + if not FEOF then + begin + FItem := TrueNext; + if FItem = nil then + FEOF := true; + end; + Result := FItem; +end; + +function TAbstractIterator.Remove: Boolean; +begin + if (FItem <> nil) and FAllowRemoval then + begin + TrueRemove; + FItem := nil; + Result := true; + end + else + Result := false; +end; + +{ TAbstractAssociationIterator } +constructor TAbstractAssociationIterator.Create(AllowRemoval: Boolean); +begin + inherited Create; + FAllowRemoval := AllowRemoval; + FEOF := true; + FAssociation := nil; +end; + +procedure TAbstractAssociationIterator.AfterConstruction; +begin + inherited AfterConstruction; + First; +end; + +function TAbstractAssociationIterator.GetAllowRemoval: Boolean; +begin + Result := FAllowRemoval; +end; + +function TAbstractAssociationIterator.CurrentKey: ICollectable; +begin + if FAssociation <> nil then + Result := FAssociation.GetKey + else + Result := nil; +end; + +function TAbstractAssociationIterator.CurrentItem: ICollectable; +begin + if FAssociation <> nil then + Result := FAssociation.GetValue + else + Result := nil; +end; + +function TAbstractAssociationIterator.EOF: Boolean; +begin + Result := FEOF; +end; + +function TAbstractAssociationIterator.First: ICollectable; +begin + FAssociation := TrueFirst; + if FAssociation <> nil then + begin + Result := FAssociation.GetValue; + FEOF := false; + end + else + begin + Result := nil; + FEOF := true; + end; +end; + +function TAbstractAssociationIterator.Next: ICollectable; +begin + if not FEOF then + begin + FAssociation := TrueNext; + if FAssociation <> nil then + Result := FAssociation.GetValue + else + begin + Result := nil; + FEOF := true; + end; + end; +end; + +function TAbstractAssociationIterator.Remove: Boolean; +begin + if (FAssociation <> nil) and FAllowRemoval then + begin + TrueRemove; + FAssociation := nil; + Result := true; + end + else + Result := false; +end; + +{ TAbstractIntegerAssociationIterator } +constructor TAbstractIntegerAssociationIterator.Create(AllowRemoval: Boolean); +begin + inherited Create; + FAllowRemoval := AllowRemoval; + FEOF := true; + FAssociation := nil; +end; + +procedure TAbstractIntegerAssociationIterator.AfterConstruction; +begin + inherited AfterConstruction; + First; +end; + +function TAbstractIntegerAssociationIterator.GetAllowRemoval: Boolean; +begin + Result := FAllowRemoval; +end; + +function TAbstractIntegerAssociationIterator.CurrentKey: Integer; +begin + if FAssociation <> nil then + Result := FAssociation.GetKey + else + Result := 0; +end; + +function TAbstractIntegerAssociationIterator.CurrentItem: ICollectable; +begin + if FAssociation <> nil then + Result := FAssociation.GetValue + else + Result := nil; +end; + +function TAbstractIntegerAssociationIterator.EOF: Boolean; +begin + Result := FEOF; +end; + +function TAbstractIntegerAssociationIterator.First: ICollectable; +begin + FAssociation := TrueFirst; + if FAssociation <> nil then + begin + Result := FAssociation.GetValue; + FEOF := false; + end + else + begin + Result := nil; + FEOF := true; + end; +end; + +function TAbstractIntegerAssociationIterator.Next: ICollectable; +begin + if not FEOF then + begin + FAssociation := TrueNext; + if FAssociation <> nil then + Result := FAssociation.GetValue + else + begin + Result := nil; + FEOF := true; + end; + end; +end; + +function TAbstractIntegerAssociationIterator.Remove: Boolean; +begin + if (FAssociation <> nil) and FAllowRemoval then + begin + TrueRemove; + FAssociation := nil; + Result := true; + end + else + Result := false; +end; + +{ TAbstractStringAssociationIterator } +constructor TAbstractStringAssociationIterator.Create(AllowRemoval: Boolean); +begin + inherited Create; + FAllowRemoval := AllowRemoval; + FEOF := true; + FAssociation := nil; +end; + +procedure TAbstractStringAssociationIterator.AfterConstruction; +begin + inherited AfterConstruction; + First; +end; + +function TAbstractStringAssociationIterator.GetAllowRemoval: Boolean; +begin + Result := FAllowRemoval; +end; + +function TAbstractStringAssociationIterator.CurrentKey: String; +begin + if FAssociation <> nil then + Result := FAssociation.GetKey + else + Result := ''; +end; + +function TAbstractStringAssociationIterator.CurrentItem: ICollectable; +begin + if FAssociation <> nil then + Result := FAssociation.GetValue + else + Result := nil; +end; + +function TAbstractStringAssociationIterator.EOF: Boolean; +begin + Result := FEOF; +end; + +function TAbstractStringAssociationIterator.First: ICollectable; +begin + FAssociation := TrueFirst; + if FAssociation <> nil then + begin + Result := FAssociation.GetValue; + FEOF := false; + end + else + begin + Result := nil; + FEOF := true; + end; +end; + +function TAbstractStringAssociationIterator.Next: ICollectable; +begin + if not FEOF then + begin + FAssociation := TrueNext; + if FAssociation <> nil then + Result := FAssociation.GetValue + else + begin + Result := nil; + FEOF := true; + end; + end; +end; + +function TAbstractStringAssociationIterator.Remove: Boolean; +begin + if (FAssociation <> nil) and FAllowRemoval then + begin + TrueRemove; + FAssociation := nil; + Result := true; + end + else + Result := false; +end; + +{ TAssociationIterator } +constructor TAssociationIterator.Create(const Iterator: IIterator); +begin + inherited Create(Iterator.GetAllowRemoval); + FIterator := Iterator; +end; + +destructor TAssociationIterator.Destroy; +begin + FIterator := nil; + inherited Destroy; +end; + +function TAssociationIterator.TrueFirst: ICollectable; +var + Association: IAssociation; +begin + Association := FIterator.First as IAssociation; + if Association <> nil then + Result := Association.GetValue + else + Result := nil; +end; + +function TAssociationIterator.TrueNext: ICollectable; +var + Association: IAssociation; +begin + Association := (FIterator.Next as IAssociation); + if Association <> nil then + Result := Association.GetValue + else + Result := nil; +end; + +procedure TAssociationIterator.TrueRemove; +begin + FIterator.Remove; +end; + +function TAssociationIterator.CurrentItem: ICollectable; +var + Association: IAssociation; +begin + Association := FIterator.CurrentItem as IAssociation; + if Association <> nil then + Result := Association.GetValue + else + Result := nil; +end; + +function TAssociationIterator.CurrentKey: ICollectable; +var + Association: IAssociation; +begin + Association := FIterator.CurrentItem as IAssociation; + if Association <> nil then + Result := Association.GetKey + else + Result := nil; +end; + +{ TAssociationComparator } +constructor TAssociationComparator.Create(NaturalKeys: Boolean); +begin + inherited Create; + if NaturalKeys then + FKeyComparator := TAbstractComparator.GetNaturalComparator + else + FKeyComparator := TAbstractComparator.GetDefaultComparator; +end; + +destructor TAssociationComparator.Destroy; +begin + FKeyComparator := nil; + inherited Destroy; +end; + +function TAssociationComparator.GetKeyComparator: IComparator; +begin + Result := FKeyComparator; +end; + +procedure TAssociationComparator.SetKeyComparator(Value: IComparator); +begin + FKeyComparator := Value; +end; + +function TAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer; +begin + Result := KeyComparator.Compare((Item1 as IAssociation).GetKey, (Item2 as IAssociation).GetKey); +end; + +function TAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean; +begin + Result := KeyComparator.Equals((Item1 as IAssociation).GetKey, (Item2 as IAssociation).GetKey); +end; + +{ TIntegerAssociationComparator } +constructor TIntegerAssociationComparator.Create; +begin + inherited Create; +end; + +destructor TIntegerAssociationComparator.Destroy; +begin + inherited Destroy; +end; + +function TIntegerAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer; +var + Key1, Key2: Integer; +begin + Key1 := (Item1 as IIntegerAssociation).GetKey; + Key2 := (Item2 as IIntegerAssociation).GetKey; + if Key1 < Key2 then + Result := -1 + else if Key1 > Key2 then + Result := 1 + else + Result := 0; +end; + +function TIntegerAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean; +begin + Result := ((Item1 as IIntegerAssociation).GetKey = (Item2 as IIntegerAssociation).GetKey); +end; + +{ TStringAssociationComparator } +constructor TStringAssociationComparator.Create; +begin + inherited Create; +end; + +destructor TStringAssociationComparator.Destroy; +begin + inherited Destroy; +end; + +function TStringAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer; +var + Key1, Key2: String; +begin + Key1 := (Item1 as IStringAssociation).GetKey; + Key2 := (Item2 as IStringAssociation).GetKey; + if Key1 < Key2 then + Result := -1 + else if Key1 > Key2 then + Result := 1 + else + Result := 0; +end; + +function TStringAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean; +begin + Result := ((Item1 as IStringAssociation).GetKey = (Item2 as IStringAssociation).GetKey); +end; + +{ TAssociationKeyIterator } +constructor TAssociationKeyIterator.Create(const Iterator: IMapIterator); +begin + inherited Create(Iterator.GetAllowRemoval); + FIterator := Iterator; +end; + +destructor TAssociationKeyIterator.Destroy; +begin + FIterator := nil; + inherited Destroy; +end; + +function TAssociationKeyIterator.TrueFirst: ICollectable; +begin + FIterator.First; + Result := FIterator.CurrentKey; +end; + +function TAssociationKeyIterator.TrueNext: ICollectable; +begin + FIterator.Next; + Result := FIterator.CurrentKey; +end; + +procedure TAssociationKeyIterator.TrueRemove; +begin + FIterator.Remove; +end; + +{ TFilterIterator } +constructor TFilterIterator.Create(const Iterator: IIterator; const Filter: IFilter; AllowRemoval: Boolean = true); +begin + FIterator := Iterator; + FFilter := Filter; +end; + +destructor TFilterIterator.Destroy; +begin + FIterator := nil; + FFilter := nil; +end; + +function TFilterIterator.TrueFirst: ICollectable; +var + Item: ICollectable; +begin + Item := FIterator.First; + while not FIterator.EOF do + begin + if FFilter.Accept(Item) then + break + else + Item := FIterator.Next; + end; + Result := Item; +end; + +function TFilterIterator.TrueNext: ICollectable; +var + Item: ICollectable; +begin + Item := FIterator.Next; + while not FIterator.EOF do + begin + if FFilter.Accept(Item) then + break + else + Item := FIterator.Next; + end; + Result := Item; +end; + +procedure TFilterIterator.TrueRemove; +begin + FIterator.Remove; +end; + +{ TFilterFuncIterator } +constructor TFilterFuncIterator.Create(const Iterator: IIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); +begin + FIterator := Iterator; + FFilterFunc := FilterFunc; +end; + +destructor TFilterFuncIterator.Destroy; +begin + FIterator := nil; + FFilterFunc := nil; +end; + +function TFilterFuncIterator.TrueFirst: ICollectable; +var + Item: ICollectable; +begin + Item := FIterator.First; + while not FIterator.EOF do + begin + if FFilterFunc(Item) then + break + else + Item := FIterator.Next; + end; + Result := Item; +end; + +function TFilterFuncIterator.TrueNext: ICollectable; +var + Item: ICollectable; +begin + Item := FIterator.Next; + while not FIterator.EOF do + begin + if FFilterFunc(Item) then + break + else + Item := FIterator.Next; + end; + Result := Item; +end; + +procedure TFilterFuncIterator.TrueRemove; +begin + FIterator.Remove; +end; + +{ TKeyFilterMapIterator } +constructor TKeyFilterMapIterator.Create(const Iterator: IMapIterator; const Filter: IFilter; AllowRemoval: Boolean = true); +begin + FIterator := Iterator; + FFilter := Filter; +end; + +destructor TKeyFilterMapIterator.Destroy; +begin + FIterator := nil; + FFilter := nil; +end; + +function TKeyFilterMapIterator.TrueFirst: ICollectable; +var + Key, Item: ICollectable; +begin + Item := FIterator.First; + while not FIterator.EOF do + begin + Key := FIterator.CurrentKey; + if FFilter.Accept(Key) then + break + else + Item := FIterator.Next; + end; + Result := Item; +end; + +function TKeyFilterMapIterator.TrueNext: ICollectable; +var + Key, Item: ICollectable; +begin + Item := FIterator.Next; + while not FIterator.EOF do + begin + Key := FIterator.CurrentKey; + if FFilter.Accept(Key) then + break + else + Item := FIterator.Next; + end; + Result := Item; +end; + +procedure TKeyFilterMapIterator.TrueRemove; +begin + FIterator.Remove; +end; + +function TKeyFilterMapIterator.CurrentKey: ICollectable; +begin + Result := FIterator.CurrentKey; +end; + +{ TKeyFilterFuncMapIterator } +constructor TKeyFilterFuncMapIterator.Create(const Iterator: IMapIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); +begin + FIterator := Iterator; + FFilterFunc := FilterFunc; +end; + +destructor TKeyFilterFuncMapIterator.Destroy; +begin + FIterator := nil; + FFilterFunc := nil; +end; + +function TKeyFilterFuncMapIterator.TrueFirst: ICollectable; +var + Key, Item: ICollectable; +begin + Item := FIterator.First; + while not FIterator.EOF do + begin + Key := FIterator.CurrentKey; + if FFilterFunc(Key) then + break + else + Item := FIterator.Next; + end; + Result := Item; +end; + +function TKeyFilterFuncMapIterator.TrueNext: ICollectable; +var + Key, Item: ICollectable; +begin + Item := FIterator.Next; + while not FIterator.EOF do + begin + Key := FIterator.CurrentKey; + if FFilterFunc(Key) then + break + else + Item := FIterator.Next; + end; + Result := Item; +end; + +procedure TKeyFilterFuncMapIterator.TrueRemove; +begin + FIterator.Remove; +end; + +function TKeyFilterFuncMapIterator.CurrentKey: ICollectable; +begin + Result := FIterator.CurrentKey; +end; + + +{ TAbstractCollection } +constructor TAbstractCollection.Create; +begin + Create(false); +end; + +constructor TAbstractCollection.Create(NaturalItemsOnly: Boolean); +begin + FCreated := false; + inherited Create; + FNaturalItemsOnly := NaturalItemsOnly or GetAlwaysNaturalItems; + if FNaturalItemsOnly then + FComparator := TAbstractComparator.GetNaturalComparator + else + FComparator := TAbstractComparator.GetDefaultComparator; + FIgnoreErrors := [ceDuplicate]; +end; + +constructor TAbstractCollection.Create(const ItemArray: array of ICollectable); +begin + Create(ItemArray, false); +end; + +// Fixed size collections must override this. +constructor TAbstractCollection.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); +var + I: Integer; +begin + Create(NaturalItemsOnly); + if not FixedSize then + begin + Capacity := Length(ItemArray); + for I := Low(ItemArray) to High(ItemArray) do + begin + Add(ItemArray[I]); + end; + end; +end; + +// Fixed size collections must override this. +constructor TAbstractCollection.Create(const Collection: ICollection); +var + Iterator: IIterator; +begin + Create(Collection.GetNaturalItemsOnly); + InitFrom(Collection); + if not FixedSize then + begin + Capacity := Collection.GetSize; + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + Add(Iterator.CurrentItem); + Iterator.Next; + end; + end; +end; + +destructor TAbstractCollection.Destroy; +begin + FCreated := false; + FComparator := nil; + inherited Destroy; +end; + +procedure TAbstractCollection.CollectionError(ErrorType: TCollectionError); +var + Msg: String; +begin + if not (ErrorType in FIgnoreErrors) then + begin + case ErrorType of + ceDuplicate: Msg := 'Collection does not allow duplicates.'; + ceDuplicateKey: Msg := 'Collection does not allow duplicate keys.'; + ceFixedSize: Msg := 'Collection has fixed size.'; + ceNilNotAllowed: Msg := 'Collection does not allow nil.'; + ceNotNaturalItem: Msg := 'Collection only accepts natural items.'; + ceOutOfRange: Msg := 'Index out of collection range.'; + end; + // If exception is thrown during construction, collection cannot be + // passed to it as destructor is automatically called and this leaves an + // interface reference to a destroyed object and crashes. + if FCreated then + raise ECollectionError.Create(Msg, Self, ErrorType) + else + raise ECollectionError.Create(Msg, nil, ErrorType); + end; +end; + +procedure TAbstractCollection.InitFrom(const Collection: ICollection); +begin + Comparator := Collection.GetComparator; + IgnoreErrors := Collection.GetIgnoreErrors; +end; + +// Implementations should override this if possible +function TAbstractCollection.TrueItemCount(const Item: ICollectable): Integer; +var + Iterator: IIterator; + Total: Integer; +begin + Total := 0; + Iterator := GetIterator; + while not Iterator.EOF do + begin + if FComparator.Equals(Item, Iterator.CurrentItem) then + Inc(Total); + Iterator.Next; + end; + Result := Total; +end; + +class function TAbstractCollection.GetAlwaysNaturalItems: Boolean; +begin + Result := false; +end; + +function TAbstractCollection.GetAsArray: TCollectableArray; +var + Iterator: IIterator; + Working: TCollectableArray; + I: Integer; +begin + SetLength(Working, Size); + I := 0; + Iterator := GetIterator; + while not Iterator.EOF do + begin + Working[I] := Iterator.CurrentItem; + Inc(I); + Iterator.Next; + end; + Result := Working; +end; + +function TAbstractCollection.GetComparator: IComparator; +begin + Result := FComparator; +end; + +function TAbstractCollection.GetDuplicates: Boolean; +begin + Result := true; // Sets and lists override this. +end; + +procedure TAbstractCollection.SetComparator(const Value: IComparator); +begin + if Value = nil then + begin + if NaturalItemsOnly then + FComparator := TAbstractComparator.GetNaturalComparator + else + FComparator := TAbstractComparator.GetDefaultComparator; + end + else + FComparator := Value; +end; + +function TAbstractCollection.GetFixedSize: Boolean; +begin + Result := false; +end; + +function TAbstractCollection.GetIgnoreErrors: TCollectionErrors; +begin + Result := FIgnoreErrors; +end; + +procedure TAbstractCollection.SetIgnoreErrors(Value: TCollectionErrors); +begin + FIgnoreErrors := Value; +end; + +function TAbstractCollection.GetInstance: TObject; +begin + Result := Self; +end; + +function TAbstractCollection.GetIterator(const Filter: IFilter): IIterator; +var + Iterator: IIterator; +begin + Iterator := GetIterator; + Result := TFilterIterator.Create(Iterator, Filter, Iterator.GetAllowRemoval); +end; + +function TAbstractCollection.GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; +var + Iterator: IIterator; +begin + Iterator := GetIterator; + Result := TFilterFuncIterator.Create(Iterator, FilterFunc, Iterator.GetAllowRemoval); +end; + +function TAbstractCollection.GetNaturalItemsOnly: Boolean; +begin + Result := FNaturalItemsOnly; +end; + +function TAbstractCollection.Add(const Item: ICollectable): Boolean; +var + ItemError: TCollectionError; + Success: Boolean; +begin + ItemError := ItemAllowed(Item); // Can be natural items only error or nil not allowed error + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Success := false; + end + else if FixedSize then + begin + CollectionError(ceFixedSize); + Success := false; + end + else + begin + Success := TrueAdd(Item); + end; + Result := Success; +end; + +function TAbstractCollection.Add(const ItemArray: array of ICollectable): Integer; +var + Item: ICollectable; + ItemError: TCollectionError; + I, Count: Integer; + Success: Boolean; +begin + Count := 0; + if FixedSize then + begin + CollectionError(ceFixedSize); + end + else + begin + for I := Low(ItemArray) to High(ItemArray) do + begin + Item := ItemArray[I]; + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Success := false; + end + else + begin + Success := TrueAdd(Item); + end; + if Success then + Inc(Count); + end; + end; + Result := Count; +end; + +function TAbstractCollection.Add(const Collection: ICollection): Integer; +var + Iterator: IIterator; + Item: ICollectable; + ItemError: TCollectionError; + Count: Integer; + Success: Boolean; +begin + Count := 0; + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + Item := Iterator.CurrentItem; + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Success := false; + end + else if FixedSize then + begin + CollectionError(ceFixedSize); + Success := false; + end + else + begin + Success := TrueAdd(Item); + end; + if Success then + Inc(Count); + Iterator.Next; + end; + Result := Count; +end; + +procedure TAbstractCollection.AfterConstruction; +begin + inherited AfterConstruction; + FCreated := true; +end; + +procedure TAbstractCollection.BeforeDestruction; +begin + if not FixedSize then + TrueClear; + inherited BeforeDestruction; +end; + +function TAbstractCollection.Clear: Integer; +begin + if not FixedSize then + begin + Result := Size; + TrueClear; + end + else + begin + CollectionError(ceFixedSize); + Result := 0; + end; +end; + +function TAbstractCollection.Clone: ICollection; +begin + Result := (TAbstractCollectionClass(ClassType)).Create(Self); +end; + +function TAbstractCollection.Contains(const Item: ICollectable): Boolean; +var + ItemError: TCollectionError; + Success: Boolean; +begin + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Success := false; + end + else + begin + Success := TrueContains(Item); + end; + Result := Success; +end; + +function TAbstractCollection.Contains(const ItemArray: array of ICollectable): Boolean; +var + I: Integer; + Success: Boolean; +begin + Success := true; + for I := Low(ItemArray) to High(ItemArray) do + begin + Success := Success and Contains(ItemArray[I]); + if not Success then + break; + end; + Result := Success; +end; + +function TAbstractCollection.Contains(const Collection: ICollection): Boolean; +var + Iterator: IIterator; + Success: Boolean; +begin + Success := true; + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + Success := Success and Contains(Iterator.CurrentItem); + if not Success then + break; + Iterator.Next; + end; + Result := Success; +end; + +function TAbstractCollection.Equals(const Collection: ICollection): Boolean; +var + Iterator: IIterator; + Success: Boolean; +begin + if Collection.GetType <> GetType then + Result := false + else if Collection.Size <> Size then + Result := false + else if not Collection.Comparator.Equals(Comparator) then + Result := false + else if not Collection.GetDuplicates and not GetDuplicates then + begin + // Not equal if any item not found in parameter collection + Success := true; + Iterator := GetIterator; + while not Iterator.EOF and Success do + begin + Success := Collection.Contains(Iterator.CurrentItem); + Iterator.Next; + end; + Result := Success; + end + else + begin + // Not equal if any item count not equal to item count in parameter collection + Success := true; + Iterator := GetIterator; + while not Iterator.EOF and Success do + begin + Success := (ItemCount(Iterator.CurrentItem) = Collection.ItemCount(Iterator.CurrentItem)); + Iterator.Next; + end; + Result := Success; + end; +end; + +function TAbstractCollection.Find(const Filter: IFilter): ICollectable; +begin + Result := GetIterator(Filter).First; +end; + +function TAbstractCollection.Find(FilterFunc: TCollectionFilterFunc): ICollectable; +begin + Result := GetIterator(FilterFunc).First; +end; + +function TAbstractCollection.FindAll(const Filter: IFilter): ICollection; +var + ResultCollection: ICollection; + Iterator: IIterator; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := Self.GetIterator(Filter); + while not Iterator.EOF do + begin + ResultCollection.Add(Iterator.CurrentItem); + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractCollection.FindAll(FilterFunc: TCollectionFilterFunc): ICollection; +var + ResultCollection: ICollection; + Iterator: IIterator; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := Self.GetIterator(FilterFunc); + while not Iterator.EOF do + begin + ResultCollection.Add(Iterator.CurrentItem); + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractCollection.IsEmpty: Boolean; +begin + Result := (Size = 0); +end; + +function TAbstractCollection.IsNaturalItem(const Item: ICollectable): Boolean; +var + Temp: IUnknown; +begin + if Item <> nil then + Result := (Item.QueryInterface(NaturalItemIID, Temp) <> E_NOINTERFACE) + else + Result := false; +end; + +function TAbstractCollection.ItemAllowed(const Item: ICollectable): TCollectionError; +begin + if NaturalItemsOnly and not IsNaturalItem(Item) then + Result := ceNotNaturalItem + else if not IsNilAllowed and (Item = nil) then + Result := ceNilNotAllowed + else + Result := ceOK; +end; + +function TAbstractCollection.ItemCount(const Item: ICollectable): Integer; +var + ItemError: TCollectionError; +begin + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Result := 0; + end + else if GetDuplicates then + begin + Result := TrueItemCount(Item); + end + else + begin + // Where duplicates are not allowed, TrueContains will be faster than TrueItemCount. + if TrueContains(Item) then + Result := 1 + else + Result := 0; + end; +end; + +function TAbstractCollection.ItemCount(const ItemArray: array of ICollectable): Integer; +var + I: Integer; + Total: Integer; +begin + Total := 0; + for I := Low(ItemArray) to High(ItemArray) do + begin + Total := Total + ItemCount(ItemArray[I]); + end; + Result := Total; +end; + +function TAbstractCollection.ItemCount(const Collection: ICollection): Integer; +var + Iterator: IIterator; + Total: Integer; +begin + Total := 0; + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + Total := Total + ItemCount(Iterator.CurrentItem); + Iterator.Next; + end; + Result := Total; +end; + +function TAbstractCollection.Matching(const ItemArray: array of ICollectable): ICollection; +var + ResultCollection: ICollection; + I: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + for I := Low(ItemArray) to High(ItemArray) do + begin + if Contains(ItemArray[I]) then + ResultCollection.Add(ItemArray[I]); + end; + Result := ResultCollection; +end; + +function TAbstractCollection.Matching(const Collection: ICollection): ICollection; +var + ResultCollection: ICollection; + Iterator: IIterator; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + if Contains(Iterator.CurrentItem) then + ResultCollection.Add(Iterator.CurrentItem); + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractCollection.Remove(const Item: ICollectable): ICollectable; +var + ItemError: TCollectionError; +begin + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Result := nil; + end + else if FixedSize then + begin + CollectionError(ceFixedSize); + Result := nil; + end + else + begin + Result := TrueRemove(Item); + end; +end; + +function TAbstractCollection.Remove(const ItemArray: array of ICollectable): ICollection; +var + ResultCollection: ICollection; + I: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + for I := Low(ItemArray) to High(ItemArray) do + begin + ResultCollection.Add(Remove(ItemArray[I])); + end; + Result := ResultCollection; +end; + +function TAbstractCollection.Remove(const Collection: ICollection): ICollection; +var + ResultCollection: ICollection; + Iterator: IIterator; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + ResultCollection.Add(Remove(Iterator.CurrentItem)); + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractCollection.RemoveAll(const Item: ICollectable): ICollection; +var + ItemError: TCollectionError; +begin + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Result := nil; + end + else if FixedSize then + begin + CollectionError(ceFixedSize); + Result := nil; + end + else + begin + Result := TrueRemoveAll(Item); + end; +end; + +function TAbstractCollection.RemoveAll(const ItemArray: array of ICollectable): ICollection; +var + ResultCollection: ICollection; + I: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + for I := Low(ItemArray) to High(ItemArray) do + begin + ResultCollection.Add(RemoveAll(ItemArray[I])); + end; + Result := ResultCollection; +end; + +function TAbstractCollection.RemoveAll(const Collection: ICollection): ICollection; +var + ResultCollection: ICollection; + Iterator: IIterator; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + ResultCollection.Add(RemoveAll(Iterator.CurrentItem)); + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractCollection.Retain(const ItemArray: array of ICollectable): ICollection; +var + ResultCollection: ICollection; + Iterator: IIterator; + Item: ICollectable; + I: Integer; + Found, Success: Boolean; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := GetIterator; + while not Iterator.EOF do + begin + // Converting the array to a map would be faster but I don't want to + // couple base class code to a complex collection. + Found := false; + for I := Low(ItemArray) to High(ItemArray) do + begin + Item := Iterator.CurrentItem; + Found := Comparator.Equals(Item, ItemArray[I]); + if Found then + break; + end; + if not Found then + begin + Success := Iterator.Remove; + if Success then + ResultCollection.Add(Item); + end; + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractCollection.Retain(const Collection: ICollection): ICollection; +var + ResultCollection: ICollection; + Iterator: IIterator; + Item: ICollectable; + Success: Boolean; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := GetIterator; + while not Iterator.EOF do + begin + Item := Iterator.CurrentItem; + if not Collection.Contains(Item) then + begin + Success := Iterator.Remove; + if Success then + ResultCollection.Add(Item); + end; + Iterator.Next; + end; + Result := ResultCollection; +end; + +{ TAbstractBag } +function TAbstractBag.CloneAsBag: IBag; +begin + Result := (TAbstractBagClass(ClassType)).Create(Self); +end; + +function TAbstractBag.GetNaturalItemIID: TGUID; +begin + Result := EquatableIID; +end; + +function TAbstractBag.GetType: TCollectionType; +begin + Result := ctBag; +end; + +function TAbstractBag.IsNilAllowed: Boolean; +begin + Result := true; +end; + +{ TAbstractSet } +function TAbstractSet.TrueAdd(const Item: ICollectable): Boolean; +var + Position: TCollectionPosition; +begin + // Adds if not already present otherwise fails + Position := GetPosition(Item); + try + if Position.Found then + begin + CollectionError(ceDuplicate); + Result := false; + end + else + begin + TrueAdd2(Position, Item); + Result := true; + end; + finally + Position.Free; + end; +end; + +function TAbstractSet.TrueContains(const Item: ICollectable): Boolean; +var + Position: TCollectionPosition; +begin + Position := GetPosition(Item); + try + Result := Position.Found; + finally + Position.Free; + end; +end; + +function TAbstractSet.TrueRemove(const Item: ICollectable): ICollectable; +var + Position: TCollectionPosition; +begin + Position := GetPosition(Item); + try + if Position.Found then + begin + Result := TrueGet(Position); + TrueRemove2(Position); + end + else + Result := nil; + finally + Position.Free; + end; +end; + +function TAbstractSet.TrueRemoveAll(const Item: ICollectable): ICollection; +var + ResultCollection: ICollection; + RemovedItem: ICollectable; +begin + ResultCollection := TPArrayBag.Create; + RemovedItem := TrueRemove(Item); + if RemovedItem <> nil then + ResultCollection.Add(RemovedItem); + Result := ResultCollection; +end; + +function TAbstractSet.GetDuplicates: Boolean; +begin + Result := false; +end; + +function TAbstractSet.GetNaturalItemIID: TGUID; +begin + Result := EquatableIID; +end; + +function TAbstractSet.GetType: TCollectionType; +begin + Result := ctSet; +end; + +function TAbstractSet.CloneAsSet: ISet; +begin + Result := (TAbstractSetClass(ClassType)).Create(Self); +end; + +function TAbstractSet.Complement(const Universe: ISet): ISet; +var + ResultSet: ISet; + Iterator: IIterator; + Item: ICollectable; +begin + // Return items in universe not found in self. + ResultSet := TAbstractSetClass(ClassType).Create(NaturalItemsOnly); + Iterator := Universe.GetIterator; + while not Iterator.EOF do + begin + Item := Iterator.CurrentItem; + if not Contains(Item) then + ResultSet.Add(Item); + Iterator.Next; + end; + Result := ResultSet; +end; + +function TAbstractSet.Intersect(const Set2: ISet): ISet; +var + ResultSet: ISet; + Iterator: IIterator; + Item: ICollectable; +begin + // Return items found in self and parameter. + ResultSet := TAbstractSetClass(ClassType).Create(NaturalItemsOnly); + Iterator := GetIterator; + while not Iterator.EOF do + begin + Item := Iterator.CurrentItem; + if Contains(Item) and Set2.Contains(Item) then + ResultSet.Add(Iterator.CurrentItem); + Iterator.Next; + end; + Result := ResultSet; +end; + +function TAbstractSet.IsNilAllowed: Boolean; +begin + Result := false; +end; + +function TAbstractSet.Union(const Set2: ISet): ISet; +var + ResultSet: ISet; + Iterator: IIterator; + Item: ICollectable; +begin + // Return items found in self or parameter. + ResultSet := CloneAsSet; + Iterator := Set2.GetIterator; + while not Iterator.EOF do + begin + Item := Iterator.CurrentItem; + if not Contains(Item) and Set2.Contains(Item) then + ResultSet.Add(Iterator.CurrentItem); + Iterator.Next; + end; + Result := ResultSet; +end; + +{ TAbstractList } +constructor TAbstractList.Create(NaturalItemsOnly: Boolean); +begin + inherited Create(NaturalItemsOnly); + FDuplicates := true; + FSorted := false; +end; + +procedure TAbstractList.InitFrom(const Collection: ICollection); +var + List: IList; +begin + inherited InitFrom(Collection); + if Collection.QueryInterface(IList, List) = S_OK then + begin + FDuplicates := List.GetDuplicates; + FSorted := List.GetSorted; + end; +end; + +function TAbstractList.TrueAdd(const Item: ICollectable): Boolean; +var + SearchResult: TSearchResult; +begin + Result := True; + if Sorted then + begin + // Insert in appropriate place to maintain sort order, unless duplicate + // not allowed. + SearchResult := BinarySearch(Item); + case SearchResult.ResultType of + srBeforeIndex: TrueInsert(SearchResult.Index, Item); + srFoundAtIndex: begin + if Duplicates then + TrueInsert(SearchResult.Index, Item) + else + begin + CollectionError(ceDuplicate); + Result := false; + end; + end; + srAfterEnd: TrueAppend(Item); + end; + end + else + begin + // Add to end, unless duplicate not allowed. + if not Duplicates and (SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex) then + begin + CollectionError(ceDuplicate); + Result := false; + end + else + TrueAppend(Item); + end; +end; + +function TAbstractList.TrueContains(const Item: ICollectable): Boolean; +begin + if Sorted then + Result := BinarySearch(Item).ResultType = srFoundAtIndex + else + Result := SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex +end; + +function TAbstractList.TrueItemCount(const Item: ICollectable): Integer; +var + SearchResult: TSearchResult; + Count: Integer; +begin + if Sorted then + begin + // If sorted, use binary search. + Count := 0; + SearchResult := BinarySearch(Item); + if SearchResult.ResultType = srFoundAtIndex then + begin + repeat + Inc(Count); + until not Comparator.Equals(Item, Items[SearchResult.Index]); + end; + Result := Count; + end + else + // Resort to sequential search for unsorted + Result := inherited TrueItemCount(Item); +end; + +function TAbstractList.TrueRemove(const Item: ICollectable): ICollectable; +var + SearchResult: TSearchResult; +begin + Result := nil; + if Sorted then + begin + SearchResult := BinarySearch(Item); + if SearchResult.ResultType = srFoundAtIndex then + begin + Result := TrueDelete(SearchResult.Index); + end; + end + else + begin + SearchResult := SequentialSearch(Item); + if SearchResult.ResultType = srFoundAtIndex then + Result := TrueDelete(SearchResult.Index); + end; +end; + +function TAbstractList.TrueRemoveAll(const Item: ICollectable): ICollection; +var + ResultCollection: ICollection; + SearchResult: TSearchResult; + I: Integer; +begin + ResultCollection := TPArrayBag.Create; + if Sorted then + begin + SearchResult := BinarySearch(Item); + if SearchResult.ResultType = srFoundAtIndex then + begin + repeat + ResultCollection.Add(TrueDelete(SearchResult.Index)); + until not Comparator.Equals(Item, Items[SearchResult.Index]); + end; + end + else + begin + I := 0; + while I < Size do + begin + if Comparator.Equals(Item, Items[I]) then + begin + ResultCollection.Add(TrueDelete(I)); + end + else + Inc(I); + end; + end; + Result := ResultCollection; +end; + +procedure TAbstractList.QuickSort(Lo, Hi: Integer; const Comparator: IComparator); +var + I, J, Mid: Integer; +begin + repeat + I := Lo; + J := Hi; + Mid := (Lo + Hi) div 2; + repeat + while Comparator.Compare(Items[I], Items[Mid]) < 0 do + Inc(I); + while Comparator.Compare(Items[J], Items[Mid]) > 0 do + Dec(J); + if I <= J then + begin + Exchange(I, J); + if Mid = I then + Mid := J + else if Mid = J then + Mid := I; + Inc(I); + Dec(J); + end; + until I > J; + if Lo < J then + QuickSort(Lo, J, Comparator); + Lo := I; + until I >= Hi; +end; + +procedure TAbstractList.QuickSort(Lo, Hi: Integer; CompareFunc: TCollectionCompareFunc); +var + I, J, Mid: Integer; +begin + repeat + I := Lo; + J := Hi; + Mid := (Lo + Hi) div 2; + repeat + while CompareFunc(Items[I], Items[Mid]) < 0 do + Inc(I); + while CompareFunc(Items[J], Items[Mid]) > 0 do + Dec(J); + if I <= J then + begin + Exchange(I, J); + if Mid = I then + Mid := J + else if Mid = J then + Mid := I; + Inc(I); + Dec(J); + end; + until I > J; + if Lo < J then + QuickSort(Lo, J, CompareFunc); + Lo := I; + until I >= Hi; +end; + +function TAbstractList.GetDuplicates: Boolean; +begin + Result := FDuplicates; +end; + +procedure TAbstractList.SetDuplicates(Value: Boolean); +var + Iterator: IIterator; + Failed: Boolean; +begin + Failed := false; + // If trying to set no duplicates, check there are no existing duplicates. + if not Value then + begin + Iterator := GetIterator; + while not Iterator.EOF and not Failed do + begin + Failed := (ItemCount(Iterator.CurrentItem) > 1); + Iterator.Next; + end; + if Failed then + CollectionError(ceDuplicate); + end; + if not Failed then + FDuplicates := Value; +end; + +function TAbstractList.GetItem(Index: Integer): ICollectable; +begin + if (Index < 0) or (Index >= Size) then + begin + CollectionError(ceOutOfRange); + Result := nil; + end + else + Result := TrueGetItem(Index); +end; + +procedure TAbstractList.SetItem(Index: Integer; const Item: ICollectable); +var + SearchResult: TSearchResult; +begin + if (Index < 0) or (Index >= Size) then + begin + CollectionError(ceOutOfRange) + end + else if not Duplicates then + begin + // Find any duplicates + if Sorted then + begin + SearchResult := BinarySearch(Item); + case SearchResult.ResultType of + srBeforeIndex, srAfterEnd: begin // If item is not present + FSorted := false; + TrueSetItem(Index, Item); + end; + srFoundAtIndex: begin // If item is already present + CollectionError(ceDuplicate); + end; + end; + end + else + begin + // If item is already present + if SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex then + begin + CollectionError(ceDuplicate); + end + else + begin + TrueSetItem(Index, Item); + end; + end; + end + else + begin + FSorted := false; + TrueSetItem(Index, Item); + end; +end; + +function TAbstractList.GetIterator: IIterator; +begin + Result := TAbstractListIterator.Create(Self); +end; + +function TAbstractList.GetNaturalItemIID: TGUID; +begin + Result := ComparableIID; +end; + +function TAbstractList.GetSorted: Boolean; +begin + Result := FSorted; +end; + +procedure TAbstractList.SetSorted(Value: Boolean); +begin + if Value then + Sort; +end; + +function TAbstractList.GetType: TCollectionType; +begin + Result := ctList; +end; + +function TAbstractList.BinarySearch(const Item: ICollectable): TSearchResult; +var + Lo, Hi, Mid: Integer; + CompareResult: Integer; + Success: Boolean; +begin + if Size = 0 then + begin + Result.ResultType := srAfterEnd; + Exit; + end; + Lo := 0; + Hi := Size - 1; + Success := false; + repeat + Mid := (Lo + Hi) div 2; + CompareResult := Comparator.Compare(Item, Items[Mid]); + if CompareResult = 0 then + Success := true + else if CompareResult > 0 then + Lo := Mid + 1 + else + Hi := Mid - 1; + until (Lo > Hi) or Success; + if Success then + begin + // Move index back if in cluster of duplicates + while (Mid > 0) and Comparator.Equals(Item, Items[Mid - 1]) do + Dec(Mid); + Result.ResultType := srFoundAtIndex; + Result.Index := Mid; + end + else if CompareResult < 0 then + begin + Result.ResultType := srBeforeIndex; + Result.Index := Mid; + end + else if Hi < Size - 1 then + begin + Result.ResultType := srBeforeIndex; + Result.Index := Mid + 1; + end + else + Result.ResultType := srAfterEnd; +end; + +function TAbstractList.CloneAsList: IList; +begin + Result := (TAbstractListClass(ClassType)).Create(Self); +end; + +function TAbstractList.Delete(Index: Integer): ICollectable; +begin + if FixedSize then + begin + CollectionError(ceFixedSize); + Result := nil; + end + else if (Index < 0) or (Index >= Size) then + begin + CollectionError(ceOutOfRange); + Result := nil; + end + else + begin + Result := TrueDelete(Index); + end; +end; + +procedure TAbstractList.Exchange(Index1, Index2: Integer); +var + Item: ICollectable; +begin + if (Index1 < 0) or (Index1 >= Size) then + CollectionError(ceOutOfRange); + if (Index2 < 0) or (Index2 >= Size) then + CollectionError(ceOutOfRange); + FSorted := false; + Item := ICollectable(Items[Index1]); + Items[Index1] := Items[Index2]; + Items[Index2] := Item; +end; + +function TAbstractList.First: ICollectable; +begin + if Size > 0 then + Result := Items[0] + else + Result := nil; +end; + +function TAbstractList.IndexOf(const Item: ICollectable): Integer; +var + SearchResult: TSearchResult; +begin + if Sorted then + SearchResult := BinarySearch(Item) + else + SearchResult := SequentialSearch(Item, Comparator); + if SearchResult.ResultType = srFoundAtIndex then + Result := SearchResult.Index + else + Result := -1; +end; + +function TAbstractList.Insert(Index: Integer; const Item: ICollectable): Boolean; +var + ItemError: TCollectionError; +begin + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Result := false; + end + else if FixedSize then + begin + CollectionError(ceFixedSize); + Result := false; + end + else if (Index < 0) or (Index > Size) then + begin + CollectionError(ceOutOfRange); + Result := false; + end + else + begin + FSorted := false; + if Index = Size then + TrueAdd(Item) + else + TrueInsert(Index, Item); + Result := true; + end; +end; + +function TAbstractList.Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; +var + Item: ICollectable; + ItemError: TCollectionError; + I, NewIndex, Count: Integer; + Success: Boolean; +begin + Count := 0; + if FixedSize then + begin + CollectionError(ceFixedSize); + end + else if (Index < 0) or (Index > Size) then + begin + CollectionError(ceOutOfRange); + end + else + begin + // Insert entire array in place in correct order + NewIndex := Index; + for I := Low(ItemArray) to High(ItemArray) do + begin + Item := ItemArray[I]; + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + end + else + begin + Success := Insert(NewIndex, Item); + if Success then + begin + Inc(NewIndex); + Inc(Count); + end; + end; + end; + end; + Result := Count; +end; + +function TAbstractList.Insert(Index: Integer; const Collection: ICollection): Integer; +var + Iterator: IIterator; + Item: ICollectable; + ItemError: TCollectionError; + NewIndex, Count: Integer; + Success: Boolean; +begin + Count := 0; + if FixedSize then + begin + CollectionError(ceFixedSize); + end + else if (Index < 0) or (Index > Size) then + begin + CollectionError(ceOutOfRange); + end + else + begin + // Insert entire collection in place in correct order + NewIndex := Index; + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + Item := Iterator.CurrentItem; + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + end + else + begin + Success := Insert(NewIndex, Item); + if Success then + begin + Inc(NewIndex); + Inc(Count); + end; + end; + Iterator.Next; + end; + end; + Result := Count; +end; + +function TAbstractList.IsNilAllowed: Boolean; +begin + Result := true; +end; + +function TAbstractList.Last: ICollectable; +begin + if Size > 0 then + Result := Items[Size - 1] + else + Result := nil; +end; + +function TAbstractList.Search(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; +begin + if Sorted and (SearchComparator = nil) then + Result := BinarySearch(Item) + else + Result := SequentialSearch(Item, SearchComparator); +end; + +function TAbstractList.SequentialSearch(const Item: ICollectable; const SearchComparator: IComparator): TSearchResult; +var + WorkingComparator: IComparator; + I: Integer; + Success: Boolean; +begin + if SearchComparator = nil then + WorkingComparator := Comparator + else + WorkingComparator := SearchComparator; + Result.ResultType := srNotFound; + I := 0; + Success := false; + while (I < Size) and not Success do + begin + if WorkingComparator.Equals(Item, Items[I]) then + begin + Result.ResultType := srFoundAtIndex; + Result.Index := I; + Success := true; + end + else + Inc(I); + end; +end; + +procedure TAbstractList.Sort(const SortComparator: IComparator); +begin + if SortComparator = nil then + begin + if Size > 0 then + QuickSort(0, Size - 1, Comparator); + FSorted := true; + end + else + begin + if Size > 0 then + QuickSort(0, Size - 1, SortComparator); + FSorted := false; + end; +end; + +procedure TAbstractList.Sort(CompareFunc: TCollectionCompareFunc); +begin + if Size > 0 then + QuickSort(0, Size - 1, CompareFunc); + FSorted := false; +end; + +{ TAbstractMap } +constructor TAbstractMap.Create; +begin + Create(false, true); +end; + +constructor TAbstractMap.Create(NaturalItemsOnly: Boolean); +begin + Create(NaturalItemsOnly, true); +end; + +constructor TAbstractMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); +begin + inherited Create(NaturalItemsOnly); + FNaturalKeysOnly := NaturalKeysOnly or GetAlwaysNaturalKeys; + FAssociationComparator := TAssociationComparator.Create(FNaturalKeysOnly); + if FNaturalKeysOnly then + FKeyComparator := TAbstractComparator.GetNaturalComparator + else + FKeyComparator := TAbstractComparator.GetDefaultComparator; +end; + +constructor TAbstractMap.Create(const ItemArray: array of ICollectable); +begin + Create(ItemArray, true, true); +end; + +constructor TAbstractMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); +begin + Create(ItemArray, true, true); +end; + +constructor TAbstractMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); +var + I: Integer; +begin + Create(true, NaturalKeysOnly); + if not FixedSize then + begin + Capacity := Length(ItemArray); + for I := Low(ItemArray) to High(ItemArray) do + begin + Add(ItemArray[I]); + end; + end; +end; + +constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable); +begin + Create(KeyArray, ItemArray, false, true); +end; + +constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); +begin + Create(KeyArray, ItemArray, NaturalItemsOnly, true); +end; + +constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); +var + I, Lo, Hi: Integer; +begin + Create(NaturalItemsOnly, NaturalKeysOnly); + if not FixedSize then + begin + Capacity := Min(Length(KeyArray), Length(ItemArray)); + Lo := Max(Low(KeyArray), Low(ItemArray)); + Hi := Min(High(KeyArray), High(ItemArray)); + for I := Lo to Hi do + begin + Put(KeyArray[I], ItemArray[I]); + end; + end; +end; + +constructor TAbstractMap.Create(const Map: IMap); +var + MapIterator: IMapIterator; +begin + Create(Map.GetNaturalItemsOnly, Map.GetNaturalKeysOnly); + InitFrom(Map); + if not FixedSize then + begin + Capacity := Map.GetSize; + MapIterator := Map.GetMapIterator; + while not MapIterator.EOF do + begin + Put(MapIterator.CurrentKey, MapIterator.CurrentItem); + MapIterator.Next; + end; + end; +end; + +destructor TAbstractMap.Destroy; +begin + FKeyComparator := nil; + FAssociationComparator := nil; + inherited Destroy; +end; + +procedure TAbstractMap.InitFrom(const Collection: ICollection); +var + Map: IMap; +begin + inherited InitFrom(Collection); + if Collection.QueryInterface(IMap, Map) = S_OK then + begin + FNaturalKeysOnly := Map.GetNaturalKeysOnly or GetAlwaysNaturalKeys; + KeyComparator := Map.GetKeyComparator; + end; +end; + +function TAbstractMap.TrueAdd(const Item: ICollectable): Boolean; +var + Position: TCollectionPosition; + Mappable: IMappable; +begin + if IsNaturalItem(Item) then + begin + Mappable := Item as IMappable; + Position := GetKeyPosition(Mappable.GetKey); + try + if Position.Found then + begin + CollectionError(ceDuplicateKey); + Result := false; + end + else + begin + TruePut(Position, TAssociation.Create(Mappable.GetKey, Item)); + Result := true; + end; + finally + Position.Free; + end; + end + else + begin + CollectionError(ceNotNaturalItem); + Result := false; + end; +end; + +function TAbstractMap.TrueContains(const Item: ICollectable): Boolean; +var + Item2: ICollectable; + Success: Boolean; + Iterator: IIterator; +begin + Iterator := GetIterator; + Success := false; + while not Iterator.EOF and not Success do + begin + Item2 := Iterator.CurrentItem; + if Comparator.Equals(Item, Item2) then + Success := true; + Iterator.Next; + end; + Result := Success; +end; + +function TAbstractMap.TrueRemove(const Item: ICollectable): ICollectable; +var + Item2: ICollectable; + Iterator: IMapIterator; + Found: Boolean; +begin + // Sequential search + Found := false; + Result := nil; + Iterator := GetAssociationIterator; + while not Iterator.EOF and not Found do + begin + Item2 := Iterator.CurrentItem; + if Comparator.Equals(Item, Item2) then + begin + Result := Item2; + Iterator.Remove; + Found := true; + end; + Iterator.Next; + end; +end; + +function TAbstractMap.TrueRemoveAll(const Item: ICollectable): ICollection; +var + ResultCollection: ICollection; + Item2: ICollectable; + Iterator: IMapIterator; +begin + // Sequential search + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := GetAssociationIterator; + while not Iterator.EOF do + begin + Item2 := Iterator.CurrentItem; + if Comparator.Equals(Item, Item2) then + begin + ResultCollection.Add(Item2); + Iterator.Remove; + end; + Iterator.Next; + end; + Result := ResultCollection; +end; + +class function TAbstractMap.GetAlwaysNaturalKeys: Boolean; +begin + Result := false; +end; + +function TAbstractMap.GetItem(const Key: ICollectable): ICollectable; +begin + Result := Get(Key); +end; + +procedure TAbstractMap.SetItem(const Key, Item: ICollectable); +begin + Put(Key, Item); +end; + +function TAbstractMap.GetIterator: IIterator; +begin + Result := GetAssociationIterator; +end; + +function TAbstractMap.GetKeyComparator: IComparator; +begin + Result := FKeyComparator; +end; + +procedure TAbstractMap.SetKeyComparator(const Value: IComparator); +begin + FKeyComparator := Value; + FAssociationComparator.KeyComparator := Value; +end; + +function TAbstractMap.GetKeyIterator: IIterator; +begin + Result := TAssociationKeyIterator.Create(GetAssociationIterator); +end; + +function TAbstractMap.GetKeys: ISet; +var + ResultCollection: TPArraySet; + KeyIterator: IIterator; +begin + ResultCollection := TPArraySet.Create(NaturalKeysOnly); + ResultCollection.SetComparator(GetKeyComparator); + KeyIterator := GetKeyIterator; + while not KeyIterator.EOF do + begin + ResultCollection.Add(KeyIterator.CurrentItem); + KeyIterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractMap.GetMapIterator: IMapIterator; +begin + Result := GetAssociationIterator; +end; + +function TAbstractMap.GetMapIteratorByKey(const Filter: IFilter): IMapIterator; +var + Iterator: IMapIterator; +begin + Iterator := GetMapIterator; + Result := TKeyFilterMapIterator.Create(Iterator, Filter, Iterator.GetAllowRemoval); +end; + +function TAbstractMap.GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; +var + Iterator: IMapIterator; +begin + Iterator := GetMapIterator; + Result := TKeyFilterFuncMapIterator.Create(Iterator, FilterFunc, Iterator.GetAllowRemoval); +end; + +function TAbstractMap.GetNaturalItemIID: TGUID; +begin + Result := MappableIID; +end; + +function TAbstractMap.GetNaturalKeyIID: TGUID; +begin + Result := EquatableIID; +end; + +function TAbstractMap.GetNaturalKeysOnly: Boolean; +begin + Result := FNaturalKeysOnly; +end; + +function TAbstractMap.GetType: TCollectionType; +begin + Result := ctMap; +end; + +function TAbstractMap.GetValues: ICollection; +var + ResultCollection: ICollection; + ValueIterator: IIterator; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + ValueIterator := GetIterator; + while not ValueIterator.EOF do + begin + ResultCollection.Add(ValueIterator.CurrentItem); + ValueIterator.Next; + end; + Result := ResultCollection; +end; + +// Overrides TAbstractCollection function, otherwise Create(ICollection) is +// called, which cannot access keys. +function TAbstractMap.Clone: ICollection; +begin + Result := (TAbstractMapClass(ClassType)).Create(Self); +end; + +function TAbstractMap.CloneAsMap: IMap; +begin + Result := (TAbstractMapClass(ClassType)).Create(Self); +end; + +function TAbstractMap.ContainsKey(const Key: ICollectable): Boolean; +var + Position: TCollectionPosition; +begin + Position := GetKeyPosition(Key); + try + Result := Position.Found; + finally + Position.Free; + end; +end; + +function TAbstractMap.ContainsKey(const KeyArray: array of ICollectable): Boolean; +var + I: Integer; + Success: Boolean; +begin + Success := true; + for I := Low(KeyArray) to High(KeyArray) do + begin + Success := Success and ContainsKey(KeyArray[I]); + if not Success then + break; + end; + Result := Success; +end; + +function TAbstractMap.ContainsKey(const Collection: ICollection): Boolean; +var + Iterator: IIterator; + Success: Boolean; +begin + Success := true; + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + Success := Success and ContainsKey(Iterator.CurrentItem); + if not Success then + break; + Iterator.Next; + end; + Result := Success; +end; + +function TAbstractMap.Get(const Key: ICollectable): ICollectable; +var + KeyError: TCollectionError; + Position: TCollectionPosition; +begin + KeyError := KeyAllowed(Key); + if KeyError <> ceOK then + begin + CollectionError(KeyError); + Result := nil; + end + else + begin + Position := GetKeyPosition(Key); + try + if Position.Found then + Result := TrueGet(Position).GetValue + else + Result := nil; + finally + Position.Free; + end; + end; +end; + +function TAbstractMap.KeyAllowed(const Key: ICollectable): TCollectionError; +begin + if NaturalKeysOnly and not IsNaturalKey(Key) then + Result := ceNotNaturalItem + else if Key = nil then + Result := ceNilNotAllowed + else + Result := ceOK; +end; + +function TAbstractMap.IsNaturalKey(const Key: ICollectable): Boolean; +var + Temp: IUnknown; +begin + if Key.QueryInterface(NaturalKeyIID, Temp) <> E_NOINTERFACE then + Result := true + else + Result := false; +end; + +function TAbstractMap.IsNilAllowed: Boolean; +begin + Result := true; +end; + +function TAbstractMap.MatchingKey(const KeyArray: array of ICollectable): ICollection; +var + ResultCollection: ICollection; + I: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + for I := Low(KeyArray) to High(KeyArray) do + begin + if ContainsKey(KeyArray[I]) then + ResultCollection.Add(KeyArray[I]); + end; + Result := ResultCollection; +end; + +function TAbstractMap.MatchingKey(const Collection: ICollection): ICollection; +var + ResultCollection: ICollection; + Iterator: IIterator; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + if ContainsKey(Iterator.CurrentItem) then + ResultCollection.Add(Iterator.CurrentItem); + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractMap.Put(const Item: ICollectable): ICollectable; +var + Mappable: IMappable; + OldAssociation, NewAssociation: IAssociation; + Position: TCollectionPosition; +begin + if not IsNaturalItem(Item) then + begin + CollectionError(ceNotNaturalItem); + Result := nil; + end + else + begin + Item.QueryInterface(IMappable, Mappable); + Position := GetKeyPosition(Mappable.GetKey); + try + NewAssociation := TAssociation.Create(Mappable.GetKey, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + Result := OldAssociation.GetValue + else + Result := nil; + finally + Position.Free; + end; + end; +end; + +function TAbstractMap.Put(const Key, Item: ICollectable): ICollectable; +var + OldAssociation, NewAssociation: IAssociation; + ItemError, KeyError: TCollectionError; + Position: TCollectionPosition; +begin + ItemError := ItemAllowed(Item); + KeyError := KeyAllowed(Key); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Result := nil; + end + else if KeyError <> ceOK then + begin + CollectionError(KeyError); + Result := nil; + end + else + begin + // Find appropriate place, then place key-item association there + Position := GetKeyPosition(Key); + try + NewAssociation := TAssociation.Create(Key, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + Result := OldAssociation.GetValue + else + Result := nil; + finally + Position.Free; + end; + end; +end; + +function TAbstractMap.Put(const ItemArray: array of ICollectable): ICollection; +var + ResultCollection: ICollection; + Mappable: IMappable; + OldAssociation, NewAssociation: IAssociation; + Position: TCollectionPosition; + Item: ICollectable; + I: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + for I := Low(ItemArray) to High(ItemArray) do + begin + Item := ItemArray[I]; + if not IsNaturalItem(Item) then + begin + CollectionError(ceNotNaturalItem); + end + else + begin + // Find appropriate place, then place key-item association there + Item.QueryInterface(IMappable, Mappable); + Position := GetKeyPosition(Mappable.GetKey); + try + NewAssociation := TAssociation.Create(Mappable.GetKey, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + ResultCollection.Add(OldAssociation.GetValue); + finally + Position.Free; + end; + end; + end; + Result := ResultCollection; +end; + +function TAbstractMap.Put(const Collection: ICollection): ICollection; +var + ResultCollection: ICollection; + Mappable: IMappable; + OldAssociation, NewAssociation: IAssociation; + Position: TCollectionPosition; + Iterator: IIterator; + Item: ICollectable; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + Item := Iterator.CurrentItem;; + if not IsNaturalItem(Item) then + begin + CollectionError(ceNotNaturalItem); + end + else + begin + // Find appropriate place, then place key-item association there + Item.QueryInterface(IMappable, Mappable); + Position := GetKeyPosition(Mappable.GetKey); + try + NewAssociation := TAssociation.Create(Mappable.GetKey, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + ResultCollection.Add(OldAssociation.GetValue); + finally + Position.Free; + end; + end; + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractMap.Put(const Map: IMap): ICollection; +var + ResultCollection: ICollection; + OldAssociation, NewAssociation: IAssociation; + ItemError, KeyError: TCollectionError; + Position: TCollectionPosition; + MapIterator: IMapIterator; + Key, Item: ICollectable; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + MapIterator := Map.GetMapIterator; + while not MapIterator.EOF do + begin + Key := MapIterator.CurrentKey; + Item := MapIterator.CurrentItem; + + ItemError := ItemAllowed(Item); + KeyError := KeyAllowed(Key); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + end + else if KeyError <> ceOK then + begin + CollectionError(KeyError); + end + else + begin + // Find appropriate place, then place key-item association there + Position := GetKeyPosition(Key); + try + NewAssociation := TAssociation.Create(Key, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + ResultCollection.Add(OldAssociation.GetValue); + finally + Position.Free; + end; + end; + MapIterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractMap.RemoveKey(const Key: ICollectable): ICollectable; +var + KeyError: TCollectionError; + Position: TCollectionPosition; + OldAssociation: IAssociation; +begin + KeyError := KeyAllowed(Key); + if KeyError <> ceOK then + begin + CollectionError(KeyError); + Result := nil; + end + else + begin + Position := GetKeyPosition(Key); + try + if Position.Found then + begin + OldAssociation := TrueRemove2(Position); + Result := OldAssociation.GetValue + end + else + Result := nil; + finally + Position.Free; + end; + end; +end; + +function TAbstractMap.RemoveKey(const KeyArray: array of ICollectable): ICollection; +var + ResultCollection: ICollection; + OldAssociation: IAssociation; + KeyError: TCollectionError; + Position: TCollectionPosition; + Key: ICollectable; + I: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + for I := Low(KeyArray) to High(KeyArray) do + begin + Key := KeyArray[I]; + KeyError := KeyAllowed(Key); + if KeyError <> ceOK then + begin + CollectionError(KeyError); + end + else + begin + Position := GetKeyPosition(Key); + try + if Position.Found then + begin + OldAssociation := TrueRemove2(Position); + ResultCollection.Add(OldAssociation.GetValue); + end; + finally + Position.Free; + end; + end; + end; + Result := ResultCollection; +end; + +function TAbstractMap.RemoveKey(const Collection: ICollection): ICollection; +var + ResultCollection: ICollection; + OldAssociation: IAssociation; + KeyError: TCollectionError; + Position: TCollectionPosition; + Key: ICollectable; + Iterator: IIterator; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + Key := Iterator.CurrentItem; + KeyError := KeyAllowed(Key); + if KeyError <> ceOK then + begin + CollectionError(KeyError); + end + else + begin + Position := GetKeyPosition(Key); + try + if Position.Found then + begin + OldAssociation := TrueRemove2(Position); + ResultCollection.Add(OldAssociation.GetValue); + end; + finally + Position.Free; + end; + end; + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractMap.RetainKey(const KeyArray: array of ICollectable): ICollection; +var + ResultCollection: ICollection; + MapIterator: IMapIterator; + I: Integer; + Found: Boolean; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + if FixedSize then + begin + CollectionError(ceFixedSize); + end + else + begin + MapIterator := GetMapIterator; + while not MapIterator.EOF do + begin + // Converting the array to a map would be faster but I don't want to + // couple base class code to a complex collection. + Found := false; + for I := Low(KeyArray) to High(KeyArray) do + begin + Found := KeyComparator.Equals(MapIterator.CurrentKey, KeyArray[I]); + if Found then + break; + end; + if not Found then + begin + ResultCollection.Add(MapIterator.CurrentItem); + MapIterator.Remove; + end; + MapIterator.Next; + end; + Result := ResultCollection; + end; +end; + +function TAbstractMap.RetainKey(const Collection: ICollection): ICollection; +var + ResultCollection: ICollection; + MapIterator: IMapIterator; + Key: ICollectable; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + if FixedSize then + begin + CollectionError(ceFixedSize); + end + else + begin + MapIterator := GetMapIterator; + while not MapIterator.EOF do + begin + Key := MapIterator.CurrentKey; + if not Collection.Contains(Key) then + begin + ResultCollection.Add(MapIterator.CurrentItem); + MapIterator.Remove; + end; + MapIterator.Next; + end; + end; + Result := ResultCollection; +end; + + +{ TAbstractIntegerMap } +constructor TAbstractIntegerMap.Create(NaturalItemsOnly: Boolean); +begin + inherited Create(NaturalItemsOnly); + FAssociationComparator := TIntegerAssociationComparator.Create; +end; + +constructor TAbstractIntegerMap.Create(const ItemArray: array of ICollectable); +begin + Create(ItemArray, true); +end; + +constructor TAbstractIntegerMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); +begin + inherited Create(ItemArray, true); +end; + +constructor TAbstractIntegerMap.Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable); +begin + Create(KeyArray, ItemArray, false); +end; + +constructor TAbstractIntegerMap.Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); +var + I, Lo, Hi: Integer; +begin + Create(NaturalItemsOnly); + Capacity := Min(Length(KeyArray), Length(ItemArray)); + if not FixedSize then + begin + Lo := Max(Low(KeyArray), Low(ItemArray)); + Hi := Min(High(KeyArray), High(ItemArray)); + for I := Lo to Hi do + begin + Put(KeyArray[I], ItemArray[I]); + end; + end; +end; + +constructor TAbstractIntegerMap.Create(const Map: IIntegerMap); +var + MapIterator: IIntegerMapIterator; +begin + Create(Map.GetNaturalItemsOnly); + InitFrom(Map); + Capacity := Map.GetSize; + if not FixedSize then + begin + MapIterator := Map.GetMapIterator; + while not MapIterator.EOF do + begin + Put(MapIterator.CurrentKey, MapIterator.CurrentItem); + MapIterator.Next; + end; + end; +end; + +destructor TAbstractIntegerMap.Destroy; +begin + FAssociationComparator := nil; + inherited Destroy; +end; + +function TAbstractIntegerMap.TrueAdd(const Item: ICollectable): Boolean; +var + Position: TCollectionPosition; + Mappable: IIntegerMappable; +begin + if IsNaturalItem(Item) then + begin + Mappable := Item as IIntegerMappable; + Position := GetKeyPosition(Mappable.GetKey); + try + if Position.Found then + begin + CollectionError(ceDuplicateKey); + Result := false; + end + else + begin + TruePut(Position, TIntegerAssociation.Create(Mappable.GetKey, Item)); + Result := true; + end; + finally + Position.Free; + end; + end + else + begin + CollectionError(ceNotNaturalItem); + Result := false; + end; +end; + +function TAbstractIntegerMap.TrueContains(const Item: ICollectable): Boolean; +var + Item2: ICollectable; + Success: Boolean; + Iterator: IIterator; +begin + Iterator := GetIterator; + Success := false; + while not Iterator.EOF and not Success do + begin + Item2 := Iterator.CurrentItem; + if Comparator.Equals(Item, Item2) then + Success := true; + Iterator.Next; + end; + Result := Success; +end; + +function TAbstractIntegerMap.TrueRemove(const Item: ICollectable): ICollectable; +var + Item2: ICollectable; + Iterator: IIntegerMapIterator; + Found: Boolean; +begin + // Sequential search + Found := false; + Result := nil; + Iterator := GetAssociationIterator; + while not Iterator.EOF and not Found do + begin + Item2 := Iterator.CurrentItem; + if Comparator.Equals(Item, Item2) then + begin + Result := Item2; + Iterator.Remove; + Found := true; + end; + Iterator.Next; + end; +end; + +function TAbstractIntegerMap.TrueRemoveAll(const Item: ICollectable): ICollection; +var + ResultCollection: ICollection; + Item2: ICollectable; + Iterator: IIntegerMapIterator; +begin + // Sequential search + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := GetAssociationIterator; + while not Iterator.EOF do + begin + Item2 := Iterator.CurrentItem; + if Comparator.Equals(Item, Item2) then + begin + ResultCollection.Add(Item2); + Iterator.Remove; + end; + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractIntegerMap.GetItem(const Key: Integer): ICollectable; +begin + Result := Get(Key); +end; + +procedure TAbstractIntegerMap.SetItem(const Key: Integer; const Item: ICollectable); +begin + Put(Key, Item); +end; + +function TAbstractIntegerMap.GetIterator: IIterator; +begin + Result := GetAssociationIterator; +end; + +function TAbstractIntegerMap.GetKeys: ISet; +var + ResultCollection: TPArraySet; + MapIterator: IIntegerMapIterator; +begin + ResultCollection := TPArraySet.Create(true); + MapIterator := GetMapIterator; + while not MapIterator.EOF do + begin + ResultCollection.Add(TIntegerWrapper.Create(MapIterator.CurrentKey) as ICollectable); + MapIterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractIntegerMap.GetMapIterator: IIntegerMapIterator; +begin + Result := GetAssociationIterator; +end; + +function TAbstractIntegerMap.GetNaturalItemIID: TGUID; +begin + Result := IntegerMappableIID; +end; + +function TAbstractIntegerMap.GetType: TCollectionType; +begin + Result := ctIntegerMap; +end; + +function TAbstractIntegerMap.GetValues: ICollection; +var + ResultCollection: ICollection; + ValueIterator: IIterator; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + ValueIterator := GetIterator; + while not ValueIterator.EOF do + begin + ResultCollection.Add(ValueIterator.CurrentItem); + ValueIterator.Next; + end; + Result := ResultCollection; +end; + +// Overrides TAbstractCollection function, otherwise Create(ICollection) is +// called, which cannot access keys. +function TAbstractIntegerMap.Clone: ICollection; +begin + Result := (TAbstractIntegerMapClass(ClassType)).Create(Self); +end; + +function TAbstractIntegerMap.CloneAsIntegerMap: IIntegerMap; +begin + Result := (TAbstractIntegerMapClass(ClassType)).Create(Self); +end; + +function TAbstractIntegerMap.ContainsKey(const Key: Integer): Boolean; +var + Position: TCollectionPosition; +begin + Position := GetKeyPosition(Key); + try + Result := Position.Found; + finally + Position.Free; + end; +end; + +function TAbstractIntegerMap.ContainsKey(const KeyArray: array of Integer): Boolean; +var + I: Integer; + Success: Boolean; +begin + Success := true; + for I := Low(KeyArray) to High(KeyArray) do + begin + Success := Success and ContainsKey(KeyArray[I]); + if not Success then + break; + end; + Result := Success; +end; + +function TAbstractIntegerMap.Get(const Key: Integer): ICollectable; +var + Position: TCollectionPosition; +begin + Position := GetKeyPosition(Key); + try + if Position.Found then + Result := TrueGet(Position).GetValue + else + Result := nil; + finally + Position.Free; + end; +end; + +function TAbstractIntegerMap.IsNilAllowed: Boolean; +begin + Result := true; +end; + +function TAbstractIntegerMap.Put(const Item: ICollectable): ICollectable; +var + Mappable: IIntegerMappable; + OldAssociation, NewAssociation: IIntegerAssociation; + Position: TCollectionPosition; +begin + if not IsNaturalItem(Item) then + begin + CollectionError(ceNotNaturalItem); + Result := nil; + end + else + begin + Item.QueryInterface(IIntegerMappable, Mappable); + Position := GetKeyPosition(Mappable.GetKey); + try + NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + Result := OldAssociation.GetValue + else + Result := nil; + finally + Position.Free; + end; + end; +end; + +function TAbstractIntegerMap.Put(const Key: Integer; const Item: ICollectable): ICollectable; +var + OldAssociation, NewAssociation: IIntegerAssociation; + ItemError: TCollectionError; + Position: TCollectionPosition; +begin + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Result := nil; + end + else + begin + Position := GetKeyPosition(Key); + try + NewAssociation := TIntegerAssociation.Create(Key, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + Result := OldAssociation.GetValue + else + Result := nil; + finally + Position.Free; + end; + end; +end; + +function TAbstractIntegerMap.Put(const ItemArray: array of ICollectable): ICollection; +var + ResultCollection: ICollection; + Mappable: IIntegerMappable; + OldAssociation, NewAssociation: IIntegerAssociation; + Position: TCollectionPosition; + Item: ICollectable; + I: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + for I := Low(ItemArray) to High(ItemArray) do + begin + Item := ItemArray[I]; + if not IsNaturalItem(Item) then + begin + CollectionError(ceNotNaturalItem); + end + else + begin + Item.QueryInterface(IIntegerMappable, Mappable); + Position := GetKeyPosition(Mappable.GetKey); + try + NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + ResultCollection.Add(OldAssociation.GetValue); + finally + Position.Free; + end; + end; + end; + Result := ResultCollection; +end; + +function TAbstractIntegerMap.Put(const Collection: ICollection): ICollection; +var + ResultCollection: ICollection; + Mappable: IIntegerMappable; + OldAssociation, NewAssociation: IIntegerAssociation; + Position: TCollectionPosition; + Iterator: IIterator; + Item: ICollectable; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + Item := Iterator.CurrentItem;; + if not IsNaturalItem(Item) then + begin + CollectionError(ceNotNaturalItem); + end + else + begin + Item.QueryInterface(IIntegerMappable, Mappable); + Position := GetKeyPosition(Mappable.GetKey); + try + NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + ResultCollection.Add(OldAssociation.GetValue); + finally + Position.Free; + end; + end; + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractIntegerMap.Put(const Map: IIntegerMap): ICollection; +var + ResultCollection: ICollection; + OldAssociation, NewAssociation: IIntegerAssociation; + ItemError: TCollectionError; + Position: TCollectionPosition; + MapIterator: IIntegerMapIterator; + Item: ICollectable; + Key: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + MapIterator := Map.GetMapIterator; + while not MapIterator.EOF do + begin + Key := MapIterator.CurrentKey; + Item := MapIterator.CurrentItem; + + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + end + else + begin + Position := GetKeyPosition(Key); + try + NewAssociation := TIntegerAssociation.Create(Key, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + ResultCollection.Add(OldAssociation.GetValue); + finally + Position.Free; + end; + end; + MapIterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractIntegerMap.RemoveKey(const Key: Integer): ICollectable; +var + Position: TCollectionPosition; + OldAssociation: IIntegerAssociation; +begin + Position := GetKeyPosition(Key); + try + if Position.Found then + begin + OldAssociation := TrueRemove2(Position); + Result := OldAssociation.GetValue + end + else + Result := nil; + finally + Position.Free; + end; +end; + +function TAbstractIntegerMap.RemoveKey(const KeyArray: array of Integer): ICollection; +var + ResultCollection: ICollection; + OldAssociation: IIntegerAssociation; + Position: TCollectionPosition; + Key: Integer; + I: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + for I := Low(KeyArray) to High(KeyArray) do + begin + Key := KeyArray[I]; + Position := GetKeyPosition(Key); + try + if Position.Found then + begin + OldAssociation := TrueRemove2(Position); + ResultCollection.Add(OldAssociation.GetValue); + end; + finally + Position.Free; + end; + end; + Result := ResultCollection; +end; + +function TAbstractIntegerMap.RetainKey(const KeyArray: array of Integer): ICollection; +var + ResultCollection: ICollection; + MapIterator: IIntegerMapIterator; + I: Integer; + Found: Boolean; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + if FixedSize then + begin + CollectionError(ceFixedSize); + end + else + begin + MapIterator := GetMapIterator; + while not MapIterator.EOF do + begin + // Converting the array to a map would be faster but I don't want to + // couple base class code to a complex collection. + Found := false; + for I := Low(KeyArray) to High(KeyArray) do + begin + Found := (MapIterator.CurrentKey = KeyArray[I]); + if Found then + break; + end; + if not Found then + begin + ResultCollection.Add(MapIterator.CurrentItem); + MapIterator.Remove; + end; + MapIterator.Next; + end; + Result := ResultCollection; + end; +end; + + +{ TAbstractStringMap } +constructor TAbstractStringMap.Create(NaturalItemsOnly: Boolean); +begin + inherited Create(NaturalItemsOnly); + FAssociationComparator := TStringAssociationComparator.Create; +end; + +constructor TAbstractStringMap.Create(const ItemArray: array of ICollectable); +begin + Create(ItemArray, true); +end; + +constructor TAbstractStringMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); +begin + inherited Create(ItemArray, true); +end; + +constructor TAbstractStringMap.Create(const KeyArray: array of String; const ItemArray: array of ICollectable); +begin + Create(KeyArray, ItemArray, false); +end; + +constructor TAbstractStringMap.Create(const KeyArray: array of String; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); +var + I, Lo, Hi: Integer; +begin + Create(NaturalItemsOnly); + Capacity := Min(Length(KeyArray), Length(ItemArray)); + if not FixedSize then + begin + Lo := Max(Low(KeyArray), Low(ItemArray)); + Hi := Min(High(KeyArray), High(ItemArray)); + for I := Lo to Hi do + begin + Put(KeyArray[I], ItemArray[I]); + end; + end; +end; + +constructor TAbstractStringMap.Create(const Map: IStringMap); +var + MapIterator: IStringMapIterator; +begin + Create(Map.GetNaturalItemsOnly); + InitFrom(Map); + Capacity := Map.GetSize; + if not FixedSize then + begin + MapIterator := Map.GetMapIterator; + while not MapIterator.EOF do + begin + Put(MapIterator.CurrentKey, MapIterator.CurrentItem); + MapIterator.Next; + end; + end; +end; + +destructor TAbstractStringMap.Destroy; +begin + FAssociationComparator := nil; + inherited Destroy; +end; + +function TAbstractStringMap.TrueAdd(const Item: ICollectable): Boolean; +var + Position: TCollectionPosition; + Mappable: IStringMappable; +begin + if IsNaturalItem(Item) then + begin + Mappable := Item as IStringMappable; + Position := GetKeyPosition(Mappable.GetKey); + try + if Position.Found then + begin + CollectionError(ceDuplicateKey); + Result := false; + end + else + begin + TruePut(Position, TStringAssociation.Create(Mappable.GetKey, Item)); + Result := true; + end; + finally + Position.Free; + end; + end + else + begin + CollectionError(ceNotNaturalItem); + Result := false; + end; +end; + +function TAbstractStringMap.TrueContains(const Item: ICollectable): Boolean; +var + Item2: ICollectable; + Success: Boolean; + Iterator: IIterator; +begin + Iterator := GetIterator; + Success := false; + while not Iterator.EOF and not Success do + begin + Item2 := Iterator.CurrentItem; + if Comparator.Equals(Item, Item2) then + Success := true; + Iterator.Next; + end; + Result := Success; +end; + +function TAbstractStringMap.TrueRemove(const Item: ICollectable): ICollectable; +var + Item2: ICollectable; + Iterator: IStringMapIterator; + Found: Boolean; +begin + // Sequential search + Found := false; + Result := nil; + Iterator := GetAssociationIterator; + while not Iterator.EOF and not Found do + begin + Item2 := Iterator.CurrentItem; + if Comparator.Equals(Item, Item2) then + begin + Result := Item2; + Iterator.Remove; + Found := true; + end; + Iterator.Next; + end; +end; + +function TAbstractStringMap.TrueRemoveAll(const Item: ICollectable): ICollection; +var + ResultCollection: ICollection; + Item2: ICollectable; + Iterator: IIterator; +begin + // Sequential search + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := GetAssociationIterator; + while not Iterator.EOF do + begin + Item2 := Iterator.CurrentItem; + if Comparator.Equals(Item, Item2) then + begin + ResultCollection.Add(Item2); + Iterator.Remove; + end; + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractStringMap.GetItem(const Key: String): ICollectable; +begin + Result := Get(Key); +end; + +procedure TAbstractStringMap.SetItem(const Key: String; const Item: ICollectable); +begin + Put(Key, Item); +end; + +function TAbstractStringMap.GetIterator: IIterator; +begin + Result := GetAssociationIterator; +end; + +function TAbstractStringMap.GetKeys: ISet; +var + ResultCollection: TPArraySet; + MapIterator: IStringMapIterator; +begin + ResultCollection := TPArraySet.Create(true); + MapIterator := GetMapIterator; + while not MapIterator.EOF do + begin + ResultCollection.Add(TStringWrapper.Create(MapIterator.CurrentKey) as ICollectable); + MapIterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractStringMap.GetMapIterator: IStringMapIterator; +begin + Result := GetAssociationIterator; +end; + +function TAbstractStringMap.GetNaturalItemIID: TGUID; +begin + Result := StringMappableIID; +end; + +function TAbstractStringMap.GetType: TCollectionType; +begin + Result := ctStringMap; +end; + +function TAbstractStringMap.GetValues: ICollection; +var + ResultCollection: ICollection; + ValueIterator: IIterator; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + ValueIterator := GetIterator; + while not ValueIterator.EOF do + begin + ResultCollection.Add(ValueIterator.CurrentItem); + ValueIterator.Next; + end; + Result := ResultCollection; +end; + +// Overrides TAbstractCollection function, otherwise Create(ICollection) is +// called, which cannot access keys. +function TAbstractStringMap.Clone: ICollection; +begin + Result := (TAbstractStringMapClass(ClassType)).Create(Self); +end; + +function TAbstractStringMap.CloneAsStringMap: IStringMap; +begin + Result := (TAbstractStringMapClass(ClassType)).Create(Self); +end; + +function TAbstractStringMap.ContainsKey(const Key: String): Boolean; +var + Position: TCollectionPosition; +begin + Position := GetKeyPosition(Key); + try + Result := Position.Found; + finally + Position.Free; + end; +end; + +function TAbstractStringMap.ContainsKey(const KeyArray: array of String): Boolean; +var + I: Integer; + Success: Boolean; +begin + Success := true; + for I := Low(KeyArray) to High(KeyArray) do + begin + Success := Success and ContainsKey(KeyArray[I]); + if not Success then + break; + end; + Result := Success; +end; + +function TAbstractStringMap.Get(const Key: String): ICollectable; +var + Position: TCollectionPosition; +begin + Position := GetKeyPosition(Key); + try + if Position.Found then + Result := TrueGet(Position).GetValue + else + Result := nil; + finally + Position.Free; + end; +end; + +function TAbstractStringMap.IsNilAllowed: Boolean; +begin + Result := true; +end; + +function TAbstractStringMap.Put(const Item: ICollectable): ICollectable; +var + Mappable: IStringMappable; + OldAssociation, NewAssociation: IStringAssociation; + Position: TCollectionPosition; +begin + if not IsNaturalItem(Item) then + begin + CollectionError(ceNotNaturalItem); + Result := nil; + end + else + begin + Item.QueryInterface(IStringMappable, Mappable); + Position := GetKeyPosition(Mappable.GetKey); + try + NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + Result := OldAssociation.GetValue + else + Result := nil; + finally + Position.Free; + end; + end; +end; + +function TAbstractStringMap.Put(const Key: String; const Item: ICollectable): ICollectable; +var + OldAssociation, NewAssociation: IStringAssociation; + ItemError: TCollectionError; + Position: TCollectionPosition; +begin + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + Result := nil; + end + else + begin + Position := GetKeyPosition(Key); + try + NewAssociation := TStringAssociation.Create(Key, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + Result := OldAssociation.GetValue + else + Result := nil; + finally + Position.Free; + end; + end; +end; + +function TAbstractStringMap.Put(const ItemArray: array of ICollectable): ICollection; +var + ResultCollection: ICollection; + Mappable: IStringMappable; + OldAssociation, NewAssociation: IStringAssociation; + Position: TCollectionPosition; + Item: ICollectable; + I: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + for I := Low(ItemArray) to High(ItemArray) do + begin + Item := ItemArray[I]; + if not IsNaturalItem(Item) then + begin + CollectionError(ceNotNaturalItem); + end + else + begin + Item.QueryInterface(IStringMappable, Mappable); + Position := GetKeyPosition(Mappable.GetKey); + try + NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + ResultCollection.Add(OldAssociation.GetValue); + finally + Position.Free; + end; + end; + end; + Result := ResultCollection; +end; + +function TAbstractStringMap.Put(const Collection: ICollection): ICollection; +var + ResultCollection: ICollection; + Mappable: IStringMappable; + OldAssociation, NewAssociation: IStringAssociation; + Position: TCollectionPosition; + Iterator: IIterator; + Item: ICollectable; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + Iterator := Collection.GetIterator; + while not Iterator.EOF do + begin + Item := Iterator.CurrentItem;; + if not IsNaturalItem(Item) then + begin + CollectionError(ceNotNaturalItem); + end + else + begin + Item.QueryInterface(IStringMappable, Mappable); + Position := GetKeyPosition(Mappable.GetKey); + try + NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + ResultCollection.Add(OldAssociation.GetValue); + finally + Position.Free; + end; + end; + Iterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractStringMap.Put(const Map: IStringMap): ICollection; +var + ResultCollection: ICollection; + OldAssociation, NewAssociation: IStringAssociation; + ItemError: TCollectionError; + Position: TCollectionPosition; + MapIterator: IStringMapIterator; + Item: ICollectable; + Key: String; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + MapIterator := Map.GetMapIterator; + while not MapIterator.EOF do + begin + Key := MapIterator.CurrentKey; + Item := MapIterator.CurrentItem; + + ItemError := ItemAllowed(Item); + if ItemError <> ceOK then + begin + CollectionError(ItemError); + end + else + begin + Position := GetKeyPosition(Key); + try + NewAssociation := TStringAssociation.Create(Key, Item); + OldAssociation := TruePut(Position, NewAssociation); + if OldAssociation <> nil then + ResultCollection.Add(OldAssociation.GetValue); + finally + Position.Free; + end; + end; + MapIterator.Next; + end; + Result := ResultCollection; +end; + +function TAbstractStringMap.RemoveKey(const Key: String): ICollectable; +var + Position: TCollectionPosition; + OldAssociation: IStringAssociation; +begin + Position := GetKeyPosition(Key); + try + if Position.Found then + begin + OldAssociation := TrueRemove2(Position); + Result := OldAssociation.GetValue + end + else + Result := nil; + finally + Position.Free; + end; +end; + +function TAbstractStringMap.RemoveKey(const KeyArray: array of String): ICollection; +var + ResultCollection: ICollection; + OldAssociation: IStringAssociation; + Position: TCollectionPosition; + Key: String; + I: Integer; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + for I := Low(KeyArray) to High(KeyArray) do + begin + Key := KeyArray[I]; + Position := GetKeyPosition(Key); + try + if Position.Found then + begin + OldAssociation := TrueRemove2(Position); + ResultCollection.Add(OldAssociation.GetValue); + end; + finally + Position.Free; + end; + end; + Result := ResultCollection; +end; + +function TAbstractStringMap.RetainKey(const KeyArray: array of String): ICollection; +var + ResultCollection: ICollection; + MapIterator: IStringMapIterator; + I: Integer; + Found: Boolean; +begin + ResultCollection := TPArrayBag.Create(NaturalItemsOnly); + if FixedSize then + begin + CollectionError(ceFixedSize); + end + else + begin + MapIterator := GetMapIterator; + while not MapIterator.EOF do + begin + // Converting the array to a map would be faster but I don't want to + // couple base class code to a complex collection. + Found := false; + for I := Low(KeyArray) to High(KeyArray) do + begin + Found := (MapIterator.CurrentKey = KeyArray[I]); + if Found then + break; + end; + if not Found then + begin + ResultCollection.Add(MapIterator.CurrentItem); + MapIterator.Remove; + end; + MapIterator.Next; + end; + Result := ResultCollection; + end; +end; + + +{ ECollectionError } +constructor ECollectionError.Create(const Msg: String; const Collection: ICollection; ErrorType: TCollectionError); +begin + inherited Create(Msg); + FCollection := Collection; + FErrorType := ErrorType; +end; + +{ TAbstractListIterator } +constructor TAbstractListIterator.Create(Collection: TAbstractList); +begin + inherited Create(true); + FCollection := Collection; + First; +end; + +function TAbstractListIterator.TrueFirst: ICollectable; +begin + FIndex := 0; + if FIndex < FCollection.GetSize then + Result := FCollection.GetItem(FIndex) + else + Result := nil; +end; + +function TAbstractListIterator.TrueNext: ICollectable; +begin + Inc(FIndex); + if FIndex < FCollection.GetSize then + Result := FCollection.GetItem(FIndex) + else + Result := nil; +end; + +procedure TAbstractListIterator.TrueRemove; +begin + FCollection.Delete(FIndex); + Dec(FIndex); +end; + +end. diff --git a/unicode/src/lib/collections/readme.txt b/unicode/src/lib/collections/readme.txt new file mode 100644 index 00000000..1f6477de --- /dev/null +++ b/unicode/src/lib/collections/readme.txt @@ -0,0 +1,14 @@ +Delphi Collections by Matthew Greet +http://www.warmachine.u-net.com/delphi_collections/ + +Help files (MS .hlp format) at +http://www.warmachine.u-net.com/downloads/delphi_collections_1_0_help.zip + +Changes +===================== +2008-11-06 FPC compatibility fixes by UltraStar Deluxe Team +2005-03-14 Maintenance release v1.0.5 - bug fix for sorted lists and functional tests checks unsorted and sorted lists. +2004-10-14 Maintenance release v1.0.4 - memory leak fixed. +2004-06-12 Maintenance release v1.0.3 - memory leak fixed, memory leak test, new Capacity property. +2004-02-13 Maintenance release v1.0.2 - expanded introduction and quick start sections in help file. +2003-10-25 Maintenance release v1.0.1 - packages and test harness no longer list unused packages.
\ No newline at end of file diff --git a/unicode/src/lib/ffmpeg/avcodec.pas b/unicode/src/lib/ffmpeg/avcodec.pas index 0954ee06..6039835c 100644 --- a/unicode/src/lib/ffmpeg/avcodec.pas +++ b/unicode/src/lib/ffmpeg/avcodec.pas @@ -27,7 +27,7 @@ (* * Conversion of libavcodec/avcodec.h * Min. version: 51.16.0, revision 6577, Sat Oct 7 15:30:46 2006 UTC - * Max. version: 52.0.0, revision 15448, Sun Sep 28 19:11:26 2008 UTC + * Max. version: 52.11.0, revision 16912, Sun Feb 1 02:00:19 2009 UTC *) unit avcodec; @@ -51,6 +51,7 @@ uses avutil, rational, opt, + SysUtils, {$IFDEF UNIX} BaseUnix, {$ENDIF} @@ -59,7 +60,7 @@ uses const (* Max. supported version by this header *) LIBAVCODEC_MAX_VERSION_MAJOR = 52; - LIBAVCODEC_MAX_VERSION_MINOR = 0; + LIBAVCODEC_MAX_VERSION_MINOR = 11; LIBAVCODEC_MAX_VERSION_RELEASE = 0; LIBAVCODEC_MAX_VERSION = (LIBAVCODEC_MAX_VERSION_MAJOR * VERSION_MAJOR) + (LIBAVCODEC_MAX_VERSION_MINOR * VERSION_MINOR) + @@ -231,6 +232,7 @@ type CODEC_ID_CMV, CODEC_ID_MOTIONPIXELS, CODEC_ID_TGV, + CODEC_ID_TGQ, //* various PCM "codecs" */ CODEC_ID_PCM_S16LE= $10000, @@ -286,6 +288,7 @@ type CODEC_ID_ADPCM_IMA_EA_EACS, CODEC_ID_ADPCM_EA_XAS, CODEC_ID_ADPCM_EA_MAXIS_XA, + CODEC_ID_ADPCM_IMA_ISS, //* AMR */ CODEC_ID_AMR_NB= $12000, @@ -350,6 +353,7 @@ type CODEC_ID_ATRAC3P, CODEC_ID_EAC3, CODEC_ID_SIPR, + CODEC_ID_MP1, //* subtitle codecs */ CODEC_ID_DVD_SUBTITLE= $17000, @@ -403,6 +407,43 @@ type _TSampleFormatArray = array [0 .. MaxInt div SizeOf(TSampleFormat)-1] of TSampleFormat; PSampleFormatArray = ^_TSampleFormatArray; +const + {* Audio channel masks *} + CH_FRONT_LEFT = $00000001; + CH_FRONT_RIGHT = $00000002; + CH_FRONT_CENTER = $00000004; + CH_LOW_FREQUENCY = $00000008; + CH_BACK_LEFT = $00000010; + CH_BACK_RIGHT = $00000020; + CH_FRONT_LEFT_OF_CENTER = $00000040; + CH_FRONT_RIGHT_OF_CENTER = $00000080; + CH_BACK_CENTER = $00000100; + CH_SIDE_LEFT = $00000200; + CH_SIDE_RIGHT = $00000400; + CH_TOP_CENTER = $00000800; + CH_TOP_FRONT_LEFT = $00001000; + CH_TOP_FRONT_CENTER = $00002000; + CH_TOP_FRONT_RIGHT = $00004000; + CH_TOP_BACK_LEFT = $00008000; + CH_TOP_BACK_CENTER = $00010000; + CH_TOP_BACK_RIGHT = $00020000; + CH_STEREO_LEFT = $20000000; ///< Stereo downmix. + CH_STEREO_RIGHT = $40000000; ///< See CH_STEREO_LEFT. + + {* Audio channel convenience macros *} + CH_LAYOUT_MONO = (CH_FRONT_CENTER); + CH_LAYOUT_STEREO = (CH_FRONT_LEFT or CH_FRONT_RIGHT); + CH_LAYOUT_SURROUND = (CH_LAYOUT_STEREO or CH_FRONT_CENTER); + CH_LAYOUT_QUAD = (CH_LAYOUT_STEREO or CH_BACK_LEFT or CH_BACK_RIGHT); + CH_LAYOUT_5POINT0 = (CH_LAYOUT_SURROUND or CH_SIDE_LEFT or CH_SIDE_RIGHT); + CH_LAYOUT_5POINT1 = (CH_LAYOUT_5POINT0 or CH_LOW_FREQUENCY); + CH_LAYOUT_7POINT1 = (CH_LAYOUT_5POINT1 or CH_BACK_LEFT or CH_BACK_RIGHT); + CH_LAYOUT_7POINT1_WIDE = (CH_LAYOUT_SURROUND or CH_LOW_FREQUENCY or + CH_BACK_LEFT or CH_BACK_RIGHT or + CH_FRONT_LEFT_OF_CENTER or CH_FRONT_RIGHT_OF_CENTER); + CH_LAYOUT_STEREO_DOWNMIX = (CH_STEREO_LEFT or CH_STEREO_RIGHT); + + const {* in bytes *} AVCODEC_MAX_AUDIO_FRAME_SIZE = 192000; // 1 second of 48khz 32bit audio @@ -559,6 +600,11 @@ const *) CODEC_CAP_SMALL_LAST_FRAME = $0040; + (** + * Codec can export data for HW decoding (VDPAU). + *) + CODEC_CAP_HWACCEL_VDPAU = $0080; + //the following defines may change, don't expect compatibility if you use them MB_TYPE_INTRA4x4 = $001; MB_TYPE_INTRA16x16 = $002; //FIXME h264 specific @@ -850,6 +896,38 @@ type *) bits_per_raw_sample: cint; {$IFEND} + + {$IF LIBAVCODEC_VERSION >= 52002000} // 52.2.0 + (** + * Audio channel layout. + * - encoding: set by user. + * - decoding: set by libavcodec. + *) + channel_layout: cint64; + + (** + * Request decoder to use this channel layout if it can (0 for default) + * - encoding: unused + * - decoding: Set by user. + *) + request_channel_layout: cint64; + {$IFEND} + + {$IF LIBAVCODEC_VERSION >= 52004000} // 52.4.0 + (** + * Ratecontrol attempt to use, at maximum, <value> of what can be used without an underflow. + * - encoding: Set by user. + * - decoding: unused. + *) + rc_max_available_vbv_use: cfloat; + + (** + * Ratecontrol attempt to use, at least, <value> times the amount needed to prevent a vbv overflow. + * - encoding: Set by user. + * - decoding: unused. + *) + rc_min_vbv_overflow_use: cfloat; + {$IFEND} end; const @@ -918,21 +996,25 @@ const FF_IDCT_SIMPLEVIS = 18; FF_IDCT_WMV2 = 19; FF_IDCT_FAAN = 20; + FF_IDCT_EA = 21; + FF_IDCT_SIMPLENEON = 22; + FF_IDCT_SIMPLEALPHA = 23; FF_EC_GUESS_MVS = 1; FF_EC_DEBLOCK = 2; - FF_MM_FORCE = $80000000; (* force usage of selected flags (OR) *) + FF_MM_FORCE = $80000000; (* force usage of selected flags (OR) *) (* lower 16 bits - CPU features *) - FF_MM_MMX = $0001; ///< standard MMX - FF_MM_3DNOW = $0004; ///< AMD 3DNOW - FF_MM_MMXEXT = $0002; ///< SSE integer functions or AMD MMX ext - FF_MM_SSE = $0008; ///< SSE functions - FF_MM_SSE2 = $0010; ///< PIV SSE2 functions - FF_MM_3DNOWEXT = $0020; ///< AMD 3DNowExt + FF_MM_MMX = $0001; ///< standard MMX + FF_MM_3DNOW = $0004; ///< AMD 3DNOW + FF_MM_MMXEXT = $0002; ///< SSE integer functions or AMD MMX ext + FF_MM_SSE = $0008; ///< SSE functions + FF_MM_SSE2 = $0010; ///< PIV SSE2 functions + FF_MM_3DNOWEXT = $0020; ///< AMD 3DNowExt FF_MM_SSE3 = $0040; ///< Prescott SSE3 functions FF_MM_SSSE3 = $0080; ///< Conroe SSSE3 functions - FF_MM_IWMMXT = $0100; ///< XScale IWMMXT + FF_MM_IWMMXT = $0100; ///< XScale IWMMXT + FF_MM_ALTIVEC = $0001; ///< standard AltiVec FF_PRED_LEFT = 0; FF_PRED_PLANE = 1; @@ -1066,13 +1148,13 @@ type // int (*func)(struct AVCodecContext *c2, void *arg) TExecuteFunc = function(c2: PAVCodecContext; arg: Pointer): cint; cdecl; - TAVClass = record {12} - class_name: pchar; + TAVClass = record + class_name: PAnsiChar; (* actually passing a pointer to an AVCodecContext - or AVFormatContext, which begin with an AVClass. - Needed because av_log is in libavcodec and has no visibility - of AVIn/OutputFormat *) - item_name: function (): pchar; cdecl; + or AVFormatContext, which begin with an AVClass. + Needed because av_log is in libavcodec and has no visibility + of AVIn/OutputFormat *) + item_name: function(): PAnsiChar; cdecl; option: PAVOption; end; @@ -1334,7 +1416,7 @@ type *) opaque: pointer; - codec_name: array [0..31] of char; + codec_name: array [0..31] of AnsiChar; codec_type: TCodecType; (* see CODEC_TYPE_xxx *) codec_id: TCodecID; (* see CODEC_ID_xxx *) @@ -1451,7 +1533,7 @@ type * - encoding: Set by libavcodec. * - decoding: unused *) - stats_out: pchar; + stats_out: PByteArray; (** * pass2 encoding statistics input buffer @@ -1459,7 +1541,7 @@ type * - encoding: Allocated/set/freed by user. * - decoding: unused *) - stats_in: pchar; + stats_in: PByteArray; (** * ratecontrol qmin qmax limiting method @@ -1485,7 +1567,7 @@ type * - encoding: Set by user * - decoding: unused *) - rc_eq: {const} pchar; + rc_eq: {const} PByteArray; (** * maximum bitrate @@ -1886,7 +1968,7 @@ type * - encoding: unused * - decoding: Set by user, will be converted to uppercase by libavcodec during init. *) - stream_codec_tag: array [0..3] of char; //cuint; + stream_codec_tag: array [0..3] of AnsiChar; //cuint; (** * scene change detection threshold @@ -1994,7 +2076,11 @@ type * - encoding: Set by libavcodec, user can override. * - decoding: Set by libavcodec, user can override. *) + {$IF LIBAVCODEC_VERSION < 52004000} // < 52.4.0 execute: function (c: PAVCodecContext; func: TExecuteFunc; arg: PPointer; ret: PCint; count: cint): cint; cdecl; + {$ELSE} + execute: function (c: PAVCodecContext; func: TExecuteFunc; arg: Pointer; ret: PCint; count: cint; size: cint): cint; cdecl; + {$IFEND} (** * thread opaque @@ -2197,7 +2283,7 @@ type (** * number of reference frames * - encoding: Set by user. - * - decoding: unused + * - decoding: Set by lavc. *) refs: cint; @@ -2349,13 +2435,16 @@ type {$IFEND} {$IF LIBAVCODEC_VERSION >= 51042000} // 51.42.0 + {$IF LIBAVCODEC_MAX_VERSION_MAJOR < 53} (** * Decoder should decode to this many channels if it can (0 for default) * - encoding: unused * - decoding: Set by user. + * @deprecated Deprecated in favor of request_channel_layout. *) request_channels: cint; {$IFEND} + {$IFEND} {$IF LIBAVCODEC_VERSION > 51049000} // > 51.49.0 (** @@ -2382,15 +2471,15 @@ type * AVCodec. *) TAVCodec = record - name: pchar; + name: PAnsiChar; type_: TCodecType; id: TCodecID; priv_data_size: cint; init: function (avctx: PAVCodecContext): cint; cdecl; (* typo corretion by the Creative CAT *) - encode: function (avctx: PAVCodecContext; buf: pchar; buf_size: cint; data: pointer): cint; cdecl; + encode: function (avctx: PAVCodecContext; buf: PByteArray; buf_size: cint; data: pointer): cint; cdecl; close: function (avctx: PAVCodecContext): cint; cdecl; decode: function (avctx: PAVCodecContext; outdata: pointer; var outdata_size: cint; - buf: {const} pchar; buf_size: cint): cint; cdecl; + buf: {const} PByteArray; buf_size: cint): cint; cdecl; (** * Codec capabilities. * see CODEC_CAP_* @@ -2409,7 +2498,7 @@ type * Descriptive name for the codec, meant to be more human readable than \p name. * You \e should use the NULL_IF_CONFIG_SMALL() macro to define it. *) - long_name: {const} PChar; + long_name: {const} PAnsiChar; {$IFEND} {$IF LIBAVCODEC_VERSION >= 51056000} // 51.56.0 supported_samplerates: {const} PCint; ///< array of supported audio samplerates, or NULL if unknown, array is terminated by 0 @@ -2417,6 +2506,9 @@ type {$IF LIBAVCODEC_VERSION >= 51062000} // 51.62.0 sample_fmts: {const} PSampleFormatArray; ///< array of supported sample formats, or NULL if unknown, array is terminated by -1 {$IFEND} + {$IF LIBAVCODEC_VERSION >= 52002000} // 52.2.0 + channel_layouts: {const} PCint64; ///< array of support channel layouts, or NULL if unknown. array is terminated by 0 + {$IFEND} end; (** @@ -2425,30 +2517,81 @@ type *) PAVPicture = ^TAVPicture; TAVPicture = record - data: array [0..3] of pchar; + data: array [0..3] of PByteArray; linesize: array [0..3] of cint; ///< number of bytes per line end; type + TAVSubtitleType = ( + SUBTITLE_NONE, + + SUBTITLE_BITMAP, ///< A bitmap, pict will be set + + (** + * Plain text, the text field must be set by the decoder and is + * authoritative. ass and pict fields may contain approximations. + *) + SUBTITLE_TEXT, + + (** + * Formatted text, the ass field must be set by the decoder and is + * authoritative. pict and text fields may contain approximations. + *) + SUBTITLE_ASS + ); + +type + PPAVSubtitleRect = ^PAVSubtitleRect; PAVSubtitleRect = ^TAVSubtitleRect; + {$IF LIBAVCODEC_VERSION < 52010000} // < 52.10.0 TAVSubtitleRect = record - x: word; - y: word; - w: word; - h: word; - nb_colors: word; + x: cuint16; + y: cuint16; + w: cuint16; + h: cuint16; + nb_colors: cuint16; linesize: cint; - rgba_palette: PCuint; - bitmap: pchar; + rgba_palette: PCuint32; + bitmap: PCuint8; + end; + {$ELSE} + TAVSubtitleRect = record + x: cint; ///< top left corner of pict, undefined when pict is not set + y: cint; ///< top left corner of pict, undefined when pict is not set + w: cint; ///< width of pict, undefined when pict is not set + h: cint; ///< height of pict, undefined when pict is not set + nb_colors: cint; ///< number of colors in pict, undefined when pict is not set + + (** + * data+linesize for the bitmap of this subtitle. + * can be set for text/ass as well once they where rendered + *) + pict: TAVPicture; + type_: TAVSubtitleType; + + text: PAnsiChar; ///< 0 terminated plain UTF-8 text + + (** + * 0 terminated ASS/SSA compatible event line. + * The pressentation of this is unaffected by the other values in this + * struct. + *) + ass: PByteArray; end; + {$IFEND} + PPAVSubtitle = ^PAVSubtitle; PAVSubtitle = ^TAVSubtitle; - TAVSubtitle = record {20} - format: word; (* 0 = graphics *) - start_display_time: cuint; (* relative to packet pts, in ms *) - end_display_time: cuint; (* relative to packet pts, in ms *) + TAVSubtitle = record + format: cuint16; (* 0 = graphics *) + start_display_time: cuint32; (* relative to packet pts, in ms *) + end_display_time: cuint32; (* relative to packet pts, in ms *) num_rects: cuint; + {$IF LIBAVCODEC_VERSION < 52010000} // < 52.10.0 rects: PAVSubtitleRect; + {$ELSE} + rects: PPAVSubtitleRect; + {$IFEND} end; @@ -2563,7 +2706,7 @@ function avpicture_fill (picture: PAVPicture; ptr: pointer; function avpicture_layout (src: {const} PAVPicture; pix_fmt: TAVPixelFormat; width: cint; height: cint; - dest: pchar; dest_size: cint): cint; + dest: PByteArray; dest_size: cint): cint; cdecl; external av__codec; (** @@ -2581,13 +2724,13 @@ function avpicture_get_size (pix_fmt: TAVPixelFormat; width: cint; height: cint) procedure avcodec_get_chroma_sub_sample (pix_fmt: TAVPixelFormat; var h_shift: cint; var v_shift: cint); cdecl; external av__codec; -function avcodec_get_pix_fmt_name(pix_fmt: TAVPixelFormat): pchar; +function avcodec_get_pix_fmt_name(pix_fmt: TAVPixelFormat): PAnsiChar; cdecl; external av__codec; procedure avcodec_set_dimensions(s: PAVCodecContext; width: cint; height: cint); cdecl; external av__codec; -function avcodec_get_pix_fmt(name: {const} pchar): TAVPixelFormat; +function avcodec_get_pix_fmt(name: {const} PAnsiChar): TAVPixelFormat; cdecl; external av__codec; function avcodec_pix_fmt_to_codec_tag(p: TAVPixelFormat): cuint; @@ -2665,7 +2808,7 @@ function avcodec_find_best_pix_fmt(pix_fmt_mask: cint; src_pix_fmt: TAVPixelForm * a negative value to print the corresponding header. * Meaningful values for obtaining a pixel format info vary from 0 to PIX_FMT_NB -1. *) -procedure avcodec_pix_fmt_string (buf: PChar; buf_size: cint; pix_fmt: cint); +procedure avcodec_pix_fmt_string (buf: PAnsiChar; buf_size: cint; pix_fmt: cint); cdecl; external av__codec; {$IFEND} @@ -2734,7 +2877,12 @@ function avcodec_build(): cuint; procedure avcodec_init(); cdecl; external av__codec; -procedure register_avcodec(format: PAVCodec); +(** + * Register the codec \p codec and initialize libavcodec. + * + * @see avcodec_init() + *) +procedure register_avcodec(codec: PAVCodec); cdecl; external av__codec; (** @@ -2752,7 +2900,7 @@ function avcodec_find_encoder(id: TCodecID): PAVCodec; * @param name name of the requested encoder * @return An encoder if one was found, NULL otherwise. *) -function avcodec_find_encoder_by_name(name: pchar): PAVCodec; +function avcodec_find_encoder_by_name(name: PAnsiChar): PAVCodec; cdecl; external av__codec; (** @@ -2770,9 +2918,9 @@ function avcodec_find_decoder(id: TCodecID): PAVCodec; * @param name name of the requested decoder * @return A decoder if one was found, NULL otherwise. *) -function avcodec_find_decoder_by_name(name: pchar): PAVCodec; +function avcodec_find_decoder_by_name(name: PAnsiChar): PAVCodec; cdecl; external av__codec; -procedure avcodec_string(buf: pchar; buf_size: cint; enc: PAVCodecContext; encode: cint); +procedure avcodec_string(buf: PAnsiChar; buf_size: cint; enc: PAVCodecContext; encode: cint); cdecl; external av__codec; (** @@ -2851,10 +2999,23 @@ function avcodec_thread_init(s: PAVCodecContext; thread_count: cint): cint; cdecl; external av__codec; procedure avcodec_thread_free(s: PAVCodecContext); cdecl; external av__codec; + + +{$IF LIBAVCODEC_VERSION < 52004000} // < 52.4.0 function avcodec_thread_execute(s: PAVCodecContext; func: TExecuteFunc; arg: PPointer; var ret: cint; count: cint): cint; cdecl; external av__codec; +{$ELSE} +function avcodec_thread_execute(s: PAVCodecContext; func: TExecuteFunc; arg: Pointer; var ret: cint; count: cint; size: cint): cint; + cdecl; external av__codec; +{$IFEND} + +{$IF LIBAVCODEC_VERSION < 52004000} // < 52.4.0 function avcodec_default_execute(s: PAVCodecContext; func: TExecuteFunc; arg: PPointer; var ret: cint; count: cint): cint; cdecl; external av__codec; +{$ELSE} +function avcodec_default_execute(s: PAVCodecContext; func: TExecuteFunc; arg: Pointer; var ret: cint; count: cint; size: cint): cint; + cdecl; external av__codec; +{$IFEND} //FIXME func typedef (** @@ -2893,7 +3054,7 @@ function avcodec_open(avctx: PAVCodecContext; codec: PAVCodec): cint; *) function avcodec_decode_audio(avctx: PAVCodecContext; samples: PSmallint; var frame_size_ptr: cint; - buf: {const} pchar; buf_size: cint): cint; + buf: {const} PByteArray; buf_size: cint): cint; cdecl; external av__codec; {$IFEND} @@ -2926,6 +3087,9 @@ function avcodec_decode_audio(avctx: PAVCodecContext; samples: PSmallint; * the linesize is not a multiple of 16 then there's no sense in aligning the * start of the buffer to 16. * + * @note Some codecs have a delay between input and output, these need to be + * feeded with buf=NULL, buf_size=0 at the end to return the remaining frames. + * * @param avctx the codec context * @param[out] samples the output buffer * @param[in,out] frame_size_ptr the output buffer size in bytes @@ -2936,7 +3100,7 @@ function avcodec_decode_audio(avctx: PAVCodecContext; samples: PSmallint; *) function avcodec_decode_audio2(avctx: PAVCodecContext; samples: PSmallint; var frame_size_ptr: cint; - buf: {const} pchar; buf_size: cint): cint; + buf: {const} PByteArray; buf_size: cint): cint; cdecl; external av__codec; {$IFEND} @@ -2973,7 +3137,7 @@ function avcodec_decode_audio2(avctx: PAVCodecContext; samples: PSmallint; *) function avcodec_decode_video(avctx: PAVCodecContext; picture: PAVFrame; var got_picture_ptr: cint; - buf: {const} PChar; buf_size: cint): cint; + buf: {const} PByteArray; buf_size: cint): cint; cdecl; external av__codec; (* Decode a subtitle message. Return -1 if error, otherwise return the @@ -2981,11 +3145,11 @@ function avcodec_decode_video(avctx: PAVCodecContext; picture: PAVFrame; * got_sub_ptr is zero. Otherwise, the subtitle is stored in *sub. *) function avcodec_decode_subtitle(avctx: PAVCodecContext; sub: PAVSubtitle; var got_sub_ptr: cint; - buf: {const} pchar; buf_size: cint): cint; + buf: {const} PByteArray; buf_size: cint): cint; cdecl; external av__codec; function avcodec_parse_frame(avctx: PAVCodecContext; pdata: PPointer; data_size_ptr: PCint; - buf: pchar; buf_size: cint): cint; + buf: PByteArray; buf_size: cint): cint; cdecl; external av__codec; (** @@ -3025,18 +3189,28 @@ function avcodec_encode_audio(avctx: PAVCodecContext; buf: PByte; * @param[in] buf_size the size of the output buffer in bytes * @param[in] pict the input picture to encode * @return On error a negative value is returned, on success zero or the number - * of bytes used from the input buffer. + * of bytes used from the output buffer. *) function avcodec_encode_video(avctx: PAVCodecContext; buf: PByte; buf_size: cint; pict: PAVFrame): cint; cdecl; external av__codec; -function avcodec_encode_subtitle(avctx: PAVCodecContext; buf: pchar; +function avcodec_encode_subtitle(avctx: PAVCodecContext; buf: PByteArray; buf_size: cint; sub: {const} PAVSubtitle): cint; cdecl; external av__codec; function avcodec_close(avctx: PAVCodecContext): cint; cdecl; external av__codec; +(** + * Register all the codecs, parsers and bitstream filters which were enabled at + * configuration time. If you do not call this function you can select exactly + * which formats you want to support, by using the individual registration + * functions. + * + * @see register_avcodec + * @see av_register_codec_parser + * @see av_register_bitstream_filter + *) procedure avcodec_register_all(); cdecl; external av__codec; @@ -3057,7 +3231,7 @@ procedure avcodec_default_free_buffers(s: PAVCodecContext); * @param[in] pict_type the picture type * @return A single character representing the picture type. *) -function av_get_pict_type_char(pict_type: cint): char; +function av_get_pict_type_char(pict_type: cint): AnsiChar; cdecl; external av__codec; (** @@ -3127,9 +3301,9 @@ type parser_init: function(s: PAVCodecParserContext): cint; cdecl; parser_parse: function(s: PAVCodecParserContext; avctx: PAVCodecContext; poutbuf: {const} PPointer; poutbuf_size: PCint; - buf: {const} pchar; buf_size: cint): cint; cdecl; + buf: {const} PByteArray; buf_size: cint): cint; cdecl; parser_close: procedure(s: PAVCodecParserContext); cdecl; - split: function(avctx: PAVCodecContext; buf: {const} pchar; + split: function(avctx: PAVCodecContext; buf: {const} PByteArray; buf_size: cint): cint; cdecl; next: PAVCodecParser; end; @@ -3156,13 +3330,13 @@ function av_parser_init(codec_id: cint): PAVCodecParserContext; function av_parser_parse(s: PAVCodecParserContext; avctx: PAVCodecContext; poutbuf: PPointer; poutbuf_size: PCint; - buf: {const} pchar; buf_size: cint; + buf: {const} PByteArray; buf_size: cint; pts: cint64; dts: cint64): cint; cdecl; external av__codec; function av_parser_change(s: PAVCodecParserContext; avctx: PAVCodecContext; poutbuf: PPointer; poutbuf_size: PCint; - buf: {const} pchar; buf_size: cint; keyframe: cint): cint; + buf: {const} PByteArray; buf_size: cint; keyframe: cint): cint; cdecl; external av__codec; procedure av_parser_close(s: PAVCodecParserContext); cdecl; external av__codec; @@ -3179,10 +3353,10 @@ type end; TAVBitStreamFilter = record - name: pchar; + name: PAnsiChar; priv_data_size: cint; filter: function(bsfc: PAVBitStreamFilterContext; - avctx: PAVCodecContext; args: pchar; + avctx: PAVCodecContext; args: PByteArray; poutbuf: PPointer; poutbuf_size: PCint; buf: PByte; buf_size: cint; keyframe: cint): cint; cdecl; {$IF LIBAVCODEC_VERSION >= 51043000} // 51.43.0 @@ -3194,11 +3368,11 @@ type procedure av_register_bitstream_filter(bsf: PAVBitStreamFilter); cdecl; external av__codec; -function av_bitstream_filter_init(name: pchar): PAVBitStreamFilterContext; +function av_bitstream_filter_init(name: PAnsiChar): PAVBitStreamFilterContext; cdecl; external av__codec; function av_bitstream_filter_filter(bsfc: PAVBitStreamFilterContext; - avctx: PAVCodecContext; args: pchar; + avctx: PAVCodecContext; args: PByteArray; poutbuf: PPointer; poutbuf_size: PCint; buf: PByte; buf_size: cint; keyframe: cint): cint; cdecl; external av__codec; @@ -3317,7 +3491,7 @@ function av_xiphlacing(s: PByte; v: cuint): cuint; * @param[in,out] height_ptr pointer to the variable which will contain the detected * frame height value *) -function av_parse_video_frame_size(width_ptr: PCint; height_ptr: PCint; str: {const} PChar): cint; +function av_parse_video_frame_size(width_ptr: PCint; height_ptr: PCint; str: {const} PAnsiChar): cint; cdecl; external av__codec; (** @@ -3329,22 +3503,7 @@ function av_parse_video_frame_size(width_ptr: PCint; height_ptr: PCint; str: {co * @param[in,out] frame_rate pointer to the AVRational which will contain the detected * frame rate *) -function av_parse_video_frame_rate(frame_rate: PAVRational; str: {const} PChar): cint; - cdecl; external av__codec; -{$IFEND} - -{$IF LIBAVCODEC_VERSION >= 51064000} // 51.64.0 -(** - * Logs a generic warning message about a missing feature. - * @param[in] avc a pointer to an arbitrary struct of which the first field is - * a pointer to an AVClass struct - * @param[in] feature string containing the name of the missing feature - * @param[in] want_sample indicates if samples are wanted which exhibit this feature. - * If \p want_sample is non-zero, additional verbage will be added to the log - * message which tells the user how to report samples to the development - * mailing list. - *) -procedure av_log_missing_feature(avc: Pointer; feature: {const} PChar; want_sample: cint); +function av_parse_video_frame_rate(frame_rate: PAVRational; str: {const} PAnsiChar): cint; cdecl; external av__codec; {$IFEND} diff --git a/unicode/src/lib/ffmpeg/avformat.pas b/unicode/src/lib/ffmpeg/avformat.pas index c516aea0..62df8a83 100644 --- a/unicode/src/lib/ffmpeg/avformat.pas +++ b/unicode/src/lib/ffmpeg/avformat.pas @@ -27,7 +27,7 @@ (* * Conversion of libavformat/avformat.h * Min. version: 50.5.0 , revision 6577, Sat Oct 7 15:30:46 2006 UTC - * Max. version: 52.22.1, revision 15441, Sat Sep 27 20:05:12 2008 UTC + * Max. version: 52.25.0, revision 16986, Wed Feb 4 05:56:39 2009 UTC *) unit avformat; @@ -54,13 +54,14 @@ uses avutil, avio, rational, + SysUtils, UConfig; const (* Max. supported version by this header *) LIBAVFORMAT_MAX_VERSION_MAJOR = 52; - LIBAVFORMAT_MAX_VERSION_MINOR = 22; - LIBAVFORMAT_MAX_VERSION_RELEASE = 1; + LIBAVFORMAT_MAX_VERSION_MINOR = 25; + LIBAVFORMAT_MAX_VERSION_RELEASE = 0; LIBAVFORMAT_MAX_VERSION = (LIBAVFORMAT_MAX_VERSION_MAJOR * VERSION_MAJOR) + (LIBAVFORMAT_MAX_VERSION_MINOR * VERSION_MINOR) + (LIBAVFORMAT_MAX_VERSION_RELEASE * VERSION_RELEASE); @@ -95,6 +96,68 @@ function avformat_version(): cuint; type PAVFile = Pointer; +(* + * Public Metadata API. + * !!WARNING!! This is a work in progress. Don't use outside FFmpeg for now. + * The metadata API allows libavformat to export metadata tags to a client + * application using a sequence of key/value pairs. + * Important concepts to keep in mind: + * 1. Keys are unique; there can never be 2 tags with the same key. This is + * also meant semantically, i.e., a demuxer should not knowingly produce + * several keys that are literally different but semantically identical. + * E.g., key=Author5, key=Author6. In this example, all authors must be + * placed in the same tag. + * 2. Metadata is flat, not hierarchical; there are no subtags. If you + * want to store, e.g., the email address of the child of producer Alice + * and actor Bob, that could have key=alice_and_bobs_childs_email_address. + * 3. A tag whose value is localized for a particular language is appended + * with a dash character ('-') and the ISO 639 3-letter language code. + * For example: Author-ger=Michael, Author-eng=Mike + * The original/default language is in the unqualified "Author" tag. + * A demuxer should set a default if it sets any translated tag. + *) +const + AV_METADATA_MATCH_CASE = 1; + AV_METADATA_IGNORE_SUFFIX = 2; + +type + PAVMetadataTag = ^TAVMetadataTag; + TAVMetadataTag = record + key: PAnsiChar; + value: PAnsiChar; + end; + + PAVMetadata = Pointer; + +{$IF LIBAVFORMAT_VERSION > 52024001} // > 52.24.1 + +(** + * gets a metadata element with matching key. + * @param prev set to the previous matching element to find the next. + * @param flags allows case as well as suffix insensitive comparisons. + * @return found tag or NULL, changing key or value leads to undefined behavior. + *) +function av_metadata_get(m: PAVMetadata; key: {const} PAnsiChar; + prev: {const} PAVMetadataTag ; flags: cint): PAVMetadataTag; + cdecl; external av__format; + +(** + * sets the given tag in m, overwriting an existing tag. + * @param key tag key to add to m (will be av_strduped). + * @param value tag value to add to m (will be av_strduped). + * @return >= 0 if success otherwise error code that is <0. + *) +function av_metadata_set(var pm: PAVMetadata; key: {const} PAnsiChar; value: {const} PAnsiChar): cint; + cdecl; external av__format; + +(** + * Free all the memory allocated for an AVMetadata struct. + *) +procedure av_metadata_free(var m: PAVMetadata); + cdecl; external av__format; + +{$IFEND} + (* packet functions *) type @@ -117,7 +180,7 @@ type * Can be AV_NOPTS_VALUE if it is not stored in the file. *) dts: cint64; - data: PChar; + data: PByteArray; size: cint; stream_index: cint; flags: cint; @@ -126,7 +189,7 @@ type * Equals next_pts - this_pts in presentation order. *) duration: cint; - destruct: procedure (p: PAVPacket); cdecl; + destruct: procedure (p: PAVPacket); cdecl; priv: pointer; pos: cint64; ///< byte position in stream, -1 if unknown @@ -220,7 +283,7 @@ type PAVFrac = ^TAVFrac; TAVFrac = record val, num, den: cint64; - end; {deprecated} + end; (*************************************************) (* input/output formats *) @@ -228,8 +291,8 @@ type type (** This structure contains the data a format has to probe a file. *) TAVProbeData = record - filename: pchar; - buf: pchar; + filename: PAnsiChar; + buf: PByteArray; buf_size: cint; end; @@ -309,7 +372,10 @@ type id: cint; ///< unique ID to identify the chapter time_base: TAVRational; ///< time base in which the start/end timestamps are specified start, end_: cint64; ///< chapter start/end time in time_base units - title: PChar; ///< chapter title + title: PAnsiChar; ///< chapter title + {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1 + metadata: PAVMetadata; + {$IFEND} end; TAVChapterArray = array[0..(MaxInt div SizeOf(TAVChapter))-1] of TAVChapter; PAVChapterArray = ^TAVChapterArray; @@ -326,9 +392,9 @@ type {$IFEND} channel: cint; (**< Used to select DV channel. *) {$IF LIBAVFORMAT_VERSION_MAJOR < 52} - device: pchar; (* video, audio or DV device, if LIBAVFORMAT_VERSION_INT < (52<<16) *) + device: PAnsiChar; (* video, audio or DV device, if LIBAVFORMAT_VERSION_INT < (52<<16) *) {$IFEND} - standard: pchar; (**< TV standard, NTSC, PAL, SECAM *) + standard: PAnsiChar; (**< TV standard, NTSC, PAL, SECAM *) { Delphi does not support bit fields -> use bf_flags instead unsigned int mpeg2ts_raw:1; (**< Force raw MPEG-2 transport stream output, if possible. *) unsigned int mpeg2ts_compute_pcr:1; (**< Compute exact PCR for each transport @@ -346,15 +412,15 @@ type end; TAVOutputFormat = record - name: pchar; + name: PAnsiChar; (** * Descriptive name for the format, meant to be more human-readable * than \p name. You \e should use the NULL_IF_CONFIG_SMALL() macro * to define it. *) - long_name: pchar; - mime_type: pchar; - extensions: pchar; (**< comma-separated filename extensions *) + long_name: PAnsiChar; + mime_type: PAnsiChar; + extensions: PAnsiChar; (**< comma-separated filename extensions *) (** Size of private data so that it can be allocated in the wrapper. *) priv_data_size: cint; (* output support *) @@ -387,13 +453,13 @@ type end; TAVInputFormat = record - name: pchar; + name: PAnsiChar; (** * Descriptive name for the format, meant to be more human-readable * than \p name. You \e should use the NULL_IF_CONFIG_SMALL() macro * to define it. *) - long_name: pchar; + long_name: PAnsiChar; (** Size of private data so that it can be allocated in the wrapper. *) priv_data_size: cint; (** @@ -435,7 +501,7 @@ type (** If extensions are defined, then no probe is done. You should usually not use extension format guessing because it is not reliable enough *) - extensions: pchar; + extensions: PAnsiChar; (** General purpose read-only value that the format can use. *) value: cint; @@ -533,7 +599,7 @@ type *) duration: cint64; - language: array [0..3] of char; (* ISO 639 3-letter language code (empty string if undefined) *) + language: array [0..3] of PAnsiChar; (* ISO 639 3-letter language code (empty string if undefined) *) (* av_read_frame() support *) need_parsing: TAVStreamParseType; @@ -555,7 +621,7 @@ type {$IFEND} {$IF LIBAVFORMAT_VERSION >= 52006000} // 52.6.0 - filename: PChar; (**< source filename of the stream *) + filename: PAnsiChar; (**< source filename of the stream *) {$IFEND} {$IF LIBAVFORMAT_VERSION >= 52008000} // 52.8.0 @@ -576,6 +642,17 @@ type *) sample_aspect_ratio: TAVRational; {$IFEND} + + {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1 + metadata: PAVMetadata; + {$IFEND} + + {$IF LIBAVFORMAT_VERSION > 52024001} // > 52.24.1 + {* av_read_frame() support *} + cur_ptr: {const} PCuint8; + cur_len: cint; + cur_pkt: TAVPacket; + {$IFEND} end; (** @@ -600,17 +677,17 @@ type nb_streams: cuint; streams: array [0..MAX_STREAMS - 1] of PAVStream; - filename: array [0..1023] of char; (* input or output filename *) + filename: array [0..1023] of AnsiChar; (* input or output filename *) (* stream info *) timestamp: cint64; - title: array [0..511] of char; - author: array [0..511] of char; - copyright: array [0..511] of char; - comment: array [0..511] of char; - album: array [0..511] of char; + title: array [0..511] of AnsiChar; + author: array [0..511] of AnsiChar; + copyright: array [0..511] of AnsiChar; + comment: array [0..511] of AnsiChar; + album: array [0..511] of AnsiChar; year: cint; (**< ID3 year, 0 if none *) track: cint; (**< track number, 0 if none *) - genre: array [0..31] of char; (**< ID3 genre *) + genre: array [0..31] of AnsiChar; (**< ID3 genre *) ctx_flags: cint; (**< Format-specific flags, see AVFMTCTX_xx *) (* private data for pts handling (do not modify directly). *) @@ -636,9 +713,11 @@ type (* av_read_frame() support *) cur_st: PAVStream; - cur_ptr: pbyte; - cur_len: cint; - cur_pkt: TAVPacket; + {$IF LIBAVFORMAT_VERSION_MAJOR < 53} + cur_ptr_deprecated: pbyte; + cur_len_deprecated: cint; + cur_pkt_deprecated: TAVPacket; + {$IFEND} (* av_seek_frame() support *) data_offset: cint64; (* offset of the first packet *) @@ -740,6 +819,10 @@ type packet_buffer_end: PAVPacketList; {$IFEND} + + {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1 + metadata: PAVMetadata; + {$IFEND} end; (** @@ -750,14 +833,17 @@ type *) TAVProgram = record id : cint; - provider_name : PChar; ///< network name for DVB streams - name : PChar; ///< service name for DVB streams + provider_name : PAnsiChar; ///< network name for DVB streams + name : PAnsiChar; ///< service name for DVB streams flags : cint; discard : TAVDiscard; ///< selects which program to discard and which to feed to the caller {$IF LIBAVFORMAT_VERSION >= 51016000} // 51.16.0 stream_index : PCardinal; nb_stream_indexes : PCardinal; {$IFEND} + {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1 + metadata: PAVMetadata; + {$IFEND} end; TAVPacketList = record @@ -779,8 +865,8 @@ type end; {deprecated} TAVImageFormat = record - name: pchar; - extensions: pchar; + name: PAnsiChar; + extensions: PAnsiChar; (* tell if a given file has a chance of being parsing by this format *) img_probe: function (d: PAVProbeData): cint; cdecl; (* read a whole image. 'alloc_cb' is called when the image size is @@ -801,10 +887,10 @@ procedure av_register_image_format(img_fmt: PAVImageFormat); function av_probe_image_format(pd: PAVProbeData): PAVImageFormat; cdecl; external av__format; deprecated; -function guess_image_format(filename: pchar): PAVImageFormat; +function guess_image_format(filename: PAnsiChar): PAVImageFormat; cdecl; external av__format; deprecated; -function av_read_image(pb: PByteIOContext; filename: pchar; +function av_read_image(pb: PByteIOContext; filename: PAnsiChar; fmt: PAVImageFormat; alloc_cb: pointer; opaque: pointer): cint; cdecl; external av__format; deprecated; @@ -828,7 +914,7 @@ function av_oformat_next(f: PAVOutputFormat): PAVOutputFormat; cdecl; external av__format; {$IFEND} -function av_guess_image2_codec(filename: {const} PChar): TCodecID; +function av_guess_image2_codec(filename: {const} PAnsiChar): TCodecID; cdecl; external av__format; (* XXX: use automatic init with either ELF sections or C file parser *) @@ -841,21 +927,21 @@ procedure av_register_input_format(format: PAVInputFormat); procedure av_register_output_format(format: PAVOutputFormat); cdecl; external av__format; -function guess_stream_format(short_name: pchar; - filename: pchar; - mime_type: pchar): PAVOutputFormat; +function guess_stream_format(short_name: PAnsiChar; + filename: PAnsiChar; + mime_type: PAnsiChar): PAVOutputFormat; cdecl; external av__format; -function guess_format(short_name: pchar; - filename: pchar; - mime_type: pchar): PAVOutputFormat; +function guess_format(short_name: PAnsiChar; + filename: PAnsiChar; + mime_type: PAnsiChar): PAVOutputFormat; cdecl; external av__format; (** * Guesses the codec ID based upon muxer and filename. *) -function av_guess_codec(fmt: PAVOutputFormat; short_name: pchar; - filename: pchar; mime_type: pchar; +function av_guess_codec(fmt: PAVOutputFormat; short_name: PAnsiChar; + filename: PAnsiChar; mime_type: PAnsiChar; type_: TCodecType): TCodecID; cdecl; external av__format; @@ -868,7 +954,7 @@ function av_guess_codec(fmt: PAVOutputFormat; short_name: pchar; * * @see av_hex_dump_log, av_pkt_dump, av_pkt_dump_log *) -procedure av_hex_dump(f: PAVFile; buf: pchar; size: cint); +procedure av_hex_dump(f: PAVFile; buf: PByteArray; size: cint); cdecl; external av__format; {$IF LIBAVFORMAT_VERSION >= 51011000} // 51.11.0 @@ -884,7 +970,7 @@ procedure av_hex_dump(f: PAVFile; buf: pchar; size: cint); * * @see av_hex_dump, av_pkt_dump, av_pkt_dump_log *) -procedure av_hex_dump_log(avcl: Pointer; level: cint; buf: PChar; size: cint); +procedure av_hex_dump_log(avcl: Pointer; level: cint; buf: PByteArray; size: cint); cdecl; external av__format; {$IFEND} @@ -913,6 +999,15 @@ procedure av_pkt_dump_log(avcl: Pointer; level: cint; pkt: PAVPacket; dump_paylo cdecl; external av__format; {$IFEND} +(** + * Initialize libavformat and register all the muxers, demuxers and + * protocols. If you do not call this function, then you can select + * exactly which formats you want to support. + * + * @see av_register_input_format() + * @see av_register_output_format() + * @see register_protocol() + *) procedure av_register_all(); cdecl; external av__format; @@ -929,7 +1024,7 @@ function av_codec_get_tag(var tags: PAVCodecTag; id: TCodecID): cuint; (** * Finds AVInputFormat based on the short name of the input format. *) -function av_find_input_format(short_name: pchar): PAVInputFormat; +function av_find_input_format(short_name: PAnsiChar): PAVInputFormat; cdecl; external av__format; (** @@ -946,7 +1041,7 @@ function av_probe_input_format(pd: PAVProbeData; is_opened: cint): PAVInputForma * This does not open the needed codecs for decoding the stream[s]. *) function av_open_input_stream(ic_ptr: PAVFormatContext; - pb: PByteIOContext; filename: pchar; + pb: PByteIOContext; filename: PAnsiChar; fmt: PAVInputFormat; ap: PAVFormatParameters): cint; cdecl; external av__format; @@ -962,7 +1057,7 @@ function av_open_input_stream(ic_ptr: PAVFormatContext; * (NULL if default). * @return 0 if OK, AVERROR_xxx otherwise *) -function av_open_input_file(var ic_ptr: PAVFormatContext; filename: pchar; +function av_open_input_file(var ic_ptr: PAVFormatContext; filename: PAnsiChar; fmt: PAVInputFormat; buf_size: cint; ap: PAVFormatParameters): cint; cdecl; external av__format; @@ -1105,7 +1200,7 @@ function av_new_program(s: PAVFormatContext; id: cint): PAVProgram; * @return AVChapter or NULL on error *) function ff_new_chapter(s: PAVFormatContext; id: cint; time_base: TAVRational; - start, end_: cint64; title: {const} Pchar): PAVChapter; + start, end_: cint64; title: {const} PAnsiChar): PAVChapter; cdecl; external av__format; {$IFEND} @@ -1287,7 +1382,7 @@ function av_interleave_packet_per_dts(s: PAVFormatContext; _out: PAVPacket; function av_write_trailer(s: pAVFormatContext): cint; cdecl; external av__format; -procedure dump_format(ic: PAVFormatContext; index: cint; url: pchar; +procedure dump_format(ic: PAVFormatContext; index: cint; url: PAnsiChar; is_output: cint); cdecl; external av__format; @@ -1296,16 +1391,18 @@ procedure dump_format(ic: PAVFormatContext; index: cint; url: pchar; * @deprecated Use av_parse_video_frame_size instead. *) function parse_image_size(width_ptr: PCint; height_ptr: PCint; - str: pchar): cint; + str: PAnsiChar): cint; cdecl; external av__format; deprecated; +{$IF LIBAVFORMAT_VERSION_MAJOR < 53} (** * Converts frame rate from string to a fraction. * @deprecated Use av_parse_video_frame_rate instead. *) function parse_frame_rate(frame_rate: PCint; frame_rate_base: PCint; - arg: pchar): cint; + arg: PByteArray): cint; cdecl; external av__format; deprecated; +{$IFEND} (** * Parses \p datestr and returns a corresponding number of microseconds. @@ -1333,7 +1430,7 @@ function parse_frame_rate(frame_rate: PCint; frame_rate_base: PCint; * not zero \p datestr is interpreted as a duration, otherwise as a * date. *) -function parse_date(datestr: pchar; duration: cint): cint64; +function parse_date(datestr: PAnsiChar; duration: cint): cint64; cdecl; external av__format; (** Gets the current time in microseconds. *) @@ -1359,7 +1456,7 @@ procedure ffm_set_write_index(s: PAVFormatContext; pos: cint64; file_size: cint6 * syntax: '?tag1=val1&tag2=val2...'. Little URL decoding is done. * Return 1 if found. *) -function find_info_tag(arg: pchar; arg_size: cint; tag1: pchar; info: pchar): cint; +function find_info_tag(arg: PAnsiChar; arg_size: cint; tag1: PAnsiChar; info: PAnsiChar): cint; cdecl; external av__format; (** @@ -1374,8 +1471,8 @@ function find_info_tag(arg: pchar; arg_size: cint; tag1: pchar; info: pchar): ci * @param number frame number * @return 0 if OK, -1 on format error *) -function av_get_frame_filename(buf: pchar; buf_size: cint; - path: pchar; number: cint): cint; +function av_get_frame_filename(buf: PAnsiChar; buf_size: cint; + path: PAnsiChar; number: cint): cint; cdecl; external av__format {$IF LIBAVFORMAT_VERSION <= 50006000} // 50.6.0 name 'get_frame_filename' @@ -1387,7 +1484,7 @@ function av_get_frame_filename(buf: pchar; buf_size: cint; * @param filename possible numbered sequence string * @return 1 if a valid numbered sequence string, 0 otherwise *) -function av_filename_number_test(filename: pchar): cint; +function av_filename_number_test(filename: PAnsiChar): cint; cdecl; external av__format {$IF LIBAVFORMAT_VERSION <= 50006000} // 50.6.0 name 'filename_number_test' @@ -1408,7 +1505,7 @@ function av_filename_number_test(filename: pchar): cint; * @param size the size of the buffer * @return 0 if OK, AVERROR_xxx on error *) -function avf_sdp_create(ac: PPAVFormatContext; n_files: cint; buff: PChar; size: cint): cint; +function avf_sdp_create(ac: PPAVFormatContext; n_files: cint; buff: PByteArray; size: cint): cint; cdecl; external av__format; {$IFEND} diff --git a/unicode/src/lib/ffmpeg/avio.pas b/unicode/src/lib/ffmpeg/avio.pas index 5107a9fb..33778206 100644 --- a/unicode/src/lib/ffmpeg/avio.pas +++ b/unicode/src/lib/ffmpeg/avio.pas @@ -27,7 +27,7 @@ (* * Conversion of libavformat/avio.h - * revision 15120, Sun Aug 31 07:39:47 2008 UTC + * revision 16100, Sat Dec 13 13:39:13 2008 UTC *) unit avio; @@ -48,13 +48,9 @@ uses ctypes, avutil, avcodec, + SysUtils, UConfig; -(* output byte stream handling *) - -type - TOffset = cint64; - (* unbuffered I/O *) const @@ -92,7 +88,7 @@ type is_streamed: cint; (**< true if streamed (no seek possible), default = false *) max_packet_size: cint; (**< if non zero, the stream is packetized with this max packet size *) priv_data: pointer; - filename: PChar; (**< specified filename *) + filename: PAnsiChar; (**< specified filename *) end; PPURLContext = ^PURLContext; @@ -104,11 +100,11 @@ type end; TURLProtocol = record - name: PChar; - url_open: function (h: PURLContext; filename: {const} PChar; flags: cint): cint; cdecl; - url_read: function (h: PURLContext; buf: PChar; size: cint): cint; cdecl; - url_write: function (h: PURLContext; buf: PChar; size: cint): cint; cdecl; - url_seek: function (h: PURLContext; pos: TOffset; whence: cint): TOffset; cdecl; + name: PAnsiChar; + url_open: function (h: PURLContext; filename: {const} PAnsiChar; flags: cint): cint; cdecl; + url_read: function (h: PURLContext; buf: PByteArray; size: cint): cint; cdecl; + url_write: function (h: PURLContext; buf: PByteArray; size: cint): cint; cdecl; + url_seek: function (h: PURLContext; pos: cint64; whence: cint): cint64; cdecl; url_close: function (h: PURLContext): cint; cdecl; next: PURLProtocol; {$IF (LIBAVFORMAT_VERSION >= 52001000) and (LIBAVFORMAT_VERSION < 52004000)} // 52.1.0 .. 52.4.0 @@ -119,8 +115,8 @@ type url_read_pause: function (h: PURLContext; pause: cint): cint; cdecl; {$IFEND} {$IF LIBAVFORMAT_VERSION >= 52001000} // 52.1.0 - url_read_seek: function (h: PURLContext; - stream_index: cint; timestamp: cint64; flags: cint): TOffset; cdecl; + url_read_seek: function (h: PURLContext; stream_index: cint; + timestamp: cint64; flags: cint): cint64; cdecl; {$IFEND} end; @@ -133,23 +129,23 @@ type *) PByteIOContext = ^TByteIOContext; TByteIOContext = record - buffer: PChar; + buffer: PByteArray; buffer_size: cint; - buf_ptr: PChar; - buf_end: PChar; + buf_ptr: PByteArray; + buf_end: PByteArray; opaque: pointer; - read_packet: function (opaque: pointer; buf: PChar; buf_size: cint): cint; cdecl; - write_packet: function (opaque: pointer; buf: PChar; buf_size: cint): cint; cdecl; - seek: function (opaque: pointer; offset: TOffset; whence: cint): TOffset; cdecl; - pos: TOffset; (* position in the file of the current buffer *) + read_packet: function (opaque: pointer; buf: PByteArray; buf_size: cint): cint; cdecl; + write_packet: function (opaque: pointer; buf: PByteArray; buf_size: cint): cint; cdecl; + seek: function (opaque: pointer; offset: cint64; whence: cint): cint64; cdecl; + pos: cint64; (* position in the file of the current buffer *) must_flush: cint; (* true if the next seek should flush *) eof_reached: cint; (* true if eof reached *) write_flag: cint; (* true if open for writing *) is_streamed: cint; max_packet_size: cint; checksum: culong; - checksum_ptr: PCuchar; - update_checksum: function (checksum: culong; buf: {const} PChar; size: cuint): culong; cdecl; + checksum_ptr: PByteArray; + update_checksum: function (checksum: culong; buf: {const} PByteArray; size: cuint): culong; cdecl; error: cint; ///< contains the error code or 0 if no error happened {$IF (LIBAVFORMAT_VERSION >= 52001000) and (LIBAVFORMAT_VERSION < 52004000)} // 52.1.0 .. 52.4.0 read_play: function(opaque: Pointer): cint; cdecl; @@ -159,30 +155,30 @@ type read_pause: function(opaque: Pointer; pause: cint): cint; cdecl; {$IFEND} {$IF LIBAVFORMAT_VERSION >= 52001000} // 52.1.0 - read_seek: function(opaque: Pointer; - stream_index: cint; timestamp: cint64; flags: cint): TOffset; cdecl; + read_seek: function(opaque: Pointer; stream_index: cint; + timestamp: cint64; flags: cint): cint64; cdecl; {$IFEND} end; {$IF LIBAVFORMAT_VERSION >= 52021000} // 52.21.0 function url_open_protocol(puc: PPURLContext; up: PURLProtocol; - filename: {const} PChar; flags: cint): cint; + filename: {const} PAnsiChar; flags: cint): cint; cdecl; external av__format; {$IFEND} -function url_open(h: PPointer; filename: {const} PChar; flags: cint): cint; +function url_open(h: PPointer; filename: {const} PAnsiChar; flags: cint): cint; cdecl; external av__format; -function url_read (h: PURLContext; buf: PChar; size: cint): cint; +function url_read (h: PURLContext; buf: PByteArray; size: cint): cint; cdecl; external av__format; -function url_write (h: PURLContext; buf: PChar; size: cint): cint; +function url_write (h: PURLContext; buf: PByteArray; size: cint): cint; cdecl; external av__format; -function url_seek (h: PURLContext; pos: TOffset; whence: cint): TOffset; +function url_seek (h: PURLContext; pos: cint64; whence: cint): cint64; cdecl; external av__format; function url_close (h: PURLContext): cint; cdecl; external av__format; -function url_exist(filename: {const} PChar): cint; +function url_exist(filename: {const} PAnsiChar): cint; cdecl; external av__format; -function url_filesize (h: PURLContext): TOffset; +function url_filesize (h: PURLContext): cint64; cdecl; external av__format; (** @@ -195,7 +191,7 @@ function url_filesize (h: PURLContext): TOffset; *) function url_get_max_packet_size(h: PURLContext): cint; cdecl; external av__format; -procedure url_get_filename(h: PURLContext; buf: PChar; buf_size: cint); +procedure url_get_filename(h: PURLContext; buf: PAnsiChar; buf_size: cint); cdecl; external av__format; (** @@ -239,8 +235,8 @@ function av_url_read_pause(h: PURLContext; pause: cint): cint; * @return >= 0 on success * @see AVInputFormat::read_seek *) -function av_url_read_seek(h: PURLContext; - stream_index: cint; timestamp: cint64; flags: cint): TOffset; +function av_url_read_seek(h: PURLContext; stream_index: cint; + timestamp: cint64; flags: cint): cint64; cdecl; external av__format; {$IFEND} @@ -259,11 +255,11 @@ function register_protocol (protocol: PURLProtocol): cint; cdecl; external av__format; type - TReadWriteFunc = function (opaque: Pointer; buf: PChar; buf_size: cint): cint; cdecl; - TSeekFunc = function (opaque: Pointer; offset: TOffset; whence: cint): TOffset; cdecl; + TReadWriteFunc = function (opaque: Pointer; buf: PByteArray; buf_size: cint): cint; cdecl; + TSeekFunc = function (opaque: Pointer; offset: cint64; whence: cint): cint64; cdecl; function init_put_byte(s: PByteIOContext; - buffer: PChar; + buffer: PByteArray; buffer_size: cint; write_flag: cint; opaque: pointer; read_packet: TReadWriteFunc; @@ -272,7 +268,7 @@ function init_put_byte(s: PByteIOContext; cdecl; external av__format; {$IF LIBAVFORMAT_VERSION >= 52004000} // 52.4.0 function av_alloc_put_byte( - buffer: PChar; + buffer: PByteArray; buffer_size: cint; write_flag: cint; opaque: Pointer; @@ -284,7 +280,7 @@ function av_alloc_put_byte( procedure put_byte(s: PByteIOContext; b: cint); cdecl; external av__format; -procedure put_buffer (s: PByteIOContext; buf: {const} PChar; size: cint); +procedure put_buffer (s: PByteIOContext; buf: {const} PByteArray; size: cint); cdecl; external av__format; procedure put_le64(s: PByteIOContext; val: cuint64); cdecl; external av__format; @@ -302,38 +298,38 @@ procedure put_le16(s: PByteIOContext; val: cuint); cdecl; external av__format; procedure put_be16(s: PByteIOContext; val: cuint); cdecl; external av__format; -procedure put_tag(s: PByteIOContext; tag: {const} PChar); +procedure put_tag(s: PByteIOContext; tag: {const} PAnsiChar); cdecl; external av__format; -procedure put_strz(s: PByteIOContext; buf: {const} PChar); +procedure put_strz(s: PByteIOContext; buf: {const} PAnsiChar); cdecl; external av__format; (** * fseek() equivalent for ByteIOContext. * @return new position or AVERROR. *) -function url_fseek(s: PByteIOContext; offset: TOffset; whence: cint): TOffset; +function url_fseek(s: PByteIOContext; offset: cint64; whence: cint): cint64; cdecl; external av__format; (** * Skip given number of bytes forward. * @param offset number of bytes *) -procedure url_fskip(s: PByteIOContext; offset: TOffset); +procedure url_fskip(s: PByteIOContext; offset: cint64); cdecl; external av__format; (** * ftell() equivalent for ByteIOContext. * @return position or AVERROR. *) -function url_ftell(s: PByteIOContext): TOffset; +function url_ftell(s: PByteIOContext): cint64; cdecl; external av__format; (** * Gets the filesize. * @return filesize or AVERROR *) -function url_fsize(s: PByteIOContext): TOffset; +function url_fsize(s: PByteIOContext): cint64; cdecl; external av__format; (** @@ -351,8 +347,8 @@ function av_url_read_fpause(h: PByteIOContext; pause: cint): cint; cdecl; external av__format; {$IFEND} {$IF LIBAVFORMAT_VERSION >= 52001000} // 52.1.0 -function av_url_read_fseek(h: PByteIOContext; - stream_index: cint; timestamp: cint64; flags: cint): TOffset; +function av_url_read_fseek(h: PByteIOContext; stream_index: cint; + timestamp: cint64; flags: cint): cint64; cdecl; external av__format; {$IFEND} @@ -363,12 +359,12 @@ function url_fgetc(s: PByteIOContext): cint; cdecl; external av__format; (** @warning currently size is limited *) -function url_fprintf(s: PByteIOContext; fmt: {const} PChar; args: array of const): cint; +function url_fprintf(s: PByteIOContext; fmt: {const} PAnsiChar; args: array of const): cint; cdecl; external av__format; (** @note unlike fgets, the EOL character is not returned and a whole line is parsed. return NULL if first char read was EOF *) -function url_fgets(s: PByteIOContext; buf: PChar; buf_size: cint): PChar; +function url_fgets(s: PByteIOContext; buf: PAnsiChar; buf_size: cint): PAnsiChar; cdecl; external av__format; procedure put_flush_packet (s: PByteIOContext); @@ -379,7 +375,7 @@ procedure put_flush_packet (s: PByteIOContext); * Reads size bytes from ByteIOContext into buf. * @returns number of bytes read or AVERROR *) -function get_buffer(s: PByteIOContext; buf: PChar; size: cint): cint; +function get_buffer(s: PByteIOContext; buf: PByteArray; size: cint): cint; cdecl; external av__format; (** @@ -388,7 +384,7 @@ function get_buffer(s: PByteIOContext; buf: PChar; size: cint): cint; * returned. * @returns number of bytes read or AVERROR *) -function get_partial_buffer(s: PByteIOContext; buf: PChar; size: cint): cint; +function get_partial_buffer(s: PByteIOContext; buf: PByteArray; size: cint): cint; cdecl; external av__format; (** @note return 0 if EOF, so you cannot use it if EOF handling is @@ -404,7 +400,7 @@ function get_le64(s: PByteIOContext): cuint64; function get_le16(s: PByteIOContext): cuint; cdecl; external av__format; -function get_strz(s: PByteIOContext; buf: PChar; maxlen: cint): PChar; +function get_strz(s: PByteIOContext; buf: PAnsiChar; maxlen: cint): PAnsiChar; cdecl; external av__format; function get_be16(s: PByteIOContext): cuint; cdecl; external av__format; @@ -447,9 +443,9 @@ function url_resetbuf(s: PByteIOContext; flags: cint): cint; (** @note when opened as read/write, the buffers are only used for writing *) {$IF LIBAVFORMAT_VERSION >= 52000000} // 52.0.0 -function url_fopen(var s: PByteIOContext; filename: {const} PChar; flags: cint): cint; +function url_fopen(var s: PByteIOContext; filename: {const} PAnsiChar; flags: cint): cint; {$ELSE} -function url_fopen(s: PByteIOContext; filename: {const} PChar; flags: cint): cint; +function url_fopen(s: PByteIOContext; filename: {const} PAnsiChar; flags: cint): cint; {$IFEND} cdecl; external av__format; function url_fclose(s: PByteIOContext): cint; @@ -469,9 +465,9 @@ function url_fget_max_packet_size (s: PByteIOContext): cint; cdecl; external av__format; {$IF LIBAVFORMAT_VERSION >= 52000000} // 52.0.0 -function url_open_buf(var s: PByteIOContext; buf: PChar; buf_size: cint; flags: cint): cint; +function url_open_buf(var s: PByteIOContext; buf: PAnsiChar; buf_size: cint; flags: cint): cint; {$ELSE} -function url_open_buf(s: PByteIOContext; buf: PChar; buf_size: cint; flags: cint): cint; +function url_open_buf(s: PByteIOContext; buf: PAnsiChar; buf_size: cint; flags: cint): cint; {$IFEND} cdecl; external av__format; @@ -519,16 +515,19 @@ function url_close_dyn_buf(s: PByteIOContext; pbuffer:PPointer): cint; cdecl; external av__format; {$IF LIBAVFORMAT_VERSION >= 51017001} // 51.17.1 -function ff_crc04C11DB7_update(checksum: culong; buf: {const} PChar; len: cuint): culong; +function ff_crc04C11DB7_update(checksum: culong; buf: {const} PByteArray; + len: cuint): culong; cdecl; external av__format; {$IFEND} function get_checksum(s: PByteIOContext): culong; cdecl; external av__format; -procedure init_checksum (s: PByteIOContext; update_checksum: pointer; checksum: culong); +procedure init_checksum(s: PByteIOContext; + update_checksum: pointer; + checksum: culong); cdecl; external av__format; (* udp.c *) -function udp_set_remote_url(h: PURLContext; uri: {const} PChar): cint; +function udp_set_remote_url(h: PURLContext; uri: {const} PAnsiChar): cint; cdecl; external av__format; function udp_get_local_port(h: PURLContext): cint; cdecl; external av__format; diff --git a/unicode/src/lib/ffmpeg/avutil.pas b/unicode/src/lib/ffmpeg/avutil.pas index b4fae422..6de35f1b 100644 --- a/unicode/src/lib/ffmpeg/avutil.pas +++ b/unicode/src/lib/ffmpeg/avutil.pas @@ -29,13 +29,13 @@ * * libavutil/avutil.h: * Min. version: 49.0.1, revision 6577, Sat Oct 7 15:30:46 2006 UTC - * Max. version: 49.11.0, revision 15415, Thu Sep 25 19:23:13 2008 UTC + * Max. version: 49.14.0, revision 16912, Sun Feb 1 02:00:19 2009 UTC * * libavutil/mem.h: - * revision 15120, Sun Aug 31 07:39:47 2008 UTC + * revision 16590, Tue Jan 13 23:44:16 2009 UTC * * libavutil/log.h: - * revision 15120, Sun Aug 31 07:39:47 2008 UTC + * revision 16571, Tue Jan 13 00:14:43 2009 UTC *) unit avutil; @@ -63,7 +63,7 @@ uses const (* Max. supported version by this header *) LIBAVUTIL_MAX_VERSION_MAJOR = 49; - LIBAVUTIL_MAX_VERSION_MINOR = 11; + LIBAVUTIL_MAX_VERSION_MINOR = 14; LIBAVUTIL_MAX_VERSION_RELEASE = 0; LIBAVUTIL_MAX_VERSION = (LIBAVUTIL_MAX_VERSION_MAJOR * VERSION_MAJOR) + (LIBAVUTIL_MAX_VERSION_MINOR * VERSION_MINOR) + @@ -98,15 +98,15 @@ type (** * Pixel format. Notes: * - * PIX_FMT_RGB32 is handled in an endian-specific manner. A RGBA + * PIX_FMT_RGB32 is handled in an endian-specific manner. An RGBA * color is put together as: * (A << 24) | (R << 16) | (G << 8) | B - * This is stored as BGRA on little endian CPU architectures and ARGB on - * big endian CPUs. + * This is stored as BGRA on little-endian CPU architectures and ARGB on + * big-endian CPUs. * * When the pixel format is palettized RGB (PIX_FMT_PAL8), the palettized * image data is stored in AVFrame.data[0]. The palette is transported in - * AVFrame.data[1] and, is 1024 bytes long (256 4-byte entries) and is + * AVFrame.data[1], is 1024 bytes long (256 4-byte entries) and is * formatted the same as in PIX_FMT_RGB32 described above (i.e., it is * also endian-specific). Note also that the individual RGB palette * components stored in AVFrame.data[1] should be in the range 0..255. @@ -117,48 +117,53 @@ type PAVPixelFormat = ^TAVPixelFormat; TAVPixelFormat = ( PIX_FMT_NONE= -1, - PIX_FMT_YUV420P, ///< Planar YUV 4:2:0, 12bpp, (1 Cr & Cb sample per 2x2 Y samples) - PIX_FMT_YUYV422, ///< Packed YUV 4:2:2, 16bpp, Y0 Cb Y1 Cr - PIX_FMT_RGB24, ///< Packed RGB 8:8:8, 24bpp, RGBRGB... - PIX_FMT_BGR24, ///< Packed RGB 8:8:8, 24bpp, BGRBGR... - PIX_FMT_YUV422P, ///< Planar YUV 4:2:2, 16bpp, (1 Cr & Cb sample per 2x1 Y samples) - PIX_FMT_YUV444P, ///< Planar YUV 4:4:4, 24bpp, (1 Cr & Cb sample per 1x1 Y samples) - PIX_FMT_RGB32, ///< Packed RGB 8:8:8, 32bpp, (msb)8A 8R 8G 8B(lsb), in cpu endianness - PIX_FMT_YUV410P, ///< Planar YUV 4:1:0, 9bpp, (1 Cr & Cb sample per 4x4 Y samples) - PIX_FMT_YUV411P, ///< Planar YUV 4:1:1, 12bpp, (1 Cr & Cb sample per 4x1 Y samples) - PIX_FMT_RGB565, ///< Packed RGB 5:6:5, 16bpp, (msb) 5R 6G 5B(lsb), in cpu endianness - PIX_FMT_RGB555, ///< Packed RGB 5:5:5, 16bpp, (msb)1A 5R 5G 5B(lsb), in cpu endianness most significant bit to 1 + PIX_FMT_YUV420P, ///< planar YUV 4:2:0, 12bpp, (1 Cr & Cb sample per 2x2 Y samples) + PIX_FMT_YUYV422, ///< packed YUV 4:2:2, 16bpp, Y0 Cb Y1 Cr + PIX_FMT_RGB24, ///< packed RGB 8:8:8, 24bpp, RGBRGB... + PIX_FMT_BGR24, ///< packed RGB 8:8:8, 24bpp, BGRBGR... + PIX_FMT_YUV422P, ///< planar YUV 4:2:2, 16bpp, (1 Cr & Cb sample per 2x1 Y samples) + PIX_FMT_YUV444P, ///< planar YUV 4:4:4, 24bpp, (1 Cr & Cb sample per 1x1 Y samples) + PIX_FMT_RGB32, ///< packed RGB 8:8:8, 32bpp, (msb)8A 8R 8G 8B(lsb), in CPU endianness + PIX_FMT_YUV410P, ///< planar YUV 4:1:0, 9bpp, (1 Cr & Cb sample per 4x4 Y samples) + PIX_FMT_YUV411P, ///< planar YUV 4:1:1, 12bpp, (1 Cr & Cb sample per 4x1 Y samples) + PIX_FMT_RGB565, ///< packed RGB 5:6:5, 16bpp, (msb) 5R 6G 5B(lsb), in CPU endianness + PIX_FMT_RGB555, ///< packed RGB 5:5:5, 16bpp, (msb)1A 5R 5G 5B(lsb), in CPU endianness, most significant bit to 0 PIX_FMT_GRAY8, ///< Y , 8bpp PIX_FMT_MONOWHITE, ///< Y , 1bpp, 0 is white, 1 is black PIX_FMT_MONOBLACK, ///< Y , 1bpp, 0 is black, 1 is white PIX_FMT_PAL8, ///< 8 bit with PIX_FMT_RGB32 palette - PIX_FMT_YUVJ420P, ///< Planar YUV 4:2:0, 12bpp, full scale (jpeg) - PIX_FMT_YUVJ422P, ///< Planar YUV 4:2:2, 16bpp, full scale (jpeg) - PIX_FMT_YUVJ444P, ///< Planar YUV 4:4:4, 24bpp, full scale (jpeg) + PIX_FMT_YUVJ420P, ///< planar YUV 4:2:0, 12bpp, full scale (JPEG) + PIX_FMT_YUVJ422P, ///< planar YUV 4:2:2, 16bpp, full scale (JPEG) + PIX_FMT_YUVJ444P, ///< planar YUV 4:4:4, 24bpp, full scale (JPEG) PIX_FMT_XVMC_MPEG2_MC,///< XVideo Motion Acceleration via common packet passing(xvmc_render.h) PIX_FMT_XVMC_MPEG2_IDCT, - PIX_FMT_UYVY422, ///< Packed YUV 4:2:2, 16bpp, Cb Y0 Cr Y1 - PIX_FMT_UYYVYY411, ///< Packed YUV 4:1:1, 12bpp, Cb Y0 Y1 Cr Y2 Y3 - PIX_FMT_BGR32, ///< Packed RGB 8:8:8, 32bpp, (msb)8A 8B 8G 8R(lsb), in cpu endianness - PIX_FMT_BGR565, ///< Packed RGB 5:6:5, 16bpp, (msb) 5B 6G 5R(lsb), in cpu endianness - PIX_FMT_BGR555, ///< Packed RGB 5:5:5, 16bpp, (msb)1A 5B 5G 5R(lsb), in cpu endianness most significant bit to 1 - PIX_FMT_BGR8, ///< Packed RGB 3:3:2, 8bpp, (msb)2B 3G 3R(lsb) - PIX_FMT_BGR4, ///< Packed RGB 1:2:1, 4bpp, (msb)1B 2G 1R(lsb) - PIX_FMT_BGR4_BYTE, ///< Packed RGB 1:2:1, 8bpp, (msb)1B 2G 1R(lsb) - PIX_FMT_RGB8, ///< Packed RGB 3:3:2, 8bpp, (msb)2R 3G 3B(lsb) - PIX_FMT_RGB4, ///< Packed RGB 1:2:1, 4bpp, (msb)1R 2G 1B(lsb) - PIX_FMT_RGB4_BYTE, ///< Packed RGB 1:2:1, 8bpp, (msb)1R 2G 1B(lsb) - PIX_FMT_NV12, ///< Planar YUV 4:2:0, 12bpp, 1 plane for Y and 1 for UV + PIX_FMT_UYVY422, ///< packed YUV 4:2:2, 16bpp, Cb Y0 Cr Y1 + PIX_FMT_UYYVYY411, ///< packed YUV 4:1:1, 12bpp, Cb Y0 Y1 Cr Y2 Y3 + PIX_FMT_BGR32, ///< packed RGB 8:8:8, 32bpp, (msb)8A 8B 8G 8R(lsb), in CPU endianness + PIX_FMT_BGR565, ///< packed RGB 5:6:5, 16bpp, (msb) 5B 6G 5R(lsb), in CPU endianness + PIX_FMT_BGR555, ///< packed RGB 5:5:5, 16bpp, (msb)1A 5B 5G 5R(lsb), in CPU endianness, most significant bit to 1 + PIX_FMT_BGR8, ///< packed RGB 3:3:2, 8bpp, (msb)2B 3G 3R(lsb) + PIX_FMT_BGR4, ///< packed RGB 1:2:1, 4bpp, (msb)1B 2G 1R(lsb) + PIX_FMT_BGR4_BYTE, ///< packed RGB 1:2:1, 8bpp, (msb)1B 2G 1R(lsb) + PIX_FMT_RGB8, ///< packed RGB 3:3:2, 8bpp, (msb)2R 3G 3B(lsb) + PIX_FMT_RGB4, ///< packed RGB 1:2:1, 4bpp, (msb)1R 2G 1B(lsb) + PIX_FMT_RGB4_BYTE, ///< packed RGB 1:2:1, 8bpp, (msb)1R 2G 1B(lsb) + PIX_FMT_NV12, ///< planar YUV 4:2:0, 12bpp, 1 plane for Y and 1 for UV PIX_FMT_NV21, ///< as above, but U and V bytes are swapped - PIX_FMT_RGB32_1, ///< Packed RGB 8:8:8, 32bpp, (msb)8R 8G 8B 8A(lsb), in cpu endianness - PIX_FMT_BGR32_1, ///< Packed RGB 8:8:8, 32bpp, (msb)8B 8G 8R 8A(lsb), in cpu endianness + PIX_FMT_RGB32_1, ///< packed RGB 8:8:8, 32bpp, (msb)8R 8G 8B 8A(lsb), in CPU endianness + PIX_FMT_BGR32_1, ///< packed RGB 8:8:8, 32bpp, (msb)8B 8G 8R 8A(lsb), in CPU endianness PIX_FMT_GRAY16BE, ///< Y , 16bpp, big-endian PIX_FMT_GRAY16LE, ///< Y , 16bpp, little-endian - PIX_FMT_YUV440P, ///< Planar YUV 4:4:0 (1 Cr & Cb sample per 1x2 Y samples) - PIX_FMT_YUVJ440P, ///< Planar YUV 4:4:0 full scale (jpeg) - PIX_FMT_YUVA420P, ///< Planar YUV 4:2:0, 20bpp, (1 Cr & Cb sample per 2x2 Y & A samples) + PIX_FMT_YUV440P, ///< planar YUV 4:4:0 (1 Cr & Cb sample per 1x2 Y samples) + PIX_FMT_YUVJ440P, ///< planar YUV 4:4:0 full scale (JPEG) + PIX_FMT_YUVA420P, ///< planar YUV 4:2:0, 20bpp, (1 Cr & Cb sample per 2x2 Y & A samples) + PIX_FMT_VDPAU_H264,///< H.264 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers + PIX_FMT_VDPAU_MPEG1,///< MPEG-1 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers + PIX_FMT_VDPAU_MPEG2,///< MPEG-2 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers + PIX_FMT_VDPAU_WMV3,///< WMV3 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers + PIX_FMT_VDPAU_VC1, ///< VC-1 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers PIX_FMT_NB ///< number of pixel formats, DO NOT USE THIS if you want to link with shared libav* because the number of formats might differ between versions ); @@ -185,7 +190,7 @@ const (* common.h *) -function MKTAG(a,b,c,d: char): integer; +function MKTAG(a,b,c,d: AnsiChar): integer; (* mem.h *) @@ -244,7 +249,7 @@ function av_mallocz(size: cuint): pointer; * @return Pointer to a newly allocated string containing a * copy of \p s or NULL if it cannot be allocated. *) -function av_strdup({const} s: PChar): PChar; +function av_strdup({const} s: PAnsiChar): PAnsiChar; cdecl; external av__util; {av_malloc_attrib} (** @@ -312,7 +317,7 @@ procedure av_log_set_level(level: cint); implementation -function MKTAG(a,b,c,d: char): integer; +function MKTAG(a,b,c,d: AnsiChar): integer; begin Result := (ord(a) or (ord(b) shl 8) or (ord(c) shl 16) or (ord(d) shl 24)); end; diff --git a/unicode/src/lib/ffmpeg/mathematics.pas b/unicode/src/lib/ffmpeg/mathematics.pas index 606d9189..fb57ccea 100644 --- a/unicode/src/lib/ffmpeg/mathematics.pas +++ b/unicode/src/lib/ffmpeg/mathematics.pas @@ -26,7 +26,7 @@ (* * Conversion of libavutil/mathematics.h - * revision 15120, Sun Aug 31 07:39:47 2008 UTC + * revision 16844, Wed Jan 28 08:50:10 2009 UTC *) unit mathematics; @@ -55,29 +55,34 @@ const type TAVRounding = ( - AV_ROUND_ZERO = 0, ///< round toward zero - AV_ROUND_INF = 1, ///< round away from zero - AV_ROUND_DOWN = 2, ///< round toward -infinity - AV_ROUND_UP = 3, ///< round toward +infinity - AV_ROUND_NEAR_INF = 5 ///< round to nearest and halfway cases away from zero + AV_ROUND_ZERO = 0, ///< Round toward zero + AV_ROUND_INF = 1, ///< Round away from zero + AV_ROUND_DOWN = 2, ///< Round toward -infinity + AV_ROUND_UP = 3, ///< Round toward +infinity + AV_ROUND_NEAR_INF = 5 ///< Round to nearest and halfway cases away from zero ); +{$IF LIBAVUTIL_VERSION >= 49013000} // 49.13.0 +function av_gcd(a: cint64; b: cint64): cint64; + cdecl; external av__util; {av_const} +{$IFEND} + (** - * rescale a 64bit integer with rounding to nearest. - * a simple a*b/c isn't possible as it can overflow + * Rescales a 64-bit integer with rounding to nearest. + * A simple a*b/c isn't possible as it can overflow. *) function av_rescale (a, b, c: cint64): cint64; cdecl; external av__util; {av_const} (** - * rescale a 64bit integer with specified rounding. - * a simple a*b/c isn't possible as it can overflow + * Rescales a 64-bit integer with specified rounding. + * A simple a*b/c isn't possible as it can overflow. *) function av_rescale_rnd (a, b, c: cint64; enum: TAVRounding): cint64; cdecl; external av__util; {av_const} (** - * rescale a 64bit integer by 2 rational numbers. + * Rescales a 64-bit integer by 2 rational numbers. *) function av_rescale_q (a: cint64; bq, cq: TAVRational): cint64; cdecl; external av__util; {av_const} diff --git a/unicode/src/lib/ffmpeg/opt.pas b/unicode/src/lib/ffmpeg/opt.pas index e734aa9f..833dc247 100644 --- a/unicode/src/lib/ffmpeg/opt.pas +++ b/unicode/src/lib/ffmpeg/opt.pas @@ -27,7 +27,7 @@ (* * Conversion of libavcodec/opt.h - * revision 15120, Sun Aug 31 07:39:47 2008 UTC + * revision 16912, Sun Feb 1 02:00:19 2009 UTC *) unit opt; @@ -74,13 +74,13 @@ type *) PAVOption = ^TAVOption; TAVOption = record - name: {const} PChar; + name: {const} PAnsiChar; (** * short English help text * @todo What about other languages? *) - help: {const} PChar; + help: {const} PAnsiChar; (** * The offset relative to the context structure where the option @@ -104,7 +104,7 @@ type * options and corresponding named constants share the same * unit. May be NULL. *) - unit_: {const} PChar; + unit_: {const} PAnsiChar; end; {$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0 @@ -114,24 +114,39 @@ type * for which it is the case that opt->flags & mask == flags). * * @param[in] obj a pointer to a struct whose first element is a - * pointer to an #AVClass + * pointer to an AVClass * @param[in] name the name of the option to look for * @param[in] unit the unit of the option to look for, or any if NULL * @return a pointer to the option found, or NULL if no option * has been found *) -function av_find_opt(obj: Pointer; {const} name: {const} PChar; {const} unit_: PChar; mask: cint; flags: cint): {const} PAVOption; +function av_find_opt(obj: Pointer; {const} name: {const} PAnsiChar; {const} unit_: PAnsiChar; mask: cint; flags: cint): {const} PAVOption; cdecl; external av__codec; {$IFEND} +{$IF LIBAVCODEC_VERSION_MAJOR < 53} + (** * @see av_set_string2() *) -function av_set_string(obj: pointer; name: {const} pchar; val: {const} pchar): {const} PAVOption; +function av_set_string(obj: pointer; name: {const} PAnsiChar; val: {const} PAnsiChar): {const} PAVOption; cdecl; external av__codec; deprecated; {$IF LIBAVCODEC_VERSION >= 51059000} // 51.59.0 (** + * @return a pointer to the AVOption corresponding to the field set or + * NULL if no matching AVOption exists, or if the value \p val is not + * valid + * @see av_set_string3() + *) +function av_set_string2(obj: Pointer; name: {const} PAnsiChar; val: {const} PAnsiChar; alloc: cint): {const} PAVOption; + cdecl; external av__codec; deprecated; +{$IFEND} + +{$IFEND} + +{$IF LIBAVCODEC_VERSION >= 52007000} // 52.7.0 +(** * Sets the field of obj with the given name to value. * * @param[in] obj A struct whose first element is a pointer to an @@ -147,36 +162,37 @@ function av_set_string(obj: pointer; name: {const} pchar; val: {const} pchar): { * scalars or named flags separated by '+' or '-'. Prefixing a flag * with '+' causes it to be set without affecting the other flags; * similarly, '-' unsets a flag. - * @return a pointer to the AVOption corresponding to the field set or - * NULL if no matching AVOption exists, or if the value \p val is not - * valid + * @param[out] o_out if non-NULL put here a pointer to the AVOption + * found * @param alloc when 1 then the old value will be av_freed() and the * new av_strduped() * when 0 then no av_free() nor av_strdup() will be used + * @return 0 if the value has been set, an AVERROR* error code if no + * matching option exists, or if the value \p val is not valid *) -function av_set_string2(obj: Pointer; name: {const} PChar; val: {const} PChar; alloc: cint): {const} PAVOption; +function av_set_string3(obj: Pointer; name: {const} PAnsiChar; val: {const} PAnsiChar; alloc: cint; out o_out: {const} PAVOption): cint; cdecl; external av__codec; {$IFEND} -function av_set_double(obj: pointer; name: {const} pchar; n: cdouble): PAVOption; +function av_set_double(obj: pointer; name: {const} PAnsiChar; n: cdouble): PAVOption; cdecl; external av__codec; -function av_set_q(obj: pointer; name: {const} pchar; n: TAVRational): PAVOption; +function av_set_q(obj: pointer; name: {const} PAnsiChar; n: TAVRational): PAVOption; cdecl; external av__codec; -function av_set_int(obj: pointer; name: {const} pchar; n: cint64): PAVOption; +function av_set_int(obj: pointer; name: {const} PAnsiChar; n: cint64): PAVOption; cdecl; external av__codec; -function av_get_double(obj: pointer; name: {const} pchar; var o_out: PAVOption): cdouble; +function av_get_double(obj: pointer; name: {const} PAnsiChar; var o_out: PAVOption): cdouble; cdecl; external av__codec; -function av_get_q(obj: pointer; name: {const} pchar; var o_out: PAVOption): TAVRational; +function av_get_q(obj: pointer; name: {const} PAnsiChar; var o_out: PAVOption): TAVRational; cdecl; external av__codec; -function av_get_int(obj: pointer; name: {const} pchar; var o_out: {const} PAVOption): cint64; +function av_get_int(obj: pointer; name: {const} PAnsiChar; var o_out: {const} PAVOption): cint64; cdecl; external av__codec; -function av_get_string(obj: pointer; name: {const} pchar; var o_out: {const} PAVOption; buf: pchar; buf_len: cint): pchar; +function av_get_string(obj: pointer; name: {const} PAnsiChar; var o_out: {const} PAVOption; buf: PAnsiChar; buf_len: cint): PAnsiChar; cdecl; external av__codec; function av_next_option(obj: pointer; last: {const} PAVOption): PAVOption; diff --git a/unicode/src/lib/ffmpeg/rational.pas b/unicode/src/lib/ffmpeg/rational.pas index 02d594ff..6762aa26 100644 --- a/unicode/src/lib/ffmpeg/rational.pas +++ b/unicode/src/lib/ffmpeg/rational.pas @@ -1,5 +1,5 @@ (* - * Rational numbers + * rational numbers * Copyright (c) 2003 Michael Niedermayer <michaelni@gmx.at> * * This library is free software; you can redistribute it and/or @@ -27,7 +27,7 @@ (* * Conversion of libavutil/rational.h - * revision 15415, Thu Sep 25 19:23:13 2008 UTC + * revision 16912, Sun Feb 1 02:00:19 2009 UTC *) unit rational; @@ -49,9 +49,9 @@ uses UConfig; type -(* - * Rational number num/den. - *) + (* + * rational number numerator/denominator + *) PAVRational = ^TAVRational; TAVRational = record num: cint; ///< numerator @@ -62,65 +62,65 @@ type PAVRationalArray = ^TAVRationalArray; (** - * Compare two rationals. + * Compares two rationals. * @param a first rational * @param b second rational - * @return 0 if a==b, 1 if a>b and -1 if a<b. + * @return 0 if a==b, 1 if a>b and -1 if a<b *) function av_cmp_q(a: TAVRational; b: TAVRational): cint; {$IFDEF HasInline}inline;{$ENDIF} (** - * Rational to double conversion. + * Converts rational to double. * @param a rational to convert * @return (double) a *) function av_q2d(a: TAVRational): cdouble; {$IFDEF HasInline}inline;{$ENDIF} (** - * Reduce a fraction. + * Reduces a fraction. * This is useful for framerate calculations. - * @param dst_nom destination numerator + * @param dst_num destination numerator * @param dst_den destination denominator - * @param nom source numerator + * @param num source numerator * @param den source denominator - * @param max the maximum allowed for dst_nom & dst_den + * @param max the maximum allowed for dst_num & dst_den * @return 1 if exact, 0 otherwise *) -function av_reduce(dst_nom: PCint; dst_den: PCint; nom: cint64; den: cint64; max: cint64): cint; +function av_reduce(dst_num: PCint; dst_den: PCint; num: cint64; den: cint64; max: cint64): cint; cdecl; external av__util; (** * Multiplies two rationals. - * @param b first rational. - * @param c second rational. - * @return b*c. + * @param b first rational + * @param c second rational + * @return b*c *) function av_mul_q(b: TAVRational; c: TAVRational): TAVRational; cdecl; external av__util; {av_const} (** * Divides one rational by another. - * @param b first rational. - * @param c second rational. - * @return b/c. + * @param b first rational + * @param c second rational + * @return b/c *) function av_div_q(b: TAVRational; c: TAVRational): TAVRational; cdecl; external av__util; {av_const} (** * Adds two rationals. - * @param b first rational. - * @param c second rational. - * @return b+c. + * @param b first rational + * @param c second rational + * @return b+c *) function av_add_q(b: TAVRational; c: TAVRational): TAVRational; cdecl; external av__util; {av_const} (** * Subtracts one rational from another. - * @param b first rational. - * @param c second rational. - * @return b-c. + * @param b first rational + * @param c second rational + * @return b-c *) function av_sub_q(b: TAVRational; c: TAVRational): TAVRational; cdecl; external av__util; {av_const} @@ -129,7 +129,7 @@ function av_sub_q(b: TAVRational; c: TAVRational): TAVRational; * Converts a double precision floating point number to a rational. * @param d double to convert * @param max the maximum allowed numerator and denominator - * @return (AVRational) d. + * @return (AVRational) d *) function av_d2q(d: cdouble; max: cint): TAVRational; cdecl; external av__util; {av_const} diff --git a/unicode/src/lib/requirements.txt b/unicode/src/lib/requirements.txt index ace3165a..d3955585 100644 --- a/unicode/src/lib/requirements.txt +++ b/unicode/src/lib/requirements.txt @@ -44,5 +44,5 @@ Install the FreePascal compiler (version 2.2.2 or later) using fink or a package Install these libs and their dependences using fink: - fink install pkgconfig ffmpeg libavcodec-dev libavformat-dev libavutil-dev libswscale-dev libtheora0 - fink install portaudio2 SDL SDL-image SDL-ttf libpng3 imlib2 sqlite3-dev
\ No newline at end of file + fink install pkgconfig libavcodec-dev libavformat-dev libavutil-dev libswscale-dev + fink install portaudio2 SDL SDL-image libpng3 sqlite3-dev
\ No newline at end of file diff --git a/unicode/src/macosx/PseudoThread.pas b/unicode/src/macosx/PseudoThread.pas index 5764395d..d74285f7 100644 --- a/unicode/src/macosx/PseudoThread.pas +++ b/unicode/src/macosx/PseudoThread.pas @@ -37,23 +37,24 @@ type // Debugging threads with XCode doesn't seem to work. // We use PseudoThread in Debug mode to get proper debugging. + TPseudoThread = class(TObject) private protected Terminated, - FreeOnTerminate : Boolean; + FreeOnTerminate: boolean; procedure Execute; virtual; abstract; procedure Resume; procedure Suspend; public - constructor Create(const suspended : Boolean); + constructor Create(const suspended : boolean); end; implementation { TPseudoThread } -constructor TPseudoThread.Create(const suspended : Boolean); +constructor TPseudoThread.Create(const suspended: boolean); begin if not suspended then begin diff --git a/unicode/src/macosx/Windows.pas b/unicode/src/macosx/Windows.pas deleted file mode 100644 index 28b5c99f..00000000 --- a/unicode/src/macosx/Windows.pas +++ /dev/null @@ -1,194 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit Windows; - -{$I switches.inc} - -interface - -uses - Types; - -const - opengl32 = 'OpenGL'; - MAX_PATH = 260; - -type - - DWORD = Types.DWORD; - {$EXTERNALSYM DWORD} - BOOL = LongBool; - {$EXTERNALSYM BOOL} - PBOOL = ^BOOL; - {$EXTERNALSYM PBOOL} - PByte = Types.PByte; - PINT = ^Integer; - {$EXTERNALSYM PINT} - PSingle = ^Single; - PWORD = ^Word; - {$EXTERNALSYM PWORD} - PDWORD = ^DWORD; - {$EXTERNALSYM PDWORD} - LPDWORD = PDWORD; - {$EXTERNALSYM LPDWORD} - HDC = type LongWord; - {$EXTERNALSYM HDC} - HGLRC = type LongWord; - {$EXTERNALSYM HGLRC} - TLargeInteger = Int64; - HFONT = type LongWord; - {$EXTERNALSYM HFONT} - HWND = type LongWord; - {$EXTERNALSYM HWND} - - PPaletteEntry = ^TPaletteEntry; - {$EXTERNALSYM tagPALETTEENTRY} - tagPALETTEENTRY = packed record - peRed: Byte; - peGreen: Byte; - peBlue: Byte; - peFlags: Byte; - end; - TPaletteEntry = tagPALETTEENTRY; - {$EXTERNALSYM PALETTEENTRY} - PALETTEENTRY = tagPALETTEENTRY; - - PRGBQuad = ^TRGBQuad; - {$EXTERNALSYM tagRGBQUAD} - tagRGBQUAD = packed record - rgbBlue: Byte; - rgbGreen: Byte; - rgbRed: Byte; - rgbReserved: Byte; - end; - TRGBQuad = tagRGBQUAD; - {$EXTERNALSYM RGBQUAD} - RGBQUAD = tagRGBQUAD; - - PBitmapInfoHeader = ^TBitmapInfoHeader; - {$EXTERNALSYM tagBITMAPINFOHEADER} - tagBITMAPINFOHEADER = packed record - biSize: DWORD; - biWidth: Longint; - biHeight: Longint; - biPlanes: Word; - biBitCount: Word; - biCompression: DWORD; - biSizeImage: DWORD; - biXPelsPerMeter: Longint; - biYPelsPerMeter: Longint; - biClrUsed: DWORD; - biClrImportant: DWORD; - end; - TBitmapInfoHeader = tagBITMAPINFOHEADER; - {$EXTERNALSYM BITMAPINFOHEADER} - BITMAPINFOHEADER = tagBITMAPINFOHEADER; - - PBitmapInfo = ^TBitmapInfo; - {$EXTERNALSYM tagBITMAPINFO} - tagBITMAPINFO = packed record - bmiHeader: TBitmapInfoHeader; - bmiColors: array[0..0] of TRGBQuad; - end; - TBitmapInfo = tagBITMAPINFO; - {$EXTERNALSYM BITMAPINFO} - BITMAPINFO = tagBITMAPINFO; - - PBitmapFileHeader = ^TBitmapFileHeader; - {$EXTERNALSYM tagBITMAPFILEHEADER} - tagBITMAPFILEHEADER = packed record - bfType: Word; - bfSize: DWORD; - bfReserved1: Word; - bfReserved2: Word; - bfOffBits: DWORD; - end; - TBitmapFileHeader = tagBITMAPFILEHEADER; - {$EXTERNALSYM BITMAPFILEHEADER} - BITMAPFILEHEADER = tagBITMAPFILEHEADER; - - -function MakeLong(a, b: Word): Longint; -procedure ZeroMemory(Destination: Pointer; Length: DWORD); -function QueryPerformanceFrequency(var lpFrequency: TLargeInteger): BOOL; -function QueryPerformanceCounter(var lpPerformanceCount: TLargeInteger): BOOL; -function GetTickCount : Cardinal; -Procedure ShowMessage(msg : String); -procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: DWORD); - -implementation - -uses - SDL; - -procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: DWORD); -begin - Move(Source^, Destination^, Length); -end; - -procedure ShowMessage(msg : String); -begin - // to be implemented -end; - -function MakeLong(A, B: Word): Longint; -begin - Result := (LongInt(B) shl 16) + A; -end; - -procedure ZeroMemory(Destination: Pointer; Length: DWORD); -begin - FillChar( Destination^, Length, 0); -end; - -function QueryPerformanceFrequency(var lpFrequency: TLargeInteger): BOOL; -begin -{$IFDEF MSWINDOWS} - Result := Windows.QueryPerformanceFrequency(lpFrequency); -{$ENDIF} -{$IFDEF MACOS} - Result := true; - lpFrequency := 1000; -{$ENDIF} -end; - -function QueryPerformanceCounter(var lpPerformanceCount: TLargeInteger): BOOL; -begin -{$IFDEF MSWINDOWS} - Result := Windows.QueryPerformanceCounter(lpPerformanceCount); -{$ENDIF} -{$IFDEF MACOS} - Result := true; - lpPerformanceCount := SDL_GetTicks; -{$ENDIF} -end; - -function GetTickCount : Cardinal; -begin - Result := SDL_GetTicks; -end; - -end. diff --git a/unicode/src/media/UAudioConverter.pas b/unicode/src/media/UAudioConverter.pas index 24131b16..657b80dd 100644 --- a/unicode/src/media/UAudioConverter.pas +++ b/unicode/src/media/UAudioConverter.pas @@ -70,7 +70,7 @@ type function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; destructor Destroy(); override; - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; + function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; override; function GetOutputBufferSize(InputSize: integer): integer; override; function GetRatio(): double; override; end; @@ -87,7 +87,7 @@ type function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; destructor Destroy(); override; - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; + function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; override; function GetOutputBufferSize(InputSize: integer): integer; override; function GetRatio(): double; override; end; @@ -103,7 +103,7 @@ type function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; destructor Destroy(); override; - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; + function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; override; function GetOutputBufferSize(InputSize: integer): integer; override; function GetRatio(): double; override; end; @@ -173,7 +173,7 @@ begin Result := cvt.len_ratio; end; -function TAudioConverter_SDL.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; +function TAudioConverter_SDL.Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; begin Result := -1; @@ -242,7 +242,7 @@ begin inherited; end; -function TAudioConverter_FFmpeg.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; +function TAudioConverter_FFmpeg.Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; var InputSampleCount: integer; OutputSampleCount: integer; @@ -360,11 +360,11 @@ begin inherited; end; -function TAudioConverter_SRC.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; +function TAudioConverter_SRC.Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; var FloatInputBuffer: PSingle; FloatOutputBuffer: PSingle; - TempBuffer: PChar; + TempBuffer: PByteArray; TempSize: integer; NumSamples: integer; OutputSize: integer; diff --git a/unicode/src/media/UAudioDecoder_Bass.pas b/unicode/src/media/UAudioDecoder_Bass.pas index 3c31175d..6bbdaeaa 100644 --- a/unicode/src/media/UAudioDecoder_Bass.pas +++ b/unicode/src/media/UAudioDecoder_Bass.pas @@ -65,7 +65,7 @@ type function IsEOF(): boolean; override; function IsError(): boolean; override; - function ReadData(Buffer: PChar; BufSize: integer): integer; override; + function ReadData(Buffer: PByteArray; BufSize: integer): integer; override; end; type @@ -193,7 +193,7 @@ begin Result := Error; end; -function TBassDecodeStream.ReadData(Buffer: PChar; BufSize: integer): integer; +function TBassDecodeStream.ReadData(Buffer: PByteArray; BufSize: integer): integer; begin Result := BASS_ChannelGetData(Handle, Buffer, BufSize); // check error state (do not handle EOF as error) @@ -237,7 +237,7 @@ begin // TODO: use BASS_STREAM_PRESCAN for accurate seeking in VBR-files? // disadvantage: seeking will slow down. - Stream := BASS_StreamCreateFile(False, PChar(Filename), 0, 0, BASS_STREAM_DECODE); + Stream := BASS_StreamCreateFile(False, PAnsiChar(Filename), 0, 0, BASS_STREAM_DECODE); if (Stream = 0) then begin //Log.LogError(BassCore.ErrorGetString(), 'TAudioDecoder_Bass.Open'); diff --git a/unicode/src/media/UAudioDecoder_FFmpeg.pas b/unicode/src/media/UAudioDecoder_FFmpeg.pas index 399c2f52..2d221f40 100644 --- a/unicode/src/media/UAudioDecoder_FFmpeg.pas +++ b/unicode/src/media/UAudioDecoder_FFmpeg.pas @@ -57,7 +57,6 @@ implementation uses Classes, - SysUtils, Math, UMusic, UIni, @@ -68,8 +67,9 @@ uses avio, mathematics, // used for av_rescale_q rational, - UMediaCore_FFmpeg, SDL, + SysUtils, + UMediaCore_FFmpeg, ULog, UCommon, UConfig; @@ -129,14 +129,14 @@ type // state-vars for DecodeFrame (locked by DecoderLock) AudioPaket: TAVPacket; - AudioPaketData: PChar; + AudioPaketData: PByteArray; AudioPaketSize: integer; AudioPaketSilence: integer; // number of bytes of silence to return // state-vars for AudioCallback (locked by DecoderLock) AudioBufferPos: integer; AudioBufferSize: integer; - AudioBuffer: PChar; + AudioBuffer: PByteArray; Filename: string; @@ -153,7 +153,7 @@ type procedure PauseParser(); procedure ResumeParser(); - function DecodeFrame(Buffer: PChar; BufferSize: integer): integer; + function DecodeFrame(Buffer: PByteArray; BufferSize: integer): integer; procedure FlushCodecBuffers(); procedure PauseDecoder(); procedure ResumeDecoder(); @@ -173,11 +173,11 @@ type function IsEOF(): boolean; override; function IsError(): boolean; override; - function ReadData(Buffer: PChar; BufferSize: integer): integer; override; + function ReadData(Buffer: PByteArray; BufferSize: integer): integer; override; end; type - TAudioDecoder_FFmpeg = class( TInterfacedObject, IAudioDecoder ) + TAudioDecoder_FFmpeg = class(TInterfacedObject, IAudioDecoder) public function GetName: string; @@ -289,7 +289,7 @@ begin Self.Filename := Filename; // open audio file - if (av_open_input_file(FormatCtx, PChar(Filename), nil, 0, nil) <> 0) then + if (av_open_input_file(FormatCtx, PAnsiChar(Filename), nil, 0, nil) <> 0) then begin Log.LogError('av_open_input_file failed: "' + Filename + '"', 'UAudio_FFmpeg'); Exit; @@ -310,7 +310,7 @@ begin FormatCtx^.pb.eof_reached := 0; {$IFDEF DebugFFmpegDecode} - dump_format(FormatCtx, 0, pchar(Filename), 0); + dump_format(FormatCtx, 0, PAnsiChar(Filename), 0); {$ENDIF} AudioStreamIndex := FFmpegCore.FindAudioStreamIndex(FormatCtx); @@ -862,7 +862,7 @@ begin end; end; -function TFFmpegDecodeStream.DecodeFrame(Buffer: PChar; BufferSize: integer): integer; +function TFFmpegDecodeStream.DecodeFrame(Buffer: PByteArray; BufferSize: integer): integer; var PaketDecodedSize: integer; // size of packet data used for decoding DataSize: integer; // size of output data decoded by FFmpeg @@ -945,7 +945,7 @@ begin Exit; // handle Status-packet - if (PChar(AudioPaket.data) = STATUS_PACKET) then + if (PAnsiChar(AudioPaket.data) = STATUS_PACKET) then begin AudioPaket.data := nil; AudioPaketData := nil; @@ -986,7 +986,7 @@ begin Continue; end; - AudioPaketData := PChar(AudioPaket.data); + AudioPaketData := AudioPaket.data; AudioPaketSize := AudioPaket.size; // if available, update the stream position to the presentation time of this package @@ -1005,7 +1005,7 @@ begin end; end; -function TFFmpegDecodeStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +function TFFmpegDecodeStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer; var CopyByteCount: integer; // number of bytes to copy RemainByteCount: integer; // number of bytes left (remain) to read diff --git a/unicode/src/media/UAudioPlayback_Bass.pas b/unicode/src/media/UAudioPlayback_Bass.pas index d68ac1d4..923c1d7b 100644 --- a/unicode/src/media/UAudioPlayback_Bass.pas +++ b/unicode/src/media/UAudioPlayback_Bass.pas @@ -37,7 +37,6 @@ implementation uses Classes, - SysUtils, Math, UIni, UMain, @@ -46,7 +45,8 @@ uses UAudioCore_Bass, ULog, sdl, - bass; + bass, + SysUtils; type PHDSP = ^HDSP; @@ -90,7 +90,7 @@ type function GetAudioFormatInfo(): TAudioFormatInfo; override; - function ReadData(Buffer: PChar; BufferSize: integer): integer; + function ReadData(Buffer: PByteArray; BufferSize: integer): integer; property EOF: boolean READ IsEOF; end; @@ -106,8 +106,8 @@ type function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override; procedure Close(); override; - procedure WriteData(Buffer: PChar; BufferSize: integer); override; - function ReadData(Buffer: PChar; BufferSize: integer): integer; override; + procedure WriteData(Buffer: PByteArray; BufferSize: integer); override; + function ReadData(Buffer: PByteArray; BufferSize: integer): integer; override; function IsEOF(): boolean; override; function IsError(): boolean; override; end; @@ -163,14 +163,14 @@ begin Result := BytesRead; end; -function TBassPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +function TBassPlaybackStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer; var AdjustedSize: integer; RequestedSourceSize, SourceSize: integer; SkipCount: integer; SourceFormatInfo: TAudioFormatInfo; FrameSize: integer; - PadFrame: PChar; + PadFrame: PByteArray; //Info: BASS_INFO; //Latency: double; begin @@ -610,7 +610,7 @@ begin inherited Close(); end; -procedure TBassVoiceStream.WriteData(Buffer: PChar; BufferSize: integer); +procedure TBassVoiceStream.WriteData(Buffer: PByteArray; BufferSize: integer); var QueueSize: DWORD; begin if ((Handle <> 0) and (BufferSize > 0)) then @@ -626,7 +626,7 @@ begin end; // Note: we do not need the read-function for the BASS implementation -function TBassVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +function TBassVoiceStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer; begin Result := -1; end; diff --git a/unicode/src/media/UAudioPlayback_SDL.pas b/unicode/src/media/UAudioPlayback_SDL.pas index b0887676..8403ef03 100644 --- a/unicode/src/media/UAudioPlayback_SDL.pas +++ b/unicode/src/media/UAudioPlayback_SDL.pas @@ -33,16 +33,14 @@ interface {$I switches.inc} -uses - Classes, - SysUtils, - UMusic; - implementation uses + Classes, sdl, + SysUtils, UAudioPlayback_SoftMixer, + UMusic, ULog, UIni, UMain; @@ -60,13 +58,13 @@ type function GetLatency(): double; override; public function GetName: String; override; - procedure MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); override; + procedure MixBuffers(dst, src: PByteArray; size: Cardinal; volume: Single); override; end; { TAudioPlayback_SDL } -procedure SDLAudioCallback(userdata: Pointer; stream: PChar; len: integer); cdecl; +procedure SDLAudioCallback(userdata: Pointer; stream: PByteArray; len: integer); cdecl; var Engine: TAudioPlayback_SDL; begin @@ -172,7 +170,7 @@ begin Result := Latency; end; -procedure TAudioPlayback_SDL.MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); +procedure TAudioPlayback_SDL.MixBuffers(dst, src: PByteArray; size: Cardinal; volume: Single); begin SDL_MixAudio(PUInt8(dst), PUInt8(src), size, Round(volume * SDL_MIX_MAXVOLUME)); end; diff --git a/unicode/src/media/UAudioPlayback_SoftMixer.pas b/unicode/src/media/UAudioPlayback_SoftMixer.pas index f3797dd6..c8da6bcd 100644 --- a/unicode/src/media/UAudioPlayback_SoftMixer.pas +++ b/unicode/src/media/UAudioPlayback_SoftMixer.pas @@ -35,8 +35,8 @@ interface uses Classes, - SysUtils, sdl, + SysUtils, URingBuffer, UMusic, UAudioPlaybackBase; @@ -48,12 +48,12 @@ type private Engine: TAudioPlayback_SoftMixer; - SampleBuffer: PChar; + SampleBuffer: PByteArray; SampleBufferSize: integer; SampleBufferCount: integer; // number of available bytes in SampleBuffer SampleBufferPos: cardinal; - SourceBuffer: PChar; + SourceBuffer: PByteArray; SourceBufferSize: integer; SourceBufferCount: integer; // number of available bytes in SourceBuffer @@ -70,7 +70,7 @@ type procedure Reset(); - procedure ApplySoundEffects(Buffer: PChar; BufferSize: integer); + procedure ApplySoundEffects(Buffer: PByteArray; BufferSize: integer); function InitFormatConversion(): boolean; procedure FlushBuffers(); @@ -100,7 +100,7 @@ type function GetAudioFormatInfo(): TAudioFormatInfo; override; - function ReadData(Buffer: PChar; BufferSize: integer): integer; + function ReadData(Buffer: PByteArray; BufferSize: integer): integer; function GetPCMData(var Data: TPCMData): Cardinal; override; procedure GetFFTData(var Data: TFFTData); override; @@ -114,7 +114,7 @@ type Engine: TAudioPlayback_SoftMixer; ActiveStreams: TList; - MixerBuffer: PChar; + MixerBuffer: PByteArray; InternalLock: PSDL_Mutex; AppVolume: single; @@ -129,7 +129,7 @@ type destructor Destroy(); override; procedure AddStream(Stream: TAudioPlaybackStream); procedure RemoveStream(Stream: TAudioPlaybackStream); - function ReadData(Buffer: PChar; BufferSize: integer): integer; + function ReadData(Buffer: PByteArray; BufferSize: integer): integer; property Volume: single read GetVolume write SetVolume; end; @@ -144,7 +144,7 @@ type function StartAudioPlaybackEngine(): boolean; virtual; abstract; procedure StopAudioPlaybackEngine(); virtual; abstract; function FinalizeAudioPlaybackEngine(): boolean; virtual; abstract; - procedure AudioCallback(Buffer: PChar; Size: integer); {$IFDEF HasInline}inline;{$ENDIF} + procedure AudioCallback(Buffer: PByteArray; Size: integer); {$IFDEF HasInline}inline;{$ENDIF} function CreatePlaybackStream(): TAudioPlaybackStream; override; public @@ -159,7 +159,7 @@ type function GetMixer(): TAudioMixerStream; {$IFDEF HasInline}inline;{$ENDIF} function GetAudioFormatInfo(): TAudioFormatInfo; - procedure MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); virtual; + procedure MixBuffers(DstBuffer, SrcBuffer: PByteArray; Size: Cardinal; Volume: Single); virtual; end; type @@ -174,8 +174,8 @@ type function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override; procedure Close(); override; - procedure WriteData(Buffer: PChar; BufferSize: integer); override; - function ReadData(Buffer: PChar; BufferSize: integer): integer; override; + procedure WriteData(Buffer: PByteArray; BufferSize: integer); override; + function ReadData(Buffer: PByteArray; BufferSize: integer): integer; override; function IsEOF(): boolean; override; function IsError(): boolean; override; end; @@ -276,7 +276,7 @@ begin Unlock(); end; -function TAudioMixerStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +function TAudioMixerStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer; var i: integer; Size: integer; @@ -545,7 +545,7 @@ begin SourceBufferCount := 0; end; -procedure TGenericPlaybackStream.ApplySoundEffects(Buffer: PChar; BufferSize: integer); +procedure TGenericPlaybackStream.ApplySoundEffects(Buffer: PByteArray; BufferSize: integer); var i: integer; begin @@ -558,7 +558,7 @@ begin end; end; -function TGenericPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +function TGenericPlaybackStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer; var ConversionInputCount: integer; ConversionOutputSize: integer; // max. number of converted data (= buffer size) @@ -573,7 +573,7 @@ var SkipSourceCount: integer; // number of source-data bytes to skip FillCount: integer; // number of bytes to fill with padding data CopyCount: integer; - PadFrame: PChar; + PadFrame: PByteArray; i: integer; begin Result := -1; @@ -986,7 +986,7 @@ begin inherited Close(); end; -procedure TGenericVoiceStream.WriteData(Buffer: PChar; BufferSize: integer); +procedure TGenericVoiceStream.WriteData(Buffer: PByteArray; BufferSize: integer); begin // lock access to buffer SDL_mutexP(BufferLock); @@ -999,7 +999,7 @@ begin end; end; -function TGenericVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +function TGenericVoiceStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer; begin Result := -1; @@ -1059,7 +1059,7 @@ begin Result := true; end; -procedure TAudioPlayback_SoftMixer.AudioCallback(Buffer: PChar; Size: integer); +procedure TAudioPlayback_SoftMixer.AudioCallback(Buffer: PByteArray; Size: integer); begin MixerStream.ReadData(Buffer, Size); end; @@ -1102,7 +1102,7 @@ begin MixerStream.Volume := Volume; end; -procedure TAudioPlayback_SoftMixer.MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); +procedure TAudioPlayback_SoftMixer.MixBuffers(DstBuffer, SrcBuffer: PByteArray; Size: Cardinal; Volume: Single); var SampleIndex: Cardinal; SampleInt: Integer; diff --git a/unicode/src/media/UVideo.pas b/unicode/src/media/UVideo.pas index 06577d9e..35f8ab4d 100644 --- a/unicode/src/media/UVideo.pas +++ b/unicode/src/media/UVideo.pas @@ -126,6 +126,7 @@ type fFrameBuffer: PByte; //**< stores a FFmpeg video frame fFrameTex: GLuint; //**< OpenGL texture for FrameBuffer + fFrameTexValid: boolean; //**< if true, fFrameTex contains the current frame fTexWidth, fTexHeight: cardinal; {$IFDEF UseSWScale} @@ -137,11 +138,11 @@ type fTimeBase: extended; //**< FFmpeg time base per time unit fTime: extended; //**< video time position (absolute) - fLoopTime: extended; //**< video time position (relative to current loop) + fLoopTime: extended; //**< start time of the current loop procedure Reset(); - function DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; - procedure SynchronizeVideo(Frame: PAVFrame; var pts: double); + function DecodeFrame(): boolean; + procedure SynchronizeTime(Frame: PAVFrame; var pts: double); procedure GetVideoRect(var ScreenRect, TexRect: TRectCoords); @@ -240,6 +241,7 @@ begin fTime := 0; fStream := nil; fStreamIndex := -1; + fFrameTexValid := false; fEOF := false; @@ -453,7 +455,7 @@ begin fOpened := False; end; -procedure TVideoPlayback_FFmpeg.SynchronizeVideo(Frame: PAVFrame; var pts: double); +procedure TVideoPlayback_FFmpeg.SynchronizeTime(Frame: PAVFrame; var pts: double); var FrameDelay: double; begin @@ -473,12 +475,21 @@ begin fTime := fTime + FrameDelay; end; -function TVideoPlayback_FFmpeg.DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; +{** + * Decode a new frame from the video stream. + * The decoded frame is stored in fAVFrame. fTime is updated to the new frame's + * time. + * @param pts will be updated to the presentation time of the decoded frame. + * returns true if a frame could be decoded. False if an error or EOF occured. + *} +function TVideoPlayback_FFmpeg.DecodeFrame(): boolean; var FrameFinished: Integer; VideoPktPts: int64; pbIOCtx: PByteIOContext; errnum: integer; + AVPacket: TAVPacket; + pts: double; begin Result := false; FrameFinished := 0; @@ -521,8 +532,17 @@ begin end; // no error -> wait for user input - SDL_Delay(100); +{ + SDL_Delay(100); // initial version, left for documentation continue; +} + + // Patch by Hawkear: + // Why should this function loop in an endless loop if there is an error? + // This runs in the main thread, so it halts the whole program + // Therefore, it is better to exit when an error occurs + Exit; + end; // if we got a packet from the video stream, then decode it @@ -555,9 +575,9 @@ begin end; pts := pts * av_q2d(fStream^.time_base); - // synchronize on each complete frame + // synchronize time on each complete frame if (frameFinished <> 0) then - SynchronizeVideo(fAVFrame, pts); + SynchronizeTime(fAVFrame, pts); end; // free the packet from av_read_frame @@ -569,13 +589,12 @@ end; procedure TVideoPlayback_FFmpeg.GetFrame(Time: Extended); var - AVPacket: TAVPacket; errnum: Integer; - myTime: Extended; + NewTime: Extended; TimeDifference: Extended; DropFrameCount: Integer; - pts: double; i: Integer; + Success: boolean; const FRAME_DROPCOUNT = 3; begin @@ -585,41 +604,50 @@ begin if fPaused then Exit; - // current time, relative to last fLoop (if any) - myTime := Time - fLoopTime; - // time since the last frame was returned - TimeDifference := myTime - fTime; + // requested stream position (relative to the last loop's start) + NewTime := Time - fLoopTime; - {$IFDEF DebugDisplay} - DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak + - 'VideoTime: '+inttostr(floor(fTime*1000)) + sLineBreak + - 'TimeBase: '+inttostr(floor(fTimeBase*1000)) + sLineBreak + - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); - {$endif} - - // check if a new frame is needed - if (fTime <> 0) and (TimeDifference < fTimeBase) then + // check if current texture still contains the active frame + if (fFrameTexValid) then begin - {$ifdef DebugFrames} - // frame delay debug display - GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00); - {$endif} + // time since the last frame was returned + TimeDifference := NewTime - fTime; {$IFDEF DebugDisplay} - DebugWriteln('not getting new frame' + sLineBreak + - 'Time: '+inttostr(floor(Time*1000)) + sLineBreak + - 'VideoTime: '+inttostr(floor(fTime*1000)) + sLineBreak + - 'TimeBase: '+inttostr(floor(fTimeBase*1000)) + sLineBreak + - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); + DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak + + 'VideoTime: '+inttostr(floor(fTime*1000)) + sLineBreak + + 'TimeBase: '+inttostr(floor(fTimeBase*1000)) + sLineBreak + + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); {$endif} - // we do not need a new frame now - Exit; + // check if last time is more than one frame in the past + if (TimeDifference < fTimeBase) then + begin + {$ifdef DebugFrames} + // frame delay debug display + GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00); + {$endif} + + {$IFDEF DebugDisplay} + DebugWriteln('not getting new frame' + sLineBreak + + 'Time: '+inttostr(floor(Time*1000)) + sLineBreak + + 'VideoTime: '+inttostr(floor(fTime*1000)) + sLineBreak + + 'TimeBase: '+inttostr(floor(fTimeBase*1000)) + sLineBreak + + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); + {$endif} + + // we do not need a new frame now + Exit; + end; end; - // update video-time to the next frame - fTime := fTime + fTimeBase; - TimeDifference := myTime - fTime; + {$IFDEF VideoBenchmark} + Log.BenchmarkStart(15); + {$ENDIF} + + // fetch new frame (updates fTime) + Success := DecodeFrame(); + TimeDifference := NewTime - fTime; // check if we have to skip frames if (TimeDifference >= FRAME_DROPCOUNT*fTimeBase) then @@ -640,19 +668,18 @@ begin // skip half of the frames, this is much smoother than to skip all at once for i := 1 to DropFrameCount (*div 2*) do - DecodeFrame(AVPacket, pts); + Success := DecodeFrame(); end; - {$IFDEF VideoBenchmark} - Log.BenchmarkStart(15); - {$ENDIF} - - if (not DecodeFrame(AVPacket, pts)) then + // check if we got an EOF or error + if (not Success) then begin if fLoop then begin - // Record the time we looped. This is used to keep the loops in time. otherwise they speed + // we have to loop, so rewind SetPosition(0); + // record the start-time of the current loop, so we can + // determine the position in the stream (fTime-fLoopTime) later. fLoopTime := Time; end; Exit; @@ -695,6 +722,9 @@ begin fCodecContext^.width, fCodecContext^.height, PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, fAVFrameRGB^.data[0]); + if (not fFrameTexValid) then + fFrameTexValid := true; + {$ifdef DebugFrames} //frame decode debug display GoldenRec.Spawn(200, 35, 1, 16, 0, -1, ColoredStar, $ffff00); @@ -738,7 +768,9 @@ begin acoLetterBox: begin ScaledVideoWidth := RenderW; ScaledVideoHeight := RenderH * ScreenAspect/fAspect; - end; + end + else + raise Exception.Create('Unhandled aspect correction!'); end; // center video @@ -762,8 +794,18 @@ var begin // have a nice black background to draw on // (even if there were errors opening the vid) - glClearColor(0, 0, 0, 0); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + // TODO: Philipp: IMO TVideoPlayback should not clear the screen at + // all, because clearing is already done by the background class + // at this moment. + if (Screen = 1) then + begin + // It is important that we just clear once before we start + // drawing the first screen otherwise the first screen + // would be cleared by the drawgl called when the second + // screen is drawn + glClearColor(0, 0, 0, 0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + end; // exit if there's nothing to draw if (not fOpened) then @@ -858,6 +900,14 @@ procedure TVideoPlayback_FFmpeg.Stop; begin end; +{** + * Sets the stream's position. + * The stream is set to the first keyframe with timestamp <= Time. + * Note that fTime is set to Time no matter if the actual position seeked to is + * at Time or the time of a preceding keyframe. fTime will be updated to the + * actual frame time when GetFrame() is called the next time. + * @param Time new position in seconds + *} procedure TVideoPlayback_FFmpeg.SetPosition(Time: real); var SeekFlags: integer; @@ -871,13 +921,18 @@ begin // TODO: handle fLoop-times //Time := Time mod VideoDuration; - // backward seeking might fail without AVSEEK_FLAG_BACKWARD - SeekFlags := AVSEEK_FLAG_ANY; - if (Time < fTime) then - SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD; + // Do not use the AVSEEK_FLAG_ANY here. It will seek to any frame, even + // non keyframes (P-/B-frames). It will produce corrupted video frames as + // FFmpeg does not use the information of the preceding I-frame. + // The picture might be gray or green until the next keyframe occurs. + // Instead seek the first keyframe smaller than the requested time + // (AVSEEK_FLAG_BACKWARD). As this can be some seconds earlier than the + // requested time, let the sync in GetFrame() do its job. + SeekFlags := AVSEEK_FLAG_BACKWARD; fTime := Time; fEOF := false; + fFrameTexValid := false; if (av_seek_frame(fFormatContext, fStreamIndex, Floor(Time/fTimeBase), SeekFlags) < 0) then begin @@ -890,7 +945,6 @@ end; function TVideoPlayback_FFmpeg.GetPosition: real; begin - // TODO: return video-position in seconds Result := fTime; end; diff --git a/unicode/src/media/UVisualizer.pas b/unicode/src/media/UVisualizer.pas index 9af6d8c2..37e0268a 100644 --- a/unicode/src/media/UVisualizer.pas +++ b/unicode/src/media/UVisualizer.pas @@ -484,7 +484,11 @@ begin glMatrixMode(GL_PROJECTION); glPushMatrix(); glLoadIdentity(); - gluOrtho2D(0, 1, 0, 1); + // Use count of screens instead of 1 for the right corner + // otherwise we would draw the visualization streched over both screens + // another point is that we draw over the at this time drawn first + // screen, if Screen = 2 + gluOrtho2D(0, Screens, 0, 1); glMatrixMode(GL_MODELVIEW); glPushMatrix(); glLoadIdentity(); @@ -496,11 +500,12 @@ begin glColor4f(1, 1, 1, 1); // draw projectM frame + // Screen is 1 to 2. So current screen is from (Screen - 1) to (Screen) glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(0, 0); - glTexCoord2f(1, 0); glVertex2f(1, 0); - glTexCoord2f(1, 1); glVertex2f(1, 1); - glTexCoord2f(0, 1); glVertex2f(0, 1); + glTexCoord2f(0, 0); glVertex2f((Screen - 1), 0); + glTexCoord2f(1, 0); glVertex2f(Screen, 0); + glTexCoord2f(1, 1); glVertex2f(Screen, 1); + glTexCoord2f(0, 1); glVertex2f((Screen - 1), 1); glEnd(); glDisable(GL_TEXTURE_2D); diff --git a/unicode/src/menu/UDisplay.pas b/unicode/src/menu/UDisplay.pas index f4cca4a5..3e653183 100644 --- a/unicode/src/menu/UDisplay.pas +++ b/unicode/src/menu/UDisplay.pas @@ -34,7 +34,7 @@ interface {$I switches.inc} uses - ucommon, + UCommon, SDL, UMenu, gl, @@ -86,15 +86,16 @@ var implementation uses - UImage, TextGL, + UCommandLine, + UGraphic, + UIni, + UImage, ULog, UMain, UTexture, - UIni, - UGraphic, UTime, - UCommandLine; + UPath; constructor TDisplay.Create; var diff --git a/unicode/src/menu/UDrawTexture.pas b/unicode/src/menu/UDrawTexture.pas index 33082765..bc136f11 100644 --- a/unicode/src/menu/UDrawTexture.pas +++ b/unicode/src/menu/UDrawTexture.pas @@ -74,7 +74,6 @@ var begin with Texture do begin - // rysuje paski gracza glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha); glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); diff --git a/unicode/src/menu/UMenuBackgroundColor.pas b/unicode/src/menu/UMenuBackgroundColor.pas index 68cf2de4..a5c2a70a 100644 --- a/unicode/src/menu/UMenuBackgroundColor.pas +++ b/unicode/src/menu/UMenuBackgroundColor.pas @@ -52,7 +52,8 @@ type implementation
uses
gl,
- glext;
+ glext,
+ UGraphic;
constructor TMenuBackgroundColor.Create(const ThemedSettings: TThemeBackground);
begin
@@ -62,8 +63,11 @@ end; procedure TMenuBackgroundColor.Draw;
begin
+ if (ScreenAct = 1) then
+ begin //just clear once, even when using two screens
glClearColor(Color.R, Color.G, Color.B, 0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+ end;
end;
end.
\ No newline at end of file diff --git a/unicode/src/menu/UMenuBackgroundFade.pas b/unicode/src/menu/UMenuBackgroundFade.pas index b6174738..dc37da45 100644 --- a/unicode/src/menu/UMenuBackgroundFade.pas +++ b/unicode/src/menu/UMenuBackgroundFade.pas @@ -66,7 +66,8 @@ uses sdl, gl,
glext,
USkins,
- UCommon;
+ UCommon,
+ UGraphic;
constructor TMenuBackgroundFade.Create(const ThemedSettings: TThemeBackground);
var texFilename: string;
@@ -121,7 +122,8 @@ begin if (UseTexture) then
begin //Draw Texture to Screen
- glClear(GL_DEPTH_BUFFER_BIT);
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
glEnable(GL_TEXTURE_2D);
glEnable(GL_BLEND);
@@ -149,7 +151,9 @@ begin end
else
begin //Clear Screen w/ progress Alpha + Color
- glClear(GL_DEPTH_BUFFER_BIT);
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
+
glDisable(GL_TEXTURE_2D);
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
diff --git a/unicode/src/menu/UMenuBackgroundNone.pas b/unicode/src/menu/UMenuBackgroundNone.pas index 6b63742a..1fccc007 100644 --- a/unicode/src/menu/UMenuBackgroundNone.pas +++ b/unicode/src/menu/UMenuBackgroundNone.pas @@ -52,7 +52,8 @@ type implementation
uses
gl,
- glext;
+ glext,
+ UGraphic;
constructor TMenuBackgroundNone.Create(const ThemedSettings: TThemeBackground);
begin
@@ -62,7 +63,8 @@ end; procedure TMenuBackgroundNone.Draw;
begin
//Do just nothing in here!
- glClear(GL_DEPTH_BUFFER_BIT);
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
end;
end.
\ No newline at end of file diff --git a/unicode/src/menu/UMenuBackgroundTexture.pas b/unicode/src/menu/UMenuBackgroundTexture.pas index e8678fc5..a1b9e88a 100644 --- a/unicode/src/menu/UMenuBackgroundTexture.pas +++ b/unicode/src/menu/UMenuBackgroundTexture.pas @@ -61,7 +61,8 @@ uses UCommon,
SysUtils,
gl,
- glext;
+ glext,
+ UGraphic;
constructor TMenuBackgroundTexture.Create(const ThemedSettings: TThemeBackground);
var texFilename: string;
@@ -92,7 +93,9 @@ end; procedure TMenuBackgroundTexture.Draw;
begin
- glClear(GL_DEPTH_BUFFER_BIT);
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
+
glColorRGB(Color);
glEnable(GL_TEXTURE_2D);
diff --git a/unicode/src/menu/UMenuBackgroundVideo.pas b/unicode/src/menu/UMenuBackgroundVideo.pas index 377c2170..d1ce0f09 100644 --- a/unicode/src/menu/UMenuBackgroundVideo.pas +++ b/unicode/src/menu/UMenuBackgroundVideo.pas @@ -105,7 +105,8 @@ uses SysUtils,
UTime,
USkins,
- UCommon;
+ UCommon,
+ UGraphic;
constructor TMenuBackgroundVideo.Create(const ThemedSettings: TThemeBackground);
begin
@@ -146,7 +147,8 @@ end; procedure TMenuBackgroundVideo.Draw;
begin
- glClear(GL_DEPTH_BUFFER_BIT);
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
VideoPlayback.GetFrame(VideoBGTimer.GetTime());
// FIXME: why do we draw on screen 2? Seems to be wrong.
diff --git a/unicode/src/menu/UMenuButton.pas b/unicode/src/menu/UMenuButton.pas index a0cdaeef..c6ff8ab7 100644 --- a/unicode/src/menu/UMenuButton.pas +++ b/unicode/src/menu/UMenuButton.pas @@ -45,24 +45,24 @@ type TButton = class protected - SelectBool: Boolean; + SelectBool: boolean; - FadeProgress: Real; - FadeLastTick: Cardinal; + FadeProgress: real; + FadeLastTick: cardinal; DeSelectW, DeSelectH, PosX, - PosY: Real; + PosY: real; constructor Create(); overload; public - Text: Array of TText; + Text: array of TText; Texture: TTexture; // Button Screen position and size Texture2: TTexture; // second texture only used for fading full resolution covers - Colorized: Boolean; + Colorized: boolean; DeSelectTexture: TTexture; // texture for colorized hack FadeTex: TTexture; //Texture for beautiful fading @@ -73,15 +73,15 @@ type Reflection: boolean; Reflectionspacing, - DeSelectReflectionspacing: Real; + DeSelectReflectionspacing: real; Fade, - FadeText: Boolean; + FadeText: boolean; Selectable: boolean; //Number of the Parent Collection, 0 if in no Collection - Parent: Byte; + Parent: byte; SelectColR, SelectColG, @@ -103,13 +103,13 @@ type procedure SetW(Value: real); procedure SetH(Value: real); - procedure SetSelect(Value: Boolean); virtual; + procedure SetSelect(Value: boolean); virtual; property X: real read PosX write SetX; property Y: real read PosY write SetY; property Z: real read Texture.z write Texture.z; property W: real read DeSelectW write SetW; property H: real read DeSelectH write SetH; - property Selected: Boolean read SelectBool write SetSelect; + property Selected: boolean read SelectBool write SetSelect; procedure Draw; virtual; @@ -120,8 +120,9 @@ type implementation -uses SysUtils, - UDrawTexture; +uses + SysUtils, + UDrawTexture; procedure TButton.SetX(Value: real); {var @@ -143,8 +144,8 @@ end; procedure TButton.SetY(Value: real); {var - dY: real; - T: integer; // text} + dY: real; + T: integer; // text} begin {dY := Value - PosY; @@ -164,7 +165,7 @@ begin DeSelectW := Value; - if Not Fade then + if not Fade then begin if SelectBool then Texture.W := SelectW @@ -180,7 +181,7 @@ begin DeSelectH := Value; - if Not Fade then + if not Fade then begin if SelectBool then Texture.H := SelectH @@ -189,9 +190,9 @@ begin end; end; -procedure TButton.SetSelect(Value : Boolean); +procedure TButton.SetSelect(Value : boolean); var - T: integer; + T: integer; begin SelectBool := Value; @@ -291,9 +292,9 @@ end; procedure TButton.Draw; var - T: integer; - Tick: Cardinal; - Spacing: Real; + T: integer; + Tick: cardinal; + Spacing: real; begin if Visible then begin @@ -315,7 +316,7 @@ begin if (FadeText) then begin - For T := 0 to high(Text) do + for T := 0 to high(Text) do begin Text[T].MoveX := (SelectW - DeSelectW) * FadeProgress; Text[T].MoveY := (SelectH - DeSelectH) * FadeProgress; @@ -353,7 +354,7 @@ begin FadeTex.TexY1 := 0; FadeTex.TexY2 := 1; - Case FadeTexPos of + case FadeTexPos of 0: //FadeTex on Top begin //Standard Texture @@ -465,7 +466,7 @@ begin //Reflection Mod if (Reflection) then // Draw Reflections begin - if (FadeProgress <> 0) AND (FadeProgress <> 1) then + if (FadeProgress <> 0) and (FadeProgress <> 1) then begin Spacing := DeSelectReflectionspacing - (DeSelectReflectionspacing - Reflectionspacing) * FadeProgress; end @@ -514,9 +515,10 @@ begin glDisable(GL_TEXTURE_2D); glDisable(GL_DEPTH_TEST); glDisable(GL_BLEND); - end else + end + else with DeSelectTexture do - begin + begin //Bind Tex and GL Attributes glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); @@ -556,7 +558,8 @@ begin end; end; - for T := 0 to High(Text) do begin + for T := 0 to High(Text) do + begin Text[T].Draw; end; end; @@ -577,7 +580,7 @@ begin Texture.ColG := 0.5; Texture.ColB := 0; Texture.Int := 1; - Colorized := False; + Colorized := false; end; // Button has the texture-type "colorized" @@ -592,7 +595,7 @@ begin Texture.ColG := 1; Texture.ColB := 1; Texture.Int := 1; - Colorized := True; + Colorized := true; end; end. diff --git a/unicode/src/screens/UScreenCredits.pas b/unicode/src/screens/UScreenCredits.pas index de559cc6..25fa96df 100644 --- a/unicode/src/screens/UScreenCredits.pas +++ b/unicode/src/screens/UScreenCredits.pas @@ -34,6 +34,7 @@ interface {$I switches.inc} uses + SysUtils, UMenu, SDL, SDL_Image, @@ -42,7 +43,6 @@ uses gl, UMusic, UFiles, - SysUtils, UThemes, UGraphicClasses; @@ -167,16 +167,16 @@ const implementation uses - ULog, - UGraphic, - UMain, - UIni, - USongs, - Textgl, - ULanguage, - UCommon, - Math; - + Math, + ULog, + UGraphic, + UMain, + UIni, + USongs, + Textgl, + ULanguage, + UCommon, + UPath; function TScreenCredits.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; begin @@ -246,63 +246,6 @@ begin Draw:=true; end; -function pixfmt_eq(fmt1,fmt2: TSDL_Pixelformat): boolean; -begin - if (fmt1.BitsPerPixel = fmt2.BitsPerPixel) and - (fmt1.BytesPerPixel = fmt2.BytesPerPixel) and - (fmt1.Rloss = fmt2.Rloss) and - (fmt1.Gloss = fmt2.Gloss) and - (fmt1.Bloss = fmt2.Bloss) and - (fmt1.Rmask = fmt2.Rmask) and - (fmt1.Gmask = fmt2.Gmask) and - (fmt1.Bmask = fmt2.Bmask) and - (fmt1.Rshift = fmt2.Rshift) and - (fmt1.Gshift = fmt2.Gshift) and - (fmt1.Bshift = fmt2.Bshift) - then - pixfmt_eq:=True - else - pixfmt_eq:=False; -end; - -function inttohexstr(i: cardinal):pchar; -var helper, i2, c:cardinal; - tmpstr: string; -begin - helper:=0; - i2:=i; - tmpstr:=''; - for c:=1 to 8 do - begin - helper:=(helper shl 4) or (i2 and $f); - i2:=i2 shr 4; - end; - for c:=1 to 8 do - begin - i2:=helper and $f; - helper := helper shr 4; - case i2 of - 0: tmpstr:=tmpstr+'0'; - 1: tmpstr:=tmpstr+'1'; - 2: tmpstr:=tmpstr+'2'; - 3: tmpstr:=tmpstr+'3'; - 4: tmpstr:=tmpstr+'4'; - 5: tmpstr:=tmpstr+'5'; - 6: tmpstr:=tmpstr+'6'; - 7: tmpstr:=tmpstr+'7'; - 8: tmpstr:=tmpstr+'8'; - 9: tmpstr:=tmpstr+'9'; - 10: tmpstr:=tmpstr+'a'; - 11: tmpstr:=tmpstr+'b'; - 12: tmpstr:=tmpstr+'c'; - 13: tmpstr:=tmpstr+'d'; - 14: tmpstr:=tmpstr+'e'; - 15: tmpstr:=tmpstr+'f'; - end; - end; - inttohexstr:=pchar(tmpstr); -end; - procedure TScreenCredits.onShow; begin inherited; diff --git a/unicode/src/screens/UScreenEdit.pas b/unicode/src/screens/UScreenEdit.pas index 3be9308e..2111adef 100644 --- a/unicode/src/screens/UScreenEdit.pas +++ b/unicode/src/screens/UScreenEdit.pas @@ -33,20 +33,24 @@ interface {$I switches.inc} -uses UMenu, SDL, UThemes; +uses + UMenu, + SDL, + UThemes; type TScreenEdit = class(TMenu) public -{ Tex_Background: TTexture; - FadeOut: boolean; - Path: string; - FileName: string;} + TextDescription: integer; + TextDescriptionLong: integer; + constructor Create; override; - procedure onShow; override; - function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override; -{ function Draw: boolean; override; - procedure Finish;} + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; + procedure InteractNext; override; + procedure InteractPrev; override; + procedure InteractInc; override; + procedure InteractDec; override; + procedure SetAnimationProgress(Progress: real); override; end; implementation @@ -58,12 +62,18 @@ uses UUnicodeUtils, SysUtils; -function TScreenEdit.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; +function TScreenEdit.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; +var + SDL_ModState: word; begin Result := true; - If (PressedDown) Then + + SDL_ModState := SDL_GetModState and (KMOD_LSHIFT + KMOD_RSHIFT + + KMOD_LCTRL + KMOD_RCTRL + KMOD_LALT + KMOD_RALT); + + if (PressedDown) then begin // Key Down - // check normal keys + // check normal keys case UCS4UpperCase(CharCode) of Ord('Q'): begin @@ -79,7 +89,6 @@ begin begin AudioPlayback.PlaySound(SoundLib.Back); FadeTo(@ScreenMain); -// Result := false; end; SDLK_RETURN: begin @@ -88,10 +97,6 @@ begin AudioPlayback.PlaySound(SoundLib.Start); FadeTo(@ScreenEditConvert); end; -// if Interaction = 1 then begin -// Music.PlayStart; -// FadeTo(@ScreenEditHeader); -// end; if Interaction = 1 then begin @@ -100,14 +105,10 @@ begin end; end; - SDLK_DOWN: - begin - InteractNext; - end; - SDLK_UP: - begin - InteractPrev; - end; + SDLK_DOWN: InteractInc; + SDLK_UP: InteractDec; + SDLK_RIGHT: InteractNext; + SDLK_LEFT: InteractPrev; end; end; end; @@ -115,41 +116,49 @@ end; constructor TScreenEdit.Create; begin inherited Create; - AddButton(400-200, 100 + 0*70, 400, 40, Skin.GetTextureFileName('ButtonF')); - AddButtonText(10, 5, 0, 0, 0, 'Convert Midi to Txt'); -// Button[High(Button)].Text[0].Size := 11; -// AddButton(400-200, 100 + 1*60, 400, 40, 'ButtonF'); -// AddButtonText(10, 5, 0, 0, 0, 'Edit Headers'); + TextDescription := AddText(Theme.Edit.TextDescription); -// AddButton(400-200, 100 + 2*60, 400, 40, 'ButtonF'); -// AddButtonText(10, 5, 0, 0, 0, 'Set GAP'); + LoadFromTheme(Theme.Edit); - AddButton(400-200, 100 + 3*60, 400, 40, Skin.GetTextureFileName('ButtonF')); - AddButtonText(10, 5, 0, 0, 0, 'Exit'); + AddButton(Theme.Edit.ButtonConvert); +{ Some ideas for more: + AddButton(Theme.Edit.ButtonEditHeaders); + AddButton(Theme.Edit.ButtonAdjustGap); +} + AddButton(Theme.Edit.ButtonExit); + Interaction := 0; end; -procedure TScreenEdit.onShow; +procedure TScreenEdit.InteractNext; begin - inherited; + inherited InteractNext; + Text[TextDescription].Text := Theme.Edit.Description[Interaction]; +end; -// Interaction := 0; +procedure TScreenEdit.InteractPrev; +begin + inherited InteractPrev; + Text[TextDescription].Text := Theme.Edit.Description[Interaction]; end; -(*function TScreenEdit.Draw: boolean; -var - Min: integer; - Sec: integer; - Tekst: string; - Pet: integer; - AktBeat: integer; +procedure TScreenEdit.InteractDec; begin + inherited InteractDec; + Text[TextDescription].Text := Theme.Edit.Description[Interaction]; end; -procedure TScreenEdit.Finish; +procedure TScreenEdit.InteractInc; begin -// -end;*) + inherited InteractInc; + Text[TextDescription].Text := Theme.Edit.Description[Interaction]; +end; + +procedure TScreenEdit.SetAnimationProgress(Progress: real); +begin + Static[0].Texture.ScaleW := Progress; + Static[0].Texture.ScaleH := Progress; +end; end. diff --git a/unicode/src/screens/UScreenEditConvert.pas b/unicode/src/screens/UScreenEditConvert.pas index 328398aa..835590ed 100644 --- a/unicode/src/screens/UScreenEditConvert.pas +++ b/unicode/src/screens/UScreenEditConvert.pas @@ -48,21 +48,21 @@ uses type TNote = record - Event: integer; - EventType: integer; - Channel: integer; - Start: real; - Len: real; - Data1: integer; - Data2: integer; - Str: string; + Event: integer; + EventType: integer; + Channel: integer; + Start: real; + Len: real; + Data1: integer; + Data2: integer; + Str: string; end; TTrack = record - Note: array of TNote; - Name: string; - Hear: boolean; - Status: byte; // 0 - none, 1 - notes, 2 - lyrics, 3 - notes + lyrics + Note: array of TNote; + Name: string; + Hear: boolean; + Status: set of (notes, lyrics); end; TNuta = record @@ -77,29 +77,29 @@ type TScreenEditConvert = class(TMenu) public - ATrack: TArrayTrack; // actual track -// Track: TArrayTrack; - Channel: TArrayTrack; - ColR: array[0..100] of real; - ColG: array[0..100] of real; - ColB: array[0..100] of real; - Len: real; - Sel: integer; - Selected: boolean; -// FileName: string; + ATrack: TArrayTrack; // actual track +// Track: TArrayTrack; + Channel: TArrayTrack; + ColR: array[0..100] of real; + ColG: array[0..100] of real; + ColB: array[0..100] of real; + Len: real; + Sel: integer; + Selected: boolean; +// FileName: string; {$IFDEF UseMIDIPort} - MidiFile: TMidiFile; - MidiTrack: TMidiTrack; - MidiEvent: pMidiEvent; - MidiOut: TMidiOutput; + MidiFile: TMidiFile; + MidiTrack: TMidiTrack; + MidiEvent: pMidiEvent; + MidiOut: TMidiOutput; {$ENDIF} - Song: TSong; - Lines: TLines; - BPM: real; - Ticks: real; - Note: array of TNuta; + Song: TSong; + Lines: TLines; + BPM: real; + Ticks: real; + Note: array of TNuta; procedure AddLyric(Start: integer; Text: string); procedure Extract; @@ -111,26 +111,30 @@ type function SelectedNumber: integer; constructor Create; override; procedure onShow; override; - function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override; + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; function Draw: boolean; override; procedure onHide; override; end; +var + ConversionFileName: string; + implementation uses SysUtils, + TextGL, gl, - UGraphic, UDrawTexture, - TextGL, UFiles, - UMain, + UGraphic, UIni, + UMain, + UPath, USkins, UUnicodeUtils; -function TScreenEditConvert.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; +function TScreenEditConvert.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; begin Result := true; If (PressedDown) Then @@ -175,13 +179,16 @@ begin {$ENDIF} end; - if Interaction = 2 then begin + if Interaction = 2 then + begin Selected := true; {$IFDEF UseMIDIPort} MidiFile.OnMidiEvent := nil; {$ENDIF} - {for T := 0 to High(ATrack) do begin - if ATrack[T].Hear then begin + {for T := 0 to High(ATrack) do + begin + if ATrack[T].Hear then + begin MidiTrack := MidiFile.GetTrack(T); MidiTrack.OnMidiEvent := MidiFile1MidiEvent; end; @@ -189,8 +196,10 @@ begin MidiFile.StartPlaying;//} end; - if Interaction = 3 then begin - if SelectedNumber > 0 then begin + if Interaction = 3 then + begin + if SelectedNumber > 0 then + begin Extract; SaveSong(Song, Lines, ChangeFileExt(ConversionFileName, '.txt'), false); end; @@ -201,9 +210,19 @@ begin SDLK_SPACE: begin // ATrack[Sel].Hear := not ATrack[Sel].Hear; - ATrack[Sel].Status := (ATrack[Sel].Status + 1) mod 4; - -{ if Selected then begin + if Notes in ATrack[Sel].Status then + begin + ATrack[Sel].Status := ATrack[Sel].Status - [Notes]; + if Lyrics in ATrack[Sel].Status then + ATrack[Sel].Status := ATrack[Sel].Status - [Lyrics] + else + ATrack[Sel].Status := ATrack[Sel].Status + [Lyrics]; + end + else + ATrack[Sel].Status := ATrack[Sel].Status + [Notes]; + +{ if Selected then + begin MidiTrack := MidiFile.GetTrack(Sel); if Track[Sel].Hear then MidiTrack.OnMidiEvent := MidiFile1MidiEvent @@ -225,12 +244,14 @@ begin SDLK_DOWN: begin Inc(Sel); - if Sel > High(ATrack) then Sel := 0; + if Sel > High(ATrack) then + Sel := 0; end; SDLK_UP: begin Dec(Sel); - if Sel < 0 then Sel := High(ATrack); + if Sel < 0 then + Sel := High(ATrack); end; end; end; @@ -240,11 +261,15 @@ procedure TScreenEditConvert.AddLyric(Start: integer; Text: string); var N: integer; begin - for N := 0 to High(Note) do begin - if Note[N].Start = Start then begin + for N := 0 to High(Note) do + begin + if Note[N].Start = Start then + begin // check for new sentece - if Copy(Text, 1, 1) = '\' then Delete(Text, 1, 1); - if Copy(Text, 1, 1) = '/' then begin + if Copy(Text, 1, 1) = '\' then + Delete(Text, 1, 1); + if Copy(Text, 1, 1) = '/' then + begin Delete(Text, 1, 1); Note[N].NewSentence := true; end; @@ -279,11 +304,16 @@ begin SetLength(Note, 0); // extract notes - for T := 0 to High(ATrack) do begin -// if ATrack[T].Hear then begin - if ((ATrack[T].Status div 1) and 1) = 1 then begin - for N := 0 to High(ATrack[T].Note) do begin - if (ATrack[T].Note[N].EventType = 9) and (ATrack[T].Note[N].Data2 > 0) then begin + for T := 0 to High(ATrack) do + begin +// if ATrack[T].Hear then +// begin + if Notes in ATrack[T].Status then + begin + for N := 0 to High(ATrack[T].Note) do + begin + if (ATrack[T].Note[N].EventType = 9) and (ATrack[T].Note[N].Data2 > 0) then + begin Nu := Length(Note); SetLength(Note, Nu + 1); Note[Nu].Start := Round(ATrack[T].Note[N].Start / Ticks); @@ -296,11 +326,16 @@ begin end; // extract lyrics - for T := 0 to High(ATrack) do begin -// if ATrack[T].Hear then begin - if ((ATrack[T].Status div 2) and 1) = 1 then begin - for N := 0 to High(ATrack[T].Note) do begin - if (ATrack[T].Note[N].EventType = 15) then begin + for T := 0 to High(ATrack) do + begin +// if ATrack[T].Hear then +// begin + if Lyrics in ATrack[T].Status then + begin + for N := 0 to High(ATrack[T].Note) do + begin + if (ATrack[T].Note[N].EventType = 15) then + begin // Log.LogStatus('<' + Track[T].Note[N].Str + '>', 'MIDI'); AddLyric(Round(ATrack[T].Note[N].Start / Ticks), ATrack[T].Note[N].Str); end; @@ -311,7 +346,8 @@ begin // sort notes for N := 0 to High(Note) do for Nu := 0 to High(Note)-1 do - if Note[Nu].Start > Note[Nu+1].Start then begin + if Note[Nu].Start > Note[Nu+1].Start then + begin NoteTemp := Note[Nu]; Note[Nu] := Note[Nu+1]; Note[Nu+1] := NoteTemp; @@ -331,8 +367,10 @@ begin N := 0; Lines.Line[C].HighNote := -1; - for Nu := 0 to High(Note) do begin - if Note[Nu].NewSentence then begin // nowa linijka + for Nu := 0 to High(Note) do + begin + if Note[Nu].NewSentence then // new line + begin SetLength(Lines.Line, Length(Lines.Line)+1); Lines.Number := Lines.Number + 1; Lines.High := Lines.High + 1; @@ -363,10 +401,10 @@ begin end; end; - // tworzy miejsce na nowa nute + // create space for new note SetLength(Lines.Line[C].Note, Length(Lines.Line[C].Note)+1); - // dopisuje + // initialize note Lines.Line[C].Note[N].Start := Note[Nu].Start; Lines.Line[C].Note[N].Length := Note[Nu].Len; Lines.Line[C].Note[N].Tone := Note[Nu].Tone; @@ -383,8 +421,10 @@ var begin Result := 0; for T := 0 to High(ATrack) do -// if ATrack[T].Hear then Inc(Result); - if ((ATrack[T].Status div 1) and 1) = 1 then Inc(Result); +// if ATrack[T].Hear then +// Inc(Result); + if Notes in ATrack[T].Status then + Inc(Result); end; {$IFDEF UseMIDIPort} @@ -428,7 +468,8 @@ begin MidiFile := TMidiFile.Create(nil); {$ENDIF} - for P := 0 to 100 do begin + for P := 0 to 100 do + begin ColR[P] := Random(10)/10; ColG[P] := Random(10)/10; ColB[P] := Random(10)/10; @@ -464,13 +505,15 @@ begin BPM := MidiFile.Bpm; Ticks := MidiFile.TicksPerQuarter / 4; -{ for T := 0 to MidiFile.NumberOfTracks-1 do begin +{ for T := 0 to MidiFile.NumberOfTracks-1 do + begin SetLength(Track, Length(Track)+1); MidiTrack := MidiFile.GetTrack(T); MidiTrack.OnMidiEvent := MidiFile1MidiEvent; Track[T].Name := MidiTrack.getName; - for N := 0 to MidiTrack.getEventCount-1 do begin + for N := 0 to MidiTrack.getEventCount-1 do + begin SetLength(Track[T].Note, Length(Track[T].Note)+1); MidiEvent := MidiTrack.GetEvent(N); Track[T].Note[N].Start := MidiEvent.time; @@ -487,20 +530,21 @@ begin end; end;} - SetLength(Channel, 16); for T := 0 to 15 do begin Channel[T].Name := IntToStr(T+1); SetLength(Channel[T].Note, 0); - Channel[T].Status := 0; + Channel[T].Status := []; end; - for T := 0 to MidiFile.NumberOfTracks-1 do begin + for T := 0 to MidiFile.NumberOfTracks-1 do + begin MidiTrack := MidiFile.GetTrack(T); MidiTrack.OnMidiEvent := MidiFile1MidiEvent; - for N := 0 to MidiTrack.getEventCount-1 do begin + for N := 0 to MidiTrack.getEventCount-1 do + begin MidiEvent := MidiTrack.GetEvent(N); C := MidiEvent.event and 15; @@ -530,8 +574,8 @@ end; function TScreenEditConvert.Draw: boolean; var - Pet: integer; - Pet2: integer; + Count: integer; + Count2: integer; Bottom: real; X: real; Y: real; @@ -544,7 +588,8 @@ begin Y := 100; H := Length(ATrack)*40; - if H > 480 then H := 480; + if H > 480 then + H := 480; Bottom := Y + H; YSkip := H / Length(ATrack); @@ -553,18 +598,21 @@ begin DrawQuad(10, Y+Sel*YSkip, 780, YSkip, 0.8, 0.8, 0.8); // selected - now me use Status System - for Pet := 0 to High(ATrack) do - if ATrack[Pet].Hear then - DrawQuad(10, Y+Pet*YSkip, 50, YSkip, 0.8, 0.3, 0.3); + for Count := 0 to High(ATrack) do + if ATrack[Count].Hear then + DrawQuad(10, Y+Count*YSkip, 50, YSkip, 0.8, 0.3, 0.3); glColor3f(0, 0, 0); - for Pet := 0 to High(ATrack) do begin - if ((ATrack[Pet].Status div 1) and 1) = 1 then begin - SetFontPos(25, Y + Pet*YSkip + 10); + for Count := 0 to High(ATrack) do + begin + if Notes in ATrack[Count].Status then + begin + SetFontPos(25, Y + Count*YSkip + 10); SetFontSize(15); glPrint('N'); end; - if ((ATrack[Pet].Status div 2) and 1) = 1 then begin - SetFontPos(40, Y + Pet*YSkip + 10); + if Lyrics in ATrack[Count].Status then + begin + SetFontPos(40, Y + Count*YSkip + 10); SetFontSize(15); glPrint('L'); end; @@ -574,21 +622,23 @@ begin DrawLine(60, Y, 60, Bottom, 0, 0, 0); DrawLine(790, Y, 790, Bottom, 0, 0, 0); - for Pet := 0 to Length(ATrack) do - DrawLine(10, Y+Pet*YSkip, 790, Y+Pet*YSkip, 0, 0, 0); + for Count := 0 to Length(ATrack) do + DrawLine(10, Y+Count*YSkip, 790, Y+Count*YSkip, 0, 0, 0); - for Pet := 0 to High(ATrack) do begin - SetFontPos(11, Y + 10 + Pet*YSkip); + for Count := 0 to High(ATrack) do + begin + SetFontPos(11, Y + 10 + Count*YSkip); SetFontSize(15); - glPrint(ATrack[Pet].Name); + glPrint(ATrack[Count].Name); end; - for Pet := 0 to High(ATrack) do - for Pet2 := 0 to High(ATrack[Pet].Note) do begin - if ATrack[Pet].Note[Pet2].EventType = 9 then - DrawQuad(60 + ATrack[Pet].Note[Pet2].Start/Len * 725, Y + (Pet+1)*YSkip - ATrack[Pet].Note[Pet2].Data1*35/127, 3, 3, ColR[Pet], ColG[Pet], ColB[Pet]); - if ATrack[Pet].Note[Pet2].EventType = 15 then - DrawLine(60 + ATrack[Pet].Note[Pet2].Start/Len * 725, Y + 0.75 * YSkip + Pet*YSkip, 60 + ATrack[Pet].Note[Pet2].Start/Len * 725, Y + YSkip + Pet*YSkip, ColR[Pet], ColG[Pet], ColB[Pet]); + for Count := 0 to High(ATrack) do + for Count2 := 0 to High(ATrack[Count].Note) do + begin + if ATrack[Count].Note[Count2].EventType = 9 then + DrawQuad(60 + ATrack[Count].Note[Count2].Start/Len * 725, Y + (Count+1)*YSkip - ATrack[Count].Note[Count2].Data1*35/127, 3, 3, ColR[Count], ColG[Count], ColB[Count]); + if ATrack[Count].Note[Count2].EventType = 15 then + DrawLine(60 + ATrack[Count].Note[Count2].Start/Len * 725, Y + 0.75 * YSkip + Count*YSkip, 60 + ATrack[Count].Note[Count2].Start/Len * 725, Y + YSkip + Count*YSkip, ColR[Count], ColG[Count], ColB[Count]); end; // playing line diff --git a/unicode/src/screens/UScreenEditHeader.pas b/unicode/src/screens/UScreenEditHeader.pas index 10480299..2548069d 100644 --- a/unicode/src/screens/UScreenEditHeader.pas +++ b/unicode/src/screens/UScreenEditHeader.pas @@ -73,7 +73,7 @@ type constructor Create; override; procedure onShow; override; - function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override; + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; { function Draw: boolean; override; procedure Finish;} end; @@ -89,13 +89,13 @@ uses UTexture, UUnicodeUtils; -function TScreenEditHeader.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; +function TScreenEditHeader.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; var T: integer; begin Result := true; - If (PressedDown) Then begin // Key Down - // check normal keys + if (PressedDown) then // Key Down + begin // check normal keys case UCS4UpperCase(CharCode) of Ord('Q'): begin @@ -115,7 +115,8 @@ begin SDLK_RETURN: begin - if Interaction = 1 then begin + if Interaction = 1 then + begin // Save; end; end; @@ -124,14 +125,14 @@ begin begin case Interaction of 0..0: InteractNext; - 1: Interaction := 0; + 1: Interaction := 0; end; end; SDLK_LEFT: begin case Interaction of - 0: Interaction := 1; + 0: Interaction := 1; 1..1: InteractPrev; end; end; @@ -139,25 +140,26 @@ begin SDLK_DOWN: begin case Interaction of - 0..1: Interaction := 2; - 2..12: InteractNext; - 13: Interaction := 0; + 0..1: Interaction := 2; + 2..12: InteractNext; + 13: Interaction := 0; end; end; SDLK_UP: begin case Interaction of - 0..1: Interaction := 13; - 2: Interaction := 0; - 3..13: InteractPrev; + 0..1: Interaction := 13; + 2: Interaction := 0; + 3..13: InteractPrev; end; end; SDLK_BACKSPACE: begin T := Interaction - 2 + TextTitle; - if (Interaction >= 2) and (Interaction <= 13) and (Length(Text[T].Text) >= 1) then begin + if (Interaction >= 2) and (Interaction <= 13) and (Length(Text[T].Text) >= 1) then + begin Text[T].DeleteLastLetter; SetRoundButtons; end; @@ -167,7 +169,8 @@ begin case CharCode of 32..255: begin - if (Interaction >= 2) and (Interaction <= 13) then begin + if (Interaction >= 2) and (Interaction <= 13) then + begin Text[Interaction - 2 + TextTitle].Text := Text[Interaction - 2 + TextTitle].Text + UCS4ToUTF8String(CharCode); SetRoundButtons; @@ -252,7 +255,8 @@ procedure TScreenEditHeader.onShow; begin inherited; -{ if FileExists(FileName) then begin // load file +{ if FileExists(FileName) then // load file + begin CurrentSong.FileName := FileName; SkanujPlik(CurrentSong); @@ -281,29 +285,33 @@ end; (*function TScreenEdit.Draw: boolean; var - Min: integer; - Sec: integer; - Tekst: string; - Pet: integer; - AktBeat: integer; + Min: integer; + Sec: integer; + Count: integer; + AktBeat: integer; begin { glClearColor(1,1,1,1); // control music - if PlaySentence then begin + if PlaySentence then + begin // stop the music - if (Music.Position > PlayStopTime) then begin + if (Music.Position > PlayStopTime) then + begin Music.Stop; PlaySentence := false; end; // click - if (Click) and (PlaySentence) then begin + if (Click) and (PlaySentence) then + begin AktBeat := Floor(CurrentSong.BPM[0].BPM * (Music.Position - CurrentSong.GAP / 1000) / 60); Text[TextDebug].Text := IntToStr(AktBeat); - if AktBeat <> LastClick then begin - for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do - if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = AktBeat) then begin + if AktBeat <> LastClick then + begin + for Count := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do + if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Count].Start = AktBeat) then + begin Music.PlayClick; LastClick := AktBeat; end; @@ -322,7 +330,7 @@ begin Text[TextNStart].Text := IntToStr(Czesci[0].Czesc[Czesci[0].Akt].Nuta[AktNuta].Start); Text[TextNDlugosc].Text := IntToStr(Czesci[0].Czesc[Czesci[0].Akt].Nuta[AktNuta].Dlugosc); Text[TextNTon].Text := IntToStr(Czesci[0].Czesc[Czesci[0].Akt].Nuta[AktNuta].Ton); - Text[TextNText].Text := Czesci[0].Czesc[Czesci[0].Akt].Nuta[AktNuta].Tekst; + Text[TextNText].Text := Czesci[0].Czesc[Czesci[0].Akt].Nuta[AktNuta].Text; // draw static menu inherited Draw; @@ -339,37 +347,52 @@ end;*) procedure TScreenEditHeader.SetRoundButtons; begin - if Length(Text[TextTitle].Text) > 0 then Static[StaticTitle].Visible := true - else Static[StaticTitle].Visible := false; - - if Length(Text[TextArtist].Text) > 0 then Static[StaticArtist].Visible := true - else Static[StaticArtist].Visible := false; - - if Length(Text[TextMp3].Text) > 0 then Static[StaticMp3].Visible := true - else Static[StaticMp3].Visible := false; - - if Length(Text[TextBackground].Text) > 0 then Static[StaticBackground].Visible := true - else Static[StaticBackground].Visible := false; - - if Length(Text[TextVideo].Text) > 0 then Static[StaticVideo].Visible := true - else Static[StaticVideo].Visible := false; + if Length(Text[TextTitle].Text) > 0 then + Static[StaticTitle].Visible := true + else + Static[StaticTitle].Visible := false; + + if Length(Text[TextArtist].Text) > 0 then + Static[StaticArtist].Visible := true + else + Static[StaticArtist].Visible := false; + + if Length(Text[TextMp3].Text) > 0 then + Static[StaticMp3].Visible := true + else + Static[StaticMp3].Visible := false; + + if Length(Text[TextBackground].Text) > 0 then + Static[StaticBackground].Visible := true + else + Static[StaticBackground].Visible := false; + + if Length(Text[TextVideo].Text) > 0 then + Static[StaticVideo].Visible := true + else + Static[StaticVideo].Visible := false; try StrToFloat(Text[TextVideoGAP].Text); - if StrToFloat(Text[TextVideoGAP].Text)<> 0 then Static[StaticVideoGAP].Visible := true - else Static[StaticVideoGAP].Visible := false; + if StrToFloat(Text[TextVideoGAP].Text)<> 0 then + Static[StaticVideoGAP].Visible := true + else + Static[StaticVideoGAP].Visible := false; except Static[StaticVideoGAP].Visible := false; end; - if LowerCase(Text[TextRelative].Text) = 'yes' then Static[StaticRelative].Visible := true - else Static[StaticRelative].Visible := false; + if LowerCase(Text[TextRelative].Text) = 'yes' then + Static[StaticRelative].Visible := true + else + Static[StaticRelative].Visible := false; try StrToInt(Text[TextResolution].Text); - if (StrToInt(Text[TextResolution].Text) <> 0) and (StrToInt(Text[TextResolution].Text) >= 1) - then Static[StaticResolution].Visible := true - else Static[StaticResolution].Visible := false; + if (StrToInt(Text[TextResolution].Text) <> 0) and (StrToInt(Text[TextResolution].Text) >= 1) then + Static[StaticResolution].Visible := true + else + Static[StaticResolution].Visible := false; except Static[StaticResolution].Visible := false; end; @@ -384,8 +407,10 @@ begin // start try StrToFloat(Text[TextStart].Text); - if (StrToFloat(Text[TextStart].Text) > 0) then Static[StaticStart].Visible := true - else Static[StaticStart].Visible := false; + if (StrToFloat(Text[TextStart].Text) > 0) then + Static[StaticStart].Visible := true + else + Static[StaticStart].Visible := false; except Static[StaticStart].Visible := false; end; @@ -401,8 +426,10 @@ begin // BPM try StrToFloat(Text[TextBPM].Text); - if (StrToFloat(Text[TextBPM].Text) > 0) then Static[StaticBPM].Visible := true - else Static[StaticBPM].Visible := false; + if (StrToFloat(Text[TextBPM].Text) > 0) then + Static[StaticBPM].Visible := true + else + Static[StaticBPM].Visible := false; except Static[StaticBPM].Visible := false; end; diff --git a/unicode/src/screens/UScreenEditSub.pas b/unicode/src/screens/UScreenEditSub.pas index e3adeaf8..a892651a 100644 --- a/unicode/src/screens/UScreenEditSub.pas +++ b/unicode/src/screens/UScreenEditSub.pas @@ -57,7 +57,7 @@ type TScreenEditSub = class(TMenu) private //Variable is True if no Song is loaded - Error: Boolean; + Error: boolean; TextNote: integer; TextSentence: integer; @@ -80,18 +80,18 @@ type CopySrc: integer; {$IFDEF UseMIDIPort} - MidiOut: TMidiOutput; + MidiOut: TMidiOutput; {$endif} - MidiStart: real; - MidiStop: real; - MidiTime: real; - MidiPos: real; - MidiLastNote: integer; + MidiStart: real; + MidiStop: real; + MidiTime: real; + MidiPos: real; + MidiLastNote: integer; - TextEditMode: boolean; + TextEditMode: boolean; - Lyric: TEditorLyrics; + Lyric: TEditorLyrics; procedure DivideBPM; procedure MultiplyBPM; @@ -111,14 +111,14 @@ type procedure CopySentence(Src, Dst: integer); procedure CopySentences(Src, Dst, Num: integer); //Note Name Mod - function GetNoteName(Note: Integer): String; + function GetNoteName(Note: integer): string; public Tex_Background: TTexture; FadeOut: boolean; constructor Create; override; procedure onShow; override; - function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override; - function ParseInputEditText(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; + function ParseInputEditText(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; function Draw: boolean; override; procedure onHide; override; end; @@ -128,29 +128,32 @@ implementation uses UGraphic, UDraw, - UMain, + UNote, USkins, ULanguage, UUnicodeUtils; // Method for input parsing. If False is returned, GetNextWindow // should be checked to know the next window to load; -function TScreenEditSub.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; +function TScreenEditSub.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; var SDL_ModState: Word; R: real; begin Result := true; - if TextEditMode then begin + if TextEditMode then + begin Result := ParseInputEditText(PressedKey, CharCode, PressedDown); - end else begin + end + else + begin SDL_ModState := SDL_GetModState and (KMOD_LSHIFT + KMOD_RSHIFT + KMOD_LCTRL + KMOD_RCTRL + KMOD_LALT + KMOD_RALT {+ KMOD_CAPS}); - If (PressedDown) then begin // Key Down - // check normal keys + if (PressedDown) then // Key Down + begin // check normal keys case UCS4UpperCase(CharCode) of Ord('Q'): begin @@ -202,14 +205,16 @@ begin Ord('V'): begin // Paste text - if SDL_ModState = KMOD_LCTRL then begin + if SDL_ModState = KMOD_LCTRL then + begin if Lines[0].Line[Lines[0].Current].HighNote >= Lines[0].Line[CopySrc].HighNote then PasteText else Log.LogStatus('PasteText: invalid range', 'TScreenEditSub.ParseInput'); end; - if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then begin + if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then + begin CopySentence(CopySrc, Lines[0].Current); end; end; @@ -328,20 +333,23 @@ begin SDLK_4: begin - if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then begin + if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then + begin CopySentence(CopySrc, Lines[0].Current); CopySentence(CopySrc+1, Lines[0].Current+1); CopySentence(CopySrc+2, Lines[0].Current+2); CopySentence(CopySrc+3, Lines[0].Current+3); end; - if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT + KMOD_LALT then begin + if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT + KMOD_LALT then + begin CopySentences(CopySrc, Lines[0].Current, 4); end; end; SDLK_5: begin - if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then begin + if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then + begin CopySentence(CopySrc, Lines[0].Current); CopySentence(CopySrc+1, Lines[0].Current+1); CopySentence(CopySrc+2, Lines[0].Current+2); @@ -349,7 +357,8 @@ begin CopySentence(CopySrc+4, Lines[0].Current+4); end; - if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT + KMOD_LALT then begin + if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT + KMOD_LALT then + begin CopySentences(CopySrc, Lines[0].Current, 5); end; end; @@ -391,19 +400,22 @@ begin SDLK_SLASH: begin - if SDL_ModState = 0 then begin + if SDL_ModState = 0 then + begin // Insert start of sentece if CurrentNote > 0 then DivideSentence; end; - if SDL_ModState = KMOD_LSHIFT then begin + if SDL_ModState = KMOD_LSHIFT then + begin // Join next sentence with current - if Lines[0].Current < Lines[0].High then + if Lines[0].Current < Lines[0].High then JoinSentence; end; - if SDL_ModState = KMOD_LCTRL then begin + if SDL_ModState = KMOD_LCTRL then + begin // divide note DivideNote; end; @@ -435,13 +447,10 @@ begin begin end; - SDLK_LCTRL: - begin - end; - SDLK_DELETE: begin - if SDL_ModState = KMOD_LCTRL then begin + if SDL_ModState = KMOD_LCTRL then + begin // moves text to right in current sentence DeleteNote; end; @@ -456,29 +465,36 @@ begin SDLK_RIGHT: begin // right - if SDL_ModState = 0 then begin + if SDL_ModState = 0 then + begin Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0; Inc(CurrentNote); - if CurrentNote > Lines[0].Line[Lines[0].Current].HighNote then CurrentNote := 0; + if CurrentNote > Lines[0].Line[Lines[0].Current].HighNote then + CurrentNote := 0; Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1; Lyric.Selected := CurrentNote; end; // ctrl + right - if SDL_ModState = KMOD_LCTRL then begin - if Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length > 1 then begin + if SDL_ModState = KMOD_LCTRL then + begin + if Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length > 1 then + begin Dec(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length); Inc(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Start); - if CurrentNote = 0 then begin + if CurrentNote = 0 then + begin Inc(Lines[0].Line[Lines[0].Current].Start); end; end; end; // shift + right - if SDL_ModState = KMOD_LSHIFT then begin + if SDL_ModState = KMOD_LSHIFT then + begin Inc(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Start); - if CurrentNote = 0 then begin + if CurrentNote = 0 then + begin Inc(Lines[0].Line[Lines[0].Current].Start); end; if CurrentNote = Lines[0].Line[Lines[0].Current].HighNote then @@ -486,14 +502,16 @@ begin end; // alt + right - if SDL_ModState = KMOD_LALT then begin + if SDL_ModState = KMOD_LALT then + begin Inc(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length); if CurrentNote = Lines[0].Line[Lines[0].Current].HighNote then Inc(Lines[0].Line[Lines[0].Current].End_); end; // alt + ctrl + shift + right = move all from cursor to right - if SDL_ModState = KMOD_LALT + KMOD_LCTRL + KMOD_LSHIFT then begin + if SDL_ModState = KMOD_LALT + KMOD_LCTRL + KMOD_LSHIFT then + begin MoveAllToEnd(1); end; @@ -502,29 +520,35 @@ begin SDLK_LEFT: begin // left - if SDL_ModState = 0 then begin + if SDL_ModState = 0 then + begin Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0; Dec(CurrentNote); - if CurrentNote = -1 then CurrentNote := Lines[0].Line[Lines[0].Current].HighNote; + if CurrentNote = -1 then + CurrentNote := Lines[0].Line[Lines[0].Current].HighNote; Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1; Lyric.Selected := CurrentNote; end; // ctrl + left - if SDL_ModState = KMOD_LCTRL then begin + if SDL_ModState = KMOD_LCTRL then + begin Dec(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Start); Inc(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length); - if CurrentNote = 0 then begin + if CurrentNote = 0 then + begin Dec(Lines[0].Line[Lines[0].Current].Start); end; end; // shift + left - if SDL_ModState = KMOD_LSHIFT then begin + if SDL_ModState = KMOD_LSHIFT then + begin Dec(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Start); // resizing sentences - if CurrentNote = 0 then begin + if CurrentNote = 0 then + begin Dec(Lines[0].Line[Lines[0].Current].Start); end; @@ -534,8 +558,10 @@ begin end; // alt + left - if SDL_ModState = KMOD_LALT then begin - if Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length > 1 then begin + if SDL_ModState = KMOD_LALT then + begin + if Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length > 1 then + begin Dec(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length); if CurrentNote = Lines[0].Line[Lines[0].Current].HighNote then Dec(Lines[0].Line[Lines[0].Current].End_); @@ -543,7 +569,8 @@ begin end; // alt + ctrl + shift + right = move all from cursor to left - if SDL_ModState = KMOD_LALT + KMOD_LCTRL + KMOD_LSHIFT then begin + if SDL_ModState = KMOD_LALT + KMOD_LCTRL + KMOD_LSHIFT then + begin MoveAllToEnd(-1); end; @@ -553,7 +580,8 @@ begin begin // skip to next sentence - if SDL_ModState = 0 then begin {$IFDEF UseMIDIPort} + if SDL_ModState = 0 then + begin {$IFDEF UseMIDIPort} MidiOut.PutShort($81, Lines[0].Line[Lines[0].Current].Note[MidiLastNote].Tone + 60, 127); PlaySentenceMidi := false; {$endif} @@ -561,7 +589,8 @@ begin Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0; Inc(Lines[0].Current); CurrentNote := 0; - if Lines[0].Current > Lines[0].High then Lines[0].Current := 0; + if Lines[0].Current > Lines[0].High then + Lines[0].Current := 0; Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1; Lyric.AddLine(Lines[0].Current); @@ -571,7 +600,8 @@ begin end; // decrease tone - if SDL_ModState = KMOD_LCTRL then begin + if SDL_ModState = KMOD_LCTRL then + begin TransposeNote(-1); end; @@ -581,7 +611,8 @@ begin begin // skip to previous sentence - if SDL_ModState = 0 then begin + if SDL_ModState = 0 then + begin {$IFDEF UseMIDIPort} MidiOut.PutShort($81, Lines[0].Line[Lines[0].Current].Note[MidiLastNote].Tone + 60, 127); PlaySentenceMidi := false; @@ -590,7 +621,8 @@ begin Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0; Dec(Lines[0].Current); CurrentNote := 0; - if Lines[0].Current = -1 then Lines[0].Current := Lines[0].High; + if Lines[0].Current = -1 then + Lines[0].Current := Lines[0].High; Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1; Lyric.AddLine(Lines[0].Current); @@ -600,7 +632,8 @@ begin end; // increase tone - if SDL_ModState = KMOD_LCTRL then begin + if SDL_ModState = KMOD_LCTRL then + begin TransposeNote(1); end; end; @@ -610,7 +643,7 @@ begin end; // if end; -function TScreenEditSub.ParseInputEditText(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; +function TScreenEditSub.ParseInputEditText(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; var SDL_ModState: Word; begin @@ -620,7 +653,7 @@ begin SDL_ModState := SDL_GetModState and (KMOD_LSHIFT + KMOD_RSHIFT + KMOD_LCTRL + KMOD_RCTRL + KMOD_LALT + KMOD_RALT {+ KMOD_CAPS}); - If (PressedDown) Then + if (PressedDown) then begin // Key Down case PressedKey of @@ -648,10 +681,12 @@ begin SDLK_RIGHT: begin // right - if SDL_ModState = 0 then begin + if SDL_ModState = 0 then + begin Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0; Inc(CurrentNote); - if CurrentNote > Lines[0].Line[Lines[0].Current].HighNote then CurrentNote := 0; + if CurrentNote > Lines[0].Line[Lines[0].Current].HighNote then + CurrentNote := 0; Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1; Lyric.Selected := CurrentNote; end; @@ -659,10 +694,12 @@ begin SDLK_LEFT: begin // left - if SDL_ModState = 0 then begin + if SDL_ModState = 0 then + begin Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0; Dec(CurrentNote); - if CurrentNote = -1 then CurrentNote := Lines[0].Line[Lines[0].Current].HighNote; + if CurrentNote = -1 then + CurrentNote := Lines[0].Line[Lines[0].Current].HighNote; Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1; Lyric.Selected := CurrentNote; end; @@ -687,11 +724,13 @@ var N: integer; begin CurrentSong.BPM[0].BPM := CurrentSong.BPM[0].BPM / 2; - for C := 0 to Lines[0].High do begin - Lines[0].Line[C].Start := Lines[0].Line[C].Start div 2; - Lines[0].Line[C].End_ := Lines[0].Line[C].End_ div 2; - for N := 0 to Lines[0].Line[C].HighNote do begin - Lines[0].Line[C].Note[N].Start := Lines[0].Line[C].Note[N].Start div 2; + for C := 0 to Lines[0].High do + begin + Lines[0].Line[C].Start := Lines[0].Line[C].Start div 2; + Lines[0].Line[C].End_ := Lines[0].Line[C].End_ div 2; + for N := 0 to Lines[0].Line[C].HighNote do + begin + Lines[0].Line[C].Note[N].Start := Lines[0].Line[C].Note[N].Start div 2; Lines[0].Line[C].Note[N].Length := Round(Lines[0].Line[C].Note[N].Length / 2); end; // N end; // C @@ -703,11 +742,13 @@ var N: integer; begin CurrentSong.BPM[0].BPM := CurrentSong.BPM[0].BPM * 2; - for C := 0 to Lines[0].High do begin - Lines[0].Line[C].Start := Lines[0].Line[C].Start * 2; - Lines[0].Line[C].End_ := Lines[0].Line[C].End_ * 2; - for N := 0 to Lines[0].Line[C].HighNote do begin - Lines[0].Line[C].Note[N].Start := Lines[0].Line[C].Note[N].Start * 2; + for C := 0 to Lines[0].High do + begin + Lines[0].Line[C].Start := Lines[0].Line[C].Start * 2; + Lines[0].Line[C].End_ := Lines[0].Line[C].End_ * 2; + for N := 0 to Lines[0].Line[C].HighNote do + begin + Lines[0].Line[C].Note[N].Start := Lines[0].Line[C].Note[N].Start * 2; Lines[0].Line[C].Note[N].Length := Lines[0].Line[C].Note[N].Length * 2; end; // N end; // C @@ -724,7 +765,8 @@ begin for N := 0 to Lines[0].Line[C].HighNut do Lines[0].Line[C].Note[N].Text := UTF8LowerCase(Lines[0].Line[C].Note[N].Text);} - for C := 0 to Lines[0].High do begin + for C := 0 to Lines[0].High do + begin S := AnsiUpperCase(Copy(Lines[0].Line[C].Note[0].Text, 1, 1)); S := S + Copy(Lines[0].Line[C].Note[0].Text, 2, Length(Lines[0].Line[C].Note[0].Text)-1); Lines[0].Line[C].Note[0].Text := S; @@ -736,33 +778,39 @@ var C: integer; N: integer; begin - for C := 0 to Lines[0].High do begin + for C := 0 to Lines[0].High do + begin // correct starting spaces in the first word while Copy(Lines[0].Line[C].Note[0].Text, 1, 1) = ' ' do Lines[0].Line[C].Note[0].Text := Copy(Lines[0].Line[C].Note[0].Text, 2, 100); // move spaces on the start to the end of the previous note - for N := 1 to Lines[0].Line[C].HighNote do begin - while (Copy(Lines[0].Line[C].Note[N].Text, 1, 1) = ' ') do begin + for N := 1 to Lines[0].Line[C].HighNote do + begin + while (Copy(Lines[0].Line[C].Note[N].Text, 1, 1) = ' ') do + begin Lines[0].Line[C].Note[N].Text := Copy(Lines[0].Line[C].Note[N].Text, 2, 100); Lines[0].Line[C].Note[N-1].Text := Lines[0].Line[C].Note[N-1].Text + ' '; end; end; // N // correct '-' to '- ' - for N := 0 to Lines[0].Line[C].HighNote do begin + for N := 0 to Lines[0].Line[C].HighNote do + begin if Lines[0].Line[C].Note[N].Text = '-' then Lines[0].Line[C].Note[N].Text := '- '; end; // N // add space to the previous note when the current word is '- ' - for N := 1 to Lines[0].Line[C].HighNote do begin + for N := 1 to Lines[0].Line[C].HighNote do + begin if Lines[0].Line[C].Note[N].Text = '- ' then Lines[0].Line[C].Note[N-1].Text := Lines[0].Line[C].Note[N-1].Text + ' '; end; // N // correct too many spaces at the end of note - for N := 0 to Lines[0].Line[C].HighNote do begin + for N := 0 to Lines[0].Line[C].HighNote do + begin while Copy(Lines[0].Line[C].Note[N].Text, Length(Lines[0].Line[C].Note[N].Text)-1, 2) = ' ' do Lines[0].Line[C].Note[N].Text := Copy(Lines[0].Line[C].Note[N].Text, 1, Length(Lines[0].Line[C].Note[N].Text)-1); end; // N @@ -782,8 +830,10 @@ var Min: integer; Max: integer; begin - for C := 1 to Lines[0].High do begin - with Lines[0].Line[C-1] do begin + for C := 1 to Lines[0].High do + begin + with Lines[0].Line[C-1] do + begin Min := Note[HighNote].Start + Note[HighNote].Length; Max := Lines[0].Line[C].Note[0].Start; case (Max - Min) of @@ -829,15 +879,15 @@ begin NStart := CurrentNote; Lines[0].Line[CNew].Start := Lines[0].Line[CStart].Note[NStart].Start; Lines[0].Line[CNew].Lyric := ''; - Lines[0].Line[CNew].LyricWidth := 0; Lines[0].Line[CNew].End_ := 0; - Lines[0].Line[CNew].BaseNote := 0; // 0.5.0: we modify it later in this procedure + Lines[0].Line[CNew].BaseNote := 0;//High(Integer); // TODO: High (Integer) will causes a memory exception later in this procedure. Weird! Lines[0].Line[CNew].HighNote := -1; SetLength(Lines[0].Line[CNew].Note, 0); // move right notes to new sentences NHigh := Lines[0].Line[CStart].HighNote; - for N := NStart to NHigh do begin + for N := NStart to NHigh do + begin // increase sentence counters with Lines[0].Line[CNew] do begin @@ -857,6 +907,16 @@ begin Lines[0].Line[CStart].Note[NStart-1].Length; SetLength(Lines[0].Line[CStart].Note, Lines[0].Line[CStart].HighNote + 1); + //recalculate BaseNote of the divided Sentence + with Lines[0].Line[CStart] do + begin + BaseNote := High(Integer); + + For N := 0 to HighNote do + if Note[N].Tone < BaseNote then + BaseNote := Note[N].Tone; + end; + Lines[0].Current := Lines[0].Current + 1; CurrentNote := 0; Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1; @@ -878,7 +938,8 @@ begin SetLength(Lines[0].Line[C].Note, Lines[0].Line[C].HighNote + 1); // move right notes to new sentences - for N := 0 to Lines[0].Line[C+1].HighNote do begin + for N := 0 to Lines[0].Line[C+1].HighNote do + begin NDst := NStart + N; Lines[0].Line[C].Note[NDst] := Lines[0].Line[C+1].Note[N]; end; @@ -911,7 +972,8 @@ begin SetLength(Note, HighNote + 1); // we copy all notes including selected one - for N := HighNote downto CurrentNote+1 do begin + for N := HighNote downto CurrentNote+1 do + begin Note[N] := Note[N-1]; end; @@ -936,7 +998,8 @@ begin begin // we copy all notes from the next to the selected one - for N := CurrentNote+1 to Lines[0].Line[C].HighNote do begin + for N := CurrentNote+1 to Lines[0].Line[C].HighNote do + begin Lines[0].Line[C].Note[N-1] := Lines[0].Line[C].Note[N]; end; @@ -984,7 +1047,8 @@ var C: integer; N: integer; begin - for C := 0 to Lines[0].High do begin + for C := 0 to Lines[0].High do + begin Lines[0].Line[C].BaseNote := Lines[0].Line[C].BaseNote + Tone; for N := 0 to Lines[0].Line[C].HighNote do Lines[0].Line[C].Note[N].Tone := Lines[0].Line[C].Note[N].Tone + Tone; @@ -997,13 +1061,17 @@ var N: integer; NStart: integer; begin - for C := Lines[0].Current to Lines[0].High do begin + for C := Lines[0].Current to Lines[0].High do + begin NStart := 0; - if C = Lines[0].Current then NStart := CurrentNote; - for N := NStart to Lines[0].Line[C].HighNote do begin + if C = Lines[0].Current then + NStart := CurrentNote; + for N := NStart to Lines[0].Line[C].HighNote do + begin Inc(Lines[0].Line[C].Note[N].Start, Move); // move note start - if N = 0 then begin // fix beginning + if N = 0 then + begin // fix beginning Inc(Lines[0].Line[C].Start, Move); end; @@ -1022,7 +1090,8 @@ var begin { C := Lines[0].Current; - for N := Lines[0].Line[C].HighNut downto 1 do begin + for N := Lines[0].Line[C].HighNut downto 1 do + begin Lines[0].Line[C].Note[N].Text := Lines[0].Line[C].Note[N-1].Text; end; // for @@ -1035,7 +1104,8 @@ begin Lines[0].Line[C].Note[NHigh].Text := Lines[0].Line[C].Note[NHigh-1].Text + Lines[0].Line[C].Note[NHigh].Text; // other words - for N := NHigh - 1 downto CurrentNote + 1 do begin + for N := NHigh - 1 downto CurrentNote + 1 do + begin Lines[0].Line[C].Note[N].Text := Lines[0].Line[C].Note[N-1].Text; end; // for Lines[0].Line[C].Note[CurrentNote].Text := '- '; @@ -1059,10 +1129,10 @@ end; procedure TScreenEditSub.CopySentence(Src, Dst: integer); var - N: integer; - Time1: integer; - Time2: integer; - TD: integer; + N: integer; + Time1: integer; + Time2: integer; + TD: integer; begin Time1 := Lines[0].Line[Src].Note[0].Start; Time2 := Lines[0].Line[Dst].Note[0].Start; @@ -1070,7 +1140,8 @@ begin SetLength(Lines[0].Line[Dst].Note, Lines[0].Line[Src].HighNote + 1); Lines[0].Line[Dst].HighNote := Lines[0].Line[Src].HighNote; - for N := 0 to Lines[0].Line[Src].HighNote do begin + for N := 0 to Lines[0].Line[Src].HighNote do + begin Lines[0].Line[Dst].Note[N].Text := Lines[0].Line[Src].Note[N].Text; Lines[0].Line[Dst].Note[N].Length := Lines[0].Line[Src].Note[N].Length; Lines[0].Line[Dst].Note[N].Tone := Lines[0].Line[Src].Note[N].Tone; @@ -1088,12 +1159,14 @@ begin SetLength(Lines[0].Line, Lines[0].Number + Num - 1); // moves sentences next to the destination - for C := Lines[0].High downto Dst + 1 do begin + for C := Lines[0].High downto Dst + 1 do + begin Lines[0].Line[C + Num - 1] := Lines[0].Line[C]; end; // prepares new sentences: sets sentence start and create first note - for C := 1 to Num-1 do begin + for C := 1 to Num-1 do + begin Lines[0].Line[Dst + C].Start := Lines[0].Line[Dst + C - 1].Note[0].Start + (Lines[0].Line[Src + C].Note[0].Start - Lines[0].Line[Src + C - 1].Note[0].Start); SetLength(Lines[0].Line[Dst + C].Note, 1); @@ -1175,9 +1248,10 @@ begin try //Check if File is XML - if copy(CurrentSong.FileName,length(CurrentSong.FileName)-3,4) = '.xml' - then Error := not CurrentSong.LoadXMLSong() - else Error := not CurrentSong.LoadSong(); + if copy(CurrentSong.FileName,length(CurrentSong.FileName)-3,4) = '.xml' then + Error := not CurrentSong.LoadXMLSong() + else + Error := not CurrentSong.LoadSong(); except Error := True; end; @@ -1189,7 +1263,8 @@ begin ScreenPopupError.ShowPopup (Language.Translate('ERROR_CORRUPT_SONG')); Exit; end - else begin + else + begin {$IFDEF UseMIDIPort} MidiOut := TMidiOutput.Create(nil); if Ini.Debug = 1 then @@ -1210,7 +1285,7 @@ begin Lyric.Clear; Lyric.X := 400; Lyric.Y := 500; - Lyric.Align := 1; + Lyric.Align := center; Lyric.Size := 42; Lyric.ColR := 0; Lyric.ColG := 0; @@ -1238,13 +1313,15 @@ begin glClearColor(1,1,1,1); // midi music - if PlaySentenceMidi then begin + if PlaySentenceMidi then + begin {$IFDEF UseMIDIPort} MidiPos := USTime.GetTime - MidiTime + MidiStart; // stop the music - if (MidiPos > MidiStop) then begin + if (MidiPos > MidiStop) then + begin MidiOut.PutShort($81, Lines[0].Line[Lines[0].Current].Note[MidiLastNote].Tone + 60, 127); PlaySentenceMidi := false; end; @@ -1254,7 +1331,8 @@ begin AktBeat := Floor(GetMidBeat(MidiPos - CurrentSong.GAP / 1000)); Text[TextDebug].Text := IntToStr(AktBeat); - if AktBeat <> LastClick then begin + if AktBeat <> LastClick then + begin for Pet := 0 to Lines[0].Line[Lines[0].Current].HighNote do if (Lines[0].Line[Lines[0].Current].Note[Pet].Start = AktBeat) then begin @@ -1273,7 +1351,8 @@ begin end; // if PlaySentenceMidi // mp3 music - if PlaySentence then begin + if PlaySentence then + begin // stop the music if (AudioPlayback.Position > PlayStopTime) then begin @@ -1282,11 +1361,13 @@ begin end; // click - if (Click) and (PlaySentence) then begin + if (Click) and (PlaySentence) then + begin // AktBeat := Floor(CurrentSong.BPM[0].BPM * (Music.Position - CurrentSong.GAP / 1000) / 60); AktBeat := Floor(GetMidBeat(AudioPlayback.Position - CurrentSong.GAP / 1000)); Text[TextDebug].Text := IntToStr(AktBeat); - if AktBeat <> LastClick then begin + if AktBeat <> LastClick then + begin for Pet := 0 to Lines[0].Line[Lines[0].Current].HighNote do if (Lines[0].Line[Lines[0].Current].Note[Pet].Start = AktBeat) then begin @@ -1347,8 +1428,8 @@ begin //Music.SetVolume(1.0); end; -function TScreenEditSub.GetNoteName(Note: Integer): String; -var N1, N2: Integer; +function TScreenEditSub.GetNoteName(Note: integer): string; +var N1, N2: integer; begin if (Note > 0) then begin @@ -1361,8 +1442,6 @@ begin N2 := -1; end; - - case N1 of 0: Result := 'c'; 1: Result := 'c#'; diff --git a/unicode/src/screens/UScreenMain.pas b/unicode/src/screens/UScreenMain.pas index 0909fc8b..eb2e051e 100644 --- a/unicode/src/screens/UScreenMain.pas +++ b/unicode/src/screens/UScreenMain.pas @@ -63,7 +63,7 @@ implementation uses UGraphic, - UMain, + UNote, UIni, UTexture, USongs, diff --git a/unicode/src/screens/UScreenName.pas b/unicode/src/screens/UScreenName.pas index 244a559d..64e90cc9 100644 --- a/unicode/src/screens/UScreenName.pas +++ b/unicode/src/screens/UScreenName.pas @@ -34,12 +34,12 @@ interface {$I switches.inc} uses - UMenu, + SysUtils, + SDL, UDisplay, - UMusic, UFiles, - SDL, - SysUtils, + UMenu, + UMusic, UThemes; type @@ -55,9 +55,10 @@ type implementation uses - UGraphic, - UMain, + UCommon, + UGraphic, UIni, + UNote, UTexture, UUnicodeUtils; diff --git a/unicode/src/screens/UScreenOpen.pas b/unicode/src/screens/UScreenOpen.pas index ac524f4c..fa65a1df 100644 --- a/unicode/src/screens/UScreenOpen.pas +++ b/unicode/src/screens/UScreenOpen.pas @@ -34,12 +34,10 @@ interface {$I switches.inc} uses - SDL, - SysUtils, - Math, - gl, UMenu, UMusic, + SDL, + SysUtils, UFiles, UTime, USongs, @@ -48,22 +46,24 @@ uses UTexture, UMenuText, ULyrics, + Math, + gl, UThemes; type TScreenOpen = class(TMenu) private - TextF: array[0..1] of integer; - TextN: integer; + TextF: array[0..1] of integer; + TextN: integer; public - Tex_Background: TTexture; - FadeOut: boolean; - Path: string; - BackScreen: pointer; + Tex_Background: TTexture; + FadeOut: boolean; + Path: string; + BackScreen: pointer; procedure AddBox(X, Y, W, H: real); constructor Create; override; procedure onShow; override; - function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override; + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; // function Draw: boolean; override; // procedure Finish; end; @@ -74,14 +74,16 @@ uses UGraphic, UDraw, UMain, + UScreenEditConvert, USkins, UUnicodeUtils; -function TScreenOpen.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; +function TScreenOpen.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; begin Result := true; - if (PressedDown) then begin // Key Down + if (PressedDown) then // Key Down + begin // check normal keys case CharCode of Ord('0')..Ord('9'), @@ -89,7 +91,8 @@ begin Ord('A')..Ord('Z'), Ord(' '), Ord('-'), Ord('.'), Ord(':'), Ord('\'): begin - if Interaction = 0 then begin + if Interaction = 0 then + begin Text[TextN].Text := Text[TextN].Text + UCS4ToUTF8String(CharCode); end; end; @@ -103,24 +106,24 @@ begin end; 8: // del begin - if Interaction = 0 then - begin - Text[TextN].DeleteLastLetter; - end; + if Interaction = 0 then + begin + Text[TextN].DeleteLastLetter; + end; end; - - SDLK_ESCAPE : + SDLK_ESCAPE: begin //Empty Filename and go to last Screen - ConversionFileName := ''; - AudioPlayback.PlaySound(SoundLib.Back); - FadeTo(BackScreen); + ConversionFileName := ''; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(BackScreen); end; SDLK_RETURN: begin - if (Interaction = 2) then begin + if (Interaction = 2) then + begin //Update Filename and go to last Screen ConversionFileName := Text[TextN].Text; AudioPlayback.PlaySound(SoundLib.Back); @@ -166,9 +169,9 @@ constructor TScreenOpen.Create; begin inherited Create; - // linijka + // line { AddStatic(20, 10, 80, 30, 0, 0, 0, 'MainBar', 'JPG', TEXTURE_TYPE_COLORIZED); - AddText(35, 17, 1, 18, 1, 1, 1, 'Linijka'); + AddText(35, 17, 1, 18, 1, 1, 1, 'line'); TextSentence := AddText(120, 14, 1, 24, 0, 0, 0, '0 / 0');} // file list @@ -195,7 +198,6 @@ begin AddButton(670, 540, 100, 40, Skin.GetTextureFileName('ButtonF')); AddButtonText(30, 5, 0, 0, 0, 'OK'); - end; procedure TScreenOpen.onShow; @@ -207,11 +209,9 @@ end; (*function TScreenEditSub.Draw: boolean; var - Min: integer; - Sec: integer; - Tekst: string; - Pet: integer; - AktBeat: integer; + Min: integer; + Sec: integer; + AktBeat: integer; begin end; @@ -222,4 +222,3 @@ begin end;*) end. - diff --git a/unicode/src/screens/UScreenOptions.pas b/unicode/src/screens/UScreenOptions.pas index ab49c49c..ff2a3fe2 100644 --- a/unicode/src/screens/UScreenOptions.pas +++ b/unicode/src/screens/UScreenOptions.pas @@ -82,7 +82,7 @@ begin SDLK_ESCAPE, SDLK_BACKSPACE : begin -// Ini.Save; + Ini.Save; AudioPlayback.PlaySound(SoundLib.Back); FadeTo(@ScreenMain); end; diff --git a/unicode/src/screens/UScreenOptionsRecord.pas b/unicode/src/screens/UScreenOptionsRecord.pas index 391c2090..0cf9eb37 100644 --- a/unicode/src/screens/UScreenOptionsRecord.pas +++ b/unicode/src/screens/UScreenOptionsRecord.pas @@ -167,8 +167,8 @@ begin SDLK_ESCAPE, SDLK_BACKSPACE: begin - // Escape -> save nothing - just leave this screen - + // TODO: Show Save/Abort screen + Ini.Save; AudioPlayback.PlaySound(SoundLib.Back); FadeTo(@ScreenOptions); end; diff --git a/unicode/src/screens/UScreenOptionsThemes.pas b/unicode/src/screens/UScreenOptionsThemes.pas index dcd870ca..64816d34 100644 --- a/unicode/src/screens/UScreenOptionsThemes.pas +++ b/unicode/src/screens/UScreenOptionsThemes.pas @@ -57,12 +57,13 @@ type implementation -uses - UMain, +uses + SysUtils, UGraphic, - USkins, + UMain, + UPath, UUnicodeUtils, - SysUtils; + USkins; function TScreenOptionsThemes.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; begin diff --git a/unicode/src/screens/UScreenPartyOptions.pas b/unicode/src/screens/UScreenPartyOptions.pas index b484144b..74c51b15 100644 --- a/unicode/src/screens/UScreenPartyOptions.pas +++ b/unicode/src/screens/UScreenPartyOptions.pas @@ -34,46 +34,47 @@ interface {$I switches.inc} uses - SDL, - SysUtils, UMenu, + SDL, UDisplay, UMusic, UFiles, + SysUtils, UThemes; type TScreenPartyOptions = class(TMenu) public - SelectLevel: Cardinal; - SelectPlayList: Cardinal; - SelectPlayList2: Cardinal; - SelectRounds: Cardinal; - SelectTeams: Cardinal; - SelectPlayers1: Cardinal; - SelectPlayers2: Cardinal; - SelectPlayers3: Cardinal; - - PlayList: Integer; - PlayList2: Integer; - Rounds: Integer; - NumTeams: Integer; - NumPlayer1, NumPlayer2, NumPlayer3: Integer; - + SelectLevel: cardinal; + SelectPlayList: cardinal; + SelectPlayList2: cardinal; + SelectRounds: cardinal; + SelectTeams: cardinal; + SelectPlayers1: cardinal; + SelectPlayers2: cardinal; + SelectPlayers3: cardinal; + + PlayList: integer; + PlayList2: integer; + Rounds: integer; + NumTeams: integer; + NumPlayer1, NumPlayer2, NumPlayer3: integer; + constructor Create; override; - function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override; + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; procedure onShow; override; procedure SetAnimationProgress(Progress: real); override; procedure SetPlaylist2; end; var - IPlaylist: array[0..2] of String; - IPlaylist2: array of String; -const - ITeams: array[0..1] of String =('2', '3'); - IPlayers: array[0..3] of String =('1', '2', '3', '4'); - IRounds: array[0..5] of String = ('2', '3', '4', '5', '6', '7'); + IPlaylist: array[0..2] of string; + IPlaylist2: array of string; + + const + ITeams: array[0..1] of string = ('2', '3'); + IPlayers: array[0..3] of string = ('1', '2', '3', '4'); + IRounds: array[0..5] of string = ('2', '3', '4', '5', '6', '7'); implementation @@ -90,13 +91,13 @@ uses USongs, UUnicodeUtils; -function TScreenPartyOptions.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; - var - I, J: Integer; - OnlyMultiPlayer: boolean; +function TScreenPartyOptions.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; +var + I, J: integer; + OnlyMultiPlayer: boolean; begin Result := true; - If (PressedDown) Then + if (PressedDown) then begin // Key Down // check normal keys case UCS4UpperCase(CharCode) of @@ -119,14 +120,16 @@ begin SDLK_RETURN: begin //Don'T start when Playlist is Selected and there are no Playlists - If (Playlist = 2) and (Length(PlaylistMan.Playlists) = 0) then + if (Playlist = 2) and (Length(PlaylistMan.Playlists) = 0) then Exit; // Don't start when SinglePlayer Teams but only Multiplayer Plugins available - OnlyMultiPlayer:=true; - for I := 0 to High(DLLMan.Plugins) do begin - OnlyMultiPlayer := (OnlyMultiPlayer AND DLLMan.Plugins[I].TeamModeOnly); + OnlyMultiPlayer := true; + for I := 0 to High(DLLMan.Plugins) do + begin + OnlyMultiPlayer := (OnlyMultiPlayer and DLLMan.Plugins[I].TeamModeOnly); end; - if (OnlyMultiPlayer) AND ((NumPlayer1 = 0) OR (NumPlayer2 = 0) OR ((NumPlayer3 = 0) AND (NumTeams = 1))) then begin + if (OnlyMultiPlayer) and ((NumPlayer1 = 0) or (NumPlayer2 = 0) or ((NumPlayer3 = 0) and (NumTeams = 1))) then + begin ScreenPopupError.ShowPopup(Language.Translate('ERROR_NO_PLUGINS')); Exit; end; @@ -143,12 +146,12 @@ begin //Save Playlist PlaylistMan.Mode := TSingMode( Playlist ); - PlaylistMan.CurPlayList := High(Cardinal); - //If Category Selected Search Category ID + PlaylistMan.CurPlayList := High(cardinal); + //if Category Selected Search Category ID if Playlist = 1 then begin J := -1; - For I := 0 to high(CatSongs.Song) do + for I := 0 to high(CatSongs.Song) do begin if CatSongs.Song[I].Main then Inc(J); @@ -161,7 +164,7 @@ begin end; //No Categorys or Invalid Entry - If PlaylistMan.CurPlayList = High(Cardinal) then + if PlaylistMan.CurPlayList = High(cardinal) then Exit; end else @@ -187,11 +190,11 @@ begin InteractInc; //Change Playlist2 if Playlist is Changed - If (Interaction = 1) then + if (Interaction = 1) then begin SetPlaylist2; end //Change Team3 Players visibility - Else If (Interaction = 4) then + else if (Interaction = 4) then begin SelectsS[7].Visible := (NumTeams = 1); end; @@ -202,11 +205,11 @@ begin InteractDec; //Change Playlist2 if Playlist is Changed - If (Interaction = 1) then + if (Interaction = 1) then begin SetPlaylist2; end //Change Team3 Players visibility - Else If (Interaction = 4) then + else if (Interaction = 4) then begin SelectsS[7].Visible := (NumTeams = 1); end; @@ -239,25 +242,25 @@ begin //Load Screen From Theme LoadFromTheme(Theme.PartyOptions); - SelectLevel := AddSelectSlide (Theme.PartyOptions.SelectLevel, Ini.Difficulty, Theme.ILevel); - SelectPlayList := AddSelectSlide (Theme.PartyOptions.SelectPlayList, PlayList, IPlaylist); + SelectLevel := AddSelectSlide (Theme.PartyOptions.SelectLevel, Ini.Difficulty, Theme.ILevel); + SelectPlayList := AddSelectSlide (Theme.PartyOptions.SelectPlayList, PlayList, IPlaylist); SelectPlayList2 := AddSelectSlide (Theme.PartyOptions.SelectPlayList2, PlayList2, IPlaylist2); - SelectRounds := AddSelectSlide (Theme.PartyOptions.SelectRounds, Rounds, IRounds); - SelectTeams := AddSelectSlide (Theme.PartyOptions.SelectTeams, NumTeams, ITeams); - SelectPlayers1 := AddSelectSlide (Theme.PartyOptions.SelectPlayers1, NumPlayer1, IPlayers); - SelectPlayers2 := AddSelectSlide (Theme.PartyOptions.SelectPlayers2, NumPlayer2, IPlayers); - SelectPlayers3 := AddSelectSlide (Theme.PartyOptions.SelectPlayers3, NumPlayer3, IPlayers); + SelectRounds := AddSelectSlide (Theme.PartyOptions.SelectRounds, Rounds, IRounds); + SelectTeams := AddSelectSlide (Theme.PartyOptions.SelectTeams, NumTeams, ITeams); + SelectPlayers1 := AddSelectSlide (Theme.PartyOptions.SelectPlayers1, NumPlayer1, IPlayers); + SelectPlayers2 := AddSelectSlide (Theme.PartyOptions.SelectPlayers2, NumPlayer2, IPlayers); + SelectPlayers3 := AddSelectSlide (Theme.PartyOptions.SelectPlayers3, NumPlayer3, IPlayers); Interaction := 0; //Hide Team3 Players - SelectsS[7].Visible := False; + SelectsS[7].Visible := false; end; procedure TScreenPartyOptions.SetPlaylist2; -var I: Integer; +var I: integer; begin - Case Playlist of + case Playlist of 0: begin SetLength(IPlaylist2, 1); @@ -266,16 +269,16 @@ begin 1: begin SetLength(IPlaylist2, 0); - For I := 0 to high(CatSongs.Song) do + for I := 0 to high(CatSongs.Song) do begin - If (CatSongs.Song[I].Main) then + if (CatSongs.Song[I].Main) then begin SetLength(IPlaylist2, Length(IPlaylist2) + 1); IPlaylist2[high(IPlaylist2)] := CatSongs.Song[I].Artist; end; end; - If (Length(IPlaylist2) = 0) then + if (Length(IPlaylist2) = 0) then begin SetLength(IPlaylist2, 1); IPlaylist2[0] := 'No Categories found'; diff --git a/unicode/src/screens/UScreenScore.pas b/unicode/src/screens/UScreenScore.pas index e807f8d8..5c312938 100644 --- a/unicode/src/screens/UScreenScore.pas +++ b/unicode/src/screens/UScreenScore.pas @@ -46,56 +46,56 @@ uses UTexture; const - ZBars : real = 0.8; // Z value for the bars - ZRatingPic : real = 0.8; // Z value for the rating pictures + ZBars: real = 0.8; // Z value for the bars + ZRatingPic: real = 0.8; // Z value for the rating pictures - EaseOut_MaxSteps : real = 10; // that's the speed of the bars (10 is fast | 100 is slower) + EaseOut_MaxSteps: real = 10; // that's the speed of the bars (10 is fast | 100 is slower) - BarRaiseSpeed : cardinal = 0; // Time for raising the bar one step higher (in ms) + BarRaiseSpeed: cardinal = 0; // Time for raising the bar one step higher (in ms) type TPlayerScoreScreenTexture = record // holds all colorized textures for up to 6 players //Bar textures - Score_NoteBarLevel_Dark : TTexture; // Note - Score_NoteBarRound_Dark : TTexture; // that's the round thing on top + Score_NoteBarLevel_Dark: TTexture; // Note + Score_NoteBarRound_Dark: TTexture; // that's the round thing on top - Score_NoteBarLevel_Light : TTexture; // LineBonus | Phrasebonus - Score_NoteBarRound_Light : TTexture; + Score_NoteBarLevel_Light: TTexture; // LineBonus | Phrasebonus + Score_NoteBarRound_Light: TTexture; - Score_NoteBarLevel_Lightest : TTexture; // GoldenNotes - Score_NoteBarRound_Lightest : TTexture; + Score_NoteBarLevel_Lightest: TTexture; // GoldenNotes + Score_NoteBarRound_Lightest: TTexture; end; TPlayerScoreScreenData = record // holds the positions and other data - Bar_Y :Real; - Bar_Actual_Height : Real; // this one holds the actual height of the bar, while we animate it - BarScore_ActualHeight : Real; - BarLine_ActualHeight : Real; - BarGolden_ActualHeight : Real; + Bar_Y: real; + Bar_Actual_Height: real; // this one holds the actual height of the bar, while we animate it + BarScore_ActualHeight: real; + BarLine_ActualHeight: real; + BarGolden_ActualHeight: real; end; TPlayerScoreRatingPics = record // a fine array of the rating pictures - RateEaseStep : Integer; - RateEaseValue: Real; + RateEaseStep: integer; + RateEaseValue: real; end; TScreenScore = class(TMenu) private - BarTime : Cardinal; - ArrayStartModifier : integer; + BarTime: cardinal; + ArrayStartModifier: integer; public - aPlayerScoreScreenTextures : array[1..6] of TPlayerScoreScreenTexture; - aPlayerScoreScreenDatas : array[1..6] of TPlayerScoreScreenData; - aPlayerScoreScreenRatings : array[1..6] of TPlayerScoreRatingPics; + aPlayerScoreScreenTextures: array[1..6] of TPlayerScoreScreenTexture; + aPlayerScoreScreenDatas: array[1..6] of TPlayerScoreScreenData; + aPlayerScoreScreenRatings: array[1..6] of TPlayerScoreRatingPics; - BarScore_EaseOut_Step : real; - BarPhrase_EaseOut_Step : real; - BarGolden_EaseOut_Step : real; + BarScore_EaseOut_Step: real; + BarPhrase_EaseOut_Step: real; + BarGolden_EaseOut_Step: real; - TextArtist: integer; - TextTitle: integer; + TextArtist: integer; + TextTitle: integer; - TextArtistTitle : integer; + TextArtistTitle: integer; TextName: array[1..6] of integer; TextScore: array[1..6] of integer; @@ -110,65 +110,62 @@ type TextTotalScore: array[1..6] of integer; PlayerStatic: array[1..6] of array of integer; - PlayerTexts : array[1..6] of array of integer; - + PlayerTexts: array[1..6] of array of integer; StaticBoxLightest: array[1..6] of integer; StaticBoxLight: array[1..6] of integer; StaticBoxDark: array[1..6] of integer; - StaticBackLevel: array[1..6] of integer; - StaticBackLevelRound: array[1..6] of integer; - StaticLevel: array[1..6] of integer; - StaticLevelRound: array[1..6] of integer; - - Animation: real; - - TextScore_ActualValue : array[1..6] of integer; - TextPhrase_ActualValue : array[1..6] of integer; - TextGolden_ActualValue : array[1..6] of integer; + StaticBackLevel: array[1..6] of integer; + StaticBackLevelRound: array[1..6] of integer; + StaticLevel: array[1..6] of integer; + StaticLevelRound: array[1..6] of integer; + Animation: real; + TextScore_ActualValue: array[1..6] of integer; + TextPhrase_ActualValue: array[1..6] of integer; + TextGolden_ActualValue: array[1..6] of integer; constructor Create; override; - function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override; + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; procedure onShow; override; procedure onShowFinish; override; function Draw: boolean; override; procedure FillPlayer(Item, P: integer); - procedure EaseBarIn(PlayerNumber : Integer; BarType: String); - procedure EaseScoreIn(PlayerNumber : Integer; ScoreType: String); - - procedure FillPlayerItems(PlayerNumber : Integer; ScoreType: String); + procedure EaseBarIn(PlayerNumber: integer; BarType: string); + procedure EaseScoreIn(PlayerNumber: integer; ScoreType: string); + procedure FillPlayerItems(PlayerNumber: integer; ScoreType: string); - procedure DrawBar(BarType:string; PlayerNumber: integer; BarStartPosY: single; NewHeight: real); + procedure DrawBar(BarType: string; PlayerNumber: integer; BarStartPosY: single; NewHeight: real); //Rating Picture procedure ShowRating(PlayerNumber: integer); - function CalculateBouncing(PlayerNumber : Integer): real; - procedure DrawRating(PlayerNumber:integer;Rating:integer); + function CalculateBouncing(PlayerNumber: integer): real; + procedure DrawRating(PlayerNumber: integer; Rating: integer); end; implementation - uses UGraphic, UScreenSong, UMenuStatic, UTime, - UMain, UIni, ULog, ULanguage, + UNote, UUnicodeUtils; -function TScreenScore.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; + +function TScreenScore.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; begin Result := true; - If (PressedDown) Then begin + if (PressedDown) then + begin // check normal keys case UCS4UpperCase(CharCode) of Ord('Q'): @@ -258,9 +255,9 @@ end; procedure TScreenScore.onShow; var - P: integer; // player - I: integer; - V: array[1..6] of boolean; // visibility array + P: integer; // player + I: integer; + V: array[1..6] of boolean; // visibility array begin @@ -297,7 +294,6 @@ begin aPlayerScoreScreenRatings[P].RateEaseValue := 20; end; - Text[TextArtist].Text := CurrentSong.Artist; Text[TextTitle].Text := CurrentSong.Title; Text[TextArtistTitle].Text := CurrentSong.Artist + ' - ' + CurrentSong.Title; @@ -349,7 +345,6 @@ begin Static[StaticBoxLight[P]].Texture.Alpha := 0; Static[StaticBoxDark[P]].Texture.Alpha := 0; - Text[TextNotes[P]].Visible := V[P]; Text[TextNotesScore[P]].Visible := V[P]; Text[TextLineBonus[P]].Visible := V[P]; @@ -379,14 +374,14 @@ end; procedure TScreenScore.onShowFinish; var - index : integer; + index: integer; begin for index := 1 to (PlayersPlay) do - begin - TextScore_ActualValue[index] := 0; - TextPhrase_ActualValue[index] := 0; - TextGolden_ActualValue[index] := 0; - end; + begin + TextScore_ActualValue[index] := 0; + TextPhrase_ActualValue[index] := 0; + TextGolden_ActualValue[index] := 0; + end; BarScore_EaseOut_Step := 1; BarPhrase_EaseOut_Step := 1; @@ -395,11 +390,11 @@ end; function TScreenScore.Draw: boolean; var - CurrentTime : Cardinal; - PlayerCounter : integer; + CurrentTime: cardinal; + PlayerCounter: integer; + PStart: integer; + PHigh: integer; begin - - inherited Draw; {* player[0].ScoreInt := 7000; player[0].ScoreLineInt := 2000; @@ -411,13 +406,38 @@ begin player[1].ScoreGoldenInt := 900; player[1].ScoreTotalInt := 4500; *} + + //Draw the Background + DrawBG; + + //Calculate first and last Player on this Screen + if (PlayersPlay > 3) then + begin + case PlayersPlay of + 4: begin + PStart := 1 + ((ScreenAct-1) * 2); + PHigh := 2 + ((ScreenAct-1) * 2); + end; + + 6: begin + PStart := 1 + ((ScreenAct-1) * 3); + PHigh := 3 + ((ScreenAct-1) * 3); + end; + end; + end + else + begin + PStart := 1; + PHigh := PlayersPlay; + end; + // Let's start to arise the bars CurrentTime := SDL_GetTicks(); - if((CurrentTime >= BarTime) AND ShowFinish) then + if((CurrentTime >= BarTime) and ShowFinish) then begin BarTime := CurrentTime + BarRaiseSpeed; - for PlayerCounter := 1 to PlayersPlay do + for PlayerCounter := PStart to PHigh do begin // We actually arise them in the right order, but we have to draw them in reverse order (golden -> phrase -> mainscore) if (BarScore_EaseOut_Step < EaseOut_MaxSteps * 10) then @@ -429,7 +449,6 @@ begin if (BarPhrase_EaseOut_Step < EaseOut_MaxSteps * 10) then BarPhrase_EaseOut_Step := BarPhrase_EaseOut_Step + 1; - // GoldenNotebonus if (BarPhrase_EaseOut_Step >= (EaseOut_MaxSteps * 10)) then begin @@ -450,12 +469,25 @@ begin EaseBarIn(PlayerCounter, 'Note'); EaseScoreIn(PlayerCounter,'Note'); - - FillPlayerItems(PlayerCounter,'Funky'); + if (PlayersPlay <= 3) then + //If we play w/ 3 or less players they fit in one screen + //so we don't have to swap the values of themeobjects + //on every draw + FillPlayerItems(PlayerCounter,'Funky'); end; end; + if (PlayersPlay > 3) then + //more then 3 players don't fit the screen + //so we have to swap the themeobjects values on every draw + for PlayerCounter := PStart to PHigh do + begin + FillPlayerItems(PlayerCounter,'Funky'); + end; + + //Draw Theme Objects + DrawFG; (* //todo: i need a clever method to draw statics with their z value @@ -468,7 +500,7 @@ begin Result := true; end; -procedure TscreenScore.FillPlayerItems(PlayerNumber : Integer; ScoreType: String); +procedure TscreenScore.FillPlayerItems(PlayerNumber: integer; ScoreType: string); var ThemeIndex: integer; begin @@ -476,7 +508,13 @@ begin Text[TextName[PlayerNumber + ArrayStartModifier]].Text := Ini.Name[PlayerNumber - 1]; // end todo - ThemeIndex := PlayerNumber + ArrayStartModifier; + // We have to do this here because we use the same Theme Object + // for players on the first and second screen + case PlayersPlay of + 1, 2, 3: ThemeIndex := PlayerNumber + ArrayStartModifier; + 4: ThemeIndex := ((PlayerNumber-1) mod 2) + 1 + ArrayStartModifier; + 6: ThemeIndex := ((PlayerNumber-1) mod 3) + 1 + ArrayStartModifier; + end; //golden Text[TextGoldenNotesScore[ThemeIndex]].Text := IntToStr(TextGolden_ActualValue[PlayerNumber]); @@ -513,14 +551,19 @@ begin end; end; - procedure TScreenScore.ShowRating(PlayerNumber: integer); var - Rating : integer; - ThemeIndex : integer; + Rating: integer; + ThemeIndex: integer; begin - ThemeIndex := PlayerNumber + ArrayStartModifier; + // We have to do this here because we use the same Theme Object + // for players on the first and second screen + case PlayersPlay of + 1, 2, 3: ThemeIndex := PlayerNumber + ArrayStartModifier; + 4: ThemeIndex := ((PlayerNumber-1) mod 2) + 1 + ArrayStartModifier; + 6: ThemeIndex := ((PlayerNumber-1) mod 3) + 1 + ArrayStartModifier; + end; case (Player[PlayerNumber-1].ScoreTotalInt) of 0..2009: @@ -568,7 +611,7 @@ begin end; //todo: this could break if the width is not given, for instance when there's a skin with no picture for ratings - if ( Theme.Score.StaticRatings[ThemeIndex].W > 0 ) AND ( aPlayerScoreScreenRatings[PlayerNumber].RateEaseValue > 0 ) then + if ( Theme.Score.StaticRatings[ThemeIndex].W > 0 ) and ( aPlayerScoreScreenRatings[PlayerNumber].RateEaseValue > 0 ) then begin Text[TextScore[ThemeIndex]].Alpha := aPlayerScoreScreenRatings[PlayerNumber].RateEaseValue / Theme.Score.StaticRatings[ThemeIndex].W; end; @@ -577,11 +620,11 @@ begin DrawRating(PlayerNumber, Rating); end; -procedure TscreenScore.DrawRating(PlayerNumber:integer;Rating:integer); +procedure TscreenScore.DrawRating(PlayerNumber: integer; Rating: integer); var - Posx : real; - Posy : real; - Width :real; + Posx: real; + Posy: real; + Width: real; begin CalculateBouncing(PlayerNumber); @@ -608,56 +651,53 @@ begin glDisable(GL_TEXTURE_2d); end; - - -function TscreenScore.CalculateBouncing(PlayerNumber : Integer): real; +function TscreenScore.CalculateBouncing(PlayerNumber: integer): real; var - ReturnValue : real; - p, s : real; + ReturnValue: real; + p, s: real; - RaiseStep, MaxVal : real; - EaseOut_Step : integer; + RaiseStep, MaxVal: real; + EaseOut_Step: integer; begin EaseOut_Step := aPlayerScoreScreenRatings[PlayerNumber].RateEaseStep; MaxVal := Theme.Score.StaticRatings[PlayerNumber + ArrayStartModifier].W; RaiseStep := EaseOut_Step; - if (MaxVal > 0) AND (RaiseStep > 0) then + if (MaxVal > 0) and (RaiseStep > 0) then RaiseStep := RaiseStep / MaxVal; - if (RaiseStep = 1) then - begin - ReturnValue := MaxVal; - end - else - begin - p := MaxVal * 0.4; + if (RaiseStep = 1) then + begin + ReturnValue := MaxVal; + end + else + begin + p := MaxVal * 0.4; - s := p/(2*PI) * arcsin (1); - ReturnValue := MaxVal * power(2,-5 * RaiseStep) * sin( (RaiseStep * MaxVal - s) * (2 * PI) / p) + MaxVal; + s := p/(2*PI) * arcsin (1); + ReturnValue := MaxVal * power(2,-5 * RaiseStep) * sin( (RaiseStep * MaxVal - s) * (2 * PI) / p) + MaxVal; - inc(aPlayerScoreScreenRatings[PlayerNumber].RateEaseStep); - aPlayerScoreScreenRatings[PlayerNumber].RateEaseValue := ReturnValue; - end; + inc(aPlayerScoreScreenRatings[PlayerNumber].RateEaseStep); + aPlayerScoreScreenRatings[PlayerNumber].RateEaseValue := ReturnValue; + end; Result := ReturnValue; end; - -procedure TscreenScore.EaseBarIn(PlayerNumber : Integer; BarType: String); +procedure TscreenScore.EaseBarIn(PlayerNumber: integer; BarType: string); const - RaiseSmoothness : integer = 100; + RaiseSmoothness: integer = 100; var - MaxHeight : real; - NewHeight : real; + MaxHeight: real; + NewHeight: real; - Height2Reach : real; - RaiseStep : real; - BarStartPosY : single; + Height2Reach: real; + RaiseStep: real; + BarStartPosY: single; - lTmp : real; - Score : integer; + lTmp: real; + Score: integer; begin MaxHeight := Theme.Score.StaticBackLevel[PlayerNumber + ArrayStartModifier].H; @@ -718,10 +758,10 @@ begin aPlayerScoreScreenDatas[PlayerNumber].BarGolden_ActualHeight := NewHeight; end; -procedure TscreenScore.DrawBar(BarType:string; PlayerNumber: integer; BarStartPosY: single; NewHeight: real); +procedure TscreenScore.DrawBar(BarType: string; PlayerNumber: integer; BarStartPosY: single; NewHeight: real); var - Width:real; - BarStartPosX:real; + Width: real; + BarStartPosX: real; begin // this is solely for better readability of the drawing Width := Theme.Score.StaticBackLevel[PlayerNumber + ArrayStartModifier].W; @@ -775,15 +815,15 @@ begin glDisable(GL_TEXTURE_2d); end; -procedure TScreenScore.EaseScoreIn(PlayerNumber: integer; ScoreType : String); +procedure TScreenScore.EaseScoreIn(PlayerNumber: integer; ScoreType: string); const - RaiseSmoothness : integer = 100; + RaiseSmoothness: integer = 100; var - RaiseStep : Real; - lTmpA : Real; - ScoreReached :Integer; - EaseOut_Step :Real; - ActualScoreValue:integer; + RaiseStep: real; + lTmpA: real; + ScoreReached: integer; + EaseOut_Step: real; + ActualScoreValue: integer; begin if (ScoreType = 'Note') then begin @@ -815,7 +855,7 @@ begin // quadratic easing out - decelerating to zero velocity // -end_position * current_time * ( current_time - 2 ) + start_postion lTmpA := (-ScoreReached * RaiseStep * (RaiseStep - 20)); - if ( lTmpA > 0 ) AND + if ( lTmpA > 0 ) and ( RaiseSmoothness > 0 ) then begin if (ScoreType = 'Note') then @@ -869,7 +909,6 @@ begin Text[TextGoldenNotesScore[Item]].Text := S; //end of fix - end; end. diff --git a/unicode/src/screens/UScreenSing.pas b/unicode/src/screens/UScreenSing.pas index 94d2b550..05683c83 100644 --- a/unicode/src/screens/UScreenSing.pas +++ b/unicode/src/screens/UScreenSing.pas @@ -33,24 +33,23 @@ interface {$I switches.inc} - uses - SDL, SysUtils, + SDL, + TextGL, gl, - UMenu, - UMusic, UFiles, - UTime, - USongs, + UGraphicClasses, UIni, ULog, - UTexture, ULyrics, - TextGL, + UMenu, + UMusic, + USingScores, + USongs, + UTexture, UThemes, - UGraphicClasses, - USingScores; + UTime; type TLyricsSyncSource = class(TSyncSource) @@ -62,22 +61,22 @@ type private VideoLoaded: boolean; protected - Paused: boolean; //Pause Mod + Paused: boolean; // pause mod LyricsSync: TLyricsSyncSource; NumEmptySentences: integer; public - // TimeBar fields + // timebar fields StaticTimeProgress: integer; TextTimeText: integer; StaticP1: integer; TextP1: integer; - //shown when game is in 2/4 player modus + // shown when game is in 2/4 player modus StaticP1TwoP: integer; TextP1TwoP: integer; - //shown when game is in 3/6 player modus + // shown when game is in 3/6 player modus StaticP1ThreeP: integer; TextP1ThreeP: integer; @@ -96,7 +95,7 @@ type FadeOut: boolean; Lyrics: TLyricEngine; - //Score Manager: + // score manager: Scores: TSingScores; fShowVisualization: boolean; @@ -106,16 +105,16 @@ type procedure onShow; override; procedure onShowFinish; override; procedure onHide; override; - + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; function Draw: boolean; override; procedure Finish; virtual; - procedure Pause; // Toggle Pause + procedure Pause; // toggle pause - procedure OnSentenceEnd(SentenceIndex: cardinal); // for LineBonus + Singbar - procedure OnSentenceChange(SentenceIndex: cardinal); // for Golden Notes + procedure OnSentenceEnd(SentenceIndex: cardinal); // for linebonus + singbar + procedure OnSentenceChange(SentenceIndex: cardinal); // for golden notes end; implementation @@ -123,37 +122,38 @@ implementation uses Classes, Math, - UGraphic, UDraw, - UMain, - USong, - URecord, + UGraphic, ULanguage, + UNote, + URecord, + USong, UUnicodeUtils; - // Method for input parsing. If False is returned, GetNextWindow - // should be checked to know the next window to load; +// method for input parsing. if false is returned, getnextwindow +// should be checked to know the next window to load; + function TScreenSing.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; begin - Result := True; + Result := true; if (PressedDown) then - begin // Key Down - // check normal keys + begin // key down + // check normal keys case UCS4UpperCase(CharCode) of Ord('Q'): begin - //When not ask before Exit then Finish now + // when not ask before exit then finish now if (Ini.AskbeforeDel <> 1) then Finish - //else just Pause and let the Popup make the Work + // else just pause and let the popup make the work else if not Paused then Pause; - Result := False; + Result := false; Exit; end; - Ord('V'): //Show Visualization + Ord('V'): // show visualization begin fShowVisualization := not fShowVisualization; @@ -179,7 +179,7 @@ begin SDLK_ESCAPE, SDLK_BACKSPACE: begin - //Record Sound Hack: + // record sound hack: //Sound[0].BufferLong Finish; @@ -192,7 +192,7 @@ begin Pause; end; - SDLK_TAB: //Change Visualization Preset + SDLK_TAB: // change visualization preset begin if fShowVisualization then fCurrentVideoPlaybackEngine.Position := now; // move to a random position @@ -202,8 +202,8 @@ begin begin end; - // Up and Down could be done at the same time, - // but I don't want to declare variables inside + // up and down could be done at the same time, + // but i don't want to declare variables inside // functions like this one, called so many times SDLK_DOWN: begin @@ -215,57 +215,57 @@ begin end; end; -//Pause Mod +// pause mod procedure TScreenSing.Pause; begin - if (not Paused) then //enable Pause + if (not Paused) then // enable pause begin - // pause Time - Paused := True; + // pause time + Paused := true; LyricsState.Pause(); - // pause Music + // pause music AudioPlayback.Pause; - // pause Video + // pause video if (CurrentSong.Video <> '') and FileExists(CurrentSong.Path + CurrentSong.Video) then fCurrentVideoPlaybackEngine.Pause; end - else //disable Pause + else // disable pause begin LyricsState.Resume(); - // Play Music + // play music AudioPlayback.Play; - // Video + // video if (CurrentSong.Video <> '') and FileExists(CurrentSong.Path + CurrentSong.Video) then fCurrentVideoPlaybackEngine.Pause; - Paused := False; + Paused := false; end; end; -//Pause Mod End +// pause mod end constructor TScreenSing.Create; begin inherited Create; - fShowVisualization := False; + fShowVisualization := false; fCurrentVideoPlaybackEngine := VideoPlayback; - //Create Score Class + // create score class Scores := TSingScores.Create; Scores.LoadfromTheme; LoadFromTheme(Theme.Sing); - //TimeBar + // timebar StaticTimeProgress := AddStatic(Theme.Sing.StaticTimeProgress); TextTimeText := AddText(Theme.Sing.TextTimeText); @@ -277,7 +277,7 @@ begin StaticP1TwoP := AddStatic(Theme.Sing.StaticP1TwoP); TextP1TwoP := AddText(Theme.Sing.TextP1TwoP); - // | P2 + // | P2 StaticP2R := AddStatic(Theme.Sing.StaticP2R); TextP2R := AddText(Theme.Sing.TextP2R); @@ -285,18 +285,18 @@ begin StaticP1ThreeP := AddStatic(Theme.Sing.StaticP1ThreeP); TextP1ThreeP := AddText(Theme.Sing.TextP1ThreeP); - // | P2 + // | P2 StaticP2M := AddStatic(Theme.Sing.StaticP2M); TextP2M := AddText(Theme.Sing.TextP2M); - // | P3 + // | P3 StaticP3R := AddStatic(Theme.Sing.StaticP3R); TextP3R := AddText(Theme.Sing.TextP3R); StaticPausePopup := AddStatic(Theme.Sing.PausePopUp); - //<note>Pausepopup is not visibile at the beginning</note> - Static[StaticPausePopup].Visible := False; + // <note> pausepopup is not visibile at the beginning </note> + Static[StaticPausePopup].Visible := false; Lyrics := TLyricEngine.Create( Skin_LyricsUpperX, Skin_LyricsUpperY, Skin_LyricsUpperW, Skin_LyricsUpperH, @@ -307,10 +307,10 @@ end; procedure TScreenSing.onShow; var - P: integer; + Index: integer; V1: boolean; - V1TwoP: boolean; //Position of ScoreBox in two-player mode - V1ThreeP: boolean; //Position of ScoreBox in three-player mode + V1TwoP: boolean; // position of score box in two player mode + V1ThreeP: boolean; // position of score box in three player mode V2R: boolean; V2M: boolean; V3R: boolean; @@ -321,9 +321,9 @@ begin inherited; Log.LogStatus('Begin', 'onShow'); - FadeOut := False; + FadeOut := false; - // reset video playback engine, to play Video Clip... + // reset video playback engine, to play video clip ... fCurrentVideoPlaybackEngine := VideoPlayback; // setup score manager @@ -333,12 +333,12 @@ begin Color.B := 0; // dummy atm <- \(O.o)/? B like bummy? // add new players - for P := 0 to PlayersPlay - 1 do + for Index := 0 to PlayersPlay - 1 do begin - Scores.AddPlayer(Tex_ScoreBG[P], Color); + Scores.AddPlayer(Tex_ScoreBG[Index], Color); end; - Scores.Init; //Get Positions for Players + Scores.Init; // get positions for players // prepare players SetLength(Player, PlayersPlay); @@ -346,92 +346,87 @@ begin case PlayersPlay of 1: begin - V1 := True; - V1TwoP := False; - V1ThreeP := False; - V2R := False; - V2M := False; - V3R := False; + V1 := true; + V1TwoP := false; + V1ThreeP := false; + V2R := false; + V2M := false; + V3R := false; end; 2: begin - V1 := False; - V1TwoP := True; - V1ThreeP := False; - V2R := True; - V2M := False; - V3R := False; + V1 := false; + V1TwoP := true; + V1ThreeP := false; + V2R := true; + V2M := false; + V3R := false; end; 3: begin - V1 := False; - V1TwoP := False; - V1ThreeP := True; - V2R := False; - V2M := True; - V3R := True; + V1 := false; + V1TwoP := false; + V1ThreeP := true; + V2R := false; + V2M := true; + V3R := true; end; 4: begin // double screen - V1 := False; - V1TwoP := True; - V1ThreeP := False; - V2R := True; - V2M := False; - V3R := False; + V1 := false; + V1TwoP := true; + V1ThreeP := false; + V2R := true; + V2M := false; + V3R := false; end; 6: begin // double screen - V1 := False; - V1TwoP := False; - V1ThreeP := True; - V2R := False; - V2M := True; - V3R := True; + V1 := false; + V1TwoP := false; + V1ThreeP := true; + V2R := false; + V2M := true; + V3R := true; end; end; - //This one is shown in 1P mode + // this one is shown in 1P mode Static[StaticP1].Visible := V1; Text[TextP1].Visible := V1; - - //This one is shown in 2/4P mode + // this one is shown in 2/4P mode Static[StaticP1TwoP].Visible := V1TwoP; Text[TextP1TwoP].Visible := V1TwoP; Static[StaticP2R].Visible := V2R; Text[TextP2R].Visible := V2R; - - //This one is shown in 3/6P mode + // this one is shown in 3/6P mode Static[StaticP1ThreeP].Visible := V1ThreeP; Text[TextP1ThreeP].Visible := V1ThreeP; - Static[StaticP2M].Visible := V2M; Text[TextP2M].Visible := V2M; - Static[StaticP3R].Visible := V3R; Text[TextP3R].Visible := V3R; - - // FIXME: sets Path and Filename to '' + // FIXME: sets path and filename to '' ResetSingTemp; CurrentSong := CatSongs.Song[CatSongs.Selected]; - // FIXME: bad style, put the try-except into LoadSong() and not here + // FIXME: bad style, put the try-except into loadsong() and not here try - // Check if file is XML + // check if file is xml if copy(CurrentSong.FileName, length(CurrentSong.FileName) - 3, 4) = '.xml' then success := CurrentSong.LoadXMLSong() else success := CurrentSong.LoadSong(); except - success := False; + success := false; end; if (not success) then @@ -450,7 +445,7 @@ begin Exit; end; - // reset video playback engine, to play video clip... + // reset video playback engine, to play video clip ... fCurrentVideoPlaybackEngine.Close; fCurrentVideoPlaybackEngine := VideoPlayback; @@ -460,32 +455,32 @@ begin * + Blank : Nothing has been set, this is our fallback * + Picture : Picture has been set, and exists - otherwise we fallback * + Video : Video has been set, and exists - otherwise we fallback - * + Visualization: + Off : No Visialization - * + WhenNoVideo: Overwrites Blank and Picture - * + On : Overwrites Blank, Picture and Video + * + Visualization: + Off : No visualization + * + WhenNoVideo: Overwrites blank and picture + * + On : Overwrites blank, picture and video *} {* * set background to: video *} - VideoLoaded := False; - fShowVisualization := False; + VideoLoaded := false; + fShowVisualization := false; if (CurrentSong.Video <> '') and FileExists(CurrentSong.Path + CurrentSong.Video) then begin if (fCurrentVideoPlaybackEngine.Open(CurrentSong.Path + CurrentSong.Video)) then begin - fShowVisualization := False; + fShowVisualization := false; fCurrentVideoPlaybackEngine := VideoPlayback; fCurrentVideoPlaybackEngine.Position := CurrentSong.VideoGAP + CurrentSong.Start; fCurrentVideoPlaybackEngine.Play; - VideoLoaded := True; + VideoLoaded := true; end; end; {* * set background to: picture *} - if (CurrentSong.Background <> '') and (VideoLoaded = False) + if (CurrentSong.Background <> '') and (VideoLoaded = false) and (TVisualizerOption(Ini.VisualizerOption) = voOff) then try Tex_Background := Texture.LoadTexture(CurrentSong.Path + CurrentSong.Background); @@ -504,7 +499,7 @@ begin *} if (TVisualizerOption(Ini.VisualizerOption) in [voOn]) then begin - fShowVisualization := True; + fShowVisualization := true; fCurrentVideoPlaybackEngine := Visualization; if (fCurrentVideoPlaybackEngine <> nil) then fCurrentVideoPlaybackEngine.Play; @@ -514,9 +509,9 @@ begin * set background to: visualization (Videos are still shown) *} if ((TVisualizerOption(Ini.VisualizerOption) in [voWhenNoVideo]) and - (VideoLoaded = False)) then + (VideoLoaded = false)) then begin - fShowVisualization := True; + fShowVisualization := true; fCurrentVideoPlaybackEngine := Visualization; if (fCurrentVideoPlaybackEngine <> nil) then fCurrentVideoPlaybackEngine.Play; @@ -541,8 +536,24 @@ begin // prepare and start voice-capture AudioInput.CaptureStart; - for P := 0 to High(Player) do - ClearScores(P); + // clear the scores of all players + + for Index := 0 to High(Player) do + with Player[Index] do + begin + Score := 0; + ScoreLine := 0; + ScoreGolden := 0; + + ScoreInt := 0; + ScoreLineInt := 0; + ScoreGoldenInt := 0; + ScoreTotalInt := 0; + + ScoreLast := 0; + + LastSentencePerfect := false; + end; // main text Lyrics.Clear(CurrentSong.BPM[0].BPM, CurrentSong.Resolution); @@ -589,24 +600,24 @@ begin end; end; // case - // Initialize lyrics by filling its queue + // initialize lyrics by filling its queue while (not Lyrics.IsQueueFull) and (Lyrics.LineCounter <= High(Lines[0].Line)) do begin Lyrics.AddLine(@Lines[0].Line[Lyrics.LineCounter]); end; - // Deactivate pause - Paused := False; + // deactivate pause + Paused := false; - // Kill all stars not killed yet (GoldenStarsTwinkle Mod) + // kill all stars not killed yet (goldenstarstwinkle mod) GoldenRec.SentenceChange; - // set Position of Line Bonus - Line Bonus end - // set number of empty sentences for Line Bonus + // set position of line bonus - line bonus end + // set number of empty sentences for line bonus NumEmptySentences := 0; - for P := Low(Lines[0].Line) to High(Lines[0].Line) do - if Lines[0].Line[P].TotalNotes = 0 then + for Index := Low(Lines[0].Line) to High(Lines[0].Line) do + if Lines[0].Line[Index].TotalNotes = 0 then Inc(NumEmptySentences); Log.LogStatus('End', 'onShow'); @@ -626,7 +637,7 @@ end; procedure TScreenSing.onHide; begin - // Unload background texture + // background texture if (Tex_Background.TexNum > 0) then begin glDeleteTextures(1, PGLuint(@Tex_Background.TexNum)); @@ -643,10 +654,15 @@ var T: integer; CurLyricsTime: real; begin - Background.Draw; - // set player names (for 2 screens and only Singstar skin) + // draw background picture (if any, and if no visualizations) + // when we don't check for visualizations the visualizations would + // be overdrawn by the picture when {UNDEFINED UseTexture} in UVisualizer + if (not fShowVisualization) then + SingDrawBackground; + + // set player names (for 2 screens and only singstar skin) if ScreenAct = 1 then begin Text[TextP1].Text := 'P1'; @@ -674,7 +690,6 @@ begin end; // case end; // if - //// // dual screen, part 1 //////////////////////// @@ -683,29 +698,26 @@ begin // will move the statics and texts to the correct screen here. // FIXME: clean up this weird stuff. Commenting this stuff out, nothing // was missing on screen w/ 6 players - so do we even need this stuff? - Static[StaticP1].Texture.X := Static[StaticP1].Texture.X + 10 * ScreenX; + {Static[StaticP1].Texture.X := Static[StaticP1].Texture.X + 10 * ScreenX; - Text[TextP1].X := Text[TextP1].X + 10 * ScreenX; + Text[TextP1].X := Text[TextP1].X + 10 * ScreenX; } {Static[StaticP1ScoreBG].Texture.X := Static[StaticP1ScoreBG].Texture.X + 10*ScreenX; Text[TextP1Score].X := Text[TextP1Score].X + 10*ScreenX;} + {Static[StaticP2R].Texture.X := Static[StaticP2R].Texture.X + 10 * ScreenX; - Static[StaticP2R].Texture.X := Static[StaticP2R].Texture.X + 10 * ScreenX; - - Text[TextP2R].X := Text[TextP2R].X + 10 * ScreenX; + Text[TextP2R].X := Text[TextP2R].X + 10 * ScreenX; } {Static[StaticP2RScoreBG].Texture.X := Static[StaticP2RScoreBG].Texture.X + 10*ScreenX; Text[TextP2RScore].X := Text[TextP2RScore].X + 10*ScreenX;} // end of weird stuff + { + Static[1].Texture.X := Static[1].Texture.X + 10 * ScreenX; } - Static[1].Texture.X := Static[1].Texture.X + 10 * ScreenX; - - for T := 0 to 1 do - Text[T].X := Text[T].X + 10 * ScreenX; - - + { for T := 0 to 1 do + Text[T].X := Text[T].X + 10 * ScreenX; } // retrieve current lyrics time, we have to store the value to avoid // that min- and sec-values do not match @@ -726,15 +738,17 @@ begin // Note: there is no menu and the animated background brakes the video playback //DrawBG; - // Draw Background - SingDrawBackground; - // update and draw movie if (ShowFinish and (VideoLoaded or fShowVisualization)) then begin if assigned(fCurrentVideoPlaybackEngine) then begin - fCurrentVideoPlaybackEngine.GetFrame(LyricsState.GetCurrentTime()); + // Just call this once + // when Screens = 2 + If (ScreenAct = 1) then + fCurrentVideoPlaybackEngine.GetFrame(CurrentSong.VideoGAP + LyricsState.GetCurrentTime()); + + fCurrentVideoPlaybackEngine.DrawGL(ScreenAct); end; end; @@ -758,7 +772,7 @@ begin if (not FadeOut) then begin Finish; - FadeOut := True; + FadeOut := true; FadeTo(@ScreenScore); end; end; @@ -767,10 +781,10 @@ begin // always draw custom items SingDraw; - //GoldenNoteStarsTwinkle + // goldennotestarstwinkle GoldenRec.SpawnRec; - //Draw Scores + // draw scores Scores.Draw; //// @@ -781,30 +795,30 @@ begin // will move the statics and texts to the correct screen here. // FIXME: clean up this weird stuff - Static[StaticP1].Texture.X := Static[StaticP1].Texture.X - 10 * ScreenX; + {Static[StaticP1].Texture.X := Static[StaticP1].Texture.X - 10 * ScreenX; Text[TextP1].X := Text[TextP1].X - 10 * ScreenX; Static[StaticP2R].Texture.X := Static[StaticP2R].Texture.X - 10 * ScreenX; Text[TextP2R].X := Text[TextP2R].X - 10 * ScreenX; - //end of weird + // end of weird Static[1].Texture.X := Static[1].Texture.X - 10 * ScreenX; for T := 0 to 1 do - Text[T].X := Text[T].X - 10 * ScreenX; + Text[T].X := Text[T].X - 10 * ScreenX; } - // Draw Pausepopup - // FIXME: this is a workaround that the Static is drawn over the Lyrics, Lines, Scores and Effects + // draw pausepopup + // FIXME: this is a workaround that the static is drawn over the lyrics, lines, scores and effects // maybe someone could find a better solution if Paused then begin - Static[StaticPausePopup].Visible := True; + Static[StaticPausePopup].Visible := true; Static[StaticPausePopup].Draw; - Static[StaticPausePopup].Visible := False; + Static[StaticPausePopup].Visible := false; end; - Result := True; + Result := true; end; procedure TScreenSing.Finish; @@ -820,11 +834,11 @@ begin Visualization.Close; // to prevent drawing closed video - VideoLoaded := False; + VideoLoaded := false; - //Kill all Stars and Effects + // kill all stars and effects GoldenRec.KillAll; - + if (Ini.SavePlayback = 1) then begin Log.BenchmarkStart(0); @@ -835,7 +849,7 @@ begin Log.LogBenchmark('Creating files', 0); end; - SetFontItalic(False); + SetFontItalic(false); end; procedure TScreenSing.OnSentenceEnd(SentenceIndex: cardinal); @@ -874,14 +888,14 @@ begin CurrentPlayer := @Player[PlayerIndex]; CurrentScore := CurrentPlayer.Score + CurrentPlayer.ScoreGolden; - // Line Bonus + // line bonus // points for this line LineScore := CurrentScore - CurrentPlayer.ScoreLast; // determine LinePerfection // Note: the "+2" extra points are a little bonus so the player does not - // have to be that perfect to reach the bonus steps. + // have to be that perfect to reach the bonus steps. LinePerfection := (LineScore + 2) / MaxLineScore; // clamp LinePerfection to range [0..1] @@ -899,7 +913,7 @@ begin // apply line-bonus CurrentPlayer.ScoreLine := CurrentPlayer.ScoreLine + LineBonus * LinePerfection; - CurrentPlayer.ScoreLineInt := Round(CurrentPlayer.ScoreLine / 10) * 10; + CurrentPlayer.ScoreLineInt := Floor(CurrentPlayer.ScoreLine / 10) * 10; // update total score CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt + @@ -911,7 +925,7 @@ begin Scores.SpawnPopUp(PlayerIndex, Rating, CurrentPlayer.ScoreTotalInt); end; - // PerfectLineTwinkle (effect), Part 1 + // PerfectLineTwinkle (effect), part 1 if (Ini.EffectSing = 1) then CurrentPlayer.LastSentencePerfect := (LinePerfection >= 1); @@ -919,7 +933,7 @@ begin CurrentPlayer.ScoreLast := CurrentScore; end; - // PerfectLineTwinkle (effect), Part 2 + // PerfectLineTwinkle (effect), part 2 if (Ini.EffectSing = 1) then GoldenRec.SpawnPerfectLineTwinkle; end; @@ -928,14 +942,14 @@ end; // SentenceIndex: index of the new active sentence procedure TScreenSing.OnSentenceChange(SentenceIndex: cardinal); begin - //GoldenStarsTwinkle + // goldenstarstwinkle GoldenRec.SentenceChange; - // Fill lyrics queue and set upper line to the current sentence + // fill lyrics queue and set upper line to the current sentence while (Lyrics.GetUpperLineIndex() < SentenceIndex) or (not Lyrics.IsQueueFull) do begin - // Add the next line to the queue or a dummy if no more lines are available + // add the next line to the queue or a dummy if no more lines are available if (Lyrics.LineCounter <= High(Lines[0].Line)) then Lyrics.AddLine(@Lines[0].Line[Lyrics.LineCounter]) else diff --git a/unicode/src/screens/UScreenSingModi.pas b/unicode/src/screens/UScreenSingModi.pas index 5230d33a..b9c9365d 100644 --- a/unicode/src/screens/UScreenSingModi.pas +++ b/unicode/src/screens/UScreenSingModi.pas @@ -119,7 +119,19 @@ procedure PlaySound (const Index: Cardinal); stdcall; //Plays a Custom Sou function ToSentences(Const Lines: TLines): TSentences; implementation -uses UGraphic, UDraw, UMain, Classes, URecord, ULanguage, math, UDLLManager, USkins, UGraphicClasses; + +uses + Classes, + Math, + UDLLManager, + UDraw, + UGraphic, + UGraphicClasses, + ULanguage, + UNote, + UPath, + URecord, + USkins; // Method for input parsing. If False is returned, GetNextWindow // should be checked to know the next window to load; @@ -167,7 +179,6 @@ begin Result.Sentence[I].Start := Lines.Line[I].Start; Result.Sentence[I].StartNote := Lines.Line[I].Note[0].Start; Result.Sentence[I].Lyric := Lines.Line[I].Lyric; - Result.Sentence[I].LyricWidth := Lines.Line[I].LyricWidth; Result.Sentence[I].End_ := Lines.Line[I].End_; Result.Sentence[I].BaseNote := Lines.Line[I].BaseNote; Result.Sentence[I].HighNote := Lines.Line[I].HighNote; @@ -180,7 +191,7 @@ begin Result.Sentence[I].Note[J].Start := Lines.Line[I].Note[J].Start; Result.Sentence[I].Note[J].Length := Lines.Line[I].Note[J].Length; Result.Sentence[I].Note[J].Tone := Lines.Line[I].Note[J].Tone; - //Result.Sentence[I].Note[J].Text := Lines.Line[I].Note[J].Tekst; + //Result.Sentence[I].Note[J].Text := Lines.Line[I].Note[J].Text; Result.Sentence[I].Note[J].FreeStyle := (Lines.Line[I].Note[J].NoteType = ntFreestyle); end; end; @@ -299,7 +310,7 @@ function TScreenSingModi.Draw: boolean; var Min: integer; Sec: integer; - Tekst: string; + TextStr: string; S, I: integer; T: integer; CurLyricsTime: real; @@ -445,82 +456,82 @@ begin // .. and scores {if PlayersPlay = 1 then begin - Tekst := IntToStr(Player[0].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP1Score].Text := Tekst; + TextStr := IntToStr(Player[0].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP1Score].Text := TextStr; end; if PlayersPlay = 2 then begin - Tekst := IntToStr(Player[0].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP1TwoPScore].Text := Tekst; + TextStr := IntToStr(Player[0].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP1TwoPScore].Text := TextStr; - Tekst := IntToStr(Player[1].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP2RScore].Text := Tekst; + TextStr := IntToStr(Player[1].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP2RScore].Text := TextStr; end; if PlayersPlay = 3 then begin - Tekst := IntToStr(Player[0].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP1ThreePScore].Text := Tekst; + TextStr := IntToStr(Player[0].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP1ThreePScore].Text := TextStr; - Tekst := IntToStr(Player[1].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP2MScore].Text := Tekst; + TextStr := IntToStr(Player[1].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP2MScore].Text := TextStr; - Tekst := IntToStr(Player[2].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP3RScore].Text := Tekst; + TextStr := IntToStr(Player[2].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP3RScore].Text := TextStr; end; if PlayersPlay = 4 then begin if ScreenAct = 1 then begin - Tekst := IntToStr(Player[0].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP1TwoPScore].Text := Tekst; + TextStr := IntToStr(Player[0].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP1TwoPScore].Text := TextStr; - Tekst := IntToStr(Player[1].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP2RScore].Text := Tekst; + TextStr := IntToStr(Player[1].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP2RScore].Text := TextStr; end; if ScreenAct = 2 then begin - Tekst := IntToStr(Player[2].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP1TwoPScore].Text := Tekst; + TextStr := IntToStr(Player[2].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP1TwoPScore].Text := TextStr; - Tekst := IntToStr(Player[3].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP2RScore].Text := Tekst; + TextStr := IntToStr(Player[3].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP2RScore].Text := TextStr; end; end; if PlayersPlay = 6 then begin if ScreenAct = 1 then begin - Tekst := IntToStr(Player[0].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP1ThreePScore].Text := Tekst; + TextStr := IntToStr(Player[0].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP1ThreePScore].Text := TextStr; - Tekst := IntToStr(Player[1].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP2MScore].Text := Tekst; + TextStr := IntToStr(Player[1].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP2MScore].Text := TextStr; - Tekst := IntToStr(Player[2].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP3RScore].Text := Tekst; + TextStr := IntToStr(Player[2].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP3RScore].Text := TextStr; end; if ScreenAct = 2 then begin - Tekst := IntToStr(Player[3].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP1ThreePScore].Text := Tekst; + TextStr := IntToStr(Player[3].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP1ThreePScore].Text := TextStr; - Tekst := IntToStr(Player[4].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP2MScore].Text := Tekst; + TextStr := IntToStr(Player[4].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP2MScore].Text := TextStr; - Tekst := IntToStr(Player[5].ScoreTotalI); - while Length(Tekst) < 5 do Tekst := '0' + Tekst; - Text[TextP3RScore].Text := Tekst; + TextStr := IntToStr(Player[5].ScoreTotalI); + while Length(TextStr) < 5 do TextStr := '0' + TextStr; + Text[TextP3RScore].Text := TextStr; end; end; } @@ -553,9 +564,7 @@ begin if (DllMan.Selected.LoadSong) AND (DllMan.Selected.LoadBack) then SingDrawBackground; - // comment by blindy: wo zum henker wird denn in diesem screen ein video abgespielt? // update and draw movie - // <mog> wie wo wadd? also in der selben funktion in der uscreensing kommt des video in der zeile 995, oder was wollteste wissen? :X { if ShowFinish and CurrentSong.VideoLoaded AND DllMan.Selected.LoadVideo then begin UpdateSmpeg; // this only draws end;} @@ -688,7 +697,7 @@ begin SetFontStyle(Style and 7); // FIXME: FONTSIZE // used by Hold_The_Line / TeamDuell - SetFontSize(Size * 3); + SetFontSize(Size); SetFontPos (X, Y); glPrint (Language.Translate(String(Text))); end; diff --git a/unicode/src/screens/UScreenSong.pas b/unicode/src/screens/UScreenSong.pas index ac1ee194..da725a59 100644 --- a/unicode/src/screens/UScreenSong.pas +++ b/unicode/src/screens/UScreenSong.pas @@ -65,7 +65,7 @@ type TextNumber: integer; //Video Icon Mod - VideoIcon: Cardinal; + VideoIcon: cardinal; TextCat: integer; StaticCat: integer; @@ -88,28 +88,28 @@ type Mode: TSingMode; //party Statics (Joker) - StaticTeam1Joker1: Cardinal; - StaticTeam1Joker2: Cardinal; - StaticTeam1Joker3: Cardinal; - StaticTeam1Joker4: Cardinal; - StaticTeam1Joker5: Cardinal; - - StaticTeam2Joker1: Cardinal; - StaticTeam2Joker2: Cardinal; - StaticTeam2Joker3: Cardinal; - StaticTeam2Joker4: Cardinal; - StaticTeam2Joker5: Cardinal; - - StaticTeam3Joker1: Cardinal; - StaticTeam3Joker2: Cardinal; - StaticTeam3Joker3: Cardinal; - StaticTeam3Joker4: Cardinal; - StaticTeam3Joker5: Cardinal; - - StaticParty: array of Cardinal; - TextParty: array of Cardinal; - StaticNonParty: array of Cardinal; - TextNonParty: array of Cardinal; + StaticTeam1Joker1: cardinal; + StaticTeam1Joker2: cardinal; + StaticTeam1Joker3: cardinal; + StaticTeam1Joker4: cardinal; + StaticTeam1Joker5: cardinal; + + StaticTeam2Joker1: cardinal; + StaticTeam2Joker2: cardinal; + StaticTeam2Joker3: cardinal; + StaticTeam2Joker4: cardinal; + StaticTeam2Joker5: cardinal; + + StaticTeam3Joker1: cardinal; + StaticTeam3Joker2: cardinal; + StaticTeam3Joker3: cardinal; + StaticTeam3Joker4: cardinal; + StaticTeam3Joker5: cardinal; + + StaticParty: array of cardinal; + TextParty: array of cardinal; + StaticNonParty: array of cardinal; + TextNonParty: array of cardinal; constructor Create; override; @@ -120,18 +120,18 @@ type procedure SetScroll4; procedure SetScroll5; procedure SetScroll6; - function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override; + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; function Draw: boolean; override; procedure GenerateThumbnails(); procedure onShow; override; procedure onHide; override; procedure SelectNext; procedure SelectPrev; - procedure SkipTo(Target: Cardinal); + procedure SkipTo(Target: cardinal); procedure FixSelected; //Show Wrong Song when Tabs on Fix procedure FixSelected2; //Show Wrong Song when Tabs on Fix - procedure ShowCatTL(Cat: Integer);// Show Cat in Top left - procedure ShowCatTLCustom(Caption: String);// Show Custom Text in Top left + procedure ShowCatTL(Cat: integer);// Show Cat in Top left + procedure ShowCatTLCustom(Caption: string);// Show Custom Text in Top left procedure HideCatTL;// Show Cat in Tob left procedure Refresh; //Refresh Song Sorting procedure ChangeMusic; @@ -154,24 +154,26 @@ type implementation uses - UGraphic, - UMain, - UCovers, - math, + Math, gl, - USkins, + UCovers, UDLLManager, + UGraphic, + UMain, + UMenuButton, + UNote, UParty, UPlaylist, - UMenuButton, - UUnicodeUtils, - UScreenSongMenu; + UScreenSongMenu, + USkins, + UUnicodeUtils; // ***** Public methods ****** // //Show Wrong Song when Tabs on Fix procedure TScreenSong.FixSelected; -var I, I2: Integer; +var + I, I2: integer; begin if CatSongs.VisibleSongs > 0 then begin @@ -191,7 +193,8 @@ begin end; procedure TScreenSong.FixSelected2; -var I, I2: Integer; +var + I, I2: integer; begin if CatSongs.VisibleSongs > 0 then begin @@ -210,15 +213,15 @@ begin end; //Show Wrong Song when Tabs on Fix End -procedure TScreenSong.ShowCatTLCustom(Caption: String);// Show Custom Text in Top left +procedure TScreenSong.ShowCatTLCustom(Caption: string);// Show Custom Text in Top left begin Text[TextCat].Text := Caption; Text[TextCat].Visible := true; - Static[StaticCat].Visible := False; + Static[StaticCat].Visible := false; end; //Show Cat in Top Left Mod -procedure TScreenSong.ShowCatTL(Cat: Integer); +procedure TScreenSong.ShowCatTL(Cat: integer); begin //Change Text[TextCat].Text := CatSongs.Song[Cat].Artist; @@ -226,7 +229,7 @@ begin //Show Text[TextCat].Visible := true; - Static[StaticCat].Visible := True; + Static[StaticCat].Visible := true; end; procedure TScreenSong.HideCatTL; @@ -235,7 +238,7 @@ begin //Text[TextCat].Visible := false; Static[StaticCat].Visible := false; //New -> Show Text specified in Theme - Text[TextCat].Visible := True; + Text[TextCat].Visible := true; Text[TextCat].Text := Theme.Song.TextCat.Text; end; //Show Cat in Top Left Mod End @@ -243,7 +246,7 @@ end; // Method for input parsing. If False is returned, GetNextWindow // should be checked to know the next window to load; -function TScreenSong.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; +function TScreenSong.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; var I: integer; I2: integer; @@ -388,7 +391,7 @@ begin begin if (Songs.SongList.Count > 0) and (Mode = smNormal) then begin - ScreenSongJumpto.Visible := True; + ScreenSongJumpto.Visible := true; end; Exit; end; @@ -401,21 +404,22 @@ begin Ord('R'): begin - if (Songs.SongList.Count > 0) and (Mode = smNormal) then + if (Songs.SongList.Count > 0) and + (Mode = smNormal) then begin - if (SDL_ModState = KMOD_LSHIFT) and (Ini.Tabs_at_startup = 1) then //Random Category + if (SDL_ModState = KMOD_LSHIFT) and (Ini.TabsAtStartup = 1) then //Random Category begin I2 := 0; //Count Cats - for I:= low(CatSongs.Song) to high (CatSongs.Song) do + for I:= 0 to high(CatSongs.Song) do begin if CatSongs.Song[I].Main then Inc(I2); end; - I2 := Random (I2)+1; //Zufall + I2 := Random(I2)+1; //Zufall //Find Cat: - for I:= low(CatSongs.Song) to high (CatSongs.Song) do + for I:= 0 to high(CatSongs.Song) do begin if CatSongs.Song[I].Main then Dec(I2); @@ -434,14 +438,14 @@ begin end; end; end - else if (SDL_ModState = KMOD_LCTRL) and (Ini.Tabs_at_startup = 1) then //random in All Categorys + else if (SDL_ModState = KMOD_LCTRL) and (Ini.TabsAtStartup = 1) then //random in All Categorys begin repeat - I2 := Random(high(CatSongs.Song)+1) - low(CatSongs.Song)+1; - until CatSongs.Song[I2].Main = false; + I2 := Random(high(CatSongs.Song)+1) + 1; + until (not CatSongs.Song[I2].Main); //Search Cat - for I := I2 downto low(CatSongs.Song) do + for I := I2 downto 0 do begin if CatSongs.Song[I].Main then break; @@ -459,7 +463,8 @@ begin SelectNext; //Fix: Not Existing Song selected: - //if (I+1=I2) then Inc(I2); + //if (I+1=I2) then + Inc(I2); //Choose Song SkipTo(I2-I); @@ -485,20 +490,20 @@ begin if (Mode = smNormal) then begin //On Escape goto Cat-List Hack - if (Ini.Tabs_at_startup = 1) and (CatSongs.CatNumShow <> -1) then + if (Ini.TabsAtStartup = 1) and (CatSongs.CatNumShow <> -1) then begin //Find Category I := Interaction; - while not catsongs.Song[I].Main do - begin - Dec (I); - if (I < low(catsongs.Song)) then + while (not CatSongs.Song[I].Main) do + begin + Dec(I); + if (I < 0) then break; - end; - if (I<= 1) then - Interaction := high(catsongs.Song) + end; + if (I <= 1) then + Interaction := high(CatSongs.Song) else - Interaction := I - 1; + Interaction := I - 1; //Stop Music StopMusicPreview(); @@ -513,7 +518,7 @@ begin SelectNext; FixSelected; //SelectPrev; - //CatSongs.Song[0].Visible := False; + //CatSongs.Song[0].Visible := false; end else begin @@ -553,7 +558,7 @@ begin end; SDLK_RETURN: begin - if Songs.SongList.Count > 0 then + if (Songs.SongList.Count > 0) then begin if CatSongs.Song[Interaction].Main then begin // clicked on Category Button @@ -610,10 +615,11 @@ begin if (CatSongs.CatNumShow > -2) then begin //Cat Change Hack - if Ini.Tabs_at_startup = 1 then + if Ini.TabsAtStartup = 1 then begin I := Interaction; - if I <= 0 then I := 1; + if I <= 0 then + I := 1; while not catsongs.Song[I].Main do begin @@ -650,11 +656,12 @@ begin if (CatSongs.CatNumShow > -2) then begin //Cat Change Hack - if Ini.Tabs_at_startup = 1 then + if Ini.TabsAtStartup = 1 then begin I := Interaction; I2 := 0; - if I <= 0 then I := 1; + if I <= 0 then + I := 1; while not catsongs.Song[I].Main or (I2 = 0) do begin @@ -740,7 +747,7 @@ begin end; } end; end; - end; + end; // if (PressedDown) end; constructor TScreenSong.Create; @@ -816,7 +823,7 @@ end; procedure TScreenSong.GenerateThumbnails(); var - I: Integer; + I: integer; CoverButtonIndex: integer; CoverButton: TButton; CoverName: string; @@ -877,7 +884,7 @@ end; procedure TScreenSong.SetScroll; var - VS, B: Integer; + VS, B: integer; begin VS := CatSongs.VisibleSongs; if VS > 0 then @@ -901,7 +908,7 @@ begin // Set texts Text[TextArtist].Text := CatSongs.Song[Interaction].Artist; Text[TextTitle].Text := CatSongs.Song[Interaction].Title; - if (Ini.Tabs_at_startup = 1) and (CatSongs.CatNumShow = -1) then + if (Ini.TabsAtStartup = 1) and (CatSongs.CatNumShow = -1) then begin Text[TextNumber].Text := IntToStr(CatSongs.Song[Interaction].OrderNum) + '/' + IntToStr(CatSongs.CatCount); Text[TextTitle].Text := '(' + IntToStr(CatSongs.Song[Interaction].CatNumber) + ' ' + Language.Translate('SING_SONGS_IN_CAT') + ')'; @@ -910,7 +917,7 @@ begin Text[TextNumber].Text := IntToStr(CatSongs.VisibleIndex(Interaction)+1) + '/' + IntToStr(VS) else if (CatSongs.CatNumShow = -3) then Text[TextNumber].Text := IntToStr(CatSongs.VisibleIndex(Interaction)+1) + '/' + IntToStr(VS) - else if (Ini.Tabs_at_startup = 1) then + else if (Ini.TabsAtStartup = 1) then Text[TextNumber].Text := IntToStr(CatSongs.Song[Interaction].CatNumber) + '/' + IntToStr(CatSongs.Song[Interaction - CatSongs.Song[Interaction].CatNumber].CatNumber) else Text[TextNumber].Text := IntToStr(Interaction+1) + '/' + IntToStr(Length(CatSongs.Song)); @@ -921,7 +928,7 @@ begin Text[TextArtist].Text := ''; Text[TextTitle].Text := ''; for B := 0 to High(Button) do - Button[B].Visible := False; + Button[B].Visible := false; end; end; @@ -951,29 +958,37 @@ begin VisCount := 0; for B := 0 to High(Button) do - if CatSongs.Song[B].Visible then Inc(VisCount); + if CatSongs.Song[B].Visible then + Inc(VisCount); VisInt := 0; for B := 0 to Interaction-1 do - if CatSongs.Song[B].Visible then Inc(VisInt); + if CatSongs.Song[B].Visible then + Inc(VisInt); - if VisCount <= 6 then begin + if VisCount <= 6 then + begin Typ := 0; - end else begin - if VisInt <= 3 then begin + end + else + begin + if VisInt <= 3 then + begin Typ := 1; Count := 7; Ready := true; end; - if (VisCount - VisInt) <= 3 then begin + if (VisCount - VisInt) <= 3 then + begin Typ := 2; Count := 7; Ready := true; end; - if not Ready then begin + if not Ready then + begin Typ := 3; Src := Interaction; end; @@ -982,13 +997,15 @@ begin // hide all buttons - for B := 0 to High(Button) do begin + for B := 0 to High(Button) do + begin Button[B].Visible := false; Button[B].Selectable := CatSongs.Song[B].Visible; end; { - for B := Src to Dst do begin + for B := Src to Dst do + begin //Button[B].Visible := true; Button[B].Visible := CatSongs.Song[B].Visible; Button[B].Selectable := Button[B].Visible; @@ -997,9 +1014,12 @@ begin } - if Typ = 0 then begin - for B := 0 to High(Button) do begin - if CatSongs.Song[B].Visible then begin + if Typ = 0 then + begin + for B := 0 to High(Button) do + begin + if CatSongs.Song[B].Visible then + begin Button[B].Visible := true; Button[B].Y := 140 + (Placed) * 60; Inc(Placed); @@ -1007,10 +1027,13 @@ begin end; end; - if Typ = 1 then begin + if Typ = 1 then + begin B := 0; - while (Count > 0) do begin - if CatSongs.Song[B].Visible then begin + while (Count > 0) do + begin + if CatSongs.Song[B].Visible then + begin Button[B].Visible := true; Button[B].Y := 140 + (Placed) * 60; Inc(Placed); @@ -1020,10 +1043,13 @@ begin end; end; - if Typ = 2 then begin + if Typ = 2 then + begin B := High(Button); - while (Count > 0) do begin - if CatSongs.Song[B].Visible then begin + while (Count > 0) do + begin + if CatSongs.Song[B].Visible then + begin Button[B].Visible := true; Button[B].Y := 140 + (6-Placed) * 60; Inc(Placed); @@ -1033,11 +1059,14 @@ begin end; end; - if Typ = 3 then begin + if Typ = 3 then + begin B := Src; Count := 4; - while (Count > 0) do begin - if CatSongs.Song[B].Visible then begin + while (Count > 0) do + begin + if CatSongs.Song[B].Visible then + begin Button[B].Visible := true; Button[B].Y := 140 + (3+Placed) * 60; Inc(Placed); @@ -1049,8 +1078,10 @@ begin B := Src-1; Placed := 0; Count := 3; - while (Count > 0) do begin - if CatSongs.Song[B].Visible then begin + while (Count > 0) do + begin + if CatSongs.Song[B].Visible then + begin Button[B].Visible := true; Button[B].Y := 140 + (2-Placed) * 60; Inc(Placed); @@ -1068,14 +1099,15 @@ end; procedure TScreenSong.SetScroll2; var B: integer; - //Wsp: integer; // wspolczynnik przesuniecia wzgledem srodka ekranu - //Wsp2: real; + //Factor: integer; // factor of position relative to center of screen + //Factor2: real; begin - // liniowe + // line for B := 0 to High(Button) do Button[B].X := 300 + (B - Interaction) * 260; - if Length(Button) >= 3 then begin + if Length(Button) >= 3 then + begin if Interaction = 0 then Button[High(Button)].X := 300 - 260; @@ -1083,12 +1115,13 @@ begin Button[0].X := 300 + 260; end; - // kolowe + // circle { - for B := 0 to High(Button) do begin - Wsp := (B - Interaction); // 0 dla srodka, -1 dla lewego, +1 dla prawego itd. - Wsp2 := Wsp / Length(Button); - Button[B].X := 300 + 10000 * sin(2*pi*Wsp2); + for B := 0 to High(Button) do + begin + Factor := (B - Interaction); // 0 to center, -1: to left, +1 to right + Factor2 := Factor / Length(Button); + Button[B].X := 300 + 10000 * sin(2*pi*Factor2); //Button[B].Y := 140 + 50 * ; end; } @@ -1098,23 +1131,24 @@ end; procedure TScreenSong.SetScroll3; // with slide var B: integer; - //Wsp: integer; // wspolczynnik przesuniecia wzgledem srodka ekranu - //Wsp2: real; + //Factor: integer; // factor of position relative to center of screen + //Factor2: real; begin SongTarget := Interaction; - // liniowe + // line for B := 0 to High(Button) do begin Button[B].X := 300 + (B - SongCurrent) * 260; if (Button[B].X < -Button[B].W) or (Button[B].X > 800) then - Button[B].Visible := False + Button[B].Visible := false else - Button[B].Visible := True; + Button[B].Visible := true; end; { - if Length(Button) >= 3 then begin + if Length(Button) >= 3 then + begin if Interaction = 0 then Button[High(Button)].X := 300 - 260; @@ -1123,12 +1157,13 @@ begin end; } - // kolowe + // circle { - for B := 0 to High(Button) do begin - Wsp := (B - Interaction); // 0 dla srodka, -1 dla lewego, +1 dla prawego itd. - Wsp2 := Wsp / Length(Button); - Button[B].X := 300 + 10000 * sin(2*pi*Wsp2); + for B := 0 to High(Button) do + begin + Factor := (B - Interaction); // 0 to center, -1: to left, +1 to right + Factor2 := Factor / Length(Button); + Button[B].X := 300 + 10000 * sin(2*pi*Factor2); //Button[B].Y := 140 + 50 * ; end; } @@ -1182,10 +1217,10 @@ procedure TScreenSong.SetScroll5; var B: integer; Angle: real; - Pos: Real; + Pos: real; VS: integer; Padding: real; - X: Real; + X: real; { Theme.Song.CoverW: circle radius Theme.Song.CoverX: x-pos. of the left edge of the selected cover @@ -1257,37 +1292,38 @@ end; procedure TScreenSong.SetScroll6; // rotate (slotmachine style) var B: integer; - Angle: real; - Pos: Real; + Angle: real; + Pos: real; VS: integer; - diff: real; - X: Real; - Wsp: real; - Z, Z2: real; + diff: real; + X: real; + Factor: real; + Z, Z2: real; begin VS := CatSongs.VisibleSongs; if VS <= 5 then begin - // kolowe + // circle for B := 0 to High(Button) do begin - Button[B].Visible := CatSongs.Song[B].Visible; // nowe - if Button[B].Visible then begin // optimization for 1000 songs - updates only visible songs, hiding in tabs becomes useful for maintaing good speed + Button[B].Visible := CatSongs.Song[B].Visible; + if Button[B].Visible then // optimization for 1000 songs - updates only visible songs, hiding in tabs becomes useful for maintaing good speed + begin + + Factor := 2 * pi * (CatSongs.VisibleIndex(B) - SongCurrent) / VS {CatSongs.VisibleSongs};// 0.5.0 (II): takes another 16ms - Wsp := 2 * pi * (CatSongs.VisibleIndex(B) - SongCurrent) / VS {CatSongs.VisibleSongs};// 0.5.0 (II): takes another 16ms + Z := (1 + cos(Factor)) / 2; + Z2 := (1 + 2*Z) / 3; - Z := (1 + cos(Wsp)) / 2; - Z2 := (1 + 2*Z) / 3; + Button[B].Y := Theme.Song.Cover.Y + (0.185 * Theme.Song.Cover.H * VS * sin(Factor)) * Z2 - ((Button[B].H - Theme.Song.Cover.H)/2); // 0.5.0 (I): 2 times faster by not calling CatSongs.VisibleSongs + Button[B].Z := Z / 2 + 0.3; - Button[B].Y := Theme.Song.Cover.Y + (0.185 * Theme.Song.Cover.H * VS * sin(Wsp)) * Z2 - ((Button[B].H - Theme.Song.Cover.H)/2); // 0.5.0 (I): 2 times faster by not calling CatSongs.VisibleSongs - Button[B].Z := Z / 2 + 0.3; + Button[B].W := Theme.Song.Cover.H * Z2; - Button[B].W := Theme.Song.Cover.H * Z2; - - //Button[B].Y := {50 +} 140 + 50 - 50 * Z2; - Button[B].X := Theme.Song.Cover.X + (Theme.Song.Cover.H - Abs(Button[B].H)) * 0.7 ; - Button[B].H := Button[B].W; + //Button[B].Y := {50 +} 140 + 50 - 50 * Z2; + Button[B].X := Theme.Song.Cover.X + (Theme.Song.Cover.H - Abs(Button[B].H)) * 0.7 ; + Button[B].H := Button[B].W; end; end; end @@ -1295,10 +1331,10 @@ begin begin //Change Pos of all Buttons for B := low(Button) to high(Button) do - begin - Button[B].Visible := CatSongs.Song[B].Visible; //Adjust Visibility + begin + Button[B].Visible := CatSongs.Song[B].Visible; //Adjust Visibility if Button[B].Visible then //Only Change Pos for Visible Buttons - begin + begin Pos := (CatSongs.VisibleIndex(B) - SongCurrent); if (Pos < -VS/2) then Pos := Pos + VS @@ -1308,7 +1344,7 @@ begin if (Abs(Pos) < 2.5) then {fixed Positions} begin Angle := Pi * (Pos / 5); - //Button[B].Visible := False; + //Button[B].Visible := false; Button[B].H := Abs(Theme.Song.Cover.H * cos(Angle*0.8));//Power(Z2, 3); @@ -1331,8 +1367,10 @@ begin begin {Behind the Front Covers} // limit-bg-covers hack - if (abs(VS/2-abs(Pos))>10) then Button[B].Visible:=False; - if VS > 25 then VS:=25; + if (abs(VS/2-abs(Pos))>10) then + Button[B].Visible := false; + if VS > 25 then + VS:=25; // end of limit-bg-covers hack if Pos < 0 then @@ -1375,7 +1413,7 @@ begin if Ini.Players = 4 then PlayersPlay := 6; //Cat Mod etc - if (Ini.Tabs_at_startup = 1) and (CatSongs.CatNumShow = -1) then + if (Ini.TabsAtStartup = 1) and (CatSongs.CatNumShow = -1) then begin CatSongs.ShowCategoryList; FixSelected; @@ -1450,9 +1488,9 @@ end; function TScreenSong.Draw: boolean; var - dx: real; - dt: real; - I: Integer; + dx: real; + dt: real; + I: integer; begin dx := SongTarget-SongCurrent; dt := TimeSkip * 7; @@ -1463,7 +1501,8 @@ begin SongCurrent := SongCurrent + dx*dt; { - if SongCurrent > Catsongs.VisibleSongs then begin + if SongCurrent > Catsongs.VisibleSongs then + begin SongCurrent := SongCurrent - Catsongs.VisibleSongs; SongTarget := SongTarget - Catsongs.VisibleSongs; end; @@ -1529,8 +1568,8 @@ end; procedure TScreenSong.SelectNext; var - Skip: integer; - VS: Integer; + Skip: integer; + VS: integer; begin VS := CatSongs.VisibleSongs; @@ -1549,22 +1588,23 @@ begin Interaction := (Interaction + Skip) mod Length(Interactions); // try to keep all at the beginning - if SongTarget > VS-1 then begin + if SongTarget > VS-1 then + begin SongTarget := SongTarget - VS; SongCurrent := SongCurrent - VS; end; end; - // Interaction -> Button, ktorego okladke przeczytamy + // Interaction -> Button, load cover // show uncached texture //Button[Interaction].Texture := Texture.GetTexture(Button[Interaction].Texture.Name, TEXTURE_TYPE_PLAIN, false); end; procedure TScreenSong.SelectPrev; var - Skip: integer; - VS: Integer; + Skip: integer; + VS: integer; begin VS := CatSongs.VisibleSongs; @@ -1574,13 +1614,15 @@ begin Skip := 1; - while (not CatSongs.Song[(Interaction - Skip + Length(Interactions)) mod Length(Interactions)].Visible) do Inc(Skip); + while (not CatSongs.Song[(Interaction - Skip + Length(Interactions)) mod Length(Interactions)].Visible) do + Inc(Skip); SongTarget := SongTarget - 1;//Skip; Interaction := (Interaction - Skip + Length(Interactions)) mod Length(Interactions); // try to keep all at the beginning - if SongTarget < 0 then begin + if SongTarget < 0 then + begin SongTarget := SongTarget + CatSongs.VisibleSongs; SongCurrent := SongCurrent + CatSongs.VisibleSongs; end; @@ -1660,9 +1702,9 @@ begin end; end; -procedure TScreenSong.SkipTo(Target: Cardinal); +procedure TScreenSong.SkipTo(Target: cardinal); var - i: integer; + i: integer; begin UnLoadDetailedCover; @@ -1677,13 +1719,13 @@ end; procedure TScreenSong.SelectRandomSong; var - I, I2: Integer; + I, I2: integer; begin case PlaylistMan.Mode of smNormal: //All Songs Just Select Random Song begin //When Tabs are activated then use Tab Method - if (Ini.Tabs_at_startup = 1) then + if (Ini.TabsAtStartup = 1) then begin repeat I2 := Random(high(CatSongs.Song)+1) - low(CatSongs.Song)+1; @@ -1756,11 +1798,11 @@ begin end else begin - Static[StaticTeam1Joker1].Visible := False; - Static[StaticTeam1Joker2].Visible := False; - Static[StaticTeam1Joker3].Visible := False; - Static[StaticTeam1Joker4].Visible := False; - Static[StaticTeam1Joker5].Visible := False; + Static[StaticTeam1Joker1].Visible := false; + Static[StaticTeam1Joker2].Visible := false; + Static[StaticTeam1Joker3].Visible := false; + Static[StaticTeam1Joker4].Visible := false; + Static[StaticTeam1Joker5].Visible := false; end; if (PartySession.Teams.NumTeams >= 2) then @@ -1773,11 +1815,11 @@ begin end else begin - Static[StaticTeam2Joker1].Visible := False; - Static[StaticTeam2Joker2].Visible := False; - Static[StaticTeam2Joker3].Visible := False; - Static[StaticTeam2Joker4].Visible := False; - Static[StaticTeam2Joker5].Visible := False; + Static[StaticTeam2Joker1].Visible := false; + Static[StaticTeam2Joker2].Visible := false; + Static[StaticTeam2Joker3].Visible := false; + Static[StaticTeam2Joker4].Visible := false; + Static[StaticTeam2Joker5].Visible := false; end; if (PartySession.Teams.NumTeams >= 3) then @@ -1790,40 +1832,40 @@ begin end else begin - Static[StaticTeam3Joker1].Visible := False; - Static[StaticTeam3Joker2].Visible := False; - Static[StaticTeam3Joker3].Visible := False; - Static[StaticTeam3Joker4].Visible := False; - Static[StaticTeam3Joker5].Visible := False; + Static[StaticTeam3Joker1].Visible := false; + Static[StaticTeam3Joker2].Visible := false; + Static[StaticTeam3Joker3].Visible := false; + Static[StaticTeam3Joker4].Visible := false; + Static[StaticTeam3Joker5].Visible := false; end; *) end else begin //Hide all - Static[StaticTeam1Joker1].Visible := False; - Static[StaticTeam1Joker2].Visible := False; - Static[StaticTeam1Joker3].Visible := False; - Static[StaticTeam1Joker4].Visible := False; - Static[StaticTeam1Joker5].Visible := False; - - Static[StaticTeam2Joker1].Visible := False; - Static[StaticTeam2Joker2].Visible := False; - Static[StaticTeam2Joker3].Visible := False; - Static[StaticTeam2Joker4].Visible := False; - Static[StaticTeam2Joker5].Visible := False; - - Static[StaticTeam3Joker1].Visible := False; - Static[StaticTeam3Joker2].Visible := False; - Static[StaticTeam3Joker3].Visible := False; - Static[StaticTeam3Joker4].Visible := False; - Static[StaticTeam3Joker5].Visible := False; + Static[StaticTeam1Joker1].Visible := false; + Static[StaticTeam1Joker2].Visible := false; + Static[StaticTeam1Joker3].Visible := false; + Static[StaticTeam1Joker4].Visible := false; + Static[StaticTeam1Joker5].Visible := false; + + Static[StaticTeam2Joker1].Visible := false; + Static[StaticTeam2Joker2].Visible := false; + Static[StaticTeam2Joker3].Visible := false; + Static[StaticTeam2Joker4].Visible := false; + Static[StaticTeam2Joker5].Visible := false; + + Static[StaticTeam3Joker1].Visible := false; + Static[StaticTeam3Joker2].Visible := false; + Static[StaticTeam3Joker3].Visible := false; + Static[StaticTeam3Joker4].Visible := false; + Static[StaticTeam3Joker5].Visible := false; end; end; procedure TScreenSong.SetStatics; var - I: Integer; - Visible: Boolean; + I: integer; + Visible: boolean; begin //Set Visibility of Party Statics and Text Visible := (Mode = smPartyMode); @@ -1867,7 +1909,7 @@ begin CatSongs.Selected := Interaction; StopMusicPreview(); - ScreenName.Goto_SingScreen := True; + ScreenName.Goto_SingScreen := true; FadeTo(@ScreenName); end; diff --git a/unicode/src/screens/UScreenSongMenu.pas b/unicode/src/screens/UScreenSongMenu.pas index 8098548c..b8720b86 100644 --- a/unicode/src/screens/UScreenSongMenu.pas +++ b/unicode/src/screens/UScreenSongMenu.pas @@ -45,38 +45,36 @@ uses type TScreenSongMenu = class(TMenu) private - CurMenu: Byte; //Num of the cur. Shown Menu + CurMenu: byte; // num of the cur. shown menu public - Visible: Boolean; //Whether the Menu should be Drawn + Visible: boolean; // whether the menu should be drawn constructor Create; override; - function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override; + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; procedure onShow; override; function Draw: boolean; override; - procedure MenuShow(sMenu: Byte); + procedure MenuShow(sMenu: byte); procedure HandleReturn; end; const SM_Main = 1; - - SM_PlayList = 64 or 1; - SM_Playlist_Add = 64 or 2; - SM_Playlist_New = 64 or 3; - SM_Playlist_DelItem = 64 or 5; + SM_PlayList = 64 or 1; + SM_Playlist_Add = 64 or 2; + SM_Playlist_New = 64 or 3; - SM_Playlist_Load = 64 or 8 or 1; - SM_Playlist_Del = 64 or 8 or 5; + SM_Playlist_DelItem = 64 or 5; + SM_Playlist_Load = 64 or 8 or 1; + SM_Playlist_Del = 64 or 8 or 5; - SM_Party_Main = 128 or 1; - SM_Party_Joker = 128 or 2; + SM_Party_Main = 128 or 1; + SM_Party_Joker = 128 or 2; var - ISelections: Array of string; - SelectValue: Integer; - + ISelections: array of string; + SelectValue: integer; implementation @@ -91,12 +89,12 @@ uses USongs, UUnicodeUtils; -function TScreenSongMenu.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; +function TScreenSongMenu.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; begin Result := true; if (PressedDown) then - begin // Key Down - if (CurMenu = SM_Playlist_New) AND (Interaction=0) then + begin // key down + if (CurMenu = SM_Playlist_New) and (Interaction=0) then begin // check normal keys if IsAlphaNumericChar(CharCode) or @@ -131,10 +129,10 @@ begin // check special keys case PressedKey of SDLK_ESCAPE, - SDLK_BACKSPACE : + SDLK_BACKSPACE: begin AudioPlayback.PlaySound(SoundLib.Back); - Visible := False; + Visible := false; end; SDLK_RETURN: @@ -142,8 +140,8 @@ begin HandleReturn; end; - SDLK_DOWN: InteractNext; - SDLK_UP: InteractPrev; + SDLK_DOWN: InteractNext; + SDLK_UP: InteractPrev; SDLK_RIGHT: begin @@ -157,8 +155,8 @@ begin end; SDLK_1: - begin //Jocker - //Use Joker + begin // jocker + // use joker case CurMenu of SM_Party_Main: begin @@ -167,8 +165,8 @@ begin end; end; SDLK_2: - begin //Jocker - //Use Joker + begin // jocker + // use joker case CurMenu of SM_Party_Main: begin @@ -177,8 +175,8 @@ begin end; end; SDLK_3: - begin //Jocker - //Use Joker + begin // jocker + // use joker case CurMenu of SM_Party_Main: begin @@ -193,12 +191,12 @@ end; constructor TScreenSongMenu.Create; begin inherited Create; - - //Create Dummy SelectSlide Entrys + + // create dummy selectslide entrys SetLength(ISelections, 1); ISelections[0] := 'Dummy'; - + AddText(Theme.SongMenu.TextMenu); LoadFromTheme(Theme.SongMenu); @@ -221,7 +219,6 @@ begin if (Length(Button[3].Text) = 0) then AddButtonText(14, 20, 'Button 4'); - Interaction := 0; end; @@ -233,24 +230,23 @@ end; procedure TScreenSongMenu.onShow; begin inherited; - end; -procedure TScreenSongMenu.MenuShow(sMenu: Byte); +procedure TScreenSongMenu.MenuShow(sMenu: byte); begin - Interaction := 0; //Reset Interaction - Visible := True; //Set Visible - Case sMenu of + Interaction := 0; // reset interaction + Visible := true; // set visible + case sMenu of SM_Main: begin CurMenu := sMenu; Text[0].Text := Language.Translate('SONG_MENU_NAME_MAIN'); - Button[0].Visible := True; - Button[1].Visible := True; - Button[2].Visible := True; - Button[3].Visible := True; - SelectsS[0].Visible := False; + Button[0].Visible := true; + Button[1].Visible := true; + Button[2].Visible := true; + Button[3].Visible := true; + SelectsS[0].Visible := false; Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAY'); Button[1].Text[0].Text := Language.Translate('SONG_MENU_CHANGEPLAYERS'); @@ -263,11 +259,11 @@ begin CurMenu := sMenu; Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST'); - Button[0].Visible := True; - Button[1].Visible := True; - Button[2].Visible := True; - Button[3].Visible := True; - SelectsS[0].Visible := False; + Button[0].Visible := true; + Button[1].Visible := true; + Button[2].Visible := true; + Button[3].Visible := true; + SelectsS[0].Visible := false; Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAY'); Button[1].Text[0].Text := Language.Translate('SONG_MENU_CHANGEPLAYERS'); @@ -280,11 +276,11 @@ begin CurMenu := sMenu; Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST_ADD'); - Button[0].Visible := True; - Button[1].Visible := False; - Button[2].Visible := False; - Button[3].Visible := True; - SelectsS[0].Visible := True; + Button[0].Visible := true; + Button[1].Visible := false; + Button[2].Visible := false; + Button[3].Visible := true; + SelectsS[0].Visible := true; Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_ADD_NEW'); Button[3].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_ADD_EXISTING'); @@ -298,9 +294,9 @@ begin end else begin - Button[3].Visible := False; - SelectsS[0].Visible := False; - Button[2].Visible := True; + Button[3].Visible := false; + SelectsS[0].Visible := false; + Button[2].Visible := true; Button[2].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_NOEXISTING'); end; end; @@ -310,11 +306,11 @@ begin CurMenu := sMenu; Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST_NEW'); - Button[0].Visible := True; - Button[1].Visible := False; - Button[2].Visible := True; - Button[3].Visible := True; - SelectsS[0].Visible := False; + Button[0].Visible := true; + Button[1].Visible := false; + Button[2].Visible := true; + Button[3].Visible := true; + SelectsS[0].Visible := false; Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_NEW_UNNAMED'); Button[2].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_NEW_CREATE'); @@ -326,11 +322,11 @@ begin CurMenu := sMenu; Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST_DELITEM'); - Button[0].Visible := True; - Button[1].Visible := False; - Button[2].Visible := False; - Button[3].Visible := True; - SelectsS[0].Visible := False; + Button[0].Visible := true; + Button[1].Visible := false; + Button[2].Visible := false; + Button[3].Visible := true; + SelectsS[0].Visible := false; Button[0].Text[0].Text := Language.Translate('SONG_MENU_YES'); Button[3].Text[0].Text := Language.Translate('SONG_MENU_CANCEL'); @@ -341,13 +337,13 @@ begin CurMenu := sMenu; Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST_LOAD'); - //Show Delete Curent Playlist Button when Playlist is opened + // show delete curent playlist button when playlist is opened Button[0].Visible := (CatSongs.CatNumShow = -3); - Button[1].Visible := False; - Button[2].Visible := False; - Button[3].Visible := True; - SelectsS[0].Visible := True; + Button[1].Visible := false; + Button[2].Visible := false; + Button[3].Visible := true; + SelectsS[0].Visible := true; Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_DELCURRENT'); Button[3].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_LOAD'); @@ -362,9 +358,9 @@ begin end else begin - Button[3].Visible := False; - SelectsS[0].Visible := False; - Button[2].Visible := True; + Button[3].Visible := false; + SelectsS[0].Visible := false; + Button[2].Visible := true; Button[2].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_NOEXISTING'); Interaction := 2; end; @@ -375,27 +371,26 @@ begin CurMenu := sMenu; Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST_DEL'); - Button[0].Visible := True; - Button[1].Visible := False; - Button[2].Visible := False; - Button[3].Visible := True; - SelectsS[0].Visible := False; + Button[0].Visible := true; + Button[1].Visible := false; + Button[2].Visible := false; + Button[3].Visible := true; + SelectsS[0].Visible := false; Button[0].Text[0].Text := Language.Translate('SONG_MENU_YES'); Button[3].Text[0].Text := Language.Translate('SONG_MENU_CANCEL'); end; - SM_Party_Main: begin CurMenu := sMenu; Text[0].Text := Language.Translate('SONG_MENU_NAME_PARTY_MAIN'); - Button[0].Visible := True; - Button[1].Visible := False; - Button[2].Visible := False; - Button[3].Visible := True; - SelectsS[0].Visible := False; + Button[0].Visible := true; + Button[1].Visible := false; + Button[2].Visible := false; + Button[3].Visible := true; + SelectsS[0].Visible := false; Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAY'); //Button[1].Text[0].Text := Language.Translate('SONG_MENU_JOKER'); @@ -408,172 +403,175 @@ begin CurMenu := sMenu; Text[0].Text := Language.Translate('SONG_MENU_NAME_PARTY_JOKER'); // to-do : Party - {Button[0].Visible := (PartySession.Teams.NumTeams >= 1) AND (PartySession.Teams.Teaminfo[0].Joker > 0); - Button[1].Visible := (PartySession.Teams.NumTeams >= 2) AND (PartySession.Teams.Teaminfo[1].Joker > 0); - Button[2].Visible := (PartySession.Teams.NumTeams >= 3) AND (PartySession.Teams.Teaminfo[2].Joker > 0);} - Button[3].Visible := True; - SelectsS[0].Visible := False; - - {Button[0].Text[0].Text := String(PartySession.Teams.Teaminfo[0].Name); +{ + Button[0].Visible := (PartySession.Teams.NumTeams >= 1) and (PartySession.Teams.Teaminfo[0].Joker > 0); + Button[1].Visible := (PartySession.Teams.NumTeams >= 2) and (PartySession.Teams.Teaminfo[1].Joker > 0); + Button[2].Visible := (PartySession.Teams.NumTeams >= 3) and (PartySession.Teams.Teaminfo[2].Joker > 0); +} + Button[3].Visible := true; + SelectsS[0].Visible := false; +{ + Button[0].Text[0].Text := String(PartySession.Teams.Teaminfo[0].Name); Button[1].Text[0].Text := String(PartySession.Teams.Teaminfo[1].Name); - Button[2].Text[0].Text := String(PartySession.Teams.Teaminfo[2].Name);} + Button[2].Text[0].Text := String(PartySession.Teams.Teaminfo[2].Name); +} Button[3].Text[0].Text := Language.Translate('SONG_MENU_CANCEL'); - //Set right Interaction + // set right interaction if (not Button[0].Visible) then begin if (not Button[1].Visible) then begin if (not Button[2].Visible) then - begin - Interaction := 4; - end - else Interaction := 2; + Interaction := 4 + else + Interaction := 2; end - else Interaction := 1; + else + Interaction := 1; end; - + end; end; end; procedure TScreenSongMenu.HandleReturn; begin - Case CurMenu of + case CurMenu of SM_Main: begin - Case Interaction of - 0: //Button 1 + case Interaction of + 0: // button 1 begin ScreenSong.StartSong; - Visible := False; + Visible := false; end; - 1: //Button 2 + 1: // button 2 begin - //Select New Players then Sing: + // select new players then sing: ScreenSong.SelectPlayers; - Visible := False; + Visible := false; end; - 2: //Button 3 + 2: // button 3 begin - //Show add to Playlist Menu + // show add to playlist menu MenuShow(SM_Playlist_Add); end; - 3: //SelectSlide 3 + 3: // selectslide 3 begin //Dummy end; - 4: //Button 4 + 4: // button 4 begin ScreenSong.OpenEditor; - Visible := False; + Visible := false; end; end; end; SM_PlayList: begin - Visible := False; - Case Interaction of - 0: //Button 1 + Visible := false; + case Interaction of + 0: // button 1 begin ScreenSong.StartSong; - Visible := False; + Visible := false; end; - 1: //Button 2 + 1: // button 2 begin - //Select New Players then Sing: + // select new players then sing: ScreenSong.SelectPlayers; - Visible := False; + Visible := false; end; - 2: //Button 3 + 2: // button 3 begin - //Show add to Playlist Menu + // show add to playlist menu MenuShow(SM_Playlist_DelItem); end; - 3: //SelectSlide 3 + 3: // selectslide 3 begin - //Dummy + // dummy end; - 4: //Button 4 + 4: // button 4 begin ScreenSong.OpenEditor; - Visible := False; + Visible := false; end; end; end; SM_Playlist_Add: begin - Case Interaction of - 0: //Button 1 + case Interaction of + 0: // button 1 begin MenuShow(SM_Playlist_New); end; - 3: //SelectSlide 3 + 3: // selectslide 3 begin - //Dummy + // dummy end; - 4: //Button 4 + 4: // button 4 begin PlaylistMan.AddItem(ScreenSong.Interaction, SelectValue); - Visible := False; + Visible := false; end; end; end; SM_Playlist_New: begin - Case Interaction of - 0: //Button 1 + case Interaction of + 0: // button 1 begin - //Nothing, Button for Entering Name + // nothing, button for entering name end; - 2: //Button 3 + 2: // button 3 begin - //Create Playlist and Add Song + // create playlist and add song PlaylistMan.AddItem( ScreenSong.Interaction, PlaylistMan.AddPlaylist(Button[0].Text[0].Text)); - Visible := False; + Visible := false; end; - 3: //SelectSlide 3 + 3: // selectslide 3 begin - //Cancel -> Go back to Add screen + // cancel -> go back to add screen MenuShow(SM_Playlist_Add); end; - 4: //Button 4 + 4: // button 4 begin - Visible := False; + Visible := false; end; end; end; SM_Playlist_DelItem: begin - Visible := False; - Case Interaction of - 0: //Button 1 + Visible := false; + case Interaction of + 0: // button 1 begin - //Delete + // delete PlayListMan.DelItem(PlayListMan.GetIndexbySongID(ScreenSong.Interaction)); - Visible := False; + Visible := false; end; - 4: //Button 4 + 4: // button 4 begin MenuShow(SM_Playlist); end; @@ -582,32 +580,32 @@ begin SM_Playlist_Load: begin - Case Interaction of - 0: //Button 1 (Delete Playlist) + case Interaction of + 0: // button 1 (Delete playlist) begin MenuShow(SM_Playlist_Del); end; - 4: //Button 4 + 4: // button 4 begin - //Load Playlist + // load playlist PlaylistMan.SetPlayList(SelectValue); - Visible := False; + Visible := false; end; end; end; SM_Playlist_Del: begin - Visible := False; - Case Interaction of - 0: //Button 1 + Visible := false; + case Interaction of + 0: // button 1 begin - //Delete + // delete PlayListMan.DelPlaylist(PlaylistMan.CurPlayList); - Visible := False; + Visible := false; end; - 4: //Button 4 + 4: // button 4 begin MenuShow(SM_Playlist_Load); end; @@ -616,17 +614,17 @@ begin SM_Party_Main: begin - Case Interaction of - 0: //Button 1 + case Interaction of + 0: // button 1 begin - //Start Singing + // start singing ScreenSong.StartSong; - Visible := False; + Visible := false; end; - 4: //Button 4 + 4: // button 4 begin - //Joker + // joker MenuShow(SM_Party_Joker); end; end; @@ -634,29 +632,29 @@ begin SM_Party_Joker: begin - Visible := False; - Case Interaction of - 0: //Button 1 + Visible := false; + case Interaction of + 0: // button 1 begin - //Joker Team 1 + // joker team 1 ScreenSong.DoJoker(0); end; - 1: //Button 2 + 1: // button 2 begin - //Joker Team 2 + // joker team 2 ScreenSong.DoJoker(1); end; - 2: //Button 3 + 2: // button 3 begin - //Joker Team 3 + // joker team 3 ScreenSong.DoJoker(2); end; - 4: //Button 4 + 4: // button 4 begin - //Cancel... (Fo back to old Menu) + // cancel... (go back to old menu) MenuShow(SM_Party_Main); end; end; @@ -665,4 +663,3 @@ begin end; end. - diff --git a/unicode/src/screens/UScreenTop5.pas b/unicode/src/screens/UScreenTop5.pas index ba990dc6..eaa90ab1 100644 --- a/unicode/src/screens/UScreenTop5.pas +++ b/unicode/src/screens/UScreenTop5.pas @@ -34,10 +34,10 @@ interface {$I switches.inc} uses - SDL, SysUtils, - UMenu, + SDL, UDisplay, + UMenu, UMusic, USongs, UThemes; @@ -45,17 +45,18 @@ uses type TScreenTop5 = class(TMenu) public - TextLevel: integer; - TextArtistTitle: integer; + TextLevel: integer; + TextArtistTitle: integer; - StaticNumber: array[1..5] of integer; - TextNumber: array[1..5] of integer; - TextName: array[1..5] of integer; - TextScore: array[1..5] of integer; + StaticNumber: array[1..5] of integer; + TextNumber: array[1..5] of integer; + TextName: array[1..5] of integer; + TextScore: array[1..5] of integer; + + Fadeout: boolean; - Fadeout: boolean; constructor Create; override; - function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override; + function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override; procedure onShow; override; function Draw: boolean; override; end; @@ -63,16 +64,18 @@ type implementation uses - UGraphic, UDataBase, + UGraphic, UMain, UIni, + UNote, UUnicodeUtils; -function TScreenTop5.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; +function TScreenTop5.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; begin Result := true; - If (PressedDown) Then begin + if (PressedDown) then + begin // check normal keys case UCS4UpperCase(CharCode) of Ord('Q'): @@ -81,14 +84,15 @@ begin Exit; end; end; - + // check special keys case PressedKey of SDLK_ESCAPE, SDLK_BACKSPACE, SDLK_RETURN: begin - if (not Fadeout) then begin + if (not Fadeout) then + begin FadeTo(@ScreenSong); Fadeout := true; end; @@ -103,7 +107,7 @@ end; constructor TScreenTop5.Create; var - I: integer; + I: integer; begin inherited Create; @@ -127,8 +131,8 @@ end; procedure TScreenTop5.onShow; var - I: integer; - PMax: integer; + I: integer; + PMax: integer; begin inherited; @@ -147,7 +151,8 @@ begin Text[TextArtistTitle].Text := CurrentSong.Artist + ' - ' + CurrentSong.Title; - for I := 1 to Length(CurrentSong.Score[Ini.Difficulty]) do begin + for I := 1 to Length(CurrentSong.Score[Ini.Difficulty]) do + begin Static[StaticNumber[I]].Visible := true; Text[TextNumber[I]].Visible := true; Text[TextName[I]].Visible := true; @@ -157,7 +162,8 @@ begin Text[TextScore[I]].Text := IntToStr(CurrentSong.Score[Ini.Difficulty, I-1].Score); end; - for I := Length(CurrentSong.Score[Ini.Difficulty])+1 to 5 do begin + for I := Length(CurrentSong.Score[Ini.Difficulty])+1 to 5 do + begin Static[StaticNumber[I]].Visible := false; Text[TextNumber[I]].Visible := false; Text[TextName[I]].Visible := false; @@ -169,25 +175,30 @@ end; function TScreenTop5.Draw: boolean; //var -{ Min: real; - Max: real; - Wsp: real; - Wsp2: real; - Pet: integer;} - -{ Item: integer; - P: integer; - C: integer;} +{ + Min: real; + Max: real; + Factor: real; + Factor2: real; + + Item: integer; + P: integer; + C: integer; +} begin // Singstar - let it be...... with 6 statics -(* if PlayersPlay = 6 then begin - for Item := 4 to 6 do begin +(* + if PlayersPlay = 6 then + begin + for Item := 4 to 6 do + begin if ScreenAct = 1 then P := Item-4; if ScreenAct = 2 then P := Item-1; FillPlayer(Item, P); - -{ if ScreenAct = 1 then begin +{ + if ScreenAct = 1 then + begin LoadColor( Static[StaticBoxLightest[Item]].Texture.ColR, Static[StaticBoxLightest[Item]].Texture.ColG, @@ -195,16 +206,18 @@ begin 'P1Dark'); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin LoadColor( Static[StaticBoxLightest[Item]].Texture.ColR, Static[StaticBoxLightest[Item]].Texture.ColG, Static[StaticBoxLightest[Item]].Texture.ColB, 'P4Dark'); - end; } - + end; +} end; - end; *) + end; +*) Result := inherited Draw; end; diff --git a/unicode/src/screens/UScreenWelcome.pas b/unicode/src/screens/UScreenWelcome.pas index ead30c10..4df2b6f7 100644 --- a/unicode/src/screens/UScreenWelcome.pas +++ b/unicode/src/screens/UScreenWelcome.pas @@ -94,8 +94,8 @@ function TScreenWelcome.Draw: boolean; var Min: real; Max: real; - Wsp: real; - Pet: integer; + Factor: real; + Count: integer; begin // star animation Animation := Animation + TimeSkip*1000; @@ -108,34 +108,34 @@ begin // popup Min := 1000; Max := 1120; if (Animation >= Min) and (Animation < Max) then begin - Wsp := (Animation - Min) / (Max - Min); + Factor := (Animation - Min) / (Max - Min); Static[0].Texture.X := 600; - Static[0].Texture.Y := 600 - Wsp * 230; + Static[0].Texture.Y := 600 - Factor * 230; Static[0].Texture.W := 200; - Static[0].Texture.H := Wsp * 230; + Static[0].Texture.H := Factor * 230; end; // bounce Min := 1120; Max := 1200; if (Animation >= Min) and (Animation < Max) then begin - Wsp := (Animation - Min) / (Max - Min); - Static[0].Texture.Y := 370 + Wsp * 50; - Static[0].Texture.H := 230 - Wsp * 50; + Factor := (Animation - Min) / (Max - Min); + Static[0].Texture.Y := 370 + Factor * 50; + Static[0].Texture.H := 230 - Factor * 50; end; // run Min := 1500; Max := 3500; if (Animation >= Min) and (Animation < Max) then begin - Wsp := (Animation - Min) / (Max - Min); + Factor := (Animation - Min) / (Max - Min); - Static[0].Texture.X := 600 - Wsp * 1400; + Static[0].Texture.X := 600 - Factor * 1400; Static[0].Texture.H := 180; - for Pet := 1 to 5 do begin - Static[Pet].Texture.X := 770 - Wsp * 1400; - Static[Pet].Texture.W := 150 + Wsp * 200; - Static[Pet].Texture.Alpha := Wsp * 0.5; + for Count := 1 to 5 do begin + Static[Count].Texture.X := 770 - Factor * 1400; + Static[Count].Texture.W := 150 + Factor * 200; + Static[Count].Texture.Alpha := Factor * 0.5; end; end; diff --git a/unicode/src/ultrastardx.dpr b/unicode/src/ultrastardx.dpr index d4664cfc..f48e9ada 100644 --- a/unicode/src/ultrastardx.dpr +++ b/unicode/src/ultrastardx.dpr @@ -35,7 +35,6 @@ program ultrastardx; {$I switches.inc} -// TODO: check if this is needed for MacOSX too {$IFDEF MSWINDOWS} // Set global application-type (GUI/CONSOLE) switch for Windows. // CONSOLE is the default for FPC, GUI for Delphi, so we have @@ -193,6 +192,8 @@ uses URingBuffer in 'base\URingBuffer.pas', USingScores in 'base\USingScores.pas', USingNotes in 'base\USingNotes.pas', + UPath in 'base\UPath.pas', + UNote in 'base\UNote.pas', TextGL in 'base\TextGL.pas', UUnicodeUtils in 'base\UUnicodeUtils.pas', |