 BASIC Listing | Type in program: Christmas Tree decorations with light + color animation
10 rem chrismtas type-in 2023 #1
20 rem by mms for cmb3.5 on plus/4 & c64 and cbm v7.0 on c128
30 rem setup
32 scnclr:color1,2,7:color4,3,2:color1,11,3:scnclr:char1,16,12,"please wait!"
34 dim ms$(12):restore1800:fora=1to12:reada$:ms$(a)=a$:next
37 dim lg(4):fora=1to4:lg(a)=0:next
40 graphic 3,1:color4,3,2:color0,1:color3,6,2:color2,6,4
50 rem pine branch
51 color1,10,0:
60 for i=0 to 6
70 circle1,90,35+i,100,34,180,250
80 nexti
105 rem pine needles upper
160 for i=0 to 2
170 for j=0 to 4
175 draw 3,10+(j*3)+(i*15),55+j-1+(i*4) to 18+(j*3)+(i*15),20+j-1+(i*4)
180 nextj:next i
181 for i=0 to 2
182 for j=0 to 2
184 rem lighter ones
185 draw 2,15+(j*10)+(i*25),61+j+(i*4) to 24+(j*10)+(i*25),37+j+(i*4)
187 nextj:next i
190 for i=0 to 3
200 for j=0 to 2
210 draw 3,55+(j*3)+(i*10),65+j+i to 63+(j*3)+(i*10),34+j+i
220 nextj:next i
230 rem pine needles below
240 for i=0 to 2
250 for j=0 to 3
260 draw 3,10+(j*3)+(i*12),63+j-1+(i*4) to 15+(j*3)+(i*12),93+j-1+(i*4)
270 nextj:next i
280 for i=0 to 2
290 for j=0 to 4
300 draw 3,45+(j*3)+(i*15),73+i to 51+(j*3)+(i*15),102+i
310 nextj:next i
311 for i=0 to 2
314 for j=0 to 2
318 draw 2,13+(j*10)+(i*25),63+j+(i*4) to 25+(j*10)+(i*25),87+j+(i*4)
319 next j:next i
320 rem pine needles middle
321 for i=0 to 2
322 for j=0 to 4
324 draw 3,10+(j*10)+(i*18),62+j+(i*4) to 36+(j*10)+(i*18),84+j+(i*4)
326 nextj:next i
350 rem pine needles end
352 draw 3,90,70 to 104,45:draw 3,90,71 to 108,48:draw 3,91,71 to 110,54
354 draw 3,91,72 to 110,60:draw 3,91,72 to 112,68:draw 2,93,73 to 105,72
356 draw 3,91,74 to 110,78:draw 3,91,75 to 112,83:draw 2,92,76 to 107,86
358 draw 3,92,77 to 105,92:draw 3,92,78 to 102,97:draw 2,90,75 to 95,91
360 draw 3,89,76 to 98,100
390 rem pendant part1
395 color1,2,3
396 draw1,88,80 to 88,114
400 rem pendant part2 globe
410 color2,5,2:circle2,88,155,20,40,0,360,0,1:paint2,88,160
420 rem pendant part3 hold
430 box1,86,110,90,120,0,1:circle1,88,118,3,1
440 rem pendant part4 reflections
450 color1,2,7:circle1,78,128,3,2,0,360,270:paint1,78,129
460 color1,5,1:circle1,88,155,18,36,95,195:circle1,88,155,17,34,95,195
470 circle1,88,155,15,30,95,195
500 rem lighting part1 line
510 color1,2,3:circle1,45,40,158,101,90,330,285
520 rem lighting part2 yellowlp
530 color2,8,4:circle2,118,123,4,8,0,360:paint2,117,125
540 rem lighting part3 bluelp
550 color2,7,3:circle2,61,182,5,10,0,360:paint2,60,185
560 rem lighting part4 greenlp
570 circle3,146,51,4,8,0,360:paint3,145,50
575 rem lighting part5 orangelp
578 color2,9,3:circle2,22,189,5,10,0,360:paint2,20,190
579 rem light anim
580 rem color1,8,7:char1,29,15," ",1:color1,8,5:char1,25,17," ",1:
590 rem getkey a$:color1,8,4:char1,29,15," ",1:color2,5,2:char2,25,17," ",1
600 rem getkey a$
610 rem color1,7,7:char1,15,22," ",1:color1,7,5:char1,18,20," ",1:
620 rem getkey a$:color1,7,3:char1,15,22," ",1:color2,5,2:char2,18,20," ",1
630 rem getkey a$
800 rem wishing text
810 color1,8,6:for l=1 to 7:color1,9,l:char1,19,1,"mms wishes you:":
825 j=1:for w=1 to 80:nextw:nextl:for l=1 to 7:color1,9,l:char1,17,3,ms$(j)
830 do
840 rn=int(rnd(0)*40)
850 if rn>36 then gosub 1000
860 if rn=1 then m=1:gosub 1100
870 if rn=4 then m=2:gosub 1200
880 if rn=7 then m=3:gosub 1300
890 if rn=11 then m=4:gosub 1400
900 loop
1000 rem removing and showing text
1010 for l=1 to 7:color1,9,8-l:char1,17,3,ms$(j)
1015 for w=1 to 50:next w:nextl:if j=12 then j=1
1020 for l=1 to 8:color1,9,l:char1,17,3,ms$(j+1):j=j+1
1030 return
1100 rem lighting up and remove light1
1110 if lg(1)=0 then lg(1)=1: else lg(1)=0
1120 if lg(1)=1 then color1,8,7:char1,29,15," ",1:color1,8,5:char1,25,17," ",1
1130 if lg(1)=0 then color1,8,4:char1,29,15," ",1:color2,5,2:char2,25,17," ",1
1150 return
1200 rem lighting up and remove light2
1210 if lg(2)=0 then lg(2)=1: else lg(2)=0
1220 if lg(2)=1 then color1,7,7:char1,15,22," ",1:color1,7,5:char1,19,20," ",1
1230 if lg(2)=0 then color1,7,3:char1,15,22," ",1:color2,5,2:char2,19,20," ",1
1250 return
1300 rem lighting up and remove light
1310 if lg(3)=0 then lg(3)=1: else lg(3)=0
1320 if lg(3)=1 then color1,9,7:char1,5,23," ",1:color1,9,5:char1,18,19," ",1
1330 if lg(3)=0 then color1,9,3:char1,5,23," ",1:color2,5,2:char2,18,19," ",1
1350 return
1400 rem lighting up and remove light
1410 if lg(4)=0 then lg(4)=1: else lg(4)=0
1420 if lg(4)=1 then color1,6,7:char1,36,6," ",1:color1,6,4:char1,23,15," ",1
1430 if lg(4)=0 then char3,36,6," ",1:color2,5,2:char2,23,15," ",1
1450 return
1800 data" merry christmas! "," vesele vanoce! "," hauskaa joulua! "
1805 data" god jul! ","vrolijk kerstfeest!"
1810 data" frohe weihnachten! "," buon natale! "," boldog karacsonyt! "
1815 data" joyeux noel! "," s rozhdestvom! ",
1820 data" hyvaa joulua! ","kala christougenna!"
2000 rem program ends
2010 graphic 0,1:char1,16,12,"goodbye!"
2020 end
|
|
