' "Caffeine, Capsaicin, and Calcium" ' A myuz1k/gr4fx work of art of sorts ' By ShinerCCC ' Apostrophes denote comments ' DIM cf(10 TO 59) AS STRING 'declaring arrays DIM cs(10 TO 59) AS STRING DIM ca(10 TO 59) AS STRING DIM m(10 TO 39) AS STRING CONST pi = 3.141593 'the CONST declaration really isn't necessary RANDOMIZE TIMER 'seeds random number generator with 'seconds elapsed since midnight. 'seeing the same graphics over and over again 'wouldn't be very exciting, would it? PLAY "t120 o4 mb" 'play in background, 120 BPM, octave 4 PLAY ON 'enables background music event trapping 'MELODIES HARD CODED HERE: 'Main theme cells m(11) = "ml c+4c+8 mn l8 e < a b > ml c+4c+8 mn e < a b > l4 c+ < b a > " 'not the 11th cell, but 1-1 m(12) = "ml c+4c+8 mn l8 e < a b > ml c+4c+8 mn e < a b > l4 d c+ < b > " '1-2, etc m(13) = "ml c+4c+8 ms < a8 a4 ml a2 p4" m(21) = "t120 o3 ml c+4c+8 mn l8 e < a b > ml c+4c+8 mn g+ f+ < b >" 'interesting note (no pun intended): I tried using E sharp (e+) but QBasic crashed m(22) = "ml c+4c+8 mn g+ f < b > ml c+4c+8 mn d < a > f+ mlc+4 l16 > f < a- > c+ < f a- c+ f < a- >" m(23) = "c+4c+8 l8 e f+ g+ c+4c+8 f+ g+ a+ c+4c+8 g+ a+ b > c+4c+8 < b > c+ f f+2f+4 < f+2f+4 inf) NEXT i ' to make shorter, multiply j (i -> 1) IF d > (2 * pi) THEN d = 0 IF c = 15 THEN c = 14 l = 1 END IF IF c = 14 AND l = 0 THEN c = 15 'swaps colours END IF LOOP UNTIL p = 13 IF d3 = 1 THEN GOSUB cf IF d3 = 2 THEN GOSUB cs IF d3 = 3 THEN GOSUB ca cf: 'now that I think about it this label isn't needed either. p = 10 q = 0 'white and gray dots begin to appear. used for cf(1*) CLS SCREEN 7 '320 x 200 DO ON PLAY(1) GOSUB finc x = INT(RND * 320) y = INT(RND * 200) c = INT(RND * 4) + 1 IF c = 1 THEN PSET (x, y), 15 IF c = 2 THEN PSET (x, y), 7 IF c = 3 THEN PSET (x, y), 8 IF c = 4 THEN PSET (x, y), 0 LOOP UNTIL q >= 4 d6 = INT(RND * 6) + 1 IF d6 < 4 THEN p = 20 'p starts out being 1 less than its target IF d6 > 3 THEN p = 24 q = 0 'trail of dots, monochrome - used for cf(2*) CLS SCREEN 8 PAINT (0, 0), 15 'white background IF d6 > 3 THEN c = 10 'head is green for 3/4 'a gigantic 3 LINE (200, 20)-(450, 40), 1, BF LINE (200, 80)-(450, 100), 1, BF LINE (200, 140)-(450, 160), 1, BF LINE (400, 20)-(450, 160), 1, BF END IF IF d6 < 4 THEN c = 14 'head is yellow for 5/4 'a gigantic 5 LINE (200, 20)-(450, 40), 2, BF LINE (200, 20)-(250, 100), 2, BF LINE (200, 80)-(440, 100), 2, BF FOR r = 80 TO 130 CIRCLE (333, 130), r, 2, pi, pi / 3 NEXT r FOR r = 20 TO 40 CIRCLE (466, 70), r, 15 NEXT r END IF PSET (320, 100), 0 'sets center x = 0 y = 0 DO ON PLAY(1) GOSUB finc PSET STEP(x, y), 0 PSET STEP(-x, -y), 0 'black dots erode the background DO x = INT(RND * 3) - 1 y = INT(RND * 3) - 1 LOOP UNTIL (y <> 0 OR x <> 0) 'don't leave without making a change FOR i = 1 TO h \ (j * 4) NEXT i PSET STEP(x, y), c 'the "head" of the eroding trail LOOP UNTIL q >= 4 IF d6 < 4 THEN d10 = INT(RND * 10) + 10 IF d10 < 15 THEN p = 33 IF d10 > 14 THEN p = 36 END IF IF d6 > 3 THEN d10 = INT(RND * 10) + 1 IF d10 < 5 THEN p = 29 IF d10 > 4 THEN p = 33 END IF q = 0 IF d10 < 5 THEN q = -5 'trail of dots with a fatter worm, multicoloured head. used for cf(3*) CLS SCREEN 7 PAINT (0, 0), 7 'light grey background PSET (160, 100), 0 x = 0 y = 0 c = 0 DO IF d10 < 5 THEN IF p >= 33 THEN p = 29 END IF ON PLAY(1) GOSUB finc CIRCLE STEP(x, y), 1, 0 'a small circle does the trick CIRCLE STEP(-x, -y), 1, 0 'STEP has better runtime than absolute coordinates DO x = INT(RND * 3) - 1 y = INT(RND * 3) - 1 LOOP UNTIL (y <> 0 OR x <> 0) c = c + 1 IF c > 15 THEN c = 1 CIRCLE STEP(x, y), 1, c LOOP UNTIL q >= 3 q = 0 p = 40 'random ascending graph. used for cf(4*) CLS SCREEN 8 x = 0 y = 200 g = 9 DO ON PLAY(1) GOSUB finc PSET (x, y), g t = INT(RND * 4) + 1 IF t < 4 THEN x = x + 1 '4 times more likely to go forward than up because IF t = 4 THEN y = y - 1 'the screen is 3.2 times wider than it is tall IF x > 639 OR y < 1 THEN 'restarts if it leaves the screen g = g + 1 IF g = 15 THEN g = 9 '9 to 15 are the extra bright colours x = 0 y = 200 END IF FOR i = 1 TO h \ (j * 100) NEXT i LOOP UNTIL q >= 8 p = 50 q = 0 'explosions?! used for cf(5*) CLS SCREEN 7 RANDOMIZE TIMER DO ON PLAY(1) GOSUB finc a = INT(RND * 260 * 1) + 1 b = INT(RND * 260 * 1) + 1 c = INT(RND * 140 * 1) + 1 FOR e = 1 TO c CIRCLE (a, b), e, 14 CIRCLE (a + 1, b + 1), e, 4 CIRCLE (a - 1, b - 1), e, 15 NEXT e LOOP UNTIL q >= 6 GOSUB conc cs: p = 10 d10 = INT(RND * 10) + 1 IF d10 < 7 THEN q = 0 IF d10 > 6 THEN q = 2 q = 0 'heat ray with a curry-coloured background. used for cs(1*) CLS SCREEN 8 r = 0 PAINT (639, 199), 2 'turns the screen green DO ON PLAY(1) GOSUB sinc CIRCLE STEP(-3, -1), r, 4 CIRCLE STEP(-3, -1), r / 2, 12 PAINT STEP(0, 0), 12 r = r + 1 FOR i = 1 TO h \ (j - (r * 50) + 1) 'PROTIP: Add 1 to avoid division by zero. NEXT i 'It happened to me, folks. LOOP UNTIL q >= 6 p = 20 q = 0 'hourglass wiper. used for cs(21+22) CLS SCREEN 8 d = 0 x = 0 PALETTE 6, 13 'makes colour 6 point to colour 13 instead DO ON PLAY(1) GOSUB sinc LINE (320, 100)-(120 + x, 25), d + 5 LINE (320, 100)-(520 - x, 175), d + 5 x = x + 1 IF d = 1 THEN x = x - 2 IF x > 399 THEN d = 1 IF x < 2 THEN d = 0 LOOP UNTIL q >= 2 PALETTE 13, 6 d10 = INT(RND * 10) + 1 IF d10 < 4 THEN p = 30 IF d10 > 3 AND d10 < 9 THEN p = 40 IF d10 > 8 THEN p = 44 q = 0 'furious mass colour changes CLS SCREEN 7 'flashfire version. used for cs(3*) IF p < 40 THEN DO ON PLAY(1) GOSUB sinc a = INT(200 * RND) PAINT (a, a), 12 b = INT(200 * RND) PAINT (b, b), 4 LOOP UNTIL q >= 4 p = 40 END IF q = 0 'wave version. used for cs(4*) CLS SCREEN 7 IF p < 44 THEN DO ON PLAY(1) GOSUB sinc PAINT (150, 150), 1 FOR i = 1 TO 99999 NEXT i PAINT (150, 150), 9 LOOP UNTIL q = 4 END IF q = 0 CLS PLAY cs(45) GOSUB conc ca: p = 10 q = 0 'shiny 3D rectangle - used for ca(1*) CLS DO ON PLAY(1) GOSUB ainc a = INT(RND * 20) + 1 b = INT(RND * 20) + 1 LINE (320 - a, 100 - b)-(320 + b, 100 + a), 7 LINE (320 - b, 100 - a)-(320 + a, 100 + b), 8 LOOP UNTIL p >= 14 p = 20 q = 0 'gray ripple - used for ca(2*) CLS SCREEN 8 r = 1 CIRCLE (320, 100), r, 7 DO ON PLAY(1) GOSUB ainc CIRCLE STEP(0, 0), r, 7 'PROTIP: instead of clearing the screen constantly, CIRCLE STEP(0, 0), r - 1, 0 'I draw a black circle behind it. r = r + 1 'This avoids flickering. IF r > 400 THEN r = 1 FOR i = 1 TO h \ (j * 5) NEXT i PSET (0, 0), 0 PSET (320, 100), 0 LOOP UNTIL p >= 23 d10 = INT(RND * 10) + 1 IF d10 < 5 THEN p = 30 IF d10 > 4 THEN p = 34 q = 0 'various coloured "coins" - used for ca(3*). colour varies depending on cell CLS r = 1 IF p = 30 THEN c = 6 'for B Dorian IF p = 34 THEN c = 7 'for D Locrian DO ON PLAY(1) GOSUB ainc x = INT(RND * 640) y = INT(RND * 200) DO CIRCLE (x, y), r, c CIRCLE (x, y), r - 1, 0 r = r + 1 FOR i = 1 TO h \ (j * 10) NEXT i LOOP UNTIL r > y r = 1 LOOP UNTIL q >= 4 d4 = INT(RND * 4) + 1 IF d4 = 1 THEN p = 40 IF d4 = 2 THEN p = 42 IF d4 = 3 THEN p = 44 IF d4 = 4 THEN p = 46 q = 0 'dark sparkle - used for ca(4*). corners vary... CLS SCREEN 7 c = 7 DO ON PLAY(1) GOSUB ainc x = INT(RND * 100) y = INT(RND * 100) IF (ABS(x - y) > 60) THEN c = 7 ELSE c = 8 x = x - 20 y = y - 20 END IF IF d4 > 0 THEN LINE (0, 0)-(x, y), c 'top left IF d4 > 1 THEN LINE (320, 0)-(320 - x, y), c 'top right IF d4 > 2 THEN LINE (0, 200)-(x, 200 - y), c 'bottom left IF d4 > 3 THEN LINE (320, 200)-(320 - x, 200 - y), c 'bottom right FOR i = 1 TO h \ j NEXT i LOOP UNTIL q >= 2 d6 = INT(RND * 6) + 1 IF d6 < 4 THEN p = 50 IF d6 > 3 THEN p = 54 q = 0 'bright sparkle - used for ca(5*) CLS SCREEN 7 c = 15 xx = 1 yy = 1 DO ON PLAY(1) GOSUB ainc l = 0 x = INT(RND * xx) y = INT(RND * yy) LINE (0, 0)-(x, y), c IF c = 15 THEN c = 14 l = 1 END IF IF c = 14 AND l = 0 THEN c = 15 IF xx < 320 THEN xx = xx + 1 'this makes the sparkle grow IF yy < 200 THEN yy = yy + 1 FOR i = 1 TO h \ j NEXT i LOOP UNTIL q >= 4 'no need for GOSUB, we're already here 'last label. conc is short for "conclusion" conc: p = 20 q = 0 'falling icicles. used for M(2*) SCREEN 8 y = 0 DO ON PLAY(1) GOSUB minc CLS x = INT(RND * 600) - 10 DO CIRCLE (x, y - 1), 50, 0, -(pi * (5 / 12)), -(pi * (7 / 12)) CIRCLE (x, y), 50, 1, -(pi * (5 / 12)), -(pi * (7 / 12)) PAINT (x, y - 10), 9, 1 'fills in any area enclosed by 1 with 9 y = y + 1 FOR i = 1 TO h \ (j * 5) NEXT i LOOP UNTIL y > 222 y = 0 LOOP UNTIL q >= 3 CLS g4 = 780 'Just pitches g3 = 390 'notes specified by frequency, rounded down 1.1111~ Hz g2 = 195 'I did 440 * (8/9) but that may have been a mistake...(15/16)^2 = 9/10 d3 = 292.5 d4 = 585 bb2 = 234 bb3 = 468 bb4 = 936 fs2 = 182.6325 fs3 = 365.265 'okay, I wanted to be picky about the leading tone a2 = 220 a3 = 440 a4 = 880 'OBVIOUSLY eb2 = 156 eb3 = 312 eb4 = 624 e2 = 166 e3 = 333 e4 = 666 PLAY "mf" 'play music in foreground. This is important to synch up graphics LINE (0, 50)-(170, 75), 1, BF '6/4 time (think 3/4 but twice as long) 'measure 1 FOR p = 1 TO 4 IF p < 3 THEN SOUND g3, 2.275 '18.2 clock ticks in 1 second IF p > 2 THEN SOUND fs3, 2.275 SOUND d4, 2.275 'this means these are 16th notes IF p < 3 THEN SOUND bb4, 2.275 'at 120 BPM. IF p > 2 THEN SOUND a4, 2.275 SOUND d4, 2.275 IF p < 3 THEN SOUND bb4, 2.275 'yeah, I did this with a goofy FOR loop IF p > 2 THEN SOUND a4, 2.275 SOUND d4, 2.275 'instead of hard coding 192 SOUND statements NEXT p LINE (0, 50)-(50, 150), 1, BF 'measure 2 FOR p = 1 TO 4 IF p < 3 THEN SOUND eb3, 2.275 IF p > 2 THEN SOUND e3, 2.275 SOUND bb3, 2.275 IF p < 3 THEN SOUND eb4, 2.275 IF p > 2 THEN SOUND e4, 2.275 SOUND bb3, 2.275 IF p < 3 THEN SOUND eb4, 2.275 IF p > 2 THEN SOUND e4, 2.275 SOUND bb3, 2.275 NEXT p LINE (50, 150)-(170, 125), 1, BF 'measure 3 FOR p = 1 TO 4 SOUND d3, 2.275 IF p < 3 THEN SOUND g3, 2.275 IF p > 2 THEN SOUND fs3, 2.275 IF p < 3 THEN SOUND bb3, 2.275 IF p > 2 THEN SOUND a3, 2.275 IF p < 3 THEN SOUND g3, 2.275 IF p > 2 THEN SOUND fs3, 2.275 IF p < 3 THEN SOUND bb3, 2.275 IF p > 2 THEN SOUND a3, 2.275 IF p < 3 THEN SOUND g3, 2.275 IF p > 2 THEN SOUND fs3, 2.275 NEXT p LINE (200, 50)-(370, 75), 4, BF 'measure 4 FOR p = 1 TO 4 SOUND bb2, 2.275 IF p < 3 THEN SOUND eb3, 2.275 IF p > 2 THEN SOUND e3, 2.275 SOUND g3, 2.275 IF p < 3 THEN SOUND eb3, 2.275 IF p > 2 THEN SOUND e3, 2.275 SOUND g3, 2.275 IF p < 3 THEN SOUND eb3, 2.275 IF p > 2 THEN SOUND e3, 2.275 NEXT p LINE (200, 50)-(250, 150), 4, BF 'if I could do chord inversions mathematically this might have been a lot faster 'measure 5 FOR p = 1 TO 4 IF p < 3 THEN SOUND bb2, 2.275 IF p > 2 THEN SOUND a2, 2.275 SOUND d3, 2.275 IF p < 3 THEN SOUND g3, 2.275 IF p > 2 THEN SOUND fs3, 2.275 SOUND d3, 2.275 IF p < 3 THEN SOUND g3, 2.275 IF p > 2 THEN SOUND fs3, 2.275 SOUND d3, 2.275 NEXT p LINE (250, 150)-(370, 125), 4, BF 'measure 6 FOR p = 1 TO 4 SOUND g2, 2.275 SOUND bb2, 2.275 IF p < 3 THEN SOUND eb3, 2.275 IF p > 2 THEN SOUND e3, 2.275 SOUND bb2, 2.275 IF p < 3 THEN SOUND eb3, 2.275 IF p > 2 THEN SOUND e3, 2.275 SOUND bb2, 2.275 NEXT p LINE (400, 50)-(600, 75), 15, BF 'measure 7 FOR p = 1 TO 4 IF p < 3 THEN SOUND g2, 2.275 IF p > 2 THEN SOUND fs2, 2.275 IF p < 3 THEN SOUND bb2, 2.275 IF p > 2 THEN SOUND a2, 2.275 SOUND d3, 2.275 IF p < 3 THEN SOUND bb2, 2.275 IF p > 2 THEN SOUND a2, 2.275 SOUND d3, 2.275 IF p < 3 THEN SOUND bb2, 2.275 IF p > 2 THEN SOUND a2, 2.275 NEXT p LINE (400, 50)-(450, 150), 15, BF 'measure 8 FOR p = 1 TO 4 IF p < 3 THEN SOUND eb2, 2.275 IF p > 2 THEN SOUND e2, 2.275 SOUND g2, 2.275 SOUND bb2, 2.275 SOUND g2, 2.275 SOUND bb2, 2.275 SOUND g2, 2.275 NEXT p p = 37 'for some reason the program skips ahead to the "inc" subs again LINE (450, 150)-(600, 125), 15, BF 'by now these LINE statements have drawn "CCC" on the screen PLAY m(31) 'same theme continued in Equal Temperament PALETTE 1, 9 'switch their colours a bit PLAY m(32) PALETTE 4, 12 PLAY m(33) PALETTE 15, 7 PLAY m(34) PALETTE 15, 8 PLAY m(35) CLS PALETTE PLAY m(36) COLOR 0 'covers up that annoying "Press any key to continue" ;) DO LOOP WHILE INKEY$ = "" 'waits for a key to be pressed END 'THE END OF THE SONG AND THE PROGRAM AND EVERYTHING 'other methods: END minc: 'short for "increment cell index" p = p + 1 'in these methods, the array index is q = q + 1 'advanced by 1 and adds to the background queue. PLAY m(p) 'Yeah, yeah, spaghetti code, etc. RETURN 'But ON PLAY literally demands a GOSUB. ainc: p = p + 1 q = q + 1 PLAY ca(p) RETURN sinc: p = p + 1 q = q + 1 PLAY cs(p) RETURN finc: p = p + 1 LET q = q + 1 'figured I would include the optional LET this time PLAY cf(p) RETURN 'eof! omg! stop reading!