Pause was added before returning to system.
Esc stops song from playing right away, by clearing song from memory with a CLEAR statement before end of program.
Pole and ball are centered - moved from column 38 to 40.
Year centered with alternating "Happy New Year" message.
Esc always displays message with pole and ball on the screen, leaving ball at the bottom.
Pole code was placed in a separate sub. Code to place smiling face and asterisk on ball was moved to the Ball sub.
Other minor changes were made.
-----------------------------------------------------------------------------
Revised Jan. 1, 2008 to remove parameters from SUB Pole (not needed) and added a pause: PLAY "P2" just before the song starts playing to fix the irregular tempo that had occurred during the first few notes.
=============================================================================
DECLARE SUB Ball (x AS INTEGER, y AS INTEGER, w AS INTEGER, tint() AS INTEGER)
DECLARE SUB Pole ()
DIM x AS INTEGER, y AS INTEGER, w AS INTEGER, t AS SINGLE
DIM yr AS INTEGER, mo AS INTEGER, cheer AS INTEGER
DIM year AS STRING, month AS STRING, msg AS STRING, E AS STRING
DIM tint(0 TO 20) AS INTEGER
DIM song(1 TO 5) AS STRING
RANDOMIZE TIMER
year$ = RIGHT$(DATE$, 4)
month$ = LEFT$(DATE$, 2)
yr = VAL(year$)
mo = VAL(month$)
IF mo >= 9 THEN yr = yr + 1
year$ = LTRIM$(RTRIM$(STR$(yr)))
year$ = SPACE$(4) + year$ + SPACE$(7) 'center interchange with message
msg$ = "HAPPY NEW YEAR!"
song$(1) = "p8mbmlO2T220" 'song - Auld Lang Syne
song$(2) = "ccfffeffaagggfgg"
song$(3) = "agffffaa>ccddddd"
song$(4) = "p8ddccc<aaaffgggfgg"
song$(5) = "agfffdddccfffff"
CLS
LOCATE 6, 22: PRINT "TIMES SQUARE ON NEW YEAR'S EVE"
PRINT TAB(22); STRING$(30, "_")
PRINT : PRINT , , "by Solitaire"
LOCATE 19, 20: PRINT "Press Alt-Enter for a full screen."
PRINT TAB(15); "Program will not work properly in a window."
LOCATE 24, 24: PRINT "Press any key to begin...";
E$ = INPUT$(1)
CLS
FOR x = 0 TO 20 'changing colors of ball as it drops
READ tint(x) 'assigned to array
NEXT x
CALL Pole
x = 2
y = 10
w = 1
CALL Ball(x, y, w, tint())
w = 0
COLOR 7, 0
LOCATE 25, 1: PRINT "Press any key to begin countdown ";
PRINT TAB(50); "Press Esc to stop";
E$ = INPUT$(1)
IF E$ = CHR$(27) THEN CLS : SYSTEM
LOCATE 25, 1: PRINT SPACE$(70);
s = 260
COLOR 8
LOCATE 10, 12: PRINT "Goodbye..."
LOCATE 10, 58: PRINT yr - 1
FOR x = 1 TO 20
ex$ = INKEY$
IF ex$ = CHR$(27) THEN 'Esc places ball on bottom
CLS
CALL Pole
CALL Ball(20, 0, 0, tint())
COLOR 7, 0: : EXIT FOR
END IF
SOUND s, 10 'sound heard while ball is dropping
s = s + 9
IF x MOD 2 = 0 THEN 'countdown from 10 to 1
y = y - 1
END IF
CALL Ball(x, y, w, tint())
t = TIMER
DO WHILE t + .5 >= TIMER AND t + .5 <= 86400: LOOP
NEXT x
IF ex$ <> CHR$(27) THEN
COLOR 30, 0
LOCATE 10, 10
PRINT msg$
LOCATE 10, 55
PRINT year$
PLAY "P2"
FOR i = 1 TO 5 'song - Auld Lang Syne
PLAY song$(i)
ex$ = INKEY$
IF ex$ = CHR$(27) THEN COLOR 7, 0: EXIT FOR
NEXT i
c = 16
END IF
IF ex$ <> CHR$(27) THEN cheer = 120
FOR blink = 1 TO cheer 'will not execute if Esc was pressed
ex$ = INKEY$
IF ex$ = CHR$(27) THEN COLOR 7, 0: EXIT FOR
c = c + 1
IF c = 32 THEN c = 17
COLOR c, 0
IF blink > 110 THEN COLOR 30 'messages blink and switch places
IF blink = 120 THEN COLOR 14
SELECT CASE blink
CASE 1 TO 16, 33 TO 48, 65 TO 80, IS > 97
LOCATE 10, 10
PRINT msg$
LOCATE 10, 55
PRINT year$
CASE ELSE
LOCATE 10, 10
PRINT year$
LOCATE 10, 55
PRINT msg$
END SELECT
DO
row = INT(21 * RND) + 2 'confetti fills the sky
col = INT(75 * RND) + 3 'does not cover ball or pole
LOOP WHILE row > 17 AND col > 34 AND col < 46 OR col = 40
tint = INT(15 * RND) + 1
confetti$ = CHR$(INT(6 * RND) + 1)
LOCATE row, col
COLOR tint, 0
IF blink > 105 THEN
confetti$ = "*" 'last confetti stars remain blinking
COLOR tint + 16, 0
END IF
PRINT confetti$
t = TIMER
DO WHILE t + .15 >= TIMER AND t + .15 <= 86400: LOOP
NEXT blink
COLOR 30 'blinking yellow
LOCATE 10, 55: PRINT year$ 'covers any random confetti
LOCATE 10, 10: PRINT msg$
IF ex$ = CHR$(27) THEN CLEAR 'stop song if Esc was pressed
COLOR 7, 0
LOCATE 25, 3: PRINT "Press any key to end...";
LOCATE 25, 55: PRINT "By Solitaire";
E$ = INPUT$(1)
CLS
DATA 3,3,2,2,3,3,5,5,3,3,2,2,3,3,5,5,3,3,2,2,3,3,3
SYSTEM
SUB Ball (x AS INTEGER, y AS INTEGER, w AS INTEGER, tint() AS INTEGER)
STATIC t AS INTEGER
IF x > 2 THEN 'clear top of ball
LOCATE x - 1, 38
PRINT SPACE$(5) 'space prints background color
END IF
LOCATE x, 36: PRINT " "
LOCATE x, 44: PRINT " "
LOCATE x, 37: PRINT SPACE$(7)
COLOR 6
IF x > 2 THEN 'redraw pole on top
LOCATE x - 1, 40
PRINT CHR$(186)
END IF
COLOR tint(t) 'redraw descending ball with changing color
IF x > 1 THEN
LOCATE x, 38
PRINT CHR$(220); STRING$(3, CHR$(219)); CHR$(220)
END IF
FOR z = 1 TO 2
IF x = 1 THEN
LOCATE x + z, 39
PRINT STRING$(3, CHR$(219))
ELSE
LOCATE x + z, 36
IF z = 1 THEN
PRINT CHR$(220); STRING$(7, CHR$(219)); CHR$(220)
ELSE
PRINT CHR$(223); STRING$(7, CHR$(219)); CHR$(223)
END IF
END IF
NEXT z
LOCATE x + 3, 38
IF x > 1 THEN PRINT CHR$(223); STRING$(3, CHR$(219)); CHR$(223)
IF y = 10 THEN
IF w = 1 THEN
LOCATE 3, 38
ELSE
LOCATE x + 2, 38
END IF
ELSE
LOCATE x + 1, 39
END IF
COLOR 0, tint(t) 'background color of countdown number
PRINT y; 'countdown number
COLOR 7, 0
LOCATE 1, 32
PRINT "TIMES SQUARE BALL"
IF x = 20 THEN
LOCATE 21, 40
COLOR 30, tint(t)
PRINT CHR$(1) 'happy face replaces countdown number
LOCATE 22, 40
PRINT "*"
END IF
t = t + 1 'static counter
END SUB
SUB Pole
COLOR 6 'color of pole
FOR x = 2 TO 24
LOCATE x, 40
PRINT CHR$(186)
NEXT x
LOCATE 24
PRINT TAB(37); CHR$(201); STRING$(2, CHR$(205)); CHR$(202); STRING$(2, CHR$(205)); CHR$(187);
END SUB