Keyboard of the TRS-80 Color Computer 3.

Merry Christmas my fellow CocoNuts!

Introduction

I wanted to express my Christmas wishes to the Coco community, so I made this short program. Below is the video of the output.

The Listing

Nothing like a Basic listing to type in, just like the old Rainbow days... So here it is.

10 'XMAS TO ALL COCONUTS 2017

20 CLS0

30 RGB

40 'SET PALETTE COLORS

50 FORX=0TO14

60 READ Y

70 PALETTEX,Y

80 NEXTX

90 HSCREEN2

100 POKE65497,0

110 'DRAW

120 HCLS0

130 HCOLOR1,0 'SET BLACK

140 GOSUB 1540 'DRAW STAR

150 HCOLOR3,0 'SET DARK GREEN

160 GOSUB 1600 'DRAW TREE

170 HCOLOR3,0 'SET DARK GREEN

180 GOSUB 1820 'DRAW TREE TRUNK

190 HCOLOR3,0 'SET DARK GREEN

200 GOSUB 1860 'DRAW RIBBON

210 GOSUB 1980 'PAINT TREE

220 GOSUB 2120 'PAINT RIBBON

230 'DRAW BAUBLE 1

240 A=203:B=39:C=3:GOSUB2190

250 B=44:D=10:GOSUB2260

260 'DRAW BAUBLE 2

270 A=241:B=39:GOSUB2190

280 B=44:D=10:GOSUB2260

290 'DRAW BAUBLE 3

300 A=219:B=35:GOSUB2190

310 B=41:D=11:GOSUB2260

320 'DRAW BAUBLE 4

330 A=226:B=35:GOSUB2190

340 B=41:D=11:GOSUB2260

350 'DRAW BAUBLE 5

360 A=216:B=52:GOSUB2190

370 B=58:D=10:GOSUB2260

380 'DRAW BAUBLE 6

390 A=224:B=51:GOSUB2190

400 B=57:D=11:GOSUB2260

410 'DRAW BAUBLE 7

420 A=183:B=80:GOSUB2190

430 B=85:D=12:GOSUB2260

440 'DRAW BAUBLE 7

450 A=261:B=81:GOSUB2190

460 B=86:D=12:GOSUB2260

470 'DRAW BAUBLE 8

480 A=199:B=77:GOSUB2190

490 B=83:D=13:GOSUB2260

500 'DRAW BAUBLE 9

510 A=211:B=74:GOSUB2190

520 B=80:D=10:GOSUB2260

530 'DRAW BAUBLE 10

540 A=225:B=72:GOSUB2190

550 B=78:D=11:GOSUB2260

560 'DRAW BAUBLE 11

570 A=237:B=75:GOSUB2190

580 B=81:D=12:GOSUB2260

590 'DRAW BAUBLE 12

600 A=158:B=117:GOSUB2190

610 B=122:D=10:GOSUB2260

620 'DRAW BAUBLE 13

630 A=174:B=113:GOSUB2190

640 B=119:D=11:GOSUB2260

650 'DRAW BAUBLE 14

660 A=198:B=107:GOSUB2190

670 B=113:D=12:GOSUB2260

680 'DRAW BAUBLE 15

690 A=214:B=103:GOSUB2190

700 B=108:D=13:GOSUB2260

710 'DRAW BAUBLE 16

720 A=234:B=103:GOSUB2190

730 B=108:D=10:GOSUB2260

740 'DRAW BAUBLE 17

750 A=254:B=109:GOSUB2190

760 B=114:D=11:GOSUB2260

770 'DRAW BAUBLE 18

780 A=265:B=112:GOSUB2190

790 B=117:D=12:GOSUB2260

800 'DRAW BAUBLE 19

810 A=286:B=117:GOSUB2190

820 B=122:D=13:GOSUB2260

830 'DRAW BAUBLE 20

840 A=125:B=161:GOSUB2190

850 B=166:D=10:GOSUB2260

860 'DRAW BAUBLE 21

870 A=148:B=156:GOSUB2190

880 B=161:D=11:GOSUB2260

890 'DRAW BAUBLE 22

900 A=160:B=154:GOSUB2190

910 B=159:D=12:GOSUB2260

920 'DRAW BAUBLE 23

930 A=175:B=150:GOSUB2190

940 B=155:D=13:GOSUB2260

950 'DRAW BAUBLE 24

960 A=190:B=147:GOSUB2190

970 B=152:D=10:GOSUB2260

980 'DRAW BAUBLE 25

990 A=205:B=144:GOSUB2190

1000 B=149:D=11:GOSUB2260

1010 'DRAW BAUBLE 26

1020 A=239:B=144:GOSUB2190

1030 B=149:D=12:GOSUB2260

1040 'DRAW BAUBLE 27

1050 A=254:B=147:GOSUB2190

1060 B=152:D=13:GOSUB2260

1070 'DRAWBAUBLE 28

1080 A=269:B=150:GOSUB2190

1090 B=155:D=10:GOSUB2260

1100 'DRAW BAUBLE 29

1110 A=284:B=153:GOSUB2190

1120 B=158:D=11:GOSUB2260

1130 'DRAWBAUBLE 30

1140 A=299:B=156:GOSUB2190

1150 B=161:D=12:GOSUB2260

1160 'DRAW BAUBLE 31

1170 A=314:B=160:GOSUB2190

1180 B=165:D=13:GOSUB2260

1190 'PRINT TEXT

1200 HCOLOR7,0:HPRINT(8,1),"MERRY"

1210 HCOLOR8,0:HPRINT(6,3),"CHRISTMAS"

1220 HCOLOR9,0:HPRINT(2,5),"TO ALL COCONUTS!"

1230 HCOLOR14,0:HPRINT(8,7),"2017"

1240 'START PALETTE SWITCHING

1250 F=9:S=54

1260 A=RND(64)-1

1270 B=RND(64)-1

1280 C=RND(64)-1

1290 D=RND(64)-1

1300 A$=INKEY$

1310 IFA$<>""THEN1500

1320 PALETTE10,A

1330 PALETTE11,B

1340 PALETTE12,C

1350 PALETTE13,D

1360 E=RND(4)

1370 IF E=1 THEN GOSUB 1440

1380 IF E=2 THEN GOSUB 1470

1390 PALETTE7,A

1400 PALETTE8,B

1410 PALETTE9,C

1420 PALETTE14,D

1430 GOTO 1260

1440 IF F=9 THEN F=11 ELSE F=9

1450 PALETTE5,F

1460 RETURN

1470 IF S=54 THEN S=7 ELSE S=54

1480 PALETTE 2,S

1490 RETURN

1500 'QUIT SHOW

1510 POKE65496,0

1520 RGB:CLS

1530 END

1540 'DRAW STAR

1550 HDRAW"BM222,2"

1560 HDRAW"G1;D2;G1;D2"

1570 HDRAW"G1;L1;H1;L3;D1;F5;G5;D1;R3;E1;R2;E2;F2;R2;F1;R3;U1;H5;E5;U1;L3;G1;L1;H1;U2;H1;U2"

1580 HPAINT(222,5),2,1

1590 RETURN

1600 'DRAW TREE

1610 HLINE(222,19)-(241,38),PSET

1620 HLINE-(222,33),PSET

1630 HLINE-(203,38),PSET

1640 HLINE-(222,19),PSET

1650 HLINE(216,36)-(196,56),PSET

1660 HLINE-(222,49),PSET

1670 HLINE-(248,56),PSET

1680 HLINE-(228,36),PSET

1690 HLINE(209,54)-(183,80),PSET

1700 HLINE-(222,70),PSET

1710 HLINE-(261,80),PSET

1720 HLINE-(235,54),PSET

1730 HLINE(196,78)-(158,116),PSET

1740 HLINE-(222,100),PSET

1750 HLINE-(286,116),PSET

1760 HLINE-(248,78),PSET

1770 HLINE(171,114)-(125,160),PSET

1780 HLINE-(222,140),PSET

1790 HLINE-(319,160),PSET

1800 HLINE-(273,114),PSET

1810 RETURN

1820 'DRAW TREE TRUNK

1830 HLINE(214,143)-(214,191),PSET

1840 HLINE(230,143)-(230,191),PSET

1850 RETURN

1860 'DRAW RIBBON

1870 HLINE(213,28)-(229,26),PSET

1880 HLINE(209,32)-(232,29),PSET

1890 HLINE(205,47)-(238,46),PSET

1900 HLINE(202,50)-(241,49),PSET

1910 HLINE(198,65)-(243,62),PSET

1920 HLINE(195,68)-(246,65),PSET

1930 HLINE(181,93)-(255,85),PSET

1940 HLINE(178,96)-(258,88),PSET

1950 HLINE(146,139)-(284,125),PSET

1960 HLINE(143,142)-(287,128),PSET

1970 RETURN

1980 'PAINT TREE - YELLOW INSIDE DARK GREEN

1990 HPAINT(222,24),4,3

2000 HPAINT(230,33),4,3

2010 HPAINT(222,36),4,3

2020 HPAINT(203,52),4,3

2030 HPAINT(238,51),4,3

2040 HPAINT(222,53),4,3

2050 HPAINT(222,68),4,3

2060 HPAINT(222,73),4,3

2070 HPAINT(222,95),4,3

2080 HPAINT(222,115),4,3

2090 HPAINT(222,137),4,3

2100 HPAINT(222,153),6,3

2110 RETURN

2120 'PAINT RIBBON - BLUE INSIDE DARK GREEN

2130 HPAINT(222,29),5,3

2140 HPAINT(222,48),5,3

2150 HPAINT(222,65),5,3

2160 HPAINT(222,90),5,3

2170 HPAINT(222,133),5,3

2180 RETURN

2190 'DRAW BAUBLES

2200 B$=RIGHT$(STR$(A),LEN(STR$(A))-1):C$=RIGHT$(STR$(B),LEN(STR$(B))-1)

2210 A$="BM"+B$+","+C$+";"

2220 IF C>0 THEN A$=A$+"C"+STR$(C)+";"

2230 HDRAW A$

2240 HDRAW"D3;L1;G2;D1;F2;R2;E2;U1;H2;L1"

2250 RETURN

2260 'PAINT BAUBLES

2270 HPAINT(A,B),D,C

2280 RETURN

2290 DATA 0,0,54,2,16,9,6,44,23,31,36,15,38,54,63

Download

Download the DSK file inside XMAS-CC3.zip.

Created on Sunday 24 December 2017.