Below you'll find the source for the QBasic file DISCO.BAS.
I've been in doubt if I'd republish this file again. Mainly for a few reasons;
1. The stuff I made as a kid is very childish (which kinda makes sense)
2. Times have changed; what was funny/innovative or sharable in 1997 doesn't meet standards in 2024.
3. Most of the code doesn't run natively anymore on modern operating systems.
4. It's in the Dutch language, where most of my shared content is in English.
Still, I've decided to share this file. Keep in mind the age of this content though.
DECLARE FUNCTION KiesRep! ()
DECLARE FUNCTION Kleur! (b!, g!, r!)
DECLARE FUNCTION RndLamp! ()
DECLARE FUNCTION TempDir$ ()
DECLARE FUNCTION KiesMus$ ()
DECLARE FUNCTION KiesZet! ()
DECLARE FUNCTION KiesLmp! ()
COMMON SHARED Temp$
CONST Nodig = -1: Onnodig = 0: Lampen = 1: Strobos = 2: Alles = 3
CLS
PRINT "Utilitie voor de Music Player"
PRINT
Temp$ = TempDir$ 'Tempdirectory ["Directory"|TEMPDIR$]
Mus$ = KiesMus$ 'Muziekbestand ["bestand.MUS"|KIESMUS$]
Zetom = KiesZet! 'Versneld [NODIG|ONNODIG|KIESZET]
Licht = KiesLmp! 'Lichten [ONNODIG|LAMPEN|STROBOS|ALLES|KIESLMP]
Repeat = KiesRep! 'Repeaten [ONNODIG|NODIG|KIESREP]
a(1) = Kleur(0, 0, 63) 'Lamp 1 aan
a(2) = Kleur(63, 0, 0) 'Lamp 2 aan
a(3) = Kleur(0, 63, 63) 'Lamp 3 aan
a(4) = Kleur(63, 63, 63)'Stroboscoop aan
u(1) = Kleur(0, 0, 10) 'Lamp 1 uit
u(2) = Kleur(10, 0, 0) 'Lamp 2 uit
u(3) = Kleur(0, 5, 5) 'Lamp 3 uit
u(4) = Kleur(3, 3, 3) 'Stroboscoop uit
PRINT "Dit programma werkt met .ASC-bestanden"
PRINT "Daarom wordt dat nu omgezet"
IF Zetom = Nodig THEN
PRINT "De lampen worden ook versneld"
PRINT "Daarom duurt dat net iets langer"
Bestand$ = UCASE$(Mus$)
Naar$ = Temp$ + "$$$$!!!!.###"
OPEN Bestand$ FOR INPUT AS #1
OPEN Temp$ + "####!!!!.$$$" FOR OUTPUT AS #2
IF RIGHT$(Bestand$, 4) <> ".ASC" THEN LINE INPUT #1, a$: PRINT "Titel: "; a$
DO UNTIL EOF(1)
LINE INPUT #1, a$
IF RIGHT$(Bestand$, 4) = ".KAR" THEN LINE INPUT #1, Leeg$
a$ = LTRIM$(UCASE$(RTRIM$(a$)))
IF LEFT$(a$, 1) <> "'" THEN
c$ = ""
FOR a = 1 TO LEN(a$)
b$ = MID$(a$, a, 1)
c$ = c$ + b$
ok = 0
IF b$ = "A" THEN ok = -1
IF b$ = "B" THEN ok = -1
IF b$ = "C" THEN ok = -1
IF b$ = "D" THEN ok = -1
IF b$ = "E" THEN ok = -1
IF b$ = "F" THEN ok = -1
IF b$ = "G" THEN ok = -1
Controle:
IF a < LEN(a$) THEN d$ = MID$(a$, a + 1, 1) ELSE d$ = ""
IF d$ = "." OR d$ = "+" OR d$ = "-" THEN
c$ = c$ + d$
a = a + 1
GOTO Controle
END IF
IF ok = -1 THEN
d$ = c$
c$ = ""
FOR t = 1 TO LEN(d$)
e$ = MID$(d$, t, 1)
IF d$ <> " " THEN c$ = c$ + e$
NEXT t
PRINT #2, c$
c$ = ""
END IF
NEXT a
PRINT #2, c$
END IF
LOOP
CLOSE #2
CLOSE #1
OPEN Temp$ + "####!!!!.$$$" FOR INPUT AS #1
OPEN Naar$ FOR OUTPUT AS #2
t = 0
DO UNTIL EOF(1)
INPUT #1, a$(t)
t = t + 1
IF t = 10 THEN
FOR a = 0 TO 8
PRINT #2, a$(a); ",";
NEXT a
PRINT #2, a$(9)
t = 0
END IF
LOOP
IF t < 10 THEN
FOR a = 0 TO 8
PRINT #2, a$(a); ",";
NEXT a
PRINT #2, a$(9)
END IF
CLOSE #2
CLOSE #1
KILL Temp$ + "####!!!!.$$$"
ELSE
PRINT "Omdat u de lichten niet hebt versneld, duurt het niet zo lang"
OPEN Temp$ + "$$$$!!!!.###" FOR OUTPUT AS #1
OPEN Mus$ FOR INPUT AS #2
IF RIGHT$(Bestand$, 4) <> ".ASC" THEN LINE INPUT #1, a$: PRINT "Titel: "; a$
DO UNTIL EOF(2)
LINE INPUT #2, a$
IF LEFT$(a$, 1) <> "'" THEN PRINT #1, a$
LOOP
CLOSE #2
CLOSE #1
END IF
PRINT "Klaar met configureren"
PRINT "Druk op een toets om "; Mus$; " te beluisteren"
SLEEP
a$ = INKEY$ 'Leegt stackruimte
SCREEN 12
'Drie circels voor de lampen worden getrokken
CIRCLE (120, 120), 120, 1 'Rood
CIRCLE (320, 360), 120, 2 'Blauw
CIRCLE (520, 120), 120, 3 'Geel
'Drie circels voor de lampen worden ingekleurd
PAINT (120, 120), 1 'Rood
PAINT (320, 360), 2 'Blauw
PAINT (520, 120), 3 'Geel
'Stroboscoop wordt getekend
LINE (0, 480)-(160, 400), 4, BF
LINE (640, 480)-(480, 400), 4, BF
'Kleurenpallet wordt aangepast
FOR a = 1 TO 3: PALETTE a, u(a): NEXT a
PALETTE 4, u(4)
Opnieuw:
OPEN Temp$ + "$$$$!!!!.###" FOR INPUT AS #1
DO UNTIL EOF(1) OR Temp2$ <> ""
INPUT #1, a$
IF Licht = Alles OR Licht = Lampen THEN b = RndLamp: PALETTE b, a(b)
IF Licht = Alles OR Licht = Strobos THEN PALETTE 4, u(4)
PLAY a$
IF Licht = Alles OR Licht = Lampen THEN PALETTE b, u(b)
IF Licht = Alles OR Licht = Strobos THEN PALETTE 4, a(4)
Temp2$ = INKEY$
LOOP
CLOSE #1
IF Temp2$ = "" AND Repeat GOTO Opnieuw
SCREEN 0
WIDTH 80, 25
KILL Temp$ + "$$$$!!!!.###"
FUNCTION KiesLmp
CONST Onnodig = 0: Lampen = 1: Strobos = 2
Temp = Onnodig
PRINT "Discolichten aan: [J/N]? ";
LOCATE , , 1
DO
IF Temp2$ <> "" THEN BEEP
Temp2$ = UCASE$(INKEY$)
LOOP WHILE Temp2$ <> "J" AND Temp2$ <> "N"
PRINT Temp2$
IF Temp2$ = "J" THEN Temp = Temp + Lampen
Temp2$ = ""
PRINT "Stroboscoop aan: [J/N]? ";
DO
IF Temp2$ <> "" THEN BEEP
Temp2$ = UCASE$(INKEY$)
LOOP WHILE Temp2$ <> "J" AND Temp2$ <> "N"
IF Temp2$ = "J" THEN Temp = Temp + Strobos
KiesLmp = Temp
LOCATE , , 0: PRINT Temp2$
END FUNCTION
FUNCTION KiesMus$
Mus$ = COMMAND$ 'Als hier wordt gezecht: Voorziening niet beschikbaar,
'Zet dan een ' voor deze regel
IF Mus$ = "" THEN
PRINT "Bezig met inlezen .ASC-bestanden"
SHELL "dir *.asc > " + Temp$ + "!!!$####.$$!"
PRINT "Bezig met inlezen .MUS-bestanden"
SHELL "dir *.mus >> " + Temp$ + "!!!$####.$$!"
PRINT "Bezig met inlezen .KAR-bestanden"
SHELL "dir *.kar >> " + Temp$ + "!!!$####.$$!"
PRINT "Bezig met sorteren"
SHELL "copy " + Temp$ + "!!!$####.$$! " + Temp$ + "!!!!####.$$$ > nul"
SHELL "type " + Temp$ + "!!!$####.$$! | sort > " + Temp$ + "!!!!####.$$$"
t = 0
OPEN Temp$ + "!!!!####.$$$" FOR INPUT AS #1
OPEN Temp$ + "!#!#!#!#.$$$" FOR OUTPUT AS #2
DO UNTIL EOF(1)
LINE INPUT #1, a$
IF LEFT$(a$, 1) <> " " AND a$ <> "" THEN
Punt = 0: c$ = ""
a$ = LEFT$(a$, 13)
FOR a = 1 TO LEN(a$)
b$ = MID$(a$, a, 1)
IF b$ = " " AND Punt = -1 THEN b$ = ""
IF b$ = " " AND Punt = 0 THEN b$ = ".": Punt = -1
c$ = c$ + b$
NEXT a
c$ = c$ + SPACE$(13 - LEN(c$))
PRINT #2, c$
t = t + 1
END IF
LOOP
CLOSE #2
CLOSE #1
Rec = 1
x = CSRLIN
DO
IF Rec < 1 THEN Rec = t
IF Rec > t THEN Rec = 1
OPEN Temp$ + "!#!#!#!#.$$$" FOR INPUT AS #1
FOR a = 1 TO Rec
LINE INPUT #1, a$
NEXT a
CLOSE #1
LOCATE x, 1: PRINT a$; " "; CHR$(24); " of "; CHR$(25); " of <─┘"
Reac = 0
DO
DO: b$ = INKEY$: LOOP WHILE b$ = ""
IF b$ = CHR$(13) THEN Reac = -1
IF b$ = CHR$(0) + "P" THEN Rec = Rec + 1: Reac = -1
IF b$ = CHR$(0) + "H" THEN Rec = Rec - 1: Reac = -1
LOOP WHILE Reac = 0
LOOP WHILE b$ <> CHR$(13)
'Tempbestanden worden gewist
KILL Temp$ + "!!!!####.$$$"
KILL Temp$ + "!#!#!#!#.$$$"
KILL Temp$ + "!!!$####.$$!"
ELSE
a$ = Mus$
PRINT "Bestand: "; a$
END IF
Temp2$ = LTRIM$(RTRIM$(UCASE$(a$)))
Fspc$ = "onbekend"
IF RIGHT$(Temp2$, 3) = "ASC" THEN Fspc$ = "ASCII"
IF RIGHT$(Temp2$, 3) = "MUS" THEN Fspc$ = "Music Player"
IF RIGHT$(Temp2$, 3) = "KAR" THEN Fspc$ = "Karaoke"
PRINT "Bestandsindeling: "; Fspc$
KiesMus$ = Temp2$
END FUNCTION
FUNCTION KiesRep
CONST Nodig = -1: Onnodig = 0
Temp = Onnodig
PRINT "Repeat: [J/N]? ";
LOCATE , , 1
DO
IF Temp2$ <> "" THEN BEEP
Temp2$ = UCASE$(INKEY$)
LOOP WHILE Temp2$ <> "J" AND Temp2$ <> "N"
LOCATE , , 0: PRINT Temp2$
IF Temp2$ = "J" THEN Temp = Nodig
KiesRep = Temp
END FUNCTION
FUNCTION KiesZet
CONST Nodig = -1: Onnodig = 0
Temp = Onnodig
PRINT "Discolichten versnellen: [J/N]? ";
LOCATE , , 1
DO
IF Temp2$ <> "" THEN BEEP
Temp2$ = UCASE$(INKEY$)
LOOP WHILE Temp2$ <> "J" AND Temp2$ <> "N"
LOCATE , , 0: PRINT Temp2$
IF Temp2$ = "J" THEN Temp = Nodig
KiesZet = Temp
END FUNCTION
FUNCTION Kleur (b, g, r)
' b = Tint blauw: 0 t/m 63
' g = Tint groen: 0 t/m 63
' r = Tint Rood : 0 t/m 63
Kleur = 65536 * b + 256 * g + r
END FUNCTION
FUNCTION RndLamp STATIC
IF Temp2 = 0 THEN RANDOMIZE TIMER
Temp = INT(RND * 3) + 1
IF Temp = Temp2 THEN Temp = Temp + 1: IF Temp > 3 THEN Temp = Temp - 3
Temp2 = Temp
RndLamp = Temp
END FUNCTION
FUNCTION TempDir$
Temp$ = ENVIRON$("TEMP")
IF Temp$ = "" THEN Temp$ = "C:"
IF RIGHT$(Temp$, 1) <> "\" THEN Temp$ = Temp$ + "\"
TempDir$ = Temp$
END FUNCTION