[comp.sys.ibm.pc] Holiday entertainment part two

wtm@neoucom.UUCP (Bill Mayhew) (12/23/87)

Following is a bit of lighter hearted stuff for use with BASICA or
GWBASIC.  Please note that a CGA display and approximately 128K of
memory is required for optimum performance.  Note that I didn't
write this.  Attribution is given at the end of the program source.

Download this to your P.C. and name it tree3.bas.  Part one will
follow shortly.  Save part one to your P.C. and name it tree.bas.
Invoke with "GWBASIC TREE".  Tree.bas chains tree3.bas.

--Bill

-------- cut here --------
5 CLEAR ,,8192 :DEFINT A-Z :PLAY "MB" :GOSUB 19900
1090 READ S,O :IF S=32767 THEN GOTO 4990
1100 READ N,D :IF N=-1 THEN GOSUB 22320 :GOTO 1090
1110 IF MUS.ON THEN SOUND F!(N+O),D :SOUND 32767,S
1115 '*** SNOW ***                                                                   '
1117 GET (280,31)-(309,99),S
1119 PUT (280,31),S,XOR
1120 PUT (280,31),S,XOR
1122 PUT (280,31),S,XOR
1124 PUT (280,32),S,XOR
1125 PSET (RND*27+280,31),3
1126 '*** MOVE FIRE ***                                                              '
1127 FIRE=FIRE+1 :IF FIRE>4 THEN FIRE=1
1128 ON FIRE GOTO 1129,1130,1131,1132
1129 PUT(22,100),FIRE1,PSET :GOTO 1135
1130 PUT(26,100),FIRE2,PSET :GOTO 1135
1131 PUT(26,100),FIRE1,PSET :GOTO 1135
1132 PUT(22,100),FIRE2,PSET
1135 EVENT=EVENT+1 :IF EVENT>MAXEVENT THEN EVENT=1'*** SELECT EVENT ***
1140 ON EVENT GOTO 1900,1400,1500,1900,1300,1400,1900,1900
1300 '*** MOVE STAR AND BIRDS ***                                                    '
1302 STAR=1-STAR :IF STAR THEN PUT(188,0),STAR1,PSET :PUT(276,17),BIRD1,PSET         ELSE PUT(188,0),STAR2,PSET :PUT(276,17),BIRD2,PSET
1304 GOTO 1100
1400 '*** MOVE CLOCK ***                                                             '
1401 IF MUS.ON=0 THEN 1402  'This line used to end "MOTOR"
1402 CLOCK=CLOCK+1 :IF CLOCK>4 THEN CLOCK=1
1405 ON CLOCK GOTO 1410,1415,1420,1425
1410 PUT(104,88),CLOCK1,PSET :GOTO 1100
1415 PUT(104,88),CLOCK2,PSET :GOTO 1100
1420 PUT(104,88),CLOCK3,PSET :GOTO 1100
1425 PUT(104,88),CLOCK2,PSET :GOTO 1100
1500 '*** PAINT CANDLES ***                                                          '
1502 PAINT(19,41),CANDLE,0
1504 CANDLE=-((CANDLE=2)*3+(CANDLE=3)*2)
1506 PAINT(53,41),CANDLE,0
1508 GOTO 1100
1900 '*** BLINK LIGHTS ***
1901 LIT=1-LIT :IF LIT THEN GOTO 1910
1902 L=L+1 :IF L>30 THEN L=0
1905 CIRCLE(LX(L),LY(L)),2,1 :PSET(LX(L),LY(L)),1 :GOTO 1100
1910 CIRCLE(LX(L),LY(L)),2,0 :PSET(LX(L),LY(L)),RND*4 :GOTO 1100
4990 IF MUS.ON THEN GOSUB 22110 :GOSUB 22110 :MUS.ON=0
4992 RESTORE 5000 :GOTO 1090
5000 DATA 1,12 :'O TANNENBAUM                                                                   '
5001 DATA 39,8,44,6,44,2,44,8,46,8,48,6,48,2,48,12,48,4
5002 DATA 46,4,48,4,49,8,43,8,46,8,44,12
5003 DATA 39,8,44,6,44,2,44,8,46,8,48,6,48,2,48,12,48,4
5004 DATA 46,4,48,4,49,8,43,8,46,8,44,12
5005 DATA -12,4,51,4,51,4,48,4,53,10,51,4,51,4,49,4,49,10,49,4
5006 DATA 49,4,46,4,51,10,49,4,49,4,48,4,48,8,39,8
5007 DATA 44,6,44,2,44,8,46,8,48,6,48,2,48,12
5008 DATA 48,4,46,4,48,4,49,8,43,8,46,8,44,16
5009 DATA -12,14,-1,-1
5010 DATA 1,12 :'HARK THE HAROLD ANGELS SING                                                    '
5011 DATA 40,4,45,4,45,5,44,2,45,4,49,4,49,4,47,4
5012 DATA 52,4,52,4,52,5,50,2,49,4,47,4,49,8
5013 DATA 40,4,45,4,45,5,44,2,45,4,49,4,49,4,47,4
5014 DATA 52,4,47,4,47,4,44,4,44,4,42,4,40,8
5015 DATA 52,4,52,4,52,4,45,4,50,4,49,4,49,4,47,4
5016 DATA 52,4,52,4,52,4,45,4,50,4,49,4,49,4,47,4
5017 DATA 54,4,54,4,54,4,52,4,50,4,49,4,50,8
5018 DATA 47,4,49,1,50,1,52,5,45,2,45,4,47,4,49,9
5019 DATA 54,4,54,4,54,4,52,4,50,4,49,4,50,8
5020 DATA 47,4,49,1,50,1,52,5,45,2,45,4,47,4,45,10
5021 DATA -12,14,-1,-1
5022 DATA 1,12 :'DECK THE HALLS                                                                 '
5023 DATA 52,5,50,2,49,4,47,4,45,4,47,4,49,4,45,4
5024 DATA 47,2,49,2,50,2,47,2,49,5,47,2,45,4,44,4,45,10
5025 DATA 52,5,50,2,49,4,47,4,45,4,47,4,49,4,45,4
5026 DATA 47,2,49,2,50,2,47,2,49,5,47,2,45,4,44,4,45,10
5027 DATA 47,5,49,2,50,4,47,4,49,5,50,2,52,4,47,4
5028 DATA 49,2,51,2,52,4,54,2,56,2,57,4,56,4,54,4,52,10
5029 DATA 52,5,50,2,49,4,47,4,45,4,47,4,49,4,45,4
5030 DATA 54,2,54,2,54,2,54,2,52,5,50,2,49,4,47,4,45,10
5039 DATA -12,14,-1,-1
5040 DATA 1,-24 :'UP ON THE HOUSE-TOP                                                            '
5041 DATA 52,4,52,2,54,2,52,4,49,2,47,2,45,4,49,4,52,8
5042 DATA 54,4,54,4,52,4,49,4,47,4,52,4,52,8
5043 DATA 52,4,52,2,54,2,52,4,49,2,47,2,45,4,49,4,52,8
5044 DATA 54,4,54,2,54,2,52,2,52,2,49,4,47,4,52,4,45,8
5045 DATA 50,4,50,4,54,8,52,4,52,2,52,2,49,8
5046 DATA 47,4,50,4,50,8,49,4,52,2,52,2,45,4,49,4
5047 DATA 52,4,52,2,54,2,52,4,49,4,50,4,52,4,54,8
5048 DATA 52,4,52,2,54,2,52,2,52,2,49,4,47,4,52,4,45,10
5049 DATA 24,14,-1,-1
5050 DATA 1,-12 :'IT CAME UPON THE MIDNIGHT CLEAR                                                '
5051 DATA 47,4,56,8,54,4,54,4,52,4,49,4,47,8,49,4,47,8
5052 DATA 47,4,49,4,51,4,52,4,52,4,54,4,56,4,54,20
5053 DATA 47,4,56,8,51,4,54,4,52,4,49,4,47,8,49,4,47,8
5054 DATA 47,4,49,8,49,4,51,4,49,4,47,4,52,20
5055 DATA 56,4,56,8,44,4,44,4,46,4,48,4,49,8,51,4,52,8
5056 DATA 56,4,54,4,52,4,51,4,49,4,51,4,49,4,47,20
5057 DATA 47,4,56,8,51,4,54,4,52,4,49,4,47,8,49,4,47,8
5058 DATA 47,4,49,8,49,4,51,4,49,4,47,4,52,20
5059 DATA 12,14,-1,-1
5060 DATA 1,0 :'AWAY IN A MANGER (JACK NELSON)                                                 '
5061 DATA 40,4,45,4,45,4,49,2,47,2,45,4,45,4,40,4,42,4,45,4,42,4,40,8
5062 DATA 40,4,45,4,45,4,47,4,49,4,49,4,52,4,52,4,49,4,45,4,47,8
5063 DATA 40,4,45,4,45,4,49,2,47,2,45,4,45,4,40,4,42,4,50,4,42,4,40,8
5064 DATA 40,4,45,4,45,4,47,4,49,4,52,4,50,4,49,4,40,4,44,4,45,8
5065 DATA 44,2,45,2,47,4,47,4,52,4,47,4,47,4,44,4,47,4,45,4,42,4,40,8
5066 DATA 44,2,45,2,47,4,47,4,52,4,47,4,47,4,44,4
5067 DATA 45,2,44,2,45,2,47,2,49,2,51,2,52,8
5068 DATA 54,4,52,4,49,4,49,2,47,2,45,4,45,4,40,4,42,4,50,4,42,4,40,8
5069 DATA 40,4,45,4,45,4,47,4,49,4,52,4,50,4,49,4,40,4,44,4,45,8
5070 DATA 0,14,-1,-1
5071 DATA 1,0 :'WHAT CHILD IS THIS?                                                            '
5072 DATA 44,4,47,8,49,4,51,5,52,2,51,4,49,8
5073 DATA 46,4,42,5,44,2,46,4,47,8,44,4,44,5,43,2,44,4,46,12,39,8
5074 DATA 44,4,47,8,49,4,51,5,52,2,51,4,49,8
5075 DATA 46,4,42,5,44,2,46,4,47,5,46,2,44,4,43,5,41,2,43,4,44,12,44,12
5076 DATA 54,12,54,5,52,2,51,4,49,8,46,4,42,5,44,2,46,4,47,8
5077 DATA 44,4,44,5,43,2,44,4,46,8,43,4,39,12
5078 DATA 54,12,54,5,52,2,51,4,49,8,46,4,42,5,44,2,46,4
5079 DATA 47,5,46,2,44,4,43,5,41,2,43,4,44,12,44,8
5080 DATA 44,4,47,8,49,4,51,5,52,2,51,4,49,8
5081 DATA 46,4,42,5,44,2,46,4,47,8,44,4,44,5,43,2,44,4,46,12,39,8
5082 DATA 44,4,47,8,49,4,51,5,52,2,51,4,49,8
5083 DATA 46,4,42,5,44,2,46,4,47,5,46,2,44,4,43,5,41,2,43,4,44,12,44,12
5084 DATA 54,12,54,5,52,2,51,4,49,8,46,4,42,5,44,2,46,4,47,8
5085 DATA 44,4,44,5,43,2,44,4,46,8,43,4,39,12
5086 DATA 54,12,54,5,52,2,51,4,49,8,46,4,42,5,44,2,46,4
5087 DATA 47,5,46,2,44,4,43,5,41,2,43,4,44,12,44,8
5088 DATA 0,14,-1,-1
5089 DATA 1,-12 :'JINGLE BELLS                                                                   '
5090 DATA 40,4,40,4,49,4,47,4,45,4,40,12,40,2,40,2,40,4,49,4,47,4,45,4,42,12
5091 DATA 42,4,42,4,50,4,49,4,47,4,44,12,44,4,52,4,52,4,50,4,47,4,49,12
5092 DATA 40,4,40,4,49,4,47,4,45,4,40,12,40,2,40,2,40,4,49,4,47,4,45,4,42,12
5093 DATA 42,4,42,4,50,4,49,4,47,4,52,4,52,4,52,4,52,4,54,4,52,4,50,4,47,4,45,16
5094 DATA 49,4,49,4,49,8,49,4,49,4,49,8,49,4,52,4,45,4,47,4,49,16
5095 DATA 50,4,50,4,50,4,50,4,50,4,49,4,49,4,49,2,49,2,49,4,47,4,47,4
5096 DATA 49,4,47,8,52,8
5097 DATA 49,4,49,4,49,8,49,4,49,4,49,8,49,4,52,4,45,4,47,4,49,16
5098 DATA 50,4,50,4,50,4,50,4,50,4,49,4,49,4,49,2,49,2,52,4,52,4,50,4,47,4,45,12
5108 DATA 12,14,-1,-1
5109 DATA 1,0:'O LITTLE TOWN OF BETHLEHEM                                                     '
5110 DATA 49,4,49,4,49,4,48,4,49,4,52,4,50,4,42,4
5111 DATA 47,4,45,4,44,2,45,2,47,4,40,4,49,12
5112 DATA 49,4,49,4,49,4,54,4,52,4,52,4,50,4,42,4
5113 DATA 47,4,45,4,44,2,45,2,49,4,47,4,45,12
5114 DATA 49,4,49,4,49,4,47,4,45,4,44,8,44,4,44,4,42,4,44,4,45,4,47,4,49,12
5115 DATA 49,4,49,4,49,4,48,4,49,4,52,4,50,4,42,4
5116 DATA 54,4,52,4,45,4,49,4,47,4,45,12
5117 DATA 49,4,49,4,49,4,48,4,49,4,52,4,50,4,42,4
5118 DATA 47,4,45,4,44,2,45,2,47,4,40,4,49,12
5119 DATA 49,4,49,4,49,4,54,4,52,4,52,4,50,4,42,4
5120 DATA 47,4,45,4,44,2,45,2,49,4,47,4,45,12
5121 DATA 49,4,49,4,49,4,47,4,45,4,44,8,44,4,44,4,42,4,44,4,45,4,47,4,49,12
5122 DATA 49,4,49,4,49,4,48,4,49,4,52,4,50,4,42,4
5123 DATA 54,4,52,4,45,4,49,4,47,4,45,12
5124 DATA 49,4,49,4,49,4,47,4,45,4,44,8
5125 DATA 44,4,44,4,42,4,44,4,45,4,47,4,49,12
5126 DATA 49,4,49,4,49,4,48,4,49,4,52,4,50,4,42,4
5127 DATA 54,4,52,4,45,4,49,4,47,4,45,8
5128 DATA 0,14,-1,-1
5129 DATA 1,0:'AWAY IN A MANGER (TRADITIONAL)
5130 DATA 52,4,52,5,50,2,49,4,49,5,47,2,45,4,45,4,44,4,42,4,40,8
5131 DATA 40,4,40,5,42,2,40,4,40,4,47,4,44,4,42,4,40,4,45,4,49,8
5132 DATA 52,4,52,5,50,2,49,4,49,5,47,2,45,4,45,4,44,4,42,4,40,8
5133 DATA 40,4,50,5,49,2,47,4,49,4,47,4,45,4,47,4,42,4,44,4,45,12
5134 DATA 42,4,45,4,50,4,40,4,45,4,49,4,40,4,44,4,47,4,49,12
5135 DATA 42,4,45,4,50,4,40,4,45,4,49,4,40,4,44,4,47,4,45,8
5136 DATA 52,4,52,5,50,2,49,4,49,5,47,2,45,4,45,4,44,4,42,4,40,8
5137 DATA 40,4,40,5,42,2,40,4,40,4,47,4,44,4,42,4,40,4,45,4,49,8
5138 DATA 52,4,52,5,50,2,49,4,49,5,47,2,45,4,45,4,44,4,42,4,40,8
5139 DATA 40,4,50,5,49,2,47,4,49,4,47,4,45,4,47,4,42,4,44,4,45,12
5140 DATA 0,14,-1,-1
5150 DATA 1,0 :'GOD REST YE MERRY GENTLEMEN
5151 DATA 42,4,42,4,49,4,49,4,47,4,45,4,44,4,42,4,40,4
5152 DATA 42,4,44,4,45,4,47,4,49,12
5153 DATA 42,4,42,4,49,4,49,4,47,4,45,4,44,4,42,4,40,4
5154 DATA 42,4,44,4,45,4,47,4,49,12
5155 DATA 49,4,50,4,47,4,49,4,50,4,52,4,54,4,49,4,47,4
5156 DATA 45,4,42,4,44,4,45,4,47,8,45,4,47,4,49,8
5157 DATA 50,4,49,4,49,4,47,4,45,4,44,4,42,8
5158 DATA 45,2,44,2,42,4,47,8
5159 DATA 45,4,47,4,49,4,50,4,52,4,54,4
5160 DATA 49,4,47,4,45,4,44,4,42,10
5161 DATA 0,14,-1,-1
5170 DATA 1,0 :'SILENT NIGHT
5171 DATA 47,11,49,4,47,8,44,24,47,11,49,4,47,8,44,24
5172 DATA 54,16,54,8,51,24,52,16,52,8,47,24
5173 DATA 49,16,49,8,52,11,51,4,49,8,47,11,49,4,47,8,44,24
5174 DATA 49,16,49,8,52,11,51,4,49,8,47,11,49,4,47,8,44,24
5175 DATA 54,16,54,8,57,11,54,4,51,8,52,24,56,24
5176 DATA 52,8,47,8,44,8,47,8,45,8,42,8,40,24
5177 DATA 0,14,-1,-1
5999 DATA 32767,32767
19900 '*** INIT PROGRAM ***
19910 X=0 :L=0 :MUS.ON=1 :EVENT=0 :MAXEVENT=8 :N=0 :D=0 :O=0 :S=0 :CLOCK=3           :CANDLE=2 :FIRE=1 :X1=0 :LIT=0 :STAR=0 :HAND=11
19920 DIM S(278),F!(88),FIRE1(48),FIRE2(48),STAR1(38),STAR2(38),                       CLOCK1(37),CLOCK2(37),CLOCK3(37),LX(30),LY(30),BIRD1(47),BIRD2(47),             HX(11),HY(11)
19924 KEY(9) ON :ON KEY(9) GOSUB 30050
19925 KEY(10) ON :ON KEY(10) GOSUB 30000
19930 '*** INIT MUSICAL NOTES ***
19940 FOR X=0 TO 6 :F!(X)=32767 :NEXT X
19950 FOR X=7 TO 88 :F!(X)=36.8*(2^(1/12))^(X-6) :NEXT X
19960 GOSUB 23000 '*** INIT TREE LIGHTS ***
19970 GOSUB 21000 '*** INIT STAR ***
19972 GOSUB 21200 '*** INIT BIRDS ***
19980 GOSUB 20000 '*** INIT FIRE ***
19982 GOSUB 22300 :GOSUB 22320 '*** INIT CLOCK HANDS ***
19990 GOSUB 22000 '*** INIT CLOCK ***
19992 GOSUB 22100 '*** START CLOCK ***
19994 RESTORE 5000 :RETURN' TO  M A I N                                               '
20000 LINE(22,112)-(26,104),2 '*** INIT FIRE ***
20010 LINE-(30,110),2 :LINE-(33,100),2
20020 LINE-(40,103),2 :LINE-(41,110),2
20030 LINE-(44,102),2 :LINE-(46,112),2
20040 LINE-(22,112),2
20050 PAINT(24,110),3,2
20060 FOR X=1 TO 12 :PSET(RND*28+22,RND*6+100),2 :NEXT X
20070 GET(22,100)-(48,112),FIRE1
20080 PUT(22,100),FIRE1,XOR
20090 LINE(46,112)-(42,104),3
20100 LINE-(38,110),3 :LINE-(35,100),3
20110 LINE-(28,103),3 :LINE-(27,110),3
20120 LINE-(24,102),3 :LINE-(22,112),3
20130 LINE-(46,112),3
20140 PAINT(24,110),2,3
20150 FOR X=1 TO 12 :PSET(RND*28+22,RND*6+100),3 :NEXT X
20160 GET (22,100)-(48,112),FIRE2                                                     '
20170 RETURN
21000 '*** INIT STAR ***
21010 X=2 :GOSUB 21100
21020 PAINT(200,4),3,2
21030 PSET(193,1),3 :PSET(207,1),3
21040 PSET(191,8),3 :PSET(209,8),3
21050 GET(188,0)-(210,11),STAR1 :PUT(188,0),STAR1,XOR
21060 X=3 :GOSUB 21100
21070 PAINT(200,4),2,3
21080 PSET(192,0),2 :PSET(208,0),2
21090 PSET(190,9),2 :PSET(210,9),2
21095 GET(188,0)-(210,11),STAR2 :RETURN
21100 LINE(200,0)-(204,4),X
21110 LINE-(210,4),X :LINE-(205,7),X
21120 LINE-(208,11),X :LINE-(200,8),X
21130 LINE-(192,11),X :LINE-(195,7),X
21140 LINE-(190,4),X :LINE-(196,4),X
21150 LINE-(200,0),X
21160 LINE(201,0)-(205,4),X
21170 LINE(199,0)-(195,4),X
21180 RETURN
21200 '*** INIT BIRDS ***
21210 GET(276,17)-(312,25),BIRD1
21220 LINE(293,20)-(297,20),0 :LINE(279,21)-(282,23),0 :LINE(311,21)-(308,23),0
21222 LINE(278,25)-(282,23),2 :LINE(308,23)-(312,25),2
21224 LINE(294,17)-(292,19),2 :LINE(296,17)-(298,19),2
21226 GET(276,17)-(312,25),BIRD2
21230 RETURN
22000 '*** INIT CLOCK ***
22010 GET(104,88)-(121,101),CLOCK2 :LINE(114,96)-(114,88),0
22020 PAINT(114,99),0,2 :CIRCLE(114,99),2,0
22030 LINE(110,95)-(114,88),3 :CIRCLE(109,98),2,2 :PAINT(109,98),3,2
22040 GET(104,88)-(121,101),CLOCK1
22050 LINE(110,95)-(114,88),0 :PAINT(109,98),0,2 :CIRCLE(109,98),2,0
22060 LINE(118,95)-(114,88),3 :CIRCLE(119,98),2,2 :PAINT(119,98),3,2
22070 GET(104,88)-(121,101),CLOCK3
22080 RETURN
22100 '*** TICK CLOCK ***
22110 FOR X=1 TO 8
22130 FOR X1=1 TO 800 :NEXT X1  'This line used to begin "MOTOR: "
22140 CLOCK=CLOCK+1 :IF CLOCK>4 THEN CLOCK=1
22150 ON CLOCK GOTO 22160,22170,22180,22190
22160 PUT(104,88),CLOCK1,PSET :GOTO 22200
22170 PUT(104,88),CLOCK2,PSET :GOTO 22200
22180 PUT(104,88),CLOCK3,PSET :GOTO 22200
22190 PUT(104,88),CLOCK2,PSET
22200 NEXT X :RETURN
22300 '*** INIT CLOCK HANDS ***
22310 RESTORE 22312
22312 DATA 114,40,119,42,122,44,124,48,122,52,119,54,114,56
22313 DATA 109,54,106,52,104,48,106,44,109,42
22314 FOR X=0 TO 11 :READ HX(X),HY(X) :NEXT X
22318 RETURN
22320 LINE(114,48)-(HX(HAND),HY(HAND)),0'*** REDRAW HANDS ***
22322 HAND=HAND+1 :IF HAND>11 THEN HAND=0
22324 LINE(114,48)-(HX(HAND),HY(HAND)),2
22328 RETURN
23000 '*** INIT TREE LIGHTS ***
23010 RESTORE 23020
23020 DATA 219,91,188,27,205,21,214,44,193,54,210,61,243,64,164,62
23022 DATA 146,78,168,88,189,88,201,100,237,89,270,99,275,114,257,122
23024 DATA 241,111,217,120,189,126,174,114,141,97,118,124,146,121
23026 DATA 172,131,209,139,244,134,244,75,185,39,171,46,224,40,185,66
23050 FOR X=0 TO 30 :READ LX(X),LY(X) :CIRCLE(LX(X),LY(X)),1,RND*2+2                  :CIRCLE(LX(X),LY(X)),2,0 :PSET(LX(X),LY(X)),RND*2+2 :NEXT X :RETURN
30000 '*** TOGGLE MUSIC ON/OFF ***
30010 MUS.ON=1-MUS.ON
30020 IF MUS.ON THEN LINE(114,48)-(HX(HAND),HY(HAND)),0 :HAND=11                      :GOSUB 22320 :GOSUB 22100 :RESTORE 5000 :RETURN 1090
30030 RESTORE :RETURN 1100
30050 CLS :SYSTEM
32770   '       PROGRAM NAME:   TREE3.BAS                                               '       WRITTEN BY:     GREGORY HORNE                                           '       EDIT DATE:      29-NOV-1983