CONST fast = 0' 1 speeds up the intrduction to study final song
CONST zseconds = .16 ' How fast confetti is generated
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
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)))
CLS
DIM tint(0 TO 20) AS INTEGER
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 20
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 23, 1: PRINT "Press any key to begin countdown ";
' ===== Wait for user while calibrating machine speed
DIM zt1 AS DOUBLE, zt2 AS DOUBLE: zt1 = TIMER
DIM zc AS DOUBLE, zRatio AS DOUBLE
FOR zc = 1 TO 1000000000000000#' i.e. forever
IF INKEY$ <> "" THEN EXIT FOR
NEXT zc
zt2 = TIMER
'zc=number of times I have to loop to equal (zt2-zt1) seconds
zRatio = zc / (zt2 - zt1)
' =====to delay x seconds, do a similar loop zRatio*x times
LOCATE 23, 1: PRINT SPACE$(40)
s = 260
FOR x = 1 TO 20
IF fast = 0 THEN 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
IF fast = 0 THEN DO WHILE t + .5 >= TIMER: LOOP
NEXT x
COLOR 30, 0
LOCATE 10, 10
PRINT "HAPPY NEW YEAR!"
LOCATE 10, 55
PRINT year$
LOCATE x, 38
COLOR , 3
PRINT CHR$(1) 'happy face replaces countdown number
LOCATE x + 1, 38
PRINT "*"
PLAY "mbmlO2T220" 'song - Auld Lang Syne
P$ = "ccfffeffaagggfgg"
P$ = P$ + "agffffaa>ccddddd"
P$ = P$ + "ddccc<aaaffgggfgg"
P$ = P$ + "agfffdddccfffff"
c = 16
FOR blink = 1 TO 120
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
LOCATE x, 38
COLOR , 3
PRINT CHR$(1)
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$
PLAY MID$(P$, blink, 1)
FOR zc = 1 TO zRatio * zseconds
IF INKEY$ <> "" THEN
LOCATE 25, 1: COLOR 7, 0: PRINT "Press any key";
SLEEP: k$ = INKEY$
CLS
SYSTEM
END IF
NEXT zc
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
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, 36
ELSE
LOCATE x + 2, 36
END IF
ELSE
LOCATE x + 1, 37
END IF
COLOR , tint(t) 'background color of countdown number
PRINT y; 'countdown number
COLOR 7, 0
LOCATE 1, 30
PRINT "TIMES SQUARE BALL"
t = t + 1 'static counter
END SUB