Qbasicnews.com
October 17, 2018, 07:08:12 PM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: Merry Christmas!  (Read 7294 times)
Ralph
Ancient Guru
****
Posts: 544


« on: December 17, 2006, 10:31:51 PM »

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
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
Logged

Ralph, using QuickBASIC 4.5 and Windows XP Home Edition and Service Pack 2, with HP LaserJet 4L printer.
zoasterboy
Guru
**
Posts: 295


Personal Text!


WWW
« Reply #1 on: December 21, 2006, 01:52:20 AM »

Nice.  Mind if I send it to some of my pals?
Logged

-yah
Ralph
Ancient Guru
****
Posts: 544


« Reply #2 on: December 21, 2006, 06:01:38 PM »

Glad you liked it.  Of course you may use these programs as you like, I posted them here for that reason, to enjoy.

But, were you able to run the original one, and hear the music?  I never have been able to! Sad
Logged

Ralph, using QuickBASIC 4.5 and Windows XP Home Edition and Service Pack 2, with HP LaserJet 4L printer.
zoasterboy
Guru
**
Posts: 295


Personal Text!


WWW
« Reply #3 on: December 22, 2006, 01:52:55 PM »

Nah I couldnt. It sucks.
Logged

-yah
Jerry Plueard
New Member

Posts: 1


« Reply #4 on: June 11, 2009, 11:53:58 PM »

I just thought someone would like to know the author of the original program written for Radio Shack's color computer is still around but I haven't done any programing after the color computer became obsolete.

I am now a Great-Grandpa 74 and still like to spend time on line.
Logged
Dav
Administrator
Ancient Guru
*****
Posts: 709



WWW
« Reply #5 on: June 12, 2009, 09:53:52 AM »

That's awesome, Jerry!  Thanks for stopping by and letting us know that you're still around. 

- Dav
Logged

Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!