DISCO.BAS

Go back

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.

Download DISCO.BAS for QBasic

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