'-----SIMULACAO DE UM ORGAO MUSICAL-----
'
KEY OFF:CLS:LOCATE,25
DEFINT A-Z
?" SIMULACAO DE UM ORGAO MUSICAL 
?
'
'-----ATIVACAO DE VIDEO-----
'
?"Este programa permite que seu computador imite ";
?"de uma forma simples a operacao de
?"um orgao musical.  Embora o PC nao seja ";
?"obviamente um orgao de tubo de R$ 100.000.000
?"ele pode produzir uma variedade de entradas";
?"de sons agradaveis.  A fileira de teclas
?"superiores compreende de C5-C6, a segunda de ";
?"C4-C5.  Pressionando-se a barra de espaco, desloca-se
?"todas as teclas para cima ou para baixo uma oitava para";
?" uma variacao de total de C4-C7.  O tremolo pode ser
?"ligado ou desligado pressionando-se o ENTER, enquanto ";
?"a duracao da nota pode ser ajustada em 0.1 seg.
?"incrementado por meio das teclas < e > ";
?"em caixa baixa.
?"APERTE UMA TECLA
slp$=INPUT$(1)
COLOR 7,1
CLS
LOCATE 1,30:?" Orgao Eletronico 
H$=STRING$(3,205):T$="Ä":X$="³":F$="ÄÄÄ
LOCATE 11,29:?"Designacao das teclas";
LOCATE 12,13:?"É";
FOR I=1 TO 12:?H$;CHR$(209);:NEXT
?H$;CHR$(187);
LOCATE 13,13:?CHR$(186);
?TAB(65);CHR$(186);
LOCATE 14,13:?CHR$(204);
FOR I=1 TO 12:?H$;CHR$(216);:NEXT
?H$;CHR$(185);
LOCATE 15,13:?CHR$(186);
?TAB(65);CHR$(186);
LOCATE 16,13:?CHR$(199);
FOR I=1 TO 12:?F$;CHR$(197);:NEXT
?F$;CHR$(182);
LOCATE 17,13:?CHR$(186);
?TAB(65);CHR$(186);
LOCATE 18,13:?CHR$(200);
FOR I=1 TO 12:?H$;CHR$(207);:NEXT
?H$;CHR$(188);
LOCATE 13,15
?"C";TAB(19);"C#";TAB(23);"D";TAB(27);"D#";TAB(31);"E";TAB(35);"F";TAB(39);"F#";TAB(43);"G";TAB(47);"G#";TAB(51);"A";TAB(55);"A#";TAB(59);"B";TAB(63);"C";
LOCATE 15,15:?"`";
FOR I=1 TO 9:?TAB(4*I+15);CHR$(I+48);:NEXT
?TAB(55);"0";TAB(59);"-";TAB(63);"=";
LOCATE 17,14
?"Tab";TAB(19);"Q";TAB(23);"W";TAB(27);"E";TAB(31);"R";TAB(35);"T";TAB(39);"Y";TAB(43);"U";TAB(47);"I";TAB(51);"O";TAB(55);"P";TAB(59);"[";TAB(63);"]";
FOR I=17 TO 61 STEP 4:LOCATE 13,I:?X$;:NEXT
FOR I=17 TO 61 STEP 4:LOCATE 15,I:?X$;:NEXT
FOR I=17 TO 61 STEP 4:LOCATE 17,I:?X$;:NEXT
LOCATE 20,1:?CHR$(218);STRING$(6,196);CHR$(191);TAB(72);CHR$(218);STRING$(7,196);CHR$(191);
LOCATE 21,1:?X$;"escala";X$;TAB(72);X$;"tremolo";X$;
LOCATE 22,1:?CHR$(192);STRING$(6,196);CHR$(217);TAB(72);CHR$(192);STRING$(7,196);CHR$(217);
LOCATE 20,30
FOR I=1 TO 9:?TAB(2*I+28);CHR$(48+I);:NEXT
?TAB(48);"10";
LOCATE 20,38:COLOR 31,1:?"5";:COLOR 7,1
LOCATE 21,30:?CHR$(212);
FOR I=1 TO 8:?CHR$(205);CHR$(207);:NEXT
?CHR$(205);CHR$(190);
LOCATE 22,31:?CHR$(27);" Duracao da Nota ";CHR$(26);
LOCATE 25,15:?"* Quando tiver acabado, pressione ";
?"S para Sair *";
'
'----INICIALIZACAO-----
'
TREMOLO=1'1=TREMOLO DESLIGADO,-1=TREMOLO LIGADO
SHIFT=1'1=CAIXA BAIXA,2=DESLOCA UMA OITAVA ACIMA
B=5:D=9'DURACAO INICIAL 0.5 SEG.
PLAY "MB"'INICIALIZA BUFFER PARA NOTAS
'
'----LOOP PARA LER O TECLADO----
'
800 V$=INPUT$(1)
SELECT CASE V$
CASE "`":F=523:GOSUB 2000:GOTO 800
CASE "1":F=554:GOSUB 2000:GOTO 800
CASE "2":F=587:GOSUB 2000:GOTO 800
CASE "3":F=622:GOSUB 2000:GOTO 800
CASE "4":F=659:GOSUB 2000:GOTO 800
CASE "5":F=698:GOSUB 2000:GOTO 800
CASE "6":F=740:GOSUB 2000:GOTO 800
CASE "7":F=784:GOSUB 2000:GOTO 800
CASE "8":F=831:GOSUB 2000:GOTO 800
CASE "9":F=880:GOSUB 2000:GOTO 800
CASE "0":F=932:GOSUB 2000:GOTO 800
CASE "-":F=988:GOSUB 2000:GOTO 800
CASE "=":F=1047:GOSUB 2000:GOTO 800
CASE CHR$(9):F=262:GOSUB 2000:GOTO 800
CASE "Q","q":F=277:GOSUB 2000:GOTO 800
CASE "W","w":F=294:GOSUB 2000:GOTO 800
CASE "E","e":F=311:GOSUB 2000:GOTO 800
CASE "R","r":F=330:GOSUB 2000:GOTO 800
CASE "T","t":F=349:GOSUB 2000:GOTO 800
CASE "Y","y":F=370:GOSUB 2000:GOTO 800
CASE "U","u":F=392:GOSUB 2000:GOTO 800
CASE "I","i":F=415:GOSUB 2000:GOTO 800
CASE "O","o":F=440:GOSUB 2000:GOTO 800
CASE "P","p":F=466:GOSUB 2000:GOTO 800
CASE "[":F=494:GOSUB 2000:GOTO 800
CASE "]":F=523:GOSUB 2000:GOTO 800
CASE " ":GOSUB 2500:GOTO 800'DESLOCA COM ESPACO
'NA LINHA DEBAIXO,<E>INICIALIZAM A DURACAO
CASE ",",".":GOSUB 3000:GOTO 800
CASE CHR$(13):GOSUB 3500:GOTO 800'CR=TREMOLO LIG/DESL
CASE "S","s":COLOR 7,0:CLS:SYSTEM
END SELECT
GOTO 800
SYSTEM
'
'-----SUBROTINA PARA TOCAR UMA NOTA-----
'
2000 SOUND 100,0:F=F*SHIFT
IF TREMOLO=1 THEN SOUND F,D:RETURN
N=.33*D:IF N<1 THEN N=1
DELTA=.012*F:F1=F+DELTA:F2=F-DELTA
'---CICLO DE TREMOLO---
FOR I=1 TO N
SOUND F1,1:SOUND F,1:SOUND F2,1
NEXT I
RETURN
'
'---SUBROTINA PARA DESLOCAMENTO DE UMA OITAVA---
'
2500 SHIFT=INT(1+(1/SHIFT))
IF SHIFT=1 THEN COLOR 7,1 ELSE COLOR 1,7
LOCATE 21,2:?"escala":COLOR 7,1
RETURN
'
'--SUBROTINA PARA DURACAO DAS NOTAS--
'
3000 C=B:IF V$="." THEN B=B+1 ELSE B=B-1
IF B>10 THEN B=10
IF B<1 THEN B=1
LOCATE 20,(2*C+28)
IF C<10 THEN ?CHR$(C+48)ELSE ?"10
COLOR 31,1:LOCATE 20,(2*B+28)
IF B<10 THEN ?CHR$(B+48)ELSE ?"10
COLOR 7,1:D=B*1.8
RETURN
'
'--SUBROTINA PARA INICIALIZAR O TREMOLO--
'
3500 TREMOLO=-TREMOLO
IF TREMOLO=1 THEN COLOR 7,1 ELSE COLOR 1,7
LOCATE 21,73:?"tremolo":COLOR 7,1
RETURN