REM >!Maestro.!RunImage
REM Copyright 2012 Castle Technology Ltd
REM
REM Licensed under the Apache License, Version 2.0 (the "License");
REM you may not use this file except in compliance with the License.
REM You may obtain a copy of the License at
REM
REM http://www.apache.org/licenses/LICENSE-2.0
REM
REM Unless required by applicable law or agreed to in writing, software
REM distributed under the License is distributed on an "AS IS" BASIS,
REM WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
REM See the License for the specific language governing permissions and
REM limitations under the License.
REM
REM (c) Acorn Computers 1988
Task_h%=0
REM TRACE TO "serial:"
DIM message_buffer% 256, err_block% 204
Messages_h% = FNopen_messagefile("<Maestro$Dir>.Messages")
maestro$ = FNmessage_lookup(Messages_h%, "Maestro")
ON ERROR PROCerror:END
INITIALISED%=FNinitialise
OSCLI ("Set Maestro$Running Yes")
ON ERROR PROCerror
REM get any filename passed as an argument
SYS "OS_GetEnv" TO EnvStr$
IF INSTR(EnvStr$," -quit ") THEN
I%=INSTR(EnvStr$,"""")
I%=INSTR(EnvStr$,"""",I%+1)
REPEATI%+=1:UNTILMID$(EnvStr$,I%,1)<>" "
f$=MID$(EnvStr$,I%)
IF f$ <> "" THEN
IF FNvalid_number_of_gates (f$) THEN
PROCload_music(f$)
ELSE
ret_code% = FNCheckOK (FNmessage_lookupN(Messages_h%, "TooBig", f$, "", "", ""), 1)
ENDIF
ENDIF
ENDIF
REPEAT
IF PLAYING% THEN PROCCheckQ
SYS "Wimp_Poll",(NOT(PLAYING% OR SCORING% OR AwaitingAck% OR SCROLLING%) AND 1),Block% TO reason%
REM Recheck since poll might have stayed away for a while
IF PLAYING% THEN PROCCheckQ
CASE reason% OF
WHEN 0:REM Null Event
IF AwaitingAck% THEN
IF FNCheckOKTag("BadData",3) THEN
AwaitingAck%=FALSE
CHANGED%=wasCHANGED%
ENDIF
ENDIF
IF SCORING% THEN PROCsymbol_pointer
IF SCROLLING% THEN PROCCheckScroll
WHEN 1:REM Redraw Window
PROCredraw_window_request
WHEN 2:REM Open Window
PROCOpenWindow(Block%)
WHEN 3:REM Close Window
PROCCloseWindow(Block%!0)
WHEN 4:REM Pointer Leaving Window
IF Block%!0=ScoreWind_h% THEN
PROCrelease
wasSCORING%=SCORING%
SCORING%=FALSE
ENDIF
WHEN 5:REM Pointer Entering Window
IF Block%!0=ScoreWind_h% THEN
SCORING%=(wasSCORING% AND NOT stopSCORING%)=TRUE
ENDIF
WHEN 6:REM Mouse Click
PROCmouse_button_click(Block%!12,Block%!16,Block%!8,Block%!0,Block%!4)
WHEN 7:REM User Drag Box
PROCUserDragBox
WHEN 8:REM Key Pressed
PROCKeyPressed(Block%!0,Block%!24)
WHEN 9:REM Menu Selection
PROCMenuSelect(Block%!0,Block%!4,Block%!8)
WHEN 10:REM Scroll Request
PROCScrollReq(Block%!32,Block%!36)
WHEN 17,18:REM User Message
PROCreceive
ENDCASE
UNTIL FALSE
END
DEF PROCCheckQ
B1%=B2%: B2%=BEAT
IFB2%<B1% PROCplay_bar
ENDPROC
DEF PROCreceive
LOCAL task%,ref%
LOCAL f$,wx%,wy%
task%=Block%!4
ref%=Block%!8
REM Ignore messages from this task
IF task%=Task_h% THEN ENDPROC
REM Process Messages
CASE Block%!16 OF
WHEN 0:REM Quit
PROCterminate
WHEN 1:REM DataSave
IF NOT SAVING% THEN
doing_scrap_load%=TRUE
Block%!0=64
Block%!12=ref%
Block%!16=2 :REM DataSaveAck
Block%!36=-1 :REM Unsafe data
Block%!40=&AF1 :REM Filetype
$(Block%+44)="<Wimp$Scrap>" :REM Path
?(Block%+44+13)=0
SYS "Wimp_SendMessage",17,Block%,task%
ENDIF
WHEN 8:REM PreQuit
IF CHANGED% THEN
IF (Block%!20 AND %1)=0 THEN
shutdown%=TRUE :REM Flag for restarting quit
ELSE
shutdown%=FALSE
ENDIF
REM Acknowledge PreQuit message
Block%!0=20
Block%!12=ref%
Block%!16=0
quit_sender%=task%
SYS "Wimp_SendMessage",19,Block%,task%
PROCOpenDiscardCancelBox
ELSE
PROCterminate
ENDIF
WHEN 2:REM DataSaveAck
IF SAVING% THEN
wasCHANGED%=CHANGED%
PROCsave_music(FNGetStr(Block%+44))
SAVING%=FALSE
REM Send DataLoad message
Block%!0=256
Block%!12=my_ref%
Block%!16=3 :REM DataLoad
Block%!36=-1 :REM Unsafe data
SYS "Wimp_SendMessage",17,Block%,task%
AwaitingAck%=TRUE
SYS "Wimp_CreateMenu",,-1
ENDIF
WHEN 3:REM DataLoad
REM Check filetype
f$=FNGetStr(Block%+44)
IF FNvalid_file_type(f$) THEN
PROCDataLoadAck(f$,ref%,task%)
ELSE
ret_code%=FNCheckOK(FNmessage_lookupN(Messages_h%,"NotMusic",f$,"","",""),1)
ENDIF
WHEN 4:REM DataLoadAck
AwaitingAck%=FALSE
WHEN 5:REM DataOpen
f$=FNGetStr(Block%+44)
IF Block%!40=MusicFileType% THEN PROCDataLoadAck(f$,ref%,task%)
WHEN 10:REM SaveDesktop
desktop_save_handle%=Block%!20
SYS "OS_ReadVarVal","Maestro$Dir",Block%,256,0,0 TO ,,len%
Block%?len%=13
BPUT #desktop_save_handle%,"Run "+$Block%
WHEN 11:REM DeviceClaim
IF Block%!20=7 THEN
f$=FNmessage_lookup(Messages_h%,"SSIU")
Block%!0=(32+LEN(f$)) AND NOT(3)
Block%!12=0
Block%!16=12 :REM DeviceInUse
$(Block%+28)=f$+CHR$(0) :REM Text
SYS "Wimp_SendMessage",17,Block%,Block%!4
ENDIF
WHEN &502:REM HelpRequest
PROCHelp(Block%!32,Block%!36,ref%,task%)
WHEN &400C0:REM Menu Warning
wx%=Block%!24
wy%=Block%!28
CASE Block%!20 OF
WHEN Bar_h%:
PROCgoto_init
SYS "Wimp_CreateSubMenu",,Bar_h%,wx%,wy%
WHEN Print_h%:
PROCprint_init
SYS "Wimp_CreateSubMenu",,Print_h%,wx%,wy%
ENDCASE
WHEN &400C1:REM ModeChange
PROCgetmodeinfo(FALSE)
ENDCASE
ENDPROC
DEF PROCDataLoadAck (f$,ref%,task%)
IF FNvalid_number_of_gates(f$) THEN
IF CHANGED% THEN
load_pending%=TRUE
pending_filename$=f$
PROCOpenDiscardCancelBox
ELSE
PROCload_music(f$)
ENDIF
REM Acknowledge message
Block%!0=256
Block%!12=ref%
Block%!16=4 :REM DataLoadAck
SYS "Wimp_SendMessage",17,Block%,task%
IF doing_scrap_load% THEN doing_scrap_load%=FALSE
ELSE
ret_code%=FNCheckOK(FNmessage_lookupN(Messages_h%,"TooBig",f$,"","",""),1)
ENDIF
ENDPROC
DEF FNvalid_number_of_gates (filename$)
LOCAL fhandle%,M$,loop%,ret%,gates%, bomb%
ret%=TRUE
M$=""
bomb%=FALSE
REM SYS "OS_Find", 79, filename$ TO fhandle%
fhandle% = OPENIN (filename$)
FOR loop% = 1 TO 8
IF NOT EOF#fhandle% THEN M$ += CHR$(BGET#fhandle%) ELSE CLOSE#fhandle%:=TRUE : REM This is an invalid file, load_music picks it up
NEXT loop%
IF M$ = "Maestro"+CHR$(10) THEN
IF BGET#fhandle% = 2 THEN
REPEAT
CASE BGET#fhandle% OF
WHEN 1
INPUT#fhandle%, gates%
IF gates% > Max_Gate% THEN
ret% = FALSE
ENDIF
bomb%=TRUE : REM Stop here, we've got what we want
WHEN 2
FOR loop%=1 TO 3
INPUT#fhandle%,gates%
NEXT loop%
WHEN 3
FOR loop%=1 TO 17
INPUT#fhandle%,gates%
NEXT loop%
WHEN 4, 5
FOR loop%=1 TO 9
INPUT#fhandle%,gates%
NEXT loop%
WHEN 6
FOR loop%=1 TO 2
INPUT#fhandle%,gates%
NEXT loop%
WHEN 7
INPUT#fhandle%, M$
WHEN 8
FOR loop%=1 TO 8
INPUT#fhandle%,M$
NEXT loop%
WHEN 9
FOR loop%=1 TO 8
INPUT#fhandle%,gates%
NEXT loop%
OTHERWISE : REM !!
ENDCASE
UNTIL bomb% OR EOF#fhandle%
ENDIF
ENDIF
CLOSE#fhandle%
=ret%
DEF FNvalid_file_type (filename$)
LOCAL laddr%, type%, ret_code%
IF filename$ <> "" THEN
SYS"OS_File",5,filename$ TO type%,,laddr%
ENDIF
CASE type% OF
WHEN 1
IF ((laddr%>>20)AND&FFF)=&FFF THEN
IF (laddr%>>8 AND &FFF) = MusicFileType% THEN
=TRUE
ELSE
=FALSE
ENDIF
ENDIF
WHEN 2
=FALSE
ENDCASE
=FALSE
DEF PROCHelp (window%,icon%,ref%,task%)
LOCAL text$
CASE window% OF
WHEN -2:
text$=FNmessage_lookup(Messages_h%,"IconHelp")
WHEN ScoreWind_h%:
IF SCORING% AND SCRIBE%(drawn%) THEN
text$=FNmessage_lookup(Messages_h%,"ScoreHelp0")
ELSE
text$=FNmessage_lookup(Messages_h%,"ScoreHelp1")
ENDIF
WHEN NotesPane_h%:
IF icon%>0 AND icon%<17 THEN
text$=FNmessage_lookup(Messages_h%,"NH"+STR$icon%)
text$=FNmessage_lookupN(Messages_h%,"SelectObject",text$,"","","")
ENDIF
WHEN SharpsPane_h%:
CASE icon% OF
WHEN 2,3,4,5,6,7,8,9,10,11,12,17,19,23:
text$=FNmessage_lookup(Messages_h%,"AH"+STR$icon%)
text$=FNmessage_lookupN(Messages_h%,"SelectObject",text$,"","","")
WHEN 14,16,18,20:
text$=FNmessage_lookup(Messages_h%,"AH"+STR$icon%)
WHEN 13:REM Barlines
text$=FNmessage_lookup(Messages_h%,"B"+STR$(BarlineType%))
text$=FNmessage_lookupN(Messages_h%,"SelectObject",text$,"","","")
WHEN 15:REM Clefs
text$=FNmessage_lookup(Messages_h%,"C"+STR$(ClefType%))
text$=FNmessage_lookupN(Messages_h%,"SelectObject",text$,"","","")
ENDCASE
WHEN InstrWind_h%:
CASE icon% OF
WHEN 20,21,22,23,24,25,26,27:REM Instruments popup
text$=FNmessage_lookup(Messages_h%,"IH0")
WHEN 36,37,38,39,40,41,42,43:REM Volumes (down)
text$=FNmessage_lookup(Messages_h%,"IH1")
WHEN 44,45,46,47,48,49,50,51:REM Stereos
text$=FNmessage_lookup(Messages_h%,"IH2")
WHEN 62,63,64:text$=FNmessage_lookup(Messages_h%,"IH"+STR$icon%)
OTHERWISE:text$=FNmessage_lookup(Messages_h%,"IH")
ENDCASE
WHEN StaveWind_h%:
CASE icon% OF
WHEN 2,3,4,5:text$=FNmessage_lookup(Messages_h%,"SH1")
WHEN 6,7,8:text$=FNmessage_lookup(Messages_h%,"SH"+STR$icon%)
OTHERWISE:text$=FNmessage_lookup(Messages_h%,"SH")
ENDCASE
WHEN Save_h%:
CASE icon% OF
WHEN 0,1,2:text$=FNmessage_lookup(Messages_h%,"SVH"+STR$icon%)
OTHERWISE:text$=FNmessage_lookup(Messages_h%,"SVH")
ENDCASE
WHEN QuitQuery_h%:
CASE icon% OF
WHEN 0,2:text$=FNmessage_lookup(Messages_h%,"QH"+STR$icon%)
OTHERWISE:text$=FNmessage_lookup(Messages_h%,"QH")
ENDCASE
WHEN ClearQuery_h%:
CASE icon% OF
WHEN 0,2,3:text$=FNmessage_lookup(Messages_h%,"CH"+STR$icon%)
OTHERWISE:text$=FNmessage_lookup(Messages_h%,"CH")
ENDCASE
WHEN Print_h%:
CASE icon% OF
WHEN 1,2:text$=FNmessage_lookup(Messages_h%,"PH"+STR$icon%)
OTHERWISE:text$=FNmessage_lookup(Messages_h%,"PH")
ENDCASE
WHEN TimeSig_h%:
CASE icon% OF
WHEN 2,3,4,5,6:text$=FNmessage_lookup(Messages_h%,"TS"+STR$icon%)
OTHERWISE:text$=FNmessage_lookup(Messages_h%,"TS")
ENDCASE
OTHERWISE:
SYS "Wimp_GetMenuState",1,Block%,window%,icon%
CASE CurrentMenu% OF
WHEN MainMenu%:
IF Block%!0>-1 THEN
text$=STR$(Block%!0)
IF Block%!4>-1 THEN
text$=text$+"."+STR$(Block%!4)
IF Block%!8>-1 THEN text$=text$+".0"
ENDIF
ENDIF
IF text$<>"" THEN text$=FNmessage_lookup(Messages_h%,"MH"+text$)
WHEN IconMenu%:
IF Block%!0>-1 THEN
text$=FNmessage_lookup(Messages_h%,"ICH"+STR$(Block%!0))
ENDIF
OTHERWISE:text$=""
ENDCASE
ENDCASE
REM If HelpText found, send HelpReply message
IF text$<>"" THEN
Block%!0=(((20+LEN(text$)+1) DIV 4)*4)+4
Block%!12=ref%
Block%!16=&503
$(Block%+20)=text$+CHR$(0)
SYS "Wimp_SendMessage",17,Block%,task%
ENDIF
ENDPROC
DEF PROCredraw_window_request
LOCAL R%
SYS "Wimp_RedrawWindow",,Window%+handle% TO R%
WHILE R%
IF Window%!handle% = ScoreWind_h% PROCdraw_staves:IF PLAYING% PROCCheckQ
REM try to avoid interruptions in the music
SYS "Wimp_GetRectangle",,Window%+handle% TO R%
ENDWHILE
ENDPROC
DEF PROCmouse_button_click (window%,icon%,button%,mx%,my%)
IF (window%<>QuitQuery_h%) AND shutdown% THEN shutdown%=FALSE
IF button%=2 THEN
PROCStopScoring
IF window%=-2 THEN
SYS "Wimp_CreateMenu",,IconMenu%,mx%-64,96+44*3
CurrentMenu%=IconMenu%
ELSE
IF window%=ScoreWind_h% THEN
SYS "Wimp_CreateMenu",,MainMenu%,mx%-64,my%
CurrentMenu%=MainMenu%
ENDIF
ENDIF
ELSE
CASE window% OF
WHEN -2:REM Iconbar click
IF FirstOpen% THEN
PROCscore_init
ELSE
Block%!0=ScoreWind_h%
SYS "Wimp_GetWindowState",,Block%
Block%!28=-1
PROCOpenWindow(Block%)
ScoreClosed%=FALSE
IF PLAYING% THEN PROCCheckScroll
ENDIF
WHEN QuitQuery_h%:
REM This window is used in a couple of circumstances:
REM 1. when we want to quit
REM 2. when we're about to overwrite a bit of music with a new piece
IF icon%=2 THEN
IF load_pending% THEN
PROCload_music(pending_filename$)
ELSE
IF shutdown% THEN
SYS "Wimp_GetCaretPosition",,Block%
REM Restart PreQuit, send CTRL-SHIFT-F12
Block%!24=&1FC
SYS "Wimp_SendMessage",8,Block%,quit_sender%
ENDIF
PROCterminate
ENDIF
SYS "Wimp_CreateMenu",,-1
ELSE
REM We've decided not to quit
IF shutdown% THEN shutdown%=FALSE
REM Cancel any impending load
IF load_pending% THEN load_pending%=FALSE
SYS "Wimp_CreateMenu",,-1
ENDIF
WHEN ClearQuery_h%:
CASE icon% OF
WHEN 2:REM Discard
PROCClearAllMusic
Block%!0=ScoreWind_h%
SYS "Wimp_GetWindowState",,Block%
Block%!20=0
LHBAR%=0
SYS "Wimp_OpenWindow",,Block%
SYS "Wimp_CreateMenu",,-1
WHEN 0:REM Save
SYS "Wimp_CreateMenu",,Save_h%,mx%,my%
WHEN 3:REM Cancel
SYS "Wimp_CreateMenu",,-1
ENDCASE
WHEN Print_h%:
PROCprint_click(icon%,button%)
WHEN NotesPane_h%,SharpsPane_h%,ScoreWind_h%:
PROCscore_click(window%,icon%,button%)
WHEN InstrWind_h%:
PROCinstruments_click(icon%,mx%,button%)
WHEN StaveWind_h%:
PROCstaves_click(icon%,button%)
WHEN Save_h%:
PROCStopScoring
IF icon%=0 THEN
PROCsave_music(FNwimp_geticontext(Save_h%,1))
PROCCloseWindow(window%)
SYS "Wimp_CreateMenu",,-1
ENDIF
IF icon%=2 THEN
LOCAL x%,y% : REM dragging icon
Window%!handle%=window%
SYS "Wimp_GetWindowState",,Window%+handle%
ysize%=Window%!y1%-Window%!y0%
x%=Window%!x0%
y%=Window%!y0%
!Window%=window%
Window%!4=icon%
SYS "Wimp_GetIconState",,Window% : REM returns icon box in right place for drag box
Window%!8 += x%
Window%!12 += y% + ysize%
Window%!16 += x%
Window%!20 += y% + ysize%
REM get size idan appropriate part of block: parent box=screen boundary
Window%!24 = 0
Window%!28 = 0
Window%!32 = S_Width%
Window%!36 = S_Height%
!Window%=0
Window%!4=5: REM fixed size drag box
SAVING%=TRUE
SYS "OS_Byte", 161, &1C TO ,,icon%
IF icon% AND 2 THEN
SYS "XDragASprite_Start", &C5, 1, "file_af1", Window% + 8
ELSE
SYS "Wimp_DragBox",,Window%
ENDIF
ENDIF
WHEN TimeSig_h%:
PROCtimesig_click(icon%,button%)
WHEN Clef_h%:
CASE icon% OF
WHEN 0:REM Treble clef
PROCwimp_seticonval(SharpsPane_h%,15,"Sstreble")
ClefType%=icon%
WHEN 1:REM Bass clef
PROCwimp_seticonval(SharpsPane_h%,15,"Ssbass")
ClefType%=icon%
ENDCASE
IF FNwimp_geticonstate(SharpsPane_h%,15,2) THEN PROCattach_clef
IF button%=4 THEN PROCCloseWindow(Clef_h%)
WHEN Barline_h%:
CASE icon% OF
WHEN 0:REM Single barline
PROCwimp_seticonval(SharpsPane_h%,13,"Ssbarline")
BarlineType%=icon%
WHEN 1:REM Double barline
PROCwimp_seticonval(SharpsPane_h%,13,"Ssdbar")
BarlineType%=icon%
ENDCASE
IF FNwimp_geticonstate(SharpsPane_h%,13,2) THEN PROCattach_barline
IF button%=4 THEN PROCCloseWindow(Barline_h%)
ENDCASE
ENDIF
ENDPROC
REM // Instruments //
DEF PROCinstruments_init (x%,y%)
LOCAL i%,c%,text$
REM Create Voices menu
PROCCheckInstalledVoices
FOR i%=0 TO NVoices%-1
PROCwimp_setmenutext(VoiceMenu%,i%,LEFT$(Voice$(i%+1),31))
NEXT
VoiceMenu%!(28+(24*(NVoices%-1)))=128
REM Set volume/stereo fields
FOR c%=0 TO 7
text$=FNmessage_lookup(Messages_h%,"V"+STR$(Volumes%(c%)))
PROCwimp_seticontext(InstrWind_h%,c%+28,LEFT$(text$,3))
PROCinstruments_slider(c%+44,Stereo_Position%(c%))
NEXT
PROCinstruments_fill(OutputType%)
PROCwimp_opendialogue(InstrWind_h%,ScoreWind_h%,1)
SYS "Wimp_SetCaretPosition",InstrWind_h%,-1
ENDPROC
DEF PROCinstruments_fill (type%)
LOCAL text$,c%
REM Set voice/MIDI channel fields
text$="OT"+STR$(type%)
PROCwimp_seticontext(InstrWind_h%,61,FNmessage_lookup(Messages_h%,text$))
FOR c%=0 TO 7
CASE type% OF
WHEN 0:REM Internal sound system
text$=LEFT$(Voice$(Instrument%(c%,1)),20)
WHEN 1:REM MIDI device
text$=FNmessage_lookupN(Messages_h%,"MIDIvoice",STR$(MIDIChannel%(c%)),"","","")
ENDCASE
PROCwimp_seticontext(InstrWind_h%,c%+12,text$)
NEXT
REM Set Output Menu options
PROCwimp_setmenustate(OutputMenu%,1,22,NOT MIDIpresent%)
PROCwimp_radiotick(OutputMenu%,type%)
ENDPROC
DEF PROCinstruments_click (icon%,mx%,button%)
LOCAL c%,v%,text$,inc%,wx%,ix%
PROCStopScoring
PROCChangedScore
REM Voices
IF icon%>19 AND icon%<28 THEN
REM Set tick in VoiceMenu/ChannelMenu
PopUpIcon%=icon%-8
CASE FNwimp_getmenustate(OutputMenu%,0,0) OF
WHEN TRUE:REM Internal sound system
text$=FNwimp_geticontext(InstrWind_h%,icon%-8)
FOR i%=0 TO NVoices%-1
IF FNwimp_getmenutext(VoiceMenu%,i%)=text$ THEN
PROCwimp_radiotick(VoiceMenu%,i%)
ENDIF
NEXT
CurrentMenu%=FNwimp_popup(InstrWind_h%,VoiceMenu%,icon%)
WHEN FALSE:REM MIDI
text$=FNwimp_geticontext(InstrWind_h%,icon%-8)
text$=RIGHT$(text$,2)
IF LEFT$(text$,1)=" " THEN text$=RIGHT$(text$,1)
PROCwimp_radiotick(ChannelMenu%,VAL(text$)-1)
CurrentMenu%=FNwimp_popup(InstrWind_h%,ChannelMenu%,icon%)
ENDCASE
ENDIF
REM Volumes
IF icon%>35 AND icon%<44 THEN
REM Set tick in VolumeMenu
v%=FNinstruments_getvol(FNwimp_geticontext(InstrWind_h%,icon%-8))
PROCwimp_radiotick(VolumeMenu%,v%)
PopUpIcon%=icon%-8
CurrentMenu%=FNwimp_popup(InstrWind_h%,VolumeMenu%,icon%)
ENDIF
REM Stereo positions
IF icon%>43 AND icon%<52 THEN
Block%!0=InstrWind_h%
SYS "Wimp_GetWindowState",,Block%
wx%=Block%!4
Block%!4=44
SYS "Wimp_GetIconState",,Block%
ix%=Block%!8
PROCinstruments_slider(icon%,(mx%-wx%-ix%) DIV 24)
ENDIF
REM Output PopUp
IF icon%=62 THEN
CurrentMenu%=FNwimp_popup(InstrWind_h%,OutputMenu%,icon%)
ENDIF
REM Cancel button
IF icon%=63 AND button%=4 THEN PROCwimp_closedialogue(InstrWind_h%,ScoreWind_h%)
REM Set button
IF icon%=64 THEN
FOR c%=0 TO 7
REM Voices/MIDI channels
text$=FNwimp_geticontext(InstrWind_h%,c%+12)
CASE FNwimp_getmenustate(OutputMenu%,0,0) OF
WHEN TRUE:REM Internal sound system
FOR i%=1 TO NVoices%
IF text$=Voice$(i%) THEN v%=i%
NEXT
PROCAttachVoice(c%,v%)
OutputType%=0
WHEN FALSE:REM MIDI device
text$=RIGHT$(text$,2)
IF LEFT$(text$,1)=" " THEN text$=RIGHT$(text$,1)
MIDIChannel%(c%)=VAL(text$)
OutputType%=1
ENDCASE
REM Set Volumes
text$=FNwimp_geticontext(InstrWind_h%,c%+28)
Volumes%(c%)=FNinstruments_getvol(text$)
REM Set Stereo positions
Block%!4=c%+44
SYS "Wimp_GetIconState",,Block%
ix%=Block%!8
Block%!4=c%+52
SYS "Wimp_GetIconState",,Block%
mx%=Block%!8+12
Stereo_Position%(c%)=(mx%-ix%) DIV 24
SYS "Sound_Stereo",c%+1,Stereo%(Stereo_Position%(c%))
NEXT
IF button%=4 THEN PROCwimp_closedialogue(InstrWind_h%,ScoreWind_h%)
ENDIF
ENDPROC
DEF FNinstruments_keypress (key%)
LOCAL used%
used%=TRUE
CASE key% OF
WHEN &1B:REM Escape
PROCinstruments_click(63,0,4)
WHEN &0D:REM Enter
PROCinstruments_click(64,0,4)
WHEN &1A2:REM Ctrl-F2
PROCinstruments_click(63,0,4)
OTHERWISE:used%=FALSE
ENDCASE
=used%
DEF FNinstruments_getvol (s$)
LOCAL i%,v%
FOR i%=0 TO 7
IF s$=FNmessage_lookup(Messages_h%,"V"+STR$(i%)) THEN v%=i%
NEXT
=v%
DEF PROCinstruments_slider (icon%,pos%)
REM We want to work on pre-RISC OS 3.5, so can't use Wimp_ResizeIcon
REM to implement an 8-point slider. Delete and re-create icons instead
LOCAL i%,x0%,x1%,y0%,y1%
Block%!0=InstrWind_h%
Block%!4=icon%
SYS "Wimp_GetIconState",,Block%
x0%=Block%!8
y0%=Block%!12
x1%=Block%!16
y1%=Block%!20
Block%!4=icon%+8
SYS "Wimp_GetIconState",,Block%
SYS "Wimp_DeleteIcon",,Block%
FOR i%=8 TO 40 STEP 4
Block%!i%=Block%!(i%+4)
NEXT
Block%!4=x0%+4+(pos%*22)
Block%!12=x0%+4+(pos%*22)+24
SYS "Wimp_CreateIcon",icon%+8,Block%
SYS "Wimp_ForceRedraw",Block%!0,x0%,y0%,x1%,y1%
ENDPROC
REM // Staves //
DEF PROCstaves_init (x%,y%)
LOCAL i%
FOR i%=2 TO 5
PROCwimp_seticonstate(StaveWind_h%,i%,21,FALSE)
NEXT
PROCwimp_seticonstate(StaveWind_h%,2+STAVE%,21,TRUE)
IF PERC% THEN
PROCwimp_seticonstate(StaveWind_h%,6,21,TRUE)
ELSE
PROCwimp_seticonstate(StaveWind_h%,6,21,FALSE)
ENDIF
PROCwimp_opendialogue(StaveWind_h%,ScoreWind_h%,1)
SYS "Wimp_SetCaretPosition",StaveWind_h%,-1
ENDPROC
DEF PROCstaves_click (icon%,button%)
CASE icon% OF
WHEN 7:REM Cancel
IF button%=4 THEN PROCwimp_closedialogue(StaveWind_h%,ScoreWind_h%)
WHEN 8:REM Set
FOR i%=2 TO 5
IF FNwimp_geticonstate(StaveWind_h%,i%,21) THEN
STAVE%=i%-2
ENDIF
NEXT
IF FNwimp_geticonstate(StaveWind_h%,6,21) THEN
PERC%=1
ELSE
PERC%=0
ENDIF
SYS "Hourglass_On"
PROCposition_staves
PROCSetExtent(S_Width%)
PROCscore_init
PROCSetDefaultChannels
PROCstart_music
PROCset_score(0)
PROCSetupBarStarts(0)
SYS "Hourglass_Off"
PROCChangedScore
IF button%=4 THEN PROCwimp_closedialogue(StaveWind_h%,ScoreWind_h%)
ENDCASE
ENDPROC
DEF FNstaves_keypress (key%)
LOCAL used%
used%=TRUE
CASE key% OF
WHEN &1B:REM Escape
PROCstaves_click(7,4)
WHEN &0D:REM Enter
PROCstaves_click(8,4)
WHEN &1A2:REM Ctrl-F2
PROCstaves_click(7,4)
OTHERWISE:used%=FALSE
ENDCASE
=used%
REM // TimeSig //
DEF PROCtimesig_init (icon%)
LOCAL n%,b%
n%=TIME_SIG%(0)+1
b%=2^(TIME_SIG%(1)-1)
PROCwimp_seticontext(TimeSig_h%,0,STR$(n%))
PROCwimp_seticontext(TimeSig_h%,1,STR$(b%))
CurrentMenu%=FNwimp_popup(SharpsPane_h%,TimeSig_h%,icon%)
ENDPROC
DEF PROCtimesig_click (icon%,button%)
REM Time signature held in TIME_SIG%() as (n+1) / 2^(d-1)
REM To edit, we have to convert to the following range:
REM n = 2-16; b = 2,4,8,16
LOCAL n%,b%,v%
n%=VAL(FNwimp_geticontext(TimeSig_h%,0))-1
b%=SQR(VAL(FNwimp_geticontext(TimeSig_h%,1))+1)+1
CASE icon% OF
WHEN 2:REM Decrement n
IF button%=4 AND n%>1 THEN
v%=1+(n%+13) MOD 15
PROCwimp_seticontext(TimeSig_h%,0,STR$(v%+1))
ENDIF
IF button%=1 AND n%<15 THEN
v%=1+(n%+15) MOD 15
PROCwimp_seticontext(TimeSig_h%,0,STR$(v%+1))
ENDIF
WHEN 3:REM Increment n
IF button%=4 AND n%<15 THEN
v%=1+(n%+15) MOD 15
PROCwimp_seticontext(TimeSig_h%,0,STR$(v%+1))
ENDIF
IF button%=1 AND n%>1 THEN
v%=1+(n%+13) MOD 15
PROCwimp_seticontext(TimeSig_h%,0,STR$(v%+1))
ENDIF
WHEN 4:REM Decrement b
IF button%=4 AND b%>2 THEN
v%=(b%+1) MOD 4+2
PROCwimp_seticontext(TimeSig_h%,1,STR$(2^(v%-1)))
ENDIF
IF button%=1 AND b%<5 THEN
v%=(b%-1) MOD 4+2
PROCwimp_seticontext(TimeSig_h%,1,STR$(2^(v%-1)))
ENDIF
WHEN 5:REM Increment b
IF button%=4 AND b%<5 THEN
v%=(b%-1) MOD 4+2
PROCwimp_seticontext(TimeSig_h%,1,STR$(2^(v%-1)))
ENDIF
IF button%=1 AND b%>2 THEN
v%=(b%+1) MOD 4+2
PROCwimp_seticontext(TimeSig_h%,1,STR$(2^(v%-1)))
ENDIF
WHEN 6:REM Select a new time sig
PROCSetTimeSig(n%,b%)
IF button%=4 THEN PROCCloseWindow(TimeSig_h%)
ENDCASE
ENDPROC
DEF PROCattach_clef
CASE ClefType% OF
WHEN 0:REM Treble
PROCattach(clef%,%100)
WHEN 1:REM Bass
PROCattach(clef%+3,%100)
ENDCASE
ENDPROC
DEF PROCattach_barline
CASE BarlineType% OF
WHEN 0:REM Single
PROCattach(bar%,%10010000)
WHEN 1:REM Double
PROCattach(bar%+1,%10010000)
ENDCASE
ENDPROC
REM // Tool icons //
DEF PROCtoolicon_click (window%,icon%)
PROCrelease
wasSCORING%=TRUE
stopSCORING%=FALSE
PROCtoolicon_clear
PROCwimp_seticonstate(window%,icon%,2,TRUE)
PROCwimp_seticonstate(window%,icon%,5,TRUE)
SelW%=window%
SelI%=icon%
ENDPROC
DEF PROCtoolicon_clear
IF SelI%>-1 THEN
PROCwimp_seticonstate(SelW%,SelI%,2,FALSE)
PROCwimp_seticonstate(SelW%,SelI%,5,FALSE)
ENDIF
ENDPROC
REM // Voice handling //
DEF PROCCheckInstalledVoices
LOCAL NewVoice$, NewNVoices%, changedVoices%
changedVoices%=FALSE
SYS "Sound_InstallVoice" TO I$,NewNVoices%:NewNVoices% -= 1
IF FNassert(NVoices%>0,"NoVoices") STOP
IF NewNVoices% <> NVoices% THEN
changedVoices% = TRUE
NVoices% = NewNVoices%
ENDIF
IF NVoices%>MAX_VOICES% THEN NVoices%=MAX_VOICES%
FOR R% = 1 TO NVoices%
SYS "Sound_InstallVoice",2,R% TO ,,,NewVoice$
IF NewVoice$<>Voice$(R%) THEN
changedVoices%=TRUE
Voice$(R%)=NewVoice$
ENDIF
NEXT : REM find if instruments have changed
IF changedVoices% THEN
FOR R% = 0 TO 7
SYS "Sound_AttachVoice",R% + 1,0 TO L%,S%
IF S% < 1 OR S% > NVoices% THEN
S%=1:REM Make sure a voice is attached to all channels
ENDIF
SYS "Sound_AttachVoice",L%,S%
Instrument%(R%,0) = S_C%(R%)+1 : REM Instrument stave
Instrument%(R%,1) = S%:REM Instrument voice
NEXT : REM Get details of each channel
PROCSetDefaultChannels
ENDIF
ENDPROC
DEF PROCAttachVoice (c%,slot%)
LOCAL v%
PROCCheckInstalledVoices
REM Find channel's previous voice
SYS "Sound_AttachVoice",c%+1 TO ,v%
REM Attach new voice
IF v%=0 THEN v%=1
IF slot%=0 THEN slot%=v%
SYS "Sound_AttachVoice",c%+1,slot%
Instrument%(c%,1)=slot%
ENDPROC
DEF PROCUserDragBox
LOCAL filename$
filename$=FNwimp_geticontext(Save_h%,1)
IF SAVING% THEN
SYS "Wimp_GetPointerInfo",,Block%
Block%!32=Block%!4
Block%!28=Block%!0
Block%!24=Block%!16
Block%!20=Block%!12 :REM this is the destination window handle
Block%!16=1 :REM DataSave
Block%!12=0
Block%!36=-1 :REM don't know file size / unsafe?
Block%!40=MusicFileType%
$(Block%+44)=FNGetLeafName(filename$)+CHR$(0)
!Block%=64
SYS "Wimp_SendMessage",17,Block%,Block%!20,Block%!24
my_ref%=Block%!8
SYS "DragASprite_Stop"
ENDIF
ENDPROC
DEF PROCMenuSelect (sel1%,sel2%,sel3%)
LOCAL n%,SoundEnable%,mx%,my%,button%,text$,allowadjust%
SYS "Wimp_GetPointerInfo",,Block%
mx%=Block%!0
my%=Block%!4
button%=Block%!8
allowadjust%=TRUE
CASE CurrentMenu% OF
WHEN MainMenu%:
CASE sel1% OF
WHEN 0:REM File menu
CASE sel2% OF
WHEN 1:REM Save file
SYS "Wimp_CreateMenu",,Save_h%,mx%,my%
allowadjust%=FALSE
WHEN 2:REM Print file
PROCprint_init
SYS "Wimp_CreateMenu",,Print_h%,mx%,my%
allowadjust%=FALSE
ENDCASE
WHEN 1:REM Edit menu
CASE sel2% OF
WHEN 0:REM Go to bar
PROCgoto_init
SYS "Wimp_CreateMenu",,Bar_h%,mx%,my%
allowadjust%=FALSE
WHEN 1:REM Clear file
IF CHANGED% THEN
PROCOpenSaveDiscardCancelBox
ELSE
PROCClearAllMusic
Block%!0=ScoreWind_h%
SYS "Wimp_GetWindowState",,Block%
Block%!20=0
LHBAR%=0
SYS "Wimp_OpenWindow",,Block%
ENDIF
allowadjust%=FALSE
ENDCASE
WHEN 2:REM Score menu
CASE sel2% OF
WHEN 0:REM REM Staves
PROCstaves_init(mx%,my%)
allowadjust%=FALSE
WHEN 1:REM Instruments
PROCinstruments_init(mx%,my%)
allowadjust%=FALSE
WHEN 2:REM Volume menu
IF sel3%>=0 THEN
PROCSetVolume(sel3%)
PROCChangedScore
ENDIF
WHEN 3:REM Tempo menu
IF sel3%>=0 THEN
PROCSetTempo(sel3%)
PROCChangedScore
ENDIF
ENDCASE
WHEN 3:REM Play
SYS "Sound_Enable",0 TO SoundEnable%:REM dont pretend to be able to play if the sound system is disabled
IF SoundEnable%=2 THEN
SCORING%=FALSE
PLAYING%=NOT PLAYING%
SCROLLING%=PLAYING%
IF PLAYING% THEN PROCplay_start ELSE PROCplay_stop
ELSE
n%=FNCheckOKTag("NoSound",1)
ENDIF
ENDCASE
WHEN IconMenu%:
CASE sel1% OF
WHEN 1:REM Help
OSCLI("Filer_Run <Maestro$Dir>.!Help")
WHEN 2:REM Quit
IF CHANGED% THEN PROCOpenDiscardCancelBox ELSE PROCterminate
ENDCASE
WHEN KeyMenu%:
REM Key signature
PROCSetKeySig(sel1%,sel2%)
WHEN VoiceMenu%:
text$=Voice$(sel1%+1)
PROCwimp_seticontext(InstrWind_h%,PopUpIcon%,text$)
PROCwimp_radiotick(VoiceMenu%,sel1%)
WHEN ChannelMenu%:
text$=FNmessage_lookupN(Messages_h%,"MIDIvoice",STR$(sel1%+1),"","","")
PROCwimp_seticontext(InstrWind_h%,PopUpIcon%,text$)
PROCwimp_radiotick(ChannelMenu%,sel1%)
WHEN VolumeMenu%:
REM This is when open over the Instruments dialogue as a pop-up
text$=FNmessage_lookup(Messages_h%,"V"+STR$(sel1%))
PROCwimp_seticontext(InstrWind_h%,PopUpIcon%,text$)
PROCwimp_radiotick(VolumeMenu%,sel1%)
WHEN OutputMenu%:
IF FNwimp_getmenustate(OutputMenu%,sel1%,0)=FALSE THEN
PROCinstruments_fill(sel1%)
ENDIF
ENDCASE
IF allowadjust% AND button%=1 THEN SYS "Wimp_CreateMenu",,CurrentMenu%
ENDPROC
DEF PROCKeyPressed (window%,key%)
LOCAL used%
used%=TRUE
CASE window% OF
WHEN Save_h%:
CASE key% OF
WHEN &0D:REM Enter
PROCsave_music(FNwimp_geticontext(Save_h%,1))
PROCCloseWindow(window%)
SYS "Wimp_CreateMenu",,-1
OTHERWISE:used%=FALSE
ENDCASE
WHEN Bar_h%:
used%=FNgoto_keypress(key%)
WHEN StaveWind_h%:
used%=FNstaves_keypress(key%)
WHEN ScoreWind_h%:
used%=FNscore_keypress(key%)
WHEN InstrWind_h%:
used%=FNinstruments_keypress(key%)
OTHERWISE:used%=FALSE
ENDCASE
IF used%=FALSE THEN SYS "Wimp_ProcessKey",key%
ENDPROC
DEF PROCScrollReq(x_scroll%, y_scroll%)
IF Window%!handle%=ScoreWind_h% THEN
IF PLAYING%AND(x_scroll%<>0) ENDPROC
CASE ABS(x_scroll%) OF
WHEN 1:Window%!scx%+=x_scroll%*4*Pgap%
WHEN 2:Window%!scx%+=(x_scroll%/2)*(Window%!x1%-Window%!x0%)
ENDCASE
CASE ABS(y_scroll%) OF
WHEN 1:Window%!scy%+=y_scroll%*C_Height%
WHEN 2:Window%!scy%+=(y_scroll%/2)*(Window%!y1%-Window%!y0%)
ENDCASE
SYS "Wimp_OpenWindow",,Window%+handle%
ScoreClosed%=FALSE
LHBAR%=FNFindBar(Window%!scx%) :REM the bar number at the left of the window
ENDIF
ENDPROC
DEF PROCOpenWindow (b%)
LOCAL x0%,x1%,y0%,y1%,behind%,ox%
IF b%!0=ScoreWind_h% THEN
IF PLAYING% THEN b%!20=OldX%
SYS "Wimp_OpenWindow",,b%
SYS "Wimp_GetWindowState",,b%
x0%=b%!4
y0%=b%!8
x1%=b%!12
y1%=b%!16
ox%=b%!20
behind%=b%!28
REM Open Sharps Pane
Block%!0=SharpsPane_h%
Block%!4=x0%
Block%!8=y0%
Block%!12=x1%
Block%!16=y0%+PaneHeight%
Block%!20=0
Block%!24=0
Block%!28=behind%
SYS "Wimp_OpenWindow",,Block%
REM Open Notes Pane
Block%!0=NotesPane_h%
Block%!4=x0%
Block%!8=y1%-PaneHeight%
Block%!12=x1%
Block%!16=y1%
Block%!20=0
Block%!24=0
Block%!28=SharpsPane_h%
SYS "Wimp_OpenWindow",,Block%
IF PLAYING% THEN PROCCheckScroll
PROCrelease
LHBAR%=FNFindBar(ox%)
ELSE
SYS "Wimp_OpenWindow",,b%
ENDIF
ENDPROC
DEF PROCUpdateTitle (title$)
LOCAL top%
Block%!0=ScoreWind_h%
SYS "Wimp_GetWindowInfo",,Block% OR 1
$(Block%!76)=title$+CHR$(0)
SYS "Wimp_GetWindowState",,Block%
top%=Block%!16
SYS "Wimp_GetWindowOutline",,Block%
SYS "Wimp_ForceRedraw",-1,Block%!4,top%,Block%!12,Block%!16
ENDPROC
DEF PROCCloseWindow (handle%)
Block%!0=handle%
SYS "Wimp_CloseWindow",,Block%
IF handle%=ScoreWind_h% THEN
Block%!0=NotesPane_h%
SYS "Wimp_CloseWindow",,Block%
Block%!0=SharpsPane_h%
SYS "Wimp_CloseWindow",,Block%
ScoreClosed%=TRUE
ENDIF
ENDPROC
DEF PROCsymbol_pointer
SYS "Wimp_GetPointerInfo",,Block%
IF Block%!12=ScoreWind_h% THEN PROCscribe(Block%!0,Block%!4)
ENDPROC
DEF PROCStopScoring
stopSCORING%=TRUE
PROCrelease
PROCtoolicon_clear
ENDPROC
DEF PROCChangedScore
IF NOT CHANGED% THEN
CHANGED%=TRUE
PROCwimp_seticontext(FileInfo_h%,2,FNmessage_lookup(Messages_h%,"Yes"))
PROCUpdateTitle(FileName$+" *")
ENDIF
ENDPROC
DEF PROCSetExtent (width%)
Score_Width%=width%
Block%!0=0
Block%!4=-Score_Height%-PaneHeight%
Block%!8=Score_Width%
Block%!12=PaneHeight%
SYS "Wimp_SetExtent",ScoreWind_h%,Block%
ENDPROC
DEF FNGetLeafName(name$)
LOCAL ch$,n%
IF ( (INSTR(name$,".")=0) AND (INSTR(name$,":")=0) ) THEN=name$
n%=LEN(name$)
REM scan string to find leaf name of file
REPEAT
ch$= MID$(name$, n%, 1)
n%-=1
UNTIL (n%<=0 OR ch$="." OR ch$=":")
IF n%>0 THEN
=RIGHT$(name$, LEN(name$)-n%-1)
ELSE
= name$
ENDIF
= ""
DEF FNGetStr(s%) : REM get string
LOCAL n$
WHILE?s%:n$+=CHR$?s%:s%+=1:ENDWHILE
=n$
DEF PROCSetDefaultChannels
LOCAL s%,text$
REM Only 1 percussion channel permitted
REM Channel assignment changes if staves change
FOR s%=0 TO 7
S_C%(s%)=Stave_Channels%(STAVE%,s%)
NEXT
REM Steal channel for percussion lines
IF PERC% THEN S_C%(7)=STAVE%+1
REM Instrument allocation
FOR s%=0 TO 7
Instrument%(s%,0)=S_C%(s%)+1
REM Set up stave names in instrument window
text$="S"+STR$(Instrument%(s%,0)+(STAVE%-3)*((Instrument%(s%,0)-1)>STAVE%))
PROCwimp_seticontext(InstrWind_h%,s%+4,FNmessage_lookup(Messages_h%,text$))
PROCAttachVoice(s%,0)
NEXT
REM Steal 1 channel for percussion
IF PERC% THEN
text$=FNmessage_lookup(Messages_h%,"S5")
PROCwimp_seticontext(InstrWind_h%,11,text$)
ENDIF
ENDPROC
DEF FNGetFileInfo (file$)
LOCAL type%,laddr%,eaddr%,len%,attr%
IF file$<>"" AND file$<>FNmessage_lookup(Messages_h%,"Untitled") THEN
SYS "OS_File",5,file$ TO type%,,laddr%,eaddr%,len%,attr%
ENDIF
IF file$="" OR file$=FNmessage_lookup(Messages_h%,"Untitled") OR ((type%=1) AND (attr% AND 1) AND (len%>8))=0 THEN
PROCwimp_seticontext(FileInfo_h%,1,FNmessage_lookup(Messages_h%,"Untitled"))
PROCset_type_string(MusicFileType%)
PROCwimp_seticontext(FileInfo_h%,4,"")
?ftime%=3
SYS "OS_Word",14,ftime%
SYS "Territory_ConvertStandardDateAndTime",-1,ftime%,Block%,255
PROCwimp_seticontext(FileInfo_h%,5,FNGetStr(Block%))
=FALSE
ELSE
PROCwimp_seticontext(FileInfo_h%,1,file$)
PROCwimp_seticontext(FileInfo_h%,4,STR$(len%))
IF ((laddr%>>20) AND &FFF)=&FFF THEN
IF (laddr%>>8 AND &FFF)=MusicFileType% THEN
PROCset_type_string(MusicFileType%)
ELSE
PROCset_type_string(laddr%>>8 AND &FFF)
ENDIF
ftime%?4=laddr% AND &FF
ftime%?3=eaddr%>>24 AND &FF
ftime%?2=eaddr%>>16 AND &FF
ftime%?1=eaddr%>>8 AND &FF
ftime%?0=eaddr% AND &FF
SYS "OS_ConvertStandardDateAndTime",ftime%,Block%,255
PROCwimp_seticontext(FileInfo_h%,5,FNGetStr(Block%))
ENDIF
ENDIF
=TRUE
DEF PROCset_type_string (type%)
LOCAL s$,r2%,r3%,space$
s$=""
SYS "OS_FSControl",18,,type% TO ,,r2%,r3%
s$=CHR$(r2% AND &FF)+CHR$((r2%>>8) AND &FF)
s$+=CHR$((r2%>>16) AND &FF)+CHR$((r2%>>24) AND &FF)
s$+=CHR$(r3% AND &FF)+CHR$((r3%>>8) AND &FF)
s$+=CHR$((r3%>>16) AND &FF)+CHR$((r3%>>24) AND &FF)
space$=STRING$(8-LEN(s$)," ")
PROCwimp_seticontext(FileInfo_h%,3,s$+space$+"("+STR$~type%+")")
ENDPROC
DEF PROCload_music(FF$)
LOCAL F%,M$,ZZ%
LOCAL ERROR
T%=0
SCORING%=FALSE
IF PLAYING% PROCplay_stop
SCROLLING%=FALSE
IF LENFF$=0 THEN VDU7 : T%=FNCheckOKTag("BadName",1) : ENDPROC
SYS "Hourglass_On"
FILE%=OPENINFF$
REM SYS "OS_Find", 79, FF$ TO FILE%
ON ERROR LOCAL VDU7:OSCLI("FX 229,1"):PROCClearAllMusic:SYS "Hourglass_Off":T%=FNCheckOK(FNmessage_lookupN(Messages_h%, "IntErr", REPORT$, STR$(ERL), "", ""),1):ENDPROC
M$=""
FORR%=1TO7
IF NOT EOF#FILE% THEN M$+=CHR$BGET#FILE% ELSE SYS "Hourglass_Off":T%=FNCheckOK(FNmessage_lookup(Messages_h%,"BadFile"),1): ENDPROC
NEXT
OSCLI("FX 229,0") :REM enable escape key
B%=BGET#FILE%
IFM$="Maestro" THEN
IF NOT FNGetFileInfo(FF$) THEN VDU7 :OSCLI("FX 229,1") : SYS "Hourglass_Off" :T%=FNCheckOKTag("BadFile",1) : ENDPROC
T%=TRUE
NBars%=0
CASE BGET#FILE% OF
WHEN 0:T%=FALSE
WHEN 1
PROClTempo:PROClInstruments:PROClStaves
T%=FNlMusic
IF T%=FALSE THEN
SYS "Hourglass_Off"
ZZ%=FNCheckOKTag("OutMem2",1)
PROCClearAllMusic
LHBAR%=0
CLOSE#FILE%
ENDPROC
ENDIF
OTHERWISE REM File id version 2 and above
A%=FALSE
REPEAT
REM Used to be an ON BGET#FILE% statement,
REM changed to allow exiting if music is too big.
CASE BGET#FILE% OF
WHEN 1:T%=FNlMusic
IF T%=FALSE THEN
SYS "Hourglass_Off"
ZZ%=FNCheckOKTag("OutMem2",1)
PROCClearAllMusic
LHBAR%=0
CLOSE#FILE%
ENDPROC
ENDIF
WHEN 2:PROClStaves
WHEN 3:PROClInstruments
WHEN 4:PROClVolumes
WHEN 5:PROClStereos
WHEN 6:PROClTempo
OTHERWISE:A%=TRUE
ENDCASE
UNTIL EOF#FILE% OR A%
ENDCASE
CLOSE#FILE%
FILE%=FALSE
OSCLI("FX 229,1")
PROCwimp_seticontext(FileInfo_h%,1,FNmessage_lookup(Messages_h%,FF$))
PROCwimp_seticontext(FileInfo_h%,2,FNmessage_lookup(Messages_h%,"No"))
IF LEFT$(FF$,12)="<Wimp$Scrap>" THEN
FF$=FNmessage_lookup(Messages_h%,"Untitled")
PROCwimp_seticontext(Save_h%,1,FNmessage_lookup(Messages_h%,"MusicFile"))
ELSE
PROCwimp_seticontext(Save_h%,1,FF$)
ENDIF
T%=FNGetFileInfo(FF$)
PROCUpdateTitle(FF$)
FileName$=FF$
SYS "Hourglass_Off"
SYS "Hourglass_On"
IF T% THEN
PROCposition_staves
PROCSetExtent(S_Width%)
PROCstart_music
PROCSetDefaultChannels
PROCset_score(0)
PROCSetupBarStarts(0)
PROCscore_init
PROCscore_update(0,-Score_Height%,Score_Width%,0)
PROCStopScoring
CHANGED%=FALSE
ENDIF
ELSE
OSCLI("FX 229,1")
T%=FALSE
ENDIF
IF NOT T% THEN ZZ%=FNCheckOKTag("InvMusic",1) : CLOSE#FILE%
load_pending% = FALSE
SYS "Hourglass_Off"
ENDPROC
DEF FNlMusic
LOCAL c%,ptr%,size%,bsize%,n%
REM Get sizes of queues and resize heap blocks if needed
INPUT#FILE%,GateSize%
bsize%=FNheap_getblocksize(Heap%,GateBlock%)
IF GateSize%>bsize% THEN
IF NOT FNheap_resizeblock(Heap%,GateBlock%,GateSize%-bsize%) THEN
REM Couldn't resize block: terminate load
n%=FNCheckOKTag("OutMem2",1)
=FALSE
ENDIF
ENDIF
FOR c%=0 TO 7
INPUT#FILE%,size%
NoteSize%(c%)=size%*2
bsize%=FNheap_getblocksize(Heap%,NoteBlock%(c%))
IF NoteSize%(c%)>bsize% THEN
IF NOT FNheap_resizeblock(Heap%,NoteBlock%(c%),NoteSize%(c%)-bsize%) THEN
REM Couldn't resize block: terminate load
n%=FNCheckOKTag("OutMem2",1)
=FALSE
ENDIF
ENDIF
NEXT
REM Fill Gate queue
ptr%=GateBlock%
WHILE ptr%<GateBlock%+GateSize%
?ptr%=BGET#FILE%
ptr%+=1
ENDWHILE
REM Fill Note queue
FOR c%=0 TO 7
ptr%=NoteBlock%(c%)
WHILE ptr%<NoteBlock%(c%)+NoteSize%(c%)
ptr%?0=BGET#FILE%
ptr%?1=BGET#FILE%
ptr%?2=0
ptr%?3=0
ptr%+=NSIZE%
ENDWHILE
NEXT
REM Set pointers to Gate and Note queues
PP%=GateBlock%
P%()=NoteBlock%()
=TRUE
DEF PROClStaves
STAVE%=BGET#FILE%
PERC%=BGET#FILE%
ENDPROC
DEF PROClInstruments
LOCAL c%,chan%,v%
FOR c%=0 TO 7
REM Get channel
chan%=BGET#FILE%
REM Write voice numbers allocated to each channel
v%=BGET#FILE% MOD (NVoices%+1)
IF v%=0 THEN v%=1
SYS "Sound_AttachVoice",chan%+1,v%
PROCAttachVoice(chan%,0)
NEXT
ENDPROC
DEF PROClVolumes
LOCAL c%
FOR c%=0 TO 7
Volumes%(c%)=BGET#FILE%
IF Volumes%(c%)>7 THEN Volumes%(c%)=7
IF Volumes%(c%)<0 THEN Volumes%(c%)=0
NEXT
ENDPROC
DEF PROClStereos
LOCAL c%
FOR c%=0 TO 7
Stereo_Position%(c%)=BGET#FILE%
SYS "Sound_Stereo",c%+1,Stereo%(Stereo_Position%(c%))
NEXT
ENDPROC
DEF PROClTempo
LOCAL t%
t%=BGET#FILE%
PROCSetTempo(t%)
ENDPROC
DEF PROCsave_init (x%,y%)
LOCAL f$
f$=FNwimp_geticontext(Save_h%,1)
IF (INSTR(f$,".")=0 AND INSTR(f$,":")=0) THEN
SYS "Wimp_CreateMenu",,Save_h%,x%,y%
ELSE
PROCsave_music(f$)
ENDIF
ENDPROC
DEF PROCsave_music (FF$)
LOCAL n%,tmp%,laddr%,eaddr%
LOCAL ERROR
T%=0
REM simple check for pathname rather than local name
IF (INSTR(FF$,".")=0 AND INSTR(FF$,":")=0 AND INSTR(FF$,"<")=0) THEN
n%=FNCheckOKTag("ToSave",1)
ENDPROC
ENDIF
SYS "Hourglass_On"
ON ERROR LOCAL OSCLI("FX 229,1"):SYS "Hourglass_Off":T%=FNCheckOK(REPORT$,1):ENDPROC
OSCLI("FX 229,0"):REM enable escape key
SYS "OS_File",5,FF$ TO ,,laddr%,eaddr%
IF CHANGED% OR (((laddr%>>20) AND &FFF)<>&FFF) THEN
REM file changed or wasn't timestamped
REM get current time
Block%?0=3:SYS "OS_Word",&0E,Block%
laddr%=Block%?4
eaddr%=Block%!0
ENDIF
REM force music file type, and preserve timestamp
laddr%=(laddr% AND &FF) OR (&FFF<<20) OR (MusicFileType%<<8)
REM I don't know what the length will be, so use zero
SYS "OS_File", &07, FF$, laddr%, eaddr%, 0, 0
REM OPENUP, error if directory or not found
SYS "OS_Find", &CC, FF$ TO FILE%
REM timestamp is automatically updated on 1st byte write
BPUT#FILE%,"Maestro"
BPUT#FILE%,2
PROCsMusic
PROCsStaves
PROCsInstruments
PROCsVolumes
PROCsStereos
PROCsTempo
CLOSE#FILE%:FILE%=FALSE
IF (NOT CHANGED%) AND (((laddr%>>20) AND &FFF)=&FFF) THEN
REM file not changed and was timestamped
REM preserve original timestamp
SYS "OS_File",2,FF$,laddr% :REM re-stamp with old stamp
SYS "OS_File",3,FF$,,eaddr% :REM nb eaddr% in r3
ENDIF
OSCLI("FX 229,1")
REM Twiddle the name we keep so that it doesn't ever get set to <Wimp$Scrap>
REM Also, if a scrap transfer is done, the document should still be marked as
REM having been altered - a scrap transfer isn't safe.
IF LEFT$(FF$, 12) = "<Wimp$Scrap>" THEN
F$ = LEFT$(FileName$) : REM Preserve old title
IF CHANGED% THEN
PROCUpdateTitle(LEFT$(F$) + "*") : REM Will already have space on end
ENDIF
ELSE
CHANGED%=FALSE
PROCwimp_seticontext(FileInfo_h%,2,FNmessage_lookup(Messages_h%,"No"))
F%=FNGetFileInfo(FF$)
PROCUpdateTitle(FF$)
PROCwimp_seticontext(Save_h%,1,FF$+CHR$(0))
FileName$=FF$
ENDIF
SYS "Hourglass_Off"
ENDPROC
DEF PROCsMusic
LOCAL c%,ptr%,size%
BPUT#FILE%,1
REM Write sizes of Gate and Note queues
PRINT#FILE%,GateSize%
FOR c%=0 TO 7
size%=NoteSize%(c%) DIV 2
PRINT#FILE%,size%
NEXT
REM Write Gate data
ptr%=GateBlock%
WHILE ptr%<GateBlock%+GateSize%
BPUT#FILE%,?ptr%
ptr%+=1
ENDWHILE
REM Write Note data
FOR c%=0 TO 7
ptr%=NoteBlock%(c%)
WHILE ptr%<NoteBlock%(c%)+NoteSize%(c%)
BPUT#FILE%,ptr%?0
BPUT#FILE%,ptr%?1
ptr%+=NSIZE%
ENDWHILE
NEXT
ENDPROC
DEF PROCsStaves
BPUT#FILE%,2
BPUT#FILE%,STAVE%
BPUT#FILE%,PERC%
ENDPROC
DEF PROCsInstruments
LOCALC%
BPUT#FILE%,3
FORC%=0TO7
BPUT#FILE%,C%
BPUT#FILE%,Instrument%(C%,1)
NEXT
ENDPROC
DEF PROCsVolumes
LOCALC%
BPUT#FILE%,4
FORC%=0TO7
BPUT#FILE%,Volumes%(C%)
NEXT
ENDPROC
DEF PROCsStereos
LOCALC%
BPUT#FILE%,5
FORC%=0TO7
BPUT#FILE%,Stereo_Position%(C%)
NEXT
ENDPROC
DEF PROCsTempo
BPUT#FILE%,6
BPUT#FILE%,Tempo%
ENDPROC
DEF PROCsprite(s%,sx%,sy%)
REM Plot sprite S%(s%) at sx%,sy%
sx%=sx%-x%(s%)
sy%=sy%-y%(s%)
SYS "OS_SpriteOp",SprPlot%,SprBlk%,S%(s%),sx%,sy%,8,factors%,pixtrans%
ENDPROC
DEF PROCfloat (s%,sx%,sy%)
LOCAL more%,width%,height%,n%,b%
REM Get size of attribute for redraw rectangle
CASE s% OF
WHEN key%:REM Key signature
IF KEY_SIG%(1) THEN
n%=X%(accidental%+2+KEY_SIG%(0))+x%(accidental%+2+KEY_SIG%(0))
width%=KEY_SIG%(1)*n%
ELSE
width%=X%(key%)
ENDIF
height%=72
WHEN time%:REM Time signature
n%=TIME_SIG%(0)+1
b%=2^(TIME_SIG%(1)-1)
width%=X%(time%+n%)
IF width%<X%(time%+b%) THEN width%=X%(time%+b%)
height%=Stave_Height%
OTHERWISE:REM Any other attribute
width%=X%(s%)
height%=Y%(s%)
ENDCASE
Block%!0=ScoreWind_h%
Block%!12=sx%+width%+2
sx%-=x%(s%)
Block%!4=sx%
Block%!16=sy%+height%
sy%-=y%(s%)
Block%!8=sy%
SYS "Wimp_UpdateWindow",,Block% TO more%
sx%+=Block%!4-Block%!20
sy%+=Block%!16-Block%!24
WHILE more%
CASE s% OF
WHEN key%:PROCfloat_key_sig(sx%,sy%+y%(s%))
WHEN time%:PROCfloat_time_sig(sx%,sy%,width%)
OTHERWISE:
SYS "OS_SpriteOp",SprPlot%,SprBlk%,S%(s%),sx%,sy%,11,factors%,fpixtrans%
ENDCASE
SYS "Wimp_GetRectangle",,Block% TO more%
ENDWHILE
ENDPROC
DEF PROCfloat_key_sig (kx%,ky%)
LOCAL i%,a%,c%,w%,m%
IF KEY_SIG%(1) THEN
c%=SCRIBE%(sclef%)
a%=KEY_SIG%(0)
m%=accidental%+2+a%
w%=x%(m%)+X%(m%)
ky%-=y%(m%)
FOR i%=0 TO KEY_SIG%(1)-1
SYS "OS_SpriteOp",SprPlot%,SprBlk%,S%(m%),kx%,ky%+Li%*Key_Y%(c%,a%,i%),11,factors%,fpixtrans%
kx%+=w%
NEXT
ELSE
SYS "OS_SpriteOp",SprPlot%,SprBlk%,S%(key%),kx%,ky%-y%(key%),11,factors%,fpixtrans%
ENDIF
ENDPROC
DEF PROCfloat_time_sig (tx%,ty%,width%)
LOCAL sx%,w%,n%,b%
n%=TIME_SIG%(0)+1
w%=X%(time%+n%)
IF w%<width% THEN sx%=tx%+12 ELSE sx%=tx%
SYS "OS_SpriteOp",SprPlot%,SprBlk%,S%(time%+n%),sx%,ty%+36,11,factors%,fpixtrans%
b%=2^(TIME_SIG%(1)-1)
w%=X%(time%+b%)
IF w%<width% THEN sx%=tx%+12 ELSE sx%=tx%
SYS "OS_SpriteOp",SprPlot%,SprBlk%,S%(time%+b%),sx%,ty%+4,11,factors%,fpixtrans%
ENDPROC
REM *********************************************************************** REM
REM REM
REM M U S I C T R A N S C R I P T I O N R O U T I N E S REM
REM REM
REM *********************************************************************** REM
DEF PROCstart_music
REM Initialise to start of music data
GP%=GateBlock%
N%()=NoteBlock%()
REM Set default clef, time sig (4/4) and key sig (Cmaj)
CLEF%()=0
SIG%(0)=%01100111
SIG%(1)=%00000010
REM Go to score start and cache bar info
BAR%=0
PX%=0
PROCPutBarInfo(0)
ENDPROC
REM PROCEDURE: note_type(Channel C%, Type T%)
DEF PROCnote_type(C%,T%)
N%(C%)?1=N%(C%)?1 AND &1F OR T%<<5
ENDPROC
DEF PROCnote_dots(C%,D%)
N%(C%)?1=N%(C%)?1 AND &E7 OR D%<<3
ENDPROC
DEF PROCnote_accidental(C%,A%)
N%(C%)?1=N%(C%)?1 AND &F8 OR A%
ENDPROC
DEF PROCnote_line (c%,l%,type%)
REM Sets the y pos for Notes/Rests
REM Note range is +/-15, Rest range is +/-3
REM For Notes, these are converted to 1-31
REM For Rests, they're converted to and 1-3 below centre line,
REM 5-7 above centre line, and 0 on centre line (to preserve
REM compatibility with older versions where Rests were always centred).
IF type%>=rest% THEN
IF l%=0 THEN l%=-4
N%(c%)?1=(N%(c%)?1 AND &F8) OR l%+4
ELSE
?N%(c%)=(?N%(c%) AND &7) OR (l%+16)<<3
ENDIF
ENDPROC
DEF PROCnote_tie (c%,type%)
REM Add/remove a tie from a note
CASE type% OF
WHEN 0:REM Remove tie
?N%(c%)=?N%(c%) AND NOT (2<<1)
WHEN 1:REM Add an over-note tie
?N%(c%)=?N%(c%) AND NOT (1<<1)
?N%(c%)=?N%(c%) OR (1<<2)
WHEN 2:REM Add an under-note tie
?N%(c%)=?N%(c%) OR (3<<1)
ENDCASE
ENDPROC
DEF PROCnote_stem(C%,D%)
?N%(C%)=?N%(C%)AND&FE OR(D%<>0)AND%1
ENDPROC
DEF PROCnote_clear (c%)
N%(c%)!0=0
ENDPROC
DEF PROCnote_chord
REM Sets the chord data for all Notes in a Gate
LOCAL n%,m%,type%,orient%,line%,t%,o%,l%,chord%,top%,bottom%
REM Clear any existing chord data
FOR n%=0 TO 7
IF (GP%?0 AND 1<<n%) THEN N%(n%)?2=N%(n%)?2 AND NOT &7
NEXT
FOR n%=0 TO 7
REM Step through all Notes in Gate, ignoring Rests
IF (GP%?0 AND 1<<n%) THEN
IF (N%(n%)?0 AND &F8) THEN
REM Get Note attributes
type%=N%(n%)?1>>5
orient%=(N%(n%)?0 AND &1)
line%=N%(n%)?0>>3
REM Step through rest of Notes in Gate
chord%=FALSE
top%=line%
bottom%=line%
FOR m%=0 TO 7
IF (GP%?0 AND 1<<m%) AND m%<>n% THEN
IF (N%(m%)?0 AND &F8) THEN
REM Is new note same Stave, note-type and stem dir?
t%=N%(m%)?1>>5
IF t%>1 THEN o%=(N%(m%)?0 AND &1) ELSE o%=orient%
IF S_C%(m%)=S_C%(n%) AND t%=type% AND o%=orient% THEN
REM Mark first Note as being in a chord
chord%=TRUE
N%(n%)?2=(N%(n%)?2 OR &1)
REM Check top/bottom chord positions
l%=N%(m%)?0>>3
IF l%>top% THEN top%=l%
IF l%<bottom% THEN bottom%=l%
IF line%>l% THEN N%(m%)?2=N%(m%)?2 AND NOT (1<<1)
IF line%<l% THEN N%(m%)?2=N%(m%)?2 AND NOT (1<<2)
ENDIF
ENDIF
ENDIF
NEXT
REM Set chord data
IF chord%=TRUE THEN
N%(n%)?2=N%(n%)?2 OR &1
IF line%=top% THEN N%(n%)?2=N%(n%)?2 OR &2
IF line%=bottom% THEN N%(n%)?2=N%(n%)?2 OR &4
ELSE
N%(n%)?2=N%(n%)?2 AND NOT &7
ENDIF
ENDIF
ENDIF
NEXT
ENDPROC
DEF PROCnote_stagger
REM Sets the stagger data for overlapping Notes in a Gate
LOCAL n%,m%,line%,stagger%,l%,s%,sc1%,sc2%
REM Clear any existing stagger data
FOR n%=0 TO 7
IF (GP%?0 AND 1<<n%) THEN N%(n%)?2=N%(n%)?2 AND NOT &8
NEXT
REM Step through all Notes in Gate, ignoring Rests
FOR n%=0 TO 7
IF (GP%?0 AND 1<<n%) THEN
IF (N%(n%)?0 AND &F8) THEN
line%=N%(n%)?0>>3
stagger%=N%(n%)?2 AND &8
REM Step through rest of Notes
FOR m%=0 TO 7
IF (GP%?0 AND 1<<m%) THEN
IF (N%(m%)?0 AND &F8) AND S_C%(m%)=S_C%(n%) AND m%<>n% THEN
l%=N%(m%)?0>>3
s%=N%(m%)?2 AND &8
REM If Notes are adjacent, and both are non-staggered,
REM calculate which one to keep in place
REM Ends of chords have highest priority,
REM followed by line height
IF ABS(line%-l%)=1 AND stagger%=0 AND s%=0 THEN
sc1%=0:sc2%=0
IF (N%(n%)?2 AND &6) THEN sc1%+=2
IF (N%(m%)?2 AND &6) THEN sc2%+=2
IF line%>l% THEN sc1%+=1
IF l%>line% THEN sc2%+=1
IF sc1%>sc2% THEN
N%(m%)?2=N%(m%)?2 OR &8:s%=1
ELSE
N%(n%)?2=N%(n%)?2 OR &8:stagger%=1
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
ENDIF
ENDIF
NEXT
ENDPROC
DEF PROCtime_sig(N%,B%)
?GP%=0:GP%?1=Time%ORN%<<1ORB%<<5
ENDPROC
DEF PROCkey_sig (A%,N%)
GP%?0=0
GP%?1=Key%ORA%<<2ORN%<<3
ENDPROC
DEF PROCclef (S%,C%)
GP%?0=0
GP%?1=Clef% OR C%<<3 OR S%<<6
ENDPROC
DEF PROCbar
GP%?0=0
GP%?1=Bar% OR BarlineType%<<6
ENDPROC
DEF FNinsert_gate (gsize%)
REM Inserts a new Gate. Returns FALSE if error extending heap block
LOCAL ptr%,bsize%,goff%,n%
REM Check if heap block needs extending
bsize%=FNheap_getblocksize(Heap%,GateBlock%)
IF GateSize%>bsize%-4 THEN
goff%=GP%-GateBlock%
IF NOT FNheap_resizeblock(Heap%,GateBlock%,512) THEN
REM Error: can't resize block
n%=FNCheckOKTag("OutMem1",1)
=FALSE
ENDIF
GP%=GateBlock%+goff%
EP%=GateBlock%+GateSize%
PROCSetupBarStarts(0)
ENDIF
IF GP%<EP% THEN
REM Shift data up by gsize% from insertion point
FOR ptr%=GateBlock%+GateSize% TO GP% STEP -4
ptr%!gsize%=!ptr%
NEXT
REM Clear up odd word
ptr%+=3
WHILE ptr%>=GP%
ptr%?gsize%=?ptr%
ptr%-=1
ENDWHILE
ENDIF
REM Insert a Gate block into the queue and clear it
GateSize%+=gsize%
EP%+=gsize%
?GP%=0
GP%?(gsize%-1)=0
=TRUE
DEF FNinsert_note (c%)
REM Inserts a new Note. Returns FALSE if error extending heap block
LOCAL ptr%,end%,bsize%,noff%,n%
REM Check if heap block needs extending
bsize%=FNheap_getblocksize(Heap%,NoteBlock%(c%))
IF NoteSize%(c%)>bsize%-NSIZE% THEN
noff%=N%(c%)-NoteBlock%(c%)
IF NOT FNheap_resizeblock(Heap%,NoteBlock%(c%),256) THEN
REM Error: can't resize block
n%=FNCheckOKTag("OutMem1",1)
=FALSE
ENDIF
N%(c%)=NoteBlock%(c%)+noff%
PROCsavp
PROCSetupBarStarts(0)
PROCrstp
SCRIBE%(c%)=N%(c%)
ENDIF
end%=NoteBlock%(c%)+NoteSize%(c%)
REM Shift data up by NSIZE% from insertion point
IF N%(c%)<end% THEN
FOR ptr%=end%-NSIZE% TO N%(c%) STEP -4
ptr%!NSIZE%=ptr%!0
NEXT
ENDIF
REM Insert a Note block into the queue and clear it
NoteSize%(c%)+=NSIZE%
GP%?0=GP%?0 OR (1<<c%)
PROCnote_clear(c%)
=TRUE
DEF PROCdelete_gate (gsize%)
LOCAL ptr%,end%
GateSize%-=gsize%
end%=GateBlock%+GateSize%
REM Shift data down by gsize%
IF GP%<end% THEN
FOR ptr%=GP% TO end% STEP 4
!ptr%=ptr%!gsize%
NEXT
ENDIF
EP%-=gsize%
ENDPROC
DEF PROCdelete_note (c%)
LOCAL ptr%,end%
NoteSize%(c%)-=NSIZE%
end%=NoteBlock%(c%)+NoteSize%(c%)
REM Shift data down by NSIZE%
IF N%(c%)<end% THEN
FOR ptr%=N%(c%) TO end% STEP 4
ptr%!0=ptr%!NSIZE%
NEXT
ENDIF
GP%?0=GP%?0 AND NOT (1<<c%)
ENDPROC
DEF FNallocate_channel (s%)
LOCAL channel%,c%
channel%=-1
c%=7
REPEAT
WHILE c%>=0 AND (?GP% AND 1<<c%)
c%-=1
ENDWHILE
IF c%>=0 THEN
IF S_C%(c%)=s% THEN channel%=c%
ENDIF
c%-=1
UNTIL c%<0
=channel%
DEF PROCarrange_stave (S%)
LOCAL C%,B%,end%
end%=GateBlock%+GateSize%
B%=TRUE
C%=TRUE
IF ?GP% THEN
ELSE
REPEAT
GP%+=2
UNTIL ?GP% OR GP%>=end%
ENDIF
WHILE B% AND GP%<end%
C%=C% OR FNsort_gate
PROCskip_notes(?GP%)
GP%+=1
IF ?GP% THEN
ELSE
B%=C%
C%=FALSE
REPEAT
GP%+=2
UNTIL ?GP% OR GP%>=end%
ENDIF
ENDWHILE
PROCSetupBarStarts(0)
ENDPROC
DEF FNsort_gate
LOCALC%,NC%,NN%,G%,g%,pg%,d%,shortest%,Gchanged%
shortest%=255
G%=?GP%
g%=FNprevious_gate(GP%)
pg%=FNpreceding_gate(GP%):REM note-gate immediately before
NC%=-1
NN%=-1
FORC%=0TO7
IFS_C%(C%)=S% THEN
NC%+=1:n%(NC%)=C%:IFG%AND%1<<C% NN%+=1:C%(NN%)=C%
IFpg%AND%1<<C% d%=N%(C%)?(-NSIZE%+1)>>3EOR%11100:IFd%<shortest% shortest%=d%
ENDIF
NEXT
shortest%=shortest%EOR%11100
IFg%ANDNC%>0ANDNN%>=0 PROCsort
=Gchanged%
DEF PROCsort
LOCAL N%,M%
c%()=-1
FOR M%=0 TO NC%
FOR N%=0 TO NN%
IF FNsame_pitch(n%(M%),C%(N%)) THEN
c%(N%)=n%(M%)
ENDIF
NEXT
NEXT
FOR N%=0 TO NN%
IF c%(N%)<0 THEN c%(N%)=FNbest
NEXT
FOR N%=0 TO NN%
IF C%(N%)=c%(N%) THEN
ELSE
Gchanged%=TRUE
M%=FNin(c%(N%),C%())
IF M%>N% THEN
PROCswap_notes(N%,M%)
ELSE
PROCmove_note(N%)
ENDIF
ENDIF
NEXT
ENDPROC
DEF PROCswap_notes(N%,M%)
LOCALs%,d%
s%=C%(N%):d%=c%(N%)
SWAPC%(N%),C%(M%)
SWAP!N%(s%),!N%(d%)
ENDPROC
DEF PROCmove_note(N%)
LOCALs%,d%
s%=C%(N%):d%=c%(N%)
IF NOT FNinsert_note(d%) THEN ENDPROC
!N%(d%)=!N%(s%)
PROCdelete_note(s%)
PROCSetupBarStarts(0)
ENDPROC
DEF FNbest
LOCALN%,C%
LOCAL short%,free%,rest%,any%,tied%
FOR N%=NC%TO0STEP-1
C%=n%(N%)
IFFNin(C%,c%())<0 THEN
IF N%(C%)?-NSIZE% AND 4 THEN
tied%=C%+1
ELSE
IFpg%AND%1<<C% THEN
IF (N%(C%)?(-NSIZE%+1)>>3)=shortest% short%=C%+1
IF N%(C%)?-NSIZE% AND &F8 ELSE rest%=C%+1
ELSE
free%=C%+1
ENDIF
any%=C%+1
ENDIF
ENDIF
NEXT
IFshort% C%=short% ELSEIFfree% C%=free% ELSEIFrest% C%=rest% ELSEIFany% C%=any% ELSEC%=tied%
=C%-1
DEF FNin(U%,U%())
LOCALI%:I%=NN%
WHILEI%ANDU%<>U%(I%):I%-=1:ENDWHILE
=I%+(U%<>U%(I%))
DEF FNsame_pitch(c%,C%)
LOCAL R%,r%
R%=?N%(C%) AND &F8
r%=N%(c%)?-NSIZE% AND &F8
=N%(c%)-NSIZE%>=NoteBlock%(c%) AND (g% OR (N%(c%)?-NSIZE% AND 4)=4) AND %1<<c% AND (R% EOR r%)=FALSE AND (FALSE<>R% EOR r%=FALSE)
DEF FNpreceding_gate(gp%)
LOCALC%,gm%
FORC%=0TO7:IFS_C%(C%)=S% gm%=gm%OR%1<<C%
NEXT
REPEAT
gp%-=1
UNTILgm%AND?gp%ORgp%<GateBlock%+2ORgp%?-1=FALSE
=?gp%ANDgp%>GateBlock%+1ANDgp%?-1<>FALSE
DEF FNprevious_gate(gp%)
LOCALC%,gm%
FORC%=0TO7:IFS_C%(C%)=S% gm%=gm%OR%1<<C%
NEXT
REPEAT
gp%-=1
WHILEgp%>GateBlock%ANDgp%?-1=FALSE:gp%-=2:ENDWHILE
UNTILgm%AND?gp%ORgp%<GateBlock%+2
=?gp%ANDgp%>GateBlock%+1
REM *********************************************************************** REM
REM REM
REM M U S I C T Y P E S E T T I N G R O U T I N E S REM
REM REM
REM *********************************************************************** REM
::
REM PROCEDURE: set_score(Starting position PX%)
REM
REM DESCRIPTION: Typeset music score from current bar to end of music/screen
REM No drawing is done as only the positions are calculated.
REM
REM EFFECTS: Stores gate X positions & types in PX%() & PTYPE%()
:
DEF PROCset_score(PX%)
WHILE GP%<GateBlock%+GateSize%
IF?GP% PROCset_notes(?GP%):GP%+=1 ELSEPROCset_attribute(GP%?1):GP%+=2
ENDWHILE:REM Until edge of screen or end of music
EP%=GP%:REM Last GP%, pointer to first undrawn gate
EX%=PX%:REM Last PX%, index to last position
PX%(PX%+1)=PX%(PX%)+PW%(PX%)+Pgap%:REM Appendation position after last symbol
IF PX%(PX%+1)>S_Width% PROCSetExtent(PX%(PX%+1)+100*Hi%) ELSE PROCSetExtent(S_Width%)
PXn%(NBars%)=PX%
PTYPE%(PX%+1)=Note%:REM Note type by default
ENDPROC
::
REM NOTE: The key signature is the only attribute that must be kept track of in order to ensure correct setting.
REM This is because a naturalising signature consists of the same number of naturals as accidentals in the previous key signature
:
DEF PROCset_attribute (a%)
LOCAL type%,subtype%,n%,b%,w%
IF a% AND PTYPE%(PX%)+TRUE ELSE IF a% AND PTYPE%(PX%) ENDPROC
type%=%1:IF a% AND %1 ELSE REPEAT type%=type%<<1:UNTIL a% AND type%
PX%(PX%+1)=PX%(PX%)+PW%(PX%)+Pgap%
PX%+=1
PTYPE%(PX%)=type%
CASE type% OF
WHEN Time%:REM Time signature
n%=(a%>>1 AND 15)+1
b%=%1<<(a%>>5)-1
w%=X%(time%+n%)
IF X%(time%+b%)>w% THEN w%=X%(time%+b%)
PW%(PX%)=x%(time%+2)+w%
WHEN Key%:REM Key signature
IF a% AND 56 THEN
REM New Key Signature has accidentals
subtype%=accidental%+(a%>>2 AND %1)+2
SIG%(1)=a%
ELSE
REM New Key Signature has no accidentals
subtype%=accidental%+1
SWAP a%,SIG%(1)
IF a% AND 56 THEN
REM Width: naturalising Key Signature
ELSE
REM Width: empty Key Signature
a%=8
subtype%+=1
ENDIF
ENDIF
PW%(PX%)=(a%>>3 AND 7)*(x%(subtype%)+X%(subtype%))
WHEN Clef%:REM Clef
PW%(PX%)=x%(clef%+3)+X%(clef%+3)
WHEN Bar%:REM Barline
subtype%=a%>>6
PW%(PX%)=x%(bar%+subtype%)+X%(bar%+subtype%)
ENDCASE
ENDPROC
DEF PROCset_notes(G%)
LOCALlx0%,lx1%,ly0%,ly1%
LOCALC%,P%,R%,s%:REM Channel, Note prefix & remainder widths, Sprite
PROCnote_chord
PROCnote_stagger
C%=-1
REPEAT
REPEATC%-=TRUE:UNTILG%AND%1<<C%
PROCbound_note(N%(C%))
IFlx0%>P% P%=lx0%:REM Maximum prefix
IFlx1%>R% R%=lx1%:REM Maximum remainder
N%(C%)+=NSIZE%:REM Pull from note queue
UNTIL(2<<C%)>G%:REM Until no more notes (1 bits)
PX%(PX%+1)=PX%(PX%)+PW%(PX%)+Pgap%+P%:REM Next position is previous position + width+gap+prefix of next note
PX%+=1:REM next note position index
PW%(PX%)=R%:REM Width of new note
PTYPE%(PX%)=Note%:REM Note type
ENDPROC
DEF PROCbound_note (n%)
REM Return bounding box for Note
LOCAL n0%,n1%,n2%,s1%,s2%
n0%=n%?0
n1%=n%?1
n2%=n%?2
REM Get Note/Rest sprite
IF (n0% AND &F8) THEN
s1%=n1%>>5 OR n0%<<3 AND &8
ELSE
s1%=rest% OR n1%>>5
ENDIF
lx0%=x%(s1%):REM Prefix width
lx1%=X%(s1%):REM Suffix width
ly0%=y%(s1%):REM Decender height
ly1%=Y%(s1%):REM Ascender height
IF (n0% AND &F8) THEN
REM Adjust for note staggers
IF (n2% AND &8) THEN
REM Note is on its own
IF (n2% AND &1)=0 THEN lx1%+=X%(3)-4
REM Note is in a chord
IF (n2% AND &1) THEN
IF (n0% AND &1) THEN lx0%+=X%(3)-4 ELSE lx1%+=X%(3)-4
ENDIF
ENDIF
REM Adjust for Accidentals
IF (n1% AND &7) THEN
s2%=accidental% OR (n1% AND &7)
lx0%+=x%(s2%)
IF y%(s2%)>ly0% THEN ly0%=y%(s2%)
IF Y%(s2%)>ly1% THEN ly1%=Y%(s2%)
ENDIF
ENDIF
REM Adjust for Dots
IF (n1% AND &18) THEN
s2%=dot%+(n1%>>3 AND &3)
lx1%=x%(s1%)+X%(s2%)
IF y%(s2%)>ly0% THEN ly0%=y%(s2%)
ENDIF
ENDPROC
DEF FNbound_tie (c%,pos%)
REM Scans ahead to check that a valid second note exists
REM to tie to. If the scan passes more than one barline, or
REM hits the end of the score, return 0. Otherwise, return
REM the x position of the gate that contains the note.
LOCAL gp%,px%,bar%,sline%,xpos%,bline%
REM Get first note's staveline
sline%=(?N%(c%) AND &F8)>>3
REM Store current score and bar pointers
PROCsavp
bar%=BAR%
REM Scan for a note on the same channel and staveline
WHILE GP%<GateBlock%+GateSize%+1 AND bline%<2
PROCskip_gate
pos%+=1
REM Check for barline
IF GP%?0=0 AND GP%?1=&20 THEN bline%+=1
REM Check for note
IF (?GP% AND (1<<c%)) AND bline%<2 THEN
IF ((?N%(c%) AND &F8)>>3)=sline% THEN
xpos%=pos%
GP%=GateBlock%+GateSize%+1
ENDIF
ENDIF
ENDWHILE
REM Restore score and bar pointers
PROCrstp
BAR%=bar%
=xpos%
DEF PROCposition_staves
LOCAL y%,s%
Score_Height%=(PERC%+1+3*(STAVE%+1)+1)*Stave_Height%
y%=-Score_Height%-Stave_Height% DIV 2
IF PERC% THEN
FOR s%=PERC% TO 1 STEP -1
y%+=Stave_Height%
Y_STAVE%(STAVE%+s%)=y%
NEXT
ENDIF
FOR s%=STAVE% TO 0 STEP -1
y%+=3*Stave_Height%
Y_STAVE%(s%)=y%
NEXT
ENDPROC
REM // Score //
DEF PROCscore_init
LOCAL wy%
REM Ensure visible height matches height of workarea
Block%!0=ScoreWind_h%
SYS "Wimp_GetWindowInfo",,(Block% OR 1)
wy%=ABS(Block%!48)+PaneHeight%
Block%!8=Block%!16-wy%
PROCOpenWindow(Block%)
LHBAR%=0
ScoreClosed%=FALSE
FirstOpen%=FALSE
SYS "Wimp_SetCaretPosition",ScoreWind_h%,-1
ENDPROC
DEF PROCscore_click (window%,icon%,button%)
CASE window% OF
WHEN NotesPane_h%:
IF icon%>0 THEN
PROCtoolicon_click(NotesPane_h%,icon%)
IF icon%<9 THEN PROCattach(note%+icon%-1,%111000)
IF icon%>8 THEN PROCattach(rest%+icon%-9,%111000)
ENDIF
WHEN SharpsPane_h%:
IF icon%>1 THEN
CASE icon% OF
WHEN 14,16,18,20:
OTHERWISE:
IF icon%=21 OR icon%=22 THEN icon%=19
PROCtoolicon_click(SharpsPane_h%,icon%)
ENDCASE
IF icon%<9 THEN PROCattach(accidental%+icon%-1,%1100000)
IF icon%>8 AND icon%<12 THEN PROCattach(dot%+icon%-8,%1101000)
IF icon%=12 THEN PROCattach(tie%,%1101000)
IF icon%=13 THEN PROCattach_barline
IF icon%=14 THEN CurrentMenu%=FNwimp_popup(SharpsPane_h%,Barline_h%,icon%)
IF icon%=15 THEN PROCattach_clef
IF icon%=16 THEN CurrentMenu%=FNwimp_popup(SharpsPane_h%,Clef_h%,icon%)
IF icon%=17 THEN PROCattach(key%,%10) :REM key signature
IF icon%=18 THEN CurrentMenu%=FNwimp_popup(SharpsPane_h%,KeyMenu%,icon%)
IF icon%=19 THEN PROCattach(time%,%1) :REM time signature
IF icon%=20 THEN PROCtimesig_init(icon%)
IF icon%=23 THEN PROCattach(tie%+1,%1101000)
ENDIF
WHEN ScoreWind_h%:
IF button%=4 THEN
IF SCORING% AND SCRIBE%(drawn%) THEN PROCput_down
ENDIF
SYS "Wimp_SetCaretPosition",ScoreWind_h%,-1
ENDCASE
ENDPROC
DEF FNscore_keypress (key%)
LOCAL used%,x%,y%,mx%,my%
used%=TRUE
SYS "Wimp_GetPointerInfo",,Block%
mx%=Block%!0
my%=Block%!4
CASE key% OF
WHEN &181:REM F1 (Help)
OSCLI("Filer_Run <Maestro$Dir>.!Help")
WHEN &183:REM F3 (Save)
Block%!0=Save_h%
SYS "Wimp_GetWindowState",,Block%
x%=mx%-(Block%!12-Block%!4) DIV 2
y%=my%+(Block%!16-Block%!8) DIV 2
SYS "Wimp_CreateMenu",,Save_h%,x%,y%
WHEN &185:REM F5 (Goto)
Block%!0=Bar_h%
SYS "Wimp_GetWindowState",,Block%
x%=mx%-(Block%!12-Block%!4) DIV 2
y%=my%+(Block%!16-Block%!8) DIV 2
PROCgoto_init
SYS "Wimp_CreateMenu",,Bar_h%,x%,y%
WHEN &013:REM ^S (Staves)
Block%!0=StaveWind_h%
SYS "Wimp_GetWindowState",,Block%
x%=mx%-(Block%!12-Block%!4) DIV 2
y%=my%+(Block%!16-Block%!8) DIV 2
PROCstaves_init(x%,y%)
WHEN &009:REM ^I (Instruments)
Block%!0=InstrWind_h%
SYS "Wimp_GetWindowState",,Block%
x%=mx%-(Block%!12-Block%!4) DIV 2
y%=my%+(Block%!16-Block%!8) DIV 2
PROCinstruments_init(x%,y%)
WHEN &180:REM Print
Block%!0=Print_h%
SYS "Wimp_GetWindowState",,Block%
x%=mx%-(Block%!12-Block%!4) DIV 2
y%=my%+(Block%!16-Block%!8) DIV 2
PROCprint_init
SYS "Wimp_CreateMenu",,Print_h%,x%,y%
WHEN &1A2:REM Ctrl-F2
PROCCloseWindow(ScoreWind_h%)
OTHERWISE:used%=FALSE
ENDCASE
=used%
DEF PROCscore_update (x0%,y0%,x1%,y1%)
LOCAL more%
Block%!0=ScoreWind_h%
Block%!4=x0%
Block%!8=y0%
Block%!12=x1%
Block%!16=y1%
SYS "Wimp_UpdateWindow",,Block% TO more%
WHILE more%
CLG
PROCdraw_staves
SYS "Wimp_GetRectangle",,Block% TO more%
ENDWHILE
ENDPROC
REM // Goto bar //
DEF PROCgoto_init
LOCAL bar%
Block%!0=ScoreWind_h%
SYS "Wimp_GetWindowState",,Block%
bar%=FNFindBar(Block%!20)
IF bar%<1 THEN bar%=1
PROCwimp_seticontext(Bar_h%,0,STR$(bar%))
PROCwimp_seticontext(Bar_h%,2,STR$(NBars%-1))
ENDPROC
DEF FNgoto_keypress (key%)
LOCAL used%
used%=TRUE
CASE key% OF
WHEN &0D:REM Enter
BAR%=VAL(FNwimp_geticontext(Bar_h%,0))
IF BAR%>NBars% THEN
BAR%=NBars%
ELSE
IF BAR%<0 THEN BAR%=0
ENDIF
Block%!0=ScoreWind_h%
SYS "Wimp_GetWindowState",,Block%
Block%!20=PX%(PXn%(BAR%))+4
REM Set scroll to requested bar number
SYS "Wimp_OpenWindow",,Block%
LHBAR%=FNFindBar(Block%!20)
PROCCloseWindow(Bar_h%)
SYS "Wimp_CreateMenu",,-1
WHEN &1A2:REM Ctrl-F2
PROCCloseWindow(Bar_h%)
OTHERWISE:used%=FALSE
ENDCASE
=used%
REM // Draw //
REM PROCEDURE: draw_staves
REM
REM DESCRIPTION: Draw current stave structure
REM 1 stave for 1 voice
REM 2 staves for keyboard
REM 3 staves for 1 voice and keyboard
REM 4 staves for 4 voice chorus
:
DEF PROCdraw_staves
LOCAL Y%,T%,B%,S%,L%:REM Y%,T%,B%=Position & Y bounds of each stave, S%=Stave index, L%=Line position
LOCAL x%,y%,lx1%:REM Virtual coordinates of bottom left & top right of score window
LOCAL c%,t%,b%:REM Left edge of clip window and Y bounds
y%=Block%!16-Block%!24
x%=Block%!4-Block%!20
lx1%=x%+Score_Width%
IF lx1%>Block%!36 THEN lx1%=Block%!36
c%=Block%!28
IF c%<x%+Hi% THEN c%=x%+Hi%
b%=Block%!32
t%=Block%!40
B%=Score_Width%
T%=Block%!36-x%
IF T%<B% THEN B%=T%:REM Right bound
T%=Block%!28-x%
IF T%<0 THEN T%=0:REM Left bound
PROCdraw_score(x%,y%,T%,B%):REM Draw symbols on stave
IFPERC% THEN
FOR S%=STAVE%+1TOSTAVE%+PERC%
Y%=y%+Y_STAVE%(S%)
IFb%<=Y%ANDt%>=Y% LINEc%,Y%,lx1%,Y%
NEXT
ENDIF
FOR S%=0 TO STAVE%
Y%=y%+Y_STAVE%(S%):T%=Y%+Stave_Height%DIV2:B%=T%-Stave_Height%
IFb%<=T%ANDt%>=B% THEN
LINEc%,Y%,lx1%,Y%:REM Plot centre bar line
FORL%=Li%*2TOL%*2STEPL%
LINEc%,Y%+L%,lx1%,Y%+L%:REM Plot upper line
LINEc%,Y%-L%,lx1%,Y%-L%:REM Plot lower line
NEXT
ENDIF
NEXT
ENDPROC
REM PROCEDURE: draw_score(Based X%,Y%, PX bounds A%,B%)
REM
REM DESCRIPTION: Write current section of music score that appears between A%
REM and B%
DEF PROCdraw_score(X%,Y%,A%,B%)
LOCAL PX%
REM Must be subtle about redrawing last note (or other item) of
REM score to prevent picking up rubbish data after end
IF A%>PX%(PXn%(NBars%)) THEN
IF A%>PX%(PXn%(NBars%))+2*Pgap% ENDPROC ELSE A%=PX%(PXn%(NBars%))
ENDIF
REM Ensure bar numbers are always completely updated,
REM but don't lose first note draw
BAR%=0
IF NBars%>2 THEN
REM Move to the first bar to draw from
WHILE PX%(PXn%(BAR%+2))<A% AND BAR%<=NBars%-1
BAR%+=1
ENDWHILE
IF BAR%>NBars% THEN ENDPROC
REM Move back two bars to ensure any note ties are picked up,
REM then get bar pointers and update clipping window
IF BAR%>2 THEN BAR%-=2
PROCGetBarInfo(BAR%)
IF PX%<A% THEN A%=PX%
IF GP%>=GateBlock%+GateSize% THEN ENDPROC
REM Skip music until A%
WHILE PX%(PX%+3)<A% AND PX%<EX%
PROCskip_gate
ENDWHILE
ELSE
PROCstart_music
ENDIF
WHILEPX%(PX%)<=B%ANDGP%<GateBlock%+GateSize%
IF?GP% PROCdraw_notes(?GP%):GP%+=1 ELSEPROCdraw_attribute(GP%?1):GP%+=2:IF PLAYING% PROCCheckQ
ENDWHILE
ENDPROC
REM PROCEDURE: draw_notes(Gate G%)
REM
REM DESCRIPTION: Get notes from the indicated channel queues and draw the
REM particular types of note in the correct places on the stave.
REM One may be a rest, may have accidentals preceding it, may have
REM dots following it, may be tied
REM
REM ASSUMPTIONS: Gate is non-zero
DEF PROCdraw_notes (g%)
LOCAL c%,n0%,n1%,n2%
LOCAL x%,y%,s%,line%,type%,offset%,barb%
REM Move to next position
PX%+=1
x%=X%+PX%(PX%)
REM Cycle through Notes in a Gate
c%=-1
REPEAT
REPEAT c%+=1:UNTIL (g% AND 1<<c%)
n0%=N%(c%)?0
n1%=N%(c%)?1
n2%=N%(c%)?2
y%=Y%+Y_STAVE%(S_C%(c%))
IF (n0% AND &F8) THEN
REM Set up Note data
line%=(n0%>>3)-16
type%=n1%>>5
s%=type% OR n0%<<3 AND &8
offset%=0
barb%=0
IF (n2% AND &1) THEN
REM Note is in a chord
REM Check stagger position
IF (n2% AND &8) THEN
IF (n0% AND &1)=0 THEN offset%=X%(3)-4
IF (n0% AND &1) THEN offset%=-X%(3)+4
ENDIF
REM If a stemmed note:
REM - only draw barbs if at the 'barb-end' of a chord
REM - use a reverse sprite if barbed note is staggered
IF type%>1 THEN
barb%=(n0% AND &1)+1
IF (n2% AND 1<<barb%) THEN
PROCdraw_cstem(g%,x%,y%+(line%*Li%),c%,type%,(n0% AND &1))
IF (n2% AND &8) AND offset%<0 THEN s%=SPR_REVERSE%+(type%-2)
ELSE
IF type%=2 THEN s%=SPR_MHEAD% ELSE s%=SPR_CHEAD%
ENDIF
ENDIF
ELSE
REM Note is on its own: check stagger position
IF (n2% AND &8) THEN offset%=X%(s%)-4
ENDIF
REM Draw note
PROCsprite(s%,x%+offset%,y%+(line%*Li%))
REM Draw ledger lines
IF ABS(line%)>5 THEN PROCsprite(ledger%+(line% DIV 2),x%+offset%,y%)
REM Draw accidentals
IF (n1% AND &7) THEN
PROCsprite(accidental% OR (n1% AND &7),x%+offset%-x%(s%),y%+(line%*Li%))
ENDIF
ELSE
REM Draw rest
line%=FNrest_getline(n1%)
s%=(rest% OR n1%>>5)
y%+=(Li%*2)*line%
PROCsprite(s%,x%,y%)
ENDIF
REM Draw dots
IF (n1% AND &18) THEN PROCsprite(dot%+(n1%>>3 AND &3),x%+x%(s%),y%+(line%*Li%))
REM Draw tie
IF (n0% AND &4) THEN PROCdraw_tie(tie%+((n0% AND &2)>>1),x%,y%+(line%*Li%),c%)
UNTIL (2<<c%)>g%
REM Increment pointers for all drawn Notes in Gate
c%=-1
REPEAT
REPEAT c%+=1:UNTIL (g% AND 1<<c%)
N%(c%)+=NSIZE%
UNTIL (2<<c%)>g%
ENDPROC
DEF PROCdraw_cstem (g%,x%,y%,c%,type%,orient%)
REM Draw the stem section of a chord
LOCAL nc%,norient%,ntype%,nl%,ny%,b%
REM We have the 'barb-end' note; find the 'note-end' note
IF orient%=0 THEN b%=2 ELSE b%=1
FOR nc%=0 TO 7
IF (g% AND 1<<nc%) THEN
IF (N%(nc%)?2 AND 1<<b%) THEN
REM Now check same stave, type and orientation
norient%=(N%(nc%)?0 AND &1)
ntype%=N%(nc%)?1>>5
IF norient%=orient% AND S_C%(nc%)=S_C%(c%) AND type%=ntype% THEN
REM Draw stem between Notes
nl%=(N%(nc%)?0>>3)-16
ny%=Y%+Y_STAVE%(S_C%(nc%))+(Li%*nl%)
IF b%=2 THEN MOVE x%+X%(3)-2,y%:DRAW x%+X%(3)-2,ny%
IF b%=1 THEN MOVE x%,ny%:DRAW x%,y%
ENDIF
ENDIF
ENDIF
NEXT
ENDPROC
DEF PROCdraw_tie (s%,sx%,sy%,c%)
REM Plot a scaled tie sprite
LOCAL span%,swidth%
LOCAL oldx0%,oldx1%,scale,scale%
sx%=sx%-x%(s%)
sy%=sy%-y%(s%)
swidth%=x%(s%)+X%(s%)
span%=X%+PX%(FNbound_tie(c%,PX%))-sx%+Pgap%
oldx0%=factors%!0
oldx1%=factors%!8
scale=span%/swidth%
IF scale<0.6 THEN scale=0.6
scale%=scale*10
factors%!0=oldx0%*scale%
factors%!8=oldx1%*10
SYS "OS_SpriteOp",SprPlot%,SprBlk%,S%(s%),sx%,sy%,8,factors%,pixtrans%
factors%!0=oldx0%
factors%!8=oldx1%
ENDPROC
DEF PROCdraw_attribute(A%)
LOCALx%,N%
N%=TRUE:REPEATN%-=TRUE:UNTILA%AND%1<<N%
IFPTYPE%(PX%)EOR%1<<N% PX%+=1
x%=X%+PX%(PX%)
ONN%+1 PROCdraw_time_sig(A%,x%),PROCdraw_key_sig(A%),PROCdraw_clef(A%),PROCdraw_slur(A%),PROCdraw_octave(A%),PROCdraw_barline(A%)
ENDPROC
DEF PROCPutBarInfo(bar%)
REM setup the various pointers to arrays at the start of this bar
FOR n%=0 TO 7
BPn%(n%,bar%)=N%(n%)
NEXT
PXn%(bar%)=PX%
GPn%(bar%)=GP%
FOR n%=0 TO Max_Stave%
CLEFn%(n%,bar%)=CLEF%(n%)
NEXT
SIGn%(0,bar%)=SIG%(0)
SIGn%(1,bar%)=SIG%(1)
ENDPROC
DEF PROCGetBarInfo(bar%)
REM get the values of the data at the start of this bar
FOR n%=0 TO 7
N%(n%)=BPn%(n%,bar%)
NEXT
PX%=PXn%(bar%)
GP%=GPn%(bar%)
FOR n%=0 TO Max_Stave%
CLEF%(n%)=CLEFn%(n%,bar%)
NEXT
SIG%(0)=SIGn%(0,bar%)
SIG%(1)=SIGn%(1,bar%)
ENDPROC
DEF PROCSetupBarStarts(bar%)
REM find pointers to various bits at the starts of all bars through
REM the music. Start at bar%
REM this is just to speed up redraw, avoiding all the note-skipping
LOCAL last%
BAR%=bar%
IF bar%>0 PROCGetBarInfo(bar%) ELSE PROCstart_music
last%=BAR%
PROCPutBarInfo(BAR%)
WHILE GP%<GateBlock%+GateSize%
IF?GP% THEN
PROCskip_notes(?GP%):GP%+=1
ELSE
PROCskip_attribute(GP%?1):GP%+=2
IF BAR%<>last% last%=BAR% : PROCPutBarInfo(BAR%)
ENDIF
ENDWHILE
BAR%+=1
PROCPutBarInfo(BAR%)
NBars%=BAR%
ENDPROC
DEF PROCskip_gate
IF?GP% PROCskip_notes(?GP%):GP%+=1 ELSEPROCskip_attribute(GP%?1):GP%+=2
ENDPROC
DEF PROCskip_notes (g%)
LOCAL c%
PX%+=1
c%=-1
REPEAT
REPEAT
c%+=1
UNTIL (g% AND 1<<c%)
N%(c%)+=NSIZE%
UNTIL (2<<c%)>g%
ENDPROC
DEF PROCskip_attribute(A%)
LOCALT%
T%=%1:IFA%AND%1 ELSEREPEATT%=T%<<%1:UNTILA%ANDT%
CASET%OF
WHENTime%,Key%:SIG%(T%-1)=A%
WHENClef%:CLEF%(A%>>6)=A%>>3AND3
WHENBar%:BAR%+=1
ENDCASE
IFT%EORPTYPE%(PX%) PX%+=1
ENDPROC
DEF PROCback_gate
IFGP%?-2 GP%-=1:PROCback_notes(?GP%) ELSEGP%-=2:PROCback_attribute(GP%?1)
ENDPROC
DEF PROCback_notes (g%)
LOCAL c%
PX%-=1
c%=-1
REPEAT
REPEAT
c%+=1
UNTIL (g% AND 1<<c%)
N%(c%)-=NSIZE%
UNTIL (2<<c%)>g%
ENDPROC
DEF PROCback_attribute(A%)
IFA%=Bar% BAR%-=1
IFA%ANDPTYPE%(PX%+1)+TRUE ELSEIFA%ANDPTYPE%(PX%+1) ENDPROC
PX%-=1
ENDPROC
DEF PROCdraw_time_sig (a%,x%)
LOCAL i%,n%,b%,nx%,bx%
SIG%(0)=a%
n%=(a%>>1 AND 15)+1
b%=%1<<(a%>>5)-1
IF X%(time%+n%)+x%(time%+n%)<PW%(PX%) THEN nx%=x%+12 ELSE nx%=x%
nx%+=x%(time%+n%)
IF X%(time%+b%)+x%(time%+b%)<PW%(PX%) THEN bx%=x%+12 ELSE bx%=x%
bx%+=x%(time%+b%)
FOR i%=0 TO STAVE%+PERC%
PROCsprite(time%+n%,nx%,Y%+Y_STAVE%(i%))
PROCsprite(time%+b%,bx%,Y%+Y_STAVE%(i%)-32)
NEXT
ENDPROC
DEF PROCdraw_key_sig(A%)
LOCALS%,C%,N%,a%,W%
IFA%AND56 SIG%(1)=A% ELSESWAPA%,SIG%(1):a%=accidental%+1:REM Change to C Major uses naturals in old key sig positions
N%=(A%>>3AND7)-1
IFN%>=0 THEN
A%=A%>>2AND%1:REM 0-Sharp or 1-flat signature
IFa% ELSEa%=accidental%+2+A%
W%=x%(a%)+X%(a%)
x%+=x%(a%)
FOR C%=0 TO N%
FOR S%=0TOSTAVE%
PROCsprite(a%,x%,Y%+Y_STAVE%(S%)+Li%*Key_Y%(CLEF%(S%),A%,C%))
NEXT
x%+=W%
NEXT
ENDIF
ENDPROC
DEF PROCdraw_clef(A%)
LOCALS%
S%=A%>>6
CLEF%(S%)=A%>>3AND3
IFS%<=STAVE% PROCsprite(clef%+CLEF%(S%),x%,Y%+Y_STAVE%(S%))
ENDPROC
DEF PROCdraw_slur(A%)
ENDPROC
DEF PROCdraw_octave(A%)
ENDPROC
DEF PROCdraw_barline (a%)
LOCAL s%,type%,by%,bx%
REM Draw barline sprite
type%=a%>>6
BAR%+=1
FOR s%=0 TO STAVE%+PERC%
PROCsprite(bar%+type%,x%,Y%+Y_STAVE%(s%))
NEXT
REM Print bar number
IF BAR% MOD 5=0 THEN
MOVE x%,Y%+Y_STAVE%(0)+Stave_Height%+20*Vi%
PRINT STR$(BAR%)
ENDIF
REM Connect keyboard staves
bx%=x%-x%(bar%+type%)
IF (STAVE%+1) AND 2 THEN
MOVE bx%,Y%+Y_STAVE%(STAVE%)+Stave_Height% DIV 2
by%=Y_STAVE%(STAVE%-1)-Y_STAVE%(STAVE%)-Stave_Height%
DRAW BY 0,by%
IF type%=1 THEN
RECTANGLE FILL bx%+6,Y%+Y_STAVE%(STAVE%)+Stave_Height% DIV 2,5,by%
ENDIF
ENDIF
ENDPROC
REM // Put //
DEF PROCput_down
LOCALC%,PX%,X%,Y%,S%,s%
SYS "Hourglass_On"
GP%=SCRIBE%(sgp%)
FORC%=0TO7:N%(C%)=SCRIBE%(C%):NEXT
PX%=SCRIBE%(posx%)
X%=SCRIBE%(sx%)
Y%=SCRIBE%(sy%)
s%=SCRIBE%(sprite%)
S%=SCRIBE%(stave%)
C%=SCRIBE%(sc%)
PROCrelease:REM undraw sprite being dragged
IF s%<accidental% THEN PROCput_note
IF s%>=accidental% AND s%<clef% THEN PROCput_accidental
IF s%>=clef% AND s%<=clef%+3 THEN PROCput_clef
IF s%>dot% AND s%<=dot%+3 THEN PROCput_dot
IF s%>=bar% AND s%<=bar%+3 THEN PROCput_bar
IF s%>=tie% AND s%<=tie%+1 THEN PROCput_tie
IF s%=time% THEN PROCput_time
IF s%=key% THEN PROCput_key
GP%=SCRIBE%(sgp%)
FORC%=0TO7:N%(C%)=SCRIBE%(C%):NEXT
PROCarrange_stave(SCRIBE%(stave%))
IF PX%(EX%)+200*Hi%>S_Width% PROCSetExtent(PX%(EX%)+200*Hi%)
PROCChangedScore
SYS "Hourglass_Off"
ENDPROC
DEF PROCput_note
LOCAL end%,type%
IF s%<rest% THEN type%=note% ELSE type%=rest%
IF X%=PX%(PX%+1) THEN
REM Insert at end of score or within an existing Gate
end%=(GP%=EP%)
IF end% THEN
IF NOT FNinsert_gate(1) THEN ENDPROC
ELSE
C%=FNput_conflict(S%,SCRIBE%(line%),type%)
ENDIF
IF end% OR C%=-1 THEN
C%=FNallocate_channel(S%)
IF C%>=0 THEN
IF NOT FNinsert_note(C%) THEN ENDPROC
PROCnote_type(C%,s% AND 7)
PROCnote_line(C%,SCRIBE%(line%),s%)
IF type%=note% THEN PROCnote_stem(C%,s% AND 8)
PROCupdate_note
ENDIF
ELSE
REM Only notes delete notes/rests delete rests
IF ((?N%(C%) AND &F8) AND type%=note%) OR ((?N%(C%) AND &F8)=0 AND type%=rest%) THEN
PROCdelete_note(C%)
REM Check if previous Note has a tie; if so, remove it
IF N%(C%)>NoteBlock%(C%) THEN
N%(C%)-=NSIZE%
IF (?N%(C%) AND &4) THEN PROCnote_tie(C%,0)
N%(C%)+=NSIZE%
ENDIF
IF ?GP% THEN
REM Delete within a Gate
PROCupdate_note
ELSE
REM Note is last in Gate; delete whole Gate
PROCdelete_gate(1)
IF GP%?-2=0 THEN
WHILE ?GP%=0 AND GP%<EP%
PROCdelete_gate(2)
ENDWHILE
ENDIF
PROCrescore(PX%)
ENDIF
ENDIF
ENDIF
ELSE
REM Insert between notes
IF X%>PX%(PX%+1) THEN PROCskip_gate
IF NOT FNinsert_gate(1) THEN ENDPROC
C%=FNallocate_channel(S%)
IF NOT FNinsert_note(C%) THEN ENDPROC
PROCnote_type(C%,s% AND 7)
PROCnote_line(C%,SCRIBE%(line%),s%)
IF type%=note% THEN PROCnote_stem(C%,s% AND 8)
PROCrescore(PX%)
ENDIF
ENDPROC
DEF FNput_conflict (s%,l%,type%)
REM Check if the placed note/rest is over an existing note/rest
REM Returns channel number (0-7) if conflict found, otherwise -1
LOCAL c%,pline%,conflict%
REM Convert the line value of the placed note/rest to 1-32
IF type%=rest% THEN l%=l%*2
l%+=16
REM Check against converted line values of already placed notes/rests
c%=7
REPEAT
IF (?GP% AND 1<<c%) AND S_C%(c%)=s% THEN
IF (?N%(c%) AND &F8) THEN
REM Already-placed object is a note
pline%=(?N%(c%)>>3)
ELSE
REM Already-placed object is a rest
pline%=(N%(c%)?1 AND &7)
IF pline%=0 THEN pline%=4
pline%=(pline%-4)*2+16
ENDIF
ENDIF
conflict%=(pline%=l%)
c%-=1
UNTIL conflict% OR c%<0
=c%-(conflict%<>0)
DEF PROCput_tie
LOCAL c%,tx%
IF (?N%(C%) AND &4) THEN
REM Remove a tie from the note and redraw
PROCnote_tie(C%,0)
tx%=FNbound_tie(C%,SCRIBE%(posx%)+1)
PROCscore_update(X%,Y%-26,X%+PX%(tx%),Y%+28)
ELSE
REM Check that first note isn't a rest
IF (?N%(C%) AND &F8)=0 THEN ENDPROC
REM Place a tie on the first note
PROCnote_tie(C%,SCRIBE%(sprite%)-(tie%-1))
REM Arrange channel distribution on the stave so that the next note
REM appearing on the same stave line (if present) is also the next
REM note in the Note queue for that channel
PROCskip_notes(?GP%):GP%+=1
PROCarrange_stave(S%)
REM Check that there's a second note on the same staveline to tie to.
REM If there is, mark the area to redraw; if not, remove the tie.
GP%=SCRIBE%(sgp%)
FOR c%=0 TO 7
N%(c%)=SCRIBE%(c%)
NEXT
tx%=FNbound_tie(C%,SCRIBE%(posx%)+1)
IF tx% THEN
PROCscore_update(X%,Y%-26,X%+PX%(tx%)+70,Y%+28)
ELSE
PROCnote_tie(C%,0)
ENDIF
ENDIF
ENDPROC
DEF PROCput_accidental
LOCALA%,a%
a%=N%(C%)?1AND7
A%=s%AND7
IFA%=a% A%=0
PROCnote_accidental(C%,A%)
PROCupdate_note
ENDPROC
DEF PROCput_dot
LOCALD%,d%
d%=N%(C%)?1>>3AND3
D%=s%AND3
IFD%=d% D%=0
PROCnote_dots(C%,D%)
IFD%*d% THEN
s%=N%(C%)?1>>5OR?N%(C%)<<3AND8:IF?N%(C%)AND&F8 ELSEs%=s%ORrest%
X%+=x%(s%)
ENDIF
PROCupdate_note
ENDPROC
DEF PROCput_clef
LOCALc%
c%=s%AND3
IF GP%=EP% OR ?GP% OR (GP%?1 AND %111)<>Clef% THEN
IF FNinsert_gate(2) THEN PROCclef(S%,c%)
ELSE
WHILE ?GP%=0AND(GP%?1AND%111)=Clef%AND(GP%?1>>6)<>S%ANDGP%<EP%
PROCskip_gate
ENDWHILE
IFGP%<EP%AND?GP%=0AND(GP%?1AND%111)=Clef%AND(GP%?1>>6)=S% THEN
IF(GP%?1>>3AND3)<>c% PROCclef(S%,c%) ELSEPROCdelete_gate(2)
ELSE
IF FNinsert_gate(2) THEN PROCclef(S%,c%)
ENDIF
ENDIF
PROCrescore(PX%)
ENDPROC
DEF PROCput_key
IF GP%=EP% OR ?GP% OR (GP%?1 AND %11)<>Key% THEN
IF FNinsert_gate(2) THEN PROCkey_sig(KEY_SIG%(0),KEY_SIG%(1))
ELSE
IFKEY_SIG%(1)>0AND(GP%?1>>2AND%1)<>KEY_SIG%(0)OR(GP%?1>>3)<>KEY_SIG%(1) PROCkey_sig(KEY_SIG%(0),KEY_SIG%(1)) ELSEPROCdelete_gate(2)
ENDIF
PROCrescore(PX%)
ENDPROC
DEF PROCput_time
IF GP%=EP% OR ?GP% OR (GP%?1AND%1)<>Time% THEN
REM Insert a new Time Signature
IF FNinsert_gate(2) THEN PROCtime_sig(TIME_SIG%(0),TIME_SIG%(1))
ELSE
IF (GP%?1>>1AND15)<>TIME_SIG%(0) OR (GP%?1>>5)<>TIME_SIG%(1) THEN
REM Overwrite new values on an existing Time Signature
PROCtime_sig(TIME_SIG%(0),TIME_SIG%(1))
ELSE
REM Delete the Time Signature
PROCdelete_gate(2)
ENDIF
ENDIF
PROCrescore(PX%)
ENDPROC
DEF PROCput_bar
IF (?GP% OR (GP%?1 AND %111111)<>Bar%) AND X%>PX%(PX%+1) AND GP%<EP% THEN
PROCskip_gate
ELSE
IF GP%?-2=0 AND (GP%?-1 AND %111111)=Bar% THEN PROCback_gate
ENDIF
IF GP%>GateBlock% THEN
IF GP%<EP% AND ?GP%=0 AND (GP%?1 AND %111111)=Bar% THEN
PROCdelete_gate(2)
NBars%-=1
WHILE ?GP%=0 AND GP%<EP%
PROCdelete_gate(2)
ENDWHILE
PROCrescore(PX%)
ELSE
IF GP%?-2 THEN
IF FNinsert_gate(2) THEN
PROCbar
NBars%+=1
PROCrescore(PX%)
ENDIF
ENDIF
ENDIF
ENDIF
ENDPROC
DEF PROCrescore(px%)
IFpx% ELSEPROCstart_music:REM Bar position assumed set, but reset if px%=0
PROCset_score(px%)
IF px%=0 PROCSetupBarStarts(0) ELSE PROCSetupBarStarts(FNFindBar(px%))
PROCscore_update(PX%(px%),-Score_Height%,Score_Width%,0)
ENDPROC
DEF PROCupdate_note
REM Re-typeset score when note width changes
LOCAL oldx%,newx%,shift%,px%
px%=PX%
REM Update current note width
oldx%=PX%(PX%+1)+PW%(PX%+1)+Pgap%
PROCset_notes(GP%?0)
REM Update following symbol x positions
newx%=PX%(PX%)+PW%(PX%)+Pgap%
shift%=newx%-oldx%
IF shift% THEN
GP%+=1
WHILE GP%<GateBlock%+GateSize%
PX%+=1
PX%(PX%)+=shift%
IF ?GP% THEN GP%+=1 ELSE GP%+=2
ENDWHILE
REM Update final GP%/PX% markers
EP%=GP%
EX%=PX%
REM Set attributes for next symbol
PX%(PX%+1)=PX%(PX%)+PW%(PX%)+Pgap%
PXn%(NBars%)=PX%
PTYPE%(PX%+1)=Note%
ENDIF
REM Cache bar starts and update Score window
IF px%=0 THEN
PROCSetupBarStarts(0)
ELSE
PROCSetupBarStarts(FNFindBar(px%))
ENDIF
PROCscore_update(PX%(px%),-Score_Height%,Score_Width%,0)
ENDPROC
DEF PROCattach(s%,V%)
SCRIBE%(sx%)=TRUE:REM New position (Maintain Y for orientation maintainance)
SCRIBE%(drawn%)=FALSE
IFs%<rest%ANDSCRIBE%(sprite%)<rest% s%=s%AND7ORSCRIBE%(sprite%)AND8:REM Maintain note orientation
SCRIBE%(sprite%)=s%
SCRIBE%(valid%)=V%
SCORING%=TRUE
ENDPROC
DEF PROCrelease
IF SCORING% AND SCRIBE%(drawn%) THEN
REM Undraw sprite
PROCfloat(SCRIBE%(sprite%),SCRIBE%(sx%),SCRIBE%(sy%))
IF SCRIBE%(sprite%)<rest% THEN
IF ABSSCRIBE%(line%)>5 THEN
REM Undraw ledger lines
PROCfloat(ledger%+SCRIBE%(line%)DIV2,SCRIBE%(sx%),Y_STAVE%(SCRIBE%(stave%)))
ENDIF
ENDIF
SCRIBE%(sx%)=TRUE:REM Continue drawing of symbol
SCRIBE%(drawn%)=FALSE
ENDIF
ENDPROC
REM PROCEDURE: scribe(At X%,Y%)
REM
REM DESCRIPTION: Draw current music symbol at position over score window
DEF PROCscribe(X%,Y%)
LOCAL S%,L%,C%,A%
Block%!0=ScoreWind_h%
SYS "Wimp_GetWindowState",,Block%
X%-=Block%!4-Block%!20
Y%-=Block%!16-Block%!24
PROCproximate(SCRIBE%(valid%))
IF X%<>SCRIBE%(sx%) OR Y%<>SCRIBE%(sy%) THEN
A%=TRUE
IF (SCRIBE%(valid%) AND &70)=&60 THEN
A%=FALSE
IF C%>=0 THEN A%=SCRIBE%(valid%) AND &8 OR S%<=STAVE% AND ?N%(C%) AND &F8
ENDIF
IF A% THEN
IF SCRIBE%(drawn%) THEN
PROCfloat(SCRIBE%(sprite%),SCRIBE%(sx%),SCRIBE%(sy%))
IF SCRIBE%(sprite%)<rest% THEN
IF ABS(SCRIBE%(line%))>5 THEN
PROCfloat(ledger%+SCRIBE%(line%) DIV 2,SCRIBE%(sx%),Y_STAVE%(SCRIBE%(stave%)))
ENDIF
ENDIF
ELSE
SCRIBE%(drawn%)=TRUE
ENDIF
IF SCRIBE%(sprite%)<rest% THEN
IF ABS(L%)>5 THEN PROCfloat(ledger%+L% DIV 2,X%,Y_STAVE%(S%))
IF Y%<>SCRIBE%(sy%) THEN
SCRIBE%(sprite%)=SCRIBE%(sprite%) AND 7 OR 8 AND Y%>SCRIBE%(sy%)
ENDIF
ENDIF
SCRIBE%(sx%)=X%
SCRIBE%(sy%)=Y%
SCRIBE%(stave%)=S%
IF S%<=Max_Stave% THEN
SCRIBE%(sclef%)=CLEF%(S%)
ELSE
SCRIBE%(sclef%)=CLEF%(Max_Stave%)
ENDIF
SCRIBE%(line%)=L%
SCRIBE%(posx%)=PX%
SCRIBE%(sgp%)=GP%
SCRIBE%(sc%)=C%
FOR C%=0 TO 7
SCRIBE%(C%)=N%(C%)
NEXT
PROCfloat(SCRIBE%(sprite%),X%,Y%)
ENDIF
ENDIF
ENDPROC
REM PROCEDURE: proximate(Positions valid mask V%)
REM
REM DESCRIPTION: Will set X%,Y% to be the nearest valid position to the point
REM X%,Y% supplied (all in stave coordinates) and return the
REM associated position index PX%.
REM
REM A mask is supplied to indicate the valid positions:
REM V% bit 0 -> Valid Time signature positions
REM 1 -> Valid Key signature positions
REM 2 -> Valid Clef positions
REM 3 -> At note/rest positions
REM 4 -> In between notes
REM 5 -> To nearest stave line (else nearest stave)
REM 6 -> To nearest symbol present
REM 7 -> On bar line if near
REM
REM SETS: S% Stave
REM L% Line(-15..15)
REM C% Channel of note
REM GP%,N%() Gate and Note pointers
REM PX% PX%() index
REM X%,Y% Position
DEF PROCproximate(V%):REM (V%, var X%,Y%) = (S%,L%,PX%)
LOCAL d%,D%:REM Distance previous¤t
LOCAL px%,x%:REM Previous PX%, Between note X position
LOCAL gp%:REM Previous gate pointer, key sig
LOCAL T%:REM Type mask
IF NBars%>4 THEN BAR%=LHBAR% ELSE BAR%=0
REM Start from start of page
PROCGetBarInfo(BAR%)
D%=4*S_Width%:REM A suitably excessive distance
IF (V% AND &7) THEN
REM Set positions for Time Signatures, Key Signatures and Clefs
REM Pointer points to centre of object
X%-=X%(clef%)>>1
REM Valid Clef/Key/Time: Work out types to ignore after bars
T%=-V%<<1 AND &6
REM Repeat until distance increases or no more positions
REPEAT
REM Save score pointers and distance
PROCsavp:d%=D%
REM Move to next bar PX%
REPEAT
PROCskip_gate
UNTIL PTYPE%(PX%) AND Bar% OR GP%=EP%
IF PTYPE%(PX%) AND Bar% THEN
REM Skipping any T% types
WHILE PTYPE%(PX%+1) AND T% AND GP%<EP%
REM Skip all clefs
REPEAT
PROCskip_gate
UNTIL GP%=EP% OR GP%?1 AND %111 EOR %100
ENDWHILE
REM Calculate distance to this position
D%=ABS(X%-PX%(PX%+1))
ELSE
REM No more bars
D%=2*S_Width%
ENDIF
UNTIL D%>d% OR GP%=EP%
REM Previous position may be closer; if so, reset
IF d%<D% THEN PROCrstp
REM Set as position
X%=PX%(PX%+1)
ELSE
REM Set x positions for Notes/Rests
REM Pointer points to centre of note
X%-=X%(2)>>1
REM Repeat until distance increases or no more notes
REPEAT
REM Save score pointers and distance
PROCsavp:d%=D%
REM Move to next symbol
PROCskip_gate
REM Skip any attribute types
WHILE PTYPE%(PX%+1) AND GP%<EP%
PROCskip_gate
ENDWHILE
REM Calculate distance to this note position
D%=ABS(X%-PX%(PX%+1))
UNTIL D%>d%ORGP%=EP%
REM Previous position may be closer (or the last valid note
REM position for an accidental/dot to appear); if so, reset
IF d%<D% OR GP%=EP% AND (V% AND &40) THEN PROCrstp
REM If mask setting: To Nearest Stave Line
IF (V% AND &10) AND GP%<EP% THEN
REM Valid between notes (if before last position)
IF X%<PX%(PX%+1) OR X%>PX%(EX%) THEN
REM Before current: between previous (also if after last note)
IF PTYPE%(PX%) THEN
x%=PX%(PX%)+PW%(PX%)-X%(2)
ELSE
x%=PX%(PX%)
ENDIF
x%=x%+PX%(PX%+1)>>1
IF (V% AND &80) THEN x%+=8:IF PTYPE%(PX%)=Bar% THEN x%=PX%(PX%)
ELSE
REM After current: between next
x%=PX%(PX%+1)+PX%(PX%+2)>>1
IF (V% AND &80) THEN x%+=8:IF PTYPE%(PX%+2)=Bar% THEN x%=PX%(PX%+2)
ENDIF
REM If mask setting: At Notes, find closest position
IF (V% AND &8) AND ABS(PX%(PX%+1)-X%)<ABS(x%-X%) THEN
X%=PX%(PX%+1)
ELSE
X%=x%
ENDIF
ELSE
REM Only At Notes: find closest position
X%=PX%(PX%+1)
ENDIF
ENDIF
C%=-1 :REM Initially no channel
L%=0 :REM Initially centre line
res%=1 :REM Resolution setting for Rest placement
IF (V% AND &40) AND ?GP%>0 THEN
REM Set y position of Accidentals, Dots and Ties
REM Find nearest symbol at gate
LOCAL G%,c%:REM Gate mask copy, Previous channel counter
c%=C%
d%=2*S_Height%:REM A suitably excessive distance
G%=?GP%
REPEAT
REPEAT
C%+=1
UNTIL G% AND %1<<C%
D%=Y%-Y_STAVE%(S_C%(C%))
IF (?N%(C%) AND &F8) THEN
REM Note
D%=ABS(D%-Li%*((?N%(C%)>>3)-16))
ELSE
REM Rest
D%=ABS(D%-Li%*FNrest_getline(N%(C%)?1))
ENDIF
IF D%<d% THEN d%=D%:c%=C%
UNTIL (2<<C%)>G%
C%=c%:REM Nearest note
S%=S_C%(C%)
IF (?N%(C%) AND &F8) THEN
REM Note
L%=(?N%(C%)>>3)-16
ELSE
REM Rest
L%=FNrest_getline(N%(C%)?1)
res%=2
ENDIF
ELSE
REM Set y positions of other objects
REM First find the correct stave
LOCAL MS%:REM Highest stave number
MS%=STAVE%
REM If object is Clef or Key Signature,
REM do not include percussion stave
IF (V% AND &6) THEN
ELSE
MS%+=PERC%
ENDIF
S%=-1:REM Before first stave
D%=2*S_Height%:REM A suitably excessive distance
REM Repeat until distance increases or no more staves
REPEAT
d%=D%:REM Copy previous distance
S%+=1:REM Next stave
D%=ABS(Y%-Y_STAVE%(S%)):REM Distance between point and current stave
UNTIL D%>d% OR S%=MS%
S%+=d%<D%:REM Previous stave was closest unless last¤t stave is nearer
REM Now set y position within stave, if a Note/Rest
REM Ledger lines take priority over percussion lines
IF (V% AND &20) THEN
IF S%=STAVE%+1 THEN S%+=Y%>=Y_STAVE%(STAVE%)-Li%*16
IF S%<=STAVE% THEN
IF SCRIBE%(sprite%)>=rest% THEN
REM Rest
REM Y% is L% steps away from centre stave, step=Li%*2
L%=(Y%-Y_STAVE%(S%))/(Li%*2)+8.75
L%-=8
res%=2
REM No further than 3 lines away
IF ABS(L%)>3 THEN L%=3*SGN(L%)
ELSE
REM Note
REM Y% is L% steps away from centre stave, step=Li%
L%=(Y%-Y_STAVE%(S%))/Li%+16.75
L%-=16
REM No further than 15 lines away
IF ABS(L%)>15 THEN L%=15*SGN(L%)
ENDIF
ENDIF
ENDIF
ENDIF
REM Set Y% to centre line of stave, +/- offset, * resolution
Y%=Y_STAVE%(S%)+L%*(Li%*res%)
ENDPROC
DEF FNrest_getline (n%)
LOCAL line%
line%=(n% AND &7)
IF line%>0 THEN line%-=4
=line%
DEF PROCsavp
n%()=N%()
px%=PX%
gp%=GP%
clef%()=CLEF%()
sig%()=SIG%()
ENDPROC
DEF PROCrstp
N%()=n%()
PX%=px%
GP%=gp%
CLEF%()=clef%()
SIG%()=sig%()
ENDPROC
DEF PROCSetTempo (t%)
Tempo%=t%
SYS "Sound_QTempo",Tempo%(t%)*128*4096 DIV 6000
PROCwimp_radiotick(TempoMenu%,t%)
ENDPROC
DEF PROCSetVolume (v%)
SYS "Sound_Volume",Volume%(v%)
PROCwimp_radiotick(VolumeMenu%,v%)
ENDPROC
DEF PROCSetKeySig (m%,k%)
LOCAL n%
KEY_SIG%(0)=(k%>=7)+1
KEY_SIG%(1)=ABS(k%-7)
IF KEY_SIG%(1) THEN
n%=accidental%+2+KEY_SIG%(0)
X%(key%)=(x%(n%)+X%(n%))*KEY_SIG%(1)
ELSE
X%(key%)=x%(accidental%+2)+X%(accidental%+2)
ENDIF
PROCwimp_radiotick(KeyMenu%,m%)
CASE m% OF
WHEN 0:REM Major menu
PROCwimp_radiotick(MajorMenu%,k%)
PROCwimp_radiotick(MinorMenu%,-1)
WHEN 1:REM Minor menu
PROCwimp_radiotick(MajorMenu%,-1)
PROCwimp_radiotick(MinorMenu%,k%)
ENDCASE
IF FNwimp_geticonstate(SharpsPane_h%,17,2) THEN PROCattach(key%,%10)
ENDPROC
DEF PROCSetTimeSig (n%,b%)
TIME_SIG%(0)=n%
TIME_SIG%(1)=b%
PROCwimp_seticonval(SharpsPane_h%,21,"S"+STR$(TIME_SIG%(0)+1))
PROCwimp_seticonval(SharpsPane_h%,22,"S"+STR$(2^(TIME_SIG%(1)-1)))
IF FNwimp_geticonstate(SharpsPane_h%,19,2) THEN PROCattach(time%,%1)
ENDPROC
REM given x position, return number of bar
DEF FNFindBar(xpos%)
LOCAL bar%
bar%=0
WHILE PX%(PXn%(bar%))<xpos% AND bar%<=NBars%:bar%+=1:ENDWHILE
IF bar%>0 bar%-=1
=bar%
REM // Play //
DEF PROCplay_start
LOCALC%,n%
SYS "Sound_Configure",8
REM set play start bar PBAR% to start of currently displayed window (scx%)
Window%!handle%=ScoreWind_h%
SYS "Wimp_GetWindowState",,Window%+handle%
PBAR%=FNFindBar(Window%!scx%)
PP%=GPn%(PBAR%)
FOR n%=0 TO 7
P%(n%)=BPn%(n%,PBAR%)
NEXT
FORC%=0TO3
PCLEF%(C%)=Clef%(CLEFn%(C%,PBAR%))
NEXT
PROCplay_key_sig(SIGn%(1,PBAR%))
PLAYING%=TRUE
SCROLLING%=TRUE
Beats%=((SIGn%(0,PBAR%)>>1AND&F)+1)*Length%(SIGn%(0,PBAR%)>>3AND%11100)
Q%()=Beats%
TIE%=&FF
B2%=&10000
SYS "Sound_QBeat",Beats%
SYS "Sound_QSchedule",Beats%,Sch% OR Sound_QTempo%,Tempo%(Tempo%)*128*4096DIV6000
C%=Beats%/50*&1000:IFC%>&7FFF C%=&7FFF
SYS "Sound_QTempo",C%
MIDI_OFF%(0,0) = -1
MIDI_OFF%(1,0) = -1
PROCwimp_setmenustate(MainMenu%,3,0,TRUE)
PROCwimp_setmenustate(EditMenu%,0,22,TRUE)
ENDPROC
REM flush sound queue and ensure note_offs are sent to midi channels
DEFPROCplay_stop
LOCAL note%, n%
PLAYING%=FALSE
SYS "Sound_QInit"
REM Handle MIDI
IF OutputType%=1 THEN
FOR n%=0 TO 1
note%=0
WHILE (MIDI_OFF%(n%,note%) > 0)
SYS MIDI_TxCommand%, MIDI_OFF%(n%,note%)
note%+=1
ENDWHILE
NEXT
REM reset end markers
MIDI_OFF%(0,0) = -1
MIDI_OFF%(1,0) = -1
ENDIF
PROCwimp_setmenustate(MainMenu%,3,0,FALSE)
PROCwimp_setmenustate(EditMenu%,0,22,FALSE)
ENDPROC
REM This should give a reasonable approximation to a smooth scroll
DEF PROCCheckScroll
LOCAL PosX%, WindowWidth%, BarPos%, LastScroll%,ThisScroll%
IF ScoreClosed% THEN
IF NOT PLAYING% SCROLLING%=FALSE
ENDPROC
ENDIF
IF PBAR%<=2 ENDPROC
IF PLAYING% PROCCheckQ
IF PLAYING% SBAR%=PBAR%-2 ELSE B1%=B2%:B2%=BEAT:IFB2%<B1%:SBAR%+=1
IF SBAR%>=NBars% OR SBAR%>PBAR%+2 SCROLLING%=FALSE:PROCplay_stop:ENDPROC
Block%!0=ScoreWind_h%
SYS "Wimp_GetWindowState",,Block%
WindowWidth%=Block%!12-Block%!4
LastScroll%=Block%!20
PosX%=PX%(PXn%(SBAR%))
BarPos%=(PX%(PXn%(SBAR%+1))-PosX%)*BEAT DIV Beats%
IF BarPos%*2<Pgap% ENDPROC :REM if small amount into bar can scroll to wrong bar (sync with play)
PosX%+=BarPos%
ThisScroll% = PosX%-WindowWidth%DIV2
IF ThisScroll%<=0 ENDPROC
IF ThisScroll%<>LastScroll% THEN
REM auto-scroll
REM divide scroll into small bits to make it appear smooth
Block%!20=(LastScroll%+ThisScroll%)/2
SYS "Wimp_OpenWindow",,Block%
Block%!20=ThisScroll%
OldX%=ThisScroll%
SYS "Wimp_OpenWindow",,Block%
LHBAR%=FNFindBar(ThisScroll%)-1 :REM the bar number at the left of the window
IF PLAYING%=FALSE THEN
REM stop scrolling at end of music
IF Block%!20<=LastScroll% THEN SCROLLING%=FALSE
ENDIF
ENDIF
ENDPROC
DEF PROCplay_bar
LOCALC%,L%,I%,D%,S%,Q%,T%,B%,A%:REM Vars for play_bar & play_notes
LOCAL f,end%
end%=GateBlock%+GateSize%
MIDI_Notenum%=0
Q%()=Beats%:REM Reset stave queue counters for next bar
B%=PBAR%
Accidental%()=0:REM No incidental accidentals initially
First%=TRUE
WHILEB%=PBAR%ANDPP%<end%
IF?PP% PROCplay_notes(?PP%):PP%+=1 ELSEPROCplay_attribute(PP%?1):PP%+=2
First%=FALSE
ENDWHILE
IFPP%>=end% THEN
PLAYING%=FALSE:SBAR%+=1
PROCwimp_setmenustate(MainMenu%,3,0,FALSE)
PROCwimp_setmenustate(EditMenu%,0,22,FALSE)
ENDIF
ENDPROC
REM Notes for each gate start playing at Q%; the latest Q%() of the staves on
REM which notes are to play. This is because all notes in a gate play at the
REM same time and cannot start before the shortest of the notes preceding them
REM have finished.
REM Q% is the time at which the notes in the gate are played
REM Q%(S%) is the time at the end of the shortest note played on stave S%.
REM QI%(S%) is the current shortest note beats interval on stave S%
DEF PROCplay_notes(G%)
LOCAL note%, packed%, Qoff%,xtraVol,tempo
tempo = 5 * 128 * Tempo%(Tempo%) / 6000
Q%=FALSE:C%=TRUE
REPEATREPEATC%-=TRUE:UNTILG%AND%1<<C%
IFQ%(S_C%(C%))>Q% Q%=Q%(S_C%(C%))
UNTIL(2<<C%)>G%
QI%()=&10000:C%=TRUE
REPEAT
IF First% xtraVol=1.01 ELSE xtraVol=1.0 :REM a little dynamics. stress 1st beat in bar very slightly
REPEATC%-=TRUE:UNTILG%AND%1<<C%
IF INT(xtraVol*Volume%(Volumes%(C%)))>&7F xtraVol=1.0 :REM ensure no overflow
T%=?P%(C%):D%=P%(C%)?1:I%=D%>>3:S%=S_C%(C%):L%=T%>>3:A%=0
IFL%ANDS%<=STAVE% THEN
IFD%AND7 Accidental%(S%,L%)=D%AND7
A%=Accidental%(S%,L%):L%+=PCLEF%(S%):IFA% ELSEA%=Key%(L%MOD7):REM If no accidental then revert to key signature
ENDIF
IFTIE%AND%1<<C% THEN
D%=Duration%(Tempo%)?I%
IF T% AND 4 THEN
TIE%=TIE% AND NOT (%1<<C%)
T%=P%(C%)+1
REPEAT T%+=2
D%+=Duration%(Tempo%)?(?T%>>3)
UNTIL T%>(NoteBlock%(C%)+NoteSize%(C%)) OR 4 AND NOT T%?TRUE
IF D%>254 THEN D%=254
ENDIF
IFL% THEN
REM Internal sound system
IF OutputType%=0 THEN
SOUNDC%+1,INT(xtraVol*Volume%(Volumes%(C%)))OR&100,Line(L%)+Aoff(A%),D%,Q%
ENDIF
REM MIDI
IF OutputType%=1 THEN
note% = 12 + INT(((Line(L%)+Aoff(A%))/&1000) * 12)
packed% = (MIDIChannel%(C%)-1) OR (note%<<8) OR INT(xtraVol*(Volume%(Volumes%(C%)))<<16)
MIDI_OFF%(PBAR%MOD2,MIDI_Notenum%) = M_NoteOff% OR packed%
MIDI_Notenum% += 1
MIDI_OFF%(PBAR%MOD2,MIDI_Notenum%) = -1 :REM end marker
REM D% = no. of 5 centisecs
Qoff% = Q% + D% * tempo
IF Qoff% > Q% + 15 Qoff% -= 10 :REM ensure note is off after start and before next note start
SYS "Sound_QSchedule",Q%, Sch% OR MIDI_TxCommand%, M_NoteOn% OR packed%
SYS "Sound_QSchedule",Qoff%, Sch% OR MIDI_TxCommand%, M_NoteOff% OR packed%
ENDIF
ENDIF
ELSE
IF4ANDNOTT% TIE%=TIE%OR%1<<C%
ENDIF
P%(C%)+=NSIZE%:IFLength%(I%)<QI%(S%) QI%(S%)=Length%(I%):Q%(S%)=Q%+QI%(S%)
UNTIL(2<<C%)>G%
ENDPROC
DEF PROCplay_attribute(A%)
C%=TRUE:REPEATC%-=TRUE:UNTILA%AND%1<<C%
ONC%+1 PROCplay_time_sig(A%),PROCplay_key_sig(A%),PROCplay_clef(A%),PROCplay_slur(A%),PROCplay_octave(A%),PROCplay_barline(A%)
ENDPROC
DEF PROCplay_time_sig(A%)
A%=((A%>>1AND&F)+1)*Length%(A%>>3AND%11100)
SYS "Sound_QSchedule",Beats%,Sch% OR Sound_QBeat%,A%
Beats%=A%
ENDPROC
DEF PROCplay_key_sig(A%)
LOCALN%:A%=A%>>2
FORN%=0TO6:Key%(N%)=Key_Sig%(A%,N%):NEXT
ENDPROC
DEF PROCplay_clef(A%)
PCLEF%(A%>>6)=Clef%(A%>>3AND3)
ENDPROC
DEF PROCplay_slur(A%)
ENDPROC
DEF PROCplay_octave(A%)
ENDPROC
DEF PROCplay_barline(A%)
PBAR%+=1
ENDPROC
DEF FNinitialise
LOCAL SoundEnable%
PROCEnumerateSWIs
PROCinitialise_miscellany
PROCinitialise_screen
PROCinitialise_sprites
PROCinitialise_music
PROCinitialise_wimp
PROCinitialise_menu
SoundEnable%=FNinitialise_sound
IF SoundEnable%=1 IF NOT FNCheckOKTag("NoSoundQuit", 3) PROCterminate
PROCinitialise_memory
REM Set up the defaults for an empty score: Cmaj, 4/4, FF, Moderato
PROCClearAllMusic
PROCSetKeySig(0,7)
PROCSetTimeSig(3,3)
PROCSetVolume(6)
PROCSetTempo(8)
REM Set Toolbar defaults
ClefType%=0 :REM Treble clef
BarlineType%=0 :REM Single barline
REM Set up channels
PROCSetDefaultChannels
=TRUE
DEF PROCEnumerateSWIs
Sch%=&0F000000 : REM SWI number mask for QSchedule SWI
Sound_QTempo%=&401C5
Sound_QBeat%=&401C6
LOCAL M%
LOCAL ERROR
ON ERROR LOCAL MIDIpresent%=FALSE : ENDPROC
SYS "OS_SWINumberFromString",0,"MIDI_SoundEnable" TO M%
M_NoteOff% = &80
M_NoteOn% = &90
MIDI_SoundEnable% = M%
MIDI_SetTxChannel% = M% + 2
MIDI_SetTxActiveSensing% = M% + 3
MIDI_TxCommand% = M% + 10
MIDI_TxLocalControl% = M% + 15
MIDI_TxOmniModeOff% = M% + 17
MIDI_TxOmniModeOn% = M% + 18
MIDI_TxMonoModeOn% = M% + 19
MIDI_TxPolyModeOn% = M% + 20
MIDI_TxProgramChange% = M% + 21
MIDI_TxSystemReset% = M% + 30
MIDIpresent%=TRUE : REM Disable untested MIDI bits
ENDPROC
DEF PROCinitialise_miscellany
DIM Block% 255
TIME=0
AwaitingAck%=FALSE
SAVING%=FALSE
load_pending% = FALSE
pending_filename$ = ""
ret_code% = -1
doing_scrap_load%=FALSE : REM Used to indicate that we're loading from another application
INITIALISED%=FALSE
shutdown% = FALSE
quit_sender% = 0
my_ref% = -1 : REM unset
CHANGED%=FALSE
FILE%=FALSE
REM File attributes
FileName$=FNmessage_lookup(Messages_h%,"Untitled")
MusicFileType%=&AF1
DIM ftime% 5
ENDPROC
DEF PROCinitialise_screen
DIM modeblockin 40
DIM modeblockout 40
PROCgetmodeinfo(TRUE)
ENDPROC
DEF PROCgetmodeinfo(new%)
LOCAL S_Rows%, S_Columns%
modeblockin!0=0 : REM ModeFlags
modeblockin!4=1 : REM ScrRCol
modeblockin!8=2 : REM ScrBCol
modeblockin!12=3 : REM NColour
modeblockin!16=4 : REM XEigFactor
modeblockin!20=5 : REM YEigFactor
modeblockin!24=11 : REM XWindLimit
modeblockin!28=12 : REM YWindLimit
modeblockin!32=-1 : REM terminate list
SYS "OS_ReadVduVariables",modeblockin, modeblockout
REM no point in reading sizes since they are fixed by the wimp
Hi%=1<<(modeblockout!16)
Vi%=1<<(modeblockout!20)
S_Width%=Hi% * ((modeblockout!24)+1)
S_Height%=Vi% * ((modeblockout!28)+1)
Hi%=2: Vi%=4
C_Width%=8*Hi% : C_Height%=8*Vi%
IF new%=FALSE THEN
SYS "Wimp_ReadPixTrans",&200,SprBlk%,S%(0),,,,factors%,pixtrans%
j%=7
FOR i%=0 TO 15
fpixtrans%?i%=pixtrans%?j%
IF i%>6 THEN j%-=1
NEXT
ENDIF
ENDPROC
DEF PROCinitialise_sprites
LOCAL path$,size%,file%,yeig%
path$="<Maestro$Dir>.Sprites"
SYS "OS_ReadModeVariable",-1,5 TO ,,yeig%
IF yeig%=1 THEN path$=path$+"22"
IF yeig%=0 THEN path$=path$+"11"
file%=OPENIN path$
size%=EXT#file%+16
CLOSE#file%
DIM SprBlk% size%
SprBlk%!0=size%
SprBlk%!8=16
SYS "OS_SpriteOp",&109,SprBlk%
SYS "OS_SpriteOp",&10A,SprBlk%,path$
SprPlot% = &234 : REM sprite plot code
LOCAL I%,x%,y%,W%,H%
RESTORE
Num%=-1
READS$
WHILES$<>""
READx%,y%,W%,H%,S$
Num%+=1
ENDWHILE
IFFNassert(Num%>=0,"SpriteLoad") STOP
DIM S$(Num%),x%(Num%),y%(Num%),X%(Num%),Y%(Num%), S%(Num%) : REM S%() are sprite pointers
RESTORE
FORI%=0TONum%
READ S$(I%),x%,y%,W%,H%
SYS "OS_SpriteOp", 256+24, SprBlk%, S$(I%) TO ,,S%(I%) : REM get pointer to sprite
x%(I%)=x%*Hi%
y%(I%)=y%*Vi%
X%(I%)=(W%-x%)*Hi%
Y%(I%)=(H%-y%)*Vi%
NEXT
note%=0
rest%=16
accidental%=24
clef%=32
dot%=40
ledger%=43
tie%=44
bar%=51
time%=55
key%=56
SPR_CHEAD%=72
SPR_MHEAD%=73
SPR_REVERSE%=74
SCORING%=FALSE:REM Flag indicating a sprite is to be drawn under the pointer
wasSCORING%=FALSE
stopSCORING%=TRUE
DIM SCRIBE%(18):REM Details of symbol under pointer
REM 0-7 Channel pointers into N%()
sx%=8:REM Current sprite X position
sy%=9:REM Current sprite Y position
drawn%=10:REM Flag indicating sprite presence
sprite%=11:REM Sprite number
valid%=12:REM Valid stave positions
stave%=13:REM Current stave symbol is on
sclef%=14:REM Current clef applying to symbol (used for key sigs)
line%=15:REM Current stave line symbol is on
posx%=16:REM X music position
sgp%=17:REM Symbol gate pointer
sc%=18:REM Channel number if symbol specified close to note
REM Set up sprite colours for fixed and floating objects
DIM factors% 15
DIM pixtrans% 15
DIM fpixtrans% 15
PROCgetmodeinfo(FALSE)
ENDPROC
REM name, x, y, w, h
DATA B,7,3,24,6,SB,0,2,13,5,Mu,0,2,12,17,Cu,0,2,12,17
DATA Qu,0,2,19,17,SQu,0,2,20,17,DSQu,0,2,20,17,SDSQu,0,2,20,17
DATA B,7,3,24,6,SB,0,2,13,5,Md,0,14,12,17,Cd,0,14,12,17
DATA Qd,0,14,12,17,SQd,0,14,12,17,DSQd,0,14,12,17,SDSQd,0,14,12,17
DATA Rest,-1,0,8,4,Rest1,2,-2,16,6,Rest2,2,0,16,2,Rest4,-2,5,9,13
DATA Rest8,-1,4,9,9,Rest16,0,6,12,13,Rest32,1,7,15,16,Rest64,2,9,18,19
DATA Natural,8,6,7,12,Natural,8,6,7,12,Sharp,10,6,9,13,Flat,8,3,8,11
DATA Sharp2,9,2,10,5,Flat2,14,3,16,11,NSharp,17,6,17,12,NFlat,15,6,16,14
DATA Treble,0,14,23,31,Alto,0,8,23,17,Alto,0,4,23,17,Bass,0,5,24,14
DATA ldg5,2,28,16,17,ldg4,2,24,16,13,ldg3,2,20,16,9,ldg2,2,16,16,5,ldg1,2,12,16,1
DATA Dot1,-14,1,4,2,Dot2,-14,1,9,2,Dot3,-14,1,14,2,Tie,-8,-3,20,4,Tie2,-8,7,20,4
DATA ldg1,2,-12,16,1,ldg2,2,-12,16,5,ldg3,2,-12,16,9,ldg4,2,-12,16,13,ldg5,2,-12,16,17
DATA Bar,-1,8,4,16,DBar,-1,8,6,16,Bar,-2,8,1,16,Bar,-2,8,1,16
DATA Time,1,9,14,16,Key,0,8,9,17
DATA 2,3,0,14,8,3,3,0,14,8,4,3,0,14,8,5,3,0,14,8,6,3,0,14,8
DATA 7,3,0,14,8,8,3,0,14,8,9,3,0,14,8,10,3,0,26,8,11,3,0,26,8
DATA 12,3,0,26,8,13,3,0,26,8,14,3,0,26,8,15,3,0,26,8,16,3,0,26,8
DATA C,0,2,12,4,M,0,2,12,4
DATA Mdb,0,14,12,17,Cdb,0,14,12,17,Qdb,0,14,20,17
DATA SQdb,0,14,21,17,DSQdb,0,14,21,17,SDSQdb,0,14,2,17
DATA ""
DEF PROCinitialise_wimp
PROCenumerate_wimp_offsets
Block%!0=2
Block%!4=3
Block%!8=4
Block%!12=5
Block%!16=10
Block%!20=&502
Block%!24=&400C1
Block%!28=11
Block%!32=12
Block%!36=8
Block%!40=1
Block%!44=&400C0
Block%!48=0
SYS "Wimp_Initialise",300,&4B534154,maestro$,Block% TO wimpversion%,Task_h%
message_buffer%!0 = (32 + LEN(maestro$)) AND NOT(3)
message_buffer%!12 = 0
message_buffer%!16 = 11
message_buffer%!20 = 7
message_buffer%!24 = 0
$(message_buffer%+28)=maestro$+CHR$(0)
SYS "Wimp_SendMessage",17,message_buffer%,0
REPEAT
SYS "Wimp_Poll",&1972,message_buffer% TO R%
IF R% = 17 OR R% = 18 OR R% = 19 THEN
IF message_buffer%!16 = 12 AND message_buffer%!20 = 7 THEN
R% = FNCheckOK($(message_buffer% + 28), 1)
PROCterminate
ENDIF
ENDIF
UNTIL R% = 0
DIM SpriteName% 14
$SpriteName%=FNmessage_lookup (Messages_h%, "SpriteName")
REM Create icon bar icon
Block%!0=-1
Block%!4=0
Block%!8=0
Block%!12=64
Block%!16=68
Block%!20=(&311A OR (0<<24) OR (7<<28))
Block%!24=SpriteName%
Block%!28=1
Block%!32=12
SYS "Wimp_CreateIcon",,Block% TO Maestro_h%
PROCload_templates
REM Initialise various window settings
OldX%=0
FirstOpen%=TRUE
PopUpIcon%=0
ScoreClosed%=TRUE
PROCwimp_seticontext(ProgInfo_h%,3,FNmessage_lookup(Messages_h%,"_Version"))
Block%!0=NotesPane_h%
SYS "Wimp_GetWindowState",,Block%
PaneHeight%=Block%!16-Block%!8
SelW%=-1
SelI%=-1
ENDPROC
DEF PROCenumerate_wimp_offsets
Window%=Block%+4
handle%=-4
x0%=0:y0%=4:x1%=8:y1%=12
scx%=16:scy%=20
ENDPROC
DEF PROCload_templates
wblock%=FNwimp_opentemplates("<Maestro$Dir>.Templates")
ProgInfo_h%=FNwimp_loadtemplate("ProgInfo",wblock%,FALSE)
QuitQuery_h%=FNwimp_loadtemplate("query",wblock%,FALSE)
FileInfo_h%=FNwimp_loadtemplate("FileInfo",wblock%,FALSE)
TimeSig_h%=FNwimp_loadtemplate("TimeSigW",wblock%,FALSE)
Bar_h%=FNwimp_loadtemplate("BarW",wblock%,FALSE)
ClearQuery_h%=FNwimp_loadtemplate("close",wblock%,FALSE)
ScoreWind_h%=FNwimp_loadtemplate("ScoreWind",wblock%,SprBlk%)
Print_h%=FNwimp_loadtemplate("print_db",wblock%,FALSE)
Save_h%=FNwimp_loadtemplate("xfer_send",wblock%,FALSE)
InstrWind_h%=FNwimp_loadtemplate("InstrWind",wblock%,SprBlk%)
SharpsPane_h%=FNwimp_loadtemplate("SharpsPane",wblock%,SprBlk%)
NotesPane_h%=FNwimp_loadtemplate("NotesPane",wblock%,SprBlk%)
Clef_h%=FNwimp_loadtemplate("ClefW",wblock%,SprBlk%)
Barline_h%=FNwimp_loadtemplate("BarLineW",wblock%,SprBlk%)
StaveWind_h%=FNwimp_loadtemplate("StaveWind",wblock%,FALSE)
SYS "Wimp_CloseTemplate"
ENDPROC
DEF PROCinitialise_menu
LOCAL i%,f%
VolumeMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Volume"),8)
FOR i%=0 TO 7
IF i%<7 THEN f%=0 ELSE f%=128
PROCwimp_additem(VolumeMenu%,i%,f%,-1,FNmessage_lookup(Messages_h%,"V"+STR$(i%)))
NEXT
TempoMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Tempo"),15)
FOR i%=0 TO 14
IF i%<14 THEN f%=0 ELSE f%=128
PROCwimp_additem(TempoMenu%,i%,f%,-1,FNmessage_lookup(Messages_h%,"T"+STR$(i%)))
NEXT
FileMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"File"),3)
PROCwimp_additem(FileMenu%,0,0,FileInfo_h%,FNmessage_lookup(Messages_h%,"FInfo"))
PROCwimp_additem(FileMenu%,1,0,Save_h%,FNmessage_lookup(Messages_h%,"Save"))
PROCwimp_additem(FileMenu%,2,136,Print_h%,FNmessage_lookup(Messages_h%,"Print"))
EditMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Edit"),2)
PROCwimp_additem(EditMenu%,0,8,Bar_h%,FNmessage_lookup(Messages_h%,"Goto"))
PROCwimp_additem(EditMenu%,1,128,-1,FNmessage_lookup(Messages_h%,"Clear"))
ScoreMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Score"),4)
PROCwimp_additem(ScoreMenu%,0,0,-1,FNmessage_lookup(Messages_h%,"Staves"))
PROCwimp_additem(ScoreMenu%,1,0,-1,FNmessage_lookup(Messages_h%,"Instruments"))
PROCwimp_additem(ScoreMenu%,2,0,VolumeMenu%,FNmessage_lookup(Messages_h%,"Volume"))
PROCwimp_additem(ScoreMenu%,3,128,TempoMenu%,FNmessage_lookup(Messages_h%,"Tempo"))
MainMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Maestro"),4)
PROCwimp_additem(MainMenu%,0,0,FileMenu%,FNmessage_lookup(Messages_h%,"File"))
PROCwimp_additem(MainMenu%,1,0,EditMenu%,FNmessage_lookup(Messages_h%,"Edit"))
PROCwimp_additem(MainMenu%,2,2,ScoreMenu%,FNmessage_lookup(Messages_h%,"Score"))
PROCwimp_additem(MainMenu%,3,128,-1,FNmessage_lookup(Messages_h%,"Play"))
IconMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Maestro"),3)
PROCwimp_additem(IconMenu%,0,0,ProgInfo_h%,FNmessage_lookup(Messages_h%,"Info"))
PROCwimp_additem(IconMenu%,1,0,-1,FNmessage_lookup(Messages_h%,"Help"))
PROCwimp_additem(IconMenu%,2,128,-1,FNmessage_lookup(Messages_h%,"Quit"))
ChannelMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Channel"),16)
FOR i%=0 TO 15
IF i%<15 THEN f%=0 ELSE f%=128
PROCwimp_additem(ChannelMenu%,i%,f%,-1,STR$(i%+1))
NEXT
VoiceMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Voices"),MAX_VOICES%-2)
FOR i%=0 TO MAX_VOICES%-3
IF i%<MAX_VOICES%-3 THEN f%=0 ELSE f%=128
PROCwimp_additem(VoiceMenu%,i%,f%,-1,STRING$(32,"X"))
NEXT
OutputMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Output"),2)
PROCwimp_additem(OutputMenu%,0,0,-1,FNmessage_lookup(Messages_h%,"OT0"))
PROCwimp_additem(OutputMenu%,1,128,-1,FNmessage_lookup(Messages_h%,"OT1"))
MajorMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Major"),15)
FOR i%=0 TO 14
IF i%<14 THEN f%=0 ELSE f%=128
IF i%=6 OR i%=7 THEN f%=2
PROCwimp_additem(MajorMenu%,i%,f%,-1,FNmessage_lookup(Messages_h%,"MJ"+STR$(i%)))
NEXT
MinorMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"Minor"),15)
FOR i%=0 TO 14
IF i%<14 THEN f%=0 ELSE f%=128
IF i%=6 OR i%=7 THEN f%=2
PROCwimp_additem(MinorMenu%,i%,f%,-1,FNmessage_lookup(Messages_h%,"MN"+STR$(i%)))
NEXT
KeyMenu%=FNwimp_makemenu(FNmessage_lookup(Messages_h%,"KeySig"),2)
PROCwimp_additem(KeyMenu%,0,0,MajorMenu%,FNmessage_lookup(Messages_h%,"Major"))
PROCwimp_additem(KeyMenu%,1,128,MinorMenu%,FNmessage_lookup(Messages_h%,"Minor"))
ENDPROC
DEF FNinitialise_sound
LOCAL SoundEnable%
SYS "Sound_Configure",8 TO OldConfigure
SYS "Sound_Enable",0 TO SoundEnable%
REM disconnect midi interpreter
IF MIDIpresent% THEN SYS MIDI_SoundEnable%,0
=SoundEnable%
DEF PROCClearAllMusic
LOCAL f%
REM Clear Note queues and reset pointers
NoteSize%()=0
PP%=GateBlock%
P%()=NoteBlock%()
NBars%=0
BAR%=0
PBAR%=0
SBAR%=0
PROCstart_music
EP%=GP%
REM Add a Barline attribute to the empty score
BarlineType%=0
PROCwimp_seticonval(SharpsPane_h%,13,"Ssbarline")
PROCbar
GateSize%=2
PX%(0)=0
PXn%(BAR%)=0
PW%(0)=4*Hi%
PTYPE%(0)=Bar%
REM Reset Gate pointer
GP%=GateBlock%
GPn%(BAR%)=GP%
PROCrescore(0)
PROCSetExtent(S_Width%)
PROCrelease
wasSCORING%=FALSE
stopSCORING%=TRUE
SCORING%=FALSE
CHANGED%=FALSE
REM Reset file information
FileName$=FNmessage_lookup(Messages_h%,"Untitled")
PROCUpdateTitle(FileName$)
PROCwimp_seticontext(FileInfo_h%,2,FNmessage_lookup(Messages_h%,"No"))
PROCwimp_seticontext(Save_h%,1,FNmessage_lookup(Messages_h%,"MusicFile")+CHR$(0))
f%=FNGetFileInfo("")
ENDPROC
REM PROCEDURE: initialise_music
REM
REM STRUCTURES: Queue of Gate;
REM Queue of Music;
REM
REM TYPES: Gate= byte0>0 -> Gate_Mask
REM byte0=0 -> Music_Attribute
REM
REM Gate_Mask= byte; bitn=1 -> gate 1 note/rest from music queue n (n=0-7)
REM
REM Music_Attribute= word; bit0_7=0
REM bit8=1 -> Time signature bit12_9 No. beats-1
REM bit15_13 Beat type
REM bit9=1 -> Key signature bit10 0-#, 1-b
REM bit13_11 0-7
REM bit10=1 -> Clef bit12_11 Treble,Alto,Tenor,Bass
REM bit15_14 Stave 1-4
REM bit11=1 -> Slur switch bit12 on/off
REM bit15_14 Stave 1-4
REM bit12=1 -> Octave shift bit13 0-up,1-down
REM bit15_14 Stave 1-4
REM bit13=1 -> bar
REM (bit13_0=0 -> Reserved)
REM
REM Music= word; bit7_3>0 -> Note
REM bit7_3=0 -> Rest
REM
REM Note= word; bit0= Stem orientation: 0-up,1-down
REM bit1=1 -> Join barbs to next note
REM bit2=1 -> Tie with next note
REM bit7_3>0 Note stave line position 1 to 31 (16=centre line)
REM bit10_8>0 -> Accidental N,#,b,X,bb,N#,Nb
REM bit12_11= Number of dots 0 to 3
REM bit15_13= Type: Breve to Semi-demi-semiquaver
REM
REM Rest= word; bit0=0 NB If a rest coincides with a note, its
REM bit1=0 position is determined by the
REM bit2=0 following note on the same channel.
REM bit7_3=0
REM bit10_8=0
REM bit12_11= Number of dots 0 to 3
REM bit15_13= Type: Breve rest to Semi-demi-semiquaver rest
REM
REM Position_type= 0 -> Note
REM 1 -> Time Signature
REM 2 -> Key Signature
REM 3 -> Clef
REM 4 -> Slur
REM 5 -> Octave shift
REM 6 -> Bar
:
DEF PROCinitialise_music
LOCALN%,C%:REM Note,channel
PROCinitialise_options
Note%=0:Time%=1:Key%=2:Clef%=4:Slur%=8:Octave%=16:Bar%=32:REM Stave attribute enumerators
DIM Ninc%(6),Line(42),Aoff(7),Clef%(3),Key%(6),Key_Sig%(15,6),Length%(31),Duration%(NTempos%),Accidental%(3,31)
FORN%=0TO6:Ninc%(N%)=ASCMID$("024579;",N%+1)AND15:NEXT:REM Note increment
LOCALST:ST=&1000/12:REM Semitone increment
FORN%=0TO42
Line(N%)=(1+N%DIV7<<12)+Ninc%(N%MOD7)*ST+.49
NEXT:REM Notes corresponding to stave lines (C octave 1 TO C octave 7)
Aoff(2)=ST:Aoff(3)=-ST:Aoff(4)=ST*2:Aoff(5)=-ST*2:Aoff(6)=ST:Aoff(7)=-ST:REM Accidental offsets
Clef%(0)=11:Clef%(1)=5:Clef%(2)=3:Clef%(3)=-1:REM Line offsets for each clef
FORC%=2TO15
FORN%=0TO(C%>>1)-1
Key_Sig%(C%,(7+Key_Y%(1,C%AND%1,N%))MOD7)=C%MOD2+2
NEXT
NEXT:REM Set up note offsets for each key signature
FORC%=0TO31
Length%(C%)=(%1<<7-(C%>>2))*(%1111000>>(C%AND3)AND%1111):REM Length of each possible note/rest (dotted) in tempo beats
NEXT
LOCALD%:REM Duration
FORN%=0TONTempos%
DIM C% 32:Duration%(N%)=C%:REM Reserve space for each tempo
FORC%=0TO31
D%=75/Tempo%(N%)*Length%(C%)/8+.5:REM Durations of note+dot combinations in 20ths of a second for each tempo (Max 22.5 Seconds)
IFD%>254 D%=254:REM Limit to maximum possible duration (12.7 Seconds)
Duration%(N%)?C%=D%
NEXT
NEXT
TIE%=&FF:REM Tie state of channels - Each bit corresponds to a channel, 0 if tied
PLAYING%=FALSE:REM Flag indicating play in process
SCROLLING%=FALSE:REM Flag indicating auto-scrolling while playing
DIM Q%(Max_Stave%+2):REM Time positions of next notes on each stave
DIM QI%(Max_Stave%+2):REM Time increments of Q%() for each stave
B1%=0:B2%=0:REM Alternate beat counters used to detect zero wrap
REM Set maximum Gates and Bars
Max_Gate%=1600
Max_Bar%=Max_Gate% DIV 4
DIM GPn%(Max_Bar%) :REM GP% at the start of each bar
DIM PX%(Max_Gate%),PW%(Max_Gate%),PTYPE%(Max_Gate%):REM Notation screen positions, widths & types
REM PX% is PX%() index to screen positions & types - Always refers to the note/attribute just passed
DIM PXn%(Max_Bar%) :REM PX% at start of each bar
DIM BPn%(7,Max_Bar%):REM Indices to (8) note queues at the start of each bar
DIM N%(7),n%(7):REM Pointers to current notes (n%()=copy, cf PROCproximate)
DIM C%(7),c%(7):REM Indexes of gate channels used in sorting
DIM CLEF%(Max_Stave%),clef%(Max_Stave%):REM Current clef on each stave (& clef copy)
DIM CLEFn%(Max_Stave%,Max_Bar%) :REM CLEF% at start of each bar
DIM SIG%(1),sig%(1):REM Base bar key & time sigs, current and copy
DIM SIGn%(1,Max_Bar%) :REM SIG% at the start of each bar
DIM P%(7),PCLEF%(3):REM Playing note pointers, clef
MaxNotesInBar%=128
REM while one half of draw q is being filled, the other half is being used for scrolling.
DIM MIDI_OFF%(1,MaxNotesInBar%*4) :REM an array of MIDI noteoffs if playing is stopped in the middle of a bar
MIDI_OFF%(0,0)=-1
MIDI_OFF%(1,0)=-1
MIDI_Notenum%=0
Pgap%=X%(2)DIV2:REM Symbol spacing (half note blob width)
ENDPROC
DEF PROCinitialise_options
REM Tempo
NTempos%=14
DIM Tempo%(NTempos%)
Tempo%(0)=40
Tempo%(1)=50
Tempo%(2)=60
Tempo%(3)=65
Tempo%(4)=70
Tempo%(5)=80
Tempo%(6)=90
Tempo%(7)=100
Tempo%(8)=115
Tempo%(9)=130
Tempo%(10)=145
Tempo%(11)=160
Tempo%(12)=175
Tempo%(13)=190
Tempo%(14)=210
REM Time signatures
DIM TIME_SIG%(1) :REM Current time signature numerator(0) and denominator(1)
REM Key signatures
DIM KEY_SIG%(1) :REM Current key signature (0: 0/1 flats/sharps; 1: 0-7)
DIM Key_Y%(3,1,6) :REM Key signature 0-sharp/1-flat stave line positions
LOCAL C%,A%,P% :REM Indices
FOR C%=0 TO 3 :REM For each clef
FOR A%=0 TO 1 :REM For each accidental type
FOR P%=0 TO 6 :REM For each accidental position
REM Position offsets of key signature accidentals from centre stave line
Key_Y%(C%,1-A%,P%)=3*(P%AND%1)-P%DIV2+(P%-3)*A%+(A%ANDC%<>2AND(P%AND5)=0)*7-1-(C%-1>>1)-2*(C%=2)
NEXT
NEXT
NEXT
REM Volumes
NVolumes%=7
DIM Volume%(NVolumes%),Volumes%(7)
FOR R%=0 TO NVolumes%
REM don't permit full volume so that dynamics are possible
Volume%(R%)=(R%+1)*120/(NVolumes%+1)-1
NEXT
SYS "Sound_Volume" TO R%
RestoreVolume=R%
REM don't permit full volume. This is reserved for dynamics
Volume%=R%*(NVolumes%+1)/120-.5
IF Volume%<0 THEN Volume%=0
SYS "Sound_Volume",Volume%(Volume%)
FOR R%=0 TO 7
Volumes%(R%)=6
NEXT
REM Staves
Max_Stave%=3
Li%=2*Vi%
Stave_Height%=Li%*8
DIM Y_STAVE%(Max_Stave%+2)
STAVE%=0 :REM means 1 stave
PERC%=0 :REM means no percussion
Score_Width%=S_Width%
PROCposition_staves
LOCALS%
DIM Stave_Channels%(Max_Stave%+2,7):REM Primary stave allocation of channels 0-7 for each stave structure
FOR S%=0 TO Max_Stave%
FOR R%=0 TO 7
Stave_Channels%(S%,R%)=(S%+1)*R%DIV8:REM Close formula to desired data
NEXT
NEXT
Stave_Channels%(2,1)=1
Stave_Channels%(2,2)=1
Stave_Channels%(2,5)=2:REM Correct the exceptions to formula
DIM S_C%(7):REM Current stave allocation
FORR%=0TO7
S_C%(R%)=Stave_Channels%(STAVE%,R%):REM Initialise channel allocation (Also reset each time stave structure is changed)
NEXT
REM Voices
LOCALI$,L%,M%:REM Instrument name, Number of instruments, Instrument name length, Max
MAX_VOICES%=32+1 :REM 1-32 Voice slots + MIDI
DIM Voice$(MAX_VOICES%) :REM Names of available voices
DIM RestoreVoice%(7) :REM Table of original voice/channel allocation
DIM Instrument%(7,1) :REM Instrument information: 0=Stave,1=Voice
REM Get number of voices available
SYS "Sound_InstallVoice" TO I$,NVoices%
NVoices%-=1
IF FNassert(NVoices%>0,"NoVoices") STOP
REM Get names of available voices
FOR R%=1 TO NVoices%
SYS "Sound_InstallVoice",2,R% TO ,,,Voice$(R%)
NEXT
REM Get voice allocation for each channel
FOR R%=0 TO 7
SYS "Sound_AttachVoice",R%+1,0 TO L%,S%
RestoreVoice%(R%)=S%
REM Make sure a voice is attached to all channels
IF S%<1 OR S%>NVoices% THEN S%=1
SYS "Sound_AttachVoice",L%,S%
REM Create instrument information (stave and voice)
Instrument%(R%,0)=S_C%(R%)+1
Instrument%(R%,1)=S%
NEXT
REM Stereo positions
NStereos%=6
DIM Stereo%(NStereos%),Stereo_Position%(7)
FOR R%=0 TO NStereos%
Stereo%(R%)=(2*R%/NStereos%-1)*127
NEXT
FOR R%=0 TO 7
Stereo_Position%(R%)=NStereos% DIV 2
SYS "Sound_Stereo",R%+1,Stereo%(Stereo_Position%(R%))
NEXT
REM Audio output
REM 0=Internal sound system
REM 1=MIDI device
OutputType%=0
REM MIDI options
NMIDIChannels%=16
DIM MIDIChannel%(7)
FOR c%=0 TO 7
MIDIChannel%(c%)=c%+1
NEXT
ENDPROC
DEF PROCinitialise_memory
LOCAL c%,n%
NSIZE%=4 :REM Size of Note block in memory
REM Reserve initial memory for music: 9 x 1K blocks + headers
Heap%=FNheap_init(9252)
IF Heap%=0 THEN
n%=FNCheckOKTag("OutMem3",1)
PROCterminate
ENDIF
REM Set up Gate data
GateBlock%=FNheap_newblock(Heap%,1024) :REM Pointer to start of Gate data
IF GateBlock%=0 THEN
n%=FNCheckOKTag("OutMem3",1)
PROCterminate
ENDIF
GateSize%=0 :REM Size of Gate data
REM Set up Note data (eight channels)
DIM NoteBlock%(7)
DIM NoteSize%(7)
FOR c%=0 TO 7
NoteBlock%(c%)=FNheap_newblock(Heap%,1024) :REM Pointer to start of Note data
IF NoteBlock%(c%)=0 THEN
n%=FNCheckOKTag("OutMem3",1)
PROCterminate
ENDIF
NoteSize%(c%)=0 :REM Size of Note data
NEXT
ENDPROC
DEF PROCrestore
REMOSCLI("audio off")
FORR%=0TO7 :REM restore channel/voice allocation
SYS "Sound_AttachVoice",R%+1,RestoreVoice%(R%)
NEXT
SYS "Sound_Volume", RestoreVolume :REM restore volume
SYS "Sound_Configure",OldConfigure
ENDPROC
DEF PROCexit
PROCCloseWindow(ScoreWind_h%)
PROCrestore
ENDPROC
DEF PROCterminate
LOCAL i%
IF INITIALISED% IF PLAYING% PROCplay_stop
*UnSet Maestro$Running
PROCclose_messagefile(Messages_h%)
IF Task_h%>0 THEN
ON ERROR SYS "Wimp_CloseDown", Task_h%, "TASK" : END
ELSE
ON ERROR END
ENDIF
IF INITIALISED% THEN
PROCheap_freeblock(Heap%,GateBlock%)
FOR i%=0 TO 7
PROCheap_freeblock(Heap%,NoteBlock%(i%))
NEXT
PROCexit
PROCCloseWindow(QuitQuery_h%)
ENDIF
ON ERROR END
IF Task_h%>0 THEN SYS "Wimp_CloseDown", Task_h%, "TASK"
END
ENDPROC
DEF FNassert(E%,A$)
LOCAL e%
A$=FNmessage_lookup(Messages_h%, A$)
IFE% THEN=FALSE ELSE e%=FNCheckOK(FNmessage_lookupN(Messages_h%, "Fatal", A$, "", "", ""),1)
PROCterminate
=TRUE
DEF PROCerror
LOCAL e%
LOCAL ERROR
ON ERROR LOCAL PROCterminate: STOP
SYS "Hourglass_Smash"
E$=FNmessage_lookupN(Messages_h%, "IntErr", REPORT$, STR$ERL, "", "")
IF INITIALISED% THEN
E$+=" "+FNmessage_lookup (Messages_h%, "ExProg")
IF FNCheckOK(E$,3) PROCterminate
ELSE
e%=FNCheckOK(E$,1) : PROCterminate
ENDIF
ENDPROC
DEF PROCOpenDiscardCancelBox
REM Dbox saying "Blah edited", Discard, Cancel
LOCAL c%,d%
LOCAL mc_dx%,mc_dy%,mc_sw%,mc_sh%,scrx%,scry%
Window%!handle%=QuitQuery_h%
SYS "Wimp_GetWindowState", ,Window%+handle%
SYS"OS_ReadModeVariable",-1,4 TO ,,mc_dx%:mc_dx%=1<<mc_dx%
SYS"OS_ReadModeVariable",-1,5 TO ,,mc_dy%:mc_dy%=1<<mc_dy%
SYS"OS_ReadModeVariable",-1,11 TO ,,mc_sw%:mc_sw%+=1
SYS"OS_ReadModeVariable",-1,12 TO ,,mc_sh%:mc_sh%+=1
scrx%=mc_sw%*mc_dx%
scry%=mc_sh%*mc_dy%
c%=(scrx%-(Window%!8 - Window%!0 )) DIV 2
d%=(scry%-(Window%!4 - Window%!12)) DIV 2
SYS "Wimp_CreateMenu",,QuitQuery_h%,c%,d%
ENDPROC
DEF PROCOpenSaveDiscardCancelBox
REM Dbox saying "Blah not saved", Save, Discard, Cancel
LOCAL c%,d%
LOCAL mc_dx%,mc_dy%,mc_sw%,mc_sh%,scrx%,scry%
Window%!handle%=ClearQuery_h%
SYS "Wimp_GetWindowState", ,Window%+handle%
SYS"OS_ReadModeVariable",-1,4 TO ,,mc_dx%:mc_dx%=1<<mc_dx%
SYS"OS_ReadModeVariable",-1,5 TO ,,mc_dy%:mc_dy%=1<<mc_dy%
SYS"OS_ReadModeVariable",-1,11 TO ,,mc_sw%:mc_sw%+=1
SYS"OS_ReadModeVariable",-1,12 TO ,,mc_sh%:mc_sh%+=1
scrx%=mc_sw%*mc_dx%
scry%=mc_sh%*mc_dy%
c%=(scrx%-(Window%!8 - Window%!0 )) DIV 2
d%=(scry%-(Window%!4 - Window%!12)) DIV 2
SYS "Wimp_CreateMenu",,ClearQuery_h%,c%,d%
ENDPROC
DEF FNCheckOK(E$, boxes%)
LOCAL E%
FILE%=FILE%:IF FILE% CLOSE#FILE% : FILE%=FALSE
!err_block%=0
$(err_block%+4)=LEFT$(E$,200)+CHR$0
SYS "Wimp_ReportError", err_block%, boxes%, maestro$ TO ,E%
=E%=1 : REM return TRUE if OK pressed
DEF FNCheckOKTag(E$, boxes%)
=FNCheckOK(FNmessage_lookup(Messages_h%, E$), boxes%)
DEF FNopen_messagefile(name$)
LOCAL type%,len%
SYS "OS_File",17,name$ TO type%,,,,len%
IF type%<>1 SYS "OS_File",19,name$,type%
DIM message_data% (len% + 19) AND &FFFFFFFC
SYS "MessageTrans_OpenFile", message_data%, name$, message_data%+16
=message_data%
DEF PROCclose_messagefile(mh%)
SYS "MessageTrans_CloseFile", mh%
ENDPROC
DEF FNmessage_lookup(mh%, tag$)
LOCAL s$
SYS "MessageTrans_Lookup", mh%, tag$, 0, 0, 0, 0, 0, 0 TO ,,s$
=s$
DEF FNmessage_lookupN(mh%, tag$, ss0$, ss1$, ss2$, ss3$)
LOCAL s$
SYS "MessageTrans_Lookup", mh%, tag$, message_buffer%, 256, ss0$, ss1$, ss2$, ss3$ TO ,,s$
=s$
REM // Print //
DEF PROCprint_init
LOCAL pname$
LOCAL ERROR
ON ERROR LOCAL:RESTORE ERROR:PROCwimp_seticontext(Print_h%,1,FNmessage_lookup(Messages_h%,"NoPrinter")):PROCwimp_seticonstate(Print_h%,2,22,TRUE):ENDPROC
SYS "PDriver_Info" TO ,,,,pname$
PROCwimp_seticontext(Print_h%,1,pname$)
PROCwimp_seticonstate(Print_h%,2,22,FALSE)
ENDPROC
DEF PROCprint_click (icon%,button%)
CASE icon% OF
WHEN 2:REM Print
IF FNwimp_geticontext(Print_h%,1)<>FNmessage_lookup(Messages_h%,"NoPrinter") THEN
PROCprint
ELSE
icon%=FNCheckOKTag("NoPrinter",1)
ENDIF
IF button%=1 THEN SYS "Wimp_CreateMenu",,-1
ENDCASE
ENDPROC
DEF PROCprint
LOCAL Hi%, Vi%
LOCAL f%, e%, h%
LOCAL page_x%, page_y%, margin%
LOCAL score_height%, staves_per_page%
LOCAL p%, gp%
LOCAL y1%, y2%, y3%
LOCAL x1%, x2%
LOCAL s%
LOCAL l%, i%
LOCAL page%, last_page%
LOCAL title$
LOCAL r0%
LOCAL lx0%, lx1%, ly0%, ly1% : REM returned by bound_note
LOCAL C%, P%, R% : REM Channel, Max prefix, Max width
LOCAL G%, A%, a%, W% : REM Note, Attribute
LOCAL N%() : REM Note indices for each channel
LOCAL n_start%(), n%() : REM Local copy of N%
LOCAL SIG%(), sig%()
LOCAL clef%()
LOCAL nbars%
LOCAL NC0%, NC1%
LOCAL x%, y%, lasty%, checkstagger%
LOCAL N%
LOCAL note_factors%, factors%
LOCAL bars_plotted%
LOCAL on_page%, last_pos%, index%, last_x_offset%
LOCAL current_gate%, n_bars%, multiplier, w1, xs
LOCAL events%, events_start%
LOCAL bar_at_front%, bar_at_front_start%
LOCAL x_res%, y_res%, ptr%, features%
LOCAL end%
DIM note_factors% 16, factors% 16
DIM N%(7)
DIM n_start%(7), n%(7)
DIM SIG%(1), sig%(1)
DIM clef%(Max_Stave%)
DIM PrintRectangle%16, PrintTransform%16, PrintPos%8
SYS "PDriver_Info" TO ,x_res%,y_res%, features%
IF x_res% < 120 OR y_res% < 144 THEN
REM Keep the above resolutions in step with the error in the messages file
IF NOT FNCheckOK(FNmessage_lookupN(Messages_h%,"LoRes",FNwimp_geticontext(Print_h%,1),STR$(x_res%),STR$(y_res%),""),3) THEN ENDPROC
ENDIF
Hi% = 2
Vi% = 4
x_mul_scale% = 3
y_mul_scale% = 3
x_div_scale% = 4
y_div_scale% = 4
SYS "Hourglass_On"
SYS "Wimp_ReadPixTrans",&200,SprBlk%,S%(0),,,,factors%,pixtrans%
note_factors%!0 = factors%!0 * x_mul_scale%
note_factors%!4 = factors%!4 * y_mul_scale%
note_factors%!8 = (factors%!8) * x_div_scale%
note_factors%!12 = (factors%!12) * y_div_scale%
clef%() = CLEF%()
clef%() = 0
N%() = NoteBlock%()
SIG%(0)=%01100111
SIG%(1)=%00000010
title$=FNwimp_geticontext(Save_h%,1)
l% = LEN(title$)
s% = 1
FOR i% = 1 TO l% - 1
c$ = MID$(title$, i%, 1)
IF (c$ = ":" OR c$ = ".") THEN s% = i% + 1
NEXT i%
title$ = MID$(title$, s%)
end% = GateBlock% + GateSize%
LOCAL ERROR
ON ERROR LOCAL: RESTORE ERROR:e%=FNCheckOK (FNmessage_lookupN(Messages_h%, "IntErr", REPORT$, STR$(ERL), "", ""), 1):ENDPROC
f% = OPENOUT("printer:")
SYS "PDriver_SelectJob", f%, title$
SYS "PDriver_CurrentJob" TO h%
REM IF (h% = 0) THEN
REM e% = FNCheckOK (FNmessage_lookup (Messages_h%, "JobFailed"), 3)
REM SYS "Hourglass_Off"
REM ENDPROC
REM ENDIF
IF (features% AND (1 << 29)) <> 0 THEN
SYS "PDriver_DeclareFont", 0, 0, 0 : REM We don't want to use any
ENDIF
ON ERROR LOCAL: RESTORE ERROR: SYS "PDriver_AbortJob", f%: CLOSE#f%:e%=FNCheckOK (FNmessage_lookupN(Messages_h%, "IntErr", REPORT$, STR$(ERL), "", ""), 1):ENDPROC
SYS "PDriver_PageSize" TO ,page_x%,page_y%, l_edge%, b_edge%, r_edge%, t_edge%
page_x% = page_x% / 400: page_y% = page_y% / 400
REM l_edge% = 0: r_edge% = page_x%
l_edge% = l_edge% / 400: r_edge% = r_edge% / 400
b_edge% = b_edge% / 400: t_edge% = t_edge% / 400
r_edge% -= (Hi% * 12)
SYS "ColourTrans_SetGCOL", &00000000,,,0,0
score_height%=(PERC%+1+3*(STAVE%+1))*Stave_Height%
margin% = Stave_Height%
staves_per_page% = (page_y% - 2 * margin%) / score_height%
gp% = GateBlock%
page% = 0
last_page% = 0
p% = gp%
index% = 0
last_x_offset% = 0
x2% = 0
last_pos% = 0
current_bar% = 0
current_gate% = 0
n%() = N%()
events% = 0
bar_at_front% = TRUE
bars_plotted% = 0
WHILE gp% < end%
last_page% = page%
page% += 1
PrintRectangle%!0 = 0
PrintRectangle%!4 = 0
PrintRectangle%!8 = page_x%
PrintRectangle%!12 = page_y%
PrintTransform%!0 = &10000
PrintTransform%!4 = &00000
PrintTransform%!8 = &00000
PrintTransform%!12 = &10000
PrintPos%!0 = 0
PrintPos%!4 = 0
SYS "PDriver_GiveRectangle", 0, PrintRectangle%, PrintTransform%, PrintPos%, &ffffffff
SYS "PDriver_DrawPage", 1, PrintRectangle%, page%, STR$(page%) TO r0%
p% = gp%
index_start% = index%
last_x_offset_start% = last_x_offset%
x2_start% = x2%
last_pos_start% = last_pos%
current_gate_start% = current_gate%
current_bar_start% = current_bar%
n_start%() = n%()
events_start% = events%
bar_at_front_start% = bar_at_front%
sig%() = SIG%()
WHILE r0%
IF last_page% = page% THEN
index% = index_start%
last_x_offset% = last_x_offset_start%
x2% = x2_start%
last_pos% = last_pos_start%
current_gate% = current_gate_start%
current_bar% = current_bar_start%
gp% = p%
n%() = n_start%()
events% = events_start%
bar_at_front% = bar_at_front_start%
SIG%() = sig%()
ENDIF
y1% = page_y% - margin% + Stave_Height%
y3% = page_y% - margin%
IF PERC% THEN
y3% -= Stave_Height%
ENDIF
stave_n% = 0
WHILE stave_n% < staves_per_page% AND gp% < GateBlock% + GateSize%
y2% = (y3% - score_height% + Stave_Height% / 2)
IF PERC% THEN
y2% -= ((stave_n%+1) * Stave_Height%)
ENDIF
FOR s% = 0 TO STAVE%+PERC%
IF (PERC%) AND (s% = 0) THEN
LINE l_edge%, y2%, r_edge%, y2%
ELSE
LINE l_edge%, y2% - Li% * 4, r_edge%, y2% - Li% * 4
LINE l_edge%, y2% - Li% * 2, r_edge%, y2% - Li% * 2
LINE l_edge%, y2%, r_edge%, y2%
LINE l_edge%, y2% + Li% * 2, r_edge%, y2% + Li% * 2
LINE l_edge%, y2% + Li% * 4, r_edge%, y2% + Li% * 4
ENDIF
y2% = y2% + 3 * Stave_Height%
NEXT s%
y3% = y3% - score_height%
y2% = y1% - Stave_Height%
IF NOT PERC% THEN
y2% -= Stave_Height%
ELSE
y3% = y3% : REM- (2 * Stave_Height%)
ENDIF
IF bar_at_front% AND GP% < GateBlock% + GateSize% THEN
PROCprint_barline(l_edge%, y2%, 0, FALSE)
ENDIF
x1% = l_edge% : REM + (Hi% * 13):
on_page% = TRUE
n_bars% = 0
x% = 0
xs = l_edge%
multiplier = 1
bars_plotted% = 0
IF gp% < end% THEN
PROCfind_last_bar_on_stave (last_pos%, index%, events%, last_x_offset%, n_bars%, r_edge%, l_edge%)
multiplier = (r_edge% - 35) / (last_pos%)
ELSE
PROCprint_barline(r_edge%, y2%, gp%>>6, TRUE)
ENDIF
WHILE gp% < end% AND on_page%
IF gp%?0 THEN
G% = gp%?0
x% = FNnote_posn(current_bar%, current_gate%, x2%) : REM Extract pre-calulated positions
IF x% > last_pos% AND n_bars% = 0 THEN on_page% = FALSE
xs = x% * multiplier
checkstagger% = FALSE
C% = -1
P% = 0
R% = 0
REPEAT
REPEAT
C% += 1
UNTIL G% AND %1 << C%
PROCbound_note(n%(C%))
IF lx0% > P% THEN P% = lx0%
IF lx1% > R% THEN R% = lx1%
NC0% = n%(C%)?0: NC1% = n%(C%)?1
y% = y2% + Y_STAVE%(S_C%(C%))
IF (NC0% AND &F8) THEN
l% = (NC0% >> 3) - 16
IF ABS(l%) > 5 PROCprint_sprite(ledger% + l% DIV 2, xs, y%, factors%)
y% += Li%*l%
s% = NC1% >> 5 OR NC0% << 3 AND 8
IF checkstagger% THEN
IF ABS(lasty% - y%) < 2 * Li% THEN
PROCprint_sprite(s%,xs+Pgap%, y%, note_factors%)
checkstagger% = FALSE
IF NC1% AND 24 PROCprint_sprite(dot%+(NC1%>>3 AND 3), xs + x%(s%) + Pgap%, y%, note_factors%)
IF (NC0% AND &4) THEN PROCprint_tie(xs,y%)
ELSE
PROCprint_sprite(s%, xs, y%, note_factors%)
IF NC1% AND 24 PROCprint_sprite(dot%+(NC1%>>3 AND 3), xs + x%(s%), y%, note_factors%)
IF (NC0% AND &4) THEN PROCprint_tie(xs,y%)
ENDIF
ELSE
PROCprint_sprite(s%, xs, y%, note_factors%)
IF NC1% AND 24 PROCprint_sprite(dot%+(NC1%>>3 AND 3), xs + x%(s%), y%, note_factors%)
IF (NC0% AND &4) THEN PROCprint_tie(xs,y%)
checkstagger%=TRUE
ENDIF
lasty% = y%
IF NC1% AND 7 PROCprint_sprite(accidental% OR NC1% AND 7, xs - x%(s%), y%, note_factors%)
ELSE
s% = rest% OR NC1% >> 5
l% = (NC1% AND &7)
IF l% = 0 THEN l% = 4
y% += Li% * (l% - 4) * 2
PROCprint_sprite(s%, xs, y%, factors%)
IF NC1% AND 24 PROCprint_sprite(dot%+(NC1%>>3 AND 3), xs + x%(s%), y%, note_factors%)
ENDIF
n%(C%)+=NSIZE%
UNTIL (2 << C%) > G%
gp% += 1
current_gate% += 1
IF x% >= last_pos% THEN
on_page% = FALSE
bar_at_front% = FALSE
ELSE
bar_at_front% = TRUE
ENDIF
ELSE
A% = gp%?1
N% = -1: REPEAT N% += 1: UNTIL A% AND %1 << N%
CASE N% OF
WHEN 0
REM Time Sig
sig%(0) = A%
B$ = STR$((A% >> 1 AND 15) + 1)
D$ = STR$(%1 << (A% >> 5) - 1)
x% = FNtime_posn(current_bar%, x2%)
xs = x% * multiplier
w1 = xs
IF LEN B$ < 2 THEN w1 += 5 * Hi%
IF LEN D$ < 2 THEN xs += 5 * Hi%
FOR S% = 0 TO STAVE%+PERC%
PROCprint_sprite(time%+VAL(B$),w1,y2% + Y_STAVE%(S%), note_factors%)
PROCprint_sprite(time%+VAL(D$),w1,y2% + Y_STAVE%(S%)-32, note_factors%)
NEXT S%
WHEN 1
REM Key Sig
x% = FNkey_posn(current_bar%, x2%)
xs = x% * multiplier
IF A% AND 56 sig%(1)=A% ELSE SWAP A%,sig%(1):a%=accidental%+1
N%=(A%>>3AND7)-1
IF N% >= 0 THEN
A%=A%>>2AND%1
IF a% ELSE a%=accidental%+2+A%
W%=x%(a%)+X%(a%)
x%+=x%(a%)
xs = x% * multiplier
FOR C%=0 TO N%
FOR S%=0TOSTAVE%
PROCprint_sprite(a%,xs,y2%+Y_STAVE%(S%)+Li%*Key_Y%(clef%(S%),A%,C%), note_factors%)
NEXT
x%+=W%
xs = x% * multiplier
NEXT
ENDIF
WHEN 2
REM Clef
sig%(0) = A% : REM Hack
S% = A% >> 6
x% = FNclef_posn(current_bar%, x2%)
xs = x% * multiplier
clef%(S%) = (A% >> 3) AND 3
IF S% <= STAVE% PROCprint_sprite(clef% + (A% >> 3 AND 3), xs, y2% + Y_STAVE%(S%), factors%)
WHEN 3
REM Slur
WHEN 4
REM Octave Shift
WHEN 5
REM Barline
x% = FNbar_posn(current_bar%, x2%)
IF x% >= last_pos% THEN
PROCprint_barline(r_edge%, y2%, A%>>6, TRUE)
on_page% = FALSE
IF (current_bar% + 1) MOD 5 = 0 THEN
MOVE r_edge%-2-((1+LEN(STR$(current_bar%+1))-1)*16),y2% + (Y_STAVE%(0) / 2): REM ***
PRINT STR$(current_bar%+1)
ENDIF
ELSE
IF x% = l_edge% THEN
xs = x% - 7: REM &&&
ELSE
xs = x% * multiplier
ENDIF
PROCprint_barline(xs+2, y2%, A%>>6, FALSE)
IF (current_bar% + 1) MOD 5 = 0 THEN
MOVE xs-1-((LEN(STR$(current_bar%+1)))*16),y2% + (Y_STAVE%(0) / 2): REM ***
PRINT STR$(current_bar%+1)
ENDIF
ENDIF
current_bar% += 1
bars_plotted% += 1
ENDCASE
gp% += 2
ENDIF : REM gp%?0
ENDWHILE : REM on_page%
IF gp% >= GateBlock% + GateSize% THEN
PROCprint_barline(r_edge%, y2%, 0, FALSE)
ENDIF
x2% += (last_pos% - l_edge%)
y1% = y1% - score_height%
IF PERC% THEN
y1% = y1% - margin%
ENDIF
stave_n% += 1
ENDWHILE
last_page% = page%
SYS "PDriver_GetRectangle", ,PrintRectangle% TO r0%
ENDWHILE
ENDWHILE
RESTORE ERROR
SYS "PDriver_EndJob", f%
CLOSE#f%
SYS "Hourglass_Off"
ENDPROC
DEF PROCprint_barline (bx%,by%,type%,right%)
LOCAL s%,y%,h%
REM Adjust xpos if along right-hand edge
IF right% THEN bx%=bx%-(X%(bar%+type%)+x%(bar%+type%))+2
FOR s%=0 TO STAVE%+PERC%
REM Get ypos and height
y%=Y_STAVE%(s%)-(Stave_Height% DIV 2)
IF ((STAVE%+1) AND 2) AND s%=STAVE% THEN
h%=Stave_Height%*3
ELSE
h%=Stave_Height%
ENDIF
REM Draw barline
CASE type% OF
WHEN 0:REM Single barline
MOVE bx%,by%+y%
DRAW bx%,by%+y%+h%
WHEN 1:REM Double barline
MOVE bx%,by%+y%
DRAW bx%,by%+y%+h%
RECTANGLE FILL bx%+6,by%+y%,5,h%
ENDCASE
NEXT
ENDPROC
DEF PROCprint_tie (sx%,sy%)
LOCAL s%,g%,span%,oldx%,end%
end%=GateBlock%+GateSize%
IF (NC0% AND &2) THEN s%=tie%+1 ELSE s%=tie%
sx%=sx%-(x%(s%))
sy%=sy%-y%(s%)
g%=gp%+1
span%=1
WHILE g%<=end%
IF ?g% THEN
IF ?g% AND (1<<C%) THEN
g%=end%+1
ELSE
span%+=1
g%+=1
ENDIF
ELSE
g%+=2
ENDIF
ENDWHILE
oldx%=factors%!0
factors%!0=span%
SYS "OS_SpriteOp",SprPlot%,SprBlk%,S%(s%),sx%,sy%,8,factors%,pixtrans%
factors%!0=oldx%
ENDPROC
DEF PROCprint_sprite(s%, X%, Y%, scale_factors%) : REM plot sprite S%(s%) at X%,Y%
LOCAL spr_y, scaled_y, y_add, x_add
spr_y = ((S%(s%)!20) + 1) * (2 / 4) : REM actual height
scaled_y = spr_y * (2 / 4) : REM scaled height
x_add = 0
REM Below are various hack factors to deal with the fact that the sprites are scaled down.
CASE S$(s%) OF
WHEN "Md", "Cd","Qd", "SQd", "DSQd", "SDSQd"
x_add = 6
WHEN "Mu", "Cu", "Qu", "SQu", "DSQu", "SDSQu", "M", "SB", "Natural", "Sharp", "Flat", "Sharp2", "Flat2", "NSharp", "NFlat", "Tie", "Dot1", "Dot2", "Dot3"
y_add = 2 : x_add = 6
WHEN "B"
y_add = 2.5 : x_add = 6
WHEN "Bar"
y_add = -0.5
OTHERWISE
y_add = 0 : x_add = 6
ENDCASE
SYS "OS_SpriteOp", SprPlot%, SprBlk%, S%(s%), X%-(x%(s%)) + x_add, Y% - y%(s%) + y_add, 8, factors%, pixtrans%
ENDPROC
DEF PROCfind_last_bar_on_stave (RETURN last_pos%, RETURN index%, RETURN events%, RETURN last_x_offset%, RETURN n_bars%, r_edge%, l_edge%)
LOCAL loop%, x%, last_x%
x% = l_edge% + PX%(index%) - x2%
WHILE ((index% < GateSize%) AND x% < (r_edge% - 35))
CASE PTYPE%(index%) OF
WHEN 0
IF n_bars% = 0 THEN
last_pos% = x%
ENDIF
events% += 1
WHEN 32
IF x% <> l_edge% THEN
last_pos% = x%
n_bars% += 1
ENDIF
events% += 2
OTHERWISE
IF n_bars% = 0 THEN
last_pos% = x%
ENDIF
events% += 2
ENDCASE
index% += 1
x% = l_edge% + PX%(index%) - x2%
ENDWHILE
IF index% >= GateSize% THEN
last_pos% = r_edge% - 35
ENDIF
ENDPROC
DEF FNnote_posn(bar%, gate%, x2%)
LOCAL loop%, enc%, x%, events%
enc% = 0
loop% = 0
events% = 0
REPEAT
IF PTYPE%(loop%) = 0 THEN
enc% += 1
x% = l_edge% + PX%(loop%) - x2%
ENDIF
loop% += 1
UNTIL (enc% > gate% OR loop% > GateSize%)
= x%
DEF FNclef_posn(bar%, x2%)
LOCAL loop%, enc%, x%, events%
enc% = 0
loop% = 0
events% = 0
REPEAT
IF PTYPE%(loop%) = 4 THEN
enc% += 1
x% = l_edge% + PX%(loop%) - x2%
ENDIF
loop% += 1
UNTIL (enc% >= bar% OR loop% > GateSize%)
= x%
DEF FNkey_posn(bar%, x2%)
LOCAL loop%, enc%, x%, events%
enc% = 0
loop% = 0
events% = 0
REPEAT
IF PTYPE%(loop%) = 2 THEN
enc% += 1
x% = l_edge% + PX%(loop%) - x2%
ENDIF
loop% += 1
UNTIL (enc% >= bar% OR loop% > GateSize%)
= x%
DEF FNbar_posn(bar%, x2%)
LOCAL loop%, enc%, x%, events%
enc% = 0
loop% = 0
events% = 0
REPEAT
IF PTYPE%(loop%) = 32 THEN
enc% += 1
x% = l_edge% + PX%(loop%) - x2%
ENDIF
loop% += 1
UNTIL (enc% > bar% OR loop% > GateSize%)
= x%
DEF FNtime_posn(bar%, x2%)
LOCAL loop%, enc%, x%, events%
enc% = 0
loop% = 0
events% = 0
REPEAT
IF PTYPE%(loop%) = 1 THEN
enc% += 1
x% = l_edge% + PX%(loop%) - x2%
ENDIF
loop% += 1
UNTIL (enc% >= bar% OR loop% > GateSize%)
= x%
REM DEF PROCdebug (a$)
REM
REM LOCAL a%, i%, l%
REM
REM i% = LENa$
REM a% = TRACE
REM IF i% = 0 THEN ENDPROC
REM
REM FOR l% = 1 TO i%
REM BPUT#a%, ASC(MID$(a$, l%, 1))
REM NEXT
REM BPUT#a%, 10
REM BPUT#a%, 13
REM
REM
REM ENDPROC
REM
REM // Wimp //
DEF FNwimp_opentemplates (path$)
REM Opens a Template file and returns buffer for largest definition
LOCAL size%,largest%,next%,w%,s$
SYS "Wimp_OpenTemplate",,path$
largest%=0
s$="*"+STRING$(11,CHR$(0))
SYS "Wimp_LoadTemplate",,0,,,,s$,0 TO ,size%,,,,,next%
WHILE next%
IF size%>largest% THEN largest%=size%
s$="*"+STRING$(11,CHR$(0))
SYS "Wimp_LoadTemplate",,0,,,,s$,next% TO ,size%,,,,,next%
ENDWHILE
DIM w% largest%+16
=w%
DEF FNwimp_loadtemplate (name$,buffer%,sprites%)
REM Loads a window definition from a Template file
LOCAL indarea%,indsize%,s$,window%
s$=name$+CHR$(13)+STRING$(12-LEN(name$)+1,CHR$(0))
SYS "Wimp_LoadTemplate",,0,,,,s$ TO ,,indsize%
DIM indarea% indsize%
SYS "Wimp_LoadTemplate",,buffer%,indarea%,indarea%+indsize%,-1,s$
IF sprites% THEN buffer%!64=sprites%
SYS "Wimp_CreateWindow",,buffer% TO window%
=window%
DEF FNwimp_geticontext (window%,icon%)
REM Gets indirected text from an icon
Block%!0=window%
Block%!4=icon%
SYS "Wimp_GetIconState",,Block%
=$(Block%!28)
DEF PROCwimp_seticontext (window%,icon%,text$)
REM Sets the indirected text in an icon
Block%!0=window%
Block%!4=icon%
SYS "Wimp_GetIconState",,Block%
$(Block%!28)=text$
Block%!8=0
Block%!12=0
SYS "Wimp_SetIconState",,Block%
ENDPROC
DEF FNwimp_geticonstate (window%,icon%,bit%)
REM Returns TRUE if bit is set, FALSE if not
Block%!0=window%
Block%!4=icon%
SYS "Wimp_GetIconState",,Block%
IF (Block%!24 AND (1<<bit%)) THEN =TRUE ELSE =FALSE
DEF PROCwimp_seticonstate (window%,icon%,bit%,action%)
REM Sets an icon state bit
Block%!0=window%
Block%!4=icon%
SYS "Wimp_GetIconState",,Block%
IF action% THEN Block%!8=1<<bit%:Block%!12=1<<bit%
IF NOT action% THEN Block%!8=0:Block%!12=1<<bit%
SYS "Wimp_SetIconState",,Block%
ENDPROC
DEF PROCwimp_seticonval (window%,icon%,text$)
REM Sets the validation string in an indirected icon
Block%!0=window%
Block%!4=icon%
SYS "Wimp_GetIconState",,Block%
$(Block%!32)=text$
Block%!8=0
Block%!12=0
SYS "Wimp_SetIconState",,Block%
ENDPROC
DEF FNwimp_makemenu (title$,items%)
REM Create a menu
LOCAL buffer%,tbuffer%
DIM buffer% 28+(24*items%)
IF LEN(title$)>12 THEN
DIM tbuffer% LEN(title$)+1
buffer%!0=tbuffer%
buffer%!4=0
buffer%!8=LEN(title$)+1
$(tbuffer%)=title$
ELSE
$(buffer%)=title$
ENDIF
buffer%!12=&00070207
buffer%!16=80
buffer%!20=44
buffer%!24=0
=buffer%
DEF PROCwimp_additem (menu%,item%,flags%,link%,text$)
REM Add a menu item
LOCAL buffer%
menu%!(28+(item%*24))=flags%
menu%!(28+(item%*24)+4)=link%
IF LEN(text$)>12 THEN
DIM buffer% LEN(text$)+1
menu%!(28+(item%*24)+8)=&07000121
menu%!(28+(item%*24)+12)=buffer%
menu%!(28+(item%*24)+16)=0
menu%!(28+(item%*24)+20)=LEN(text$)+1
$(buffer%)=text$
ELSE
menu%!(28+(item%*24)+8)=&07000021
$(menu%+28+(item%*24)+12)=text$
ENDIF
ENDPROC
DEF FNwimp_getmenutext (menu%,item%)
REM Gets indirected text from a menu item
LOCAL menuptr%,indarea%,text$
menuptr%=menu%+28
menuptr%+=item%*24
indarea%=menuptr%!12
text$=$(indarea%)
=text$
DEF PROCwimp_setmenutext (menu%,item%,text$)
REM Sets the indirected text in an menu item
LOCAL menuptr%,indarea%
menuptr%=menu%+28
menuptr%+=item%*24
indarea%=menuptr%!12
$(indarea%)=text$
ENDPROC
DEF FNwimp_getmenustate (menu%,item%,bit%)
REM Gets a menu item's flag state
LOCAL menuptr%
menuptr%=menu%+28+(item%*24)
IF ?menuptr% AND (1<<bit%) THEN =TRUE ELSE =FALSE
DEF PROCwimp_setmenustate (menu%,item%,bit%,state%)
REM Sets a menu item's flags
LOCAL menuptr%
menuptr%=menu%+28+(item%*24)
CASE bit% OF
WHEN 0,1,2,3,4,7,8:
IF state% THEN menuptr%!0=menuptr%!0 OR (1<<bit%)
IF NOT state% THEN menuptr%!0=menuptr%!0 AND NOT (1<<bit%)
WHEN 22:
IF state% THEN menuptr%!8=menuptr%!8 OR (1<<bit%)
IF NOT state% THEN menuptr%!8=menuptr%!8 AND NOT (1<<bit%)
ENDCASE
ENDPROC
DEF PROCwimp_radiotick (menu%,item%)
REM Ticks one menu item and unticks the rest
LOCAL menuptr%,i%
menuptr%=menu%+4
REPEAT
menuptr%+=24
IF i%=item% THEN
menuptr%!0=menuptr%!0 OR (1<<0)
ELSE
menuptr%!0=menuptr%!0 AND NOT (1<<0)
ENDIF
i%+=1
UNTIL menuptr%!0 AND &80
ENDPROC
DEF PROCwimp_opendialogue (dialogue%,window%,type%)
REM Opens a dialogue box centred over a window/over iconbar
REM type%=0 transient; type%=1 persistent
LOCAL x%,y%,dwidth%,dheight%,width%,height%
Block%!0=dialogue%
SYS "Wimp_GetWindowState",,Block%
dwidth%=Block%!12-Block%!4
dheight%=Block%!16-Block%!8
IF window%=-2 THEN
Block%!0=window%
Block%!4=IconHandle%
SYS "Wimp_GetIconState",,Block%
x%=Block%!8-64 :REM Same x-offset as default menu
y%=dheight%+136 :REM Iconbar height + 40
ELSE
Block%!0=window%
SYS "Wimp_GetWindowState",,Block%
x%=Block%!4
y%=Block%!16
width%=Block%!12-x%
height%=y%-Block%!8
x%=x%+(width% DIV 2)-(dwidth% DIV 2)
y%=y%-(height% DIV 2)+(dheight% DIV 2)
ENDIF
CASE type% OF
WHEN 0:REM Open transient dialogue box
SYS "Wimp_CreateMenu",,dialogue%,x%,y%
WHEN 1:REM Open persistent dialogue box
Block%!0=dialogue%
Block%!4=x%
Block%!8=y%-dheight%
Block%!12=x%+dwidth%
Block%!16=y%
Block%!20=0
Block%!24=0
Block%!28=-1
SYS "Wimp_OpenWindow",,Block%
ENDCASE
ENDPROC
DEF PROCwimp_closedialogue (dialogue%,window)
REM Closes a persistent dialogue box and returns focus to window
Block%!0=dialogue%
SYS "Wimp_CloseWindow",,Block%
Block%!0=window%
SYS "Wimp_GetWindowState",,Block%
IF Block%!32 AND (1<<16) THEN
SYS "Wimp_SetCaretPosition",window%,-1
ENDIF
ENDPROC
DEF FNwimp_popup (window%,menu%,icon%)
REM Opens a popup menu and returns menu handle
LOCAL x%,y%
Block%!0=window%
SYS "Wimp_GetWindowState",,Block%
x%=Block%!4
y%=Block%!16
Block%!4=icon%
SYS "Wimp_GetIconState",,Block%
x%=x%+Block%!16
y%=y%+Block%!20
SYS "Wimp_CreateMenu",,menu%,x%,y%
=menu%
REM // Heap //
DEF FNheap_init (size%)
REM Sets up the Heap
REM Returns the Heap pointer if successful, 0 if error
LOCAL heap%,heapsize%
heapsize%=FNheap_getmemory(0,size%)
IF heapsize%>0 THEN
heap%=HIMEM
SYS "OS_Heap",0,heap%,,heapsize%
ENDIF
=heap%
DEF FNheap_newblock (heap%,size%)
REM Creates a new Block within the Heap
REM Returns Block pointer if successful, 0 if error
LOCAL free%,block%,heapsize%
IF size%=0 THEN =0
IF heap%=0 THEN =0
heapsize%=1
SYS "OS_Heap",1,heap% TO ,,free%
IF free%<size% THEN heapsize%=FNheap_getmemory(heap%,size%-free%)
IF heapsize%>0 THEN SYS "OS_Heap",2,heap%,,size% TO ,,block%
=block%
DEF FNheap_resizeblock (heap%,RETURN block%,change%)
REM Resizes a Block
REM Updates the Block pointer
REM Returns 0 if Block could not be extended, otherwise TRUE
LOCAL flags%,page%,heapsize%,success%
success%=TRUE
SYS "OS_ReadMemMapInfo" TO page%
REPEAT
SYS "XOS_Heap",4,heap%,block%,change% TO ,,block%;flags%
IF (flags% AND &1) THEN
heapsize%=FNheap_getmemory(heap%,page%)
IF heapsize%=0 THEN success%=FALSE
ENDIF
UNTIL (flags% AND &1)=0 OR success%=FALSE
IF success%=TRUE THEN
IF change%<0 THEN PROCheap_losememory(heap%)
ENDIF
=success%
DEF PROCheap_freeblock (heap%,block%)
REM Deletes a Block and frees memory
SYS "OS_Heap",3,heap%,block%
PROCheap_losememory(heap%)
ENDPROC
DEF FNheap_getblocksize (heap%,block%)
REM Returns a Block's size
LOCAL size%
SYS "OS_Heap",6,heap%,block% TO ,,,size%
REM Reduce value by size of block header
size%-=4
=size%
DEF FNheap_getmemory (heap%,memory%)
REM Claims memory and extends WimpSlot
REM If heap%=0 then create a new heap
REM Otherwise, take/release memory from the specified heap
REM Returns the size of Heap if successful, 0 if error
LOCAL old%,new%,heapsize%
SYS "Wimp_SlotSize",-1,-1 TO old%
SYS "Wimp_SlotSize",old%+memory%,-1 TO new%
IF new%<old%+memory% THEN
SYS "Wimp_SlotSize",old%,-1
ELSE
IF heap% THEN SYS "OS_Heap",5,heap%,,new%-old%
heapsize%=new%+&8000-HIMEM
ENDIF
=heapsize%
DEF PROCheap_losememory (heap%)
REM Returns memory and shrinks WimpSlot
LOCAL change%,flags%,old%,page%
SYS "OS_ReadMemMapInfo" TO page%
SYS "Wimp_SlotSize",-1,-1 TO old%
REPEAT
SYS "XOS_Heap",5,heap%,,-page% TO ,,,change%;flags%
IF (flags% AND &1) THEN
SYS "OS_Heap",5,heap%,,change%
ELSE
SYS "Wimp_SlotSize",old%-page%,-1
ENDIF
UNTIL (flags% AND &1)
ENDPROC