Classic Computer Magazine Archive PROGRAM LISTING: 85-06/PIANO.LGO


TO SIGN :LEN
TELL [0 1] PU
TELL 0 BK 6 TELL 1 FD 14
TELL [0 1] LT 90 FD :LEN / 2 - 10
END

TO STAFF :LEN :HIT
CS PU LT 90 FD :LEN / 2 RT 90 FD :HIT * 5 / 2 PD
REPEAT 4 [SETH 90 FD :LEN BK :LEN RT 90 FD :HIT]
RT 180
REPEAT 2 [FD :HIT * 4 RT 90 FD :LEN RT 90]
SIGN :LEN
END

TO MEASURE
CS
TELL 2 STAFF 250 10
END

TO DIRECTIONS
CT
PR [IF YOU WANT THE COMPUTER TO PLAY]
PR [ALONG WITH YOU, PRESS 'y' NOW.]
MAKE "CHOI RC
IF :CHOI = "Y [PR [THE COMPUTER WILL PLAY ALONG.]] [PR [THE COMPUTER WILL NOT PLAY.]]
PR [Press a key to go on.]
PR RC CLEANUP
END

TO SETUP
SETBG 0
TELL 2 SETPN 0 SETPC 0 102 SETC 15
TELL [0 1] SETC 6
TELL [0 1 2] CS
TELL 2 MEASURE
TELL 2 PU SETPOS [0 -20] SETC 15
PUTSH 1 :NOAT
PUTSH 2 :STAFFLO
PUTSH 3 :STAFFHI
TELL 0 SETSH 2 TELL 1 SETSH 3
TELL 2 SETSH 1
END

TO BEEP :NOTE
SETENV 0 3
TOOT 0 :NOTE 10 20
END

TO PLAY :ST
IF :ST = "A [TYPE [\ c] SETY -20 OP 260.7]
IF :ST = "S [TYPE [\ d] SETY -15 OP 293.3]
IF :ST = "D [TYPE [\ e] SETY -10 OP 330]
IF :ST = "F [TYPE [\ f] SETY -5 OP 347.7]
IF :ST = "G [TYPE [\ g] SETY 0 OP 391.1]
IF :ST = "H [TYPE [\ a] SETY 5 OP 440]
IF :ST = "J [TYPE [\ b] SETY 10 OP 495]
IF :ST = "K [TYPE [\ C] SETY 15 OP 521.5]
IF :ST = "L [TYPE [\ D] SETY 20 OP 586.6]
IF :ST = "; [TYPE [\ E] SETY 25 OP 660]
IF :ST = "+ [TYPE [\ F] SETY 30 OP 695.4]
IF :ST = "* [TYPE [\ G] SETY 35 OP 782.2]
IF :ST = CHAR 32 [TYPE [\ ] SETY 0 OP 50000]
OP 50000
END

TO BEEP2 :NOTE
SETENV 0 3
TOOT 0 :NOTE 10 20
TOOT 1 :NOTE / 2 8 20
END

TO REMEM :ST
MAKE "LINE LPUT :ST :LINE
END

TO REPLAY :LINE
IF EMPTYP :LINE [STOP]
IF :CHOI = "Y [BEEP2 PLAY FIRST :LINE] [BEEP PLAY FIRST :LINE]
REPLAY BF :LINE
END

TO START
SETUP
BEEP2 PLAY "A
DIRECTIONS
GET.NOTE
END

TO CLEANUP
CT
PR [C\=CLEANUP,Y\=START OVER,R\=REPLAY]
MAKE "LINE []
END

TO GET.NOTE
.DEPOSIT 731 255
MAKE "ST RC
IF :ST = "C [CLEANUP GET.NOTE]
IF :ST = "Y [START]
IF :ST = "R [REPLAY :LINE GET.NOTE]
REMEM :ST
IF :CHOI = "Y [BEEP2 PLAY :ST] [BEEP PLAY :ST]
GET.NOTE
END


MAKE "ST "R
MAKE "STAFFHI [8 12 10 9 9 9 9 9 9 9 9 9 9 10 12 8]
MAKE "STAFFLO [8 24 40 72 136 136 136 138 141 141 139 137 137 73 42 28]
MAKE "NOAT [0 7 15 12 8 8 8 8 8 8 104 248 248 240 96 0]
MAKE "CHOI "Y
MAKE "LINE [S D F \  F G H \  H J K \  K K K]

Back to previous page