home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 601-625 / apd615 / source.asc < prev   
Text File  |  1986-08-03  |  38KB  |  1,491 lines
  1. ' ************************* ALEX'S COOL, FLASHY MIDI PROG *******************
  2.  
  3. ' Version C is the tidied up fixed verion
  4. ' Version D displays no messages 
  5. ' Version E has complete rewrite of graph routine which was too messy
  6. '      making it run too slow. + intro built in to start 
  7. ' Version f has vu_meters routine (v. crappy)
  8. ' Version g has vel vs pitch routine with rainbow. realy nice! 
  9. ' Version h has dodgy picture viewer 
  10. ' Version i has new picture viewer and ravey circles 
  11. ' version j has ghost player piano taken out the crappy vu_meters
  12. ' verison k has music score routine completed
  13. ' version l has verical bars routine (v1)
  14. ' **************** INITIALISE, SETUP SCREEN AND VARIABLES *******************
  15.  
  16.  
  17. ' Dimention arrays 
  18. Dim CHANEL_MESSAGE$(113)
  19. Dim COMMON_MESSAGE$(7)
  20. Dim REAL_TIME_MESSAGE$(15)
  21. Dim NOEON(2)
  22.  
  23. Dim EBONY_N_IVORY$(12),EBONY_N_IVORY(12)
  24.  
  25. Dim PITCH_2KEY_CONVERSION_TABLE(24)
  26.  
  27. Dim GRAPHX_OLD(16)
  28. Dim GRAPHY_OLD(16)
  29.  
  30. Dim PY(85)
  31.  
  32. Dim SCR(2)
  33.  
  34. Dim CX(360)
  35.  
  36. Dim SPRYT(110)
  37.  
  38. Dim MSCORE_YCORD(46),MSCORE_SHAPE(46)
  39. Dim SCRDATA(5),CHANEL_COLOURS(16)
  40.  
  41. Dim HORIS_SLIDERX(16),OLD_HORIS_SLIDERX(16)
  42.  
  43. ' Allow these variables to be used throughout all procedures 
  44. Global CHANEL_MESSAGE$(),COMMON_MESSAGE$(),REAL_TIME_MESSAGE$(),X,PITCH,VEL
  45. Global BEEN_TO_NOTE_ON,NOEON(),EBONY_N_IVORY$(),EBONY_N_IVORY(),NOE,COUNT,KOUNT
  46. Global PITCH_2KEY_CONVERSION_TABLE(),CHANEL,NEED_A_ROUTINE,CHANGEIT,S
  47.  
  48. Global GRAPHX,GRAPHX_OLD(),GRAPHY,GRAPHX_MAX,GRAPHX_MIN,GRAPHY_MIN,GRAPH_SPACE
  49. Global GRAPHY_OLD(),FILTER,ALREADY_PULSED,OLD_TIME,TIME
  50. Global ROUTINE_COUNTER,CYCLE_PIANO_SKY_CHANGE,CYCLE_PIANO_SKY_CHANGE_MAX
  51.  
  52. Global VUHEIGHT,VUHEIGTMAX,VUWIDTH,VUY
  53.  
  54. Global PY(),EX_ROUTINE
  55.  
  56. Global OLDPIC
  57.  
  58. Global CX()
  59.  
  60. Global SPRYT(),SPRY_NUMBER
  61.  
  62. Global MSCORE_YCORD(),MSCORE_SHAPE(),MSCOREX,MSCOREY,MSCOREX_MAX,MSCOREX_MIN
  63. Global MSCORE_SPACE,MSCORE_TOP_OR_BOTTOM_OFFSET,MSCORE_TOP_OR_BOTTOM
  64. Global SCRDATA(),CHANEL_COLOURS()
  65.  
  66. Global HORIS_SLIDERX(),OLD_HORIS_SLIDERX(),LISTEN_TO
  67.  
  68.  
  69. ' Turn off disk operating system and text editor 
  70.  
  71. Close Workbench : Close Editor 
  72.  
  73. ' Do the intro and initialise main program 
  74. Proc FLOATING_NOTES_INTRO
  75.  
  76. Proc INIT
  77.  
  78. Proc SLIDER_PREFS
  79. ' Turn off external interupts (eg. test for mouse movement)
  80. Dreg(0)=Execall(-132)
  81.  
  82. ' Make a beep when ready to start
  83. Play 60,1
  84.  
  85.  
  86.  
  87. '   * * * * * * * * * * * * M A I N    L O O P * * * * * * * * * * * 
  88.  
  89.  
  90. Do 
  91.    
  92.    Proc FETCHMIDI
  93.    Proc ANALYSE_MIDI
  94.    If BEEN_TO_NOTE_ON=1 Then Proc PICK_OUTPUT_ROUTINE
  95.    
  96. Loop 
  97.  
  98. Proc _CLOSEDOWN
  99.  
  100. End 
  101.  
  102. '  ************************** E N D   O F   P R O G R A M ***************
  103. '  ----------------------------------------------------------------------
  104.  
  105.  
  106.  
  107. '  ----------------------------------------------------------------------
  108. '  ***************************** P R O C E D U R E S ********************
  109.  
  110. ' ***--- MIDI DECODING/TRANSLATION ROUTINES ---*** 
  111.  
  112. Procedure INIT
  113. Screen Open 0,360,256,2,Lowres
  114.    Cls 0
  115.    
  116.    'Set up Serial Port  
  117.    Serial Open 1,0,0,0,0
  118.    Serial Speed 1,31250
  119.    Serial Bits 1,8,1
  120.    Serial Parity 1,-1
  121.    Serial Buf 1,2048
  122.    
  123.    ' Set up messages for text output
  124.    CHANEL_MESSAGE$(0)="Note off"
  125.    CHANEL_MESSAGE$(16)="Note on message"
  126.    CHANEL_MESSAGE$(32)="Poly key pressure"
  127.    CHANEL_MESSAGE$(48)="Control change"
  128.    CHANEL_MESSAGE$(64)="Program change"
  129.    CHANEL_MESSAGE$(80)="Channel pressure"
  130.    CHANEL_MESSAGE$(96)="Pitch bend"
  131.    CHANEL_MESSAGE$(112)="System message"
  132.    
  133.    COMMON_MESSAGE$(0)="System exclusive"
  134.    COMMON_MESSAGE$(1)="MIDI Time code"
  135.    COMMON_MESSAGE$(2)="Song position pointer"
  136.    COMMON_MESSAGE$(3)="Song select"
  137.    COMMON_MESSAGE$(4)="Undefined com message1"
  138.    COMMON_MESSAGE$(5)="Undefined com message2"
  139.    COMMON_MESSAGE$(6)="Tune request"
  140.    COMMON_MESSAGE$(7)="End of system exclusive"
  141.    
  142.    'REAL_TIME_MESSAGE$(0)="Timing Clock"
  143.    REAL_TIME_MESSAGE$(1)="Undefined Real Time message1"
  144.    REAL_TIME_MESSAGE$(2)="Start"
  145.    REAL_TIME_MESSAGE$(3)="Continue"
  146.    REAL_TIME_MESSAGE$(4)="Stop"
  147.    REAL_TIME_MESSAGE$(5)="Undefined Real Time message2"
  148.    REAL_TIME_MESSAGE$(6)="Active sensing"
  149.    REAL_TIME_MESSAGE$(7)="System reset"
  150.    
  151.    ' Keys data for Player_piano_routine 
  152.    For LOUP=1 To 12
  153.       Read EBONY_N_IVORY$(LOUP)
  154.    Next LOUP
  155.    Data "C","#","D","#","E","C","#","D","#","D","#","E"
  156.    
  157.    For LOUP=1 To 12
  158.       Read EBONY_N_IVORY(LOUP)
  159.    Next LOUP
  160.    Data 0,5,13,21,27,40,44,53,59,65,74,78
  161.    
  162.    
  163.    ' Get the cycle_piano routine ready for imediate use 
  164.    Proc CYCLE_PIANO_SETUP
  165.    
  166.    ' Set up graph variables ready for imediate use
  167.    Proc GRAPH_SETUP
  168.  
  169. ' set up defalt prefs
  170. Restore PREFS
  171. For LOUP=8 To 1 Step -1
  172. Read HORIS_SLIDERX(LOUP)
  173. Next LOUP
  174. PREFS:
  175. Data 98,24,99,104,103,102,101,100
  176.  
  177.    ' Reset routine counter
  178.    ROUTINE_COUNTER=101
  179.    Proc ROUTINE_SWAP
  180.    
  181.    ' set up vel_vs_pitch_vector_graph for use.
  182.    Proc VEL_VS_PITCH_SETUP
  183.    
  184.    ' set up picture screen for use
  185.    Proc PIC_VIEWER_SETUP
  186.    
  187.    ' set up player_piano for use
  188.    Proc PIANO_PLAYER_SETUP
  189.    
  190.    ' set up music score maker for use 
  191.    Proc MSCORE_SETUP
  192.    
  193. End Proc
  194. Procedure FETCHMIDI
  195.    
  196.    'Read SERIALPort 
  197.    Repeat 
  198.       FETCH_DATA[X]
  199.       If FILTER=False and X=$FE Then Proc CLOCK_PULSE
  200.       
  201.    Until X<>$FE and X<>$F8
  202.    
  203.    ' Not all routines need all data therefore do filtering other wise 
  204.    ' recognise a midi clock pulse and go no further.
  205.    
  206.    
  207.    
  208. End Proc
  209. Procedure ANALYSE_MIDI
  210.    'CHECK BIT 7 To SEE WHAT TYPE OF MESSAGE : STATUS or Data  
  211.    If(X and $80) Then Proc STATUS_BYTE Else Proc DAT_BYTE
  212.    
  213. End Proc
  214. Procedure FETCH_DATA[X]
  215.    ' Read data procedure. Ignores  -1 (no data found) 
  216.    
  217.    Repeat 
  218.       X=Serial Get(1)
  219.    Until X<>-1
  220.    
  221. End Proc[X]
  222.  
  223. ' *STATUS BYTE ROUTINES* 
  224.  
  225. Procedure STATUS_BYTE
  226.    ' Test and go to appropriate proc
  227.    
  228.    If(X<$F0) Then Proc CHANEL_MESSAGE Else Proc SYS_MESSAGE
  229.    
  230. End Proc
  231. Procedure CHANEL_MESSAGE
  232.    
  233.    CHANEL=(X and $F)+1
  234.    STATUS=(X and $70)
  235.    
  236.    ' The print statement below for debugging only.
  237.    ' Print CHANEL_MESSAGE$(STATUS);" on channel ";CHANEL
  238.    
  239.    ' if PROGRAM CHANGE message occurs (64) then this may be voice 99 to change
  240.    ' the output routine.
  241.    If STATUS=64 Then CHANGEIT=True : Proc ROUTINE_CHANGE
  242.    
  243.    
  244.    
  245.    ' Ignore pitch bend data (this is part of note on messages and is not required.) 
  246.    If STATUS=96 Then BEEN_TO_NOTE_ON=0 : Pop Proc
  247.    
  248.    '   If STATUS=16 and BEEN_TO_NOTE_ON=0 Then BEEN_TO_NOTE_ON=0 : Proc NOE_ON
  249.    
  250.    ' *** (resets the been_to_note_on flag. A diffent sys message has) 
  251.    ' *** (been encountered that is not going to be pitch or velocity.)
  252.    
  253.    If STATUS=16 Then BEEN_TO_NOTE_ON=0 : Proc NOE_ON
  254.    If STATUS=0 Then BEEN_TO_NOTE_ON=0 : Proc NOE_OFF
  255. End Proc
  256. Procedure SYS_MESSAGE
  257.    
  258.    BEEN_TO_NOTE_ON=0
  259.    If(X and $8) Then Proc REAL_TIME_MESSAGE Else Proc COMMON_MESSAGE
  260.    
  261. End Proc
  262.  
  263. ' (messages taken out, these are now empty routines!) proc then endproc! 
  264. Procedure REAL_TIME_MESSAGE
  265.    
  266.    ' THE BELOW MESSAGE Not NEEDED ANYMORE 
  267.    '   If(X and 7)<>0 Then Print REAL_TIME_MESSAGE$(X and 7)
  268.    
  269. End Proc
  270. Procedure COMMON_MESSAGE
  271.    
  272.    '   Print "COMMON routine" 
  273.    ' Print REAL_TIME_MESSAGE$(X and $7) 
  274.    
  275. End Proc
  276.  
  277. ' *DATA BYTE ROUTINES* 
  278. Procedure DAT_BYTE
  279.    
  280.    
  281.    If BEEN_TO_NOTE_ON=1 Then Proc NOE_ON : Rem Else Print "DATA ignored"
  282.    '                                        ^^^^^ message taken out 
  283.    '                                        *********************** 
  284.    ' *** ( if the program has just been to the note on procedure) 
  285.    ' *** ( Then the data is still pitch and velocity data)  
  286.    
  287. End Proc
  288. Procedure NOE_ON
  289.    
  290.    ' Read PITCH   
  291.    If BEEN_TO_NOTE_ON=0 Then FETCH_DATA[X] : PITCH=X
  292.    If BEEN_TO_NOTE_ON=1 Then PITCH=X : Rem (Don't have to read pitch again.)
  293.    '  (the x variable is data which is pitch) 
  294.    
  295.    ' Read Velocity
  296.    FETCH_DATA[X]
  297.    VEL=X
  298.    
  299.    
  300.    ' Output results 
  301.    '   Print "Note ";PITCH; 
  302.    If VEL>0 Then NOE=1 Else NOE=0
  303.    
  304.    
  305.    ' Put results into a form suitable to be passed to the gfx routines
  306.    
  307.    ' a nice, neat array containing pitch and note on/off status.
  308.    NOEON(1)=PITCH
  309.    NOEON(2)=NOE
  310.    
  311.    
  312.    ' Set been_to_note_on flag as 1 so if NOE_ON proc is called again straight 
  313.    ' away the procedure will remember not to read the serial port again as
  314.    ' the data in the x variable is the pitch. 
  315.    
  316.    BEEN_TO_NOTE_ON=1
  317.    
  318. End Proc
  319.  
  320. Procedure NOE_OFF
  321.    'Say "Note off.  HELP!  help. help!" 
  322.    ' Read PITCH   
  323.    If BEEN_TO_NOTE_ON=0 Then FETCH_DATA[X] : PITCH=X
  324.    If BEEN_TO_NOTE_ON=1 Then PITCH=X : Rem (Don't have to read pitch again.)
  325.    '  (the x variable is data which is pitch) 
  326.    
  327.    
  328.    ' Output results 
  329.    '   Print "Note ";PITCH; 
  330.    NOE=0
  331.    
  332.    
  333.    ' Put results into a form suitable to be passed to the gfx routines
  334.    
  335.    ' a nice, neat array containing pitch and note on/off status.
  336.    NOEON(1)=PITCH
  337.    NOEON(2)=NOE
  338.    
  339.    
  340.    ' Set been_to_note_on flag as 1 so if NOE_ON proc is called again straight 
  341.    ' away the procedure will remember not to read the serial port again as
  342.    ' the data in the x variable is the pitch. 
  343.    
  344.    BEEN_TO_NOTE_ON=1
  345.    
  346. End Proc
  347. Procedure _CLOSEDOWN
  348.    
  349.    'Dreg(0)=Execall(-138) 
  350.    Play 60,1
  351. End Proc
  352.  
  353.  
  354.  
  355. ' ***********************************************************************
  356. ' ***--- GRAPHICAL OUTPUT ROTINES (THE FLASHY STUFF!) ---*** 
  357.  
  358. ' Pick a routine from all the below
  359.  
  360. Procedure ROUTINE_CHANGE
  361.    
  362.    Proc FETCH_DATA[X]
  363.    
  364.    'check the 8 horis_slider variables incase a change of routine is called for     
  365.    For LOUP=1 To 8
  366.       If X=HORIS_SLIDERX(LOUP) Then Proc ROUTINE_SWAP
  367.    Next LOUP
  368. End Proc
  369. Procedure ROUTINE_SWAP
  370.    ROUTINE_COUNTER=X
  371.    
  372.    ' Closedown old routines if necessary
  373.    If EX_ROUTINE=4 Then Proc VEL_VS_PITCH_DISAPPEAR
  374.    If EX_ROUTINE=3 Then Proc PIANO_PLAYER_DISAPPEAR
  375.    If EX_ROUTINE=-1 Then Proc VERTICAL_BARS_DISAPPEAR
  376.    
  377.    ' Set up screens for the new routines
  378.    If ROUTINE_COUNTER=HORIS_SLIDERX(1) Then Proc GRAPH_APPEAR
  379.    If ROUTINE_COUNTER=HORIS_SLIDERX(2) Then Proc CYCLE_PIANO_APPEAR
  380.    If ROUTINE_COUNTER=HORIS_SLIDERX(3) Then Proc PIANO_PLAYER_APPEAR
  381.    If ROUTINE_COUNTER=HORIS_SLIDERX(4) Then Proc VEL_VS_PITCH_APPEAR
  382.    If ROUTINE_COUNTER=HORIS_SLIDERX(5) Then Proc PIC_VIEWER_APPEAR
  383.    If ROUTINE_COUNTER=HORIS_SLIDERX(7) Then Proc MSCORE_APPEAR
  384.    If ROUTINE_COUNTER=HORIS_SLIDERX(8) Then Proc VERTICAL_BARS_APPEAR
  385. End Proc
  386. Procedure PICK_OUTPUT_ROUTINE
  387.    
  388.    
  389.    ' routine currently tested 
  390.    ' ROUTINE_COUNTER=5
  391.    
  392.    
  393.    '    Proc TXT_DISPLAY
  394.    '   Pop Proc 
  395.    '   Proc PITCHNO_2_KEY   
  396.    
  397.    
  398.    If ROUTINE_COUNTER=HORIS_SLIDERX(1) Then Proc GRAPH
  399.    If ROUTINE_COUNTER=HORIS_SLIDERX(2) Then Proc CYCLE_PIANO
  400.    If ROUTINE_COUNTER=HORIS_SLIDERX(3) Then Proc PIANO_PLAYER
  401.    If ROUTINE_COUNTER=HORIS_SLIDERX(4) Then Proc VEL_VS_PITCH
  402.    If ROUTINE_COUNTER=HORIS_SLIDERX(5) Then Proc PIC_VIEWER
  403.    If ROUTINE_COUNTER=HORIS_SLIDERX(6) Then Proc CIRC
  404.    If ROUTINE_COUNTER=HORIS_SLIDERX(7) Then Proc MSCORE
  405.    If ROUTINE_COUNTER=HORIS_SLIDERX(8) Then Proc VERTICAL_BARS
  406. End Proc
  407.  
  408. Procedure CLOCK_PULSE
  409.    
  410.    ' what to do if pitch vs time graph is running 
  411.    If ROUTINE_COUNTER=1 and ALREADY_PULSED=False Then Proc _INCREMENT_GRAPHX : Proc _INCREMENT_GRAPHX
  412.    
  413.    ' what to do if velocity vs pitch graph is running 
  414.    If ROUTINE_COUNTER=4 Then Proc VECTOR_PTS_DECREASE_YET[1]
  415.    
  416.    ALREADY_PULSED=True
  417. End Proc
  418.  
  419. ' *****TEXT OUTPUT ROUTINES***** 
  420. ' Mainly for debuging and testing ideas
  421. Procedure TXT_DISPLAY
  422.    S=Screen
  423.    If S<>0 Then Bell : Screen Open 0,320,250,2,LORES : Screen To Front 0 : Screen 0
  424.    
  425.    Print "Pitch =";NOEON(1);PITCH
  426.    If NOEON(2)=0 Then Print " off!" Else Print " on!" : Play 1,PITCH,0
  427.    
  428. End Proc
  429. Procedure PITCHNO_2_KEY
  430.    Screen To Front 0
  431.    Screen 0
  432.    ' This procedure is used to work out from the pitch, the key that is played
  433.    ' ie. pitch=32 might be the key C#. This information is useful to the
  434.    ' player_piano routine.
  435.    
  436.    
  437.    ' NOTES:  PITCH24 IS LOWEST C
  438.    
  439.    
  440.    PRESSED=PITCH
  441.    Add PRESSED,1
  442.    
  443.    ' get pressed between 1 and 12 
  444.    While PRESSED>12
  445.       Add PRESSED,-12
  446.    Wend 
  447.    Bell 
  448.    Print EBONY_N_IVORY$(PRESSED),PRESSED,PITCH,
  449.    If NOE=1 Then Print "on" Else Print "off"
  450.    
  451. End Proc
  452.  
  453. Procedure FLOATING_NOTES_INTRO
  454.    
  455.    Degree 
  456.    Dim XC(4),YC(4),XIC(4),YIC(4)
  457.    Hide On 
  458.    No Mask : For F=1 To 3 : Make Mask F : Next F
  459.    BUBBLE$=" R:  L R1=Z(2)+1; A 1,(R1,1); L R0=Z(6)+1; L Y=296; L:  L Y=Y-R0; I Y<0 J R; P; J L;"
  460.    BUBBLE2$=" R:  L Y=1; P; L:  L Y=Y+2; I Y>256 J R; P; J L;"
  461.    
  462.    Unpack 5 To 0
  463.    
  464.    Unpack 7 To 1
  465.    Palette 0,0
  466.    Wait Vbl : Dual Playfield 0,1
  467.    Screen 0
  468.    For F=8 To 15 : Sprite F,((F-8)*40)+128,1,1 : Channel F To Sprite F : Amal F,BUBBLE$ : Next F
  469.    Channel 1 To Screen Offset 1 : Amal 1,BUBBLE2$ : Amal On 
  470.    
  471.    Fade 3,0,4072,3490,3202,$400,$600,$EEE,$A50,0,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
  472.    
  473.    
  474.    Repeat 
  475.    Until Mouse Key=1 or Joy(1)=16
  476.    
  477.    Fade 3 : Wait 45
  478.    For F=8 To 15 : Amal Off F : Sprite Off F : Next F
  479.    Amal Off 1 : Screen Close 1
  480. End Proc
  481.  
  482. ' *****CYCLE_PIANO_ROUTINES!*******
  483. ' The futuristic keyboard. Keys flashed by colour cycling technique  
  484. ' (ie changing the palette colours)
  485. Procedure CYCLE_PIANO
  486.    
  487.    '******************************************************************* 
  488.    '  
  489.    '   C Y C L E   P I A N O     N O T E S. 
  490.    '
  491.    '
  492.    '      If get a better cycle piano routine (ie full 5 octaves) then make 
  493.    '      the original screen back to like in demo. Don't bother about  
  494.    '      drawing out the extra black notes that arn't there realy. 
  495.    ' and don't worry about acuracy. just have it as a flashy routine. Not 
  496.    ' accurate.
  497.    '      Make it so that keys just flash black then fade out. dont have
  498.    '      red until the right noe off message recived. this will halve
  499.    '      the amount of processing! (no noe offs) 
  500.    '    do this by having a sepearate proc fade_keys to do the keys 
  501.    'and a pop proc if noe=0.
  502.    '********************************************************************
  503.    
  504.    'Count how many times the procedure has been run and change the sky colour!
  505.    Add COUNT,1,1 To 200
  506.    If COUNT=199 Then Proc CYCLE_PIANO_CHANGE_SKY
  507.    
  508.    
  509.    ' Flash keys 
  510.    Proc CYCLE_PIANO_KEYS_FLASH
  511.    
  512. End Proc
  513. Procedure CYCLE_PIANO_SETUP
  514.    
  515.    
  516.    Unpack 8 To 1
  517.    
  518.    Screen Hide 1
  519.    
  520.    ' pitch to key conversion table' 
  521.    Restore CONV_TABLE
  522.    For LOUP=0 To 24
  523.       Read PITCH_2KEY_CONVERSION_TABLE(LOUP)
  524.    Next LOUP
  525.    
  526.    CYCLE_PIANO_SKY_CHANGE_MAX=4
  527.    
  528.    ' *********  conversion table ***********
  529.    CONV_TABLE:
  530.    Data 0,-1,1,-1,2,3,-1,4,-1,5,-1,6,7,-1,8,-1,9,10,-1,11,-1,5,-1,6,7
  531.    ' ***************************************
  532.    
  533. End Proc
  534. Procedure CYCLE_PIANO_APPEAR
  535.    
  536.    ' hide old screen
  537.    S=Screen
  538.    Screen Hide S
  539.    
  540.    ' Display cycle_piano screen 
  541.    
  542.    Screen Show 1
  543.    Screen To Front 1
  544.    Screen 1
  545.    
  546.    'turn the read data filter on
  547.    FILTER=True
  548.    CYCLE_PIANO_SKY_CHANGE=1
  549. End Proc
  550. Procedure CYCLE_PIANO_KEYS_FLASH
  551.    
  552.    ' Change pitch (a value between about 1 and 70) to pressed 
  553.    '                                              (a value between 1 and 12)
  554.    PRESSED=PITCH
  555.    
  556.    ' Decrese pitch to a value between 1 and 24 (covers the 1 and a bit octaves of keyboard) 
  557.    While PRESSED>23
  558.       Add PRESSED,-24
  559.    Wend 
  560.    
  561.    
  562.    ' Convert key PRESSED to screen palette colour number
  563.    PRESSED=PITCH_2KEY_CONVERSION_TABLE(PRESSED)
  564.    
  565.    
  566.    ' Ignore the black keys
  567.    ' Quit the procedure now if key PRESSED is a black key (-1)
  568.    If PRESSED=-1 Then Pop Proc
  569.    
  570.    ' first colour in palette is no 20 so add 20   
  571.    Add PRESSED,20
  572.    
  573.    
  574.    ' Change colours 
  575.    If NOE=0 Then Colour PRESSED,$FFF Else Colour PRESSED,$F00
  576.    
  577. End Proc
  578. Procedure CYCLE_PIANO_CHANGE_SKY
  579.    ' Change the colour of the sky!
  580.    'Add CYCLE_PIANO_SKY_CHANGE,1,1 To CYCLE_PIANO_SKY_CHANGE_MAX
  581.    Add KOUNT,1,1 To 3
  582.    If KOUNT=3 Then C=$EEF : D=$221 : Rem BLUE!
  583.    If KOUNT=2 Then C=$EFE : D=$212 : Rem GREEN! 
  584.    If KOUNT=1 Then C=$FEE : D=$122 : Rem RED! 
  585.    
  586.    For LOUP=1 To 7 : Rem  Go through the 7 colours used in the sky and change 'em 
  587.       
  588.       Add C,-D
  589.       Colour LOUP,C
  590.       
  591.       ' Wait until the next video blank
  592.       ' Slows down the colouring so looks more like a nice fade
  593.       ' rather than a sudden change  
  594.       Wait Vbl 
  595.       
  596.    Next LOUP
  597. End Proc
  598.  
  599.  
  600. ' ****** MUSICAL SCORE ROUTINES! *********** 
  601. '****** this was tricky! ****************
  602.  
  603.  
  604.  
  605. Procedure MSCORE
  606.    Proc _INCREMENT_MSCOREX
  607.    
  608.    If NOE=0
  609.       ALREADY_PULSED=False
  610.       Pop Proc
  611.    Else 
  612.       Proc STICK_NOTES_DOWN
  613.       ALREADY_PULSED=False
  614.    End If 
  615.    
  616. End Proc
  617. Procedure MSCORE_SETUP
  618.    
  619.    
  620.    ' set up variables 
  621.    
  622.    MSCOREX_MIN=60
  623.    MSCOREX_MAX=600
  624.    MSCORE_SPACE=5
  625.    
  626.    ' read in notes data 
  627.    Restore MSCORE_DATA
  628.    For LOUP=1 To 46
  629.       Read MSCORE_YCORD(LOUP)
  630.       Read MSCORE_SHAPE(LOUP)
  631.    Next LOUP
  632.    
  633.    Make Icon Mask 
  634.    
  635.    ' Comma separated variable data statement in the format  
  636.    ' Data y-coordinate,sprite(ie note shape)number  
  637.    
  638.    ' **************************************************************************** 
  639.    
  640.    
  641.    '    b    a#    a    g#    g    f#    f    e    d#    d    c#    c    b    a#      
  642.    MSCORE_DATA:
  643.    Data 11,7,11,16,15,9,14,12,18,5,17,12,21,5,25,5,25,12,29,5,28,12,32,5,13,6,16,13
  644.  
  645.    '    a    g#    g    f#    f    e    d#    d    c#    c     b        
  646.    Data 16,6,20,13,20,6,23,13,23,6,27,6,30,13,30,6,36,17,36,10,65,5
  647.    
  648.    '    a#    a    g#    g    f#    f    e    d#    d    c#    c    b    a#       
  649.    Data 65,12,69,5,68,12,72,5,72,12,76,5,79,5,59,13,59,6,63,13,63,6,66,6,70,13
  650.    
  651.    '    a    g#    g    f#    f    e     d#    d        
  652.    Data 70,6,74,13,74,6,77,13,77,6,82,10,86,15,86,8
  653.    '******************************************************************************* 
  654.    
  655. End Proc
  656. Procedure MSCORE_APPEAR
  657.    
  658.    ' hide last screen 
  659.    S=Screen
  660.    Screen Hide S
  661.    
  662.    ' create screen and Load in background screen  
  663.    Screen Open 0,640,256,2,Hires
  664.    Load Iff "ram:pics/music_sheet"
  665.    
  666.    'turn read data filter on
  667.    FILTER=True
  668.    
  669. End Proc
  670. Procedure _INCREMENT_MSCOREX
  671.    
  672.    Proc TIMECHECK
  673.    TIME=Param
  674.    ' time is set to value returned by timecheck procedure (parameter passing) 
  675.    
  676.    MOVEUP=Abs(OLD_TIME-TIME)
  677.    
  678.    If MOVEUP<MSCORE_SPACE Then Pop Proc : Rem only move up if its worth it   
  679.    
  680.    ' increment mscorex by incrementing moveup like this rather than 
  681.    '     "Add mscorex,moveup*3" 
  682.    ' because that Add instruction works very much faster than the multiplying 
  683.    ' operator.                          ----  
  684.    
  685.    EXTRA=MOVEUP
  686.    Add MOVEUP,MOVEUP
  687.    'Add MOVEUP,EXTRA
  688.    ' moveup is now moveup*3 
  689.    
  690.    Add MSCOREX,MOVEUP,MSCOREX_MIN To MSCOREX_MAX
  691.    
  692.    OLD_TIME=TIME
  693.    If MSCOREX=MSCOREX_MIN Then Proc MSCORE_CLEAR_SCREEN
  694.    
  695. End Proc
  696. Procedure STICK_NOTES_DOWN
  697.    
  698.    
  699.    'This is the procedure that puts notes onto the paper' 
  700.    
  701.    ' decrease pitch to a value between 1 and 46 
  702.    ' (because thats the range of note we can put on screen) 
  703.    PRESSED=96-PITCH
  704.    If PRESSED>46 or PRESSED<1 Then Pop Proc
  705.    
  706.    ' Set up y-coordinate according to which sheet to print the notes on 
  707.    ' top sheet or the bottom sheet
  708.    MSCORE_Y=MSCORE_YCORD(PRESSED)+MSCORE_TOP_OR_BOTTOM_OFFSET
  709.    
  710.    ' Decrese pitch to a value between 1 and 12 (to check if a black note was played)  
  711.    BLK_OR_WHITE=PITCH+1
  712.    While BLK_OR_WHITE>12
  713.       Add BLK_OR_WHITE,-12
  714.    Wend 
  715.    
  716.    
  717.    ' Use the ebony_n_ivory array (set up in initailisation proc) to check 
  718.    ' if the PRESSED key is a "#" sharp ie black key and take that into
  719.    ' account when working out x,y co-ords 
  720.    
  721.    If EBONY_N_IVORY$(BLK_OR_WHITE)="#"
  722.  
  723. ' move up the x-coord to make room for the # sign
  724.  
  725.       Add MSCOREX,10,MSCOREX_MIN To MSCOREX_MAX
  726.       OLD_TIME=TIME
  727.       If MSCOREX=MSCOREX_MIN
  728.          Proc MSCORE_CLEAR_SCREEN
  729.       End If 
  730.  
  731.       Paste Icon MSCOREX,MSCORE_Y,MSCORE_SHAPE(PRESSED)
  732.       
  733.    Else 
  734.       ' Put the right shaped note at the right coordinate on the screen
  735.       Paste Icon MSCOREX,MSCORE_Y,MSCORE_SHAPE(PRESSED)
  736.       
  737.    End If 
  738.    
  739.    
  740.    
  741.    
  742. End Proc
  743. Procedure MSCORE_CLEAR_SCREEN
  744.    
  745.    If MSCORE_TOP_OR_BOTTOM=0
  746.       ' Overlay blank graph background picture that has been saved in main memory
  747.       Load Iff "ram:pics/music_sheet"
  748.       
  749.       'reset the top_or_bottom_y-coordinat offset
  750.       MSCORE_TOP_OR_BOTTOM_OFFSET=0
  751.    Else 
  752.       MSCORE_TOP_OR_BOTTOM_OFFSET=118
  753.       
  754.    End If 
  755.    
  756.    ' reset time axis base 
  757.    Proc TIMECHECK
  758.    OLD_TIME=Param
  759.    
  760.    ' reverse the top or bottom flag 
  761.    Add MSCORE_TOP_OR_BOTTOM,1,0 To 1
  762.    
  763. End Proc
  764.  
  765.  
  766. ' ******* PITCH vs TIME GRAPH
  767. ' V2 after complete re-write (got too messy and slow)
  768.  
  769. Procedure GRAPH
  770.    Proc _INCREMENT_GRAPHX
  771.    If NOE=0
  772.       ALREADY_PULSED=False
  773.       Pop Proc
  774.    Else 
  775.       Proc GRAPH_PLOT
  776.       ALREADY_PULSED=False
  777.    End If 
  778. End Proc
  779. Procedure GRAPH_SETUP
  780.    
  781.    'set up screen 
  782.    
  783.    Hide : Flash Off : Curs Off 
  784.    Unpack 4 To 3
  785.    Save Iff "ram:graph_background.iff"
  786.    Screen Hide 3
  787.    
  788.    ' set up variables 
  789.    GRAPHY_MIN=250
  790.    GRAPHX_MIN=10
  791.    GRAPHX_MAX=310
  792.    GRAPH_SPACE=5
  793.    
  794.    'reset graph coords to start position
  795.    
  796.    For LOUP=1 To 16
  797.       GRAPHY_OLD(LOUP)=GRAPHY_MIN/2 : Rem set graph y to mid position
  798.       GRAPHX_OLD(LOUP)=GRAPHX_MIN
  799.    Next LOUP
  800.    
  801.    
  802. End Proc
  803. Procedure GRAPH_APPEAR
  804.    
  805.    ' hide last screen 
  806.    S=Screen
  807.    Screen Hide S
  808.    
  809.    GRAPHX=GRAPHX_MIN
  810.    Screen Show 3
  811.    Screen To Front 3
  812.    Screen 3
  813.    Proc GRAPH_CLEAR_SCREEN
  814.    FILTER=False
  815.    
  816. End Proc
  817. Procedure _INCREMENT_GRAPHX
  818.    
  819.    Proc TIMECHECK
  820.    TIME=Param
  821.    ' time is set to value returned by timecheck procedure (parameter passing) 
  822.    
  823.    MOVEUP=Abs(OLD_TIME-TIME)
  824.    
  825.    If MOVEUP<GRAPH_SPACE Then Pop Proc : Rem only move up if its worth it   
  826.    Add GRAPHX,MOVEUP,GRAPHX_MIN To GRAPHX_MAX
  827.    
  828.    OLD_TIME=TIME
  829.    If GRAPHX=GRAPHX_MIN Then Proc GRAPH_CLEAR_SCREEN
  830.    
  831.    
  832.    
  833.    
  834.    '   Add GRAPHX,GRAPH_SPACE,GRAPHX_MIN To GRAPHX_MAX
  835.    '   If GRAPHX=GRAPHX_MIN Then Proc GRAPH_CLEAR_SCREEN
  836.    
  837.    
  838. End Proc
  839. Procedure GRAPH_CLEAR_SCREEN
  840.    
  841.    ' Overlay blank graph background picture that has been saved in main memory
  842.    Load Iff "ram:graph_background.iff"
  843.    
  844.    ' reset x_old variables
  845.    For LOUP=1 To 16
  846.       GRAPHX_OLD(LOUP)=GRAPHX_MIN
  847.    Next LOUP
  848.    
  849.    ' reset time axis base 
  850.    Proc TIMECHECK
  851.    OLD_TIME=Param
  852.    
  853. End Proc
  854. Procedure GRAPH_PLOT
  855.    
  856.    GRAPHY=GRAPHY_MIN-(PITCH-20)*3
  857.    If GRAPHX_OLD(CHANEL)=-1 Then GRAPHX_OLD(CHANEL)=GRAPHX
  858.    Ink CHANEL
  859.    ' only colours 0 to 15, there is no colour 16 so.. 
  860.    If CHANEL=16 Then Ink 15
  861.    
  862.    Draw GRAPHX_OLD(CHANEL),GRAPHY_OLD(CHANEL) To GRAPHX,GRAPHY
  863.    GRAPHY_OLD(CHANEL)=GRAPHY
  864.    GRAPHX_OLD(CHANEL)=GRAPHX
  865.    
  866. End Proc
  867. Procedure TIMECHECK
  868.    
  869.    N$=Space$(12) : N=Varptr(N$) : Dreg(1)=N
  870.    C=Doscall(-192)
  871.    TIME=Leek(N+8)
  872.    
  873. End Proc[TIME]
  874.  
  875.  
  876. Procedure VEL_VS_PITCH
  877.    If NOE=1 Then Proc VEL_VS_PITCH_NEW
  878. End Proc
  879. Procedure VEL_VS_PITCH_NEW
  880.    
  881.    ' decrease vector_pts if enough time has elapsed but DONT redraw yet [0] 
  882.    ' because going to redraw anyway 
  883.    Proc VECTOR_PTS_DECREASE_YET[0]
  884.    
  885.    PY(PITCH-23)=200-(VEL*2)
  886.    Proc VECTOR_PTS_REDRAW
  887.    
  888. End Proc
  889. Procedure VEL_VS_PITCH_NOTES
  890.    
  891.    ' workout new vector point after a note on message 
  892.    PY(PITCH)=200-VEL
  893.    
  894.    'workout new polygon points and decrease all the old polygon points
  895.    
  896.    '   For LOUP=1 To 16 
  897.    '   Add PY(LOUP),-1 : If PY(LOUP)<BASE Then PY(LOUP)=BASE
  898.    '   Next LOUP
  899.    
  900.    'New polly point after a note on 
  901.    'PY(CHANEL)=VEL*10 
  902.    
  903.    'Polygon 0,PY(1) To 20,PY(2) To 40,PY(3) To 60,PY(4) To 80,PY(5) To 100,PY(6) To 120,PY(7) To 140,PY(8) To 160,PY(1) 
  904.    'Screen Swap : Wait Vbl  
  905.    'Cls 0 
  906. End Proc
  907. Procedure VECTOR_PTS_DECREASE_YET[YET]
  908.    
  909.    ' check on the time and pass parameter into this routine 
  910.    Proc TIMECHECK
  911.    TIME=Param
  912.    If TIME_PAST-TIME<-5 Then Proc VECTOR_PTS_DECREASE : If YET=1 Then Proc VECTOR_PTS_REDRAW
  913.    TIME_PAST=TIME
  914.    
  915. End Proc
  916. Procedure VECTOR_PTS_DECREASE
  917.    ' after time elapsed since last decrease is enough 
  918.    ' decrement all vector_pts (as this is the y-axis which has min=200 then add 1 
  919.    For LOUP=1 To 85
  920.       If PY(LOUP)<200 Then Add PY(LOUP),10 : If PY(LOUP)>200 Then PY(LOUP)=200
  921.    Next 
  922.    
  923. End Proc
  924. Procedure VECTOR_PTS_REDRAW
  925.    ' redraw the vector points in the background and then swap screens 
  926.    
  927.    Ink 1
  928.    ' plot first point 
  929.    Plot 0,200
  930.    
  931.    ' draw the rest of the points that arn't 0 (ie worth plotting) 
  932.    For LOUP=1 To 85
  933.       If PY(LOUP)<200 Then Draw To 4*LOUP,PY(LOUP)
  934.    Next LOUP
  935.    
  936.    ' draw to last dot 
  937.    Draw To 360,200
  938.    Screen Swap : Wait Vbl 
  939.    Cls 0
  940.    
  941. End Proc
  942. Procedure VEL_VS_PITCH_SETUP
  943.    
  944.    Screen Open 2,360,256,2,Lowres : Flash Off : Curs Off : Cls 0 : Hide On 
  945.    Palette $0,$FFF
  946.    'Screen Display 2,10,0,, 
  947.    Screen 2 : Double Buffer : Autoback 0
  948.    
  949.    ' setup initial values for vector points 
  950.    For LOUP=1 To 60
  951.       PY(LOUP)=200
  952.    Next LOUP
  953.    
  954.    
  955.    
  956. End Proc
  957. Procedure VEL_VS_PITCH_APPEAR
  958.    
  959.    ' hide old screen
  960.    S=Screen
  961.    Screen Hide S
  962.    
  963.    ' show screen for this routine 
  964.    Screen Show 2
  965.    Cls 0
  966.    Screen To Front 2
  967.    Screen 2
  968.    
  969.    FILTER=False : Rem DONT ignore clock pulses (important to this routine
  970.    'because used to slowly decrease the points)   
  971.    ' Make rainbow background
  972.    Restore RDATA
  973.    Set Rainbow 0,1,180,"","",""
  974.    Rainbow 0,80,93,200
  975.    For F=0 To 178 Step 2
  976.       Read R : Rain(0,F)=R : Rain(0,F+1)=R
  977.    Next F
  978.    Rainbow 0,80,93,200
  979.    
  980.    
  981.    RDATA:
  982.    Data $F00,$F10,$F20,$F30,$F40,$F50,$F60,$F70,$F80,$F90,$FA0,$FB0,$FC0,$FD0,$FE0
  983.    Data $FF0,$EF0,$DF0,$CF0,$BF0,$AF0,$9F0,$8F0,$7F0,$6F0,$5F0,$4F0,$3F0,$2F0,$1F0
  984.    Data $F0,$F1,$F2,$F3,$F4,$F5,$F6,$F7,$F8,$F9,$FA,$FB,$FC,$FD,$FE
  985.    Data $FF,$EF,$DF,$CF,$BF,$AF,$9F,$8F,$7F,$6F,$5F,$4F,$3F,$2F,$1F
  986.    Data $F,$10F,$20F,$30F,$40F,$50F,$60F,$70F,$80F,$90F,$A0F,$B0F,$C0F,$D0F,$E0F
  987.    Data $F0F,$F0E,$F0D,$F0C,$F0B,$F0A,$F09,$F08,$F07,$F06,$F05,$F04,$F03,$F02,$F01
  988.    CAT:
  989.    Data 0,90,0,4,95,95
  990.    Data 225,315,0,0,75,75
  991.    Data 90,180,4,0,95,95
  992.    Data 315,45,0,0,75,75
  993.    Data 180,270,0,4,95,95
  994.    Data 45,135,0,0,75,75
  995.    Data 270,0,4,0,95,95
  996.    Data 135,225,0,0,75,75
  997.    '
  998.    Data 0,90,1,1,95,95
  999.    Data 45,135,355,355,55,55
  1000.    Data 90,180,1,1,95,95
  1001.    Data 135,225,355,355,55,55
  1002.    Data 180,270,1,1,95,95
  1003.    Data 225,315,355,355,55,55
  1004.    Data 270,0,1,1,95,95
  1005.    Data 315,45,355,355,55,55
  1006.    Data 0,90,1,1,95,95
  1007.    Data 45,135,4,4,95,95
  1008.    Data 90,180,2,2,95,95
  1009.    Data 135,225,3,3,95,95
  1010.    Data 180,270,3,3,95,95
  1011.    Data 225,315,2,2,95,95
  1012.    Data 270,0,4,4,95,95
  1013.    Data 315,45,1,1,95,95
  1014.    Data 0,90,5,4,95,95
  1015.    Data 225,315,5,4,45,45
  1016.    Data 90,180,5,4,95,95
  1017.    Data 315,45,5,4,45,45
  1018.    Data 180,270,5,4,95,95
  1019.    Data 45,135,5,4,45,45
  1020.    Data 270,0,5,4,95,95
  1021.    Data 135,225,5,4,45,45
  1022.    
  1023.    ' set ex_routine flag so the rainbow effect is turned off before next  
  1024.    ' routine
  1025.    EX_ROUTINE=4
  1026.    
  1027. End Proc
  1028. Procedure VEL_VS_PITCH_DISAPPEAR
  1029.    
  1030.    ' end the rainbow effect which slows down processing 
  1031.    
  1032.    Rainbow Del 0
  1033.    ' RESET EX_ROUTINE FLAG
  1034.    EX_ROUTINE=0
  1035. End Proc
  1036.  
  1037.  
  1038. Procedure PIC_VIEWER_SETUP
  1039.    
  1040.    Screen Open 5,320,256,2,Lowres : Flash Off : Curs Off : Cls 0 : Hide On 
  1041.    Double Buffer : Autoback 0
  1042.    Palette $0,$FFF
  1043.    
  1044. End Proc
  1045. Procedure PIC_VIEWER
  1046.    
  1047.    ' quit this proc if note off message is recived(ie finger is lifting off the key)
  1048.    If VEL=0 Then Pop Proc
  1049.    
  1050.    ' Change pitch (a value between about 1 and 70) to pressed 
  1051.    '                                              (a value between 1 and 12)
  1052.    PRESSED=PITCH
  1053.    
  1054.    ' Decrese pitch to a value between 1 and 12 (to select one of the 12 pics) 
  1055.    While PRESSED>12
  1056.       Add PRESSED,-12
  1057.    Wend 
  1058.    
  1059.    ' load picture into the background (as long as it is a different one)  
  1060.    
  1061.    If PRESSED<>OLDPIC
  1062.       Load Iff "ram:pics/"+Str$(PRESSED)-" "
  1063.       OLDPIC=PRESSED
  1064.       
  1065.       Palette Rnd(4096),Rnd(4096)
  1066.       ' R*256+G*16+B)4 
  1067.       
  1068.       ' when picture has finished loading flip the logical & physical screens
  1069.       ' to show the new picture that has loaded into the background
  1070.       Screen Swap 
  1071.       
  1072.    End If 
  1073. End Proc
  1074. Procedure PIC_VIEWER_APPEAR
  1075.    
  1076.    ' hide old screen
  1077.    S=Screen
  1078.    Screen Hide S
  1079.    
  1080.    ' show screen for this routine 
  1081.    Screen Show 5
  1082.    Screen To Front 5
  1083.    Screen 5
  1084.    
  1085.    ' don't need to process clock pulses.
  1086.    FILTER=True
  1087. End Proc
  1088.  
  1089. Procedure CIRC
  1090.    
  1091.    S=Screen
  1092.    Screen Hide S
  1093.    Curs Off : Degree : Hide On 
  1094.    Screen Open 0,320,180,2,Lowres : Hide On : Curs Off : Cls 0
  1095.    Screen Display 0,128,70,, : Palette 0,0
  1096.    Unpack 6 To 6
  1097.    Screen To Front 0 : Screen Hide 6
  1098.    Screen Open 7,400,32,2,Lowres : Screen Hide 7 : Screen 0
  1099.    Double Buffer : Bob Update Off : Autoback 0 : Curs Off 
  1100.    For F=1 To 360 : CX(F)=(Sin(F)*100)+128 : Next F
  1101.    Y1=90 : Y2=90 : CH=0 : SCAR=7 : Def Scroll 1,0,0 To 390,32,-2,0
  1102.    
  1103.    T$="     ALEXS MIDI MAGIX              *"
  1104.    
  1105.    Sprite Update Off 
  1106.    Do 
  1107.       Add X1,1,1 To 360
  1108.       Add X2,2,1 To 359
  1109.       Add Y1,3,1 To 358
  1110.       Add Y2,1,1 To 360
  1111.       XP1=CX(X1)+32
  1112.       YP1=CX(Y1)
  1113.       XP2=CX(X2)+32
  1114.       YP2=CX(Y2)
  1115.       Screen 7
  1116.       
  1117.       Scroll 1
  1118.       Add SCAR,1,0 To 15 : If SCAR=0 Then Gosub PCHAR
  1119.       
  1120.       Screen Copy 6,XP1,YP1,XP1+319,YP1+180 To 0,0,0
  1121.       Screen Copy 6,XP2,YP2,XP2+319,YP2+180 To 0,0,0,%1100000
  1122.       Screen Copy 7,0,0,320,31 To 0,0,80,%1100000
  1123.       Screen 0
  1124.       Add T,1,0 To 89 : If T=0 Then Gosub CCOL : Rem change col 
  1125.       Screen Swap : Wait Vbl 
  1126.       
  1127.       ' If ascii value of the text$ gives 42 ("*") then quit 
  1128.       If B=42 Then Goto CIRCLOSE
  1129.       
  1130.       
  1131.    Loop 
  1132.    CCOL:
  1133.    Add CT,1,0 To 5
  1134.    If CT=0 Then Fade 3,$F00,$F0F
  1135.    If CT=1 Then Fade 3,$0,$F
  1136.    If CT=2 Then Fade 3,$FF0,$F0
  1137.    If CT=3 Then Fade 3,$FF0,$0
  1138.    If CT=4 Then Fade 3,$F0F,$FF
  1139.    If CT=5 Then Fade 3,$F,$FF
  1140.    Return 
  1141.    
  1142.    PCHAR:
  1143.    Add CH,1,1 To Len(T$)
  1144.    B=Asc(Mid$(T$,CH,1))
  1145.    Paste Bob 354,0,B+3
  1146.    Return 
  1147.    
  1148.    CIRCLOSE:
  1149.    Screen 0 : Wait 45 : Fade 3 : Wait 45 : Screen Close 0
  1150.    Screen Close 6 : Screen Close 7
  1151. If S<>0 Then Screen Show S
  1152.    X=HORIS_SLIDERX(1) : Proc ROUTINE_SWAP
  1153. End Proc
  1154.  
  1155. Procedure PIANO_PLAYER_SETUP
  1156. End Proc
  1157. Procedure PIANO_PLAYER_APPEAR
  1158.    
  1159.    ' hide old screen
  1160.    S=Screen
  1161.    Screen Hide S
  1162.    
  1163.    'make this screen and unpack the compressed screen in memory bank 3 into it
  1164.    Screen Open 6,640,44,16,Hires
  1165.    Hide On : Curs Off 
  1166.    Unpack 3 To 6
  1167.    
  1168.    ' Set the sprites' colours all to red (colour indexes 17 to 31)
  1169.    For LOUP=17 To 31
  1170.       Colour LOUP,$F00
  1171.    Next LOUP
  1172.    
  1173.    ' don't need to process clock pulses.
  1174.    FILTER=TURE
  1175.    
  1176.    'set ex_routine flag so this routine will be "disapeared" properly   
  1177.    EX_ROUTINE=3
  1178.    
  1179. End Proc
  1180. Procedure PIANO_PLAYER_DISAPPEAR
  1181.    
  1182.    For LOUP=0 To 7
  1183.       Sprite Off LOUP
  1184.    Next LOUP
  1185.    EX_ROUTINE=0
  1186. End Proc
  1187. Procedure PIANO_PLAYER
  1188.    
  1189.    ' if Note off the make the sprite dissapear and leave procedure
  1190.    
  1191.    If VEL=0
  1192.       Sprite Off SPRYT(PITCH)
  1193.       Pop Proc
  1194.    End If 
  1195.    
  1196.    
  1197.    ' Work out x,y co-ordinates for the new sprite taking into account 
  1198.    ' the way a real keyboard is laid out with black notes halfway between 
  1199.    ' some of the white notes. 
  1200.    
  1201.    ' Change pitch (a value between about 1 and 70) to pressed 
  1202.    '                                              (a value between 1 and 12)
  1203.    PRESSED=PITCH+1
  1204.    
  1205.    ' Decrese pressed to a value between 1 and 12 (to select one of the 12 keys) 
  1206.    ' but work out the octave the note was played in too 
  1207.    While PRESSED>12
  1208.       Add PRESSED,-12
  1209.       Add OCTAVE,1
  1210.    Wend 
  1211.    Add OCTAVE,-2
  1212.    
  1213.    
  1214.    ' Use the ebony_n_ivory array (set up in initailisation proc) to check 
  1215.    ' if the PRESSED key is a "#" sharp ie black key and take that into
  1216.    ' account when working out x,y co-ords 
  1217.    
  1218.    If EBONY_N_IVORY$(PRESSED)="#"
  1219.       XKEY=(OCTAVE*91)+EBONY_N_IVORY(PRESSED)+50
  1220.       YKEY=223
  1221.       
  1222.    Else 
  1223.       
  1224.       XKEY=(OCTAVE*91)+EBONY_N_IVORY(PRESSED)+50
  1225.       YKEY=238
  1226.    End If 
  1227.    
  1228.    'Increment the Sprite_number counter so that different sprite is used
  1229.    ' each time. 
  1230.    
  1231.    Add SPRY_NUMBER,1,0 To 7
  1232.    
  1233.    ' Put sprite onto screen 
  1234.    Sprite SPRY_NUMBER,X Hard(XKEY),Y Hard(YKEY),4
  1235.    
  1236.    ' Put into sprite array at position according to pitch of the note 
  1237.    ' the sprite number used so that when the pitch?? vel0 message is recived
  1238.    ' when the player lifts their finger off the procedure can work out from the 
  1239.    ' pitch of the message which sprite to make dissapear. 
  1240.    
  1241.    SPRYT(PITCH)=SPRY_NUMBER
  1242.    
  1243.    
  1244. End Proc
  1245.  
  1246. Procedure VERTICAL_BARS_APPEAR
  1247.  
  1248.  
  1249.    ' hide old screen
  1250.    S=Screen
  1251.    Screen Hide S
  1252.  
  1253.    ' don't need to process clock pulses.
  1254.    FILTER=TURE
  1255.  
  1256.    WIDTH=352
  1257.    HEIGHT=16*3
  1258.    X=X Hard(-5)
  1259.    Y=Y Hard(0)
  1260.  
  1261. ' Create 5 screens and load in the stripes to each of them 
  1262. ' Use screens 0,4,5,6 and 7 which can be cleared (others in  
  1263. ' use from other routines eg. screen one reserved for cycle piano.)
  1264.  
  1265. ' Use data statement (SCRDATA) to know which screens to use
  1266. Restore SCRDATAS
  1267.    For LOUP=0 To 4
  1268.       Read SCRDATA(LOUP)
  1269.       Screen Open SCRDATA(LOUP),WIDTH,HEIGHT,16,Lowres
  1270.       Flash Off : Curs Off 
  1271.       Load Iff "ram:pics/stripes2",SCRDATA(LOUP)
  1272.    Next LOUP
  1273.  
  1274. 'place the screens one below the other 
  1275.    For LOUP=0 To 4
  1276.       Screen Display SCRDATA(LOUP),X,Y+(LOUP*HEIGHT),WIDTH,HEIGHT
  1277.    Next LOUP
  1278.    
  1279. ' reset all the screens' 16 colours to black ($0)    
  1280.    For LOUP=0 To 4
  1281.       Screen SCRDATA(LOUP)
  1282.       For L=0 To 16
  1283.          Colour L,$0
  1284.       Next L
  1285.    Next LOUP
  1286.  
  1287. ' read in the channel values 
  1288. Restore CHANEL_COLOURS_DATA
  1289. For LOUP=0 To 15
  1290. Read CHANEL_COLOURS(LOUP)
  1291. Next LOUP
  1292.  
  1293.  
  1294. SCRDATAS:
  1295. Data 0,4,5,6,7
  1296.  
  1297. CHANEL_COLOURS_DATA:
  1298. Data $4,$F00,$F60,$FC0,$CF0,$6F0,$F0,$F5,$FA,$FF,$AF,$5F,$F,$CCC,$444,$777
  1299.  
  1300. ' set ex_routine flag so that this routine will dissapear properly and 
  1301. ' release the screens back 
  1302. EX_ROUTINE=-1
  1303. End Proc
  1304. Procedure VERTICAL_BARS_DISAPPEAR
  1305.  
  1306. ' close the 5 screens that were used 
  1307. ' so they are free to be used again by the other procedures
  1308.  
  1309.    For LOUP=0 To 4
  1310.       Screen Close SCRDATA(LOUP)
  1311.    Next LOUP
  1312. 'reset ex_routine flag 
  1313. EX_ROUTINE=0
  1314.  
  1315. End Proc
  1316. Procedure VERTICAL_BARS
  1317.  
  1318. ' work out variables for screen and bar number 
  1319.    BRR=109-PITCH
  1320. '-24 
  1321.  
  1322. BRR2=BRR
  1323. Add BRR2,-1
  1324. BRR2=BRR2/16
  1325. SCR=Int(BRR2)
  1326. If SCR>5 Then Pop Proc : Rem note is out of range   
  1327.  
  1328. ' bar is between 0 and 16
  1329.    While BRR>16
  1330.       Add BRR,-16
  1331.    Wend 
  1332.    Add BRR,-1
  1333.  
  1334. 'Screen 0
  1335. 'Ink 1 
  1336. 'Colour 1,$FFF 
  1337. 'Locate 1,1 : Print "Pitch=";PITCH;" Bar=";BRR;" scr=";SCR;" " 
  1338.  
  1339. ' select screen and change the bar to red if note on or black if note off
  1340.    Screen SCRDATA(SCR)
  1341.  
  1342.    If NOE=0 Then Colour BRR,$0
  1343.  
  1344.    If NOE=1 Then Colour BRR,CHANEL_COLOURS(CHANEL)
  1345. End Proc
  1346.  
  1347.  
  1348. Procedure SLIDERS_APPEAR
  1349.    ' hide old screen
  1350.    S=Screen
  1351.    Screen Hide S
  1352.  
  1353.    Screen Open 0,360,256,4,Lowres
  1354.    Cls 0 : Curs Off : Flash Off 
  1355.    Load Iff "ram:Pics/sliders_screen",0
  1356.    Rem draw the sliders 
  1357.    Reserve Zone 16
  1358.    Set Slider ,,11,,,,,
  1359.    LISTEN_TO=1
  1360.    
  1361.    For LOUP=1 To 8 : Rem 8 routines 
  1362.       Hslider 30,30*(LOUP) To 150,(30*LOUP)+10,116,HORIS_SLIDERX(LOUP),2
  1363.       Set Zone LOUP,30,30*(LOUP) To 150,(30*LOUP)+10
  1364.    Next LOUP
  1365.    
  1366.    Rem set up text windows for channel data 
  1367.    For LOUP=1 To 8
  1368.       Wind Open LOUP,170,30*(LOUP),4,1
  1369.       Curs Off 
  1370.       Paper 0
  1371.       Scroll Off 
  1372.    Next LOUP
  1373.    Window 1 : Paper 0 : Clw 
  1374.    For LOUP=1 To 8
  1375.       Window LOUP
  1376.       Print HORIS_SLIDERX(LOUP)
  1377.    Next LOUP
  1378.    
  1379.    Rem *** set up LISTEN box and surround it with a mouse zone
  1380.    Wind Open 9,255,230,11,3,2
  1381.    Set Zone 9,255,230 To 334,253
  1382.    Curs Off 
  1383.    Paper 4
  1384.    Scroll Off 
  1385.    Clw 
  1386.    Print "" : Print "Listen";
  1387.    
  1388. End Proc
  1389. Procedure CHECK_HORIS_SLIDER[MZ]
  1390.    Rem *** check horizontal slider and change pattern if left key is pressed  
  1391.    If Mouse Zone=MZ and Mouse Key=1
  1392.       LOUP=MZ
  1393.       Limit Mouse X Hard(30),Y Hard(30*(MZ)) To X Hard(145),Y Hard((30*MZ)+10)
  1394.       Hslider 30,30*(LOUP) To 150,(30*LOUP)+10,116,1,2
  1395.       HORIS_SLIDERX(MZ)=X Screen(X Mouse)-30
  1396.       SLIDE[HORIS_SLIDERX(MZ),MZ]
  1397.    Else 
  1398.       Limit Mouse 
  1399.    End If 
  1400. End Proc
  1401. Procedure CHECK_LISTENING_BOX
  1402.    If Mouse Zone=9 and Mouse Key=1
  1403.  
  1404. ' keep the mouse in the listen box 
  1405.       Limit Mouse X Hard(255),Y Hard(230) To X Hard(334),Y Hard(253)
  1406.       Window 9
  1407.       Clw 
  1408.       Print "" : Print "Listenin";
  1409.       Wait Vbl : Wait Vbl 
  1410.       
  1411.       ' empty out the serial buffer of any left over midi data 
  1412.       While TRASH<>-1
  1413.          TRASH=Serial Get(1)
  1414.       Wend 
  1415.  
  1416. ' listen for intrument change messages an alter the horisontal sliders 
  1417. ' until the mouse button is pressed again
  1418.       While Mouse Key<>1
  1419.          Repeat 
  1420.             Proc FETCH_DATA[X]
  1421.             Exit If Mouse Key=1
  1422.          Until X<>$FE and X<>$F8
  1423.  
  1424.          
  1425.          ' check to see if the MIDI data is a system message and a channel message
  1426.          If(X and $80) and X<$F0
  1427.             
  1428.             'check to see if the channel message is a program change message (64)
  1429.             If(X and $70)=64
  1430.                ' if PROGRAM CHANGE message occurs (64) then read the next byte of data which
  1431.                'contains the instrument number            
  1432.                Proc FETCH_DATA[X]
  1433.                HORIS_SLIDERX(LISTEN_TO)=X
  1434.                Proc SLIDE[X,LISTEN_TO]
  1435.             End If 
  1436.          End If 
  1437.       Wend 
  1438.       Limit Mouse 
  1439.       Window 9 : Clw 
  1440.       Print "" : Print "Listen";
  1441.       Wait Vbl : Wait Vbl 
  1442.       
  1443.    End If 
  1444. End Proc
  1445. Procedure SLIDER_PREFS
  1446.    Show 
  1447.    Proc SLIDERS_APPEAR
  1448.    Do 
  1449.       For LOUP=1 To 8
  1450.          Proc CHECK_HORIS_SLIDER[LOUP]
  1451.       Next LOUP
  1452.       Proc CHECK_LISTENING_BOX
  1453.       
  1454.       Rem *** quit if right mouse key is pressed 
  1455.       Exit If Mouse Key=2
  1456.    Loop 
  1457.    Hide 
  1458. Screen Close 0
  1459. End Proc
  1460.  
  1461. Procedure SLIDE[HORIS_SLIDERX,MZ]
  1462.    If LISTEN_TO<>MZ
  1463.       Set Slider ,,11,,,,,
  1464.       Hslider 30,30*(LISTEN_TO) To 150,(30*LISTEN_TO)+10,116,HORIS_SLIDERX(LISTEN_TO),2
  1465.    End If 
  1466.    Set Slider ,,2,,,,,
  1467.    Hslider 30,30*(MZ) To 150,(30*MZ)+10,116,HORIS_SLIDERX(MZ),2
  1468.    Window MZ
  1469.    Ink 0 : Print HORIS_SLIDERX;" "
  1470.    LISTEN_TO=MZ
  1471.    Wait Vbl 
  1472. End Proc
  1473. Procedure _NOTES_TO_READ
  1474.    '
  1475.    '
  1476.    
  1477.    
  1478.    ' WIPE GRAPH SCREEN AFTER DOING A VOICE 99. THIS IS DONE IN PICK_OUTPUT
  1479.    ' ROUTINE  BUT DOESN'T RESET X COORDS. 
  1480.    '
  1481.    ' IF A NOTE OFF MESSAGE IS SENT BY SEQUENCER THEN THE PROGRAM MAY  
  1482.    'NOT WORK BECAUSE PROGRAMED TO RECOGNISE NOTE_ON_VEL=0 AS NOTE OFF 
  1483.    '
  1484. End Proc
  1485.  
  1486.  
  1487.  
  1488.  
  1489.  
  1490.  
  1491.