Revised version - ball is rounder, pole is thinner, confetti more random.January 1 2006 at 12:57 PM | Solitaire (Login Solitaire1) S |
Response to Happy New Year - Times Square program. |
| This version uses ASCII characters for the pole and ball rather than spaces to paint them as a color background, so it's not as boxy as before. A DO loop avoids covering the ball or pole with random confetti so RANDOMIZE TIMER can be used instead of a fixed random arrangement for the confetti, and every time the program is run, the confetti display will be different. In case some random confetti covers the year or message, the text is reprinted at the end.
=============================================================================
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
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)))
song$(1) = "p8mbmlO2T220" 'song - Auld Lang Syne
song$(2) = "ccfffeffaagggfgg"
song$(3) = "agffffaa>ccddddd"
song$(4) = "p8ddccc<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 = 2 TO 20
LOCATE x + 4, 38
PRINT CHR$(186)
NEXT x
PRINT TAB(35); CHR$(201); STRING$(2, CHR$(205)); CHR$(202); STRING$(2, CHR$(205)); CHR$(187);
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, 54: PRINT yr - 1
FOR x = 1 TO 20
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 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 "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 "*"
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$; SPACE$(11)
CASE ELSE
LOCATE 10, 10
PRINT year$; SPACE$(11)
LOCATE 10, 55
PRINT "HAPPY NEW YEAR!"
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 > 32 AND col < 44 OR col = 38
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 "HAPPY NEW YEAR!"
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
IF x > 2 THEN 'clear top of ball
LOCATE x - 1, 36
PRINT SPACE$(5) 'space prints background color
END IF
LOCATE x, 34: PRINT " "
LOCATE x, 42: PRINT " "
LOCATE x, 35: PRINT SPACE$(7)
COLOR 6
IF x > 2 THEN 'redraw pole on top
LOCATE x - 1, 38
PRINT CHR$(186)
END IF
COLOR tint(t) 'redraw descending ball with changing color
IF x > 1 THEN
LOCATE x, 36
PRINT CHR$(220); STRING$(3, CHR$(219)); CHR$(220)
END IF
FOR z = 1 TO 2
IF x = 1 THEN
LOCATE x + z, 37
PRINT STRING$(3, CHR$(219))
ELSE
LOCATE x + z, 34
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, 36
IF x > 1 THEN PRINT CHR$(223); STRING$(3, CHR$(219)); CHR$(223)
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 0, 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
This message has been edited by Solitaire1 on Jan 2, 2006 10:04 AM This message has been edited by Solitaire1 on Jan 1, 2006 1:03 PM
|
|
|