12-18-2006, 06:31 AM
Here are two programs, the first is the original one, which doesn't work in QuickBASIC, as is, due to a number of incompatiblities.
The second one was made by me, from scratch, based on the idea of the first one, for QuickBASIC 4.5, running under Windows XP.
E N J O Y !
1st Program:
11111111111111111111111111111111111111111111111111111
2nd program:
2222222222222222222222222222222222222222222222222222
The second one was made by me, from scratch, based on the idea of the first one, for QuickBASIC 4.5, running under Windows XP.
E N J O Y !
1st Program:
11111111111111111111111111111111111111111111111111111
Code:
'''The following program is as published in the TRS-80 Microcomputer News
'''magazine, Volumn 3, Issue 12, December, 1981. Unfortunately, many of the
'''statements, such as PRINT@, PLAY, PSET for the color of a LINE, and others,
'''are not supported by QuickBASIC and/or Windows XP, making the program not
'''usable in QuickBASIC. However, I, Ralph A. Esquivel, email
'''RAEsquivelC@Yahoo.com, print it here, so that those who still are using DOS
'''or Windows versions that support BASIC may use the parts of the program
'''that work and/or create a new version, in which the music plays!
'A Christmas Wreath and Song
'by Gerald Plueard
'501 North 143 Street
'Seatt;e. WA 98133
5 'THIS PROGRAM WAS MADE ON THE (TRS-80) COLOR 16K COMPUTER AND PRINTED ON
'THE(TRS-8-) LINE PRINTER VII.
10 'THIS PROGRAM MAY BE PUBLISHED, I HAVE NO COPY RIGHTS TO IT, NOR IS ANY
'OF IT COPY RIGHTED, TO MY KNOWLEDGE.
20 'FINISHED ON AUGUST 30, 1981 AT 501 NORTH 143 ST., SEATTLE WA. 98133, BY
'JERRY PLUEARD
30 'LINES 110 THROUGH 320 IS A WAY OF DISPLAYING A MOVING CURSOR, SO YOU
'KNOW HOW MUCH TIME YOU HAVE TO READ THE WORDS.
40 'LINES 350 THROUGH 400 MOVE THE SONG WORDS ACROSS THE CENTER OF YOUR SCREEN
50 'LINES 590 THROUGH 900 DEVELOP THE CHRISTMAS WREATH IN A WINDOW.
55 CLS
60 PRINT@64, STRINGS(32,"*")
70 PRINT@352, string$(32,"*")
80 PRINT@199, "JOY TO THE WORLD"
90 FOR X = 1 TO 1000: NEXT X: CLS
110 PRINT@256, "JOY TO THE WORLD"
120 GOSUB 280
130 PRINT@256, "THE LORD IS COME"
140 GOSUB 280
150 PRINT@256, "LET EARTH RECEIVE HER KING"
160 GOSUB 280
170 PRINT@256, "LET EVERY HEART"
180 GOSUB 280
190 PRINT@256, "PREPARE HIM ROOM"
200 GOSUB 280
210 PRINT@256, "AND HEAVEN AND NATURE SING"
220 GOSUB 280
230 PRINT@256, "AND HEAVEN AND NATURE SING"
240 GOSUB 280
250 PRINT@256, "AND HEAVEN, AND HEAVEN AND NATURE SING."
260 GOSUB 280
270 GOTO 340
'''this is a subroutine for lines 120, 140, ... 260, above
280 FOR C1 = 0 TO 31
290 PRINT@288+C1,CHR$(128);
300 FOR D1 = 1 TO 15: NEXT D1
310 PRINT@288, " ";
320 NEXT C1
330 RETURN
340 CLS
350 Q$ = "JOY TO THE WORLD THE LORD IS COME LET EARTH RECIEVE HER KING LET EVERY HEART PREPARE HIM ROOM AND HEAVEN AND NATURE SING AND HEAVEN AND NATURE SING AND HEAVEN AND HEAVEN AND NATURE SING "
360 FOR Z = 1 TO LEN(Q$)
370 PRINT@260,MID$(Q$,Z,22)
380 PLAY "L64;O5;1"
390 FOR D2 = 1 TO 50: NEXT D2
400 NEXT Z
410 GOTO 570
420 a$ = "TR;O3;L2;C;L4;O2;B;L8;A;L2.;G;L4;F;L2;E;D;"
430 G$ = a$
: RETURN 'to 870
440 B$ = "L2.;C;P32;L4;G;L2;A;L4;P32;A;L2.;B;P32;L4;B;O3;L1.;C"
450 G$ = B$
: RETURN 'to 870
460 C$ = "L4;C;C;O2;L4;B;A;B;L4.;B;L8;F;L4;E;O3;C"
470 G$ = C$
: RETURN 'to 870
480 D$ = "O3;L4;C;O2;B;A;G;P32;L4;G;L8;F;L4;E;P32;E;P32;E;P32;E;P32;E;P32;L8;E;F"
490 G$ = D$
: RETURN 'to 870
500 E$ = "L2.;G;L8;F;E;L4;D;P32;D;P32;D;P32;L8;D;E;L2.;F;L8;E;D"
510 C$ = E$
: RETURN 'to 870
520 F$ = "O2;L4;C;O3;L2;C;O2;L4;A;L4.;G;L8;F;L4;R;F;L2;E;D;L1;C"
530 G$ = F$
: RETURN 'to 870
540 X$ = "XA$;XB$;XC$;XD$;XE$;XF$;"
550 G$ = X$
: RETURN 'to 870
560 PLAY X$
570 PMODE 3, 1
580 PCLS
590 SCREEN 1, 0
600 LINE(0,0)-(255,191),PSET, B
610 LINE(128,0)-(128,18(,PSET
620 FOR I = 0 TO 6.5 STEP .02
630 LA = 60 * SIN(I)
640 LB = 60 * COS(I)
650 I2 = I2 + .3
660 SA = 20 * SIN(I2)
670 SB = 20 * COS(I2)
680 LINE -(128-LA-SA,96-KB-SB),PSET
690 NEXT I
700 PAINT (10, 40), 4, 0
710 CIRCLE (127, 95), 44, 3
720 GOSUB 780
730 PAINT (128, 60), 2, 0
740 LINE(120,95)-(128,70),PSET
750 PAINT (128, 80), 1, 2
760 GOSUB 840
770 GOTO 820
780 LINE(120,89)-(126,70),PSET
790 LINE-(136,89),PSET
800 LINE(120,89),PSET
810 RETURN
820 GOSUB 840
830 GOTO 720
840 K = K + 1
850 IF K > 20 THEN 860 ELSE 900
860 J = J + 1
870 ON J GOSUB 420, 440, 460, 480, 500, 520, 540
880 IF J >= 7 THEN J = 0
890 PLAY G$
900 RETURN
910 END
2nd program:
2222222222222222222222222222222222222222222222222222
Code:
'WREATH-1.BAS is a program created by Ralph A. Esquivel, on December 15, 2006.
'My email address is RAEsquivelC@Yahoo.com
'A wreath program was created by Jerry Plueard, 501 Northa 143 St., Seattle,
'WA 98133, on August 30, 1981, for the TRS-80, 16K, Color Computer, in BASIC,
'and the author stated it was not copyrighted, and invited its use.
'Because QuickBASIC is not compatible with many of the statements used in the
'original program, I, Ralph A. Esquivel, email
RAEsquivelC@Yahoo.com,
'decided to take the main idea, and came up with this new program, which, I hope, you will like.
'The program consists of five parts:
'PART1: The song to sing
'PART2: The musical part (I don't know how to implement music for Windows XP)
'PART3: Draw the wreath
'PART4: Print a Christmas greeting
'PART5: Draw the candle and the flickering flame
'============================================================================
SCREEN 12
CLS
X = 638: Y = 478' actually, X = 639, and Y = 479, for SCREEN 12
'''I like to use the color names as the constants, as:
black = 0: blue = 1: green = 2: cyan = 3: red = 4: magenta = 5: brown = 6
white = 7
grey = black + 8: bblue = blue + 8: BGREEN = green + 8: bcyan = cyan + 8
BRED = red + 8: bmagenta = magenta + 8: YELLOW = brown + 8: BWHITE = white + 8
'''constants
DIM PI AS SINGLE
DIM c AS SINGLE
DIM S AS SINGLE
DIM StartP AS SINGLE
DIM EndP AS SINGLE
CLS
'----------------------------------------------------------------------------
CLS
PART1: 'song to sing
'print song to sing's title, inside a red- and green-star rectangle
A$ = "JOY TO THE WORLD": GOSUB GreenRed
'announce singing is to start
COLOR BWHITE
PRINT
A$ = " We will now sing, JOY TO THE WORLD:": GOSUB CENTER
SLEEP 3
'print the song, one line at a time, and allow time to sing it
COLOR BGREEN
R = 9 'R = row
A$ = "JOY TO THE WORLD,": GOSUB Timing:
A$ = "THE LORD IS COME": GOSUB Timing:
A$ = "LET EARTH, RECEIVE HER KING": GOSUB Timing:
A$ = "LET EVERY HEART,": GOSUB Timing:
A$ = "PREPARE HIM ROOM,": GOSUB Timing:
A$ = "AND HEAVEN AND NATURE SING,": GOSUB Timing:
PRINT
A$ = "AND HEAVEN AND NATURE SING,": GOSUB Timing:
PRINT
A$ = "AND HEAVEN, AND HEAVEN AND NATURE SING": GOSUB Timing:
SLEEP 3
LOCATE 28
COLOR BWHITE
SLEEP 3
'last line of PART 1
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
PART2: 'The musical part
'I don't know how to implement this musical part, so:
GOTO PART3:
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
PART3: 'Draw the wreath
CLS
'colors selected for wreath:
CO = YELLOW 'used for frame
c1 = YELLOW 'used for 1st time drawing of outer circles & partial circles
C2 = green 'used for rings (2nd drawing of outer rings, 1st of smaller rings)
c3 = red + 8 'used for 2nd time drawing of inner circles
'--------------------
'constants for wreath
PI = 3.14159
LR = 5 * Y / 16'radius to draw the circles on
Rp = 5 * LR / 16'radius for partial, outer circles
Ro = 5 * LR / 16'radius for outer circles
Rs = Ro - 10 'radius for smaller, inner circles
'--------------------------
'frame
u = 4 'frame thickness
LINE (u, u)-(X - u, Y - u), CO, B 'outer frame
LINE (2 * u, 2 * u)-(X - 2 * u, Y - 2 * u), CO, B 'inner frame
PAINT (X / 2, u + 1), CO
LINE (X / 2 - u / 2, 2 * u)-(X / 2 + u / 2, Y / 2 - LR - Ro), CO, BF 'hanger
CIRCLE (X / 2, 5), 5, CO
PAINT (X / 2, 5 - 4), CO
PAINT (X / 2, 5 - 1), CO
PAINT (X / 2, 5 + 1), CO
'-----------------------------
OUTER:
'draw outer circles in c1
FOR I = 1 TO 12 'draw 12 circles with 30ø separation
c = COS(I * PI / 6): S = SIN(I * PI / 6)
Xo = X / 2 + (LR) * c
Yo = Y / 2 - (LR) * S
CIRCLE (Xo, Yo), Ro, c1
NEXT I
'-------------------------------
PARTIAL:
'draw outer partial circles in c1
'circle center = Xp,Yp
FOR I = 1 TO 12'draw 12 partial circles with 30ø separation
c = COS((2 * I - 1) * PI / 12): S = SIN((2 * I - 1) * PI / 12)
Xp = X / 2 + .93 * LR * c
Yp = Y / 2 - .93 * LR * S
StartP = (I - 1) * PI / 6: EndP = StartP + PI / 6
CIRCLE (Xp, Yp), Rp, c1, StartP, EndP
'calculate x, y for point in outer area of partical circle
XL = Xp + (Rp - 5) * c
YL = Yp - (Rp - 5) * S
PAINT (XL, YL), c1
NEXT I
'--------------------------------------------------------
'c2 - draw small outer and inner circles (ring) and paint
RING:
d = 5
FOR I = 1 TO 12 'draw 12 CIRCLES
c = COS(I * PI / 6): S = SIN(I * PI / 6)
Xo = X / 2 + (LR) * c
Yo = Y / 2 - (LR) * S
CIRCLE (Xo, Yo), Ro, C2 'larger, outer circle
CIRCLE (Xo, Yo), Rs, C2 'smaller, inner circle
'TOP & BOTTOM
XL = Xo + (Ro - d) * c
YL = Yo - (Ro - d) * S
'CIRCLE (XL, YL), 3,green+8
PAINT (XL, YL), C2
XL = Xo - (Ro - d) * c
YL = Yo + (Ro - d) * S
'CIRCLE (XL, YL), 3,YELLOW
PAINT (XL, YL), C2
'RIGHT & LEFT
XL = Xo + (Ro - d) * COS(I * PI / 6 + 11 * PI / 8)
YL = Yo - (Ro - d) * SIN(I * PI / 6 + 11 * PI / 8)
'CIRCLE(XL,YL),3,GREEN+8
PAINT (XL, YL), C2
XL = Xo - (Ro - d) * COS(I * PI / 6 - 3 * PI / 8)
YL = Yo + (Ro - d) * SIN(I * PI / 6 - 3 * PI / 8)
'CIRCLE(XL,YL),3,yellow
PAINT (XL, YL), C2
'NOT USED:
'BOTTOM-RIGHT & BOTTOM-LEFT
XL = Xo - (Ro - d) * COS(I * PI / 6 + PI / 6)
YL = Yo + (Ro - d) * SIN(I * PI / 6 + PI / 6)
'CIRCLE(XL,YL),3,green+8
'PAINT (XL, YL), C2
XL = Xo - (Ro - d) * COS(I * PI / 6 - PI / 6)
YL = Yo + (Ro - d) * SIN(I * PI / 6 - PI / 6)
'CIRCLE(XL,YL),3,YELLOW
'PAINT (XL, YL), C2
NEXT I
'------------------------------------
'c3 - paint interior of small circles
FOR I = 1 TO 12 'draw 12 CIRCLES
c = COS(I * PI / 6): S = SIN(I * PI / 6)
Xs = X / 2 + (LR) * c
YS = Y / 2 - (LR) * S
CIRCLE (Xs, YS), Rs, c3 'smaller, inner circle
XL = Xs
YL = YS
'CIRCLE (XL, YL), 3, RED+8
PAINT (XL, YL), c3
NEXT I
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
PART4: 'Print a Christmas greeting
COLOR green + 8
A = 11 '11th line
B = 41 '41st column
A$ = RIGHT$(DATE$, 4) + " - " + STR$(VAL(RIGHT$(DATE$, 4)) + 1)
LOCATE A, B - LEN(A$) / 2
PRINT A$
A$ = "MERRY CHRISTMAS"
LOCATE A + 1, B - LEN(A$) / 2
PRINT A$
A$ = " AND A HAPPY NEW YEAR!"
LOCATE A + 2, B - LEN(A$) / 2
PRINT A$
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
PART5: 'Draw the candle
'brown candle holder
c = 6 'brown
dy = 102
LINE (X / 2 - 30, Y / 2 + dy)-(X / 2 + 30, Y / 2 + dy), c
LINE -(X / 2 + 36, Y / 2 + dy - 8), c
LINE -(X / 2 - 36, Y / 2 + dy - 8), c
LINE -(X / 2 - 30, Y / 2 + dy), c
PAINT (X / 2, Y / 2 + dy - 1), c
'white body of candle
W = 30'50'18
740 LINE (X / 2 - W / 2, Y / 2 + dy - 8)-(X / 2 + W / 2, Y / 2 + dy - 90), 15, BF
750 PAINT (X / 2, Y / 2 + dy - 9), 15
'wick
dy = 102 - 90
794 LINE (X / 2 - 1, Y / 2 + dy)-(X / 2, Y / 2 + dy - 7), 7, BF
'candle flame
dy = dy - 4
FLAME:
B = INT(RND * 12)
IF B <= 10 THEN c = red + 8 ELSE c = YELLOW
LINE (X / 2, Y / 2 + dy)-(X / 2 + 4, Y / 2 + dy - 3), c
LINE -(X / 2, Y / 2 + dy - 25), c
LINE -(X / 2 - 5, Y / 2 + dy - 3), c
LINE -(X / 2, Y / 2 + dy), c
PAINT (X / 2, Y / 2 + dy - 10), c
GOTO FLAME:
END
'***************************************************************************
'SUBROUTINES:
GreenRed:
L = 18
'top
LOCATE 3, 39 - L
FOR I = 1 TO L / 2
COLOR BRED: PRINT "* ";
COLOR BGREEN: PRINT "* ";
NEXT I
COLOR BRED: PRINT "*"
'in between
LOCATE 4, 39 - L: COLOR BGREEN: PRINT "*"; SPC(2 * L - 1); "*"
LOCATE 5, 39 - L
COLOR BRED: PRINT "*"; SPC(L - LEN(A$) / 2 - 1);
COLOR YELLOW: PRINT A$; SPC(L - LEN(A$) / 2);
COLOR BRED: PRINT "*"
LOCATE 6, 39 - L: COLOR BGREEN: PRINT "*"; SPC(2 * L - 1); "*"
'BOTTOM
LOCATE 7, 39 - L
FOR I = 1 TO L / 2
COLOR BRED: PRINT "* ";
COLOR BGREEN: PRINT "* ";
NEXT I
COLOR BRED: PRINT "*"
SLEEP 4
RETURN
Timing:
R = R + 2
LOCATE R, 39 - LEN(A$) / 2
PRINT A$
SLEEP 1.7
RETURN
CENTER: 'centers the text A$
PRINT SPC(38 - LEN(A$) / 2); A$
RETURN
LOCATING: 'Ycv = 480/2 = 240
YY1 = (Y + 1) / 100
YY2 = (Y + 1) * 50 / 100
YS = (Y + 1) * 49 / 100
FOR IL = YY1 TO YY2 STEP YS
CIRCLE (XL, YL), IL, white + 8
NEXT IL
RETURN
Ralph, using QuickBASIC 4.5 and Windows XP Home Edition and Service Pack 2, with HP LaserJet 4L printer.