home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 2 / 64er_Magazin_Sonderheft_02_86-02_1986_Markt__Technik_de.d64 / bass_irq-source (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  8KB  |  395 lines
  1. 100 open1,8,1,"@:bass/irq"
  2. 110 open4,4
  3. 120 sys9*4096
  4. 130 .opt p4,o1
  5. 140 ;
  6. 150 ;************
  7. 160 ;* bass/irq *
  8. 170 ;************
  9. 180 ;
  10. 190 ; (c)1985 robert treichler
  11. 200 ;         fl-9497 triesenberg, f.tum liechtenstein
  12. 210 ;
  13. 220 *= $c000
  14. 230 ;
  15. 240 ; aufrufe aus basic ---------------
  16. 245 ;
  17. 250 ; init    sys ap
  18. 252 ; exit    sys ap+3
  19. 254 ; para    sys ap+6,h4,fw,fw*fw,ton-bez.
  20. 256 ; trend   sys ap+9,ha%(h),tr%,ta%
  21. 257 ; hnext   sys ap+12,ha%(h),ha%(hn),hg%(h),hg%(hn),tr%,ta%
  22. 258 ; zufall  sys ap+15,ha%(h),ta%
  23. 259 ; tempo   sys ap+18,t2%.t3%,t4%
  24. 260 ;
  25. 265 jmp init ;irq-rout. ein
  26. 270 jmp exit ;irq-rout. aus
  27. 280 jmp para ;ton-parameter aus basic holen
  28. 290 jmp trend ;nae.akkordeig.ton suchen
  29. 300 jmp hnext ;ueberg.ton zu nae.harm.suchen
  30. 310 jmp zufall ;zufalls-ton ermitteln
  31. 312 jmp tempo ;tempo aus basic holen
  32. 315 ;
  33. 320 ; definitionen --------------------
  34. 330 ;
  35. 340 h4 .byt 0 ;nr. 1/4-schlag im takt
  36. 350 fs .byt 0,0;frequenz hauptschlag
  37. 360 fv .byt 0,0;frequenz vorschlag
  38. 370 save .byt 0,0,0,0,0;save h4,fs,fv
  39. 380 ;
  40. 390 t2 .byt 0 ;zeit-inkrement (1.vors.)
  41. 400 t3 .byt 0 ;      do.      (2.vors.)
  42. 410 t4 .byt 0 ;      do.      (haupts.)
  43. 420 ;
  44. 430 timer .byt 0 ;zeit-zaehler
  45. 440 ;
  46. 450 pc    .byt 0 ;perc. attack/decay
  47. 460 ;
  48. 470 ha .byt 0,0 ;akkordeig.toene akt.harmonie (lb/hb)
  49. 480 hanx .byt 0,0 ;akkordeig.toene naechste harmonie
  50. 490 hg .byt 0 ;nr.grundton akt.harmonie
  51. 500 tr .byt 0 ;trend +/-1 (1,255)
  52. 510 ta .byt 0 ;nr.akt.ton
  53. 512 ;
  54. 513 ;and-masken fuer 2er-potenzen
  55. 514 mask .byt 1,2,4,8,16,32,64,128 ;lb(bit0-7)
  56. 516 .byt 1,2,4,8 ;hb(bit8-11)
  57. 520 ;
  58. 530 rb = 251  ;run bass
  59. 540 rp = 252  ;run percussion
  60. 550 ;
  61. 560 sid = 54272  ;sid-reg.adr
  62. 570 random = $d012 ;pseudo-random-wert
  63. 580 irqex = $ea31 ;irq-rout.exit
  64. 590 chkcom = $aefd ;check komma
  65. 600 chrout = $ffd2 ;char-output
  66. 610 getbyt = $b79e ;holt 1-byte-wert ->reg.x
  67. 612 getvar = $b08b ;variable suchen
  68. 614 typerr = $ad99 ;type-mismatch-error
  69. 620 getpar = $b1b2 ;holt 16-bit-parameter ->$64/65
  70. 630 frmevl = $ad9e ;bel.ausdruck auswerten
  71. 640 frestr = $b6a3 ;string-verwaltung
  72. 650 ;
  73. 660 ; programm ------------------------
  74. 750 ;
  75. 760 ; irq-routine einschalten
  76. 770 ;
  77. 780 init lda #<irq
  78. 790 ldx #>irq
  79. 800 vektor sei
  80. 805 sta $0314
  81. 810 stx $0315
  82. 820 lda #0
  83. 830 sta rb
  84. 840 sta rp
  85. 850 sta fs
  86. 860 cli
  87. 870 rts
  88. 880 ;
  89. 890 ;irq-rout. aus
  90. 895 ;
  91. 900 exit lda #<irqex
  92. 910 ldx #>irqex
  93. 920 jmp vektor
  94. 930 ;
  95. 931 ;irq-einsprung
  96. 932 ;
  97. 940 irq lda rb
  98. 950 ora rp
  99. 960 beq tim
  100. 970 inc timer
  101. 980 lda timer
  102. 990 cmp t2;check intervall-zeiten
  103. 1000 beq playt2
  104. 1010 cmp t3
  105. 1020 beq playt3
  106. 1030 cmp t4
  107. 1040 beq playt4
  108. 1050 tim sta timer
  109. 1060 return jmp irqex
  110. 1070 ;
  111. 1080 playt2 lda #0;1.vorschlag
  112. 1090 sta pc
  113. 1100 lda h4 ;kein 1.vorschlag, wenn ...
  114. 1110 bmi return ;...h4=neg.
  115. 1115 beq return ;...oder h4=0
  116. 1120 and #1
  117. 1130 bne return ;...oder schlag=ungerade
  118. 1140 lda random
  119. 1150 adc #220
  120. 1160 bcs return ;...oder random-exit
  121. 1170 lda #5
  122. 1180 sta pc ;hi-hat kurz
  123. 1190 jsr perc
  124. 1200 jmp return
  125. 1210 ;
  126. 1220 playt3 lda h4;2.vorschlag
  127. 1230 bmi return ;kein 2.vors.wenn h4=neg
  128. 1235 beq return ;...oder h4=0
  129. 1240 and #1
  130. 1250 beq p310
  131. 1260 lda #5 ;hi-hat kurz,wenn...
  132. 1270 sta pc ;...schlag=ungerade
  133. 1280 p310 jsr perc ;...oder 1.vors.ausgefuehrt
  134. 1290 lda h4
  135. 1300 cmp #2
  136. 1310 bcs return ;bass-vorschlag nur bei #1
  137. 1320 lda random
  138. 1330 adc #200
  139. 1340 bcs return ;random-exit
  140. 1350 lda fv+1 ;bass-vorschlag
  141. 1360 ldy fv
  142. 1365 beq return ;ton noch nicht bereit
  143. 1370 jsr bass
  144. 1380 jmp return
  145. 1390 ;
  146. 1400 playt4 ldx #5;1/4-hauptschlag
  147. 1410 lda h4
  148. 1420 and #1
  149. 1430 beq p410
  150. 1440 ldx #8
  151. 1450 p410 stx pc
  152. 1460 jsr perc
  153. 1470 lda fs+1 ;bass-hauptschlag
  154. 1480 ldy fs
  155. 1490 jsr bass
  156. 1500 lda #0
  157. 1510 sta timer;reset timer
  158. 1515 sta pc   ;reset perc.byte
  159. 1520 ldx h4
  160. 1530 beq p600
  161. 1540 sta fs;freigeben freq-loc. wenn h4>0
  162. 1550 sta fv
  163. 1560 lda string
  164. 1570 beq p600
  165. 1580 ldx #0 ;string ausdrucken
  166. 1590 p500 lda string,x
  167. 1600 beq p550
  168. 1610 jsr chrout
  169. 1620 inx
  170. 1630 bne p500
  171. 1640 p550 lda #32
  172. 1650 jsr chrout
  173. 1660 p600 jmp return
  174. 1670 ;
  175. 1680 perc lda rp;evtl.percussion ->sid
  176. 1690 beq percex;->keine perc.
  177. 1700 lda pc
  178. 1710 beq percex;->keine perc.
  179. 1720 lda #128
  180. 1730 sta sid+18;vco#3 noise+gate
  181. 1740 lda pc
  182. 1750 sta sid+19;vco#3 attack/decay
  183. 1760 lda #129
  184. 1770 sta sid+18
  185. 1780 percex rts
  186. 1790 ;
  187. 1800 bass bne bass10 ;evtl.bass ->sid
  188. 1810 lda #42 ;timing-fehler
  189. 1820 jsr chrout
  190. 1830 lda #$ff
  191. 1840 bass10 bmi bassex ;pause
  192. 1850 ldx rb
  193. 1860 beq bassex;->kein bass
  194. 1890 ldx #32
  195. 1895 stx sid+4 ;vco#1 saegezahn+gate
  196. 1900 ldx #64
  197. 1905 stx sid+11;vco#2 rechteck+sync+gate
  198. 1910 sta sid ;vco#1 frequenz
  199. 1915 sty sid+1
  200. 1920 sta sid+7 ;vco#2 frequenz
  201. 1925 sty sid+8
  202. 1930 lda #33
  203. 1935 sta sid+4
  204. 1940 lda #67
  205. 1945 sta sid+11
  206. 1950 bassex rts
  207. 1960 ;
  208. 1961 ;ton-parameter aus basic holen
  209. 1962 ;
  210. 1970 para jsr chkcom
  211. 1980 jsr getbyt ;h4
  212. 1990 stx save
  213. 2000 jsr getpar ;haupt-freq-wert
  214. 2010 lda $64
  215. 2020 bne par10
  216. 2030 lda #$ff ;aus null wird $ff
  217. 2040 par10 sta save+1 ;   hb
  218. 2050 lda $65
  219. 2060 sta save+2 ;   lb
  220. 2070 jsr getpar ;vorschlag-freq-wert
  221. 2080 lda $64
  222. 2090 sta save+3 ;   hb
  223. 2100 lda $65
  224. 2110 sta save+4 ;   lb
  225. 2120 par20 lda fs ;check freq-loc.frei
  226. 2130 beq par40 ;ja
  227. 2140 lda h4
  228. 2150 bne par20 ;warten wenn h4>0
  229. 2160 par40 ldx #4
  230. 2170 par60 lda save,x ;param.uebertragen
  231. 2180 sta h4,x
  232. 2190 dex
  233. 2200 bpl par60
  234. 2210 ;
  235. 2220 jsr chkcom ;string holen
  236. 2230 jsr frmevl
  237. 2240 jsr frestr
  238. 2250 tax
  239. 2260 ldy #0
  240. 2270 inx
  241. 2280 par80 dex ;string uebertragen
  242. 2290 beq par90 ;string zu ende
  243. 2300 lda ($22),y
  244. 2310 sta string,y
  245. 2320 iny
  246. 2330 bne par80
  247. 2340 par90 lda #0 ;mit null abschliessen
  248. 2350 sta string,y
  249. 2360 rts
  250. 2370 ;
  251. 2380 ;naechsten ton im trend suchen
  252. 2390 ;
  253. 2400 trend jsr getint ;hole bit-muster ha%()
  254. 2410 ;
  255. 2420 sta ha ;l.b.
  256. 2430 stx ha+1 ;h.b.
  257. 2440 jsr getint ;hole trend tr%
  258. 2450 sta tr
  259. 2460 jsr getint ;hole ton-nr. ta%
  260. 2470 tre010 sta ta
  261. 2480 tre020 lda tr ;ta+tr->ta
  262. 2490 jsr chkakk ;check ob akkordeigen
  263. 2500 beq tre020 ;nein ->loop
  264. 2510 jsr putta ;ta% absp.
  265. 2520 rts
  266. 2530 ;
  267. 2540 ;uebergangston zu nae.harmonie suchen
  268. 2550 ;
  269. 2560 hnext jsr getint ;hole ha%(h)
  270. 2570 sta ha
  271. 2580 stx ha+1
  272. 2590 jsr getint ;hole ha%(hn)
  273. 2600 sta hanx
  274. 2610 stx hanx+1
  275. 2620 jsr getint ;hole hg%(h)
  276. 2630 sta hg
  277. 2640 jsr getint ;hole hg%(hn)
  278. 2650 sta ta ;->wird ta
  279. 2660 jsr getint ;hole tr%
  280. 2670 sta tr
  281. 2680 jsr getint ;hole ta%
  282. 2690 sta save ;ta% saven
  283. 2700 ;1.var.  suche nachbar-ton v.nae.grundton, ...
  284. 2710 ;..der akkordeigen zu akt.harmonie ist
  285. 2720 lda #255 ;ta-1->ta (-1/2 ton)
  286. 2730 jsr chkakk ;check ob akkordeigen
  287. 2740 bne hnexit ;->ja, neuer ton gefunden
  288. 2750 lda #2 ;ta+2->ta (+1/2 ton)
  289. 2760 jsr chkakk ;check ob akkordeigen
  290. 2770 bne hnexit ;->ja, neuer ton gefunden
  291. 2780 lda #253 ;ta-3->ta (-1 ton)
  292. 2790 jsr chkakk ;check ob akkordeigen
  293. 2800 bne hnexit ;->ja, neuer ton gefunden
  294. 2810 lda #4   ;ta+4->ta (+1 ton)
  295. 2820 jsr chkakk ;check ob akkordeigen
  296. 2830 bne hnexit ;->ja, neuer ton gefunden
  297. 2840 ;2.var.  suche ton, der fuer beide harm. akkordeigen
  298. 2850 lda ha
  299. 2860 and hanx
  300. 2870 sta ha
  301. 2880 lda ha+1
  302. 2890 and hanx+1
  303. 2900 sta ha+1
  304. 2910 ora ha ;check ob gemeins.toene
  305. 2920 bne hne020 ;->ja
  306. 2930 lda hg ;nein, grundton nehmen
  307. 2940 sta ta
  308. 2950 hnexit jsr putta ;ta% absp.
  309. 2960 rts
  310. 2970 ;
  311. 2980 hne020 lda save ;ta% holen und laut trend...
  312. 2990 jmp tre010 ;...gemeins.akkord-ton suchen
  313. 3000 ;
  314. 3010 ;hole integer aus basic
  315. 3020 ;
  316. 3030 getint jsr chkcom ;komma
  317. 3040 jsr getvar ;var.suchen
  318. 3050 sta $49 ;var.adr. absp.
  319. 3060 sty $4a
  320. 3070 lda $0e ;check ob integer
  321. 3080 beq geterr ;->nein, error
  322. 3085 ldy #0
  323. 3090 lda ($49),y ;var.wert holen
  324. 3100 tax ;h.b. ->reg.x
  325. 3110 iny
  326. 3120 lda ($49),y ;l.b. ->reg.a
  327. 3130 rts
  328. 3140 ;
  329. 3150 geterr jmp typerr ;error
  330. 3160 ;
  331. 3170 ;ta% als basic-integer-var. absp.
  332. 3180 ;
  333. 3190 putta lda #0
  334. 3200 tay
  335. 3210 sta ($49),y ;h.b.
  336. 3220 lda ta
  337. 3230 iny
  338. 3240 sta ($49),y ;l.b.
  339. 3250 rts
  340. 3260 ;
  341. 3270 ;check ob ton nr.(ta)+reg.a  = akkordeigen
  342. 3280 ;in  reg.a=inkr./dekr. auf ta
  343. 3290 ;
  344. 3300 chkakk clc
  345. 3310 adc ta ;ta+inkr/dekr ->ta
  346. 3320 bpl cak010 ;check ob ta im bereich 0...11
  347. 3330 clc
  348. 3340 adc #12 ;...sonst korrektur
  349. 3350 cak010 cmp #12
  350. 3360 bcc cakbit
  351. 3370 sec
  352. 3380 sbc #12
  353. 3390 ;
  354. 3400 cakbit sta ta ;bit f.akt.ton holen
  355. 3410 tax
  356. 3420 lda mask,x ;and-maske holen
  357. 3430 ldy #0
  358. 3440 cpx #8 ;check ob l.b. oder h.b
  359. 3450 bcc cak030 ;->l.b.
  360. 3460 ldy #1 ;h.b.
  361. 3470 cak030 and ha,y ;bit aus akt.harm.extrahieren
  362. 3480 rts
  363. 3490 ;
  364. 3500 ; zufalls-ton ermitteln
  365. 3510 ;
  366. 3520 zufall jsr getint ;hole ha%(h)
  367. 3530 sta ha ;l.b.
  368. 3540 stx ha+1 ;h.b.
  369. 3550 jsr getint ;hole ta%
  370. 3560 jsr cakbit ;bit f.akt.ton holen
  371. 3570 eor #$ff ;...und loeschen
  372. 3580 and ha,y ;...damit nicht nochmals
  373. 3590 sta ha,y ;...gleicher ton kommt.
  374. 3600 lda random ;zufalls-zahl + ta ->ta
  375. 3610 and #7
  376. 3620 bne zuf030
  377. 3630 zuf020 lda #1
  378. 3640 zuf030 jsr chkakk ;check ob akk.eigen
  379. 3650 beq zuf020 ;->nein, weiter suchen
  380. 3660 jmp putta ;ja, ta% als basic-var.absp.
  381. 3690 ;
  382. 3700 ; tempo aus basic holen
  383. 3701 ;
  384. 3710 tempo jsr getint ;hole t2% (1.vorschlag)
  385. 3720 sta t2
  386. 3730 jsr getint ;hole t3% (2.vorschlag)
  387. 3740 sta t3
  388. 3750 jsr getint ;hole t4% (1/4-hauptschlag)
  389. 3760 sta t4
  390. 3770 rts
  391. 5000 ;
  392. 5010 string = *
  393. 5020 .end
  394. 5030 end
  395.