home *** CD-ROM | disk | FTP | other *** search
/ Audio 4.94 - Over 11,000 Files / audio-11000.iso / msdos / music / song / song.arc / BIRDSONG.BAS next >
BASIC Source File  |  1987-03-17  |  20KB  |  443 lines
  1. 1 '**** BIRDSOND.BAS **** Program to play bird's songs
  2. 2 '****
  3. 3 KEY OFF: SCREEN 0: WIDTH 80: KEY(8) ON: ON KEY(8) GOSUB 65000
  4. 4 DEF SEG = 0: IF (PEEK(&H410) AND &H30) <> &H30 THEN GRAPH.ICS=1
  5. 5 IF GRAPH.ICS THEN FC=3: BC=4 ELSE FC=7
  6. 10 '**
  7. 11 '(C) Copyright 1984 SCOTT CAMAZINE & P. KIRK VISSCHER
  8. 12 KEY OFF: CLS: SCREEN 0                   'set up screen
  9. 15 LOCATE ,,0                               'turn off blinking cursor
  10. 30 ON ERROR GOTO 62000                      'error trapping routine
  11. 50 GOSUB 60000                              'introduction
  12. 95 DIM A(640)                               'array to hold plotted points
  13. 97 DIM B%(640)                              'array to hold frequencies
  14. 102 CLS
  15. 104 DEF SEG = 0: IF (PEEK(&H410) AND &H30) <> &H30 THEN GRAPH.ICS=1
  16. 108 GOSUB 41000                             'option to get a song from a file
  17. 109 CLS
  18. 110 IF GRAPH.ICS <>1 THEN CLS: LOCATE 10,10,0: PRINT "You need graphics to create a song.": LOCATE 14,10: PRINT "Press any key to continue."; ELSE GOTO 118
  19. 111 IF INKEY$="" THEN 111 ELSE GOTO 102
  20. 118 LOCATE 12,15:PRINT "Initializing; please wait";
  21. 120 FOR I = 1 TO 640: B%(I)=&HFFFF: IF I MOD 32 = 0 THEN PRINT "-";
  22. 121 NEXT I                                  'initialize at inaudible
  23. 122 IF GRAPH.ICS THEN GOSUB 6000            'set up graphics screen grid
  24. 172 KEY (10) ON
  25. 185 ON KEY(10) GOSUB 3000                   'play sound
  26. 190 FREQ.SCALE.FACTOR = 40
  27. 195 CX = 20: CY = 185                       'initialize cursor position
  28. 196 DRAWFLAG = 0                            'cursor drawing routine toggle
  29. 197 FLAG = 0                                'flag = 1 for playing a file
  30. 198 YINCREMENT = -1                         'cursor drawing frequency increment
  31. 199 RADIUS = 1                              'radius of circle drawn
  32. 202 '
  33. 500 '--------------- setup for cursor routines
  34. 501 '
  35. 504 KEY(5) ON
  36. 505 KEY(9) ON
  37. 510 FOR I = 11 TO 14: KEY (I) ON: NEXT I
  38. 512 ON KEY(5)  GOSUB 2500                    'toggle drawing off/on
  39. 515 ON KEY(9)  GOSUB 4000                    'redraw the graph
  40. 520 ON KEY(11) GOSUB 2100                    'cursor up
  41. 522 ON KEY(14) GOSUB 2200                    'cursor down
  42. 524 ON KEY(13) GOSUB 2300                    'cursor right
  43. 526 ON KEY(12) GOSUB 2400                    'cursor left
  44. 540 '
  45. 2000 '** CURSOR KEY SUBROUTINE FOR DATA ENTRY
  46. 2001 '
  47. 2010 IF CX =< 15 THEN CX = 15              'trap out of range
  48. 2015 IF CX >= 640  THEN CX = 640
  49. 2020 IF CY =< 10 THEN CY = 10
  50. 2025 IF CY >= 190   THEN CY = 190
  51. 2030 CIRCLE (CX,CY),RADIUS,1
  52. 2045     IF DRAWFLAG = 1 THEN A(CX) = CY
  53. 2046     IF DRAWFLAG = 1 THEN B%(CX) = 26775/(191-CY)
  54. 2070 GOTO 2000
  55. 2071 '
  56. 2100 '---- cursor up
  57. 2101 '
  58. 2105 IF DRAWFLAG = 0 THEN CIRCLE (CX,CY),RADIUS,0   'erase previous point
  59. 2110 CY = CY + YINCREMENT
  60. 2115 RETURN
  61. 2120 '
  62. 2200 '---cursor down
  63. 2201 '
  64. 2205 IF DRAWFLAG = 0 THEN CIRCLE (CX,CY),RADIUS,0       'erase previous point
  65. 2210 CY = CY - YINCREMENT
  66. 2215 RETURN
  67. 2220 '
  68. 2300 '--- cursor right
  69. 2301 '
  70. 2305 IF DRAWFLAG = 0 THEN CIRCLE (CX,CY),RADIUS,0       'erase previous point
  71. 2310 CX = CX + 1: IF CX=640 THEN BEEP:CX=639
  72. 2315 RETURN
  73. 2320 '
  74. 2400 '--- cursor left
  75. 2401 '
  76. 2405 IF DRAWFLAG = 0 THEN CIRCLE (CX,CY),RADIUS,0       'erase previous point
  77. 2410 CX = CX - 1
  78. 2415 RETURN
  79. 2420 '
  80. 2500 '--- toggle drawflag on/off
  81. 2501 '
  82. 2505 IF DRAWFLAG = 1  THEN DRAWFLAG = 0: GOTO 2520
  83. 2510 IF DRAWFLAG = 0  THEN DRAWFLAG = 1:
  84. 2520 RETURN
  85. 2521 '
  86. 3000 '*** subroutine to play the sound
  87. 3001 '
  88. 3005 IF GRAPH.ICS THEN GOSUB 4000            'redraw the pattern
  89. 3010 LOCATE 1,1: PRINT STRING$(75,32);       'clear line #1
  90. 3015 LOCATE 1,45
  91. 3016 PRINT "Press [Esc] to end the song"
  92. 3017 LOCATE 1,15: PRINT BIRDNAME$
  93. 3139 GOSUB 50000                             'machine language subroutine
  94. 3141 A$ = INKEY$: IF A$ = CHR$(27) THEN GOTO 3142 ELSE GOTO 3139
  95. 3142 IF FLAG = 1 THEN GOTO 3155              'song is alread stored on disk
  96. 3148 LOCATE 1,1
  97. 3150 GOSUB 40000                             'option to store array
  98. 3155 CLS
  99. 3157 LOCATE 12,18
  100. 3160 PRINT "Would you like to see more BIRD SONGS? (y/n)"
  101. 3170 DEF SEG=0: POKE &H41A,PEEK(&H41C)  '**** Clear keyboard buffer
  102. 3175 A$ = INKEY$: IF A$ = "" THEN GOTO 3175
  103. 3180 IF A$ = "y" OR A$ = "Y" THEN CLEAR:GOTO 95 ELSE IF A$<>"N" AND A$<>"n" THEN BEEP: GOTO 3175
  104. 3181 '
  105. 3183 '--- end program
  106. 3184 '
  107. 3190   CLS                                           '... end the program
  108. 3192   LOCATE 10,35
  109. 3194   PRINT "BIRDSONG"
  110. 3196   LOCATE 15,15
  111. 3197   PRINT "(C) Copyright 1984  Scott Camazine & P. Kirk Visscher"
  112. 3199   FOR WAITE=1 TO 2000: NEXT WAITE: GOTO 65000
  113. 3200 '
  114. 4000 '*** subroutine to redraw points already entered
  115. 4001 '
  116. 4120 CLS
  117. 4122 GOSUB 6000                                'redraw grid
  118. 4130 FOR I = 1 TO 640                          'replot the points
  119. 4131     IF A(I) = 0 THEN GOTO 4136
  120. 4134     CIRCLE (I+15,A(I)),RADIUS+2,1
  121. 4136 NEXT I
  122. 4140 RETURN
  123. 6000 '*** draw axes
  124. 6001 CLS
  125. 6005 SCREEN 2
  126. 6009 LINE (15,10) - (640,10)
  127. 6010 LINE (15,55) - (640,55)
  128. 6012 LINE (15,100) - (640,100)
  129. 6014 LINE (15,145) - (640,145)
  130. 6015 LINE (15,190) - (640,190)
  131. 6027 LOCATE  2,1: PRINT "KHz";
  132. 6030 LOCATE  7,1: PRINT "6"              'label frequencies on axis
  133. 6035 LOCATE 13,1: PRINT "4"              'label frequencies on axis
  134. 6040 LOCATE 19,1: PRINT "2"              'label frequencies on axis
  135. 6052 '
  136. 6060 LOCATE 25,29: PRINT "1";            'label seconds on x axis
  137. 6062 LOCATE 25,56: PRINT "2";            'label seconds on x axis
  138. 6063 '
  139. 6092 FOR I = 15 TO 640 STEP 640/6         'tick marks for 1/2 seconds
  140. 6094     LINE (I,10)-(I,190)
  141. 6095 NEXT I
  142. 6096 LINE (639,10)-(639,190)
  143. 6097 LOCATE 25,39: PRINT "seconds";
  144. 6105 IF GETFILE$ = "y" OR GETFILE$ = "Y" THEN GOTO 6500
  145. 6112 LOCATE 1,10:PRINT "[F5] toggle drawing on/off   [F9] review graph   [F1O] play song"
  146. 6500 RETURN
  147. 20000 '--- BIRD DESCRIPTIONS
  148. 20001 '
  149. 20003 ON NUMBER GOSUB 21000,22000,23000,24000,25000,26000,27000,28000
  150. 20004 'GOSUB 61000                       'press any key to continue
  151. 20050 RETURN
  152. 21000 '--- CARDINAL
  153. 21001 '
  154. 21005 SCREEN 0: COLOR 12: LOCATE 1,30
  155. 21010 PRINT "CARDINAL"
  156. 21015 LOCATE 5,1
  157. 21020 PRINT "DESCRIPTION:  The cardinal is a common bird of the suburbs, and"
  158. 21025 PRINT "   a frequent visitor to winter bird feeders. The brilliant red "
  159. 21030 PRINT "   plummage, pointed crest, and black bib of the male are "
  160. 21035 PRINT "   unmistakable. The female and immatures are light brown with "
  161. 21040 PRINT "   hints of red. Their heavy conical bills, red in both sexes,
  162. 21045 PRINT "   are ideally suited for cracking hard seeds.
  163. 21050 PRINT "   Cardinals are found over most of the eastern US.
  164. 21055 PRINT
  165. 21060 PRINT "SONG: A long repetition of loud slurred whistles, occurring"
  166. 21065 PRINT "   5-10 per minute. There are over 20 different dialects "
  167. 21070 PRINT "   to the song, one of which is included here. The dialects"
  168. 21075 PRINT "   vary their pattern with time and geographical area.
  169. 21080 PRINT "   Males maintain a large territory of about 6 acres, the "
  170. 21085 PRINT "   boundaries of which are established by singing from one or"
  171. 21090 PRINT "   several tall perches in the area. Other males match their"
  172. 21095 PRINT "   song to neighboring males in singing duels to defend the "
  173. 21100 PRINT "   territories. A female occasionally sings just before nesting"
  174. 21105 PRINT "   and matches her song to her partner's even more closely "
  175. 21110 PRINT "   closely than the male does with his neighbors.       ";
  176. 21500 RETURN
  177. 22000 '--------------------- yellow warbler
  178. 22001 '
  179. 22005 SCREEN 0: COLOR 14,0,4: CLS: LOCATE 1,30
  180. 22010 PRINT "YELLOW WARBLER "
  181. 22015 LOCATE 5,1
  182. 22020 PRINT "DESCRIPTION:  Easily recognized as the only small bird which"
  183. 22025 PRINT "   appears to be all yellow. Other warblers have yellow "
  184. 22030 PRINT "   undersides but none is as yellow on the back, wings or tail."
  185. 22035 PRINT "   A common resident of suburban shrubbery, willow thickets and"
  186. 22040 PRINT "   swamp edges. Like most warblers, the yellow warbler eats a "
  187. 22045 PRINT "   variety of caterpillars, and other insect pests and is thus"
  188. 22050 PRINT "   of great benefit. This little bird is found throughout most"
  189. 22052 PRINT "   of the United States, often close to human habitation, but"
  190. 22054 PRINT "   winters in the tropics.
  191. 22055 PRINT
  192. 22060 PRINT "SONG: A cheerful `tsee-tsee-tsee-tsee-ti-ti-wee` or
  193. 22065 PRINT "   `sweet,sweet,sweet...I am so sweet` composed of 7 clear "
  194. 22070 PRINT "   notes, with the second half of the song being slightly"
  195. 22075 PRINT "   faster and the final note slurred upward."
  196. 22500 RETURN
  197. 23000 '--------------------- YELLOW THROAT
  198. 23001 '
  199. 23005 SCREEN 0: COLOR 14,0,6: CLS: LOCATE 1,30
  200. 23010 PRINT "YELLOW THROAT"
  201. 23015 LOCATE 5,1
  202. 23020 PRINT "DESCRIPTION:  The male is readily identified by his black mask"
  203. 23025 PRINT "   and bright yellow throat. The female is duller and lacks"
  204. 23030 PRINT "   a mask. These birds frequent low vegetation in grassy "
  205. 23035 PRINT "   clearings, swamps, marshes and shrubby areas, throughout the"
  206. 23040 PRINT "   entire United States. They are one of our most common "
  207. 23045 PRINT "   warblers, often seen near the ground, moving quickly about."
  208. 23055 PRINT
  209. 23060 PRINT "SONG: A distinctive rapid, `witchity, witchity, witchity, witch`,"
  210. 23065 PRINT "   repeated 4 to 6 times per minute. This is one of the easiest"
  211. 23070 PRINT "   warbler songs to recognize.
  212. 23500 RETURN
  213. 24000 '--------------------- EASTERN PHOEBE
  214. 24001 '
  215. 24005 SCREEN 0: COLOR 3,0,4: CLS: LOCATE 1,30
  216. 24010 PRINT "EASTERN PHOEBE"
  217. 24015 LOCATE 5,1
  218. 24020 PRINT "DESCRIPTION:  This bird is found near farm buildings and bridges"
  219. 24025 PRINT "   where it builds its nest on an over-hanging beam or ledge."
  220. 24030 PRINT "   It is composed of mud, covered with moss and dead leaves,"
  221. 24035 PRINT "   and lined with more moss and soft feathers. It can be found"
  222. 24040 PRINT "   throughout most of the eastern United States. It looks "
  223. 24045 PRINT "   similar to the Eastern Wood Pewee, but has a distinctive"
  224. 24050 PRINT "   song, and a habit of persistently bobbing its tail."
  225. 24055 PRINT
  226. 24060 PRINT "SONG: The phoebe clearly says its name, `phoe-be` or `fee-bree`.
  227. 24065 PRINT
  228. 24070 PRINT
  229. 24500 RETURN
  230. 25000 '--------------------- EASTERN WOOD PEWEE
  231. 25001 '
  232. 25005 SCREEN 0: COLOR 3,0,6: CLS: LOCATE 1,30
  233. 25010 PRINT "EASTERN WOOD PEWEE"
  234. 25015 LOCATE 5,1
  235. 25020 PRINT "DESCRIPTION:  One of the many flycatchers, common in deciduous"
  236. 25025 PRINT "   and mixed woodland areas. It is about the size of a sparrow,"
  237. 25030 PRINT "   olive-brown above and whitish below. It can be distinguished"
  238. 25035 PRINT "   from the similar-appearing Eastern Phoebe by its conspicuous"
  239. 25040 PRINT "   wingbars and lighter-colored bill. Like the other flycatchers,"
  240. 25045 PRINT "   it snaps up passing insects in flight.
  241. 25055 PRINT
  242. 25060 PRINT "SONG: A plaintive, drawling whistle, `pee-o-wee` repeated"
  243. 25065 PRINT "   6 to 11 times per minute.
  244. 25500 RETURN
  245. 26000 '--------------------- WHITE-THROATED SPARROW
  246. 26001 '
  247. 26005 LOCATE 1,30
  248. 26010 PRINT "WHITE-THROATED SPARROW"
  249. 26015 LOCATE 5,1
  250. 26020 PRINT "DESCRIPTION:  One of the prettiest sparrows, with a distinctive"
  251. 26025 PRINT "   white throat, a black and white striped crown and a yellow"
  252. 26030 PRINT "   spot between the eye and bill.  It prefers dense undergrowth"
  253. 26035 PRINT "   and brushy areas, usually feeding on the ground. It can be "
  254. 26040 PRINT "   attracted to winter feeding stations if seed is scattered  "
  255. 26045 PRINT "   on the ground."
  256. 26055 PRINT
  257. 26060 PRINT "SONG: An easily-imitated whistle, `Old Sam Peabody, Peabody,"
  258. 26065 PRINT "   Peabody`, as described by New Englanders or 'Oh Sweet "
  259. 26070 PRINT "   Canada, Canada, Canada` by the Canadians for whom it is the"
  260. 26075 PRINT "   national bird. The song is unmistakable once it has been"
  261. 26080 PRINT "   heard. The initial two notes are clear, followed by the"
  262. 26085 PRINT "   quavering `Peabody` notes on a different pitch."
  263. 26500 RETURN
  264. 27000 '--------------------- TOWHEE
  265. 27001 '
  266. 27005 SCREEN 0: COLOR 10,0: CLS: LOCATE 1,30
  267. 27010 PRINT "RUFOUS-SIDED TOWHEE"
  268. 27015 LOCATE 5,1
  269. 27020 PRINT "DESCRIPTION:  Feeds on the ground in brush and thick undergrowth"
  270. 27025 PRINT "   where it is often detected by its noisy scratching and hopping"
  271. 27030 PRINT "   amongst the dead leaves as it searches for insects and seeds."
  272. 27035 PRINT "   The male is a beautiful bird with a black back and white "
  273. 27040 PRINT "   belly with reddish (rufous) sides. Its eye is bright red,  "
  274. 27045 PRINT "   except for a white-eyed race found in the Southwest.
  275. 27050 PRINT "   The female differs from the male by being dusky brown where"
  276. 27052 PRINT "   the male is black. Found throughout the United States."
  277. 27055 PRINT
  278. 27060 PRINT "SONG: `Drink your tea`, with the last syllable a long "
  279. 27065 PRINT "   drawn-out trill, more like `teeeee` than `tea` as the "
  280. 27070 PRINT "   mnemonic would suggest. Repeated 7 to 12 times per minute."
  281. 27500 RETURN
  282. 28000 '--------------------- other birds
  283. 28001 '
  284. 28005 RETURN  45020                     'no description so return to get file
  285. 28006 '
  286. 40000 '******* subroutine to store file on disk
  287. 40001 '
  288. 40002 CLS
  289. 40004 LOCATE 12,10
  290. 40005 PRINT "Would you like to store the song on diskette (y/n)";:PRINT
  291. 40010 YN$ = INKEY$: IF YN$ = ""  THEN GOTO 40010
  292. 40012 IF YN$ = "y"  OR YN$ = "Y" THEN GOTO 40020 ELSE RETURN
  293. 40020 LOCATE 12,1:PRINT STRING$(75,32);
  294. 40021 LOCATE 12,10
  295. 40022 INPUT "Filename (8 characters or less)    ";DATAFILE$
  296. 40023 LOCATE 12,1:PRINT STRING$(75,32);
  297. 40024 LOCATE 12,10
  298. 40025 INPUT "Bird name (20 characters or less)  ";BIRDNAME$
  299. 40026 DATAFILE$ = LEFT$(DATAFILE$,8) + ".sng"
  300. 40030 OPEN DATAFILE$ FOR OUTPUT AS #2
  301. 40032 WRITE #2, BIRDNAME$
  302. 40035 FOR I = 1 TO 640
  303. 40040     WRITE #2, B%(I)
  304. 40050 NEXT I
  305. 40060 CLOSE
  306. 40070 CLS
  307. 40080 RETURN
  308. 40081 '
  309. 41000 '**** subroutine to read data from a file
  310. 41001 '
  311. 41002 CLS: LOCATE 12,15
  312. 41003 PRINT "Would you like to (P)lay a song from disk ";
  313. 41004 LOCATE 13,15
  314. 41005 PRINT "             -or- (C)reate your own song ?";
  315. 41006 LOCATE 15,15: PRINT "Press [P] or [C]"
  316. 41010 GETFILE$ = INKEY$: IF GETFILE$ = "" THEN GOTO 41010
  317. 41012 IF GETFILE$ = "C" OR GETFILE$ = "c" THEN RETURN ELSE IF GETFILE$<>"P" AND GETFILE$<>"p" THEN BEEP: GOTO 41010
  318. 41015 '
  319. 42000 '-------------------- choose a birdsong to play
  320. 42001 '
  321. 42003 FLAG = 1                               'retrieving a saved file
  322. 42005 CLS
  323. 42010 LOCATE 5,24
  324. 42020 PRINT "Choose One of the Following Birds"
  325. 42040 LOCATE 8,23: PRINT "1 ---------- Cardinal"
  326. 42050 LOCATE 9,23: PRINT "2 ---------- Yellow Warbler"
  327. 42060 LOCATE 10,23: PRINT "3 ---------- Yellow Throat"
  328. 42070 LOCATE 11,23: PRINT "4 ---------- Eastern Phoebe"
  329. 42074 LOCATE 12,23: PRINT "5 ---------- Eastern Wood Pewee"
  330. 42076 LOCATE 13,23: PRINT "6 ---------- White-Throated Sparrow"
  331. 42078 LOCATE 14,23: PRINT "7 ---------- Rufous-Sided Towhee"
  332. 42080 LOCATE 15,23: PRINT "8 ---------- Another Bird Song (not listed)"
  333. 42085 LOCATE 18,27,1: PRINT "What is your choice? (1-8) ";
  334. 42090 A$ = INKEY$: IF A$ = "" THEN GOTO 42090 ELSE PRINT A$;: LOCATE ,,0
  335. 42100 NUMBER = VAL(A$)
  336. 43100  IF NUMBER = 1 THEN FILENAME$ = "CARDNAL4.sng"
  337. 43102  IF NUMBER = 2 THEN FILENAME$ = "YL-WARB.sng"
  338. 43103  IF NUMBER = 3 THEN FILENAME$ = "YL-THRT.sng"
  339. 43104  IF NUMBER = 4 THEN FILENAME$ = "phoebe.sng"
  340. 43106  IF NUMBER = 5 THEN FILENAME$ = "pewe1.sng"
  341. 43107  IF NUMBER = 6 THEN FILENAME$ = "wht-thrt.sng"
  342. 43108  IF NUMBER = 7 THEN FILENAME$ = "towhee1.sng"
  343. 43109  IF NUMBER = 8 THEN CLS: LOCATE 8,1:FILES "*.sng": PRINT :PRINT :INPUT "     Filename (without .SNG extension) "; FILENAME$: FILENAME$=FILENAME$+".SNG"
  344. 43120  IF NUMBER < 1 OR NUMBER > 8 THEN BEEP: GOTO 42005      'catch errors
  345. 44040 CLS
  346. 45010 '--
  347. 45012 '
  348. 45013 GOSUB 20000
  349. 45020 OPEN FILENAME$ FOR INPUT AS #1
  350. 45030 INPUT #1, BIRDNAME$
  351. 45040 FOR I = 1 TO 640
  352. 45050   INPUT#1, B%(I)
  353. 45055 IF B%(I) = &HFFFF THEN A(I)=0 ELSE A(I) = (191*(B%(I))-26775)/B%(I)
  354. 45060 NEXT I
  355. 45070 CLOSE
  356. 45100 GOSUB 61000: GOTO 3000
  357. 50000 '*** call to machine language routine
  358. 50001 RESTORE
  359. 50020 DEF SEG = &H1700
  360. 50030 FOR I = 0 TO 67
  361. 50040 READ J
  362. 50050 POKE I,J
  363. 50060 NEXT I
  364. 50070 SING = 0
  365. 50075 FACTOR = 1
  366. 50080 LENGTH% = 1237*FACTOR               ' &H4d5 = 1237 = normal tempo
  367. 50130 CALL SING(B%(1), LENGTH%)
  368. 50150 DATA  &H55, &h89, &he5, &h8b, &h76, &h08, &h8b, &h6e
  369. 50160 DATA  &H06, &h8b, &h6e, &h00, &hb0, &hb6, &he6, &h43
  370. 50170 DATA  &he4, &h61, &h88, &hc6, &h29, &hdb, &h8b, &h00, &he6, &h42, &h88
  371. 50190 DATA  &he0, &he6, &h42, &h83, &hc3, &h02, &h88, &hf0, &h0c
  372. 50195 DATA  &h03, &h80, &hfc, &hff, &h74, &h04, &he6, &h61
  373. 50200 DATA  &heb, &h04, &h88, &hf0, &he6, &h61, &h89, &he9, &he2, &hfe, &h81
  374. 50205 DATA  &hfb, &h00, &h05, &h7c, &hda, &h88, &hf0, &he6
  375. 50220 DATA  &h61, &h5d, &Hca, &h04, &h00
  376. 50555 RETURN
  377. 60000 '*** introduction
  378. 60001 '
  379. 60002 COLOR 14,0
  380. 60003 FOR I = 1 TO 30
  381. 60004     LOCATE 1,I
  382. 60005     PRINT "  BIRDSONG"
  383. 60006     FOR J = 1 TO 120: NEXT
  384. 60007 NEXT I
  385. 60008 '
  386. 60009 BIRD$ = "c#;p64;c#;p64;c#;p16;eabcdeff#;p8"
  387. 60010 FOR I = 1 TO 4
  388. 60011    PLAY "mb o6 l64; xbird$;"
  389. 60012 NEXT I
  390. 60013 '
  391. 60014 COLOR 3,0
  392. 60015 PRINT
  393. 60020 PRINT "    BIRDSONG is a program which allows you to reproduce the songs of birds.  "
  394. 60025 PRINT "  Each song was first created graphically as a sonogram using the cursor keys"
  395. 60030 PRINT "  to trace out the distinctive song pattern on the screen.  The screen has a"
  396. 60035 PRINT "  vertical axis for the tone of the song, and a horizontal axis representing"
  397. 60045 PRINT "  the time in seconds."
  398. 60050 PRINT "**  If you are using a computer equipped with graphics, you will be able to "
  399. 60051 PRINT "  create new songs.  Without graphics, you will only be able to play the songs"
  400. 60052 PRINT "  that are on the disk.**"
  401. 60072 PRINT "  To trace out the song pattern press [F5] to toggle the drawing mode off or "
  402. 60074 PRINT "  on. Draw the sonogram by repeatedly pressing one of the four cursor keys."
  403. 60076 PRINT "  To redraw the song press [F9] at any time.  You may save a song on diskette"
  404. 60078 PRINT "  and run the program to play any of the songs you have created."
  405. 60081 PRINT
  406. 60082 PRINT "  BIRDSONG includes seven files of common bird songs along with a description"
  407. 60085 PRINT "  of each bird. Other bird songs can be traced from sonograms found in bird"
  408. 60087 PRINT "  field guides, or you may experiment with songs and melodies of your own"
  409. 60090 PRINT "  invention."
  410. 60200  LOCATE 21,5 : COLOR 7,0
  411. 60210 PRINT "(C) Copyright 1984  Scott Camazine &  P. Kirk Visscher ";
  412. 60215 PRINT "            36 DOVE DRIVE, ITHACA, NEW YORK  14850         ";
  413. 60220 PRINT "  If you like and use this program, please send the author $10.00.";
  414. 60225 LOCATE 24,1: PRINT "          SUPPORT THE USER SUPPORTED SOFTWARE CONCEPT.";
  415. 60300 FOR WAITE=1 TO 3000: NEXT WAITE: LOCATE 25,1: PRINT SPACE$(79);
  416. 60500 GOSUB 61000
  417. 60510 RETURN
  418. 61000 '---------------- press any key to continue
  419. 61001 '
  420. 61002 LOCATE 25,20
  421. 61010 PRINT "Press any key to continue";
  422. 61020 A$ = INKEY$: IF A$ = "" THEN GOTO 61020
  423. 61030 LOCATE 25,20: PRINT STRING$(40,32);
  424. 61040 'CLS
  425. 61050 RETURN
  426. 62000 '------------------ error traps
  427. 62001 '
  428. 62010 LOCATE 14,30
  429. 62015 IF ERR = 53 THEN PRINT "File Not Found.......Please try again":                    GOSUB 64000: RESUME 42000
  430. 62025 IF ERR = 71 THEN PRINT "Disk Drive Not Ready....Please check drive":               GOSUB 64000: RESUME 42000
  431. 62050 '
  432. 64000 '------------------- pause
  433. 64001 '
  434. 64010 FOR I = 1 TO 3000: NEXT I
  435. 64020 RETURN
  436. 64030 '
  437. 65000 SCREEN 0: WIDTH 80: COLOR FC,0,BC ' return to magazette
  438. 65010 COMMON ADDR.%, COLOR.MONITOR$
  439. 65020 'COLOR 14,0: LOCATE 25,1: PRINT SPACE$(28);"Returning to Magazette";SPACE$(29);: RUN"start"
  440. 65030 CLS: LOCATE 12,35: PRINT"Good-bye!": COLOR 3
  441. 65040 END
  442. 
  443.