GEMini Atari/GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso/files/music/musgfa/musedt.lst

File List | 1993-08-22 | 52.5 KB | 2,046 lines

' musedt.gfa  6 June 1991: graphics envelope added 3 may 92
' music scoring software
' programmed by Seymour Shlien in GFA Basic 3.5 on my 1040STE
' 624 Courtenay Avenue / Ottawa, Ontario, Canada  K2A 3B5
' The program is public domain and not for commercial use.
DIM note_yposition%(52) ! vertical of natural notes on staff
DIM flat_yposition%(22),sharp_yposition%(22) ! vertical position of other notes
DIM length_sprite%(12) !mapping of note time value with its sprite number
DIM rest_sprite%(12) !mapping of rest time value with its sprite number
DIM sharp_key_to_letter$(13) !mapping of pitch code (1 to 12) to letter code
DIM flat_key_to_letter$(13) ! mapping of pitch code to letter code (c,d,e...g)
DIM duration_to_text$(17) !duration code (0 to 12) to symbol (eg HN.)
DIM keysig_to_text$(15) !key signature code (1 to 12) to text
DIM assumed_accidental%(12) ! indicates whether note must be preceded by #,b
DIM nat_keys%(15) !keys to be printed as natural as function of key signature
DIM shrp_keys%(15) !keys assumed to be accidentals as function of keysig
DIM sharp_sig_ypos%(7),flat_sig_ypos%(7)  ! treble and bass sharp sequence
DIM notes_to_microbeats%(12) ! duration code (1 - 12) to microbeat value
DIM elapsed_microbeats%(3) !number of microbeats for each voice (bar lines)
DIM sprite$(30)
DIM seq%(3) !note sequence number in each voice during play
DIM micro_beat%(3) ! accumulated microbeats for voice (for play)
DIM next_event%(3) ! time for next note to sound for voice (for play)
DIM play_stop%(3) ! kounter for stop playing -used in cue
DIM note_tick%(3) ! time a note was sounded. Used for envelope
DIM tone_envel%(300) ! loudness envelope 1 to 100 for each voice
DIM volum(3),decay(3)
DIM voice_end_flag%(3) ! flag to signal end of voice
DIM note%(3),duration%(3),draw_flag%(3) !last notes sounded
DIM black_keys%(5) ! position of black keys on keyboard
REM white key - black key to pitch code converter
DIM white_keycod%(7),black_keycod%(7),white_key_decoder%(32),black_key_decoder%(21)
DIM x1%(50),x2%(50),y1%(50),y2%(50) ! for mouse sensitive zones
DIM kount%(2),vclen%(2),repeat_sign%(2),repeat_count%(2)
REM memory for storing music
DIM tnote&(2,1000),mubeat%(3)
DIM last_note_duration%(3) !need it if we correct an error with right button
REM if USESHARPS = 1 then sharps are used instead of flats
usesharps%=0
DEFMOUSE 0
CLS
rez%=XBIOS(4)
IF rez%<>1
  ALERT 3," Please switch to | medium resolution! ",1,"Oops",b%
  STOP
ENDIF
CLS
IF usesharps%<>1
  usesharps%=1
ELSE
  usesharps%=0
ENDIF
key_sig%=8 ! key signature for c major (a minor)
beats_per_bar%=4
beat_size%=4
bar_length%=beats_per_bar%*notes_to_microbeats%(beat_size%)
next_bar_line%=bar_length%
next_key_sig%=8
tnt%=11 ! assume quarter note sprite
staff_yshift%=-25 !vertical position to draw treble and bass staff
voic%=1
voic1%=voic%-1
speed%=50
@read_music_data
@load_note_sprites
@initialize_note_table
volum(0)=11
volum(1)=10
volum(2)=10
decay(0)=0.08
decay(1)=0.09
decay(2)=0.13
FOR i%=0 TO 2
  offset=volum(i%)
  attenuation=decay(i%)
  @make_tone_envelope(i%,offset,attenuation)
NEXT i%
@draw_musedt_screen
@reset
tlen%=4
@switch_note_duration
note_xcoor%=40
' run till infinity
FOR i%=1 TO 500000
  @decode_mouse_key
  PAUSE 10
  IF write%=1
    IF klick%=1 !appending or overwriting next note
      kount%(voic1%)=kount%(voic1%)+1
      tnote&(voic1%,kount%(voic1%))=nte%+tlen%*256
      last_note_duration%(voic1%)=tlen%
      IF tlen%<13
        elapsed_microbeats%(voic1%)=elapsed_microbeats%(voic1%)+notes_to_microbeats%(tlen%)
      ENDIF
      IF (elapsed_microbeats%(voic1%)>next_bar_line%)
        @new_bar_line
        note_xposition%=next_note_xposition%
      ENDIF
      IF next_note_xposition%>595 THEN
        @show
      ELSE
        @draw_note_on_staff(next_note_xposition%,1)
      ENDIF
      @sound_note
      @update_editor_windows
      IF kount%(voic1%)>vclen%(voic1%)
        vclen%(voic1%)=kount%(voic1%)
        '  @show
      ENDIF
    ENDIF
    IF klick%=2 !   right button for correcting the last note keyed in
      tnote&(voic1%,kount%(voic1%))=nte%+tlen%*256
      IF tlen%<>last_note_duration%(voic1%)
        elapsed_microbeats%(voic1%)=elapsed_microbeats%(voic1%)-notes_to_microbeats%(last_note_duration%(voic1%))
        elapsed_microbeats%(voic1%)=elapsed_microbeats%(voic1%)+notes_to_microbeats%(tlen%)
        last_note_duration%(voic1%)=tlen%
      ENDIF
      @show
      @sound_note
      @update_editor_windows
    ENDIF
  ENDIF
  IF klick%=0
    @ascii_code_dispatcher
  ENDIF
  IF ky%=38
    @execute_menu_command
  ENDIF
  IF ky%>33 AND ky%<37 !process repeat signs
    draw_marker(ky%-32,next_note_xposition%)
    INC kount%(voic1%)
    IF kount%(voic1%)>vclen%(voic1%)
      vclen%(voic1%)=kount%(voic1%)
    ENDIF
    tnote&(voic1%,kount%(voic1%))=256*(ky%-21)
  ENDIF
NEXT i%
> PROCEDURE tnote_structure_doc
  ' tnote array stores the pitch and duration value of every note
  ' to be played for the three voices (tracks). The high byte contains
  ' the duration code and other special codes. The low byte contains
  ' the pitch code. The pitch code modulo 12 maps into the note letter
  ' c,c#,d,d#,... b. If the pitch code is zero then a rest is assumed.
  ' The duration code 0 to 12 map to note duration in the order that
  ' the note duration sprites appear in the menu. Other codes 13 to 15
  ' control repeats. Codes 16 and 17 are not fully implemented but allow
  ' the inclusion of long rests in a particular voice. Other codes are
  ' only used for the input /output files *.TUN for specifying key signature,
  ' time signature, and tempo.
RETURN
> PROCEDURE note_sprites_doc
  ' order of sprites in the sprite array is: 1 c-cleff, 2 bass-cleff
  ' 3 flat symbol for tail up note, 4 flat symbol for tail down, 5,6 sharp
  ' symbol (tail up and down), 7,8 whole note symbol, 9,10 half note symbol
  ' 11,12 quarter note symbol, 13,14 eighth note symbol, 15,16 sixteenth note
  ' 17,18 32nd node, 19-25 rest symbols, 26,27 natural symbol.
RETURN
> PROCEDURE load_note_sprites
  LOCAL loop%
  OPEN "i",#1,"notes2.put"
  FOR loop%=1 TO 29
    sprite$(loop%)=INPUT$(CVI(INPUT$(2,#1)),#1)
  NEXT loop%
  CLOSE #1
RETURN
> PROCEDURE read_music_data
  @read_note_positions
  @read_note_duration_sprite_numbers
  @read_rest_duration_sprite_numbers
  @read_key_to_letter_converter
  @read_note_duration_code
  @read_key_signature_representation
  @read_order_of_flats_and_sharps
  @read_signature_sharp_sequence
  @read_timconv_array
  @read_key_decoders
RETURN
> PROCEDURE read_note_positions
  LOCAL i%
  REM read the vertical position to display the note sprites on
  REM the treble or bass staff.
  REM negative numbers are pointers to sharp or flat notes.
  FOR i%=1 TO 49
    READ note_yposition%(i%)
  NEXT i%
  FOR i%=1 TO 21
    READ flat_yposition%(i%)
  NEXT i%
  FOR i%=1 TO 20
    READ sharp_yposition%(i%)
  NEXT i%
  DATA 67,-1,65,-2,62,-3,60,58,-4,55
  DATA -5,63,61,-6,59,-7,56,-8,54,52
  DATA -9,32,-10,30,28,-11,25,-12,23,-13
  DATA 20,28,-14,26,-15,23,21,-16,19,-17
  DATA 17,-18,15,13,-19,11,-20,9,-21
  REM
  DATA 65,62,60,55,63,59,57,54,32,30
  DATA 25,23,20,26,23,19,17,15,11,9
  DATA 7
  REM
  DATA 67,65,62,58,55,61,59,56,52,32
  DATA 28,25,23,28,26,21,19,17,13,11
RETURN
> PROCEDURE read_note_duration_sprite_numbers
  LOCAL i%
  FOR i%=0 TO 12
    READ length_sprite%(i%)
  NEXT i%
  DATA 17,15,13,13,11,11,9,9,7,7,17,15,13
  ltlen%=4
RETURN
> PROCEDURE read_rest_duration_sprite_numbers
  LOCAL i%
  FOR i%=0 TO 12
    READ rest_sprite%(i%)
  NEXT i%
  DATA 24,23,22,22,21,21,20,20,19,19,24,23,22
RETURN
> PROCEDURE read_key_to_letter_converter
  LOCAL i%
  FOR i%=1 TO 12
    READ sharp_key_to_letter$(i%)
  NEXT i%
  FOR i%=1 TO 12
    READ flat_key_to_letter$(i%)
  NEXT i%
  DATA "C","C#","D","D#","E","F","F#","G","G#","A","A#","B"
  DATA "C","Db","D","Eb","E","F","Gb","G","Ab","A","Bb","B"
RETURN
> PROCEDURE read_note_duration_code
  LOCAL i%
  FOR i%=0 TO 17
    READ duration_to_text$(i%)
  NEXT i%
  DATA "TN","SN","EN","EN.","QN","QN.","HN","HN.","WN","WN.","TN3","SN3","EN3"
  DATA "SGN","REP","HID","RST1","RST2"
RETURN
> PROCEDURE read_key_signature_representation
  LOCAL i%
  FOR i%=1 TO 15
    READ keysig_to_text$(i%)
  NEXT i%
  DATA "Cb+ Ab-","Gb+ Eb-","Db+ Bb-","Ab+ F-","Eb+ C-"
  DATA "Bb+ G-","F+ D-","C+ A-","G+ E-","D+ B-"
  DATA "A+ F#-","E+ C#-","B+ Cb-","F#+ Gb-","C#+ Db-"
RETURN
> PROCEDURE read_order_of_flats_and_sharps
  ' order of flats and sharps when changing key signature.
  ' order is given in pitch codes
  LOCAL i%
  FOR i%=2 TO 15
    READ nat_keys%(i%)
  NEXT i%
  FOR i%=2 TO 15
    READ shrp_keys%(i%)
  NEXT i%
  DATA 6,1,8,3,10,5,12,6,1,8,3,10,5,12
  DATA 5,12,7,2,9,4,11,7,2,9,4,11,6,1
  FOR i%=1 TO 12
    assumed_accidental%(i%)=0
  NEXT i%
RETURN
> PROCEDURE read_signature_sharp_sequence
  LOCAL i%
  FOR i%=1 TO 7
    READ sharp_sig_ypos%(i%)
  NEXT i%
  FOR i%=1 TO 7
    READ flat_sig_ypos%(i%)
  NEXT i%
  DATA 21,28,19,26,32,24,30
  DATA 61,68,59,66,72,64,70
RETURN
> PROCEDURE read_timconv_array
  LOCAL i%
  REM for converting notes to microbeats
  FOR i%=0 TO 12
    READ notes_to_microbeats%(i%)
  NEXT i%
  DATA 3,6,12,18,24,36,48,72,96,144,2,4,8
  ' whole note = 96 microbeats
RETURN
> PROCEDURE read_key_decoders
  LOCAL i%
  REM The decoders convert the key press to the note to be sounded.
  FOR i%=1 TO 7
    READ white_keycod%(i%)
  NEXT i%
  FOR i%=1 TO 5
    READ black_keycod%(i%)
  NEXT i%
  k%=0
  FOR j%=0 TO 3
    FOR i%=1 TO 7
      white_key_decoder%(k%)=white_keycod%(i%)+30+j%*12
      k%=k%+1
    NEXT i%
  NEXT j%
  white_key_decoder%(28)=0 !for rest note
  white_key_decoder%(29)=0 ! for rest note
  white_key_decoder%(30)=0 ! for rest note
  white_key_decoder%(31)=0
  k%=1
  FOR j%=0 TO 3
    FOR i%=1 TO 5
      black_key_decoder%(k%)=black_keycod%(i%)+30+12*j%
      k%=k%+1
    NEXT i%
  NEXT j%
  DATA 0,2,4,6,7,9,11
  DATA 1,3,5,8,10
RETURN
> PROCEDURE read_black_keys
  LOCAL i%
  RESTORE black_keys_data
  FOR i%=1 TO 5
    READ black_keys%(i%)
  NEXT i%
black_keys_data:
  DATA 13,35,57,93,117
RETURN
'
'
> PROCEDURE decode_mouse_key
  ' the program spends most of its time here waiting for input
  ' from the mouse or keyboard. ky% contains the key (black or white)
  ' on the keyboard or other function buttons. eky% contains the
  ' ascii code of key pressed on computer keyboard.
  ' if a piano keyboard key is pressed, the pitch code is put in nte%
  ' flags like write%, klick%, indicate what action is needed later
  ky%=0
  write%=0
  SHOWM
  REPEAT
    k$=INKEY$
    klick%=MOUSEK
  UNTIL klick%<>0 OR k$<>""
  IF k$<>"" THEN
    eky%=ASC(k$)
    GOTO mouse_key_exit
  ENDIF
  ky%=@get_zone
  IF ky%=0
    ypos%=MOUSEY
    IF ypos%<wb% AND ypos%>wt%
      ky%=(MOUSEX) DIV 20
      write%=1
      nte%=white_key_decoder%(ky%)
      IF ky%>28 !so we don't have conflict with function keys
        ky%=28
      ENDIF
      GOTO mouse_key_exit
    ENDIF
  ENDIF
  IF ky%<21 AND ky%>0 THEN
    nte%=black_key_decoder%(ky%)
    write%=1
    GOTO mouse_key_exit
  ENDIF
  IF ky%>33
    GOTO mouse_key_exit
  ENDIF
  IF ky%>20
    tlen%=ky%-21
    write%=0
    @switch_note_duration
  ENDIF
mouse_key_exit:
RETURN
> PROCEDURE ascii_code_dispatcher
  ' the ascii code dispatcher provides a sometimes more convenient
  ' way of calling a function. i.e type l or L gets the load file
  ' function. The F1 to F10 map into note durations. This feature
  ' is not documented in the help file.
  IF eky%=0
    scancode%=CVI(k$)
    IF scancode%>58 AND scancode%<68
      tlen%=scancode%-58
      @switch_note_duration
      GOTO exit_dispatcher
    ENDIF
    SELECT scancode%
    CASE 82
      @insert_note
    DEFAULT
    ENDSELECT
  ELSE
    SELECT eky%
    CASE 76,108
      @read_tune_file
    CASE 83,115
      @write_tune_file
    CASE 65,97
      @append_tune_file
    CASE 67,99
      @clear_one_voice
    CASE 74,106
      '     @jump
    CASE 113
      @cue
    CASE 127
      @delete_note
    DEFAULT
      LOCATE 1,1
      PRINT eky%
    ENDSELECT
  ENDIF
exit_dispatcher:
  k$=""
RETURN
'
> PROCEDURE draw_sharp_key_signature
  LOCAL i%
  next_note_xposition%=50
  FOR i%=1 TO key_sig%-8
    yp%=sharp_sig_ypos%(i%)
    PUT next_note_xposition%,yp%+staff_yshift%+40,sprite$(6),7
    yp%=flat_sig_ypos%(i%)
    PUT next_note_xposition%,yp%+staff_yshift%+40,sprite$(6),7
    next_note_xposition%=next_note_xposition%+10
  NEXT i%
RETURN
> PROCEDURE draw_flat_key_signature
  LOCAL i%
  next_note_xposition%=50
  FOR i%=1 TO 8-key_sig%
    yp%=sharp_sig_ypos%(8-i%)
    PUT next_note_xposition%,yp%+staff_yshift%+40,sprite$(5),7
    yp%=flat_sig_ypos%(8-i%)
    PUT next_note_xposition%,yp%+staff_yshift%+40,sprite$(5),7
    next_note_xposition%=next_note_xposition%+10
  NEXT i%
RETURN
> PROCEDURE draw_treble_bass_staff
  DEFFILL 0
  PBOX 5,48+staff_yshift%,639,124+staff_yshift%
  DEFFILL 1
  COLOR 1
  FOR i=1 TO 5
    LINE 5,60+staff_yshift%+i*5,639,60+i*5+staff_yshift%
    LINE 5,95+i*5+staff_yshift%,639,95+i*5+staff_yshift%
  NEXT i
  PUT 10,65+staff_yshift%,sprite$(1),7
  PUT 10,100+staff_yshift%,sprite$(2),7
  next_note_xposition%=55
  @display_key_signature
  GET 0,60+staff_yshift%,620,121+staff_yshift%,staff$ !save for refresh
RETURN
> PROCEDURE draw_musedt_screen
  CLS
  @draw_keyboard
  @draw_black_keys
  @display_note_duration_menu
  @display_menu
  @display_top_menu
  @display_tempo
  @display_editor_key_sig
  @display_number_of_beats
  @display_beat_size
  @draw_treble_bass_staff
RETURN
> PROCEDURE display_key_signature
  IF key_sig%<8
    draw_flat_key_signature
    usesharps%=0
  ENDIF
  IF key_sig%>8
    draw_sharp_key_signature
    usesharps%=1
  ENDIF
  next_note_xposition%=next_note_xposition%+10
  new_staff_xposition%=next_note_xposition%
RETURN
> PROCEDURE new_key_signature
  ' if assumed_accidental = 0 --> usual for action drawing note
  ' if assumed_accidental = 1 or -1 --> suppress accidental
  ' if assumed_accidental = 2 or -2 --> must precede note with natural sign
  ' when changing key signature we update this table
  IF next_key_sig%=key_sig%
    GOTO new_key_sig_return
  ENDIF
  IF next_key_sig%>key_sig%
    WHILE key_sig%<next_key_sig%
      key_sig%=key_sig%+1
      assumed_accidental%(nat_keys%(key_sig%))=assumed_accidental%(nat_keys%(key_sig%))+2
      assumed_accidental%(shrp_keys%(key_sig%))=assumed_accidental%(shrp_keys%(key_sig%))+1
    WEND
    GOTO new_key_sig_return
  ELSE
    WHILE key_sig%>next_key_sig%
      assumed_accidental%(nat_keys%(key_sig%))=assumed_accidental%(nat_keys%(key_sig%))-2
      assumed_accidental%(shrp_keys%(key_sig%))=assumed_accidental%(shrp_keys%(key_sig%))-1
      key_sig%=key_sig%-1
    WEND
  ENDIF
new_key_sig_return:
RETURN
> PROCEDURE new_bar_line
  next_bar_line%=next_bar_line%+bar_length%
  next_note_xposition%=next_note_xposition%+5
  LINE next_note_xposition%,65+staff_yshift%,next_note_xposition%,85+staff_yshift%
  LINE next_note_xposition%,100+staff_yshift%,next_note_xposition%,120+staff_yshift%
  next_note_xposition%=next_note_xposition%+5
RETURN
> PROCEDURE draw_note_documentation
  ' Drawing a note on the musical staff, is quite complex. This
  ' is a first attempt. First we must intercept rests, repeat signs etc.
  ' We must put preceding sharp, flat, natural symbols if necessary.
  ' We display the note tail up or down depending on where it is on the
  ' staff. A dot or numeral 3 must be placed for dotted notes or triplets.
  ' Extra leger lines may be needed for some notes. Notes in other voices
  ' should be vertically aligned if they occur at the same time or
  ' otherwise offset.
RETURN
> PROCEDURE draw_note_on_staff(xp%,voice%)
  REM intercept nte=0 for rests
  REM need voice% number to decide which staff to put rests
  '
  ' is it a rest note or a repeat sign
  IF nte%=0
    yp%=0
    IF voice%>1
      yp%=35
    ENDIF
    IF tlen%<13
      PUT xp%,67+yp%+staff_yshift%,sprite$(rest_sprite%(tlen%)),7
      IF tlen%>2
        IF ((tlen% MOD 2)=1)
          PBOX xp%+20,70+yp%+staff_yshift%,xp%+21,71+yp%+staff_yshift%
        ENDIF
      ENDIF
      xp%=xp%+25
    ELSE
      draw_marker(tlen%-11,xp%)
    ENDIF
    GOTO draw_note_return
  ENDIF
  '
  ' not a rest note
  yp%=note_yposition%(nte%-29)
  ltr%=(nte% MOD 12)
  IF ltr%=0 THEN
    ltr%=12
  ENDIF
  '
  ' do we draw any accidentals
  accid%=0
  IF yp%<0 AND usesharps%=0
    yp%=flat_yposition%(-yp%)
    accid%=1
  ENDIF
  IF yp%<0 AND usesharps%=1
    yp%=sharp_yposition%(-yp%)
    accid%=2
  ENDIF
  yp%=yp%+40
  tnt%=length_sprite%(tlen%) !sprite number ignoring tail up/down
  qnt%=tnt%
  '
  ' up tail or down tail
  IF nte%>39 THEN
    qnt%=tnt%+1
  ENDIF
  IF nte%=40 AND usesharps%=1
    qnt%=tnt%
  ENDIF
  IF nte%>(49+usesharps%)
    qnt%=tnt%
  ENDIF
  IF nte%>60
    qnt%=tnt%+1
  ENDIF
  IF nte%=49
    qnt%=tnt%
    yp%=74
  ENDIF
  IF (ABS(assumed_accidental%(ltr%))=1) ! sharps or flats subsumed
    accid%=0
  ENDIF
  IF (ABS(assumed_accidental%(ltr%))<>2)
    IF accid%=0
      GOTO noaccidentals
    ENDIF
    '
    ' draw accidental (sharp  or flat)
    IF (qnt% MOD 2)=1 THEN
      accbse%=2
    ENDIF
    IF (qnt% MOD 2)=0 THEN
      accbse%=4
    ENDIF
    PUT xp%,yp%+staff_yshift%,sprite$(accid%+accbse%),7
    xp%=xp%+10
    GOTO noaccidentals
  ENDIF
  '
  ' draw natural sign
  IF (qnt% MOD 2)=1
    accbse%=25
  ELSE
    accbse%=26
  ENDIF
  PUT xp%,yp%+staff_yshift%,sprite$(accbse%),7
  xp%=xp%+10
noaccidentals:
  PUT xp%,yp%+staff_yshift%,sprite$(qnt%),7
  '
  ' extra ledger lines?
  IF nte%=49 AND qnt%=tnt%
    LINE xp%+4,89+staff_yshift%,xp%+19,89+staff_yshift%
  ENDIF
  IF nte%=50 AND qnt%=tnt% AND usesharps%=1
    LINE xp%+4,89+staff_yshift%,xp+19,89+staff_yshift%
  ENDIF
  IF nte%=49 AND qnt%<>tnt%
    LINE xp%+4,96+staff_yshift%,xp%+19,96+staff_yshift%
  ENDIF
  IF nte%=50 AND usesharps%=1 AND qnt%<>tnt%
    LINE xp%+4,96+staff_yshift%,xp%+19,96+staff_yshift%
  ENDIF
  IF nte%>69
    LINE xp%+3,61+staff_yshift%,xp%+20,61+staff_yshift%
  ENDIF
  IF nte%>72 THEN
    LINE xp%+3,57+staff_yshift%,xp%+20,57+staff_yshift%
  ENDIF
  IF nte%=77
    LINE xp%+3,53+staff_yshift%,xp%+20,53+staff_yshift%
  ENDIF
  xp%=xp%+25
  '
  ' dotted note?
  IF (tlen%>2) AND (tlen%<10) AND ((tlen% MOD 2)=1)
    IF (qnt% MOD 2)=0
      PBOX xp%,yp%+staff_yshift%+5,xp%+1,yp%+staff_yshift%+6
    ELSE
      PBOX xp%,yp%+staff_yshift%+15,xp%+1,yp%+staff_yshift%+16
    ENDIF
    xp%=xp%+5
  ENDIF
  IF (tlen%>9)
    DEFTEXT 1,1,0,4
    IF (qnt% MOD 2)=0
      TEXT xp%,yp%+staff_yshift%+7,"3"
    ELSE
      TEXT xp%,yp%+staff_yshift%+17,"3"
    ENDIF
  ENDIF
draw_note_return:
  next_note_xposition%=MAX(xp%,next_note_xposition%)
RETURN
> PROCEDURE draw_marker(num%,xp%)
  ' repeat markers num% from 1 to 3
  IF voic1%<1
    PUT xp%,66+staff_yshift%,sprite$(num%+25),7
  ELSE
    PUT xp%,102+staff_yshift%,sprite$(num%+25),7
  ENDIF
  next_note_xposition%=xp%+15
RETURN
> PROCEDURE new_staff
  DEFFILL 0
  PBOX 0,52+staff_yshift%,639,124+staff_yshift%
  PUT 0,60+staff_yshift%,staff$
  xp%=0
  xnx%=0
  next_note_xposition%=new_staff_xposition%
  DEFFILL 1
RETURN
'
> PROCEDURE yamaha_doc
  ' I was not very successful using the sound or wave commands in gfa
  ' basic to produce polyphonic music. (Its ok for chords). Furthermore
  ' the envelope feature on the Yamaha chip produced problems that I could
  ' not resolve. I therefore implemented the sound at a fairly low level
  ' using BIOS commands. The following functions interface with the xbios
  ' command 28. This is tricky since some of the registers are used for
  ' disk i/o and damage to the disk can result. I put in extra protection
  ' in this code which should never be commented out.
  ' I decided to implement the music production this way rather than
  ' using the xbios 32 play sequence command so that I can follow the
  ' production of each note. Even though I am controlling the amplitude
  ' envelope every 50 th of a second, as well as placing sprites on the
  ' screen, there is ample time left over.
  ' The make_tone_envelope function controls the linear rise and two
  ' linear decay modes of the amplitude. The envelope is put into a table.
  '
  ' The procedure play_next_notes, polls all three voices to see whether
  ' it is time to change the volume or pitch of a note. When it is
  ' time to change it finds the next note and sets the time to change
  ' that note based on the notes duration and the slowness of the music.
RETURN
> PROCEDURE initialize_note_table
  ' Thanks ken
  LOCAL note|
  IF NOT u__init!
    u__init!=TRUE
    DIM u__period%(96)
    FOR note|=0 TO 12
      FOR o%=0 TO 7
        u__period%(12*o%+note|)=125000/(2^o%*440*(2^(note|/12))/(2^(10/12))/16)+0.5
      NEXT o%
    NEXT note|
  ENDIF
RETURN
> PROCEDURE set_tone_period(voice%,period%)
  LOCAL reg%,period_low%,period_hi%,reg_val%
  IF voice%<0 OR voice%>2
    GOTO set_tone_err
  ENDIF
  reg%=voice%*2
  period_low%=AND(period%,255)
  period_hi%=SHR(AND(period%,&HF00),8)
  period%=XBIOS(28,period_low%,reg%+128) !period% is not used anymore
  reg%=reg%+1
  reg_val%=AND(XBIOS(28,0,reg%),&HF0) !must save hi bits
  reg_val%=OR(AND(period_hi%,15),reg_val%) !combine low and hi bits
  reg_val%=XBIOS(28,reg_val%,reg%+128) !output
  GOTO set_tone_return
set_tone_err:
  STOP
set_tone_return:
RETURN
> PROCEDURE disable_noise_channels
  LOCAL reg_val%
  reg_val%=XBIOS(28,0,7)
  reg_val%=OR(AND(reg_val%,192),56)
  reg_val=XBIOS(28,reg_val%,7+128)
RETURN
> PROCEDURE set_volume(voice%,level%)
  ' level between 0 and 15 for constant volume
  ' level 16 for waveform envelope
  LOCAL reg%,reg_val%
  IF voice%<0 OR voice>2 !check for legal voice number
    GOTO set_volume_err
  ENDIF
  IF level%>31 OR level%<0
    GOTO set_volume_err
  ENDIF
  reg%=8+voice%
  regval%=XBIOS(28,0,reg%)
  regval%=AND(regval%,&HE0) !save only top 3 bits
  regval%=OR(regval%,AND(level%,31))
  regval%=XBIOS(28,regval%,reg%+128)
  GOTO set_volume_return
set_volume_err:
  STOP
set_volume_return:
RETURN
> PROCEDURE play_tune(cue_flag%)
  ' The procedure plays song number numb%.
  ' The base_time% is set to the current time in ticks.
  ' The function next_note is called repeatedly, to sound the next
  ' note when it is time to do so. If a note has been sounded, we
  ' draw it on the staff.
  LOCAL i%,note_xposition%
  skoll%=0 ! rem scrolling is off
  @draw_treble_bass_staff
  ' find voices
  IF speed%>0
    slowness=135/speed% !comment this statement when debugging
  ELSE
    slowness=2
  ENDIF
  base_time%=TIMER
  FOR i%=1 TO 3
    IF cue_flag%<>1
      seq%(i%)=0
      repeat_count%(i%-1)=0
      repeat_sign%(i%-1)=0
      play_stop%(i%-1)=vclen%(i%-1)
      elapsed_microbeats%(i%-1)=0
      micro_beat%(i%)=0
      next_bar_line%=bar_length%
    ELSE
      play_stop%(i%-1)=kount%(i%-1)
    ENDIF
    IF klick%=2 AND cue_flag%=1
      play_stop%(i%-1)=vclen%(i%-1)
    ENDIF
    next_event%(i%)=base_time%+slowness*micro_beat%(i%)
    IF seq%(i%)<=play_stop%(i%-1)
      voice_end_flag%(i%)=0
    ELSE
      voice_end_flag%(i%)=1
    ENDIF
    @set_volume(i%-1,10)
    @set_tone_period(i%-1,5)
  NEXT i%
  LOCATE 1,1
  '
  ' ready to start
  @disable_noise_channels
  REPEAT
    FOR i%=1 TO 3
      draw_flag%(i%)=0
    NEXT i%
    @play_next_notes
    ' the rest of this code is used for drawing the notes on the staff
    ' when necessary.
    IF next_note_xposition%>595 THEN
      @new_staff
    ENDIF
    note_xposition%=next_note_xposition%
    FOR i%=1 TO 3
      IF draw_flag%(i%)=1
        kk%=i%
        nte%=note%(i%)
        tlen%=duration%(i%)
        elapsed_microbeats%(i%-1)=elapsed_microbeats%(i%-1)+notes_to_microbeats%(tlen%)
        IF (elapsed_microbeats%(i%-1)>next_bar_line%)
          @new_bar_line
          note_xposition%=next_note_xposition%
        ENDIF
        ' PRINT nte%,tlen%
        IF (nte%>29 AND nte%<90) OR nte%=0
          @draw_note_on_staff(note_xposition%,i%)
        ENDIF
      ENDIF
    NEXT i%
    PAUSE 1 ! we have lots of time to spare
    i%=voice_end_flag%(1)+voice_end_flag%(2)+voice_end_flag%(3)
    key_interrupt$=INKEY$
    IF cue_flag%=1 AND klick%<>2
      IF seq%(voic1%+1)>=kount%(voic1%)
        i%=3
      ENDIF
    ENDIF
  UNTIL i%=3 OR key_interrupt$<>""
  FOR i%=0 TO 2
    set_volume(i%,0)
    IF seq%(i%+1)<=vclen%(i%)
      kount%(i%)=seq%(i%+1) !play_next_notes overshoots
    ELSE
      kount%(i%)=vclen%(i%)
    ENDIF
  NEXT i%
  tlen%=duration%(voic%)
  @update_editor_windows
  @switch_note_duration
RETURN
> PROCEDURE play_next_notes
  LOCAL i%,j%
  ' this procedure sequences through the notes in the tnote array and
  ' sounds them on the Yamaha chip using the xbios function 28. The array
  ' voice_end_flag indicates whether a particular voice has finished.
  ' The next_event% array indicates the next time tick to process the
  ' next note for the particular voice. The tick number was determined
  ' from the previous note duration (and slowness parameter).
  ' If the note was sounded, we store the key and duration for that voice
  ' in the arrays note% and duration%. We set the draw_flag to tell
  ' the procedure play_tune that we have a note to be displayed on the
  ' staff.
  ' this code applies the envelope function to the amplitude.
  t%=TIMER
  FOR i%=1 TO 3
    index%=SHR(t%,2)-note_tick%(i%)
    IF index%>0 AND index%<100
      j%=i%-1
      set_volume(j%,tone_envel%(index%+j%*100))
    ENDIF
  NEXT i%
  '
  FOR i%=1 TO 3 !check if it is time to sound next note for all voices
    IF voice_end_flag%(i%)<1
      IF t%>=next_event%(i%)
        tlen%=-1
        ' find the next note of finite duration and bypass any control
        ' codes
        DO UNTIL tlen%>=0 AND tlen%<13 OR seq%(i%)>play_stop%(i%-1) OR tlen%>14
          seq%(i%)=seq%(i%)+1
          ne%=tnote&(i%-1,seq%(i%))
          IF seq%(i%)>play_stop%(i%-1)
            voice_end_flag%(i%)=1
            set_volume(i%-1,0)
            tlen%=0
          ELSE
            tlen%=SHR(ne%,8)
          ENDIF
          IF tlen%=13
            repeat_sign%(i%-1)=seq%(i%)
            repeat_count%(i%-1)=0
          ENDIF
          IF tlen%=14 AND repeat_count%(i%-1)<1
            seq%(i%)=repeat_sign%(i%-1)
            INC repeat_count%(i%-1)
          ENDIF
          IF tlen%=16
            ' necessary to resync using a variable size rest
            low_byte%=ne% MOD 256
            elapsed_microbeats%(i%-1)=elapsed_microbeats%(i%-1)+low_byte%*96
            micro_beat%(i%)=micro_beat%(i%)+low_byte%*96
          ENDIF
          IF tlen%=17
            ' necessary to resync using a variable size rest
            low_byte%=ne% MOD 256
            elapsed_microbeats%(i%-1)=elapsed_microbeats%(i%-1)+low_byte%
            micro_beat%(i%)=micro_beat%(i%)+low_byte%
          ENDIF
        LOOP
        IF tlen%=15 AND repeat_count%(i%-1)>0
          skip_to_repeat_sign(i%)
        ENDIF
        IF seq%(i%)>1000
          voice_end_flag%(i%)=1
        ENDIF
        IF voice_end_flag%(i%)=1
          GOTO play_next_voice
        ENDIF
        IF tlen%>13
          next_event%(i%)=base_time%+micro_beat%(i%)*slowness
          set_volume(i%-1,0)
          note_tick%(i%)=0
          GOTO play_next_voice
        ENDIF
        nte%=ne% MOD 256 !get and sound note
        IF nte%<96 AND nte%>5
          set_tone_period(i%-1,u__period%(nte%))
          note_tick%(i%)=SHR(t%,2)
        ENDIF
        ' set time to end note
        micro_beat%(i%)=micro_beat%(i%)+notes_to_microbeats%(tlen%)
        next_event%(i%)=base_time%+micro_beat%(i%)*slowness
        draw_flag%(i%)=1
        note%(i%)=nte%
        duration%(i%)=tlen%
      ENDIF
    ENDIF
  play_next_voice:
  NEXT i% ! next voice
RETURN
> PROCEDURE resync_voices
  ' inserts rests to get all voices resyncd.
  LOCAL i%,j%,repeat%,largest%,nrest%,nfrac%,dif%,timinc%
  largest%=0
  FOR j%=0 TO 2
    repeat%=1
    elapsed_microbeats%(j%)=0
    FOR i%=1 TO vclen%(j%)
      tlen%=SHR(tnote&(j%,i%),8)
      low_byte%=tnote&(j%,i%) MOD 256
      IF tlen%=13
        repeat%=2
      ENDIF
      IF tlen%=14 OR tlen%=15
        repeat%=1
      ENDIF
      IF tlen%>0 AND tlen%<13
        timinc%=notes_to_microbeats%(tlen%)
        elapsed_microbeats%(j%)=elapsed_microbeats%(j%)+timinc%*repeat%
      ENDIF
      IF tlen%=16
        timinc%=low_byte%*96
        elapsed_microbeats%(j%)=elapsed_microbeats%(j%)+timinc%*repeat%
      ENDIF
      IF tlen%=17
        timinc%=low_byte
        elapsed_microbeats%(j%)=elapsed_microbeats%(j%)+timinc%*repeat%
      ENDIF
    NEXT i%
    largest%=MAX(largest%,elapsed_microbeats%(j%))
  NEXT j%
  '  LOCATE 20,1
  ' PRINT SPACE$(20)
  ' LOCATE 20,1
  FOR j%=0 TO 2
    dif%=(largest%-elapsed_microbeats%(j%))
    ' PRINT elapsed_microbeats%(j%);" ";
    nrest%=dif% DIV 96
    nfrac%=dif% MOD 96
    IF nrest%<>0
      INC vclen%(j%)
      tnote&(j%,vclen%(j%))=256*16+nrest%
    ENDIF
    IF nfrac%<>0
      INC vclen%(j%)
      tnote&(j%,vclen%(j%))=256*17+nfrac%
    ENDIF
  NEXT j%
RETURN
> PROCEDURE compute_seq_in_middle(voice%,kounter%)
  ' in order to get random access to any part of the music
  ' in the cue command, the procedure finds note positions
  ' for the other voices which would be sounded at the
  ' same time as tnote(voice%,kounter%). It also sets up
  ' relative delays in case the corresponding notes in the other voices
  ' are not coincident.
  LOCAL i%,stopmubeat%,mubeat%
  stopmubeat%=0
  seq%(voice%+1)=kounter%
  FOR i%=1 TO kounter%
    tlen%=SHR(tnote&(voice%,i%),8)
    IF tlen%>0 AND tlen%<10
      stopmubeat%=stopmubeat%+notes_to_microbeats%(tlen%)
    ENDIF
  NEXT i%
  ' now find seq% for the other voices
  FOR j%=0 TO 2
    mubeat%(j%)=0
  NEXT j%
  FOR j%=0 TO 2
    IF j%<>voice%
      FOR i%=0 TO vclen%(j%)
        '
        tlen%=SHR(tnote&(j%,i%),8)
        IF tlen%>0 AND tlen%<13
          mubeat%(j%)=mubeat%(j%)+notes_to_microbeats%(tlen%)
        ENDIF
        EXIT IF mubeat%(j%)>=stopmubeat%
      NEXT i%
      seq%(j%+1)=i%
    ELSE
      mubeat%(j%)=stopmubeat%
    ENDIF
  NEXT j%
  FOR j%=0 TO 2
    elapsed_microbeats%(j%)=mubeat%(j%)
    micro_beat%(j%+1)=mubeat%(j%)-stopmubeat%
  NEXT j%
  ' be sure that seq() does not go beyond vclen%()
  FOR j%=1 TO 3
    IF vclen%(j%-1)=0
      seq%(j%)=0
    ENDIF
  NEXT j%
  next_bar_line%=(stopmubeat% DIV bar_length%+1)*bar_length%
RETURN
> PROCEDURE cue
  IF kount%(voic1%)>5
    compute_seq_in_middle(voic1%,kount%(voic1%)-5)
  ELSE
    compute_seq_in_middle(voic1%,1)
  ENDIF
  LOCATE 1,1
  play_tune(1)
RETURN
> PROCEDURE skip_to_repeat_sign(i%)
  LOCAL done%
  done%=0
  DO UNTIL voice_end_flag%(i%-1)=1 OR done%=1
    INC seq%(i%)
    ne%=tnote&(i%-1,seq%(i%))
    IF seq%(i%)>play_stop%(i%-1)
      voice_end_flag%(i%)=1
      set_volume(i%-1,0)
      tlen%=0
    ELSE
      tlen%=SHR(ne%,8)
    ENDIF
    IF tlen%=14
      done%=1
    ENDIF
  LOOP
RETURN
'
> PROCEDURE draw_keyboard
  LOCAL i%
  wb%=195
  wt%=wb%-40
  REM draw white keys
  FOR i%=0 TO 28
    BOX i%*20,wb%,i%*20+18,wt%
  NEXT i%
  DEFTEXT 1,0,2700,13
  TEXT 563,wt%+5,"REST"
  DEFTEXT 1,1,0,6
RETURN
> PROCEDURE draw_black_keys
  LOCAL i%,j%
  @read_black_keys
  DEFFILL 1
  wb%=wb%-13
  k%=1
  REM draw black keys. The black keys are also zoned.
  FOR j%=1 TO 4
    FOR i%=1 TO 5
      PBOX black_keys%(i%),wb%,black_keys%(i%)+10,wt%
      set_zone(k%,black_keys%(i%),wt%,black_keys%(i%)+10,wb%)
      k%=k%+1
      black_keys%(i%)=black_keys%(i%)+140
    NEXT i%
  NEXT j%
  wb%=wb%+13
  number_of_zones%=k%-1
RETURN
> PROCEDURE set_zone(num%,xleft%,ytop%,xright%,ybot%)
  ' sets up mouse sensitive zones
  x1%(num%)=xleft%
  x2%(num%)=xright%
  y1%(num%)=ytop%
  y2%(num%)=ybot%
RETURN
> FUNCTION get_zone
LOCAL i%
button%=0
FOR i%=1 TO number_of_zones%
  IF (MOUSEX>x1%(i%))
    IF MOUSEX<x2%(i%)
      IF MOUSEY>y1%(i%)
        IF MOUSEY<y2%(i%)
          RETURN i%
        ENDIF
      ENDIF
    ENDIF
  ENDIF
NEXT i%
RETURN 0
ENDFUNC
> PROCEDURE display_note_duration_menu
DEFFILL 1
xp%=1
yp%=130
k%=21
FOR i%=0 TO 12
  PUT xp%,yp%,sprite$(length_sprite%(i%))
  IF i%>2 AND (i% MOD 2)=1 AND i%<10
    PBOX xp%+25,yp%+15,xp%+26,yp%+16
  ENDIF
  IF i%>9
    DEFTEXT 1,1,0,4
    TEXT xp%+22,yp%+17,"3"
  ENDIF
  BOX xp%,yp%,xp%+34,yp%+20
  @set_zone(k%,xp%,yp%,xp%+34,yp%+20)
  k%=k%+1
  xp%=xp%+35
NEXT i%
FOR i%=13 TO 15
  PUT xp%+5,yp%+2,sprite$(i%+14)
  BOX xp%,yp%,xp%+34,yp%+20
  @set_zone(k%,xp%,yp%,xp%+34,yp%+20)
  k%=k%+1
  xp%=xp%+35
NEXT i%
number_of_zones%=k%
RETURN
> PROCEDURE switch_note_duration
COLOR 0
BOX ltlen%*35+2,131,(1+ltlen%)*35+2,149
COLOR 1
BOX tlen%*35+2,131,(1+tlen%)*35+2,149
ltlen%=tlen%
RETURN
> PROCEDURE display_menu
LOCAL i%
menu_row%=114
BOX 0,menu_row%-9,470,menu_row%+12
INC number_of_zones%
set_zone(number_of_zones%,0,menu_row%-9,470,menu_row%+12)
LINE 0,menu_row%+2,470,menu_row%+2
FOR i%=1 TO 9
  LINE i%*48-2,menu_row%-9,i%*48-2,menu_row%+12
NEXT i%
DEFTEXT 1,0,0,6
TEXT 2,menu_row%,"PLAY"
TEXT 6*8,menu_row%,"SHOW"
TEXT 12*8,menu_row%," -->"
TEXT 18*8,menu_row%," <-- "
SELECT voic%
CASE 1
  TEXT 24*8,menu_row%,"TRK 1"
CASE 2
  TEXT 24*8,menu_row%,"TRK 2"
CASE 3
  TEXT 24*8,menu_row%,"TRK 3"
ENDSELECT
TEXT 30*8,menu_row%," KEY "
TEXT 8*36,menu_row%,"RESET"
TEXT 8*42,menu_row%,"LOAD"
TEXT 8*48,menu_row%,"APND"
TEXT 8*54,menu_row%,"QUIT"
TEXT 2,menu_row%+10," CUE"
TEXT 6*8,menu_row%+10," FF"
TEXT 12*8,menu_row%+10," DEL"
TEXT 18*8,menu_row%+10," INS"
TEXT 24*8,menu_row%+10,"SPEED"
TEXT 30*8,menu_row%+10,"TIME"
TEXT 36*8,menu_row%+10,"CLEAR"
TEXT 42*8,menu_row%+10,"SAVE"
TEXT 48*8,menu_row%+10,"HELP"
TEXT 8*54,menu_row%+10,"ENVL"
RETURN
'
> PROCEDURE execute_menu_command
LOCAL command%
command%=((MOUSEY-menu_row%+9) DIV 10)*10+MOUSEX DIV 48
SELECT command%
CASE 0
  @play_tune(0)
CASE 1
  @show
CASE 2
  @shift_sequence_number(1)
CASE 3
  @shift_sequence_number(-1)
CASE 4
  @change_voice_number
CASE 5
  @set_key_signature
CASE 6
  @reset
CASE 7
  @read_tune_file
CASE 8
  @append_tune_file
CASE 9
  END
CASE 10
  @cue
CASE 11
  @fast_forward
CASE 12
  @delete_note
CASE 13
  @insert_note
CASE 14
  @set_speed
CASE 15
  @set_time_signature
CASE 16
  @clear_one_voice
CASE 17
  @write_tune_file
CASE 18
  @show_instructions
CASE 19
  @set_tone_envelope
DEFAULT
  LOCATE 1,1
  PRINT command%
ENDSELECT
RETURN
'
> PROCEDURE shift_sequence_number(dir%)
IF kount%(voic1%)<2 AND dir%<0
  GOTO shift_sequence_return
ENDIF
IF kount%(voic1%)>=vclen%(voic1%) AND dir%>0
  GOTO shift_sequence_return
ENDIF
IF dir%>0
  kount%(voic1%)=kount%(voic1%)+dir%
  ne%=tnote&(voic1%,kount%(voic1%))
  nte%=ne% MOD 256
  tlen%=ne% DIV 256
  IF tlen%<13
    elapsed_microbeats%(voic1%)=elapsed_microbeats%(voic1%)+notes_to_microbeats%(tlen%)
    @switch_note_duration
  ENDIF
ELSE
  ne%=tnote&(voic1%,kount%(voic1%))
  nte%=ne% MOD 256
  tlen%=ne% DIV 256
  IF tlen%<13
    elapsed_microbeats%(voic1%)=elapsed_microbeats%(voic1%)-notes_to_microbeats%(tlen%)
  ENDIF
  kount%(voic1%)=kount%(voic1%)+dir%
  ne%=tnote&(voic1%,kount%(voic1%))
  nte%=ne% MOD 256
  tlen%=ne% DIV 256
  IF tlen%<13
    @switch_note_duration
  ENDIF
ENDIF
next_bar_line%=(elapsed_microbeats%(voic1%) DIV bar_length%+1)*bar_length%
@update_editor_windows
@show
shift_sequence_return:
RETURN
> PROCEDURE change_voice_number
DEFTEXT 1,0,0,6
INC voic%
IF voic%>3
  voic%=1
ENDIF
SELECT voic%
CASE 1
  TEXT 24*8,menu_row%,"TRK 1"
CASE 2
  TEXT 24*8,menu_row%,"TRK 2"
CASE 3
  TEXT 24*8,menu_row%,"TRK 3"
ENDSELECT
voic1%=voic%-1
next_bar_line%=(elapsed_microbeats%(voic1%) DIV bar_length%+1)*bar_length%
@show
RETURN
> PROCEDURE set_speed
LOCAL xspeed%
xspeed%=2.3*xspeed%+400
DEFFILL 0
PBOX 400,0,639,30
DEFFILL 1
BOX 400,10,630,20
PBOX 400,11,xspeed%,19
SETMOUSE 510,22
TEXT 400,28,"SLOW"
TEXT 600,28,"FAST"
HIDEM
PAUSE 15
DO UNTIL MOUSEK<>0
  IF MOUSEX<400
    SETMOUSE 400,22
  ENDIF
  IF MOUSEX>630
    SETMOUSE 630,22
  ENDIF
  IF MOUSEY<>22
    SETMOUSE MOUSEX,22
  ENDIF
  DEFFILL 0
  PBOX MOUSEX,11,629,19
  DEFFILL 1
  PBOX 400,11,MOUSEX,19
  speed%=(MOUSEX-400)/2.3
  @display_tempo
LOOP
SHOWM
DEFFILL 0
PBOX 400,0,639,30
DEFFILL 1
SETMOUSE 300,100
PAUSE 5
RETURN
> PROCEDURE set_time_signature
DEFFILL 0
PBOX 400,0,639,30
LOCATE 51,1
PRINT "Press + or - for bar length"
DEFLINE 1,3
BOX 410,10,430,20
TEXT 416,18,"+"
set_zone(number_of_zones%+1,410,10,430,20)
BOX 450,10,470,20
TEXT 456,18,"-"
set_zone(number_of_zones%+2,450,10,470,20)
BOX 490,10,520,20
TEXT 496,18,"ok"
set_zone(number_of_zones%+3,490,10,520,20)
DEFLINE 1,1
eky%=0
number_of_zones%=number_of_zones%+3
DO UNTIL eky%=13 OR ky%=41
  k$=INKEY$
  eky%=ASC(k$)
  IF MOUSEK<>0
    ky%=@get_zone
    EXIT IF ky%<39
    PAUSE 10
  ENDIF
  IF (eky%=43 OR ky%=39) AND beats_per_bar%<100
    INC beats_per_bar%
    @display_number_of_beats
    ky%=38
    SHOWM
  ENDIF
  IF (eky%=45 OR ky%=40) AND beats_per_bar%>1
    DEC beats_per_bar%
    @display_number_of_beats
    ky%=38
    SHOWM
  ENDIF
LOOP
next_bar_line%=(elapsed_microbeats%(voic1%) DIV bar_length%+1)*bar_length%
PBOX 400,0,639,8
LOCATE 51,1
PRINT "Press + or - for beat size"
eky%=0
ky%=38
DO UNTIL eky%=13 OR ky%=41
  k$=INKEY$
  eky%=ASC(k$)
  IF MOUSEK<>0
    ky%=@get_zone
    PAUSE 10
    EXIT IF ky%<39
  ENDIF
  IF (eky%=43 OR ky%=39) AND beat_size<10
    INC beat_size%
    @display_beat_size
    ky%=38
    SHOWM
  ENDIF
  IF (eky%=45 OR ky%=40) AND beat_size%>1
    DEC beat_size%
    @display_beat_size
    ky%=38
    SHOWM
  ENDIF
LOOP
next_bar_line%=(elapsed_microbeats%(voic1%) DIV bar_length%+1)*bar_length%
number_of_zones%=number_of_zones%-3
PBOX 400,0,639,30
DEFFILL 1
RETURN
> PROCEDURE set_key_signature
DEFFILL 0
PBOX 400,0,639,30
LOCATE 51,1
PRINT "Press + or - to change key"
' LOCATE 51,2
' PRINT "(on keypad) and then return"
DEFLINE 1,3
BOX 410,10,430,20
TEXT 416,18,"+"
set_zone(number_of_zones%+1,410,10,430,20)
BOX 450,10,470,20
TEXT 456,18,"-"
set_zone(number_of_zones%+2,450,10,470,20)
BOX 490,10,520,20
TEXT 496,18,"ok"
set_zone(number_of_zones%+3,490,10,520,20)
DEFLINE 1,1
eky%=0
number_of_zones%=number_of_zones%+3
DO UNTIL eky%=13 OR ky%=41
  k$=INKEY$
  IF MOUSEK<>0
    ky%=@get_zone
    EXIT IF ky%<39
    PAUSE 10
  ENDIF
  eky%=ASC(k$)
  IF (eky%=43 OR ky%=39) AND key_sig%<15
    key_sig%=key_sig%+1
    assumed_accidental%(nat_keys%(key_sig%))=assumed_accidental%(nat_keys%(key_sig%))+2
    assumed_accidental%(shrp_keys%(key_sig%))=assumed_accidental%(shrp_keys%(key_sig%))+1
    @display_editor_key_sig
    @draw_treble_bass_staff
    ky%=38
    SHOWM
  ENDIF
  IF (eky%=45 OR ky%=40) AND key_sig%>1
    assumed_accidental%(nat_keys%(key_sig%))=assumed_accidental%(nat_keys%(key_sig%))-2
    assumed_accidental%(shrp_keys%(key_sig%))=assumed_accidental%(shrp_keys%(key_sig%))-1
    key_sig%=key_sig%-1
    @display_editor_key_sig
    @draw_treble_bass_staff
    ky%=38
    SHOWM
  ENDIF
LOOP
DEFFILL 0
PBOX 400,0,639,30
number_of_zones%=number_of_zones%-3
DEFFILL 1
RETURN
> PROCEDURE set_tone_envelope
CLS
@show_tone_envelope(voic1%)
TEXT 150,18,"Volume"
TEXT 150,30,"Decay"
BOX 210,10,230,20
TEXT 216,18,"+"
set_zone(number_of_zones%+1,210,10,230,20)
BOX 250,10,270,20
TEXT 256,18,"-"
set_zone(number_of_zones%+2,250,10,270,20)
BOX 210,22,230,32
TEXT 216,30,"+"
set_zone(number_of_zones%+3,210,22,230,30)
BOX 250,22,270,32
TEXT 256,30,"-"
set_zone(number_of_zones%+4,250,22,270,30)
BOX 290,10,320,20
TEXT 296,18,"ok"
set_zone(number_of_zones%+5,290,10,320,20)
DEFLINE 1,1
eky%=0
number_of_zones%=number_of_zones%+5
DO UNTIL ky%=43
  IF MOUSEK<>0
    ky%=@get_zone
  ENDIF
  IF (ky%=39)
    INC volum(voic1%)
    volum(voic1%)=MAX(15,volum(voic1%))
    @make_tone_envelope(voic1%,volum(voic1%),decay(voic1%))
    @show_tone_envelope(voic1%)
    ky%=0
    SHOWM
  ENDIF
  IF (ky%=40)
    DEC volum(voic1%)
    volum(voic%)=MIN(0,volum(voic1%))
    @make_tone_envelope(voic1%,volum(voic1%),decay(voic1%))
    @show_tone_envelope(voic1%)
    ky%=0
    SHOWM
  ENDIF
  IF (ky%=41)
    decay(voic1%)=decay(voic1%)+0.04
    decay(voic1%)=MIN(0.6,decay(voic1%))
    @make_tone_envelope(voic1%,volum(voic1%),decay(voic1%))
    @show_tone_envelope(voic1%)
    ky%=0
    SHOWM
  ENDIF
  IF (ky%=42)
    decay(voic1%)=decay(voic1%)-0.04
    decay(voic1%)=MAX(0,decay(voic1%))
    @make_tone_envelope(voic1%,volum(voic1%),decay(voic1%))
    @show_tone_envelope(voic1%)
    ky%=0
    SHOWM
  ENDIF
LOOP
DEFFILL 0
PBOX 400,0,639,30
number_of_zones%=number_of_zones%-5
DEFFILL 1
@draw_musedt_screen
RETURN
> PROCEDURE show_tone_envelope(num%)
LOCAL index%,i%,ix%,iy%
index%=100*num%
DEFFILL 0
PBOX 20,190,420,35
BOX 20,190,420,35
DEFFILL 1
FOR i%=0 TO 99
  ix%=20+4*i%
  iy%=190-10*tone_envel%(i%+index%)
  PBOX ix%,iy%,ix%+2,iy%-3
NEXT i%
TEXT 50,170,"Track"
TEXT 100,170,STR$(num%+1)
RETURN
> PROCEDURE make_tone_envelope(num%,offset,attenuation)
LOCAL index%,val%,i%
index%=num%*100
FOR i%=0 TO 99
  val%=offset-i%*attenuation
  val%=MAX(val%,0)
  val%=MIN(val%,15)
  tone_envel%(i%+index%)=val%
NEXT i%
RETURN
'
> PROCEDURE display_top_menu
edy%=14
edx%=58
ecol1%=6
ecol2%=16
ecol3%=22
ply%=2
plx%=1
LOCATE plx%,ply%
PRINT "Tempo"
LOCATE plx%+16,ply%
PRINT "Key Sig"
LOCATE plx%,ply%+1
PRINT "Num Beats"
LOCATE plx%+16,ply%+1
PRINT "Beat = "
RETURN
> PROCEDURE display_note_sequence
LOCAL beatnu%,beatfra%
LOCATE edx%+ecol1%,edy%
PRINT "          ";
LOCATE edx%+ecol1%,edy%
PRINT kount%(voic1%);
LOCATE edx%+ecol1%+4,edy%
beatnu%=elapsed_microbeats%(voic1%) DIV notes_to_microbeats%(beat_size%)
beatfra%=elapsed_microbeats%(voic1%) MOD notes_to_microbeats%(beat_size%)
PRINT beatnu%;"  ";beatfra%;
RETURN
> PROCEDURE display_note_name
ntelet%=nte% MOD 12
IF ntelet%=0 THEN
  ntelet%=12
ENDIF
nteoct%=nte% DIV 12
LOCATE edx%+ecol2%+1,edy%+voic%
PRINT "  ";
LOCATE edx%+ecol2%+1,edy%+voic%
IF nte%=0
  PRINT "PA";
ELSE
  IF kys%<8 THEN
    PRINT flat_key_to_letter$(ntelet%)
  ELSE
    PRINT sharp_key_to_letter$(ntelet%)
  ENDIF
  LOCATE edx%+ecol2%+3,edy%+voic%
  PRINT nteoct%;
ENDIF
RETURN
> PROCEDURE display_note_duration_name
LOCATE edx%+ecol2%+2,edy%
PRINT "   ";
LOCATE edx%+ecol2%+2,edy%
PRINT duration_to_text$(tlen%);
RETURN
> PROCEDURE update_editor_windows
@display_note_sequence
'  @display_note_name
@display_note_duration_name
REM gosub 6990 : rem return cursor to item
RETURN
> PROCEDURE display_tempo
LOCATE plx%+10,ply%
PRINT "   "
LOCATE plx%+10,ply%
PRINT speed%;
RETURN
> PROCEDURE display_editor_key_sig
LOCATE plx%+25,ply%
PRINT "       "
LOCATE plx%+25,ply%
PRINT keysig_to_text$(key_sig%);
RETURN
> PROCEDURE display_number_of_beats
LOCATE plx%+10,ply%+1
PRINT "  "
LOCATE plx%+10,ply%+1
PRINT beats_per_bar%;
bar_length%=beats_per_bar%*notes_to_microbeats%(beat_size%)
RETURN
> PROCEDURE display_beat_size
LOCATE plx%+23,ply%+1
PRINT "   "
LOCATE plx%+23,ply%+1
PRINT duration_to_text$(beat_size%);
bar_length%=beats_per_bar%*notes_to_microbeats%(beat_size%)
RETURN
'
> PROCEDURE show
LOCAL tlen%
@draw_treble_bass_staff
' back up by 12 notes
IF kount%(voic1%)<1
  GOTO show_return
ENDIF
FOR i%=0 TO 12
  EXIT IF (kount%(voic1%)-i%<1)
  nc%=tnote&(voic1%,kount%(voic1%)-i%)
  tlen%=nc% DIV 256
  IF tlen%<13
    elapsed_microbeats%(voic1%)=elapsed_microbeats%(voic1%)-notes_to_microbeats%(tlen%)
  ENDIF
  begn%=kount%(voic1%)-i%
NEXT i%
IF begn%>vclen%(voic1%)
  GOTO show_return
ENDIF
next_bar_line%=(elapsed_microbeats%(voic1%) DIV bar_length%+1)*bar_length%
kk%=voic%
FOR i%=begn% TO kount%(voic1%)
  nc%=tnote&(voic1%,i%)
  nte%=nc% MOD 256
  tlen%=nc% DIV 256
  IF tlen%<13
    elapsed_microbeats%(voic1%)=elapsed_microbeats%(voic1%)+notes_to_microbeats%(tlen%)
  ENDIF
  IF (tlen%<16)
    IF (elapsed_microbeats%(voic1%)>next_bar_line%)
      @new_bar_line
      note_xposition%=next_note_xposition%
    ENDIF
    @draw_note_on_staff(next_note_xposition%,voic%)
  ENDIF
NEXT i%
write%=0
show_return:
@update_editor_windows
RETURN
> PROCEDURE clear_one_voice
DEFFILL 0
PBOX 400,0,639,30
LOCATE 51,1
PRINT "Clear track ";voic1%+1;" to end?"
DEFLINE 1,3
BOX 410,10,440,20
TEXT 416,18,"yes"
set_zone(number_of_zones%+1,416,10,436,20)
BOX 460,10,490,20
TEXT 468,18,"no"
set_zone(number_of_zones%+2,460,10,490,20)
DEFLINE 1,1
DO UNTIL MOUSEK<>0
LOOP
number_of_zones%=number_of_zones%+2
ky%=@get_zone
IF ky%=39
  vclen%(voic1%)=kount%(voic1%)
ENDIF
PAUSE 10
number_of_zones%=number_of_zones%-2
PBOX 400,0,639,30
DEFFILL 1
RETURN
> PROCEDURE reset
FOR i%=0 TO 2
  kount%(i%)=0
  vclen%(i%)=0
  elapsed_microbeats%(i%)=0
NEXT i%
@draw_treble_bass_staff
write%=0
next_bar_line%=bar_length%
voic%=1
voic1%=0
DEFTEXT 1,0,0,6
TEXT 24*8,menu_row%,"TRK 1"
note_xcoor%=40
tlen%=4
@switch_note_duration
RETURN
> PROCEDURE write_tune_file
LOCATE 51,2
DEFFILL 0
PBOX 400,0,639,30
DEFFILL 1
' @tune_file_selector
FILESELECT #"output file","*.tun","noname.tun",tun$
@assert_tun_extension
PRINT "Output file :";tun$
IF tun$<>""
  OPEN "o",#1,tun$
  OUT #1,33
  OUT #1,key_sig%
  OUT #1,34
  OUT #1,beats_per_bar%
  OUT #1,35
  OUT #1,beat_size%
  OUT #1,36
  OUT #1,speed%
  OUT #1,37
  OUT #1,TRUNC(volum(0))+TRUNC(decay(0)*25)*16
  OUT #1,38
  OUT #1,TRUNC(volum(1))+TRUNC(decay(1)*25)*16
  OUT #1,39
  OUT #1,TRUNC(volum(2))+TRUNC(decay(2)*25)*16
  l%=8
  FOR i%=0 TO 2
    IF vclen%(i%)=0
      GOTO write_next_i
    ENDIF
    FOR k%=1 TO vclen%(i%)
      nc%=tnote&(i%,k%)
      tnte%=nc% MOD 256
      nlen%=nc% DIV 256
      OUT #1,nlen%
      OUT #1,tnte%
      l%=l%+2
    NEXT k%
    OUT #1,32
    OUT #1,0
    l%=l%+2
  write_next_i:
  NEXT i%
  CLOSE #1
  LOCATE 51,3
  PRINT l%;" bytes written"
ENDIF
write_tune_return:
ON ERROR
RETURN
> PROCEDURE write_tune_error
LOCATE 40,3
PRINT "disk write error"
RESUME write_tune_return
RETURN
> PROCEDURE read_tune_file
DEFFILL 0
PBOX 400,0,639,30
DEFFILL 1
LOCATE 51,2
' PRINT "Enter input file :";
' @tune_file_selector
FILESELECT #"input file","*.tun","noname.tun",tun$
PRINT "Input file = ";tun$
IF EXIST(tun$)=-1
  OPEN "i",#1,tun$
  FOR i%=0 TO 2
    vclen%(i%)=0
    kount%(i%)=0
  NEXT i%
  i%=0
  l%=0
  FOR k%=1 TO LOF(#1)/2
    s$=INPUT$(1,#1)
    nlen%=ASC(s$)
    s$=INPUT$(1,#1)
    tnte%=ASC(s$)
    nc%=nlen%*256+tnte%
    IF nlen%>17
      IF nlen%=32
        kount%(i%)=l%
        vclen%(i%)=l%
        l%=0
        i%=i%+1
      ENDIF
      IF nlen%=33
        next_key_sig%=tnte%
        @new_key_signature
      ENDIF
      IF nlen%=34
        beats_per_bar%=tnte%
        @display_number_of_beats
      ENDIF
      IF nlen%=35 THEN
        beat_size%=tnte%
        @display_beat_size
      ENDIF
      IF nlen%=36
        speed%=tnte%
        @display_tempo
      ENDIF
      IF nlen%=37
        volum(0)=tnte% MOD 16
        decay(0)=(tnte% DIV 16)/25
        @make_tone_envelope(0,volum(0),decay(0))
      ENDIF
      IF nlen%=38
        volum(1)=tnte% MOD 16
        decay(1)=(tnte% DIV 16)/25
        @make_tone_envelope(1,volum(1),decay(1))
      ENDIF
      IF nlen%=39
        volum(2)=tnte% MOD 16
        decay(2)=(tnte% DIV 16)/25
        @make_tone_envelope(2,volum(2),decay(2))
      ENDIF
    ELSE
      l%=l%+1
      tnote&(i%,l%)=nc%
    ENDIF
  NEXT k%
  CLOSE #1
  LOCATE 51,3
  PRINT k%;" notes read"
  vclen%(voic1%)=kount%(voic1%)
ELSE
  LOCATE 60,3
  PRINT "cannot read file"
ENDIF
read_tune_return:
RETURN
> PROCEDURE append_tune_file
DEFFILL 0
PBOX 400,0,639,30
DEFFILL 1
LOCATE 51,2
'  PRINT "Append file :";
'  @tune_file_selector
FILESELECT #"append file","*.tun","noname.tun",tun$
@resync_voices
IF EXIST(tun$)=-1
  OPEN "i",#1,tun$
  i%=0
  l%=vclen%(i%)
  FOR k%=1 TO LOF(#1)/2
    s$=INPUT$(1,#1)
    nlen%=ASC(s$)
    s$=INPUT$(1,#1)
    tnte%=ASC(s$)
    nc%=nlen%*256+tnte%
    IF nlen%>17
      IF nlen%=32
        kount%(i%)=l%
        vclen%(i%)=l%
        i%=i%+1
        IF i%<3
          l%=vclen%(i%)
        ENDIF
      ENDIF
    ELSE
      l%=l%+1
      tnote&(i%,l%)=nc%
    ENDIF
  NEXT k%
  CLOSE #1
  LOCATE 51,3
  PRINT k%;" notes read"
  vclen%(voic1%)=kount%(voic1%)
ELSE
  LOCATE 60,3
  PRINT "cannot read file"
ENDIF
RETURN
> PROCEDURE assert_tun_extension
k%=LEN(tun$)
IF k%>12
  tun$=LEFT$(tun$,12)
ENDIF
k%=INSTR(tun$,".")
IF (k%>0)
  tun$=LEFT$(tun$,k%-1)
ENDIF
tun$=tun$+".TUN"
RETURN
> PROCEDURE delete_note
ptlen%=tlen%
IF kount%(voic1%)<vclen%(voic1%)
  IF tlen%<13
    elapsed_microbeats%(voic1%)=elapsed_microbeats%(voic1%)-notes_to_microbeats%(tlen%)
  ENDIF
  FOR l%=kount%(voic1%) TO vclen%(voic1%)
    tnote&(voic1%,l%)=tnote&(voic1%,l%+1)
  NEXT l%
  vclen%(voic1%)=vclen%(voic1%)-1
  nte%=tnote&(voic1%,kount%(voic1%)) MOD 256
  tlen%=tnote&(voic1%,kount%(voic1%)) DIV 256
  IF tlen%<13
    elapsed_microbeats%(voic1%)=elapsed_microbeats%(voic1%)+notes_to_microbeats%(tlen%)
  ENDIF
  next_bar_line%=(elapsed_microbeats%(voic1%) DIV bar_length%+1)*bar_length%
  @update_editor_windows
  tlen%=ptlen%
  @switch_note_duration
  GOTO delete_note_return
ELSE
  ' deleting last note
  IF kount%(voic1%)<1
    GOTO delete_note_return
  ENDIF
  IF vclen%(voic1%)<1
    GOTO delete_note_return
  ENDIF
  tlen%=SHR(tnote&(voic1%,kount%(voic1%)),8)
  IF tlen%<13
    elapsed_microbeats%(voic1%)=elapsed_microbeats%(voic1%)-notes_to_microbeats%(tlen%)
  ENDIF
  vclen%(voic1%)=vclen%(voic1%)-1
  kount%(voic1%)=kount%(voic1%)-1
  IF kount%(voic1%)<1
    @update_editor_windows
    GOTO delete_note_return
  ENDIF
  nte%=tnote&(voic1%,kount%(voic1%)) MOD 256
  tlen%=tnote&(voic1%,kount%(voic1%)) DIV 256
  next_bar_line%=(elapsed_microbeats%(voic1%) DIV bar_length%+1)*bar_length%
  @update_editor_windows
  tlen%=ptlen%
  @switch_note_duration
ENDIF
delete_note_return:
@show
RETURN
> PROCEDURE insert_note
ld%=vclen%(voic1%)
lum%=vclen%(voic1%)-kount%(voic1%)
FOR l%=0 TO lum%
  tnote&(voic1%,ld%+1-l%)=tnote&(voic1%,ld%-l%)
NEXT l%
vclen%(voic1%)=vclen%(voic1%)+1
ne%=nte%+tlen%*256
tnote&(voic1%,kount%(voic1%))=ne%
INC kount%(voic1%)
@show
RETURN
> PROCEDURE sound_note
ntelet%=nte% MOD 12
IF ntelet%=12
  ntelet%=12
ENDIF
nteoct%=nte% DIV 12
SOUND 0,10,ntelet%,nteoct%,0
WAVE 7,7,1,5000,10
RETURN
> PROCEDURE show_instructions
LOCAL i%,string$
RESTORE instructions
CLS
LOCATE 1,1
FOR i%=1 TO 22
  READ string$
  PRINT string$
NEXT i%
~INP(2)
CLS
@draw_musedt_screen
instructions:
DATA Left mouse button keys in next note on piano.
DATA Right mouse button alters last note keyed on piano.
DATA The space bar stops the music when playing.
DATA PLAY - plays back everything keyed in.
DATA CUE - plays last few notes keyed in.
DATA SHOW - displays last few notes in active track.
DATA --> shift to next note in current track.
DATA <-- shift to previous note in current track.
DATA DEL - delete current note.
DATA INS - same note into track.
DATA FF - fast forward to any note in the memory
DATA TRK - select track number.
DATA SPEED - select tempo of music.
DATA KEY - select key signature.
DATA TIME - set time signature.
DATA RESET - clears everything
DATA CLEAR - clears selected track.
DATA SAVE - save work on disk producing a *.TUN file.
DATA LOAD - load a *.TUN file into memory.
DATA APND - append a *.TUN file to the music already in memory
DATA The musedt.hlp file has more detailed instructions
DATA ..........hit any key to continue
RETURN
> PROCEDURE fast_forward
LOCAL lastpos%,nextpos%
DEFFILL 0
PBOX 400,0,639,30
DEFFILL 1
BOX 399,10,631,20
TEXT 400,28,"start"
TEXT 600,28,"end"
HIDEM
DEFFILL 1
SETMOUSE kount%(voic1%)/vclen%(voic1%)*230+400,22
DO UNTIL MOUSEK<>0
  IF MOUSEX<401
    SETMOUSE 401,22
  ENDIF
  IF MOUSEX>629
    SETMOUSE 629,22
  ENDIF
  lastpos%=kount%(voic1%)/vclen%(voic1%)*230+400
  nextpos%=MOUSEX
  LOCATE 70,1
  PRINT "    "
  LOCATE 70,1
  PRINT kount%(voic1%)
  IF lastpos%<>nextpos%
    COLOR 0
    LINE lastpos%,11,lastpos%,19
    COLOR 1
    IF nextpos%>629
      nextpos%=629
    ENDIF
    IF nextpos%<401
      nextpos%=401
    ENDIF
    kount%(voic1%)=(nextpos%-400)/230*vclen%(voic1%)
    nextpos%=kount%(voic1%)/vclen%(voic1%)*230+400
    LINE nextpos%,11,nextpos%,19
  ENDIF
  PAUSE 5
LOOP
LOCATE 78,1
PRINT vclen%(voic1%);
DEFFILL 0
PBOX 396,0,639,30
DEFFILL 1
RETURN