unit FrmMain; { © COPYRIGHT 1999 .. 2014 Blue Hell / Jan Punter This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License version 2 as published by the Free Software Foundation; This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA For all listed email addresses : _dot. to be substituted by a dot '.' 2@t2 to be substituted by an at sign '@' Blue Hell is a trade mark owned by Jan Punter Oogstplein 6 7545 HP Enschede the Netherlands http://www.iaf.nl/Users/BlueHell/ http://bluehell.electro-music.com/ j_dot.punter2@t2iaf_dot.nl All rights attributed to Blue Hell are owned by Jan Punter. +-----------------------------------------------------------------+ + HrastUnit courtesy HrastProgrammer, please note the distinctive + + copyright notice in that file. + +-----------------------------------------------------------------+ } interface uses WinApi.Windows, WinApi.Messages, Winapi.CommCtrl, System.SysUtils, System.UITypes, System.TypInfo, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ExtCtrls, Vcl.ComCtrls, VCLTee.Chart, VCLTee.Series, System.IniFiles, WinApi.MMSystem, System.Math, Vcl.Menus, Vcl.Samples.Spin, WinApi.ShellApi, Vcl.Imaging.jpeg, VclTee.TeeGDIPlus, VCLTee.TeeProcs, VCLTee.TeEngine, System.Win.Registry, Vcl.Imaging.pngimage, OverbyteIcsWndControl, OverbyteIcsWSocket, Vcl.Mask, JvExMask, JvToolEdit, KnobsConversions, KnobsUtils, Globals, FrmStore, wave_dlg, KnobParser, AudioIO, CpuUsage, module_defs, module_implementations, knobs2013, Rationals, scala, HrastUnit; type // Some stuff to fix the border width for TPageControls TPageControl = class( Vcl.ComCtrls.TPageControl) private procedure TCMAdjustRect(var Msg: TMessage); message TCM_ADJUSTRECT; end; TMidiRxState = ( mrxNormal, mrxRunningStatus ); TFormModules = class(TForm) PanelControl: TPanel; Label1: TLabel; Label2: TLabel; TimerStatsUpdate: TTimer; PanelMain: TPanel; PageControlMain: TPageControl; TabSheetDebug: TTabSheet; PanelDebug: TPanel; LabelIOBalance: TLabel; BitBtnClear: TBitBtn; BitBtnDump: TBitBtn; SaveDialogPatch: TSaveDialog; BitBtnDocument: TBitBtn; TabSheetEditor: TTabSheet; OpenDialogPatch: TOpenDialog; MainMenu1: TMainMenu; MenuFile: TMenuItem; MenuFileLoad: TMenuItem; MenuFileSave: TMenuItem; MenuEdit: TMenuItem; N1: TMenuItem; MenuFileExit: TMenuItem; MenuEditDelete: TMenuItem; MenuEditCut: TMenuItem; MenuEditCopy: TMenuItem; MenuEditPaste: TMenuItem; N2: TMenuItem; MenuEditSelectAll: TMenuItem; MenuEditInvertSelection: TMenuItem; N3: TMenuItem; MenuEditUndo: TMenuItem; MenuEditRedo: TMenuItem; MenuFileSaveAs: TMenuItem; N4: TMenuItem; MenuEditWiggleWires: TMenuItem; MenuSetup: TMenuItem; MenuSetupDevices: TMenuItem; MenuFileNew: TMenuItem; BitBtnShowDesigner: TBitBtn; BitBtnDebugStep: TBitBtn; BitBtnDebugRun: TBitBtn; BitBtnDebugReset: TBitBtn; MenuHelp: TMenuItem; MenuHelpHelp: TMenuItem; N5: TMenuItem; MenuSetupSettings: TMenuItem; BitBtnAudioRunning: TBitBtn; PageControlDGSA: TPageControl; TabSheetText: TTabSheet; TabSheetGraph: TTabSheet; MemoDebug: TMemo; ChartDebug: TChart; BitBtnClearGraph: TBitBtn; CheckBoxUseGraph: TCheckBox; CheckBoxGraphStairs: TCheckBox; TabSheetSettings: TTabSheet; PanelSettings: TPanel; MenuView: TMenuItem; MenuViewEditor: TMenuItem; MenuViewDebugger: TMenuItem; MenuViewGraphs: TMenuItem; MenuViewSettings: TMenuItem; BitBtnCloseDubugger: TBitBtn; LabelOverflows: TLabel; LabelUnderflows: TLabel; TabSheetAbout: TTabSheet; MenuViewAbout: TMenuItem; MenuHelpAbout: TMenuItem; Panelabout: TPanel; PanelAboutRight: TPanel; MemoAbout: TMemo; PanelAboutLeft: TPanel; Label7: TLabel; PanelWren: TPanel; ImageWren: TImage; Label8: TLabel; Label9: TLabel; LabelProgramVersion: TLabel; LabelPatchVersion: TLabel; N7: TMenuItem; N8: TMenuItem; MenuFileReopen: TMenuItem; KnobOutVolume: TKnobsKnob; KnobInVolume: TKnobsKnob; IndicatorBarVolumeInLeft: TKnobsIndicatorBar; IndicatorBarVolumeInRight: TKnobsIndicatorBar; IndicatorBarVolumeOutLeft: TKnobsIndicatorBar; IndicatorBarVolumeOutRight: TKnobsIndicatorBar; GroupBoxEditorSettings: TGroupBox; Label12: TLabel; KnobsDisplayOffsetLeft: TKnobsDisplay; KnobsDisplayOffsetTop: TKnobsDisplay; Label13: TLabel; KnobsSmallKnobOffsetLeft: TKnobsNoKnob; KnobsSmallKnobOffsetTop: TKnobsNoKnob; LabeldBIn: TLabel; LabeldbOut: TLabel; MenuAction: TMenuItem; MenuActionRunStop: TMenuItem; OpenDialogWave: TOpenDialog; PanelEditorTop: TPanel; SelectNone1: TMenuItem; Bevel4: TBevel; Bevel5: TBevel; Bevel6: TBevel; Bevel7: TBevel; EditorPatch: TKnobsWirePanel; Label14: TLabel; WSocketNetMidi: TWSocket; RadioGroupControlMode: TRadioGroup; CheckBoxCurvedLines: TCheckBox; Label15: TLabel; GroupBoxNetMidi: TGroupBox; Label16: TLabel; Label17: TLabel; EditNetMidiServer: TEdit; EditNetMidiPort: TEdit; BitBtnApplyNetMidi: TBitBtn; BitBtnCancelNetMidi: TBitBtn; BitBtnNetMidiConnect: TBitBtn; CheckBoxNetMidiAutoConnect: TCheckBox; TimerNetMidiConnect: TTimer; LedNetMidiConnect2: TKnobsLed; LedNetMidiTx2: TKnobsLed; LedNetMidiRx2: TKnobsLed; Label23: TLabel; Label22: TLabel; Label21: TLabel; LedNetMidiConnect1: TKnobsLed; LedNetMidiTx1: TKnobsLed; LedNetMidiRx1: TKnobsLed; Label20: TLabel; Label19: TLabel; Label18: TLabel; Label6: TLabel; CheckBoxReloadLastPatch: TCheckBox; CheckBoxAutoRun: TCheckBox; Panel3: TPanel; ModuleSelector: TKnobsModuleSelector; EditPatchName: TEdit; LabelRunTime: TLabel; SpinButtonWureThickness: TSpinButton; LabelCpuUsage: TLabel; Label3: TLabel; EditSearch: TEdit; Help1: TMenuItem; Profile1: TMenuItem; BitBtnProfile: TBitBtn; N6: TMenuItem; Find1: TMenuItem; Label10: TLabel; Label24: TLabel; CheckBoxLogMidi: TCheckBox; CheckBoxLogMidiMsgs: TCheckBox; CheckBoxCompilerDebug: TCheckBox; BitBtnTest: TBitBtn; GroupBoxTuning: TGroupBox; Label4: TLabel; Label5: TLabel; Label11: TLabel; Label25: TLabel; EditReferenceA: TEdit; EditNotesPerOctave: TEdit; EditMiddleNote: TEdit; RadioGroupPrioLevel: TRadioGroup; Label26: TLabel; JvFilenameEditScalaScaleFile: TJvFilenameEdit; Label27: TLabel; JvFilenameEditScalaMappingFile: TJvFilenameEdit; Bevel1: TBevel; Label28: TLabel; PopupMenuConnector: TPopupMenu; DeleteConnector: TMenuItem; BreakWire: TMenuItem; DisconnectConnector: TMenuItem; CheckBoxWarnOnPatchChange: TCheckBox; BitBtnSynthReset: TBitBtn; PopupMenuModule: TPopupMenu; CopyModule: TMenuItem; CutModule: TMenuItem; DeleteModule: TMenuItem; PopupMenuKnob: TPopupMenu; SetKnobDefaultvalue: TMenuItem; LockKnob: TMenuItem; procedure BitBtnExItClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure BitBtnDebugStepClick(Sender: TObject); procedure BitBtnClearClick(Sender: TObject); procedure BitBtnClearGraphClick(Sender: TObject); procedure BitBtnDebugRunClick(Sender: TObject); procedure CheckBoxUseGraphClick(Sender: TObject); procedure BitBtnDebugResetClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure CheckBoxGraphStairsClick(Sender: TObject); procedure BitBtnDumpClick(Sender: TObject); procedure KnobOutVolumeValueChanged(aSender: TObject; const aPath, aControlType: string; aValue: Double; IsFinal: Boolean); procedure KnobInVolumeValueChanged(aSender: TObject; const aPath, aControlType: string; aValue: Double; IsFinal: Boolean); procedure TimerStatsUpdateTimer(Sender: TObject); procedure FormCreate(Sender: TObject); procedure CheckBoxReloadLastPatchClick(Sender: TObject); procedure CheckBoxAutoRunClick(Sender: TObject); procedure BitBtnDocumentClick(Sender: TObject); procedure ModuleSelectorModuleButtonClick(aSender: TObject; aModuleclass: Integer); procedure MenuFileLoadClick(Sender: TObject); procedure MenuFileSaveClick(Sender: TObject); procedure MenuFileSaveAsClick(Sender: TObject); procedure MenuFileExitClick(Sender: TObject); procedure MenuEditDeleteClick(Sender: TObject); procedure MenuEditCutClick(Sender: TObject); procedure MenuEditCopyClick(Sender: TObject); procedure MenuEditPasteClick(Sender: TObject); procedure MenuEditSelectAllClick(Sender: TObject); procedure MenuEditInvertSelectionClick(Sender: TObject); procedure MenuEditUndoClick(Sender: TObject); procedure MenuEditRedoClick(Sender: TObject); procedure MenuEditWiggleWiresClick(Sender: TObject); procedure MenuSetupDevicesClick(Sender: TObject); procedure MenuFileNewClick(Sender: TObject); procedure SpinButtonWureThicknessUpClick(Sender: TObject); procedure SpinButtonWureThicknessDownClick(Sender: TObject); procedure CheckBoxCurvedLinesClick(Sender: TObject); procedure BitBtnShowDesignerClick(Sender: TObject); procedure MenuHelpHelpClick(Sender: TObject); procedure MenuSetupSettingsClick(Sender: TObject); function ModuleSelectorGetGlyph(aSender: TObject; const aName: string): TBitmap; procedure BitBtnAudioRunningClick(Sender: TObject); procedure RadioGroupPrioLevelClick(Sender: TObject); procedure BitBtnCloseDubuggerClick(Sender: TObject); procedure MenuViewEditorClick(Sender: TObject); procedure MenuViewDebuggerClick(Sender: TObject); procedure MenuViewGraphsClick(Sender: TObject); procedure MenuViewSettingsClick(Sender: TObject); procedure MenuViewAboutClick(Sender: TObject); procedure MenuHelpAboutClick(Sender: TObject); procedure EditPatchNameChange(Sender: TObject); procedure EditNotesPerOctaveChange(Sender: TObject); procedure EditReferenceAChange(Sender: TObject); procedure BitBtnProfileClick(Sender: TObject); procedure KnobsSmallKnobOffsetLeftValueChanged(aSender: TObject; const aPath, aControlType: string; aValue: Double; IsFinal: Boolean); procedure KnobsSmallKnobOffsetTopValueChanged(aSender: TObject; const aPath, aControlType: string; aValue: Double; IsFinal: Boolean); procedure MenuActionRunStopClick(Sender: TObject); procedure SelectNone1Click(Sender: TObject); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure RadioGroupControlModeClick(Sender: TObject); procedure BitBtnNetMidiConnectClick(Sender: TObject); procedure CheckBoxNetMidiAutoConnectClick(Sender: TObject); procedure BitBtnApplyNetMidiClick(Sender: TObject); procedure BitBtnCancelNetMidiClick(Sender: TObject); procedure EditNetMidiServerChange(Sender: TObject); procedure EditNetMidiPortChange(Sender: TObject); procedure TimerNetMidiConnectTimer(Sender: TObject); procedure WSocketNetMidiBgException(Sender: TObject; E: Exception; var CanClose: Boolean); procedure WSocketNetMidiChangeState(Sender: TObject; OldState, NewState: TSocketState); procedure WSocketNetMidiDataAvailable(Sender: TObject; ErrCode: Word); procedure WSocketNetMidiDataSent(Sender: TObject; ErrCode: Word); procedure WSocketNetMidiError(Sender: TObject); procedure WSocketNetMidiSessionClosed(Sender: TObject; ErrCode: Word); procedure WSocketNetMidiSessionConnected(Sender: TObject; ErrCode: Word); procedure CheckBoxLogMidiClick(Sender: TObject); procedure CheckBoxLogMidiMsgsClick(Sender: TObject); procedure EditSearchChange(Sender: TObject); procedure CheckBoxCompilerDebugClick(Sender: TObject); procedure Profile1Click(Sender: TObject); procedure Find1Click(Sender: TObject); procedure EditMiddleNoteChange(Sender: TObject); procedure BitBtnTestClick(Sender: TObject); procedure JvFilenameEditScalaScaleFileAfterDialog(Sender: TObject; var AName: string; var AAction: Boolean); procedure JvFilenameEditScalaScaleFileBeforeDialog(Sender: TObject; var AName: string; var AAction: Boolean); procedure JvFilenameEditScalaMappingFileAfterDialog(Sender: TObject; var AName: string; var AAction: Boolean); procedure JvFilenameEditScalaMappingFileBeforeDialog(Sender: TObject; var AName: string; var AAction: Boolean); procedure DeleteConnectorClick(Sender: TObject); procedure BreakConnectorClick(Sender: TObject); procedure DisconnectConnectorClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure CheckBoxWarnOnPatchChangeClick(Sender: TObject); procedure BitBtnSynthResetClick(Sender: TObject); procedure CutModuleClick(Sender: TObject); procedure CopyModuleClick(Sender: TObject); procedure DeleteModuleClick(Sender: TObject); procedure SetKnobDefaultvalueClick(Sender: TObject); procedure LockKnobClick(Sender: TObject); private // BOHM ProcessingFrequency,ProcessingTime,ProcessingSamples: Int64; // EOHM FOldMemoDebug : TWndMethod; private FIniLoaded : Boolean; // True on successful load of ini file - no auto ini save when false FPrioLevel : Integer; FUseGraph : Boolean; FGraphStairs : Boolean; FHistoryCount : Integer; FRecentSourceFiles : TRecentStrings; FOrigCaption : string; FReloadLastPatch : Boolean; FAutoRun : Boolean; FPatchChanged : Boolean; FWarnOnPatchChange : Boolean; FPopupSender : TControl; private FNetMidiServer : string; FNetMidiPort : string; FNetMidiAutoConnect : Boolean; FNetMidiConnected : Boolean; FNetMidiChanged : Boolean; FLogMidi : Boolean; FLogMidiMsgs : Boolean; private FCompilerDebug : Boolean; FDebugRunning : Boolean; FSynthPatch : TSynthPatch; FChartSeries : array of TFastLineSeries; FTime : Cardinal; FUpdateCounter : Integer; private FSelectedInputId : DWORD; FSelectedOutputId : DWORD; FAudioIn : TAudioIn; FAudioOut : TAudioOut; FBalance : Int64; FPatchReader : IKnobsPatchReader; FPatchWriter : IKnobsPatchWriter; private FStartTime : TDateTime; FInShadow : TSignal; FOutShadow : TSignal; FInVolume : TSignal; FOutVolume : TSignal; FAudioRunning : Boolean; private FWireThickness : Integer; FCurvedLines : Boolean; FControlMode : TDistanceMode; private FdBInMax : TSignal; FdBOutMax : TSignal; private FCpuUsageData : PCPUUsageData; FProcessTime : Single; private FMidiRxState : TMidiRxState; // Either mrxNormal or mrxRunningStatus FMidiRunningStatus : Byte; // Current running status - a midi command FMidiDataCount : Integer; // Number of bytes received dofar, for current midi message FMidiChannel : Byte; // Channel for current midi message FMidiData : Byte; // last received midi data septet FMidiSysex : TBytes; // Buffer for incoming sysex message private FScalaScaleFile : TScalaScaleFile; FScalaMappingFile : TScalaMappingFile; private procedure UpdateCaption; private function GetOffsetLeft : Integer; procedure SetOffsetLeft ( aValue: Integer); function GetOffsetTop : Integer; procedure SetOffsetTop ( aValue: Integer); procedure SetPrioLevel ( aValue: Integer); procedure SetUseGraph ( aValue: Boolean); procedure SetGraphStairs ( aValue: Boolean); procedure SetHistoryCount ( aValue: Integer); function GetSourceFileName : string; procedure SetSourceFileName ( const aValue: string); function GetPatchName : string; procedure SetPatchName ( const aValue: string); procedure SetReloadLastPatch ( aValue: Boolean); procedure SetAutoRun ( aValue: Boolean); procedure SetPatchChanged ( aValue: Boolean); procedure SetWarnOnPatchChange( aValue: Boolean); private procedure SetNetMidiServer ( const aValue: string); procedure SetNetMidiPort ( const aValue: string); procedure SetNetMidiAutoConnect( aValue: Boolean); procedure SetNetMidiConnected ( aValue: Boolean); procedure SetNetMidiChanged ( aValue: Boolean); procedure SetLogMidi ( aValue: Boolean); procedure SetLogMidiMsgs ( aValue: Boolean); procedure SetCompilerDebug ( aValue: Boolean); private function GetInVolume : Integer; procedure SetInVolume ( aValue: Integer); function GetOutVolume : Integer; procedure SetOutVolume ( aValue: Integer); procedure SetAudioRunning( aValue: Boolean); private procedure OpenRecentFile( const anIndex: Integer); procedure DorecentMenuItemClick( aSender: TObject); procedure AddrecentMenuItem( anIndex: Integer; const aFileName: string); procedure RemoveRecentMenuItems; procedure SetRecentMenuItems; procedure SetMostRecentFile( const aFileName: string); procedure LoadIni; procedure SaveIni; procedure ShowHelp; function MustMakeDocs: Boolean; procedure MakeDocs( const aFolder : string); private procedure Log( const aMsg: string); procedure LogFmt( const aFmt: string; const anArgs: array of const); procedure MidiLog( const aMsg: string); procedure MidiLogFmt( const aFmt: string; const anArgs: array of const); procedure MidiMsgLog( const aMsg: string); procedure MidiMsgLogFmt( const aFmt: string; const anArgs: array of const); procedure DebugPerformance( const aMsg: string; aTime_ms, aSampleCount: Cardinal); function CountModules: Integer; function CountWires: Integer; procedure ClearMemo; procedure ClearGraphs; procedure BuildGraphs; procedure ShowPatch; procedure ProfilePatch; function ChangeSynthPatch( const aSynthPatch: TSynthPatch): Boolean; procedure ExecutePatch; procedure ChartOutput( anIndex: Integer; aValue: TSignal); procedure ChartOoutputs; procedure DebugRunStop; procedure EnableDebugButtons( anEnable: Boolean); private procedure DeZipper; function HandleAudioInOnBufferFilled( aBuffer: pAnsiChar; var aSize: Integer): Boolean; function HandleAudiOutOnFillBuffer ( aBuffer: pAnsiChar; var aSize: Integer): Boolean; procedure HandleAudiInOnStart ( aSender: TObject); procedure HandleAudiInOnStop ( aSender: TObject); procedure HandleAudiOutOnStart ( aSender: TObject); procedure HandleAudiOutOnStop ( aSender: TObject); procedure CreateDevices; procedure FreeDevices; procedure HookDevices; procedure UnhookDevices; procedure StopAudioIo; procedure StartAudioIo; procedure VerifyDevices; procedure SelectDevices; procedure ClearVolumeIndicators; procedure ShowOverUnderFlows; procedure ShowRunTime; procedure ClearDisplayRunTime; procedure ConnectorDelete ( const aConnector : TKnobsConnector ); procedure ConnectorBreak ( const aConnector : TKnobsConnector ); procedure ConnectorDisconnect( const aConnector : TKnobsConnector ); procedure ModuleCut ( const aModule : TKnobsModule ); procedure ModuleCopy ( const aModule : TKnobsModule ); procedure ModuleDelete ( const aModule : TKnobsModule ); procedure KnobSetDefaultValue( const aValuedControl: TKnobsValuedControl); procedure KnobChangeLock( const aKnob: TKnobsKnob); private procedure SetWireThickness ( aValue: Integer); procedure SetCurvedLines ( aValue: Boolean); procedure SetControlMode ( aValue: TDistanceMode); function GetReferenceA : TSignal; procedure SetReferenceA ( aValue: TSignal); function GetNotesPerOctave: TSignal; procedure SetNotesPerOctave( aValue: TSignal); function GetMiddleNote: TSignal; procedure SetMiddleNote( aValue: TSignal); private function GetScalaScaleFile : string; procedure SetScalaScaleFile ( const aValue: string); function GetScalaMappingFile: string; procedure SetScalaMappingFile( const aValue: string); private procedure DoDesignerLog ( aSender: TObject; const aMsg: string); procedure DoWirePanelLog ( aSender: TObject; const aMsg: string); procedure DoHistoryChanged( aSender: TObject; anUndoCount, aRedoCount: Integer); procedure DoValueChanged ( aSender: TObject; const aPath, aControlType: string; aValue: TSignal; IsFinal: Boolean); procedure DoDisplayChanged( aSender: TObject; const aPath, aValue: string); procedure DoFileChanged ( aSender: TObject; const aPath, aValue: string); procedure DoShowHint( var aHintStr: string; var CanShow: Boolean; var aHintInfo: Vcl.Controls.THintInfo); function DoCreateModuleBitmap( aModuleType: TKnobsModuleType): TBitmap; function DoReadModuleComment ( aModuleType: TKnobsModuleType): string; private function SplitValueInfo ( const aPath: string; var aModule: TKnobsCustomModule; var aModuleType, aSignalName: string): Boolean; procedure HandleSpecialValues( const aPath, aControlType: string; aValue: TSignal); procedure ChangeRangeFor ( const aModule: TKnobsCustomModule; const aModuleType, aRangeType: string; aValue: TSignal); procedure ChangeModeFor ( const aModule: TKnobsCustomModule; const aModuleType: string; aValue: TSignal); procedure HandleRandomFor ( const aModule: TKnobsCustomModule; const aModuleType: string; aValue: TSignal); private procedure DoLights ( aSender: TMod; const aMsg: string); procedure DoData ( aSender: TMod; const aPath: string; const aData: TSignalArray); procedure DoInfo ( aSender: TMod; const aMsg: string); procedure DoPatchChanged ( aSender: TKnobsWirePanel); procedure DoShowPopupMenu( const aSender: TKnobsWirePanel; const aControl: TControl); function SavePatch : Boolean; function SavePatchAs: Boolean; procedure DoLoadPatch( const aFileName: string); procedure LoadPatch; procedure NewPatch; procedure DeleteModules; procedure CutModules; procedure CopyModules; procedure PasteModules; procedure SelectAll; procedure SelectNone; procedure InvertSelection; procedure WiggleWires; procedure SearchPatch( const aValue: string); private function FunctionalPinName( const aName: string): string; function SplitConnectorName( const aName: string; var aMod, aPin: string): Boolean; function ModuleTypeToModule( aType: Integer; const aParent: TSynthPatch; const aName: string): TMod; procedure CompilePatch; private procedure InitializeCPUCounter; procedure FinalizeCPUCounter; procedure TickCPUCounter; private procedure StartNetMidiConnectTimer; procedure StopNetMidiConnectTimer; procedure NetMidiConnectTimerFired; procedure NetMidiConnect; procedure NetMidiDisconnect; procedure NetMidiApply; procedure NetMidiCancel; function SocketStateToStr( aValue: TSocketState): string; procedure ReceiveNetMidi; procedure SendNetMidi ( const aData: TBytes); procedure AcceptNetMidi( const aData: TBytes); procedure AcceptMidiByte ( aByte: Byte); procedure AcceptMidiCommand( aByte: Byte); procedure AcceptMidiData ( aByte: Byte); procedure AcceptMidiSysex ( aByte: Byte); procedure MidiReset; procedure MidiProcessNoteOff ( aVelocity, aNote, aChannel: Byte); procedure MidiProcessNoteOn ( aVelocity, aNote, aChannel: Byte); procedure MidiProcessKeyPressure ( aPressure, aNote, aChannel: Byte); procedure MidiProcessControlChange ( aValue, aController, aChannel: Byte); procedure MidiProcessProgramChange ( aProgram, aChannel: Byte); procedure MidiProcessChannelPressure( aValue, aChannel: Byte); procedure MidiProcessPitchBend ( aData: Word; aChannel: Byte); procedure MidiProcessStartSysEx; procedure MidiProcessEndSysEx; procedure MidiProcessSongPosition ( aData: Word); procedure MidiProcessSongSelect ( aSong: Byte); procedure MidiProcessTuneRequest; procedure MidiProcessTimingClock; procedure MidiProcessStart; procedure MidiProcessContinue; procedure MidiProcessStop; procedure MidiProcessActiveSense; procedure MidiProcessReset; procedure MidiProcessSysExData ( aData: Byte); procedure MidiProcessMessage( const aMsg: TMidiMessage); procedure DoMidiSendMessage( aSender: TObject; const aMsg: TMidiMessage); public // yes .. public .. procedure MemoDebugWindowProc( var aMsg: TMessage); function IsShortCut( var aMessage: TWMKey): Boolean; override; private property OffsetLeft : Integer read GetOffsetLeft write SetOffsetLeft; property OffsetTop : Integer read GetOffsetTop write SetOffsetTop; property PrioLevel : Integer read FPrioLevel write SetPrioLevel; property UseGraph : Boolean read FUseGraph write SetUseGraph; property GraphStairs : Boolean read FGraphStairs write SetGraphStairs; property HistoryCount : Integer read FHistoryCount write SetHistoryCount; property SourceFileName : string read GetSourceFileName write SetSourceFileName; property PatchName : string read GetPatchName write SetPatchName; property ReloadLastPatch : Boolean read FReloadLastPatch write SetReloadLastPatch; property AutoRun : Boolean read FAutoRun write SetAutoRun; property PatchChanged : Boolean read FPatchChanged write SetPatchChanged; property WarnOnPatchChange : Boolean read FWarnOnPatchChange write SetWarnOnPatchChange; private property NetMidiServer : string read FNetMidiServer write SetNetMidiServer; property NetMidiPort : string read FNetMidiPort write SetNetMidiPort; property NetMidiAutoConnect : Boolean read FNetMidiAutoConnect write SetNetMidiAutoConnect; property NetMidiConnected : Boolean read FNetMidiConnected write SetNetMidiConnected; property NetMidiChanged : Boolean read FNetMidiChanged write SetNetMidiChanged; property LogMidi : Boolean read FLogMidi write SetLogMidi; property LogMidiMsgs : Boolean read FLogMidiMsgs write SetLogMidiMsgs; property CompilerDebug : Boolean read FCompilerDebug write SetCompilerDebug; private property InVolume : Integer read GetInVolume write SetInVolume; property OutVolume : Integer read GetOutVolume write SetOutVolume; property AudioRunning : Boolean read FAudioRunning write SetAudioRunning; private property WireThickness : Integer read FWireThickness write SetWireThickness; property CurvedLines : Boolean read FCurvedLines write SetCurvedLines; property ControlMode : TDistanceMode read FControlMode write SetControlMode; property ReferenceA : TSignal read GetReferenceA write SetReferenceA; property NotesPerOctave : TSignal read GetNotesPerOctave write SetNotesPerOctave; property MiddleNote : TSignal read GetMiddleNote write SetMiddleNote; private property ScalaScaleFile : string read GetScalaScaleFile write SetScalaScaleFile ; property ScalaMappingFile : string read GetScalaMappingFile write SetScalaMappingFile; end; var FormModules: TFormModules; implementation type TSample = SmallInt; // External value type for OS samples TSamples = packed array[ 0 .. MaxInt div SizeOf( TSample) - 1] of TSample; PSamples = ^TSamples; const SAMP_MAX = High( TSample); // Maximum value for a sample SAMP_MIN = - High( TSample); // Minimum value for a sample {$R *.dfm} // User area function ClipSample( aSample: TSignal): TSample; inline; begin if aSample > SAMP_MAX then Result := SAMP_MAX else if aSample < SAMP_MIN then Result := SAMP_MIN else Result := Round( aSample); end; function SampleToUnits( aSample: TSample): TSignal; inline; begin Result := aSample / SAMP_MAX; end; function UnitsToSample( aUnit: TSignal): TSample; inline; begin Result := ClipSample( aUnit * SAMP_MAX); end; { ======== TPageControl = class( Vcl.ComCtrls.TPageControl) private } // Some stuff to fix the border width for TPageControls procedure TPageControl.TCMAdjustRect(var Msg: TMessage); // message TCM_ADJUSTRECT; begin inherited; if Msg.WParam = 0 then InflateRect( PRect( Msg.LParam)^, 4, 4) else InflateRect( PRect( Msg.LParam)^, -4, -4); end; { ======== TFormModules = class( TForm) private } procedure TFormModules.UpdateCaption; procedure Addpart( const aParts: TStringList; const aPart: string); begin if aPart <> '' then aParts.Add( aPart); end; const {$ifdef DEBUG} Changed: array[ Boolean] of string = ( 'DEBUG ', 'DEBUG Patch changed' ); Runs: array[ Boolean] of string = ( 'Stopped', '' ); {$else} Changed: array[ Boolean] of string = ( '', '*' ); Runs: array[ Boolean] of string = ( 'Stopped', '' ); {$endif} var aParts : TStringList; begin aparts := TStringList.Create; try AddPart( aParts, FOrigCaption); Addpart( aParts, Runs[ AudioRunning]); Addpart( aParts, Changed[ PatchChanged]); AddPart( aParts, PatchName); Addpart( aparts, ExtractFileName( SourceFileName)); Caption := Implode( aParts, ' :: '); finally aParts.Free; end; end; // private function TFormModules.GetOffsetLeft: Integer; begin if Assigned( EditorPatch) then Result := EditorPatch.OffsetLeft else Result := 4; end; procedure TFormModules.SetOffsetLeft( aValue: Integer); begin if Assigned( EditorPatch) then EditorPatch.OffsetLeft := aValue; KnobsSmallKnobOffsetLeft.KnobPosition := aValue; end; function TFormModules.GetOffsetTop: Integer; begin if Assigned( EditorPatch) then Result := EditorPatch.OffsetTop else Result := 4; end; procedure TFormModules.SetOffsetTop( aValue: Integer); begin if Assigned( EditorPatch) then EditorPatch.OffsetTop := aValue; KnobsSmallKnobOffsetTop.KnobPosition := aValue; end; procedure TFormModules.SetPrioLevel( aValue: Integer); function PriorityLevelToStr( aValue : Integer): string; begin case aValue of 0 : Result := 'normal'; 1 : Result := 'higher'; 2 : Result := 'real time'; else Result := Format( 'unknown (%d)', [ aValue]); end; end; begin if aValue <> FPrioLevel then begin if SetPriorityLevel( aValue) then begin FPrioLevel := aValue; LogFmt( 'priority level was set to "%s".', [ PriorityLevelToStr( FPrioLevel)]); end else LogFmt( 'could not set priority level to "%s".', [ PriorityLevelToStr( aValue)]); end; RadioGroupPrioLevel.ItemIndex := FPrioLevel; end; procedure TFormModules.SetUseGraph( aValue: Boolean); begin if aValue <> FUseGraph then begin FUseGraph := aValue; CheckBoxUseGraph.Checked := aValue; BuildGraphs; end; end; procedure TFormModules.SetGraphStairs( aValue: Boolean); var i : Integer; begin if aValue <> FGraphStairs then begin FGraphStairs := aValue; CheckBoxGraphStairs.Checked := aValue; for i := 0 to Length( FChartSeries) - 1 do FChartSeries[ i].Stairs := aValue; end; end; procedure TFormModules.SetHistoryCount( aValue: Integer); begin if aValue <> FHistoryCount then begin FHistoryCount := aValue; end; end; function TFormModules.GetSourceFileName : string; begin if Assigned( EditorPatch) then Result := EditorPatch.Filename else Result := ''; end; procedure TFormModules.SetSourceFileName( const aValue: string); begin if ( aValue <> SourceFileName) and Assigned( EditorPatch) then begin EditorPatch.Filename := aValue; SetMostRecentFile( aValue); UpdateCaption; end; end; function TFormModules.GetPatchName: string; begin if Assigned( EditorPatch) then Result := EditorPatch.Title else Result := 'no name'; end; procedure TFormModules.SetPatchName( const aValue: string); begin if ( aValue <> PatchName) and Assigned( EditorPatch) then begin EditorPatch.Title := aValue; UpdateCaption; end; EditPatchName.Text := aValue; end; procedure TFormModules.SetPatchChanged( aValue: Boolean); begin if aValue <> FPatchChanged then begin FPatchChanged := aValue; UpdateCaption; end; end; procedure TFormModules.SetWarnOnPatchChange( aValue: Boolean); begin if aValue <> FWarnOnPatchChange then begin FWarnOnPatchChange := aValue; CheckBoxWarnOnPatchChange.Checked := aValue; end; end; procedure TFormModules.SetReloadLastPatch( aValue: Boolean); begin if aValue <> FReloadLastPatch then begin FReloadLastPatch := aValue; CheckBoxReloadLastPatch.Checked := aValue; end; end; procedure TFormModules.SetAutoRun( aValue: Boolean); begin if aValue <> FAutoRun then begin FAutoRun := aValue; CheckBoxAutoRun.Checked := aValue; if AutoRun and not AudioRunning then AudioRunning := True; end; end; // private procedure TFormModules.SetNetMidiServer( const aValue: string); var WasConnected : Boolean; begin if aValue <> FNetMidiServer then begin WasConnected := NetMidiConnected; NetMidiDisconnect; FNetMidiServer := aValue; if WasConnected then NetMidiConnect; end; end; procedure TFormModules.SetNetMidiPort( const aValue: string); var WasConnected : Boolean; begin if aValue <> FNetMidiPort then begin WasConnected := NetMidiConnected; NetMidiDisconnect; FNetMidiPort := aValue; if WasConnected then NetMidiConnect; end; end; procedure TFormModules.SetNetMidiAutoConnect( aValue: Boolean); begin if aValue <> FNetMidiAutoConnect then begin FNetMidiAutoConnect := aValue; CheckBoxNetMidiAutoConnect.Checked := aValue; if NetMidiAutoConnect and not NetMidiConnected then StartNetMidiConnectTimer; end; end; procedure TFormModules.SetNetMidiConnected( aValue: Boolean); const Caps : array[ Boolean] of string = ( 'connect', 'disconnect' ); begin if aValue <> FNetMidiConnected then begin FNetMidiConnected := aValue; LedNetMidiConnect1 .Active := aValue; LedNetMidiConnect2 .Active := aValue; BitBtnNetMidiConnect.Caption := Caps[ aValue]; end; end; procedure TFormModules.SetNetMidiChanged( aValue: Boolean); begin if aValue <> FNetMidiChanged then begin FNetMidiChanged := aValue; BitBtnApplyNetMidi .Enabled := aValue; BitBtnCancelNetMidi.Enabled := aValue; end; end; procedure TFormModules.SetLogMidi( aValue: Boolean); begin if aValue <> FLogMidi then begin FLogMidi := aValue; CheckBoxLogMidi.Checked := aValue; end; end; procedure TFormModules.SetLogMidiMsgs( aValue: Boolean); begin if aValue <> FLogMidiMsgs then begin FLogMidiMsgs := aValue; CheckBoxLogMidiMsgs.Checked := aValue; end; end; procedure TFormModules.SetCompilerDebug( aValue: Boolean); begin if aValue <> FCompilerDebug then begin FCompilerDebug := aValue; CheckBoxCompilerDebug.Checked := aValue; end; end; // private function TFormModules.GetInVolume: Integer; begin Result := KnobInVolume.KnobPosition; end; procedure TFormModules.SetInVolume( aValue: Integer); begin KnobInVolume.KnobPosition := aValue; FInShadow := KnobInVolume.AsValue; end; function TFormModules.GetOutVolume: Integer; begin Result := KnobOutVolume.KnobPosition; end; procedure TFormModules.SetOutVolume( aValue: Integer); begin KnobOutVolume.KnobPosition := aValue; FOutShadow := KnobOutVolume.AsValue; end; procedure TFormModules.SetAudioRunning( aValue: Boolean); const Caps: array[ Boolean] of string = ( 'run', 'stop' ); begin if aValue <> FAudioRunning then begin FAudioRunning := aValue; if aValue then begin EnableDebugButtons( False); if Assigned( FSynthPatch) then FSynthPatch.FixZippers; StartAudioIo; FStartTime := Now; end else begin StopAudioIo; EnableDebugButtons( True); end; end; BitBtnAudioRunning.Caption := Caps[ AudioRunning]; MenuActionRunStop .Caption := Caps[ AudioRunning]; MenuActionRunStop .Checked := AudioRunning; UpdateCaption; end; // private procedure TFormModules.OpenRecentFile( const anIndex: Integer); var aFileName: string; begin if Assigned( FRecentSourceFiles) and ( anIndex >= 0) and ( anIndex < FRecentSourceFiles.Count) then begin aFileName := FRecentSourceFiles[ anIndex]; if FileExists( aFileName) then DoLoadPatch( aFileName) else begin FRecentSourceFiles.Delete( anIndex); SetRecentMenuItems; end; end; end; procedure TFormModules.DorecentMenuItemClick( aSender: TObject); var aMenuItem: TMenuItem; begin aMenuItem := aSender as TMenuItem; if Assigned( aMenuItem) then OpenRecentFile( aMenuItem.Tag); end; procedure TFormModules.AddrecentMenuItem( anIndex: Integer; const aFileName: string); var aMenuItem : TMenuItem; aHotKey : Char; begin if FileExists( aFileName) then begin aMenuItem := TMenuItem.Create( MenuFileReopen); with aMenuItem do begin if anIndex >= 10 then aHotKey := Char( anIndex + Ord( 'A')) else aHotKey := Char( anIndex + Ord( '0')); Caption := Format( '&%s %s', [ aHotKey, aFileName], AppLocale); Tag := anIndex; OnClick := DorecentMenuItemClick; end; MenuFileReopen.Add( aMenuItem); end; end; procedure TFormModules.RemoveRecentMenuItems; var i : Integer; begin with MenuFileReopen do begin for i := Count - 1 downto 0 do Delete( i); end; end; procedure TFormModules.SetRecentMenuItems; var i : Integer; begin RemoveRecentMenuItems; for i := 0 to FRecentSourceFiles.Count - 1 do AddrecentMenuItem( i, FRecentSourceFiles[ i]); end; procedure TFormModules.SetMostRecentFile( const aFileName: string); begin FRecentSourceFiles.SetMostRecent( aFileName); SetRecentMenuItems; end; const sdfs = 'settings'; procedure TFormModules.LoadIni; var L, T, W, H: Integer; anIniFile : TMemIniFile; DoAutoRun : Boolean; WinState : TWindowState; begin logFmt( 'Loading inifile: %s', [ IniFileName]); anIniFile := TMemIniFile.Create( IniFileName); with anIniFile do begin try FRecentSourceFiles.LoadFromIni( anIniFile, 'RecentFiles'); HistoryCount := FRecentSourceFiles.MaxDepth; L := ReadInteger( sdfs, 'Left' , Left ); T := ReadInteger( sdfs, 'Top' , Top ); W := ReadInteger( sdfs, 'Width' , Width ); H := ReadInteger( sdfs, 'Height' , Height ); WinState := TWindowState( ReadInteger( sdfs, 'WindowState' , Integer( WindowState ))); OffsetLeft := ReadInteger( sdfs, 'OffsetLeft' , OffsetLeft ); OffsetTop := ReadInteger( sdfs, 'OffsetTop' , OffsetTop ); PrioLevel := ReadInteger( sdfs, 'PrioLevel' , PrioLevel ); ReloadLastPatch := ReadBool ( sdfs, 'ReloadLastPatch' , ReloadLastPatch ); DoAutoRun := ReadBool ( sdfs, 'AutoRun' , AutoRun ); SourceFileName := ReadString ( sdfs, 'SourceFileName' , SourceFileName ); UseGraph := ReadBool ( sdfs, 'UseGraph' , UseGraph ); GraphStairs := ReadBool ( sdfs, 'GraphStairs' , GraphStairs ); InVolume := ReadInteger( sdfs, 'InVolume' , InVolume ); OutVolume := ReadInteger( sdfs, 'OutVolume' , OutVolume ); WireThickness := ReadInteger( sdfs, 'WireThickness' , WireThickness ); CurvedLines := ReadBool ( sdfs, 'CurvedLines' , CurvedLines ); ControlMode := TDistanceMode( ReadInteger( sdfs, 'ControlMode' , Integer( ControlMode ))); ReferenceA := ReadFloat ( sdfs, 'ReferenceA' , ReferenceA ); NotesPerOctave := ReadFloat ( sdfs, 'NotesPerOctave' , NotesPerOctave ); MiddleNote := ReadFloat ( sdfs, 'MiddleNote' , MiddleNote ); FSelectedInputId := DWORD( ReadInteger( sDfs, 'SelectedInput' , FSelectedInputId )); FSelectedOutputId := DWORD( ReadInteger( sDfs, 'SelectedOutput' , FSelectedOutputId)); NetMidiServer := ReadString ( sdfs, 'NetMidiServer' , NetMidiServer ); NetMidiPort := ReadString ( sdfs, 'NetMidiPort' , NetMidiPort ); NetMidiAutoConnect := ReadBool ( sdfs, 'NetMidiAutoConnect', NetMidiAutoConnect); LogMidi := ReadBool ( sdfs, 'LogMidi' , LogMidi ); LogMidiMsgs := ReadBool ( sdfs, 'LogMidiMsgs' , LogMidiMsgs ); CompilerDebug := ReadBool ( sdfs, 'CompilerDebug' , CompilerDebug ); ScalaScaleFile := ReadString ( sdfs, 'ScalaScaleFile' , ScalaScaleFile ); ScalaMappingFile := ReadString ( sdfs, 'ScalaMappingFile' , ScalaMappingFile ); WarnOnPatchChange := ReadBool ( sdfs, 'WarnOnPatchChange' , WarnOnPatchChange ); NetMidiCancel; if ( L < 0) or ( L > Screen.Width - 20) then L := 0; if ( T < 0) or ( T > Screen.Height - 20) then T := 0; if W > Screen.Width then W := Screen.Width - 20; if H > Screen.Height then H := Screen.Height - 20; SetBounds( L, T, W, H); if WinState = wsMaximized then WindowState := wsMaximized; VerifyDevices; if ReloadLastPatch and FileExists( SourceFileName) then begin LogFmt( 'Reopening last used patch [%s]', [ SourceFileName]); DoLoadPatch( SourceFileName); end else begin LogFmt( 'Could not find last used patch [%s] - starting a new patch', [ SourceFileName]); DoAutoRun := False; PatchName := 'new patch'; SourceFileName := 'new_patch'; end; if DoAutoRun then begin AutoRun := True; AudioRunning := True; UpdateCaption; end; FIniLoaded := True; finally Free; end; end; Log('ini file loaded'); end; procedure TFormModules.SaveIni; var anIniFile : TMemIniFile; begin anIniFile := TMemIniFile.Create( IniFileName); with anIniFile do begin try EraseSection( sdfs); WriteInteger( sdfs, 'Left' , Left ); WriteInteger( sdfs, 'Top' , Top ); WriteInteger( sdfs, 'Width' , Width ); WriteInteger( sdfs, 'Height' , Height ); WriteInteger( sdfs, 'WindowState' , Integer( WindowState )); WriteInteger( sdfs, 'PrioLevel' , PrioLevel ); WriteInteger( sdfs, 'OffsetLeft' , OffsetLeft ); WriteInteger( sdfs, 'OffsetTop' , OffsetTop ); WriteBool ( sdfs, 'ReloadLastPatch' , ReloadLastPatch ); WriteBool ( sdfs, 'AutoRun' , AutoRun ); WriteString ( sdfs, 'SourceFileName' , SourceFileName ); WriteBool ( sdfs, 'UseGraph' , UseGraph ); WriteBool ( sdfs, 'GraphStairs' , GraphStairs ); WriteFloat ( sdfs, 'InVolume' , InVolume ); WriteFloat ( sdfs, 'OutVolume' , OutVolume ); WriteInteger( sdfs, 'WireThickness' , WireThickness ); WriteBool ( sdfs, 'CurvedLines' , CurvedLines ); WriteInteger( sdfs, 'ControlMode' , Integer( ControlMode )); WriteFloat ( sdfs, 'ReferenceA' , ReferenceA ); WriteFloat ( sdfs, 'NotesPerOctave' , NotesPerOctave ); WriteFloat ( sdfs, 'MiddleNote' , MiddleNote ); WriteInteger( sDfs, 'SelectedInput' , Integer( FSelectedInputId )); WriteInteger( sDfs, 'SelectedOutput' , Integer( FSelectedOutputId)); WriteString ( sdfs, 'NetMidiServer' , NetMidiServer ); WriteString ( sdfs, 'NetMidiPort' , NetMidiPort ); WriteBool ( sdfs, 'NetMidiAutoConnect', NetMidiAutoConnect); WriteBool ( sdfs, 'LogMidi' , LogMidi ); WriteBool ( sdfs, 'LogMidiMsgs' , LogMidiMsgs ); WriteBool ( sdfs, 'CompilerDebug' , CompilerDebug ); WriteString ( sdfs, 'ScalaScaleFile' , ScalaScaleFile ); WriteString ( sdfs, 'ScalaMappingFile' , ScalaMappingFile ); WriteBool ( sdfs, 'WarnOnPatchChange' , WarnOnPatchChange ); FRecentSourceFiles.MaxDepth := HistoryCount; FRecentSourceFiles.SaveToIni( anIniFile, 'RecentFiles'); finally UpdateFile; Free; end; end; end; procedure TFormModules.ShowHelp; var aHelpIndex : string; aModule : TKnobsCustomModule; anURL : string; begin aHelpIndex := ''; if Assigned( EditorPatch) then begin aModule := EditorPatch.FindFirstSelectedModule; if Assigned( aModule) then aHelpIndex := Format( '#%d', [ aModule.ModuleType]); end; if MustMakeDocs then begin if MessageDlg( Format( 'I need to make some folders and files for that inside my application folder:'^M^M'%s,'^M^M'is that okay?', [ ApplicationPath], AppLocale ), mtInformation, [ mbYes, mbNo], 0 ) = mrYes then MakeDocs( DocsPath); end; if FileExists( DocsPath + '\modules.html') then begin anURL := Format( '"file:///%s/modules.html%s"', [ DocsPath, aHelpIndex]); anURL := StringReplace( anURL, '\', '/', [ rfReplaceAll]); if not BrowseURL( anURL) then MessageDlg( 'could not open the docs in the default web browser ...', mtError, [ mbOK], 0); end else MessageDlg( 'could not create docs ...', mtError, [ mbOK], 0); end; function TFormModules.MustMakeDocs: Boolean; begin if not FileExists( DocsPath + '\modules.html') then Result := True else begin if DirectoryExists( DocsPath + '\images') then begin if FileExists( Format( '%s\images\%s', [ DocsPath, GetFileVersion], AppLocale)) then Result := False else Result := True; end else Result := True; end; end; procedure TFormModules.MakeDocs( const aFolder : string); const Images = '\images'; var aFileNames : TStrings; aFileName : string; aFile : TextFile; aFileVersion : string; aVersion : string; begin aFileVersion := GetFileVersion; if not DirectoryExists( aFolder) then begin ForceDirectories( aFolder); end; if not DirectoryExists( aFolder + Images) then begin ForceDirectories( aFolder + Images); end; aFileNames := GetFileNames( aFolder + Images, '*.*'); if Assigned( aFileNames) then begin try for aFileName in aFileNames do DeleteFile( aFileName); finally aFileNames.Free; end; end; FormStore.Show; try FormStore.Document( aFolder, Images, aFileVersion); finally FormStore.Hide; end; aVersion := Format( '%s\%s\%s', [ aFolder, Images, aFileVersion], AppLocale); AssignFile( aFile, aVersion); Rewrite( aFile); try WriteLn( aFile, 'this file is for documentation version checking'); WriteLn( aFile, aVersion); WriteLn( aFile, 'when the path above is not my actual position and name, just delete me please.'); finally CloseFile( aFile); end; end; // private procedure TFormModules.Log( const aMsg: string); begin MemoDebug.Lines.Add( Format( '%s %s', [ GetDebugTimeStr, aMsg], AppLocale)); end; procedure TFormModules.LogFmt( const aFmt: string; const anArgs: array of const); begin Log( Format( aFmt, anArgs, AppLocale)); end; procedure TFormModules.MidiLog( const aMsg: string); begin if LogMidi then LogFmt( 'NET MIDI %s', [ aMsg]); end; procedure TFormModules.MidiLogFmt( const aFmt: string; const anArgs: array of const); begin MidiLog( Format( aFmt, anArgs)); end; procedure TFormModules.MidiMsgLog( const aMsg: string); begin if LogMidiMsgs then LogFmt( 'NET MIDI msg %s', [ aMsg]); end; procedure TFormModules.MidiMsgLogFmt( const aFmt: string; const anArgs: array of const); begin MidiMsgLog( Format( aFmt, anArgs)); end; procedure TFormModules.DebugPerformance( const aMsg: string; aTime_ms, aSampleCount: Cardinal); var SampleRate : TSignal; Utilisation : TSignal; ModuleCount : Integer; WireCount : Integer; MaxModules : Integer; MaxWires : Integer; begin SampleRate := aSampleCount / aTime_ms; // in ks/s Utilisation := ( System_Rate * 0.1) / SampleRate; // in %, for a SYSTEM_RATE s/s system ModuleCount := CountModules; WireCount := CountWires; MaxModules := Floor(( 100 / Utilisation) * ModuleCount); MaxWires := Floor(( 100 / Utilisation) * WireCount ); LogFmt( '%s : time = %d ms, samples = %d, speed = %f ks/s, core usage = %f %% at system rate = %f s/s [using %d modules (max %d) and %d wires (max %d)]', [ aMsg, aTime_ms, aSampleCount, SampleRate, Utilisation, System_Rate, CountModules, MaxModules, CountWires, MaxWires ] ); end; function TFormModules.CountModules: Integer; begin if Assigned( FSynthPatch) then Result := FSynthPatch.ModuleCount else Result := 0; end; function TFormModules.CountWires: Integer; begin Result := 0; if Assigned( FSynthPatch) then begin Result := Result + FSynthPatch.ConnectionCount; Result := Result + FSynthPatch.InputCount; Result := Result + FSynthPatch.OutputCount; end; end; procedure TFormModules.ClearMemo; begin MemoDebug.Clear; end; procedure TFormModules.ClearGraphs; var i : Integer; begin for i := 0 to Length( FChartSeries) - 1 do FChartSeries[ i].Clear; end; procedure TFormModules.BuildGraphs; const Colors : array[ 0 .. 3] of TColor = ( clRed, clBlue, clGreen, clPurple); var ChartCount : Integer; i : Integer; aSeries : TChartSeries; begin if UseGraph then begin // RemoveAllSeries does not work ... well, it frees them not ... while ChartDebug.SeriesList.Count > 0 do begin aSeries := ChartDebug.SeriesList[ ChartDebug.SeriesList.Count - 1]; ChartDebug.RemoveSeries( aSeries); aSeries.Free; end; if Assigned( FSynthPatch) then begin ChartCount := FSynthPatch.OutputCount; SetLength( FChartSeries, ChartCount); for i := 0 to ChartCount - 1 do begin FChartSeries[ i] := TFastLineSeries.Create( ChartDebug); FChartSeries[ i].Name := Format( 'out_%d', [ i], AppLocale); FChartSeries[ i].Stairs := GraphStairs; FChartSeries[ i].InvertedStairs := True; FChartSeries[ i].LinePen.Width := 2; FChartSeries[ i].Active := True; FChartSeries[ i].Visible := True; if i < Length( Colors) then FChartSeries[ i].Color := Colors[ i]; ChartDebug.AddSeries( FChartSeries[ i]); end; end; end; end; procedure TFormModules.ShowPatch; var S : string; begin S := ''; if Assigned( FSynthPatch) then FSynthPatch.Save( 0, S); if S = '' then Log( 'FSynthPatch not assigned, can not dump patch') else LogFmt( '%s', [ S]); end; procedure TFormModules.ProfilePatch; var aProfile : TStringList; aPath : string; begin if Assigned( FSynthPatch) then begin aProfile := FSynthPatch.GetProfileHtml; if Assigned( aProfile) then begin try aPath := IncludeTrailingPathDelimiter( IncludeTrailingPathDelimiter( ApplicationPath) + 'data'); if not DirectoryExists( aPath) then ForceDirectories( aPath); aProfile.SaveToFile( aPath + 'profile.html'); if FileExists( aPath + 'profile.html') then begin ShellExecute( Handle, Nil, PChar( Format( 'file://%s', [ aPath + 'profile.html'])), Nil, Nil, SW_SHOWNORMAL ); end finally FreeAndNil( aProfile); end; end; end else Log( 'No synth patch avaialable, can not profile'); end; function TFormModules.ChangeSynthPatch( const aSynthPatch: TSynthPatch): Boolean; var OldSynth : TSynthPatch; begin Result := False; if Assigned( aSynthPatch) then begin if not aSynthPatch.IsSamePatch( FSynthPatch) // Do not change the patch if it's 'the same' .. equivalent ... then begin EditorPatch.BlockScreenUpdates; try OldSynth := FSynthPatch; if Assigned( OldSynth) then OldSynth.OnSendMidi := nil; aSynthPatch.GatherLights( '', DoLights); aSynthPatch.GatherData ( '', DoData ); aSynthPatch.GatherInfo ( '', DoInfo ); aSynthPatch.OnSendMidi := DoMidiSendMessage; PatchName := aSynthPatch.Name; FSynthPatch := aSynthPatch; EditorPatch.FixAllSynthParams; BuildGraphs; if Assigned( OldSynth) then FreeAndNil( OldSynth); Result := True; finally EditorPatch.UnblockScreenUpdates; end; end; end else PageControlMain.ActivePage := TabSheetDebug; end; procedure TFormModules.ExecutePatch; begin if Assigned( FSynthPatch) then FSynthPatch.Tick; if not AudioRunning and UseGraph then ChartOoutputs; end; procedure TFormModules.ChartOutput( anIndex: Integer; aValue: TSignal); begin if Assigned( FSynthPatch) then begin if FChartSeries[ anIndex].Count > 40960 then FChartSeries[ anIndex].Clear; FChartSeries[ anIndex].AddXY( SampleCountToTime( FSynthPatch.Samples) * 1000, aValue); // in ms end; end; procedure TFormModules.ChartOoutputs; var i : Integer; begin Assert( Assigned( FSynthPatch), 'FSynthPatch should be assigned here'); for i := 0 to Length( FChartSeries) - 1 do ChartOutput( i, Max( -256, Min( 256, FSynthPatch.Output[ i]))) end; procedure TFormModules.DebugRunStop; var i : Integer; begin if AudioRunning then Log( 'can not do a debug run while audio generation is on') else begin Assert( Assigned( FSynthPatch), 'FSynthPatch should be assigned here'); if FDebugRunning then begin FTime := timeGetTime - FTime; FDebugRunning := False; BitBtnDebugRun.Caption := 'debug Run'; DebugPerformance( 'overall', FTime, FSynthPatch.Samples); Log( 'DebugRun stopped'); end else begin FSynthPatch.Reset; FDebugRunning := True; BitBtnDebugRun.Caption := 'debug Stop'; Log( 'DebugRun started'); FTime := timeGetTime; while FDebugRunning and not AudioRunning do begin Application.ProcessMessages; for i := 1 to 512 do ExecutePatch; end; FDebugRunning := False; BitBtnDebugRun.Caption := 'debug Run'; end; end; end; procedure TFormModules.EnableDebugButtons( anEnable: Boolean); begin BitBtnDebugStep .Enabled := anEnable; BitBtnDebugRun .Enabled := anEnable; BitBtnDebugReset.Enabled := anEnable; end; // private procedure TFormModules.DeZipper; begin FOutVolume := ( FOutShadow + FOutVolume * 1023) / 1024; FInVolume := ( FInShadow + FInVolume * 1023) / 1024; end; function TFormModules.HandleAudioInOnBufferFilled( aBuffer: pAnsiChar; var aSize: Integer): Boolean; // Handle input var i : Integer; aSampleCount : Integer; aLeft : TSignal; aRight : TSignal; aMaxLeft : TSignal; aMaxRight : TSignal; adBLeft : TSignal; adBRight : TSignal; adB : TSignal; begin aSampleCount := aSize div 4; // 16 bit samples and two channels, so 4 times a byte Inc( FBalance); aMaxLeft := 0; aMaxRight := 0; if Assigned( FSynthPatch) then begin for i := 0 to aSampleCount - 1 do begin aLeft := FInVolume * SampleToUnits( PSamples( aBuffer)[ 2 * i + 0]); aRight := FInVolume * SampleToUnits( PSamples( aBuffer)[ 2 * i + 1]); aMaxLeft := Max( aMaxLeft , Abs( aLeft )); aMaxRight := Max( aMaxRight, Abs( aRight)); FSynthPatch.AcceptSamplePair( aLeft, aRight); end; ShowOverUnderFlows; end; adBLeft := SignalTodB( aMaxLeft ); adBRight := SignalTodB( aMaxRight); adB := Max( adBLeft, adBRight); if adB > FdBInMax then FdBInMax := adB else FdBInMax := ( 199 * FdBInMax + adB) / 200; IndicatorBarVolumeInLeft .Value := RangeMap( Clip( adBLeft , -100, 20), -100, 20, 0, 24); IndicatorBarVolumeInRight.Value := RangeMap( Clip( adBRight, -100, 20), -100, 20, 0, 24); Result := True; end; function TFormModules.HandleAudiOutOnFillBuffer( aBuffer: pAnsiChar; var aSize: Integer): Boolean; // Collect output // Buffer is 8192, so 2048 double samples .. or 44k1 / 2048 = 86.13 ms var i : Integer; aLeft : TSignal; aRight : TSignal; aSampleCount : Integer; aMaxLeft : TSignal; aMaxRight : TSignal; adBLeft : TSignal; adBRight : TSignal; adB : TSignal; // BOHM TickCounter1,TickCounter2: Int64; // EOHM begin // BOHM QueryPerformanceCounter(TickCounter1); // EOHM aSampleCount := aSize div 4; // 16 bit samples and two channels, so 4 times a byte Dec( FBalance); Result := True; aMaxLeft := 0; aMaxRight := 0; if Assigned( FSynthPatch) then begin FUpdateCounter := ( FUpdateCounter + 1) mod 2; case FUpdateCounter of 0 : FSynthPatch.GatherLights( '', DoLights); 1 : begin FSynthPatch.GatherData( '', DoData ); FSynthPatch.GatherInfo( '', DoInfo ); end; end; for i := 0 to aSampleCount - 1 do begin DeZipper; with FSynthPatch do begin Tick; aLeft := FOutVolume * Output[ 0]; aRight := FOutVolume * Output[ 1]; end; PSamples( aBuffer)[ 2 * i + 0] := UnitsToSample( aLeft ); PSamples( aBuffer)[ 2 * i + 1] := UnitsToSample( aRight); aMaxLeft := Max( aMaxLeft , Abs( aLeft )); aMaxRight := Max( aMaxRight, Abs( aRight)); end; end else begin for i := 0 to aSampleCount - 1 do begin PSamples( aBuffer)[ 2 * i + 0] := 0; PSamples( aBuffer)[ 2 * i + 1] := 0; end; end; adBLeft := SignalTodB( aMaxLeft ); adBRight := SignalTodB( aMaxRight); adB := Max( adBLeft, adBRight); if adB > FdBOutMax then FdBOutMax := adB else FdBOutMax := ( 199 * FdBOutMax + adB) / 200; IndicatorBarVolumeOutLeft .Value := RangeMap( Clip( adBLeft , -100, 20), -100, 20, 0, 24); IndicatorBarVolumeOutRight.Value := RangeMap( Clip( adBRight, -100, 20), -100, 20, 0, 24); // BOHM QueryPerformanceCounter(TickCounter2); ProcessingTime:=ProcessingTime+TickCounter2-TickCounter1; ProcessingSamples:=ProcessingSamples+ASampleCount // EOHM end; procedure TFormModules.HandleAudiInOnStart( aSender: TObject); begin Log( 'audio in was started'); end; procedure TFormModules.HandleAudiInOnStop( aSender: TObject); begin Log( 'audio in was stopped'); end; procedure TFormModules.HandleAudiOutOnStart( aSender: TObject); begin Log( 'audio out was started'); end; procedure TFormModules.HandleAudiOutOnStop( aSender: TObject); begin Log( 'audio out was stopped'); end; procedure TFormModules.CreateDevices; begin FAudioOut := TAudioOut.Create( Self); FAudioIn := TAudioIn .Create( Self); FAudioOut.BufferSize := 8192; FAudioOut.NumBuffers := 4; FAudioOut.FrameRate := 44100; FAudioOut.Stereo := True; FAudioIn .BufferSize := 8192; FAudioIn .NumBuffers := 4; FAudioIn .FrameRate := 44100; FAudioIn .Stereo := True; HookDevices; end; procedure TFormModules.FreeDevices; begin UnhookDevices; AudioRunning := False; FAudioIn .Free; FAudioOut.Free; end; procedure TFormModules.HookDevices; begin FAudioIn .OnBufferFilled := HandleAudioInOnBufferFilled; FAudioIn .OnStart := HandleAudiInOnStart; FAudioIn .OnStop := HandleAudiInOnStop; FAudioOut.OnFillBuffer := HandleAudiOutOnFillBuffer; FAudioOut.OnStart := HandleAudiOutOnStart; FAudioOut.OnStop := HandleAudiOutOnStop; end; procedure TFormModules.UnhookDevices; begin FAudioIn .OnBufferFilled := nil; FAudioIn .OnStart := nil; FAudioIn .OnStop := nil; FAudioOut.OnFillBuffer := nil; FAudioOut.OnStart := nil; FAudioOut.OnStop := nil; end; procedure TFormModules.StopAudioIo; begin LogFmt( 'stopping audio for current patch "%s"', [ PatchName]); FAudioIn .StopAtOnce; FAudioOut.StopAtOnce; ClearVolumeIndicators; end; procedure TFormModules.StartAudioIo; begin LogFmt( 'starting audio for current patch "%s"', [ PatchName]); ClearVolumeIndicators; FBalance := 0; FAudioIn .WaveDevice := FSelectedInputId; FAudioOut.WaveDevice := FSelectedOutputId; FAudioOut.Start; FAudioIn .Start; end; procedure TFormModules.VerifyDevices; begin FormWaveDeviceSelect.SelectedInputId := FSelectedInputId; FormWaveDeviceSelect.SelectedOutputId := FSelectedOutputId; SelectDevices; end; procedure TFormModules.SelectDevices; var WasRunning: Boolean; begin WasRunning := AudioRunning; AudioRunning := False; FSelectedInputId := FormWaveDeviceSelect.SelectedInputId; FSelectedOutputId := FormWaveDeviceSelect.SelectedOutputId; FAudioIn .WaveDevice := FSelectedInputId; FAudioOut.WaveDevice := FSelectedOutputId; AudioRunning := WasRunning; end; procedure TFormModules.ClearVolumeIndicators; begin IndicatorBarVolumeInLeft .Value := 0.0; IndicatorBarVolumeInRight .Value := 0.0; IndicatorBarVolumeOutLeft .Value := 0.0; IndicatorBarVolumeOutRight.Value := 0.0; labeldbIn .Caption := '-'; labeldbOut.Caption := '-'; FdBInMax := -333; FdBOutMax := -333; end; procedure TFormModules.ShowOverUnderFlows; var unders : Integer; overs : Integer; begin unders := 0; overs := 0; if Assigned( FSynthPatch) then begin unders := FSynthPatch.Underflows; overs := FSynthPatch.Overflows; end; LabelUnderflows.Caption := Format( 'underflows: %d', [ unders], AppLocale); LabelOverflows .Caption := Format( 'overflows: %d' , [ overs ], AppLocale); end; procedure TFormModules.ShowRunTime; var Delta : TDateTime; begin Delta := Now - FStartTime; LabelRunTime.Caption := Format( FormatDateTime( '"%.2d":hh:mm:ss', Delta), [ Floor( Delta)]); end; procedure TFormModules.ClearDisplayRunTime; begin FStartTime := Now; ShowRunTime; end; procedure TFormModules.ConnectorDelete( const aConnector: TKnobsConnector); begin if Assigned( EditorPatch) then EditorPatch.ConnectorDelete( aConnector); end; procedure TFormModules.ConnectorBreak( const aConnector: TKnobsConnector); begin if Assigned( EditorPatch) then EditorPatch.ConnectorBreak( aConnector); end; procedure TFormModules.ConnectorDisconnect( const aConnector: TKnobsConnector); begin if Assigned( EditorPatch) then EditorPatch.ConnectorDisconnect( aConnector); end; procedure TFormModules.ModuleCut( const aModule: TKnobsModule); begin if Assigned( EditorPatch) and Assigned( aModule) then begin aModule.SelectUnique; CutModules; end; end; procedure TFormModules.ModuleCopy( const aModule: TKnobsModule); begin if Assigned( EditorPatch) and Assigned( aModule) then begin aModule.SelectUnique; CopyModules; end; end; procedure TFormModules.ModuleDelete( const aModule: TKnobsModule); begin if Assigned( EditorPatch) and Assigned( aModule) then begin aModule.SelectUnique; DeleteModules; end; end; procedure TFormModules.KnobSetDefaultValue( const aValuedControl: TKnobsValuedControl); begin if Assigned( aValuedControl) then aValuedControl.SetDefault; end; procedure TFormModules.KnobChangeLock( const aKnob: TKnobsKnob); begin if Assigned( aKnob) then aKnob.Locked := not aKnob.Locked; end; // private procedure TFormModules.SetWireThickness( aValue: Integer); begin if aValue <> FWireThickness then begin FWireThickness := aValue; if Assigned( EditorPatch) then EditorPatch.WireThickness := aValue; end; end; procedure TFormModules.SetCurvedLines( aValue: Boolean); begin if aValue <> FCurvedLines then begin FCurvedLines := aValue; if Assigned( EditorPatch) then EditorPatch.CurvedLines := aValue; CheckBoxCurvedLines.Checked := aValue; end; end; procedure TFormModules.SetControlMode( aValue: TDistanceMode); begin if aValue <> FControlMode then begin FControlMode := aValue; if Assigned( EditorPatch) then EditorPatch.ControlMode := FControlMode; RadioGroupControlMode.ItemIndex := Integer( FControlMode); end; end; function TFormModules.GetReferenceA: TSignal; begin Result := KnobsConversions.ReferenceA; end; procedure TFormModules.SetReferenceA( aValue: TSignal); begin if aValue <> KnobsConversions.ReferenceA then begin KnobsConversions.ReferenceA := aValue; EditReferenceA.Text := Format( '%.3f', [ aValue], AppLocale); end; end; function TFormModules.GetNotesPerOctave: TSignal; begin Result := KnobsConversions.NotesPerOctave; end; procedure TFormModules.SetNotesPerOctave( aValue: TSignal); begin if aValue <> KnobsConversions.NotesPerOctave then begin KnobsConversions.NotesPerOctave := aValue; EditNotesPerOctave.Text := Format( '%.3f', [ aValue], AppLocale); end; end; function TFormModules.GetMiddleNote: TSignal; begin Result := KnobsConversions.MiddleNote; end; procedure TFormModules.SetMiddleNote( aValue: TSignal); begin if aValue <> KnobsConversions.MiddleNote then begin KnobsConversions.MiddleNote := aValue; EditMiddleNote.Text := Format( '%.3f', [ aValue], AppLocale); end; end; // private function TFormModules.GetScalaScaleFile: string; begin if Assigned( FScalaScaleFile) then Result := FScalaScaleFile.FileName else Result := ''; end; procedure TFormModules.SetScalaScaleFile( const aValue: string); var aScaleFile : TScalaScaleFile; begin if FileExists( aValue) then begin aScaleFile := FScalaScaleFile; FScalaScaleFile := TScalaScaleFile.Create( aValue); JvFilenameEditScalaScaleFile.FileName := aValue; if Assigned( aScaleFile) then FreeAndNil( aScaleFile); end; end; function TFormModules.GetScalaMappingFile: string; begin if Assigned( FScalaMappingFile) then Result := FScalaMappingFile.FileName else Result := ''; end; procedure TFormModules.SetScalaMappingFile( const aValue: string); var aMappingFile : TScalaMappingFile; begin if FileExists( aValue) then begin aMappingFile := FScalaMappingFile; FScalaMappingFile := TScalaMappingFile.Create( aValue); JvFilenameEditScalaMappingFile.FileName := aValue; if Assigned( aMappingFile) then FreeAndNil( aMappingFile); end; end; // private procedure TFormModules.DoDesignerLog( aSender: TObject; const aMsg: string); begin Log( aMsg); end; procedure TFormModules.DoWirePanelLog( aSender: TObject; const aMsg: string); begin Log( aMsg); end; procedure TFormModules.DoHistoryChanged( aSender: TObject; anUndoCount, aRedoCount: Integer); begin MenuEditUndo.Enabled := anUndoCount > 0; MenuEditRedo.Enabled := aRedoCount > 0; PatchChanged := anUndoCount <> 0; end; procedure TFormModules.DoValueChanged( aSender: TObject; const aPath, aControlType: string; aValue: TSignal; IsFinal: Boolean); var aPrefix : string; aFullname : string; begin // An editor module control changed value, to be reflected in a synth setting if Assigned( FSynthPatch) then begin if IsFinal then HandleSpecialValues( aPath, aControlType, aValue); // Handle some special cases here ParsePrefix( aPath, aPrefix, aFullname); // Parse off the container prefix - and ignore that. FSynthPatch.AcceptParam( aFullname, aValue); // Pass on the value to the Synth end; end; procedure TFormModules.DoDisplayChanged( aSender: TObject; const aPath, aValue: string); var aPrefix : string; aRest : string; aValues : TSignals; aModuleName : string; aFullParamName : string; aModuleIndex : Integer; aModule : TMod; aParts : TStringList; // aKnob : TKnobsKnob; begin // An editor module's display changed value, to be reflected in a synth setting // These changes are assumed to always be 'final' - i.e. 'inbetween' edits should // not make it to here. And for now the value is assumed to be for a text based // sequencer only ... ok, but that is tested at least (TModTextSequencer) if Assigned( FSynthPatch) then begin ParsePrefix( aPath, aPrefix, aRest); // Parse off the container prefix - and ignore that. ParsePrefix( aRest, aModuleName, aFullParamName); aModuleIndex := FSynthPatch.FindModule( aModuleName); if aModuleIndex >= 0 then begin aModule := FSynthPatch.Module[ aModuleIndex]; if Assigned( aModule) then begin if ( aModule is TModTextSequencer) and SameText( aFullParamName, 'textsequencer_values') then begin aValues := ParseTextSequencerValue( aValue); if Assigned( aValues) then begin try TModTextSequencer( aModule).SetStepValues( aValues); finally aValues.Free; end; end; end else if ( aModule is TModWavePlayer ) and SameText( aFullParamName, 'waveplayer_display_filename' ) then begin aParts := Explode( aFullParamName, '_'); try if aParts.Count = 3 then aModule.StringValue[ aParts[ 2]] := aValue; finally aParts.Free; end; end else begin aParts := Explode( aFullParamName, '_'); try // aKnob := nil; // if aSender is TKnobsKnob // then aKnob := TKnobsKnob( aSender); if ( aParts.Count = 3) and SameText( aParts[ 1], 'display') then begin aModule.InternalStringValue[ aParts[ 2]] := aValue; // Which can set both a param value or an internal value // if Assigned( aKnob) // then aKnob.Value := TextToValue( aValue); ... this would kill the manully set value end; finally aParts.Free; end; end; end; end; end; end; procedure TFormModules.DoFileChanged( aSender: TObject; const aPath, aValue: string); var aPrefix : string; aRest : string; aModuleName : string; aFullParamName : string; aModuleIndex : Integer; aModule : TMod; aParts : TStringList; begin // An editor module's filename changed. if Assigned( FSynthPatch) then begin ParsePrefix( aPath, aPrefix, aRest); // Parse off the container prefix - and ignore that. ParsePrefix( aRest, aModuleName, aFullParamName); aModuleIndex := FSynthPatch.FindModule( aModuleName); if aModuleIndex >= 0 then begin aModule := FSynthPatch.Module[ aModuleIndex]; if Assigned( aModule) then begin if ( aModule is TModWavePlayer ) and SameText( aFullParamName, 'waveplayer_fileselector_filename' ) then begin aParts := Explode( aFullParamName, '_'); try if aParts.Count = 3 then aModule.StringValue[ aParts[ 2]] := aValue; finally aParts.Free; end; end; end; end; end; end; procedure TFormModules.DoShowHint( var aHintStr: string; var CanShow: Boolean; var aHintInfo: Vcl.Controls.THintInfo); begin if Pos( '~', aHintStr) > 0 then aHintInfo.HintWindowClass := TKnobsHintWindow else aHintInfo.HintWindowClass := THintWindow; end; function TFormModules.DoCreateModuleBitmap( aModuleType: TKnobsModuleType): TBitmap; begin Result := FormStore.CreateModuleBitmap( aModuleType); end; function TFormModules.DoReadModuleComment( aModuleType: TKnobsModuleType): string; begin Result := FormStore.ReadModuleComment( aModuleType); end; // private function TFormModules.SplitValueInfo( const aPath: string; var aModule: TKnobsCustomModule; var aModuleType, aSignalName: string): Boolean; var aParts : TStringList; bParts : TStringList; aModuleName : string; aMod : TKnobsCustomModule; begin Result := False; aModule := nil; aModuleType := ''; aSignalName := ''; aParts := Explode( aPath, '/'); try if aParts.Count >= 2 then begin aModuleName := aParts[ aParts.Count - 2]; aMod := EditorPatch.FindModule( aModuleName); if Assigned( aMod) then begin aSignalName := aParts[ aParts.Count - 1]; bParts := Explode( aSignalName, '_'); try if bParts.Count = 2 then begin aModuleType := bParts[ 0]; aSignalName := bParts[ 1]; aModule := aMod; Result := True; end; finally bParts.Free; end; end; end; finally aParts.Free; end; end; procedure TFormModules.HandleSpecialValues( const aPath, aControlType: string; aValue: TSignal); var aPostFix : string; aModule : TKnobsCustomModule; aModuleType : string; aSignalName : string; begin if SplitValueInfo( aPath, aModule, aModuleType, aSignalName) then begin aPostFix := ParsePostFix( aPath); if SameText( aPostFix, 'range') then ChangeRangeFor( aModule, aModuleType, aPostFix, aValue) else if SameText( aPostFix, 'arange') then ChangeRangeFor( aModule, aModuleType, aPostFix, aValue) else if SameText( aPostFix, 'hrange') then ChangeRangeFor( aModule, aModuleType, aPostFix, aValue) else if SameText( aPostFix, 'drange') then ChangeRangeFor( aModule, aModuleType, aPostFix, aValue) else if SameText( aPostFix, 'rrange') then ChangeRangeFor( aModule, aModuleType, aPostFix, aValue) else if SameText( aPostFix, 'mode') then ChangeModeFor( aModule, aModuleType, aValue) else if SameText( aPostFix, 'random') then HandleRandomFor( aModule, aModuleType, aValue); end; end; procedure TFormModules.ChangeRangeFor( const aModule: TKnobsCustomModule; const aModuleType, aRangeType: string; aValue: TSignal); var aKnob : TKnobsKnob; aKnobName : string; i : Integer; anEnvSpeed : TEnvRange; anLfoSpeed : TLfoRange; aDelaySize : TDelaySize; begin if Assigned( aModule) then begin with aModule do begin if SameText( aModuleType, 'envahd') or SameText( aModuleType, 'envadsr') then begin anEnvSpeed := SignalToEnvRange( aValue); for i := 0 to ComponentCount - 1 do begin if Components[ i] is TKnobsKnob then begin aKnob := TKnobsKnob( Components[ i]); aKnobName := aKnob.Name; if ( SameText( aKnobName, 'envahd_attack' ) and SameText( aRangeType, 'arange')) or ( SameText( aKnobName, 'envahd_hold' ) and SameText( aRangeType, 'hrange')) or ( SameText( aKnobName, 'envahd_decay' ) and SameText( aRangeType, 'drange')) or ( SameText( aKnobName, 'envadsr_attack' ) and SameText( aRangeType, 'arange')) or ( SameText( aKnobName, 'envadsr_decay' ) and SameText( aRangeType, 'drange')) or ( SameText( aKnobName, 'envadsr_release') and SameText( aRangeType, 'rrange')) then begin case anEnvSpeed of esFast : aKnob.ControlType := 'EnvTimeFast' ; esMedium : aKnob.ControlType := 'EnvTimeMedium'; esSlow : aKnob.ControlType := 'EnvTimeSlow' ; end; end; end; end; end else if SameText( aModuleType, 'lfo') or SameText( aModuleType, 'randomwalklfo') or SameText( aModuleType, 'lfotrig') or SameText( aModuleType, 'squarelfo') then begin anLfoSpeed := SignalToLfoRange( aValue); for i := 0 to ComponentCount - 1 do begin if Components[ i] is TKnobsKnob then begin aKnob := TKnobsKnob( Components[ i]); aKnobName := aKnob.Name; if SameText( aKnobName, 'lfo_frequency' ) or SameText( aKnobName, 'randomwalklfo_frequency') or SameText( aKnobName, 'lfotrig_frequency' ) or SameText( aKnobName, 'squarelfo_frequency' ) then begin case anLfoSpeed of lsFast : aKnob.ControlType := 'LfoFreqCoarseFast' ; lsMedium : aKnob.ControlType := 'LfoFreqCoarseMedium'; lsSlow : aKnob.ControlType := 'LfoFreqCoarseSlow' ; lsBPM : aKnob.ControlType := 'LfoFreqCoarseBPM' ; end; end end; end; end else if SameText( aModuleType, 'delay') then begin aDelaySize := SignalToDelaySize( aValue); for i := 0 to ComponentCount - 1 do begin if Components[ i] is TKnobsKnob then begin aKnob := TKnobsKnob( Components[ i]); aKnobName := aKnob.Name; if SameText( aKnobName, 'delay_length') then begin case aDelaySize of dsShort : aKnob.ControlType := 'DelayTimeShort'; dsMedium : aKnob.ControlType := 'DelayTimeMedium'; dsLong : aKnob.ControlType := 'DelayTimeLong'; end; end; end; end; end; end; end; end; procedure TFormModules.ChangeModeFor( const aModule: TKnobsCustomModule; const aModuleType: string; aValue: TSignal); var aKnob : TKnobsKnob; i : Integer; begin if Assigned( aModule) then begin if SameText( aModuleType, 'scaler') then begin aKnob := nil; with aModule do begin for i := 0 to ComponentCount - 1 do begin if Components[ i] is TKnobsKnob then begin aKnob := TKnobsKnob( Components[ i]); // Pick the first Knob found ... it should be paired in the designer already. Break; end; end; end; if Assigned( aKnob) then aKnob.PairingMode := TKnobsPairingMode( SignalToInt( aValue)); end else if SameText( aModuletype, 'mixm4to1') or SameText( aModuletype, 'mixs2to1') or SameText( aModuletype, 'mixm6to6') then begin with aModule do begin for i := 0 to ComponentCount - 1 do begin if Components[ i] is TKnobsKnob then begin if SignalToInt( aValue) = 0 then TKnobsKnob( Components[ i]).ControlType := 'linear[-1,1]' else TKnobsKnob( Components[ i]).ControlType := 'dB[0,1]' end; end; end; end else if SameText( aModuletype, 'constant' ) or SameText( aModuletype, 'amplifier') then begin with aModule do begin for i := 0 to ComponentCount - 1 do begin if Components[ i] is TKnobsKnob then begin if SignalToInt( aValue) = 0 then TKnobsKnob( Components[ i]).ControlType := 'linear[-4,4]' else TKnobsKnob( Components[ i]).ControlType := 'dB[0,4]' end; end; end; end; end; end; procedure TFormModules.HandleRandomFor( const aModule: TKnobsCustomModule; const aModuleType: string; aValue: TSignal); var aKnob : TKnobsKnob; i : Integer; begin if SameText( aModuleType, 'sequencer') then begin if Assigned( aModule) then begin with aModule do begin for i := 0 to ComponentCount - 1 do begin if Components[ i] is TKnobsNoKnob then begin aKnob := TKnobsKnob( Components[ i]); if SameText( aKnob.ControlType, 'NoteName') then aKnob.KnobPosition := Random( aKnob.StepCount); end; end; end; end; end; end; procedure TFormModules.DoLights( aSender: TMod; const aMsg: string); // A synth signal to be reflected in a module light var aTmp : string; // use aTmp to avoid crashes in optimized code - see comments in ParsePrefix code aPrefix : string; aRest : string; aModule : string; aSignal : string; aValue : string; aMod : TKnobsCustomModule; aVal : TSignal; begin ParsePrefix( aMsg, aPrefix, aTmp); // Strip off the container prefix ParsePrefix( aTmp, aModule, aRest); // Strip off the module aMod := EditorPatch.FindModule( aModule); // Find the module in the editor if Assigned( aMod) then begin ParsePrefix( aRest, aSignal, aValue); // Strip off the signal name aVal := StrToFloatDef( aValue, -1); // which leaves the value ... aMod.SetLight( aSignal, aVal); end; end; procedure TFormModules.DoData( aSender: TMod; const aPath: string; const aData: TSignalArray); // A synth signal to be reflected in a module control var aTmp : string; // use aTmp to avoid crashes in optimized code - see comments in ParsePrefix code aPrefix : string; aModule : string; aSignal : string; aMod : TKnobsCustomModule; begin ParsePrefix( aPath, aPrefix, aTmp); // Strip off the container prefix ParsePrefix( aTmp, aModule, aSignal); // Strip off the module, leaving the signal name aMod := EditorPatch.FindModule( aModule); // Find the module in the editor if Assigned( aMod) then aMod.SetData( aSignal, TSignalArray( aData)); end; procedure TFormModules.DoInfo( aSender: TMod; const aMsg: string); // A synth signal to be reflected in a module light var aTmp : string; // use aTmp to avoid crashes in optimized code - see comments in ParsePrefix code aPrefix : string; aRest : string; aModule : string; aSignal : string; aValue : string; aMod : TKnobsCustomModule; begin ParsePrefix( aMsg, aPrefix, aTmp); // Strip off the container prefix ParsePrefix( aTmp, aModule, aRest); // Strip off the module aMod := EditorPatch.FindModule( aModule); // Find the module in the editor if Assigned( aMod) then begin ParsePrefix( aRest, aSignal, aValue); // Strip off the signal name aMod.SetInfo( aSignal, aValue); // which leaves the value ... end; end; procedure TFormModules.DoPatchChanged( aSender: TKnobsWirePanel); // The patch changed module, module-type or wire wise. begin CompilePatch; end; procedure TFormModules.DoShowPopupMenu( const aSender: TKnobsWirePanel; const aControl: TControl); procedure ShowPopupConnector( aPopup: TPopupMenu; aControl: TControl); begin FPopupSender := aControl; PopupMenuConnector.Popup( aControl.ClientOrigin.X + 10, aControl.ClientOrigin.Y + 10); end; procedure ShowPopupModule( aPopup: TPopupMenu; aControl: TControl); begin FPopupSender := aControl; PopupMenuModule.Popup( aControl.ClientOrigin.X + 10, aControl.ClientOrigin.Y + 10); end; procedure ShowPopupValuedControl( aPopup: TPopupMenu; aControl: TControl); begin FPopupSender := aControl; if aControl is TKnobsKnob then LockKnob.Checked := TKnobsKnob( aControl).Locked else LockKnob.Visible := False; PopupMenuKnob.Popup( aControl.ClientOrigin.X + 10, aControl.ClientOrigin.Y + 10); end; begin if aControl is TKnobsConnector then ShowPopupConnector( PopupMenuConnector, aControl) else if aControl is TKnobsModule then ShowPopupModule( PopupMenuModule, aControl) else if aControl is TKnobsValuedControl then ShowPopupValuedControl( PopupMenuModule, aControl); end; function TFormModules.SavePatch: Boolean; var aFileName : string; begin aFileName := EditorPatch.Filename; if FileExists( aFileName) then begin FPatchWriter.WriteFile( EditorPatch, aFileName); EditorPatch.ClearUndoRedo; Result := True; end else Result := SavePatchAs; end; function TFormModules.SavePatchAs: Boolean; begin Result := False; with SaveDialogPatch do begin if FileName = '' then Filename := EditorPatch.Filename; InitialDir := ExtractFilePath( Filename); FileName := ExtractFileName( Filename); if InitialDir = '' then InitialDir := ApplicationPath + 'patches'; if Execute then begin SourceFileName := FileName; PatchName := CleanFileName( FileName); FPatchWriter.WriteFile( EditorPatch, FileName); EditorPatch.ClearUndoRedo; Result := True; end; end; end; procedure TFormModules.DoLoadPatch( const aFileName: string); begin if FileExists( aFileName) then begin EditorPatch.BlockScreenUpdates; try LogFmt( 'loading file %s', [ aFileName]); SourceFileName := aFileName; FPatchReader.ReadFile( aFileName, EditorPatch, rmReplace); PatchName := EditorPatch.Title; EditorPatch.ClearUndoRedo; EditorPatch.UnSelectAllModules; finally EditorPatch.UnblockScreenUpdates; end; end; end; procedure TFormModules.LoadPatch; begin with OpenDialogPatch do begin if FileName = '' then Filename := EditorPatch.Filename; InitialDir := ExtractFilePath( Filename); FileName := ExtractFileName( Filename); if InitialDir = '' then InitialDir := ApplicationPath + 'patches'; if Execute then DoLoadPatch( FileName); end; end; procedure TFormModules.NewPatch; begin SourceFileName := 'new'; if Assigned( EditorPatch) then begin EditorPatch.FreeModules; EditorPatch .Title := 'new'; EditPatchName.Text := 'new'; end; end; procedure TFormModules.DeleteModules; begin if Assigned( EditorPatch) then EditorPatch.FreeSelectedModules; end; procedure TFormModules.CutModules; begin CopyModules; DeleteModules; end; procedure TFormModules.CopyModules; begin if Assigned( FPatchWriter) then FPatchWriter.WriteToClipboard( EditorPatch, wmSelected); end; procedure TFormModules.PasteModules; begin if Assigned( FPatchReader) then FPatchReader.ReadFromClipboard( EditorPatch, rmAppend); end; procedure TFormModules.SelectAll; begin if Assigned( EditorPatch) then EditorPatch.SelectAllModules; end; procedure TFormModules.SelectNone; begin if Assigned( EditorPatch) then EditorPatch.UnselectAllModules; end; procedure TFormModules.InvertSelection; begin if Assigned( EditorPatch) then EditorPatch.InvertModuleSelection; end; procedure TFormModules.WiggleWires; begin if Assigned( EditorPatch) then EditorPatch.WiggleWires; end; procedure TFormModules.SearchPatch( const aValue: string); begin if Assigned( EditorPatch) then EditorPatch.Search( aValue); end; // private function TFormModules.FunctionalPinName( const aName: string): string; var aList: TStringList; begin aList := Explode( aName, '_'); Result := ''; try if aList.Count = 2 then Result := aList[ 1]; finally aList.Free; end; end; function TFormModules.SplitConnectorName( const aName: string; var aMod, aPin: string): Boolean; var aList: TStringList; begin aMod := ''; aPin := ''; Result := False; aList := Explode( aName, '.'); try if aList.Count = 2 then begin aMod := aList[ 0]; aPin := aList[ 1]; Result := True; end; finally aList.Free; end; end; function TFormModules.ModuleTypeToModule( aType: Integer; const aParent: TSynthPatch; const aName: string): TMod; function CreateMod( aClass: TModuleClass): TMod; begin Result := aClass.Create( aParent, aName); end; begin Result := nil; case aType of 101 : Result := CreateMod( TModInput ); 102 : Result := CreateMod( TModOutput ); 201 : Result := CreateMod( TModXFade ); 202 : Result := CreateMod( TModPan ); 203 : Result := CreateMod( TModMixM4to1 ); 204 : Result := CreateMod( TModMixS2to1 ); 205 : Result := CreateMod( TModMixM6to6 ); 301 : Result := CreateMod( TModConstant ); 302 : Result := CreateMod( TModInverter ); 303 : Result := CreateMod( TModAdder ); 304 : Result := CreateMod( TModMultiplier ); 305 : Result := CreateMod( TModAmplifier ); 306 : Result := CreateMod( TModScaler ); 307 : Result := CreateMod( TModQuantize ); 308 : Result := CreateMod( TModRatio ); 309 : Result := CreateMod( TModRotator ); 310 : Result := CreateMod( TModRectifier ); 311 : Result := CreateMod( TModMinMax ); 312 : Result := CreateMod( TModIntDif ); 401 : Result := CreateMod( TModLfo ); 402 : Result := CreateMod( TModSquareLfo ); 403 : Result := CreateMod( TModNoiseLfo ); 404 : Result := CreateMod( TModRandomWalkLfo); 405 : Result := CreateMod( TModLfoTrig ); 406 : Result := CreateMod( TModSquareLfoTrig); 407 : Result := CreateMod( TModNoiseLfoTrig ); 501 : Result := CreateMod( TModOsc ); 502 : Result := CreateMod( TModSquare ); 503 : Result := CreateMod( TModNoise ); 504 : Result := CreateMod( TModTrigOsc ); 505 : Result := CreateMod( TModSquareTrig ); 506 : Result := CreateMod( TModNoiseTrig ); 601 : Result := CreateMod( TModNot ); 602 : Result := CreateMod( TModGate ); 603 : Result := CreateMod( TModDivider ); 604 : Result := CreateMod( TModDFlipFlop ); 605 : Result := CreateMod( TModRSFlipFlop ); 701 : Result := CreateMod( TModDelay ); 702 : Result := CreateMod( TModWavePlayer ); 801 : Result := CreateMod( TModSampleAndHold); 802 : Result := CreateMod( TModTrackAndHold ); 803 : Result := CreateMod( TModSwitch2to1 ); 901 : Result := CreateMod( TModEnvAR ); 902 : Result := CreateMod( TModEnvARRetrig ); 903 : Result := CreateMod( TModEnvAHD ); 904 : Result := CreateMod( TModEnvADSR ); 1001 : Result := CreateMod( TModAverage ); 1002 : Result := CreateMod( TModSVF ); 1101 : Result := nil; // a panel1, no need to compile it. 1102 : Result := nil; // a panel2, no need to compile it. 1103 : Result := nil; // a panel3, no need to compile it. 1104 : Result := nil; // a panel4, no need to compile it. 1105 : Result := nil; // a panel5, no need to compile it. 1106 : Result := CreateMod( TModDisplay ); 1107 : Result := nil; // a notes , no need to compile it. 1201 : Result := CreateMod( TModSequencer ); 1202 : Result := CreateMod( TModTextSequencer); 1203 : Result := CreateMod( TModSeqStep ); 1204 : Result := CreateMod( TModSeqClockStep ); 1301 : Result := CreateMod( TModMidiNoteIn ); 1302 : Result := CreateMod( TModMidiCCIn ); 1303 : Result := CreateMod( TModMidiNoteOut ); // BOHM 4000 .. 4999 : Result := HrastUnit.CreateModule( aType, aParent, aName); // EOHM end; end; procedure TFormModules.CompilePatch; // This creates a synth patch from an editor patch and then // changed the the current synth patch for the new one. var aSynthPatch : TSynthPatch; i : Integer; aPatchModule : TKnobsCustomModule; aModuleType : Integer; aModuleName : string; aModule : TMod; S : string; aWire : TKnobsWire; aSrcConnector : string; aDstConnector : string; aSrcMod : string; aSrcPin : string; aDstMod : string; aDstPin : string; begin Log( 'compiling synth patch'); if Assigned( EditorPatch) then begin aSynthPatch := TSynthPatch.Create( nil, PatchName); try aSynthPatch.Version := EditorPatch.Version; with EditorPatch do begin for i := 0 to ModuleCount - 1 do begin aPatchModule := Module[ i]; aModuleType := aPatchModule.ModuleType; aModuleName := aPatchModule.Name; aModule := ModuleTypeToModule( aModuleType, aSynthPatch, aModuleName); if Assigned( aModule) // Module translates then aSynthPatch.AddModule( aModule); end; FixAllWires; // Get the wire directions right before wire compilation for i := 0 to WireCount - 1 do begin aWire := Wire[ i]; aSrcConnector := aWire.SourceName; aDstConnector := aWire.DestinationName; if SplitConnectorName( aSrcConnector, aSrcMod, aSrcPin) and SplitConnectorName( aDstConnector, aDstMod, aDstPin) and not SameText( aSrcMod, '') and not SameText( aDstMod, '') and not SameText( aSrcPin, '') and not SameText( aDstPin, '') then begin aSrcPin := FunctionalPinName( aSrcPin); aDstPin := FunctionalPinName( aDstPin); aSynthPatch.AddConnection( aSrcMod, aSrcPin, aDstMod, aDstPin); end; end; // for i := 0 to WireCount - 1 if not ChangeSynthPatch( aSynthPatch) then FreeAndNil( aSynthPatch); // Some debug stuff - write the just created synth patch to test.txt - in the current (application) directory if CompilerDebug and Assigned( FSynthPatch) then begin S := ''; FSynthPatch.Save( 0, S); StringTofile( S, 'test.txt'); end; end; // with WirePanel .. except aSynthPatch.Free; end; // try ... except end; // if Assigned( aWirePanel) Log( 'compiled synth patch'); end; // private procedure TFormModules.InitializeCPUCounter; begin FCpuUsageData := CreateCpuUsageCounter( GetCurrentProcessId); end; procedure TFormModules.FinalizeCPUCounter; begin if Assigned( FCpuUsageData) then begin DestroyCpuUsageCounter( FCpuUsageData); FCpuUsageData := nil; end; end; procedure TFormModules.TickCPUCounter; begin if Assigned( FCpuUsageData) then FProcessTime := ( FProcessTime + 2 * GetCpuUsage( FCpuUsageData) / CpuCount) / 3 else FProcessTime := -1; end; // private procedure TFormModules.StartNetMidiConnectTimer; begin StopNetMidiConnectTimer; TimerNetMidiConnect.Interval := 1000; TimerNetMidiConnect.Enabled := True; end; procedure TFormModules.StopNetMidiConnectTimer; begin TimerNetMidiConnect.Enabled := False; end; procedure TFormModules.NetMidiConnectTimerFired; begin if NetMidiAutoConnect and not NetMidiConnected then NetMidiConnect; end; procedure TFormModules.NetMidiConnect; begin if not NetMidiConnected then begin // set net midi connect params WSocketNetMidi.Addr := NetMidiServer; WSocketNetMidi.Port := NetMidiPort; // start net midi client WSocketNetMidi.Connect; end; end; procedure TFormModules.NetMidiDisconnect; begin if NetMidiConnected then begin // stop net midi client WSocketNetMidi.Close; end; end; procedure TFormModules.NetMidiApply; var WasConnected : Boolean; begin WasConnected := NetMidiConnected; NetMidiDisconnect; NetMidiServer := EditNetMidiServer.Text; NetMidiPort := EditNetMidiPort .Text; if WasConnected then NetMidiConnect; NetMidiChanged := False; end; procedure TFormModules.NetMidiCancel; begin EditNetMidiServer.Text := NetMidiServer; EditNetMidiPort .Text := NetMidiPort; NetMidiChanged := False; end; function TFormModules.SocketStateToStr( aValue: TSocketState): string; begin Result := GetEnumName(TypeInfo( TSocketState), Integer( aValue)); end; procedure TFormModules.ReceiveNetMidi; var aBuffer : array[ 0 .. 1023] of Byte; aCount : Integer; aData : TBytes; i : Integer; begin aCount := WSocketNetMidi.Receive( @ aBuffer, 1024); if aCount > 0 then begin SetLength( aData, aCount); for i := 0 to aCount - 1 do aData[ i] := aBuffer[ i]; AcceptNetMidi( aData); end; end; procedure TFormModules.SendNetMidi( const aData: TBytes); type TPackedBytes = array[ 0 .. MaxInt - 1] of Byte; PPackedBytes = ^TPackedBytes; var Bytes : PPackedBytes; Res : Integer; i : Integer; begin if Length( aData) > 0 then begin GetMem( Bytes, Length( aData)); try for i := 0 to Length( aData) - 1 do Bytes^[ i] := aData[ i]; Res := WSocketNetMidi.Send( Bytes, Length( aData)); if Res > 0 then begin LedNetMidiTx1.Active := True; LedNetMidiTx2.Active := True; end else MidiLogFmt( 'TX error : %d', [ Res]); finally FreeMem( Bytes); end; end; end; procedure TFormModules.AcceptNetMidi( const aData: TBytes); var i : Integer; begin for i := 0 to Length( aData) - 1 do AcceptMidiByte( aData[ i]); end; procedure TFormModules.AcceptMidiByte( aByte: Byte); begin case FMidiRxState of mrxNormal : begin if aByte and $80 = $80 then AcceptMidiCommand( aByte); end; mrxRunningStatus : begin if aByte and $80 = $80 then AcceptMidiCommand( aByte) else AcceptMidiData ( aByte); end; end; end; procedure TFormModules.AcceptMidiCommand( aByte: Byte); begin FMidiDataCount := 0; case aByte and $f0 of CSysEx : AcceptMidiSysex( aByte); else begin FMidiRunningStatus := aByte; FMidiRxState := mrxRunningStatus; FMidiChannel := aByte and $0f; end; end; end; procedure TFormModules.AcceptMidiData( aByte: Byte); begin case FMidiRunningStatus of CNoteOff : // = $80; // Length = 3; begin if FMidiDataCount = 1 then MidiProcessNoteOff( aByte, FMidiData, FMidiChannel) else begin FMidiData := aByte; Inc( FMidiDataCount); end; end; CNoteOn : // = $90; // Length = 3; begin if FMidiDataCount = 1 then MidiProcessNoteOn( aByte, FMidiData, FMidiChannel) else begin FMidiData := aByte; Inc( FMidiDataCount); end; end; CKeyPressure : // = $a0; // Length = 3; begin if FMidiDataCount = 1 then MidiProcessKeyPressure( aByte, FMidiData, FMidiChannel) else begin FMidiData := aByte; Inc( FMidiDataCount); end; end; CControlChange : // = $b0; // Length = 3; begin if FMidiDataCount = 1 then MidiProcessControlChange( aByte, FMidiData, FMidiChannel) else begin FMidiData := aByte; Inc( FMidiDataCount); end; end; CProgramChange : // = $c0; // Length = 2; begin MidiProcessProgramChange( aByte,FMidiChannel); end; CChannelPressure : // = $d0; // Length = 2; begin MidiProcessChannelPressure( aByte,FMidiChannel); end; CPitchBend : // = $e0; // Length = 2; begin if FMidiDataCount = 1 then MidiProcessPitchBend(( aByte and $7f) + 128 * ( FMidiData and $7f), FMidiChannel) else begin FMidiData := aByte; Inc( FMidiDataCount); end; end; CSysEx : // = $f0; // Length = n; begin MidiProcessSysExData( aByte); end; SSongPosition : begin if FMidiDataCount = 1 then MidiProcessSongPosition(( aByte and $7f) + 128 * ( FMidiData and $7f)) else begin FMidiData := aByte; Inc( FMidiDataCount); end; end; SSongSelect : begin MidiProcessSongSelect( aByte); end; else MidiReset; end; end; procedure TFormModules.AcceptMidiSysex( aByte: Byte); begin case aByte and $0f of SSysEx : // = $00; // Length = 1, followed by arbitrary amt of data, finalized by SEox; begin FMidiRunningStatus := SSysEx; FMidiRxState := mrxRunningStatus; MidiProcessStartSysEx; end; SSongPosition : // = $02; // Length = 3; begin FMidiRunningStatus := SSongPosition; FMidiRxState := mrxRunningStatus; end; SSongSelect : // = $03; // Length = 2; begin FMidiRunningStatus := SSongPosition; FMidiRxState := mrxRunningStatus; end; STuneRequest : // = $06; // Length = 1; begin MidiProcessTuneRequest; end; SEox : // = $07; // Length = 1; begin MidiProcessEndSysEx; end; STimingClock : // = $08; // Length = 1; begin MidiProcessTimingClock; end; SStart : // = $0a; // Length = 1; begin MidiProcessStart; end; SContinue : // = $0b; // Length = 1; begin MidiProcessContinue; end; SStop : // = $0c; // Length = 1; begin MidiProcessStop; end; SActiveSense : // = $0e; // Length = 1; begin MidiProcessActiveSense; end; SReset : // = $0f; // Length = 1; begin MidiProcessReset; end; end; end; procedure TFormModules.MidiReset; begin FMidiRxState := mrxNormal; FMidiRunningStatus := 0; end; procedure TFormModules.MidiProcessNoteOff( aVelocity, aNote, aChannel: Byte); begin MidiProcessMessage( MakeMidiNoteOff( aVelocity, aNote, aChannel)); end; procedure TFormModules.MidiProcessNoteOn( aVelocity, aNote, aChannel: Byte); begin if aVelocity = 0 then MidiProcessMessage( MakeMidiNoteOff( 0 , aNote, aChannel)) else MidiProcessMessage( MakeMidiNoteOn ( aVelocity, aNote, aChannel)); end; procedure TFormModules.MidiProcessKeyPressure( aPressure, aNote, aChannel: Byte); begin MidiProcessMessage( MakeMidiKeyPressure( aPressure, aNote, aChannel)); end; procedure TFormModules.MidiProcessControlChange( aValue, aController, aChannel: Byte); begin MidiProcessMessage( MakeMidiControlChange( aValue, aController, aChannel)); end; procedure TFormModules.MidiProcessProgramChange( aProgram, aChannel: Byte); begin MidiProcessMessage( MakeMidiProgramChange( aProgram, aChannel)); end; procedure TFormModules.MidiProcessChannelPressure( aValue, aChannel: Byte); begin MidiProcessMessage( MakeMidiChannelPressure( aValue, aChannel)); end; procedure TFormModules.MidiProcessPitchBend( aData: Word; aChannel: Byte); begin MidiProcessMessage( MakeMidiPitchBend( aData, aChannel)); end; procedure TFormModules.MidiProcessStartSysEx; begin SetLength( FMidiSysex, 0); end; procedure TFormModules.MidiProcessEndSysEx; begin // Sysex message completed and stored in FMidiSysex MidiProcessMessage( MakeMidiSysExData( FMidiSysex)); end; procedure TFormModules.MidiProcessSongPosition( aData: Word); begin MidiProcessMessage( MakeMidiSongPosition( aData)); end; procedure TFormModules.MidiProcessSongSelect( aSong: Byte); begin MidiProcessMessage( MakeMidiSongSelect( aSong)); end; procedure TFormModules.MidiProcessTuneRequest; begin MidiProcessMessage( MakeMidiTuneRequest); end; procedure TFormModules.MidiProcessTimingClock; begin MidiProcessMessage( MakeMidiTimingClock); end; procedure TFormModules.MidiProcessStart; begin MidiProcessMessage( MakeMidiStart); end; procedure TFormModules.MidiProcessContinue; begin MidiProcessMessage( MakeMidiContinue); end; procedure TFormModules.MidiProcessStop; begin MidiProcessMessage( MakeMidiStop); end; procedure TFormModules.MidiProcessActiveSense; begin MidiProcessMessage( MakeMidiActiveSense); end; procedure TFormModules.MidiProcessReset; begin MidiProcessMessage( MakeMidiReset); end; procedure TFormModules.MidiProcessSysExData( aData: Byte); begin if Length( FMidiSysex) >= 1024 // Prevent buffer from getting arbitrary large then begin MidiProcessEndSysEx; // process the partial message MidiProcessStartSysEx; // and start a new one end; SetLength( FMidiSysex, Length( FMidiSysex) + 1); FMidiSysex[ Length( FMidiSysex) - 1] := aData; end; procedure TFormModules.MidiProcessMessage( const aMsg: TMidiMessage); begin if Assigned( FSynthPatch) and AudioRunning then begin FSynthPatch.AcceptMidi( aMsg); MidiMsgLogFmt( 'RX : %s', [ MidiMessageToLog( aMsg)]); end; end; procedure TFormModules.DoMidiSendMessage( aSender: TObject; const aMsg: TMidiMessage); var aData : TBytes; begin MidiMessageToBytes( aMsg, aData); SendNetMidi( aData); MidiMsgLogFmt( 'TX : %s', [ MidiMessageToLog( aMsg)]); end; // public procedure TFormModules.MemoDebugWindowProc( var aMsg: TMessage); var aTicks : SmallInt; aScrollMsg : TWMVScroll; begin if aMsg.Msg = WM_MOUSEWHEEL then begin aScrollMsg.Msg := WM_VSCROLL; aTicks := SmallInt( HiWord( aMsg.WParam)); if aTicks > 0 then aScrollMsg.ScrollCode := SB_LINEUP else aScrollMsg.ScrollCode := SB_LINEDOWN; aScrollMsg.Pos := 0; MemoDebug.Dispatch( aScrollMsg) ; end else FOldMemoDebug( aMsg); end; function TFormModules.IsShortCut( var aMessage: TWMKey): Boolean; // override; begin if EditorPatch.HasEditPopup then Result := False else Result := inherited IsShortcut( aMessage); end; // Delphi area procedure TFormModules.LockKnobClick(Sender: TObject); begin KnobChangeLock( FPopupSender as TKnobsKnob); end; procedure TFormModules.SetKnobDefaultvalueClick(Sender: TObject); begin KnobSetDefaultValue( FPopupSender as TKnobsValuedcontrol) end; procedure TFormModules.DeleteModuleClick(Sender: TObject); begin ModuleDelete( FPopupSender as TKnobsModule); end; procedure TFormModules.CopyModuleClick(Sender: TObject); begin ModuleCopy( FPopupSender as TKnobsModule); end; procedure TFormModules.CutModuleClick(Sender: TObject); begin ModuleCut( FPopupSender as TKnobsModule); end; procedure TFormModules.DisconnectConnectorClick(Sender: TObject); begin ConnectorDisconnect( FPopupSender as TKnobsConnector); end; procedure TFormModules.DeleteConnectorClick(Sender: TObject); begin ConnectorDelete( FPopupSender as TKnobsConnector); end; procedure TFormModules.JvFilenameEditScalaMappingFileAfterDialog(Sender: TObject; var AName: string; var AAction: Boolean); begin if AAction then ScalaMappingFile := AName; end; procedure TFormModules.JvFilenameEditScalaMappingFileBeforeDialog(Sender: TObject; var AName: string; var AAction: Boolean); begin if AAction then AName := ScalaMappingFile; end; procedure TFormModules.JvFilenameEditScalaScaleFileAfterDialog(Sender: TObject; var AName: string; var AAction: Boolean); begin if AAction then ScalaScaleFile := AName; end; procedure TFormModules.JvFilenameEditScalaScaleFileBeforeDialog(Sender: TObject; var AName: string; var AAction: Boolean); begin if AAction then AName := ScalaScaleFile; end; procedure TFormModules.Find1Click(Sender: TObject); begin EditSearch.SetFocus; end; procedure TFormModules.Profile1Click(Sender: TObject); begin ProfilePatch; end; procedure TFormModules.WSocketNetMidiBgException(Sender: TObject; E: Exception; var CanClose: Boolean); begin MidiLogFmt( 'exception : %s', [ E.Message]); CanClose := True; end; procedure TFormModules.WSocketNetMidiChangeState(Sender: TObject; OldState, NewState: TSocketState); begin MidiLogFmt( 'state changed from %s to %s', [ SocketStateToStr( OldState), SocketStateToStr( NewState)]); end; procedure TFormModules.WSocketNetMidiDataAvailable(Sender: TObject; ErrCode: Word); begin // MidiLogFmt( 'data available, error code %d', [ ErrCode]); LedNetMidiRx1.Active := True; LedNetMidiRx2.Active := True; ReceiveNetMidi; end; procedure TFormModules.WSocketNetMidiDataSent(Sender: TObject; ErrCode: Word); begin // MidiLogFmt( 'data sent, error code %d', [ ErrCode]); LedNetMidiTx1.Active := True; LedNetMidiTx2.Active := True; end; procedure TFormModules.WSocketNetMidiError(Sender: TObject); begin MidiLog( 'error (no further specification available)'); end; procedure TFormModules.WSocketNetMidiSessionClosed(Sender: TObject; ErrCode: Word); begin MidiLogFmt( 'session closed, error code %d', [ ErrCode]); NetMidiConnected := False; if NetMidiAutoConnect then StartNetMidiConnectTimer; end; procedure TFormModules.WSocketNetMidiSessionConnected(Sender: TObject; ErrCode: Word); begin MidiLogFmt( 'session connected, error code %d', [ ErrCode]); NetMidiConnected := True; end; procedure TFormModules.MenuViewGraphsClick(Sender: TObject); begin PageControlMain.ActivePage := TabSheetDebug; PageControlDGSA.ActivePage := TabSheetGraph; end; procedure TFormModules.MenuViewDebuggerClick(Sender: TObject); begin PageControlMain.ActivePage := TabSheetDebug; PageControlDGSA.ActivePage := TabSheetText; end; procedure TFormModules.EditMiddleNoteChange(Sender: TObject); var F : TSignal; begin if EditMiddleNote.Text <> '' then begin F := StrToFloatDef( EditMiddleNote.Text, NaN); if not IsNan( F) and not AlmostZero( F) then MiddleNote := F; end; end; procedure TFormModules.EditNetMidiPortChange(Sender: TObject); begin NetMidiChanged := True; end; procedure TFormModules.EditNetMidiServerChange(Sender: TObject); begin NetMidiChanged := True; end; procedure TFormModules.EditNotesPerOctaveChange(Sender: TObject); var F : TSignal; begin if EditNotesPerOctave.Text <> '' then begin F := StrToFloatDef( EditNotesPerOctave.Text, NaN); if not IsNan( F) and not AlmostZero( F) then NotesPerOctave := F; end; end; procedure TFormModules.MenuViewEditorClick(Sender: TObject); begin PageControlMain.ActivePage := TabSheetEditor; end; procedure TFormModules.EditPatchNameChange(Sender: TObject); begin PatchName := EditPatchName.Text; end; procedure TFormModules.EditReferenceAChange(Sender: TObject); var F: TSignal; begin if EditReferenceA.Text <> '' then begin F := StrToFloatDef( EditReferenceA.Text, NaN); if not IsNan( F) then ReferenceA := F; end; end; procedure TFormModules.EditSearchChange(Sender: TObject); begin SearchPatch( EditSearch.Text); end; procedure TFormModules.RadioGroupControlModeClick(Sender: TObject); begin ControlMode := TDistanceMode( RadioGroupControlMode.ItemIndex); end; procedure TFormModules.RadioGroupPrioLevelClick( Sender: TObject); begin PrioLevel := RadioGroupPrioLevel.ItemIndex; end; procedure TFormModules.MenuSetupSettingsClick(Sender: TObject); begin PageControlMain.ActivePage := TabSheetDebug; PageControlDGSA.ActivePage := TabSheetSettings; end; procedure TFormModules.MenuViewSettingsClick(Sender: TObject); begin PageControlMain.ActivePage := TabSheetDebug; PageControlDGSA.ActivePage := TabSheetSettings; end; procedure TFormModules.MenuHelpHelpClick(Sender: TObject); begin ShowHelp; end; procedure TFormModules.SpinButtonWureThicknessDownClick(Sender: TObject); begin if WireThickness > 0 then WireThickness := WireThickness - 1; end; procedure TFormModules.SpinButtonWureThicknessUpClick(Sender: TObject); begin if WireThickness < 4 then WireThickness := WireThickness + 1; end; procedure TFormModules.MenuFileNewClick(Sender: TObject); begin NewPatch; end; procedure TFormModules.MenuSetupDevicesClick(Sender: TObject); begin with FormWaveDeviceSelect do begin SelectedInputId := Self.FSelectedInputId; SelectedOutputId := Self.FSelectedOutputId; if Execute then SelectDevices; end; end; procedure TFormModules.MenuEditWiggleWiresClick(Sender: TObject); begin WiggleWires; end; procedure TFormModules.MenuEditRedoClick(Sender: TObject); begin if Assigned( EditorPatch) then EditorPatch.Redo; end; procedure TFormModules.MenuEditUndoClick(Sender: TObject); begin if Assigned( EditorPatch) then EditorPatch.Undo; end; procedure TFormModules.MenuEditInvertSelectionClick(Sender: TObject); begin InvertSelection; end; procedure TFormModules.MenuEditSelectAllClick(Sender: TObject); begin SelectAll; end; procedure TFormModules.SelectNone1Click(Sender: TObject); begin SelectNone; end; procedure TFormModules.MenuEditPasteClick(Sender: TObject); begin PasteModules; end; procedure TFormModules.MenuActionRunStopClick(Sender: TObject); begin AudioRunning := not AudioRunning; end; procedure TFormModules.MenuEditCopyClick(Sender: TObject); begin CopyModules; end; procedure TFormModules.MenuEditCutClick(Sender: TObject); begin CutModules; end; procedure TFormModules.MenuEditDeleteClick(Sender: TObject); begin DeleteModules; end; procedure TFormModules.MenuFileExitClick(Sender: TObject); begin if FDebugRunning then DebugRunStop; Close; end; procedure TFormModules.MenuFileSaveClick(Sender: TObject); begin SavePatch; end; procedure TFormModules.MenuFileSaveAsClick(Sender: TObject); begin SavePatchAs; end; procedure TFormModules.MenuFileLoadClick(Sender: TObject); begin LoadPatch; end; function TFormModules.ModuleSelectorGetGlyph(aSender: TObject; const aName: string): TBitmap; begin Result := FormStore.FindBitmap( aName); end; procedure TFormModules.ModuleSelectorModuleButtonClick(aSender: TObject; aModuleclass: Integer); begin // User requested module creation by clicking // a button in the module selector, create it ! // todo : is FixupInsertions really needed here? EditorPatch.BeginStateChange; try FormStore.CreateModule( EditorPatch, aModuleClass, DO_DRAG).FixupInsertion; finally EditorPatch.EndStateChange( True); end; end; procedure TFormModules.TimerStatsUpdateTimer(Sender: TObject); // BOHM var n: Integer; y: Double; // EOHM begin // BOHM n:=FAudioOut.FrameRate; if ProcessingSamples>=n then begin if (n=0) or (ProcessingFrequency=0) then y:=0 else y:=100*ProcessingTime/ProcessingFrequency/(ProcessingSamples/n); LabelCPUUsage.Caption:='CPU: '+FormatFloat('##0.0',y)+'%'; ProcessingTime:=0; ProcessingSamples:=0 end; //TickCPUCounter; //LabelCpuUsage .Caption := Format( 'CPU: %.1f%% - core: %.1f%%', [ FProcessTime, FProcessTime * CpuCount], AppLocale); // EOHM LabelIOBalance.Caption := Format( 'I/O balance: %d' , [ FBalance ], AppLocale); if FdBInMax <= -120 then LabeldBIn.Caption := '---' else LabeldBIn.Caption := Format( '%.1f dB', [ FdBinMax], AppLocale); if FdBInMax > 0 then LabeldBIn.Font.Color := clYellow else LabeldBIn.Font.Color := clBlack; if FdBOutMax <= -120 then LabeldBOut.Caption := '---' else LabeldBOut.Caption := Format( '%.1f dB', [ FdBOutMax], AppLocale); if FdBOutMax > 0 then LabeldBOut.Font.Color := clYellow else LabeldBOut.Font.Color := clBlack; if AudioRunning then ShowRunTime; // if Assigned( EditorPatch) // then LabelPaintCount.Caption := Format( 'paint count: %d %d', [ EditorPatch.PaintCount, EditorPatch.PaintClocks div 1000]); end; procedure TFormModules.TimerNetMidiConnectTimer(Sender: TObject); begin if NetMidiAutoConnect then begin if NetMidiConnected then StopNetMidiConnectTimer else NetMidiConnectTimerFired; end else StopNetMidiConnectTimer; end; procedure TFormModules.KnobInVolumeValueChanged(aSender: TObject; const aPath, aControlType: string; aValue: Double; IsFinal: Boolean); begin InVolume := KnobInVolume.KnobPosition; end; procedure TFormModules.KnobOutVolumeValueChanged(aSender: TObject; const aPath, aControlType: string; aValue: Double; IsFinal: Boolean); begin OutVolume := KnobOutVolume.KnobPosition; end; procedure TFormModules.KnobsSmallKnobOffsetLeftValueChanged(aSender: TObject; const aPath, aControlType: string; aValue: Double; IsFinal: Boolean); begin OffsetLeft := SignalToInt( aValue); end; procedure TFormModules.KnobsSmallKnobOffsetTopValueChanged(aSender: TObject; const aPath, aControlType: string; aValue: Double; IsFinal: Boolean); begin OffsetTop := SignalToInt( aValue); end; procedure TFormModules.CheckBoxAutoRunClick(Sender: TObject); begin AutoRun := CheckBoxAutoRun.Checked; end; procedure TFormModules.CheckBoxCompilerDebugClick(Sender: TObject); begin CompilerDebug := CheckBoxCompilerDebug.Checked; end; procedure TFormModules.CheckBoxCurvedLinesClick(Sender: TObject); begin CurvedLines := CheckBoxCurvedLines.Checked; end; procedure TFormModules.CheckBoxGraphStairsClick(Sender: TObject); begin GraphStairs := CheckBoxGraphStairs.Checked; end; procedure TFormModules.CheckBoxLogMidiClick(Sender: TObject); begin LogMidi := CheckBoxLogMidi.Checked; end; procedure TFormModules.CheckBoxLogMidiMsgsClick(Sender: TObject); begin LogMidiMsgs := CheckBoxLogMidiMsgs.Checked; end; procedure TFormModules.CheckBoxNetMidiAutoConnectClick(Sender: TObject); begin NetMidiAutoConnect := CheckBoxNetMidiAutoConnect.Checked; end; procedure TFormModules.CheckBoxReloadLastPatchClick(Sender: TObject); begin ReloadLastPatch := CheckBoxReloadLastPatch.Checked; end; procedure TFormModules.CheckBoxUseGraphClick(Sender: TObject); begin UseGraph := CheckBoxUseGraph.Checked; end; procedure TFormModules.CheckBoxWarnOnPatchChangeClick(Sender: TObject); begin WarnOnPatchChange := CheckBoxWarnOnPatchChange.Checked; end; procedure TFormModules.BitBtnDebugStepClick(Sender: TObject); begin if AudioRunning then Log( 'can not do a debug step while audio generation is on') else ExecutePatch; end; procedure TFormModules.BitBtnDocumentClick(Sender: TObject); begin MakeDocs( DocsPath); end; procedure TFormModules.BitBtnClearGraphClick(Sender: TObject); begin ClearGraphs; end; procedure TFormModules.BitBtnCloseDubuggerClick(Sender: TObject); begin PageControlMain.ActivePage := TabSheetEditor; end; procedure TFormModules.MenuViewAboutClick(Sender: TObject); begin PageControlMain.ActivePage := TabSheetDebug; PageControlDGSA.ActivePage := TabSheetAbout; end; procedure TFormModules.MenuHelpAboutClick(Sender: TObject); begin PageControlMain.ActivePage := TabSheetDebug; PageControlDGSA.ActivePage := TabSheetAbout; end; procedure TFormModules.BitBtnApplyNetMidiClick(Sender: TObject); begin NetMidiApply; end; procedure TFormModules.BitBtnAudioRunningClick(Sender: TObject); begin AudioRunning := not AudioRunning; end; procedure TFormModules.BitBtnCancelNetMidiClick(Sender: TObject); begin NetMidiCancel; end; procedure TFormModules.BitBtnClearClick(Sender: TObject); begin ClearMemo; end; procedure TFormModules.BitBtnDebugResetClick(Sender: TObject); begin if AudioRunning then Log( 'can not do a debug reset while audio generation is on') else begin if Assigned( FSynthPatch) then FSynthPatch.Reset; ClearGraphs; end; end; procedure TFormModules.BitBtnShowDesignerClick(Sender: TObject); begin FormStore.Show; end; procedure TFormModules.BitBtnSynthResetClick(Sender: TObject); begin if Assigned( FSynthPatch) then FSynthPatch.Reset; end; procedure TFormModules.BitBtnTestClick(Sender: TObject); begin Rationals.UnitTest; end; procedure TFormModules.BreakConnectorClick(Sender: TObject); begin ConnectorBreak( FPopupSender as TKnobsConnector); end; procedure TFormModules.BitBtnDebugRunClick(Sender: TObject); begin DebugRunStop; end; procedure TFormModules.BitBtnDumpClick(Sender: TObject); begin ShowPatch; end; procedure TFormModules.BitBtnExItClick(Sender: TObject); begin FDebugRunning := False; Close; end; procedure TFormModules.BitBtnNetMidiConnectClick(Sender: TObject); begin if NetMidiConnected then NetMidiDisconnect else NetMidiConnect; end; procedure TFormModules.BitBtnProfileClick(Sender: TObject); begin ProfilePatch; end; procedure TFormModules.FormClose(Sender: TObject; var Action: TCloseAction); begin StopAudioIo; NetMidiDisconnect; if FIniLoaded then SaveIni; end; procedure TFormModules.FormCloseQuery(Sender: TObject; var CanClose: Boolean); var MResult : Integer; begin if FPatchChanged and WarnOnPatchChange then begin MResult := MessageDlg ( 'The patch was changed'^M^M + 'Do you want to save your changes?'^M^M + '- Yes to save the patch and exit'^M + '- No to not save, but exit anyway'^M + '- Cancel to not exit the program', mtWarning, [ mbYes, mbNo, mbCancel], 0, mbYes ); if MResult = mrYes then CanClose := SavePatch else if MResult = mrNo then CanClose := True else CanClose := False; end else CanClose := True; end; procedure TFormModules.FormCreate(Sender: TObject); begin FOldMemoDebug := MemoDebug.WindowProc; MemoDebug.WindowProc := MemoDebugWindowProc; Randomize; ClearDebugTiming; InitializeCPUCounter; knobs2013.GOnCreateModuleBitmap := DoCreateModuleBitmap; knobs2013.GOnReadModuleComment := DoReadModuleComment; Application.HintPause := 0; Application.HintHidePause := -1; Application.OnShowHint := DoShowHint; FormStore := TFormStore.Create( Application); // Ah .. "designer" needs manual creation .. ok, do it. FormStore.OnDesignerLog := DoDesignerLog; FormStore.PopulateSelector( ModuleSelector); // Poplulate module selector from the "designer" FPatchReader := TPatchReader.Create; FPatchWriter := TPatchWriter.Create; EditorPatch.OnLog := DoWirePanelLog; EditorPatch.PatchReader := FPatchReader; EditorPatch.PatchWriter := FPatchWriter; EditorPatch.OnHistoryChange := DoHistoryChanged; EditorPatch.OnValueChanged := DoValueChanged; EditorPatch.OnDisplayChanged := DoDisplayChanged; EditorPatch.OnFileChanged := DoFileChanged; EditorPatch.OnPatchChanged := DoPatchChanged; EditorPatch.OnShowPoup := DoShowPopupMenu; EditorPatch.Title := 'no name'; FRecentSourceFiles := TRecentStrings.Create( 20); EditorPatch.MaxHistory := 100; with PageControlMain do begin TabHeight := 2; TabWidth := 2; ActivePage := TabSheetEditor; end; // BOHM QueryPerformanceFrequency(ProcessingFrequency) // EOHM end; procedure TFormModules.FormDestroy(Sender: TObject); begin if Assigned( FSynthPatch) then FSynthPatch.OnSendMidi := nil; FreeAndNil( FSynthPatch); FreeDevices; FreeAndNil( FRecentSourceFiles); FinalizeCPUCounter; FreeAndNil( FScalaScaleFile ); FreeAndNil( FScalaMappingFile); end; procedure TFormModules.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); Var aMsg : Cardinal; aCode : Cardinal; i : Integer; n : Integer; begin MousePos := ScreenToClient( MousePos); if ( MousePos.X > EditorPatch.Left ) and ( MousePos.Y > EditorPatch.Top ) and ( MousePos.X < EditorPatch.Left + EditorPatch.Width ) and ( MousePos.Y < EditorPatch.Top + EditorPatch.Height) then begin if ssShift in Shift then aMsg := WM_HSCROLL else aMsg := WM_VSCROLL; if WheelDelta < 0 then aCode := SB_LINEDOWN else aCode := SB_LINEUP; n := Mouse.WheelScrollLines; for i:= 1 to n do EditorPatch.Perform( aMsg, aCode, 0); EditorPatch.Perform( aMsg, SB_ENDSCROLL, 0); Handled := True; end; end; procedure TFormModules.FormShow(Sender: TObject); begin FOrigCaption := Caption; PatchName := ''; SourceFileName := ''; CreateDevices; ClearMemo; FUseGraph := True; UseGraph := False; InVolume := 1; InVolume := 0; OutVolume := 1; OutVolume := 0; FAudioRunning := True; AudioRunning := False; FReloadLastPatch := False; ReloadLastPatch := True; FHistoryCount := 0; HistoryCount := 15; FCurvedLines := False; CurvedLines := True; FControlMode := dmHorizontal; ControlMode := dmCircular; ReferenceA := 100; ReferenceA := 440.0; NotesPerOctave := 3; NotesPerOctave := 12.0; MiddleNote := 1; MiddleNote := 69; FWireThickness := 2; WireThickness := 1; FPrioLevel := 2; PrioLevel := 1; OffsetLeft := 6; OffsetTop := 6; NetMidiServer := 'localhost'; NetMidiPort := '31415'; FNetMidiAutoConnect := True; NetMidiAutoConnect := False; FLogMidi := False; LogMidi := True; FLogMidiMsgs := True; LogMidiMsgs := False; FNetMidiChanged := True; NetMidiChanged := False; FCompilerDebug := True; CompilerDebug := False; FWarnOnPatchChange := False; WarnOnPatchChange := True; LabelProgramVersion.Caption := Format( 'program version: %s', [ GetFileVersion ], AppLocale); LabelPatchVersion .Caption := Format( 'patch version: %d' , [ KnobsPatchVersion], AppLocale); ClearVolumeIndicators; ClearDisplayRunTime; with LabeldBOut do begin Left := 1; Width := PanelControl.Width - 1; end; with LabeldBIn do begin Left := 1; Width := PanelControl.Width - 1; end; MemoAbout.Text := CopyRightMsg; if FileExists( IniFileName) then LoadIni else begin AutoRun := True; FIniLoaded := True; SaveIni; end; KnobOutVolume.SetFocus; end; end.