DECLARE SUB Ball (x AS INTEGER, y AS INTEGER, w AS INTEGER, tint() AS INTEGER)
DIM x AS INTEGER, y AS INTEGER, w AS INTEGER, t AS SINGLE, E AS STRING
DIM year AS STRING, month AS STRING, yr AS INTEGER, mo AS INTEGER
DIM tint(0 TO 20) AS INTEGER
DIM song(1 TO 5) AS STRING
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)))
song$(1) = "mbmlO2T220" 'song - Auld Lang Syne
song$(2) = "ccfffeffaagggfgg"
song$(3) = "agffffaa>ccddddd"
song$(4) = "ddccc<aaaffgggfgg"
song$(5) = "agfffdddccfffff"
CLS
LOCATE 7, 22: PRINT "TIMES SQUARE AT NEW YEAR'S EVE"
PRINT TAB(22); STRING$(30, "_")
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
COLOR , 6 'color of pole
FOR x = 1 TO 19
LOCATE x + 2, 38
PRINT " " 'space prints background color
NEXT x
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
FOR x = 1 TO 19 '1 to 20 *menn
ex$ = INKEY$
IF ex$ = CHR$(27) THEN COLOR 7, 0: CLS : EXIT FOR
SOUND s, 10 'sound heard while ball is dropping
s = s + 9
IF (x + 1) MOD 2 = 0 THEN 'countdown from 10 to 1 ' x+1 was x *menn
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 "HAPPY NEW YEAR!"
LOCATE 10, 55
PRINT year$
LOCATE x, 38
''COLOR , 3 ''*menn
PRINT CHR$(1) 'happy face replaces countdown number
LOCATE x + 1, 38
PRINT "*"
FOR i = 1 TO 5 'song - Auld Lang Syne
ex$ = INKEY$
IF ex$ = CHR$(27) THEN COLOR 7, 0: CLS : EXIT FOR
PLAY song$(i)
NEXT i
c = 16
END IF
FOR blink = 1 TO 120
IF ex$ = CHR$(27) THEN COLOR 7, 0: CLS : EXIT FOR
ex$ = INKEY$
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 "HAPPY NEW YEAR!"
LOCATE 10, 55
PRINT year$; " "
CASE ELSE
LOCATE 10, 10
PRINT year$; " "
LOCATE 10, 55
PRINT "HAPPY NEW YEAR!"
END SELECT
row = INT(21 * RND) + 2 'confetti fills the sky
col = INT(75 * RND) + 3 '(always in same random locations)
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 7, 0
LOCATE 24, 55
PRINT "by Solitaire";
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
COLOR , 0
IF x > 1 THEN 'clear top of ball
LOCATE x - 1, 36
PRINT SPACE$(5) 'space prints background color
END IF
LOCATE x, 35
PRINT SPACE$(7)
COLOR , 6
IF x > 2 THEN 'redraw pole on top
LOCATE x - 1, 38
PRINT " "
END IF
''COLOR , tint(t) 'redraw descending ball with changing colors
''IF x > 1 THEN
'' LOCATE x, 36
'' PRINT SPACE$(5)
''END IF
'*menn (all lines double remmed '' by *menn)
newco = tint(t) + 10 - 2 * (tint(t) = 2)
COLOR newco, 0
IF x + z > 1 THEN LOCATE x + z, 29 + 5: PRINT SPACE$(9) 'clear top
nn = 29
LOCATE x + z + ABS(x < 2), 7 + nn: PRINT STRING$(5, 248)
LOCATE , 5 + nn: PRINT STRING$(9, 248)
LOCATE , 5 + nn
PRINT STRING$(2, 248) + "20" + CHR$(248) + "06" + STRING$(2, 248)
LOCATE , 5 + nn: PRINT STRING$(9, 248)
LOCATE , 7 + nn: PRINT STRING$(5, 248)
''FOR z = 1 TO 2
'' IF x = 1 THEN
'' LOCATE x + z, 36
'' PRINT SPACE$(5)
'' ELSE
'' LOCATE x + z, 35
'' PRINT SPACE$(7)
'' END IF
''NEXT z
''LOCATE x + 3, 36
''PRINT SPACE$(5)
''COLOR 1, 3
IF y = 10 THEN
IF w = 1 THEN
LOCATE 3, 37 'was 3, 36
ELSE
LOCATE x + 2, 37 'was 36
END IF
ELSE
LOCATE x + 1, 38 'was 37
END IF
''COLOR , tint(t) 'background color of countdown number
PRINT LTRIM$(STR$(y)); 'countdown number 'was ? y; *menn
''COLOR 7, 0
LOCATE 1, 30
PRINT "TIMES SQUARE BALL"
t = t + 1 'static counter
END SUB