/* xmas.tc - lrb - 5/22/2008

/* This program plays Christmas carols.

/* It's written in tiny-c/PC. The music data was taken from a
/* BASIC program written by Ray Knapp around 1990.

/* It requires ansi.sys (or equivalent) for color and
/* highlight/lowlight screen commands to work.

/* cosmetic mods - 12/11/2009

int oct(23) /* two octaves
char sc(600) /* music script
int speed,spd
int ob /* octave base
int dur /* duration of note
int music /* music on / off switch
char ma(2) /* music on / off array
char ct(9*35) /* carol titles

xmas [ /* main program

oct(0)=261;oct(1)=277;oct(2)=293;oct(3)=311;oct(4)=329;oct(5)=349
oct(6)=370;oct(7)=392;oct(8)=415;oct(9)=440;oct(10)=466;oct(11)=493
oct(12)=523;oct(13)=554;oct(14)=587;oct(15)=622;oct(16)=659;oct(17)=698
oct(18)=740;oct(19)=784;oct(20)=830;oct(21)=880;oct(22)=932;oct(23)=987

strcat(ct,"We three kings                     ")
strcat(ct,"O come, all ye faithful            ")
strcat(ct,"Hark! The herald angles sing       ")
strcat(ct,"Silent night                       ")
strcat(ct,"O little town of Bethlehem         ")
strcat(ct,"Away in the manger                 ")
strcat(ct,"The first Noel                     ")
strcat(ct,"It came upon the midnight clear    ")
strcat(ct,"Joy to the world!                  ")

char c;music=1 /* start w/ music on
ma="n";char ch(1) /* holds user command character 
int i,j

while (1) [ /* display play menu, get user command, launch it
  cls;i=-1
  pl "      ";hilo('1');ps "xmas.tc - lrb - 5/22/2008";hilo('0');pl ""
  while ((i=i+1)<9 ) [ /* display carol titles
    pl "     ";pn i+1;ps ". "
    j=-1;while ((j=j+1)<35) putchar ct(35*i+j)
    ]
  pl ""
  pl "      r. Random carol"
  pl "      a. All carols"
  pl "      m. Toggle music on / off (currently "
  hilo('1');ps "o";ps ma;hilo('0');ps ")" 
  pl "      x. Exit"
  pl "";pl "      ? ";c=getchar
  if (c=='x') break
  ch(0)=c;ch(1)=0
  if (index("123456789ram",12,ch,1)) lc c /* launch command if valid
  i=30;while (i=i-1) pause 2000
  ]
]

lc char c [ /* launch command
  if (c=='r') pc (c=random('1','9'))
  else if (c=='a') [
    int i
    c='0';while ((c=c+1)<='9') [i=30;while (i=i-1) pause 2000;pc(c)]
    ]
  else if (c=='m') [
    music=1-music;if (music) ma="n";else ma="ff"
    ]
  else pc c /* play carol
]

pc char c [ /* play carol
  cls;spd=600;speed=spd/100 /* default tempo
  int ci;ci=c-'1' /* used as index into titles string
  sc(0)=0 /* clear the music script
  int j;j=-1;pl "";pl ""
  hilo('1');color(random('1','6'))
  while ((j=j+1)<35) putchar ct(35*ci+j);pl ""
  hilo('0');color('7')
  if      (c=='1') kings
  else if (c=='2') ocome
  else if (c=='3') hark
  else if (c=='4') silent
  else if (c=='5') little
  else if (c=='6') away
  else if (c=='7') noel
  else if (c=='8') midnight
  else if (c=='9') joy
  int i;i=0;char wstr(7)
  while (music*sc(i)) [ /* play the script if music is on
    j=0
    while (sc(i)!=' ') [ /* build the play command
      wstr(j)=sc(i);i=i+1;j=j+1
      ]
    wstr(j)=0 /* null terminate it
    process wstr /* do the command (tempo, length, note, pause, octave)
    i=i+1 /* advance to next play command
    ]
]

process char cmd(0) [ /* music command processor
  int w(0)
  if      (cmd(0)=='T') [atoi(cmd+1,w);tempo(w(0))]
  else if (cmd(0)=='P') [atoi(cmd+1,w);pause(800*speed*w(0)/8)]
  else if (cmd(0)=='O') [atoi(cmd+1,w);octave(w(0)]
  else if (cmd(0)=='L') [atoi(cmd+1,w);length(w(0)]
  else if (cmd(0)=='C') pnote(0,(cmd+1))
  else if (cmd(0)=='D') pnote(2,(cmd+1))
  else if (cmd(0)=='E') pnote(4,(cmd+1))
  else if (cmd(0)=='F') pnote(5,(cmd+1))
  else if (cmd(0)=='G') pnote(7,(cmd+1))
  else if (cmd(0)=='A') pnote(9,(cmd+1))
  else if (cmd(0)=='B') pnote(11,(cmd+1))
]

tempo int i [speed=spd/i]

octave int o [ob=(o-4)*12]

length int l [dur=speed*8/l]

pnote int p;char sharp(0) [ /* play the note
  int off /* offet 
  if (sharp(0)=='#') off=1
  if (sharp(0)=='-') off=-1
  play (oct(ob+p+off),dur)
]

play int f,d [beep(f,d)]

pause int k [
  int l;while ((l=l+1)<k) []
]

/* color 0=black 1=red 2=green 3=yellow 4=blue 5=magenta 6=cyan 7=white

color char c [
  MC '\'-1-'@',1
  MC '\'-1,1
  MC '3',1
  MC c,1
  MC 'm',1
]

hilo char c [ /* 1 is high intensity (bold) 0 is all attributes off
  MC '\'-1-'@',1
  MC '\'-1,1
  MC c,1
  MC 'm',1 
]

kings [

pl ""
pl "We three kings of Orient are; Bearing gifts we traverse afar,"
pl "Field and fountain, moor and mountain, Following yonder star."
pl "O star of wonder, star of night, Star with royal beauty bright,"
pl "Westward leading, still proceeding, Guide us to thy perfect Light."
pl "";pl ""

strcat(sc,"T120 O4 L4 ")
strcat(sc,"B L8 A L4 G L8 E F# G F# L4 E P8 B L8 A L4 G L8 E F# G F# ")
strcat(sc,"L4 E P8 G L8 G L4 A L8 A L4 B L8 B O5 D C O4 B A B A L4 G ")
strcat(sc,"L8 F# L4 E L4 F# L8 A L4 G L8 G L4 G L8 D L4 G L8 E L4 G ")
strcat(sc,"L4 G L8 G L4 G L8 D L4 G L8 E L4 G L4 G L8 G L4 A L8 B O5 ")
strcat(sc,"L4 C O4 L8 B L4 A L8 B L4 G L8 G L4 G L8 D L4 G L8 E L4 G ")

]

silent [

pl ""
pl "Silent night, holy night, All is calm, all is bright"
pl "Round yon virgin mother and Child."
pl "Holy Infant, so tender and mild,"
pl "Sleep in heavenly peace, Sleep in heavenly peace."
pl "";pl ""

strcat(sc,"T100 O4 L6 G L16 A L8 G L3 E L6 G L16 A L8 G L3 E O5 L4 D L8 ")
strcat(sc,"D O4 L3 B O5 L4 C L8 C O4 L3 G L4 A L8 A O5 L6 C O4 L16 B L8 ")
strcat(sc,"A L6 G L16 A L8 G L3 E L4 A L8 A O5 L6 C O4 L16 B L8 A L6 G ")
strcat(sc,"L16 A L8 G L3 E O5 L4 D L8 D L6 F L16 D O4 L8 B O5 L3 C L3 E ")
strcat(sc,"L6 C O4 L16 G L8 E L6 G L16 F L8 D L2 C ")

]

ocome [

pl ""
pl "O come, all ye faithful, joyful and triumphant,"
pl "Come ye, O come ye to Bethlehem."
pl "Come and behold Him, born the King of angels."
pl "O come, let us adore Him, O come, let us adore him"
pl "O come, let us adore Him, Christ the Lord."
pl "";pl ""

strcat(sc,"T180 O4 L4 G L2 G L4 D L4 G L2 A L2 D L4 B L4 A L4 B O5 L4 C ")
strcat(sc,"O4 L2 B L2 A L2 G L4 F# L4 E L4 F# L4 G L4 A L4 B L2 F# L3 E ")
strcat(sc,"L8 D L1 D O5 L2 D L4 C O4 L4 B O5 L2 C O4 L2 B L4 A L4 B L4 ")
strcat(sc,"G L4 A L3 F# L8 E L4 D L4 D L4 G L4 F# L4 G L4 A L2 G L4 D ")
strcat(sc,"L4 B L4 B L4 A L4 B O5 L4 C O4 L2 B L4 A L4 B O5 L4 C O4 L4 ")
strcat(sc,"B L4 A L4 G L2 F# L3 G O5 L4 C O4 L2 B L3 A L8 G L3 G ")

]

hark [

pl "" 
pl "Hark! The herald angles sing. Glory to the newborn King."
pl "Peace on earth and mercy mild, God and sinners reconciled!"
pl "Joyful all ye nations, rise, Join the triumph of the skies;"
pl "With angelic host proclaim, Christ is born in Bethlehem."
pl "Hark! the herald angels sing, Glory to the new born King."
pl "";pl ""

strcat(sc,"T120 O4 L4 D L4 G L3 G L8 F# L4 G L4 B L4 B L4 A O5 L4 D L4 ")
strcat(sc,"D L3 D L8 C O4 L4 B L4 A L2 B L4 D L4 G L3 G L8 F# L4 G L4 B ")
strcat(sc,"L4 B L4 A O5 L4 D O4 L4 A L3 A L8 F# L4 F# L4 E L2 D O5 L4 D ")
strcat(sc,"L4 D L4 D O4 L4 G O5 L4 C O4 L4 B L4 B L4 A O5 L4 D L4 D L4 ")
strcat(sc,"D O4 L4 G O5 L4 C O4 L4 B L4 B L4 A O5 L4 E L4 E L4 E L4 D ")
strcat(sc,"L4 C O4 L4 B O5 L2 C O4 L4 A L8 B O5 L8 C L3 D O4 L8 G L4 G ")
strcat(sc,"L4 A L2 B O5 L3 E L8 E L4 E L4 D L4 C O4 L4 B O5 L2 C O4 L4 ")
strcat(sc,"A L8 B O5 L8 C L3 D O4 L8 G L4 G L4 A L2 G ")

]

little [

pl "" 
pl "O little town of Bethlehem, How still we see thee lie!"
pl "Above thy deep and dreamless sleep The silent stars go by."
pl "Yet in thy dark streets shineth the everlasting Light;"
pl "The hopes and fears of all the years Are met in thee tonight."
pl "";pl ""

strcat(sc,"T110 O4 L4 B L4 B L4 B L4 A# L4 B O5 L4 D L4 C O4 L4 E L4 A ")
strcat(sc,"L4 G L8 F# L8 G L4 A L4 D L3 B L4 B L4 B L4 B O5 L4 E L4 D ")
strcat(sc,"L4 D L4 C O4 L4 E L4 A L4 G L8 F# L8 G L4 B L4 A L3 G L4 B ")
strcat(sc,"L4 B L4 B L4 A L4 G L2 F# L4 F# L4 F# L4 E L4 F# L4 G L4 A ")
strcat(sc,"L3 B L4 B L4 B L4 B L4 A# L4 B O5 L4 D L4 C O4 L4 E O5 L4 E ")
strcat(sc,"L4 D O4 L4 G L3 B L8 A L3 G ")

]

away [

pl "" 
pl "Away in the manger, no crib for His bed,"
pl "The little Lord Jesus laid down His sweet head;"
pl "The stars in the sky looked down where He lay,"
pl "The little Lord Jesus asleep on the hay."
pl "";pl ""

strcat(sc,"T125 O5 L4 D L3 D L8 C O4 L4 B L3 B L8 A L4 G L4 G L4 F# L4 E L2 ")
strcat(sc,"D L4 D L4 D L8 E L4 D L4 D L4 A L4 F# L4 E L4 D L4 G L2 B O5 ")
strcat(sc,"L4 D L3 D L8 C O4 L4 B L3 B L8 A L4 G L4 G L4 F# L4 E L2 D ")
strcat(sc,"L4 D O5 L3 C O4 L8 B L4 A L4 B L4 A L4 G L4 A L4 E L4 F# L2 ")
strcat(sc,"G ")

]

noel [

pl ""
pl "The first Noel, the angels did say,"
pl "Was to certain poor shepherds in fields as they lay."
pl "In fields where they lay keeping their sheep"
pl "On a cold winter's night that was so deep"
pl "Noel, Noel, Noel, Noel,"
pl "Born is the King of Israel."
pl "";pl ""

int i;i=3

while (i=i-1) [ 
  strcat(sc,"T120 O4 L8 E L8 D L3 C L8 D L8 E L8 F L2 G L8 A L8 B O5 L4 C ")
  strcat(sc,"O4 L4 B L4 A L2 G L8 A L8 B O5 L4 C O4 L4 B L4 A L4 G L4 A ")
  strcat(sc,"L4 B O5 L4 C O4 L4 G L4 F L2 E ")
  ]

strcat(sc,"L8 E L8 D L3 C L8 D L8 E L8 F ")
strcat(sc,"L2 G O5 L8 C O4 L8 B L2 A L4 A L3 G O5 L4 C O4 L4 B L4 A L4 ")
strcat(sc,"G L4 A L4 B O5 L4 C O4 L4 G L4 F L4 E ")

]

midnight [

pl ""
pl "It came upon the midnight clear, That glorious song of old;"
pl "From angels bending near the earth To touch their harps of gold."
pl "Peace on the earth, good will to men From Heav'n's all gracious King."
pl "The world in solemn stillness lay To hear the angels sing."
pl "";pl ""

strcat(sc,"T80 O4 L8 F O5 L4 D O4 L8 A O5 L8 C O4 L8 B- L8 G L4 F L8 G ")
strcat(sc,"L4 F L8 F L8 G L8 A L8 B- L8 B- O5 L8 C L8 D L2 C O4 L8 F O5 ")
strcat(sc,"L4 D O4 L8 A O5 L8 C O4 L8 B- L8 G L4 F L8 G L4 F L8 F L4 G ")
strcat(sc,"L8 G L8 A L8 G L8 F L2 B- O5 L8 D L8 D O4 L8 D L8 D L8 E L8 ")
strcat(sc,"F# L5G L8 A L4 B- O5 L8 D L8 C O4 L8 B- L8 A L8 G L8 A L8 G ")
strcat(sc,"L2 F L8 F O5 L4 D O4 L8 A O5 L8 C O4 L8 B- L8 G L4 F L8 G L4 ")
strcat(sc,"F L8 F L4 G L8 G L8 A L8 G L8 F L2 B- ")

]

joy [

pl "Joy to the world! The Lord is come; Let earth receive her King,"
pl "Let every heart prepare Him Room,"
pl "And Heav'n and nature sing, And Heav'n and nature sing,"
pl "And Heav'n, and Heav'n and nature sing."

strcat(sc,"T120 O5 L4 C O4 L6 B L16 A L3 G L8 F L4 E L4 D L3 C L8 G L3 ")
strcat(sc,"A L8 A L3 B L8 B O5 L2 C L8 C L8 C O4 L8 B L8 A L8 G L6 G ")
strcat(sc,"L16 F L8 E O5 L8 C L8 C O4 L8 B L8 A L8 G L6 G L16 F L8 E L8 ")
strcat(sc,"E L8 E L8 E L16 E L16 F L3 G L16 F L16 E L8 D L8 D L8 D L16 ")
strcat(sc,"D L16 E L3 F L16 E L16 D L8 C O5 L4 C O4 L8 A L6 G L16 F L8 ")
strcat(sc,"E L8 F L4 E L4 D L2 C ")

]