Techno Classical （COBOLで音楽を生成 -2-）

今となってはClassical なプログラミング言語「COBOL」で音楽を生成する実験。2つ目は、プログラムででMML（テキストデータ）を生成し、これをMIDIにコンパイルする方法で作成しました。

私が使っているCOBOL環境はOpenCOBOL（Windowsでもmacでも使えます）です。オープンソースのCOBOLコンパイラで、COBOLコードをCのコードに変換してGCCでコンパイルします。

汎用機でCOBOLを使い始めた頃は、コンパイラーが吐き出すアセンブラーのソースコードを見て、アセンブラーの勉強をしました。OpenCOBOLでもCのコートを作ってくれるので、これを眺めると、なるほどという感じでどんな仕掛けで動いているのかがわかります。

Techno Classical

https://yamazawa.bandcamp.com/album/techno-classical

Techno Classical | YAMAZAWA

Techno Classical by YAMAZAWA, released 29 July 2015 1. 未熟女 2. R31.415 3. 白と赤 4. ニッチマン unlimited 5. NON-STOP OSC

https://yamazawa.bandcamp.com/album/techno-classical

アルバム「Techno Classical 」の簡単な解説です。

Techno Classical (03 - 白と赤 ) by A_COMPANY | Free Listening on SoundCloud

Stream Techno Classical (03 - 白と赤 ) by A_COMPANY from desktop or your mobile device

https://soundcloud.com/a_company/techno-classical-03

[ソースプログラム]

program-id. otoiro2.

environment division.

input-output section.

file-control.

select txt-file assign txtf organization line sequential.

select prm-file assign prmf organization line sequential.

select mml-file assign mmlf organization line sequential.

data division.

file section.

fd txt-file label records standard.

01 txt-rec pic x(128).

fd prm-file label records standard.

01 prm-rec pic x(512).

fd mml-file label records standard.

01 mml-rec pic x(128).

working-storage section.

01 i pic 9(4).

01 j pic 9(4).

01 k pic 9(4).

01 x pic 9(4).

01 y pic 9(4).

01 t pic 9(4).

01 r pic 9(6).

01 l pic 9(6).

01 h pic 9(6).

01 n pic x(20).

01 msrn pic 9999.

01 seed pic 9999.

01 txtf pic x(20).

01 prmf pic x(20).

01 mmlf pic x(20).

01 inst pic x(60).

01 cmd pic x(40).

01 edw pic x(10).

01 ef pic x value low-value.

01 filler.

02 mhdr pic x(80).

02 occurs 8.

03 thdr pic x(80).

03 lc pic 99.

03 lg occurs 10 pic x(3).

03 pc pic 99.

03 pt occurs 17 pic x(20).

01 filler.

02 occurs 1024.

03 rgb occurs 3 pic 9(3).

01 ppm.

02 c occurs 15 pic x(4).

01 filler.

02 pml pic x(128).

02 pmn pic x(320).

01 filler.

02 filler occurs 3.

03 cc occurs 17 pic 9(4).

procedure division.

display "oto-iro 2" perform prm-set

display "txt :" txtf display "prm :" prmf display "mml :" mmlf display "seed:" seed

open input txt-file open output mml-file

read txt-file into txt-rec

read txt-file into txt-rec

read txt-file into txt-rec

unstring txt-rec delimited ' ' into x y

read txt-file into txt-rec

compute i = 0 move low-value to ef

perform until ef = high-value

read txt-file into txt-rec

end move high-value to ef

not end perform mml-set

end-read

end-perform

compute t = i

display 'Tone Number = ' t

perform varying i from 1 by 1 until i > t

perform varying j from 1 by 1 until j > 3

add 1 to cc(j,rgb(i,j)) add 1 to cc(j,17)

end-perform

end-perform

perform varying i from 1 by 1 until i > 17

if i = 17

display '==== ' cc(1,i) ' ' pt(1,i) cc(2,i) ' ' pt(2,i) cc(3,i) ' ' pt(3,i)

else

display i ' - ' cc(1,i) ' ' pt(1,i) cc(2,i) ' ' pt(2,i) cc(3,i) ' ' pt(3,i)

end-if

end-perform

write mml-rec from mhdr display mhdr

perform varying j from 1 by 1 until j > 3

write mml-rec from thdr(j) display thdr(j)

perform varying i from 1 by 1 until i > t

compute l = 1 compute h = lc(j) perform randomn

move pt(j, rgb(i,j)) to n

move ' ' to mml-rec

string 'l' lg(j, r) n delimited size into mml-rec

write mml-rec

end-perform

end-perform

close txt-file mml-file

string 'cSakura -p ' mmlf '> nul' into cmd call 'SYSTEM' using cmd

stop run.

prm-set.

perform

display 1 upon argument-number accept txtf from argument-value

if txtf = " " move "tmp.ppm" to txtf end-if

display 2 upon argument-number accept prmf from argument-value

if prmf = " " move "prm.txt" to prmf end-if

display 3 upon argument-number accept mmlf from argument-value

if mmlf = " " move "tmp.mml" to mmlf end-if

display 4 upon argument-number accept seed from argument-value

compute r = function random(seed)

open input prm-file move low-value to ef

perform until ef = high-value

read prm-file into prm-rec

end move high-value to ef

not end perform trk-set

end-read

end-perform

close prm-file

end-perform

exit.

trk-set.

perform

evaluate prm-rec(1:1)

when "*"

continue

when other

evaluate prm-rec(1:2)

when "//"

move high-value to ef continue

when "Te"

move prm-rec to mhdr

when "TR"

unstring prm-rec delimited " " into edw

compute i = function numval(edw)

move prm-rec to thdr(i)

when other

unstring prm-rec delimited all ' ' into pml pmn move 0 to lc(i) pc(i)

unstring pml delimited '/' into

lg(i,01) lg(i,02) lg(i,03) lg(i,04) lg(i,05) lg(i,06) lg(i,07) lg(i,08) lg(i,09) lg(i,10)

tallying lc(i)

unstring pmn delimited '/' into

pt(i,01) pt(i,02) pt(i,03) pt(i,04) pt(i,05) pt(i,06) pt(i,07) pt(i,08) pt(i,09) pt(i,10)

pt(i,11) pt(i,12) pt(i,13) pt(i,14) pt(i,15) pt(i,16)

tallying pc(i)

end-evaluate

end-evaluate

end-perform

exit.

mml-set.

perform

move ' ' to ppm

unstring txt-rec delimited ' ' into

c(01) c(02) c(03) c(04) c(05) c(06) c(07) c(08) c(09) c(10)

c(11) c(12) c(13) c(14) c(15)

end-unstring

perform varying k from 0 by 1 until k > 4

if c(k * 3 + 1) not = ' '

compute i = i + 1

perform varying j from 1 by 1 until j > 3

compute rgb(i,j) = (function numval(c(k * 3 + j)) / 16 + 1) * 1.25

if rgb(i,j) > 16 compute rgb(i,j) = 16 end-if

end-perform

end-if

end-perform

end-perform

exit.

randomn.

compute r = function rem(function random * 123456789 (h - l + 1)) + l.

#プログラミング 　#COBOL