AMOS PD CD/amospdcd.iso/251-275/apd269/autoexec.amos/autoexec.amosSourceCode

AMOS Source Code | 1991-05-05 | 15KB | 545 lines

'+-------------------------------------------------------------------+
'|                                                                   |
'|                    S K E T C H - A - T U N E                      |
'|                                                                   |
'|                        By  Colin Naylar                           |
'|                                                                   |
'+-------------------------------------------------------------------+
'
Dim MUSIK(200)
Global SF,SFN,SPEED,V,POS,STAVELENGTH,MUSIK(),STAFF,OFFSET,A,B,S1,S2,S3,S4
BEGSCN
INSTSCN
INFOSCRN
'----initial settings for samples----
S1=3 : S2=3 : S3=4 : S4=4
Sample S1 To 1
Sample S2 To 2
Sample S3 To 4
Sample S4 To 8
MAINBODY
End
Procedure MAINBODY
   Shared HOWFAR
   Screen Open 1,320,200,16,Lowres
   Hide On : Flash Off : Curs Off
   Screen Open 3,320,200,16,Lowres
   Hide : Flash Off : Curs Off
   Colour 2,$FFA : Colour 5,$AA0 : Colour 7,$AAA
   Colour 15,$0 : Colour 9,$AEE
   Cls 2
   SPEED=7 : STAVELENGTH=48 : OFFSET=0 : STAFF=0 : HOWFAR=0
   'Load "df1:5instru2.abk"
   INIT
   Screen Copy 3 To 1
   CLEARARRAY
   MKSTAF
   X Mouse=X Hard(100) : Y Mouse=Y Hard(20)
     Do
      Screen 3
     Wait Vbl
         X1=X Hard(12)
         Y1=Y Hard(4+OFFSET)
         X2=X Hard(10+STAVELENGTH*6)
         Y2=Y Hard(48+OFFSET)
     Wait Vbl : Limit Mouse X1,Y1 To X2,Y2
     Do
         A$=""
         A$=Upper$(Inkey$)
         If A$="P" Then HEAR[1]
         If A$="O" Then HEAR[0]
         If A$="R" Then DELETE
         If A$="X" Then EXTRACT
         If A$="I" Then INSERT
         If A$="S" Then SAVIT : Screen Copy 1 To 3 : MKSTAF : POKIT
         If A$="F" Then SAVIFF
         If A$="V" Then SWP_SAMP : Exit
         If A$="T" Then ALTERSPEED
         If A$="L" Then Screen Copy 1 To 3 : MKSTAF : LODIT : POKIT
         If A$="N" Then Screen Copy 1 To 3 : MKSTAF : CLEARARRAY : HOWFAR=1
         If A$="D" Then STAFF=STAFF+1 : Exit
         If A$="U" Then STAFF=STAFF-1 : Exit
         A=X Screen(X Mouse) : A=(A-A mod 6)
         B=Y Screen(Y Mouse) : B=(B-B mod 3)
         POS=((A-6)/6)+STAVELENGTH*STAFF
         '
         If Mouse Key=1 and MUSIK(POS)=0
            PLACE
         End If
         '
         P=Point(A,B+1)
         If Mouse Key=2 and(P=15 or P=5 or P=6)
            RUBOUT
         End If
         Wait Vbl
         '
         Get Bob 1,A-1,B-1 To A+4,B+4
         Wait Vbl
         Ink 6 : Box A-1,B-1 To A+3,B+3
         Wait Vbl
         Paste Bob A-1,B-1,1
      Loop
      If STAFF>3 Then STAFF=3
      If STAFF<0 Then STAFF=0
      OFFSET=STAFF*48
      MKSTAF
   Loop
End Proc
Procedure MKSTAF
   Pen 0 : Paper 2 : Locate 38,SF*6+2 : Print " ";
   Locate 38,STAFF*6+2 : Print Chr$(171);
   SF=STAFF
End Proc
Procedure PLACE
   Shared C,HOWFAR,POS
   K=15 : SFN=0
   If Key State(91) Then K=5 : SFN=1
   If Key State(90) Then K=6 : SFN=-1
   C=26+(OFFSET/3)-B/3
   '   If C<15 Then Ink 7 : Draw A-2,40+OFFSET To A+4,40+OFFSET
   '   If C>23 Then Ink 7 : Draw A-2,4+OFFSET To A+4,4+OFFSET
   Ink K
   Circle A+1,B+1,2 : Bar A,B To A+2,B+2
   '   POS=((A-6)/6)+OFFSET
   If C<19
      Draw A+3,B-10 To A+3,B+2
   Else
      Draw A-1,B To A-1,B+12
   End If
   HOWFAR=Max(HOWFAR,POS)
   STORE
   Play 15,V+24+SFN,0
End Proc
Procedure RUBOUT
   Shared C,HOWFAR,POS,MUSIK()
   C=26+(OFFSET/3)-B/3
   '  If C<15 Then Ink 2 : Draw A-2,40+OFFSET To A+4,40+OFFSET
   '  If C>23 Then Ink 2 : Draw A-2,4+OFFSET To A+4,4+OFFSET
   Ink 2
   Circle A+1,B+1,2 : Bar A,B To A+2,B+2
   POS=((A-6)/6)+OFFSET
   If C<19
      Draw A+3,B-10 To A+3,B+2
   Else
      Draw A-1,B To A-1,B+12
   End If
   Ink 7
   For N=10+OFFSET To 34+OFFSET Step 6
      Draw A-1,N To A+3,N
   Next
   HOWFAR=Max(HOWFAR,POS)
   MUSIK(POS)=0
End Proc
Procedure STORE
   Shared C,POS,MUSIK()
   If C=10 Then V=8
   If C=11 Then V=10
   If C=12 Then V=12
   If C=13 Then V=13
   If C=14 Then V=15
   If C=15 Then V=17
   If C=16 Then V=18
   If C=17 Then V=20
   If C=18 Then V=22
   If C=19 Then V=24
   If C=20 Then V=25
   If C=21 Then V=27
   If C=22 Then V=29
   If C=23 Then V=30
   If C=24 Then V=32
   If C=25 Then V=34
   If C=26 Then V=36
   MUSIK(POS)=V+SFN
End Proc
Procedure HEAR[Q]
   Shared MUSIK(),HOWFAR
   If Q=1 Then V=1 Else V=POS
   Ink 15
   For N=V To HOWFAR
      Exit If Inkey$<>""
      XP=N mod STAVELENGTH : YP=Int(N/STAVELENGTH)
      Bob 2,(N mod STAVELENGTH)*6+11,YP*48+44,2
      If MUSIK(N)=0 Then Goto MISS
      Play 15,MUSIK(N)+24,0
      MISS:
      Wait SPEED
   Next
   Bob Off 2
End Proc
Procedure STAVE[YY]
   Ink 9
   For N=10 To 10+STAVELENGTH*6 Step 6
      Draw N,10+YY To N,34+YY
      Ink 7 : Plot N,YY+4 : Plot N,YY+40 : Plot N,YY+46 : Ink 9
   Next
   Ink 7
   For N=10+YY To 34+YY Step 6
      Draw 10,N To 10+STAVELENGTH*6,N
   Next
   Ink 8
   For N=10 To 10+STAVELENGTH*6 Step 48
      Draw N,6+YY To N,38+YY
   Next
End Proc
Procedure INFOSCRN
   Screen Open 2,640,48,8,Hires
   Screen Display 2,140,252,,
   Screen To Front 2
   Colour 2,$FFA : Curs Off : Cls 2 : Flash Off
   Ink 6,2 : Box 1,1 To 638,38
   Text 10,10,"LEFT BUTTON  - Put Note    D - Down a Stave   S - Save Music   L - Load Music"
   Text 10,18,"RIGHT BUTTON - Erase Note  U - Up a Stave     N - New Music    V - Swap Voice"
   Text 10,26,"P - Play from Start        I - Insert Note    F - Save Screen  X - Note Values"
   Text 10,34,"O - Play from Cursor       R - Remove Note    T - Tempo"
   Ink 1
   Text 514,35,"TEMPO:"
   Text 558,35,Str$(40-SPEED)
End Proc
Procedure SAVIT
   Shared MUSIK(),HOWFAR,S
   Show On
   FL$=Fsel$("*.mus","","Save a Music File","")
   If FL$="" Then Hide : Pop Proc
   Open Out 1,FL$
   Print #1,HOWFAR
   Print #1,SPEED
   Print #1,S1
   Print #1,S2
   Print #1,S3
   Print #1,S4
   For N=1 To HOWFAR
      Print #1,MUSIK(N)
   Next
   Close 1
   Hide
End Proc
Procedure LODIT
   Show On
   Shared MUSIK(),HOWFAR,S
   FL$=Fsel$("*.mus","","Load a Music File","")
   If FL$="" Then Hide : Pop Proc
   Open In 1,FL$
   Input #1,HOWFAR
   Input #1,SPEED
   Input #1,S1
   Input #1,S2
   Input #1,S3
   Input #1,S4
   For N=1 To HOWFAR
      Input #1,MUSIK(N)
   Next
   Close 1
   Hide
   Text 558,35,Str$(40-SPEED)
   Sample S1 To 1
   Sample S2 To 2
   Sample S3 To 4
   Sample S4 To 8
End Proc
Procedure POKIT
   Shared MUSIK(),HOWFAR
   Screen 3
   For N=1 To HOWFAR
      C=MUSIK(N)
      If C=0 Then Goto MIS
      Gosub FIND
      Ink SFN
      A=(((N-1)*6) mod 6*STAVELENGTH)+12 : B=78-V*3
      If N>STAVELENGTH Then B=B+48
      If N>STAVELENGTH*2 Then B=B+48
      If N>STAVELENGTH*3 Then B=B+48
      Circle A+1,B+1,2 : Bar A,B To A+2,B+2
      If C<23
         Draw A+3,B-10 To A+3,B+2
      Else
         Draw A-1,B To A-1,B+12
      End If
      MIS:
   Next
   Pop Proc
   FIND:
   If C=8 Then V=10 : SFN=15
   If C=9 Then V=10 : SFN=5
   If C=10 Then V=11 : SFN=15
   If C=11 Then V=11 : SFN=5
   If C=12 Then V=12 : SFN=15
   If C=13 Then V=13 : SFN=15
   If C=14 Then V=13 : SFN=5
   If C=15 Then V=14 : SFN=15
   If C=16 Then V=14 : SFN=5
   If C=17 Then V=15 : SFN=15
   If C=18 Then V=16 : SFN=15
   If C=19 Then V=16 : SFN=5
   If C=20 Then V=17 : SFN=15
   If C=21 Then V=17 : SFN=5
   If C=22 Then V=18 : SFN=15
   If C=23 Then V=18 : SFN=5
   If C=24 Then V=19 : SFN=15
   If C=25 Then V=20 : SFN=15
   If C=26 Then V=20 : SFN=5
   If C=27 Then V=21 : SFN=15
   If C=28 Then V=21 : SFN=5
   If C=29 Then V=22 : SFN=15
   If C=30 Then V=23 : SFN=15
   If C=31 Then V=23 : SFN=5
   If C=32 Then V=24 : SFN=15
   If C=33 Then V=24 : SFN=5
   If C=34 Then V=25 : SFN=15
   If C=35 Then V=25 : SFN=5
   If C=36 Then V=26 : SFN=15
   Return
End Proc
Procedure INSERT
   Shared HOWFAR,MUSIK()
   HOWFAR=HOWFAR+1
   If HOWFAR>192 Then HOWFAR=192
   For N=HOWFAR To POS Step -1
      MUSIK(N)=MUSIK(N-1)
   Next N
   MUSIK(POS)=0
   Screen Copy 1 To 3
   POKIT
End Proc
Procedure DELETE
   Shared HOWFAR,MUSIK()
   For N=POS To HOWFAR
      MUSIK(N)=MUSIK(N+1)
   Next N
   MUSIK(HOWFAR)=0
   HOWFAR=HOWFAR-1
   Screen Copy 1 To 3
   POKIT
End Proc
Procedure INIT
   Screen 3
   Cls 2
   'For N=0 To 15
   '   Ink N
   '   Bar N*20,220 To N*20+20,240
   'Next
   Cls 2
   Ink 6
   Bar 0,0 To 4,2
   Get Bob 2,0,0 To 4,2
   Cls 2
   Ink 5
   Bar 0,0 To 4,2
   Get Bob 3,0,0 To 4,2
   Cls 2
   STAVE[0]
   STAVE[48]
   STAVE[96]
   STAVE[144]
   Ink 6 : Box 1,1 To 318,198
End Proc
Procedure CLEARARRAY
   Shared MUSIK()
   For N=1 To 200 : MUSIK(N)=0 : Next
End Proc
Procedure SWP_SAMP
   Reserve Zone 9
   Set Zone 1,207,66 To 215,73
   Set Zone 2,239,66 To 247,73
   Set Zone 3,207,74 To 215,81
   Set Zone 4,239,74 To 247,81
   Set Zone 5,207,82 To 215,89
   Set Zone 6,239,82 To 247,89
   Set Zone 7,207,90 To 215,97
   Set Zone 8,239,90 To 247,97
   Set Zone 9,230,120 To 265,128
   Wind Save
   Wind Open 1,50,50,28,11,10
   Curs Off : Paper 0 : Pen 7 : Clw
   Show On :
   Limit Mouse X Hard(200),Y Hard(60) To X Hard(274),Y Hard(130)
   Locate 1,1 : Print "Voice 1 = Sample <";S1;" >"
   Locate 1,2 : Print "Voice 2 = Sample <";S2;" >"
   Locate 1,3 : Print "Voice 3 = Sample <";S3;" >"
   Locate 1,4 : Print "Voice 4 = Sample <";S4;" >"
   Locate 1,6 : Print "Click on < & > to change"
   Locate 21,8 : Print "EXIT";
   Do
      Repeat
         Z=Zone(X Screen(X Mouse),Y Screen(Y Mouse))
      Until Mouse Click=1
      If Z=9 Then Exit
      If Z=1 Then Add S1,-1,1 To 5 : Locate 19,1 : Print S1;
      If Z=2 Then Add S1,1,1 To 5 : Locate 19,1 : Print S1;
      If Z=3 Then Add S2,-1,1 To 5 : Locate 19,2 : Print S2;
      If Z=4 Then Add S2,1,1 To 5 : Locate 19,2 : Print S2;
      If Z=5 Then Add S3,-1,1 To 5 : Locate 19,3 : Print S3;
      If Z=6 Then Add S3,1,1 To 5 : Locate 19,3 : Print S3;
      If Z=7 Then Add S4,-1,1 To 5 : Locate 19,4 : Print S4;
      If Z=8 Then Add S4,1,1 To 5 : Locate 19,4 : Print S4;
   Loop
   Sample S1 To 1
   Sample S2 To 2
   Sample S3 To 4
   Sample S4 To 8
   While Mouse Key=1 : Wend
   Wind Close
   Hide
End Proc
Procedure SAVIFF
   Shared MUSIK(),HOWFAR
   Show
   FL$=Fsel$("","","Save the Screen","")
   If FL$="" Then Hide : Pop Proc
   Save Iff FL$,0
   Hide
End Proc
Procedure ALTERSPEED
   Bell
   Screen 2
   Ink 1,2
   Text 514,35,"TEMPO:"
   Do
      If Key State(77) Then SPEED=SPEED+1 : Wait 5
      If Key State(76) Then SPEED=SPEED-1 : Wait 5
      If SPEED<1 Then SPEED=1
      If SPEED>30 Then SPEED=30
      Text 558,35,Str$(40-SPEED)
      Q$=Upper$(Inkey$)
      Exit If Q$=Chr$(13)
   Loop
   Screen 3
   Bell
End Proc
Procedure EXTRACT
   Shared HOWFAR,MUSIK()
   Screen 2 : Cls 2
   Paper 3
   For N=1 To HOWFAR
      C=MUSIK(N)
      Gosub LOOK
      Print C$;
   Next
   Locate 64,4 : Print "(P)rinter/(Q)uit";
   Repeat
      Q$=Upper$(Inkey$)
   Until Q$<>""
   If Q$="P"
      For N=1 To HOWFAR
         C=MUSIK(N)
         Gosub LOOK
         Lprint C$;
      Next
      Lprint Chr$(13)
   End If
   Screen Close 2
   INFOSCRN
   Screen 3
   Pop Proc
   LOOK:
   If C=0 Then C$="<>" : Pen 2
   If C=8 Then C$="G0" : Pen 2
   If C=9 Then C$="G0" : Pen 5
   If C=10 Then C$="A0" : Pen 2
   If C=11 Then C$="A0" : Pen 5
   If C=12 Then C$="B1" : Pen 2
   If C=13 Then C$="C1" : Pen 2
   If C=14 Then C$="C1" : Pen 5
   If C=15 Then C$="D1" : Pen 2
   If C=16 Then C$="D1" : Pen 5
   If C=17 Then C$="E1" : Pen 2
   If C=18 Then C$="F1" : Pen 2
   If C=19 Then C$="F1" : Pen 5
   If C=20 Then C$="G1" : Pen 2
   If C=21 Then C$="G1" : Pen 5
   If C=22 Then C$="A1" : Pen 2
   If C=23 Then C$="A1" : Pen 5
   If C=24 Then C$="B2" : Pen 2
   If C=25 Then C$="C2" : Pen 2
   If C=26 Then C$="C2" : Pen 5
   If C=27 Then C$="D2" : Pen 2
   If C=28 Then C$="D2" : Pen 5
   If C=29 Then C$="E2" : Pen 2
   If C=30 Then C$="F2" : Pen 2
   If C=31 Then C$="F2" : Pen 5
   If C=32 Then C$="G2" : Pen 2
   If C=33 Then C$="G2" : Pen 5
   If C=34 Then C$="A2" : Pen 2
   If C=35 Then C$="A2" : Pen 5
   If C=36 Then C$="B2" : Pen 2
   Return
End Proc
Procedure INSTSCN
   Screen Open 1,640,256,4,Hires : Colour 1,$FFA : Cls 1
   Hide : Flash Off : Curs Off
   Screen To Front 1
   Colour 0,$0 : Colour 2,$33F
   Cls 1 : Hide
   Pen 2 : Paper 1
   Print "                     SKETCH A TUNE  By Colin Naylar."
   Print ""
   Pen 0
   Print "      Notes are entered on a representation of a Musical Stave, which is easy"
   Print "   to follow. There are 24 bars on the screen with eight notes in each bar."
   Print "   There are on-screen reminders, but Notes are simply entered on the staves"
   Print "   with the left Mouse button and deleted with the Right Mouse Button. All the"
   Print "   controls are via the Keyboard. A very useful feature is the O key which "
   Print "   plays the tune from the cursor, P plays from the start of the music."
   Print "   Sharps & Flats are entered by pressing '(' and ')' on the numeric keyboard"
   Print "   at the same time as the mouse button. Sharps are shown yellow, flats blue."
   Print "   One of five Samples is allocated individually to each of the Four Voices"
   Print "   These may be altered by pressing the S key, eg. The same sample can be set"
   Print "   on each channel for simplicity, or each channel can sound a different sample."
   Print "   The S key saves the notes,tempo & Samples used, L reloads them."
   Print ""
   Print "   The F key will save the screen as an IFF file."
   Print ""
   Print "   The I Key inserts a gap in the music wherever the square cursor is, and"
   Print ""
   Print "   The R Key removes a Note and shifts the following Notes back one place."
   Print ""
   Print "   To change Tempo - Press T, then the Up or Down Arrow Keys then Enter. "
   Print ""
   Print "   Use the U & D keys to change the Stave you are working on."
   Print ""
   Print "   N clears all Music. P plays your Tune. Any Key stops Play. V changes Voice"
   Print ""
   Print "   X prints the note names to the screen or printer for Soundtracker transfer."
   Print "   Once again sharps are shown in yellow (all flats are converted to sharps)."
   Pen 2
   Print ""
   Print "                            PRESS A MOUSE KEY";
   Repeat
   Until Inkey$<>"" or Mouse Key<>0
   View
   Screen Close 1
End Proc
Procedure BEGSCN
   Screen Open 1,320,256,16,Lowres
   Cls 0
   Flash Off : Curs Off : Hide
   Unpack 7 To 0
   TITLEMUSIC
   Cls 0
   Screen Close 1
End Proc
Procedure TITLEMUSIC
   Shared MUSIK(),HOWFAR,S
   Open In 1,"Sketch_a_Tune:fiddle.mus"
   Input #1,HOWFAR
   Input #1,SPEED
   Input #1,S1
   Input #1,S2
   Input #1,S3
   Input #1,S4
   For N=1 To HOWFAR
      Input #1,MUSIK(N)
   Next
   Close 1
   Sample S1 To 1
   Sample S2 To 2
   Sample S3 To 4
   Sample S4 To 8
'
   For N=V To HOWFAR
      Exit If(Inkey$<>"" or Mouse Key<>0)
      If MUSIK(N)=0 Then Goto ISS
      Play 15,MUSIK(N)+24,0
      ISS:
      Wait SPEED
   Next
End Proc