**************************************************************** * * Don't Fret! 1.3 * * copyright 1996, 1997 Kelvin Sherlock * ALL RIGHTS RESERVED. * * **************************************************************** case on mcopy fret.mac copy fret.equ Dont_Fret START using DFDat phb phk plb _TLStartup pha _MMStartup pla sta MyID pha pha pha ;;MyID pea RefIsResource pea $0000 pea kStartStopID _StartUpTools pla sta ToolListRef pla sta ToolListRef+2 bcs Bad ;;tool error jsl InitGlobals jsl MakeMenus jsl OpenWindows ;open the windows _InitCursor jsl HandleMessage jsl MainEvent Bad anop pea RefIsHandle lda ToolListRef+2 pha lda ToolListRef pha _ShutDownTools lda MyID pha _MMShutdown _TLShutdown plb _QuitGS QuitParms Dont_Fret END * Draw the pretty menu bars *inputs: none *outputs: none MakeMenus START kMenuBarID equ 1 pha ;;space for handle pha ~NewMenuBar2 #2,#kMenuBarID,#0 _SetSysBar ~SetMenuBar #0 ~FixAppleMenu #kAppleMID pha _FixMenuBar pla _DrawMenuBar ~CheckMItem #TRUE,#kAItem rtl MakeMenus END *procedure adjust *Takes the notes in word Notes, transposes them to the proper key, *and saves them in word NewNotes (used for doing the actual drawing *better watch out, cause x,y, and a registers are overwritten. * * inputs (stack, for reentrency) * * |prev stuff * ------------ * | word notes 6,S * ------------ * | word key 4,S * ------------ * |rtl 1,S * * outputs: A -the adjusted notes * Adjust START notes equ $6 key equ $4 Ab equ 2048 tsc ;;set up a dpage phd tcd lda notes ldx key loop anop cpx #0 beq done asl a bit #$f000 beq ok and #$0fff ;strip hi bits ora #$0001 ;add note 'A' ok anop dex bra loop done anop pld ;;restore the old dpage tax ;;save the new notes lda 2,S ;;fix return address sta 6,S pla sta 3,S pla txa ;;restore notes for returning rtl Adjust END * *Set the Active flag to zero and close the window (if needed) * DoClose Start lda Active beq Done stz Active lda ChordWinPtr+2 pha lda ChordWinPtr pha _CloseWindow Done rtl DoClose End ************************************** * * Initialize the globals for safety * ************************************** InitGlobals Start using DFDat stz Active stz Quit stz key ;A is default stz Capo stz Mode lda #kMajor sta Type ;Major lda #kIonianS sta Scale lda #6 sta strcount ;# of strings stz LowFret lda #13 sta HiFret lda #An+Db+E ;AMajor sta notes sta newnotes lda #E sta stringsSTD lda #An sta stringsSTD+2 lda #D sta stringsSTD+4 lda #G sta stringsSTD+6 lda #B sta stringsSTD+8 lda #E sta stringsSTD+10 rtl InitGlobals End ****************************************************** * * * Enable Chords stuff * * * * * ****************************************************** DoChords Start using DFDat lda Mode bne switch brl done switch anop stz Mode ~SetMenuFlag #enableMenu,#kTypeMID ~SetMenuFlag #enableMenu,#kExtrasMID ~SetMenuFlag #disableMenu,#kScalesMID ~HiliteMenu #FALSE,#kTypeMID ~HiliteMenu #FALSE,#kExtrasMID ~HiliteMenu #FALSE,#kScalesMID lda #An+Db+E sta notes jsr DoMajorItem ~CheckMItem #FALSE,#kSus2 ~CheckMItem #FALSE,#kb3rd ~CheckMItem #FALSE,#kSus4 ~CheckMItem #FALSE,#k6th ~CheckMItem #FALSE,#k7th ~CheckMItem #FALSE,#kMaj7 done anop rtl DoChords End ****************************************************** * * * Scale Mode * * * * * ****************************************************** DoScales Start using DFDat lda Mode bne done inc Mode ~SetMenuFlag #disableMenu,#kTypeMID ~SetMenuFlag #disableMenu,#kExtrasMID ~SetMenuFlag #enableMenu,#kScalesMID ~HiliteMenu #FALSE,#kTypeMID ~HiliteMenu #FALSE,#kExtrasMID ~HiliteMenu #FALSE,#kScalesMID lda Scale jsr DoEachScale done anop rtl DoScales End DrawOptions Start ~DrawControls OptionWinPtr rtl DrawOptions End DFDat DATA QuitParms dc i2'2' dc i4'0' ; Pathname of next app dc i2'$00' ; flags ToolListRef ds 4 ; MyID entry ds 2 ; from MM MyPrRecPtr dc i4'MyPrRec' MyPrRec ds 140 PortGraf ds 4 Type entry ds 2 ; what type of chord (menu #) Scale entry ds 2 ; which scale is checked (menu #) Mode entry ds 2 ; which mode (1=scales, 0=chords) RWOS entry ReadDCB_pcount dc i2'5' ReadDCB_refNum ds 2 ReadDCB_dataBuffer ds 4 ReadDCB_requestCount dc i4'18' ReadDCB_transferCount dc i4'0' ReadDCB_cachePriority dc i4'0' CloseOS entry CloseDCB_pcount dc i2'1' CloseDCB_refNum ds 2 OpenOS entry OpenDCB_pcount dc i2'15' OpenDCB_refNum ds 2 OpenDCB_pathName ds 4 OpenDCB_requestAccess dc i2'3' OpenDCB_resourceNumber dc i2'0' OpenDCB_access ds 2 OpenDCB_fileType ds 2 OpenDCB_auxtype ds 4 OpenDCB_storageType ds 2 OpenDCB_createDateTime ds 8 OpenDCB_modDateTime ds 8 OpenDCB_optionList ds 4 OpenDCB_dataEOF ds 4 OpenDCB_blocksUsed ds 4 OpenDCB_resourceEOF ds 4 OpenDCB_resourceBlocks ds 4 DestroyOS entry DestroyDCB_pcount dc i2'1' DestroyDCB_pathName ds 4 CreateOS entry CreateDCB_pcount dc i2'7' CreateDCB_pathName ds 4 CreateDCB_access dc i2'$e3' CreateDCB_fileType dc i2'MyFileType' CreateDCB_auxType dc i4'MyAuxType' CreateDCB_storageType dc i2'1' CreateDCB_dataEOF dc i4'0' CreateDCB_resourceEOF dc i4'0' TypeList entry ;;type list for saved tunings dc i2'1' dc i2'0' dc i2'MyFileType' dc i4'MyAuxType' MyReplyRec entry MyReplyRec_good ds 2 MyReplyRec_fileType ds 2 MyReplyRec_auxFileType ds 4 MyReplyRec_nameVerb dc i2'0' ;;pointer MyReplyRec_nameRef dc i4'SFname' MyReplyRec_pathVerb dc i2'0' ;;pointer MyReplyRec_pathRef dc i4'SFpath' DefaultOut entry ;;default naem for a new file gstr 'NewTuning' SFname entry dc i2'32' SFname_string ds 2 ds 32 SFpath entry dc i2'255' SFpath_string ds 2 ds 255 DFDat End swap START rtlb equ 1 Data equ 5 phb tsc phd tcd pei Data+2 ; set the db plb plb lda (Data) ; ByteOrder xba sta (Data) ldy #2 lda (Data),y ; Version xba sta (Data),y ldy #4 lda (Data),y ; Capo xba sta (Data),y ldy #16 lda (Data),y ; String Count xba sta (Data),y ldy #18 ; offset to 1st string tax beq d_loop loop lda (Data),y xba sta (Data),y iny iny dex bne loop d_loop anop lda (Data),y ; Comment Length xba sta (Data),y pld pla sta 3,s pla sta 3,s plb rtl swap END