├── .gitignore ├── LICENSE ├── README.md ├── bin ├── FORMAT.TXT ├── INSTR.TXT └── PATTERN.TXT ├── doc └── img │ ├── nepper_000.png │ ├── nepper_001.png │ └── nepper_book8088.png └── src ├── adlib.pas ├── clipbrd.pas ├── dialogs.pas ├── edinstr.pas ├── edpattern.pas ├── edsong.pas ├── formats.pas ├── input.pas ├── keyboard.pas ├── nepper.lpi ├── nepper.lpr ├── player.pas ├── screen.pas ├── timer.pas └── utils.pas /.gitignore: -------------------------------------------------------------------------------- 1 | *.dbg 2 | *.bak 3 | *.exe 4 | *.csv 5 | *.dll 6 | *.so 7 | *.lps 8 | *.tmp 9 | *.zip 10 | link*.res 11 | lib 12 | ppas.sh 13 | *.ins 14 | *.bat 15 | *.nis 16 | *.ntr -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 Kagamma 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # nepper 2 | 3 | An attempt to write an OPL2/3 tracker that can run on IBM XT and its clones. 4 | 5 | Motivation: I just want a tracker that can run on my Book 8088 laptop, which is basically an IBM XT clone with a built-in OPL3 chip. 6 | 7 | The UI of the program is inspired by Faust Music Creator, while its playback engine is more in line with Adlib Tracker II. 8 | 9 | The program supports the following file formats: 10 | - `.NTR` (Nepper's TRack) [R/W] 11 | - `.NIS` (Nepper's InStrument) [R/W] 12 | - `.RAD` (Reality AdLib Tracker v1) [R] 13 | 14 | While the program can load RAD files, it might sound weird due to incompatible playback engine. 15 | 16 | Documentation: 17 | - See `bin\FORMAT.TXT` for `NTR` file format, `bin\INSTR.TXT` and `bin\PATTERN.TXT` for how to use the program. 18 | - You can also access `bin\INSTR.TXT` and `bin\PATTERN.TXT` in Nepper by pressing `F1`. 19 | 20 | How to build: 21 | - You need a Free Pascal cross-compiler for msdos-8086, with Compact memory model. 22 | 23 | ![1](/doc/img/nepper_000.png) 24 | 25 | ![2](/doc/img/nepper_001.png) 26 | 27 | ![3](/doc/img/nepper_book8088.png) 28 | -------------------------------------------------------------------------------- /bin/FORMAT.TXT: -------------------------------------------------------------------------------- 1 | HEADER 2 | ====== 3 | - Magic number: 2 bytes, always equals to 0xBAB0. 4 | - Version: 1 byte, equals to 1. 5 | - Song name: array of 40 bytes. 6 | - Ticks: 1 byte. 7 | - Clock speed: 1 byte. 8 | - OPL mode: 1 byte. 0 = OPL2, 1 = OPL3 4-op, 2 = OPL3 2-op. 9 | - Channel count: 1 byte. 10 | 11 | INSTRUMENTS 12 | =========== 13 | An array of 32 instrument record: 14 | - Operators: An array of 4 operators, contains the following fields: 15 | + Effect: 1 byte, register 20-35. 16 | + Volume: 1 byte, register 40-55. 17 | + AttackDecay: 1 byte, register 60-75. 18 | + SustainRelease: 1 byte, register 80-95. 19 | + Waveform: 1 byte, register E0-F5. 20 | - Algorithm and Feedback: 1 byte, register C0-C8. 21 | - Fine-tune: 1 byte. 22 | - Is 4-operator: 1 byte. 23 | - Instrument name: array of 20 bytes. 24 | 25 | ORDERS 26 | ====== 27 | An array of 256 bytes contains pattern indices. 28 | 29 | PATTERNS 30 | ======== 31 | Read the file for patterns until it reach EOF. Pattern has the following record: 32 | - Pattern index: 1 byte. 33 | - Channel index: 1 byte. 34 | - Start of row: 1 byte. 35 | - Cells: an array of notes & effects, start from "start of row" to 63. 36 | + Note: 1 byte. bit 0..3 is note value (C-..B-), while bit 4..7 is octave. 37 | + Effect: 2 bytes. First byte is effect. Second byte is effect's XY values. 38 | + Instrument index: 1 byte. 39 | -------------------------------------------------------------------------------- /bin/INSTR.TXT: -------------------------------------------------------------------------------- 1 | TYPES OF WAVEFORMS 2 | ================== 3 | _ _ _ _ _ _ 4 | 0: /_\___ 1: /_\/_\/_\ 2: /_\__/_\ 3: /|/|/| 5 | \_/ 6 | 7 | The following waveforms are for OPL3 only 8 | _ _ 9 | 4: /\____/\__ 5: /\/\__/\/\ 6: | | | | 7: |\_|\_ 10 | \/ \/ |_| |_ \| \| 11 | 12 | 13 | SYNTHESIS MODES 14 | =============== 15 | 16 | The following synthesis modes are for OPL2/OPL3 2-operator mode 17 | 18 | OP1 -+ 19 | 0: | 1: OP1-OP2-Out 20 | |-Out 21 | | 22 | OP2 -+ 23 | 24 | The following systhesis modes are for OPL3 4-operator mode only 25 | 26 | 0: OP1-OP2-OP3-OP4-Out 1: OP1---------+ 27 | | 28 | OP2-OP3-OP4-+-Out 29 | 30 | 2: OP1-OP2-+ 3: OP1-----+ 31 | | | 32 | |-Out OP2-OP3-+-Out 33 | | | 34 | OP3-OP4-+ OP4-----+ 35 | 36 | 37 | PHASES 38 | ====== 39 | 40 | Attack 41 | /\ Decay 42 | / \ 43 | / \ Sustain 44 | / \____________ 45 | / \ 46 | / \ Release 47 | 48 | 49 | ATTACK RATE 50 | ----------- 51 | Indicates how fast the note goes from zero to maximum volume. 52 | 1=slowest, F=fastest, 0=no attack phase. 53 | 54 | DECAY RATE 55 | ---------- 56 | Indicates how fast the note goes from maximum volume to sustain volume. 57 | 1=slowest, F=fastest, 0=no decay phase. 58 | 59 | SUSTAIN LEVEL 60 | ------------- 61 | Indicates the sustain level. 62 | 1=softest, F=loudest, 0=no sustain phase. 63 | 64 | RELEASE RATE 65 | ------------ 66 | Indicates how fast the note goes from sustain volume to zero volume. 67 | 1=slowest, F=fastest, 0=no release phase. 68 | -------------------------------------------------------------------------------- /bin/PATTERN.TXT: -------------------------------------------------------------------------------- 1 | Default freq: 50Hz 2 | Default speed/ticks: 6 3 | 4 | When OPL3 4-Op mode is enabled, only column 1,2,3,7,8,9 perform 4-operator synth. 5 | 6 | List of additional hotkeys 7 | ========================== 8 | 9 | [Shift-1..9] ENABLE / DISABLE CHANNELS 10 | ------------------------------------- 11 | Usable in Pattern editing mode. 12 | 13 | [F5] COPY MARK 14 | -------------- 15 | When use with Ctrl-C/X, only copy/cut from mark position to cursor position. 16 | 17 | List of effects 18 | =============== 19 | 20 | [0xy] ARPEGGIO 21 | -------------- 22 | This command causes the note to quickly cycle through three notes. 23 | x: 2nd note halftone above. 24 | y: 3rd note halftone above. 25 | Make sure speed is at least 3 if you want to play all notes. 26 | 27 | [1xx] FREQUENCY SLIDE UP 28 | ------------------------ 29 | This command slides the frequency up (pitch bend) one per tick. 30 | xx: Speed of slide. 31 | 00: Uses the last value. 32 | 33 | [2xx] FREQUENCY SLIDE DOWN 34 | -------------------------- 35 | This command slides the frequency down (pitch bend) one per tick. 36 | xx: Speed of slide. 37 | 00: Uses the last value. 38 | 39 | [3xx] TONE PORTAMENTO 40 | --------------------- 41 | This command is used together with a note and will slide to its frequency. 42 | xx: Speed of slide. 43 | 00: Uses the last value. 44 | 45 | [4xy] VIBRATO 46 | ------------- 47 | This command causes the frequency to oscillate. 48 | x: Speed. 49 | y: Depth. 50 | 00: Uses the last value. 51 | 52 | [5xx] VOLUME SLIDE + TONE PORTAMENTO 53 | ------------------------------------ 54 | This command executes both Tone portamento with "00" and Volume slide. 55 | x: Speed of volumeslide up 56 | y: Speed of slide down 57 | 00: Uses the last value 58 | 59 | [9xx] VOLUME 60 | ------------ 61 | This command set instrument's volume value. 62 | xx: Volume in 00..3F range. 63 | 64 | [Axy] VOLUME SLIDE 65 | ------------------ 66 | This command slides the volume up or down at the given speed. 67 | x: Speed of slide up 68 | y: Speed of slide down 69 | 00: Uses the last value 70 | 71 | [Dxx] PATTERN BREAK 72 | This commands break current pattern and jumps to next order. 73 | xx: The line to play in next order. 74 | 75 | [Exx] SET CLOCK FREQUENCY 76 | ------------------------- 77 | This command changes the clock frequency. 78 | xx: Frequency in Hz. 79 | 80 | [Fxx] SET SPEED 81 | --------------- 82 | This command changes the song speed. 83 | xx: Number of ticks to wait before process to next row. 84 | 85 | [Mxy] TREMOLO 86 | This command causes the volume to oscillate. 87 | x: Speed. 88 | y: Depth. 89 | 00: Uses the last value. 90 | 91 | [Nxy] TREMOR 92 | This command causes the volume to remain normal for 'x' ticks, then fades the 93 | volume to zero for 'y' ticks. 94 | 95 | [Z0x] SET TREMOLO DEPTH 96 | ----------------------- 97 | This command changes the hardware Tremolo depth of all operators. 98 | 0: 1dB 99 | 1: 4.8dB 100 | 101 | [Z1x] SET VIBRATO DEPTH 102 | ----------------------- 103 | This command changes the hardware Vibrato depth of all operators. 104 | 0: 7% 105 | 1: 14% 106 | 107 | [ZF0] STOP SOUND 108 | ---------------- 109 | This command causes the track volume to fade down immediately. 110 | Note that it nulls current Attack rate, Decay rate, Sustain level, and Release 111 | rate. 112 | 113 | [ZF4] START RELEASE PHASE 114 | ------------------------- 115 | This command starts the release phase of note. 116 | 117 | -------------------------------------------------------------------------------- /doc/img/nepper_000.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Kagamma/nepper/dd3eaf9fd00cf8d646ebfc3803601f35d5a89a51/doc/img/nepper_000.png -------------------------------------------------------------------------------- /doc/img/nepper_001.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Kagamma/nepper/dd3eaf9fd00cf8d646ebfc3803601f35d5a89a51/doc/img/nepper_001.png -------------------------------------------------------------------------------- /doc/img/nepper_book8088.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Kagamma/nepper/dd3eaf9fd00cf8d646ebfc3803601f35d5a89a51/doc/img/nepper_book8088.png -------------------------------------------------------------------------------- /src/adlib.pas: -------------------------------------------------------------------------------- 1 | unit Adlib; 2 | 3 | {$mode objFPC} 4 | 5 | interface 6 | 7 | const 8 | ADLIB_PORT_STATUS = $0388; 9 | ADLIB_MODULATOR = 0; 10 | ADLIB_CARRIER = 1; 11 | ADLIB_MAX_OCTAVE = 8; 12 | MAX_CHANNELS = 9; 13 | 14 | ADLIB_SLOTS_OPL2: array[0..MAX_CHANNELS - 1, 0..1] of Byte = ( 15 | ($00, $03), 16 | ($01, $04), 17 | ($02, $05), 18 | ($08, $0B), 19 | ($09, $0C), 20 | ($0A, $0D), 21 | ($10, $13), 22 | ($11, $14), 23 | ($12, $15) 24 | ); 25 | 26 | ADLIB_SLOTS_OPL3: array[0..MAX_CHANNELS - 1, 0..3] of Word = ( 27 | ($000, $003, $008, $00B), 28 | ($001, $004, $009, $00C), 29 | ($002, $005, $00A, $00D), 30 | ($010, $013, $0FF, $0FF), 31 | ($011, $014, $0FF, $0FF), 32 | ($012, $015, $0FF, $0FF), 33 | ($100, $103, $108, $10B), 34 | ($101, $104, $109, $10C), 35 | ($102, $105, $10A, $10D) 36 | ); 37 | 38 | ADLIB_CHANNELS_OPL3: array[0..MAX_CHANNELS - 1] of Word = ( 39 | 0, 1, 2, 6, 7, 8, $100, $101, $102 40 | ); 41 | 42 | // Music Frequency * 2^(20-Block) / 49716 Hz 43 | ADLIB_FREQ_TABLE: array[1..13] of Word = ( 44 | $159, $16B, $181, $198, $1B0, $1CA, $1E5, $202, $220, $241, $263, $287, $2B1 45 | ); 46 | 47 | ADLIB_NOTESYM_TABLE: array[1..12] of String[2] = ( 48 | 'C-', 49 | 'C#', 50 | 'D-', 51 | 'D#', 52 | 'E-', 53 | 'F-', 54 | 'F#', 55 | 'G-', 56 | 'G#', 57 | 'A-', 58 | 'A#', 59 | 'B-' 60 | ); 61 | 62 | type 63 | TBit1 = 0..1; 64 | TBit2 = 0..3; 65 | TBit3 = 0..7; 66 | TBit4 = 0..15; 67 | TBit5 = 0..31; 68 | TBit6 = 0..63; 69 | TBit7 = 0..127; 70 | TBit10 = 0..1023; 71 | 72 | TAdlibOPLKind = ( 73 | aokOPL2 = 0, 74 | aokOPL3Op4 = 1, 75 | aokOPL3Op2 = 2 76 | ); 77 | 78 | TAdlibReg2035 = bitpacked record 79 | ModFreqMult: TBit4; 80 | KSR: TBit1; 81 | EGTyp: TBit1; 82 | Vib: TBit1; 83 | AmpMod: TBit1; 84 | end; 85 | 86 | TAdlibReg4055 = bitpacked record 87 | Total: TBit6; 88 | Scaling: TBit2; 89 | end; 90 | 91 | TAdlibReg6075 = bitpacked record 92 | Decay: TBit4; 93 | Attack: TBit4; 94 | end; 95 | 96 | TAdlibReg8095 = bitpacked record 97 | Release: TBit4; 98 | Sustain: TBit4; 99 | end; 100 | 101 | PAdlibRegA0B8 = ^TAdlibRegA0B8; 102 | TAdlibRegA0B8 = bitpacked record 103 | Freq: TBit10; 104 | Octave: TBit3; 105 | KeyOn: TBit1; 106 | Unused: TBit2; 107 | end; 108 | 109 | TAdlibRegC0C8 = bitpacked record 110 | Alg: TBit1; 111 | Feedback: TBit3; 112 | Panning: TBit2; 113 | Alg2: TBit2; 114 | end; 115 | 116 | TAdlibRegBD = bitpacked record 117 | HiHat: TBit1; 118 | Cymbal: TBit1; 119 | TomTom: TBit1; 120 | Snare: TBit1; 121 | Drum: TBit1; 122 | Rhymth: TBit1; 123 | Vibrato: TBit1; 124 | AMDepth: TBit1; 125 | end; 126 | 127 | TAdlibRegE0F5 = bitpacked record 128 | Waveform: TBit3; 129 | Unused: TBit5; 130 | end; 131 | 132 | PAdlibInstrumentOperator = ^TAdlibInstrumentOperator; 133 | TAdlibInstrumentOperator = packed record 134 | Effect: TAdlibReg2035; 135 | Volume: TAdlibReg4055; 136 | AttackDecay: TAdlibReg6075; 137 | SustainRelease: TAdlibReg8095; 138 | Waveform: TAdlibRegE0F5; 139 | end; 140 | 141 | PAdlibInstrument = ^TAdlibInstrument; 142 | TAdlibInstrument = packed record 143 | Operators: array[0..3] of TAdlibInstrumentOperator; // 4 operators 144 | AlgFeedback: TAdlibRegC0C8; 145 | FineTune: ShortInt; 146 | Is4Op: Boolean; 147 | Name: String[20]; 148 | end; 149 | TWriteRegProc = procedure(const Reg: Word; Value: Byte); 150 | 151 | var 152 | VolumeModList: array[0..MAX_CHANNELS - 1] of ShortInt; 153 | FreqRegs: array[0..MAX_CHANNELS - 1] of TAdlibRegA0B8; 154 | FreqRegsBack: array[0..MAX_CHANNELS - 1] of TAdlibRegA0B8; 155 | FreqPrecisionList: array[0..MAX_CHANNELS - 1] of DWord; 156 | IsOPL3Avail: Boolean = False; 157 | IsOPL3Op4Enabled: Boolean; 158 | 159 | function Check: Boolean; 160 | procedure Init; 161 | procedure Reset; 162 | procedure SetInstrument(const Channel: Byte; const Inst: PAdlibInstrument); 163 | procedure SetVolume(const Channel: Byte; const Inst: PAdlibInstrument); 164 | procedure NoteOn(const Channel, Note, Octave: Byte; const FineTune: ShortInt = 0); 165 | procedure NoteOff(const Channel: Byte); 166 | procedure NoteClear(const Channel: Byte); 167 | procedure SetRegFreq(const Channel: Byte; const Freq: Word); inline; 168 | procedure ModifyRegFreq(const Channel: Byte; const Freq: Integer; const Ticks: Byte); inline; 169 | procedure WriteNoteReg(const Channel: Byte; const Reg: PAdlibRegA0B8); 170 | procedure SetOPL3(const V: TAdlibOPLKind); 171 | 172 | var 173 | WriteReg: TWriteRegProc; 174 | 175 | implementation 176 | 177 | uses 178 | Utils; 179 | 180 | procedure WriteRegSlow(const Reg: Word; Value: Byte); assembler; 181 | asm 182 | mov ax,Reg 183 | mov dx,ADLIB_PORT_STATUS 184 | or ah,ah 185 | jz @Pri 186 | inc dx 187 | inc dx 188 | @Pri: 189 | out dx,al 190 | // wait at least 3.3us 191 | in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; 192 | // 193 | inc dx 194 | mov al,Value 195 | out dx,al 196 | dec dx 197 | // wait at least 23us 198 | in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; 199 | in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; 200 | in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; 201 | in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; 202 | in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; 203 | in al,dx; in al,dx; in al,dx; in al,dx; in al,dx; 204 | end; 205 | 206 | procedure WriteRegFast(const Reg: Word; Value: Byte); assembler; 207 | asm 208 | mov ax,Reg 209 | mov dx,ADLIB_PORT_STATUS 210 | or ah,ah 211 | jz @Pri 212 | inc dx 213 | inc dx 214 | @Pri: 215 | out dx,al 216 | // wait a bit 217 | // 218 | inc dx 219 | mov al,Value 220 | out dx,al 221 | dec dx 222 | // wait a bit 223 | end; 224 | 225 | function Chan(const C: Byte): Word; inline; 226 | begin 227 | if IsOPL3Op4Enabled then 228 | Result := ADLIB_CHANNELS_OPL3[C] 229 | else 230 | Result := C; 231 | end; 232 | 233 | procedure SetInstrument(const Channel: Byte; const Inst: PAdlibInstrument); 234 | var 235 | I: Byte; 236 | C: Word; 237 | Op: PAdlibInstrumentOperator; 238 | Volume: TAdlibReg4055; 239 | VolumeTmp: ShortInt; 240 | Alg2: TAdlibRegC0C8; 241 | 242 | procedure AdjustVolume(const V: Byte); inline; 243 | begin 244 | if IsOPL3Op4Enabled and ((Channel <= 2) or (Channel >= 6)) then 245 | case Inst^.AlgFeedback.Alg2 of 246 | 0: 247 | begin 248 | if I = 3 then 249 | Volume.Total := V; 250 | end; 251 | 1: 252 | begin 253 | if (I = 0) or (I = 3) then 254 | Volume.Total := V; 255 | end; 256 | 2: 257 | begin 258 | if (I = 1) or (I = 3) then 259 | Volume.Total := V; 260 | end; 261 | 3: 262 | begin 263 | if (I = 0) or (I = 2) or (I = 3) then 264 | Volume.Total := V; 265 | end; 266 | end 267 | else 268 | case Inst^.AlgFeedback.Alg2 of 269 | 0: 270 | begin 271 | if (I = 0) or (I = 1) then 272 | Volume.Total := V; 273 | end; 274 | 1: 275 | begin 276 | if I = 1 then 277 | Volume.Total := V; 278 | end; 279 | end; 280 | end; 281 | 282 | begin 283 | if IsOPL3Op4Enabled then 284 | begin 285 | C := Chan(Channel); 286 | for I := 0 to 3 do 287 | begin 288 | Op := @Inst^.Operators[I]; 289 | Volume := Op^.Volume; 290 | VolumeTmp := Min(Max(Volume.Total - VolumeModList[Channel], 0), 63); 291 | AdjustVolume(VolumeTmp); 292 | 293 | if ADLIB_SLOTS_OPL3[Channel, I] <> $FF then 294 | begin 295 | WriteRegFast(ADLIB_SLOTS_OPL3[Channel, I] + $20, Byte(Op^.Effect)); 296 | WriteRegFast(ADLIB_SLOTS_OPL3[Channel, I] + $40, Byte(Volume)); 297 | WriteRegFast(ADLIB_SLOTS_OPL3[Channel, I] + $60, Byte(Op^.AttackDecay)); 298 | WriteRegFast(ADLIB_SLOTS_OPL3[Channel, I] + $80, Byte(Op^.SustainRelease)); 299 | WriteRegFast(ADLIB_SLOTS_OPL3[Channel, I] + $E0, Byte(Op^.Waveform)); 300 | end; 301 | end; 302 | Inst^.AlgFeedback.Alg := Inst^.AlgFeedback.Alg2; 303 | WriteRegFast(C + $C0, Byte(Inst^.AlgFeedback)); 304 | if (Byte(C) < 6) or (Byte(C) > 8) then 305 | begin 306 | Alg2.Alg := Inst^.AlgFeedback.Alg2 shr 1; 307 | WriteRegFast(C + 3 + $C0, Byte(Alg2)); 308 | end; 309 | end else 310 | begin 311 | for I := 0 to 1 do 312 | begin 313 | Op := @Inst^.Operators[I]; 314 | Volume := Op^.Volume; 315 | VolumeTmp := Min(Max(Volume.Total - VolumeModList[Channel], 0), 63); 316 | AdjustVolume(VolumeTmp); 317 | 318 | WriteReg(ADLIB_SLOTS_OPL2[Channel, I] + $20, Byte(Op^.Effect)); 319 | WriteReg(ADLIB_SLOTS_OPL2[Channel, I] + $40, Byte(Volume)); 320 | WriteReg(ADLIB_SLOTS_OPL2[Channel, I] + $60, Byte(Op^.AttackDecay)); 321 | WriteReg(ADLIB_SLOTS_OPL2[Channel, I] + $80, Byte(Op^.SustainRelease)); 322 | WriteReg(ADLIB_SLOTS_OPL2[Channel, I] + $E0, Byte(Op^.Waveform)); 323 | end; 324 | Inst^.AlgFeedback.Alg := Inst^.AlgFeedback.Alg2; 325 | WriteReg(Channel + $C0, Byte(Inst^.AlgFeedback)); 326 | end; 327 | end; 328 | 329 | procedure SetVolume(const Channel: Byte; const Inst: PAdlibInstrument); 330 | var 331 | I: Byte; 332 | Op: PAdlibInstrumentOperator; 333 | Volume: TAdlibReg4055; 334 | VolumeTmp: ShortInt; 335 | 336 | procedure AdjustVolume(const V: Byte); inline; 337 | begin 338 | if IsOPL3Op4Enabled and ((Channel <= 2) or (Channel >= 6)) then 339 | case Inst^.AlgFeedback.Alg2 of 340 | 0: 341 | begin 342 | if I = 3 then 343 | Volume.Total := V; 344 | end; 345 | 1: 346 | begin 347 | if (I = 0) or (I = 3) then 348 | Volume.Total := V; 349 | end; 350 | 2: 351 | begin 352 | if (I = 1) or (I = 3) then 353 | Volume.Total := V; 354 | end; 355 | 3: 356 | begin 357 | if (I = 0) or (I = 2) or (I = 3) then 358 | Volume.Total := V; 359 | end; 360 | end 361 | else 362 | case Inst^.AlgFeedback.Alg2 of 363 | 0: 364 | begin 365 | if (I = 0) or (I = 1) then 366 | Volume.Total := V; 367 | end; 368 | 1: 369 | begin 370 | if I = 1 then 371 | Volume.Total := V; 372 | end; 373 | end; 374 | end; 375 | 376 | begin 377 | if IsOPL3Op4Enabled then 378 | begin 379 | for I := 0 to 3 do 380 | begin 381 | Op := @Inst^.Operators[I]; 382 | Volume := Op^.Volume; 383 | VolumeTmp := Min(Max(Volume.Total - VolumeModList[Channel], 0), 63); 384 | AdjustVolume(VolumeTmp); 385 | 386 | if ADLIB_SLOTS_OPL3[Channel, I] <> $FF then 387 | begin 388 | WriteRegFast(ADLIB_SLOTS_OPL3[Channel, I] + $40, Byte(Volume)); 389 | end; 390 | end; 391 | end else 392 | begin 393 | for I := 0 to 1 do 394 | begin 395 | Op := @Inst^.Operators[I]; 396 | Volume := Op^.Volume; 397 | VolumeTmp := Min(Max(Volume.Total - VolumeModList[Channel], 0), 63); 398 | AdjustVolume(VolumeTmp); 399 | 400 | WriteReg(ADLIB_SLOTS_OPL2[Channel, I] + $40, Byte(Volume)); 401 | end; 402 | end; 403 | end; 404 | 405 | function Check: Boolean; 406 | var 407 | S1, S2: Byte; 408 | begin 409 | // We simply check adlib card's existence by making timer 1's register overflow, 410 | // then check for bit 6 & 7 in time control register 411 | WriteRegSlow($04, $60); // Reset both timers 412 | WriteRegSlow($04, $80); // Enable timer interrupt 413 | S1 := Port[ADLIB_PORT_STATUS]; 414 | WriteRegSlow($02, $FF); 415 | WriteRegSlow($04, $21); // Start timer 1 416 | S2 := Port[ADLIB_PORT_STATUS]; 417 | WriteRegSlow($04, $60); 418 | WriteRegSlow($04, $80); 419 | S1 := S1 and $E0; 420 | S2 := S2 and $E0; 421 | if (S1 = $00) and (S2 = $C0) then 422 | Check := True; 423 | if Port[ADLIB_PORT_STATUS] and 6 = 0 then 424 | IsOPL3Avail := True; 425 | end; 426 | 427 | procedure Init; 428 | begin 429 | Reset; 430 | WriteReg($BD, %11000000); // Deep vibrato & tremolo 431 | WriteReg($1, $20); // Allows waveforms 432 | end; 433 | 434 | procedure Reset; 435 | var 436 | I: Byte; 437 | begin 438 | if IsOPL3Avail then 439 | begin 440 | SetOPL3(aokOPL3Op4); 441 | for I := 0 to 245 do 442 | WriteReg($100 + I, 0); 443 | end; 444 | SetOPL3(aokOPL2); 445 | for I := 0 to 245 do 446 | WriteReg(I, 0); 447 | end; 448 | 449 | procedure WriteNoteReg(const Channel: Byte; const Reg: PAdlibRegA0B8); 450 | var 451 | C: Word; 452 | begin 453 | C := Chan(Channel); 454 | WriteReg($A0 + C, Lo(Word(Reg^))); 455 | WriteReg($B0 + C, Hi(Word(Reg^))); 456 | end; 457 | 458 | procedure NoteOn(const Channel, Note, Octave: Byte; const FineTune: ShortInt = 0); 459 | var 460 | N: PAdlibRegA0B8; 461 | C: Word; 462 | begin 463 | C := Chan(Channel); 464 | N := @FreqRegs[Channel]; 465 | N^.KeyOn := 0; 466 | WriteReg($B0 + C, Hi(Word(N^))); 467 | N^.Freq := ADLIB_FREQ_TABLE[Note] + FineTune; 468 | N^.Octave := Octave; 469 | N^.KeyOn := 1; 470 | FreqPrecisionList[Channel] := DWord(N^.Freq) shl 8; 471 | WriteReg($A0 + C, Lo(Word(N^))); 472 | WriteReg($B0 + C, Hi(Word(N^))); 473 | FreqRegsBack[Channel] := N^; 474 | end; 475 | 476 | procedure NoteOff(const Channel: Byte); 477 | var 478 | C: Word; 479 | N: PAdlibRegA0B8; 480 | begin 481 | C := Chan(Channel); 482 | N := @FreqRegs[Channel]; 483 | N^.KeyOn := 0; 484 | WriteReg($B0 + C, Hi(Word(N^))); 485 | end; 486 | 487 | procedure NoteClear(const Channel: Byte); 488 | var 489 | C: Word; 490 | begin 491 | C := Chan(Channel); 492 | WriteReg($A0 + C, 0); 493 | WriteReg($B0 + C, 0); 494 | end; 495 | 496 | procedure SetRegFreq(const Channel: Byte; const Freq: Word); 497 | begin 498 | FreqPrecisionList[Channel] := DWord(Freq) shl 8; 499 | FreqRegs[Channel].Freq := FreqPrecisionList[Channel] shr 8; 500 | end; 501 | 502 | procedure ModifyRegFreq(const Channel: Byte; const Freq: Integer; const Ticks: Byte); 503 | begin 504 | Inc(FreqPrecisionList[Channel], (Freq shl 8) div Ticks); 505 | FreqRegs[Channel].Freq := FreqPrecisionList[Channel] shr 8; 506 | end; 507 | 508 | procedure SetOPL3(const V: TAdlibOPLKind); 509 | begin 510 | case V of 511 | aokOPL2: 512 | begin 513 | WriteReg($105, 0); 514 | IsOPL3Op4Enabled := False; 515 | end; 516 | aokOPL3Op2: 517 | begin 518 | WriteReg($105, 1); 519 | WriteReg($104, 0); 520 | IsOPL3Op4Enabled := False; 521 | end; 522 | aokOPL3Op4: 523 | begin 524 | WriteReg($105, 1); 525 | WriteReg($104, $3F); 526 | IsOPL3Op4Enabled := True; 527 | end; 528 | end; 529 | end; 530 | 531 | initialization 532 | if not Adlib.Check then 533 | begin 534 | Writeln('ERROR: AdLib sound card not found!'); 535 | Halt; 536 | end; 537 | if Adlib.IsOPL3Avail then 538 | begin 539 | WriteReg := @WriteRegFast; 540 | Writeln('OPL3 found!'); 541 | end else 542 | WriteReg := @WriteRegSlow; 543 | FillChar(VolumeModList[0], SizeOf(VolumeModList), 0); 544 | 545 | end. 546 | 547 | -------------------------------------------------------------------------------- /src/clipbrd.pas: -------------------------------------------------------------------------------- 1 | unit Clipbrd; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | uses 8 | Formats, Adlib; 9 | 10 | var 11 | ClipbrdCells: TNepperChannelCells; 12 | ClipbrdCellStart: ShortInt = -1; 13 | ClipbrdCellEnd: ShortInt; 14 | ClipbrdInstr: TAdlibInstrument; 15 | 16 | implementation 17 | 18 | initialization 19 | FillChar(ClipbrdCells[0], SizeOf(ClipbrdInstr), 0); 20 | FillChar(ClipbrdInstr.Operators[0], SizeOf(ClipbrdInstr), 0); 21 | 22 | end. 23 | 24 | -------------------------------------------------------------------------------- /src/dialogs.pas: -------------------------------------------------------------------------------- 1 | unit Dialogs; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | uses 8 | Utils; 9 | 10 | function ShowInputDialog(const Title: String40; var Output: String40): Boolean; 11 | procedure ShowMessageDialog(const Title, Text: String40); 12 | procedure ShowHelpDialog(const FileName: String40); 13 | 14 | implementation 15 | 16 | uses 17 | Screen, Keyboard, Input; 18 | 19 | var 20 | HelpData: ^String80; 21 | HelpAnchor: Integer = 0; 22 | HelpSize: Integer = 0; 23 | HelpFileNameOld: String80; 24 | 25 | function ShowInputDialog(const Title: String40; var Output: String40): Boolean; 26 | var 27 | OldInputCursor: Byte; 28 | begin 29 | Result := False; 30 | OldInputCursor := InputCursor; 31 | InputCursor := 1; 32 | Screen.WriteText(20, 10, $3E, '', 40); 33 | Screen.WriteTextMid(40, 10, $3E, Title); 34 | Screen.WriteText(20, 11, $1F, '', 40); 35 | Screen.SetCursorPosition(20, 11); 36 | repeat 37 | Keyboard.WaitForInput; 38 | Input.InputText(Output, 40); 39 | Screen.WriteText(20, 11, $1F, Output, 40); 40 | case KBInput.ScanCode of 41 | SCAN_ESC: 42 | begin 43 | Break; 44 | end; 45 | SCAN_ENTER: 46 | begin 47 | Result := True; 48 | Break; 49 | end; 50 | end; 51 | until False; 52 | Screen.WriteText(20, 10, 0, '', 40); 53 | Screen.WriteText(20, 11, 0, '', 40); 54 | InputCursor := OldInputCursor; 55 | KBInput.ScanCode := $FF; 56 | end; 57 | 58 | procedure ShowMessageDialog(const Title, Text: String40); 59 | begin 60 | Screen.WriteText(20, 10, $3E, '', 40); 61 | Screen.WriteText(20, 11, $30, '', 40); 62 | Screen.WriteText(20, 12, $30, '', 40); 63 | Screen.WriteText(20, 13, $30, '', 40); 64 | Screen.WriteTextMid(40, 10, $3E, Title); 65 | Screen.WriteTextMid(40, 12, $3F, Text); 66 | Keyboard.WaitForInput; 67 | Screen.WriteText(20, 10, 0, '', 40); 68 | Screen.WriteText(20, 11, 0, '', 40); 69 | Screen.WriteText(20, 12, 0, '', 40); 70 | Screen.WriteText(20, 13, 0, '', 40); 71 | KBInput.ScanCode := $FF; 72 | end; 73 | 74 | procedure ShowHelpDialog(const FileName: String40); 75 | 76 | function ReadFile: Boolean; 77 | var 78 | F: Text; 79 | S: String80; 80 | begin 81 | if HelpFileNameOld = FileName then 82 | begin 83 | Exit(True); 84 | end; 85 | HelpFileNameOld := FileName; 86 | Result := False; 87 | Assign(F, FileName); 88 | {$I-} 89 | System.Reset(F); 90 | {$I+} 91 | if IOResult = 0 then 92 | begin 93 | HelpAnchor := 0; 94 | HelpSize := 0; 95 | HelpData := AllocMem(SizeOf(String80) * 100); 96 | while not EOF(F) do 97 | begin 98 | if MemSize(HelpData) div SizeOf(String80) <= HelpSize then 99 | ReAllocMem(HelpData, MemSize(HelpData) + SizeOf(String80) * 10); 100 | Readln(F, HelpData[HelpSize]); 101 | Inc(HelpSize); 102 | end; 103 | Close(F); 104 | Result := True; 105 | end; 106 | end; 107 | 108 | procedure RenderAll; 109 | var 110 | I: Byte; 111 | begin 112 | FillWord(ScreenPointer[80], 80*24, $0F00); 113 | for I := HelpAnchor to HelpAnchor + 78 do 114 | begin 115 | if I > HelpSize - 1 then 116 | Break; 117 | WriteText(0, I - HelpAnchor + 1, $0F, HelpData[I]); 118 | end; 119 | end; 120 | 121 | procedure RenderScrollUp; 122 | var 123 | I: Byte; 124 | begin 125 | for I := 24 downto 1 do 126 | Move(ScreenPointer[I * 80], ScreenPointer[(I + 1) * 80], 160); 127 | WriteText(0, 1, $0F, HelpData[HelpAnchor], 80); 128 | end; 129 | 130 | procedure RenderScrollDown; 131 | begin 132 | Move(ScreenPointer[160], ScreenPointer[80], 80 * 23 * 2); 133 | WriteText(0, 24, $0F, HelpData[Min(HelpAnchor + 23, HelpSize - 1)], 80); 134 | end; 135 | 136 | begin 137 | if not ReadFile then 138 | begin 139 | ShowMessageDialog('Error', '"' + FileName + '" not found!'); 140 | Exit; 141 | end; 142 | RenderAll; 143 | repeat 144 | Keyboard.WaitForInput; 145 | case KBInput.ScanCode of 146 | SCAN_ESC, SCAN_F1: 147 | begin 148 | Break; 149 | end; 150 | SCAN_UP: 151 | begin 152 | if HelpAnchor > 0 then 153 | begin 154 | Dec(HelpAnchor); 155 | RenderScrollUp; 156 | end; 157 | end; 158 | SCAN_DOWN: 159 | begin 160 | if HelpSize - HelpAnchor > 25 then 161 | begin 162 | Inc(HelpAnchor); 163 | RenderScrollDown; 164 | end; 165 | end; 166 | SCAN_PGUP: 167 | begin 168 | Dec(HelpAnchor, 22); 169 | if HelpAnchor < 0 then 170 | HelpAnchor := 0; 171 | RenderAll; 172 | end; 173 | SCAN_PGDN: 174 | begin 175 | Inc(HelpAnchor, 22); 176 | if HelpSize - HelpAnchor < 24 then 177 | HelpAnchor := HelpSize - 24; 178 | RenderAll; 179 | end; 180 | end; 181 | until False; 182 | KBInput.ScanCode := $FF; 183 | ClrScr; 184 | end; 185 | 186 | end. 187 | 188 | -------------------------------------------------------------------------------- /src/edinstr.pas: -------------------------------------------------------------------------------- 1 | unit EdInstr; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | uses 8 | Screen, Adlib, Keyboard, Input, Utils, Formats; 9 | 10 | var 11 | CurInstr: PAdlibInstrument; 12 | IsInstr: Boolean; 13 | IsInstrTesting: Boolean = False; 14 | 15 | procedure Loop; 16 | 17 | implementation 18 | 19 | uses 20 | Dialogs, Clipbrd; 21 | 22 | const 23 | OP1_X = 16; 24 | OP2_X = 36; 25 | OP3_X = 56; 26 | OP4_X = 76; 27 | 28 | type 29 | TEdInstrMenuItem = record 30 | X, Y: Byte; 31 | end; 32 | 33 | var 34 | CurMenuPos: Byte = 1; 35 | CurInstrPos: Byte = 0; 36 | TestNote: TNepperNote; 37 | MenuList: array[0..53] of TEdInstrMenuItem; 38 | 39 | procedure ResetParams; 40 | begin 41 | Input.InputCursor := 1; 42 | Screen.SetCursorPosition(MenuList[CurMenuPos].X, MenuList[CurMenuPos].Y); 43 | end; 44 | 45 | procedure RenderTexts; 46 | begin 47 | WriteText(0, 0, $1F, ' - Nepper -', 80); 48 | WriteText(0, 0, $1A, 'INSTRUMENT EDIT'); 49 | WriteText(0, 1, $0E, ' [F1] Help [F2] Song/Pattern Editor [F3] Instrument Editor [ESC] Exit Nepper'); 50 | 51 | WriteTextBack(OP1_X, 3, COLOR_LABEL, 'Inst. number:'); 52 | WriteTextBack(OP1_X, 4, COLOR_LABEL, 'Synthesis mode:'); 53 | WriteTextBack(OP1_X + 2, 6, $4E, ' Operator 1 '); 54 | WriteTextBack(OP1_X, 7, COLOR_LABEL, 'Attack:'); 55 | WriteTextBack(OP1_X, 8, COLOR_LABEL, 'Decay:'); 56 | WriteTextBack(OP1_X, 9, COLOR_LABEL, 'Sustain:'); 57 | WriteTextBack(OP1_X, 10, COLOR_LABEL, 'Release:'); 58 | WriteTextBack(OP1_X, 11, COLOR_LABEL, 'Volume:'); 59 | WriteTextBack(OP1_X, 12, COLOR_LABEL, 'Level scale:'); 60 | WriteTextBack(OP1_X, 13, COLOR_LABEL, 'Multiplier:'); 61 | WriteTextBack(OP1_X, 14, COLOR_LABEL, 'Waveform:'); 62 | WriteTextBack(OP1_X, 15, COLOR_LABEL, 'Sustain Sound:'); 63 | WriteTextBack(OP1_X, 16, COLOR_LABEL, 'Scale Envelope:'); 64 | WriteTextBack(OP1_X, 17, COLOR_LABEL, 'Vibrato:'); 65 | WriteTextBack(OP1_X, 18, COLOR_LABEL, 'Tremolo:'); 66 | 67 | WriteTextBack(OP2_X, 3, COLOR_LABEL, 'Inst. name:'); 68 | WriteTextBack(OP2_X, 4, COLOR_LABEL, 'Feedback:'); 69 | WriteTextBack(OP2_X + 2, 6, $4E, ' Operator 2 '); 70 | WriteTextBack(OP2_X, 7, COLOR_LABEL, 'Attack:'); 71 | WriteTextBack(OP2_X, 8, COLOR_LABEL, 'Decay:'); 72 | WriteTextBack(OP2_X, 9, COLOR_LABEL, 'Sustain:'); 73 | WriteTextBack(OP2_X, 10, COLOR_LABEL, 'Release:'); 74 | WriteTextBack(OP2_X, 11, COLOR_LABEL, 'Volume:'); 75 | WriteTextBack(OP2_X, 12, COLOR_LABEL, 'Level scale:'); 76 | WriteTextBack(OP2_X, 13, COLOR_LABEL, 'Multiplier:'); 77 | WriteTextBack(OP2_X, 14, COLOR_LABEL, 'Waveform:'); 78 | WriteTextBack(OP2_X, 15, COLOR_LABEL, 'Sustain Sound:'); 79 | WriteTextBack(OP2_X, 16, COLOR_LABEL, 'Scale Envelope:'); 80 | WriteTextBack(OP2_X, 17, COLOR_LABEL, 'Vibrato:'); 81 | WriteTextBack(OP2_X, 18, COLOR_LABEL, 'Tremolo:'); 82 | 83 | WriteTextBack(OP3_X, 4, COLOR_LABEL, 'Fine Tune:'); 84 | WriteTextBack(OP3_X + 2, 6, $4E, ' Operator 3 '); 85 | WriteTextBack(OP3_X, 7, COLOR_LABEL, 'Attack:'); 86 | WriteTextBack(OP3_X, 8, COLOR_LABEL, 'Decay:'); 87 | WriteTextBack(OP3_X, 9, COLOR_LABEL, 'Sustain:'); 88 | WriteTextBack(OP3_X, 10, COLOR_LABEL, 'Release:'); 89 | WriteTextBack(OP3_X, 11, COLOR_LABEL, 'Volume:'); 90 | WriteTextBack(OP3_X, 12, COLOR_LABEL, 'Level scale:'); 91 | WriteTextBack(OP3_X, 13, COLOR_LABEL, 'Multiplier:'); 92 | WriteTextBack(OP3_X, 14, COLOR_LABEL, 'Waveform:'); 93 | WriteTextBack(OP3_X, 15, COLOR_LABEL, 'Sustain Sound:'); 94 | WriteTextBack(OP3_X, 16, COLOR_LABEL, 'Scale Envelope:'); 95 | WriteTextBack(OP3_X, 17, COLOR_LABEL, 'Vibrato:'); 96 | WriteTextBack(OP3_X, 18, COLOR_LABEL, 'Tremolo:'); 97 | 98 | WriteTextBack(OP4_X, 4, COLOR_LABEL, 'Panning:'); 99 | WriteTextBack(OP4_X + 2, 6, $4E, ' Operator 4 '); 100 | WriteTextBack(OP4_X, 7, COLOR_LABEL, 'Attack:'); 101 | WriteTextBack(OP4_X, 8, COLOR_LABEL, 'Decay:'); 102 | WriteTextBack(OP4_X, 9, COLOR_LABEL, 'Sustain:'); 103 | WriteTextBack(OP4_X, 10, COLOR_LABEL, 'Release:'); 104 | WriteTextBack(OP4_X, 11, COLOR_LABEL, 'Volume:'); 105 | WriteTextBack(OP4_X, 12, COLOR_LABEL, 'Level scale:'); 106 | WriteTextBack(OP4_X, 13, COLOR_LABEL, 'Multiplier:'); 107 | WriteTextBack(OP4_X, 14, COLOR_LABEL, 'Waveform:'); 108 | WriteTextBack(OP4_X, 15, COLOR_LABEL, 'Sustain Sound:'); 109 | WriteTextBack(OP4_X, 16, COLOR_LABEL, 'Scale Envelope:'); 110 | WriteTextBack(OP4_X, 17, COLOR_LABEL, 'Vibrato:'); 111 | WriteTextBack(OP4_X, 18, COLOR_LABEL, 'Tremolo:'); 112 | 113 | WriteTextBack(76, 21, COLOR_LABEL, 'Test operator mode:'); 114 | WriteTextBack(76, 22, COLOR_LABEL, 'Test tone:'); 115 | WriteText(0, 23, $0A, '[L] Load [<] Prev [SPC] Test [+] Test Tone Up [F10] Test operator mode'); 116 | WriteText(0, 24, $0A, '[S] Save [>] Next [CR] Quiet [-] Test Tone Down'); 117 | end; 118 | 119 | procedure RenderInstrInfo; 120 | var 121 | I: Byte; 122 | Ofs: Byte; 123 | S: String20; 124 | begin 125 | WriteText(OP1_X + 1, 3, $0F, HexStrFast2(CurInstrPos)); 126 | WriteText(OP1_X + 1, 4, $0F, HexStrFast2(CurInstr^.AlgFeedback.Alg2)); 127 | WriteText(OP2_X + 1, 3, $0F, CurInstr^.Name, 20); 128 | WriteText(OP2_X + 1, 4, $0F, HexStrFast2(CurInstr^.AlgFeedback.Feedback)); 129 | WriteText(OP3_X + 1, 4, $0F, HexStrFast2(CurInstr^.FineTune)); 130 | WriteText(OP4_X + 1, 4, $0F, ByteToPanning(CurInstr^.AlgFeedback.Panning)); 131 | for I := 0 to 3 do 132 | begin 133 | Ofs := I * ((OP2_X + 2) - (OP1_X + 2)); 134 | WriteText((OP1_X + 1) + Ofs, 7, $0F, HexStrFast2(CurInstr^.Operators[I].AttackDecay.Attack)); 135 | WriteText((OP1_X + 1) + Ofs, 8, $0F, HexStrFast2(CurInstr^.Operators[I].AttackDecay.Decay)); 136 | WriteText((OP1_X + 1) + Ofs, 9, $0F, HexStrFast2($F - CurInstr^.Operators[I].SustainRelease.Sustain)); 137 | WriteText((OP1_X + 1) + Ofs, 10, $0F, HexStrFast2(CurInstr^.Operators[I].SustainRelease.Release)); 138 | WriteText((OP1_X + 1) + Ofs, 11, $0F, HexStrFast2($3F - CurInstr^.Operators[I].Volume.Total)); 139 | WriteText((OP1_X + 1) + Ofs, 12, $0F, HexStrFast2(CurInstr^.Operators[I].Volume.Scaling)); 140 | WriteText((OP1_X + 1) + Ofs, 13, $0F, HexStrFast2(CurInstr^.Operators[I].Effect.ModFreqMult));; 141 | WriteText((OP1_X + 1) + Ofs, 14, $0F, HexStrFast2(CurInstr^.Operators[I].Waveform.Waveform)); 142 | WriteText((OP1_X + 1) + Ofs, 15, $0F, ByteToYesNo(CurInstr^.Operators[I].Effect.EGTyp), 3); 143 | WriteText((OP1_X + 1) + Ofs, 16, $0F, ByteToYesNo(CurInstr^.Operators[I].Effect.KSR), 3); 144 | WriteText((OP1_X + 1) + Ofs, 17, $0F, ByteToYesNo(CurInstr^.Operators[I].Effect.Vib), 3); 145 | WriteText((OP1_X + 1) + Ofs, 18, $0F, ByteToYesNo(CurInstr^.Operators[I].Effect.AmpMod), 3); 146 | end; 147 | Str(TestNote.Octave, S); 148 | WriteText(77, 22, $0F, ADLIB_NOTESYM_TABLE[TestNote.Note]); 149 | WriteText(79, 22, $0F, S); 150 | if Adlib.IsOPL3Op4Enabled and CurInstr^.Is4Op then 151 | WriteText(77, 21, $0F, '4') 152 | else 153 | WriteText(77, 21, $0F, '2'); 154 | end; 155 | 156 | procedure Loop; 157 | var 158 | OldCurMenuPos: Byte; 159 | S: String40; 160 | V: Byte; 161 | begin 162 | IsInstr := True; 163 | ClrScr; 164 | ResetParams; 165 | RenderTexts; 166 | RenderInstrInfo; 167 | repeat 168 | Keyboard.WaitForInput; 169 | OldCurMenuPos := CurMenuPos; 170 | case CurMenuPos of 171 | 1: 172 | begin 173 | V := CurInstr^.AlgFeedback.Alg2; 174 | Input.InputHex2(S, V, 3); 175 | CurInstr^.AlgFeedback.Alg2 := V; 176 | end; 177 | // 178 | 2: 179 | begin 180 | V := CurInstr^.Operators[0].AttackDecay.Attack; 181 | Input.InputHex2(S, V, $F); 182 | CurInstr^.Operators[0].AttackDecay.Attack := V; 183 | end; 184 | 3: 185 | begin 186 | V := CurInstr^.Operators[0].AttackDecay.Decay; 187 | Input.InputHex2(S, V, $F); 188 | CurInstr^.Operators[0].AttackDecay.Decay := V; 189 | end; 190 | 4: 191 | begin 192 | V := $F - CurInstr^.Operators[0].SustainRelease.Sustain; 193 | Input.InputHex2(S, V, $F); 194 | CurInstr^.Operators[0].SustainRelease.Sustain := $F - V; 195 | end; 196 | 5: 197 | begin 198 | V := CurInstr^.Operators[0].SustainRelease.Release; 199 | Input.InputHex2(S, V, $F); 200 | CurInstr^.Operators[0].SustainRelease.Release := V; 201 | end; 202 | 6: 203 | begin 204 | V := $3F - CurInstr^.Operators[0].Volume.Total; 205 | Input.InputHex2(S, V, $3F); 206 | CurInstr^.Operators[0].Volume.Total := $3F - V; 207 | end; 208 | 7: 209 | begin 210 | V := CurInstr^.Operators[0].Volume.Scaling; 211 | Input.InputHex2(S, V, 3); 212 | CurInstr^.Operators[0].Volume.Scaling := V; 213 | end; 214 | 8: 215 | begin 216 | V := CurInstr^.Operators[0].Effect.ModFreqMult; 217 | Input.InputHex2(S, V, $F); 218 | CurInstr^.Operators[0].Effect.ModFreqMult := V; 219 | end; 220 | 9: 221 | begin 222 | V := CurInstr^.Operators[0].Waveform.Waveform; 223 | Input.InputHex2(S, V, $7); 224 | CurInstr^.Operators[0].Waveform.Waveform := V; 225 | end; 226 | 10: 227 | begin 228 | V := CurInstr^.Operators[0].Effect.EGTyp; 229 | Input.InputYesNo(S, V); 230 | CurInstr^.Operators[0].Effect.EGTyp := V; 231 | end; 232 | 11: 233 | begin 234 | V := CurInstr^.Operators[0].Effect.KSR; 235 | Input.InputYesNo(S, V); 236 | CurInstr^.Operators[0].Effect.KSR := V; 237 | end; 238 | 12: 239 | begin 240 | V := CurInstr^.Operators[0].Effect.Vib; 241 | Input.InputYesNo(S, V); 242 | CurInstr^.Operators[0].Effect.Vib := V; 243 | end; 244 | 13: 245 | begin 246 | V := CurInstr^.Operators[0].Effect.AmpMod; 247 | Input.InputYesNo(S, V); 248 | CurInstr^.Operators[0].Effect.AmpMod := V; 249 | end; 250 | // 251 | 14: 252 | begin 253 | Input.InputText(CurInstr^.Name, 20); 254 | S := CurInstr^.Name; 255 | end; 256 | 15: 257 | begin 258 | V := CurInstr^.AlgFeedback.Feedback; 259 | Input.InputHex2(S, V, 7); 260 | CurInstr^.AlgFeedback.Feedback := V; 261 | end; 262 | // 263 | 16: 264 | begin 265 | V := CurInstr^.Operators[1].AttackDecay.Attack; 266 | Input.InputHex2(S, V, $F); 267 | CurInstr^.Operators[1].AttackDecay.Attack := V; 268 | end; 269 | 17: 270 | begin 271 | V := CurInstr^.Operators[1].AttackDecay.Decay; 272 | Input.InputHex2(S, V, $F); 273 | CurInstr^.Operators[1].AttackDecay.Decay := V; 274 | end; 275 | 18: 276 | begin 277 | V := $F - CurInstr^.Operators[1].SustainRelease.Sustain; 278 | Input.InputHex2(S, V, $F); 279 | CurInstr^.Operators[1].SustainRelease.Sustain := $F - V; 280 | end; 281 | 19: 282 | begin 283 | V := CurInstr^.Operators[1].SustainRelease.Release; 284 | Input.InputHex2(S, V, $F); 285 | CurInstr^.Operators[1].SustainRelease.Release := V; 286 | end; 287 | 20: 288 | begin 289 | V := $3F - CurInstr^.Operators[1].Volume.Total; 290 | Input.InputHex2(S, V, $3F); 291 | CurInstr^.Operators[1].Volume.Total := $3F - V; 292 | end; 293 | 21: 294 | begin 295 | V := CurInstr^.Operators[1].Volume.Scaling; 296 | Input.InputHex2(S, V, 3); 297 | CurInstr^.Operators[1].Volume.Scaling := V; 298 | end; 299 | 22: 300 | begin 301 | V := CurInstr^.Operators[1].Effect.ModFreqMult; 302 | Input.InputHex2(S, V, $F); 303 | CurInstr^.Operators[1].Effect.ModFreqMult := V; 304 | end; 305 | 23: 306 | begin 307 | V := CurInstr^.Operators[1].Waveform.Waveform; 308 | Input.InputHex2(S, V, $7); 309 | CurInstr^.Operators[1].Waveform.Waveform := V; 310 | end; 311 | 24: 312 | begin 313 | V := CurInstr^.Operators[1].Effect.EGTyp; 314 | Input.InputYesNo(S, V); 315 | CurInstr^.Operators[1].Effect.EGTyp := V; 316 | end; 317 | 25: 318 | begin 319 | V := CurInstr^.Operators[1].Effect.KSR; 320 | Input.InputYesNo(S, V); 321 | CurInstr^.Operators[1].Effect.KSR := V; 322 | end; 323 | 26: 324 | begin 325 | V := CurInstr^.Operators[1].Effect.Vib; 326 | Input.InputYesNo(S, V); 327 | CurInstr^.Operators[1].Effect.Vib := V; 328 | end; 329 | 27: 330 | begin 331 | V := CurInstr^.Operators[1].Effect.AmpMod; 332 | Input.InputYesNo(S, V); 333 | CurInstr^.Operators[1].Effect.AmpMod := V; 334 | end; 335 | // 336 | 28: 337 | begin 338 | V := Byte(CurInstr^.FineTune); 339 | Input.InputHex2(S, V, $FF); 340 | CurInstr^.FineTune := ShortInt(V); 341 | end; 342 | // 343 | 29: 344 | begin 345 | V := CurInstr^.Operators[2].AttackDecay.Attack; 346 | Input.InputHex2(S, V, $F); 347 | CurInstr^.Operators[2].AttackDecay.Attack := V; 348 | end; 349 | 30: 350 | begin 351 | V := CurInstr^.Operators[2].AttackDecay.Decay; 352 | Input.InputHex2(S, V, $F); 353 | CurInstr^.Operators[2].AttackDecay.Decay := V; 354 | end; 355 | 31: 356 | begin 357 | V := $F - CurInstr^.Operators[2].SustainRelease.Sustain; 358 | Input.InputHex2(S, V, $F); 359 | CurInstr^.Operators[2].SustainRelease.Sustain := $F - V; 360 | end; 361 | 32: 362 | begin 363 | V := CurInstr^.Operators[2].SustainRelease.Release; 364 | Input.InputHex2(S, V, $F); 365 | CurInstr^.Operators[2].SustainRelease.Release := V; 366 | end; 367 | 33: 368 | begin 369 | V := $3F - CurInstr^.Operators[2].Volume.Total; 370 | Input.InputHex2(S, V, $3F); 371 | CurInstr^.Operators[2].Volume.Total := $3F - V; 372 | end; 373 | 34: 374 | begin 375 | V := CurInstr^.Operators[2].Volume.Scaling; 376 | Input.InputHex2(S, V, 3); 377 | CurInstr^.Operators[2].Volume.Scaling := V; 378 | end; 379 | 35: 380 | begin 381 | V := CurInstr^.Operators[2].Effect.ModFreqMult; 382 | Input.InputHex2(S, V, $F); 383 | CurInstr^.Operators[2].Effect.ModFreqMult := V; 384 | end; 385 | 36: 386 | begin 387 | V := CurInstr^.Operators[2].Waveform.Waveform; 388 | Input.InputHex2(S, V, $7); 389 | CurInstr^.Operators[2].Waveform.Waveform := V; 390 | end; 391 | 37: 392 | begin 393 | V := CurInstr^.Operators[2].Effect.EGTyp; 394 | Input.InputYesNo(S, V); 395 | CurInstr^.Operators[2].Effect.EGTyp := V; 396 | end; 397 | 38: 398 | begin 399 | V := CurInstr^.Operators[2].Effect.KSR; 400 | Input.InputYesNo(S, V); 401 | CurInstr^.Operators[2].Effect.KSR := V; 402 | end; 403 | 39: 404 | begin 405 | V := CurInstr^.Operators[2].Effect.Vib; 406 | Input.InputYesNo(S, V); 407 | CurInstr^.Operators[2].Effect.Vib := V; 408 | end; 409 | 40: 410 | begin 411 | V := CurInstr^.Operators[2].Effect.AmpMod; 412 | Input.InputYesNo(S, V); 413 | CurInstr^.Operators[2].Effect.AmpMod := V; 414 | end; 415 | // 416 | 41: 417 | begin 418 | V := Byte(CurInstr^.AlgFeedback.Panning); 419 | Input.InputPanning(S, V); 420 | CurInstr^.AlgFeedback.Panning := V; 421 | end; 422 | // 423 | 42: 424 | begin 425 | V := CurInstr^.Operators[3].AttackDecay.Attack; 426 | Input.InputHex2(S, V, $F); 427 | CurInstr^.Operators[3].AttackDecay.Attack := V; 428 | end; 429 | 43: 430 | begin 431 | V := CurInstr^.Operators[3].AttackDecay.Decay; 432 | Input.InputHex2(S, V, $F); 433 | CurInstr^.Operators[3].AttackDecay.Decay := V; 434 | end; 435 | 44: 436 | begin 437 | V := $F - CurInstr^.Operators[3].SustainRelease.Sustain; 438 | Input.InputHex2(S, V, $F); 439 | CurInstr^.Operators[3].SustainRelease.Sustain := $F - V; 440 | end; 441 | 45: 442 | begin 443 | V := CurInstr^.Operators[3].SustainRelease.Release; 444 | Input.InputHex2(S, V, $F); 445 | CurInstr^.Operators[3].SustainRelease.Release := V; 446 | end; 447 | 46: 448 | begin 449 | V := $3F - CurInstr^.Operators[3].Volume.Total; 450 | Input.InputHex2(S, V, $3F); 451 | CurInstr^.Operators[3].Volume.Total := $3F - V; 452 | end; 453 | 47: 454 | begin 455 | V := CurInstr^.Operators[3].Volume.Scaling; 456 | Input.InputHex2(S, V, 3); 457 | CurInstr^.Operators[3].Volume.Scaling := V; 458 | end; 459 | 48: 460 | begin 461 | V := CurInstr^.Operators[3].Effect.ModFreqMult; 462 | Input.InputHex2(S, V, $F); 463 | CurInstr^.Operators[3].Effect.ModFreqMult := V; 464 | end; 465 | 49: 466 | begin 467 | V := CurInstr^.Operators[3].Waveform.Waveform; 468 | Input.InputHex2(S, V, $7); 469 | CurInstr^.Operators[3].Waveform.Waveform := V; 470 | end; 471 | 50: 472 | begin 473 | V := CurInstr^.Operators[3].Effect.EGTyp; 474 | Input.InputYesNo(S, V); 475 | CurInstr^.Operators[3].Effect.EGTyp := V; 476 | end; 477 | 51: 478 | begin 479 | V := CurInstr^.Operators[3].Effect.KSR; 480 | Input.InputYesNo(S, V); 481 | CurInstr^.Operators[3].Effect.KSR := V; 482 | end; 483 | 52: 484 | begin 485 | V := CurInstr^.Operators[3].Effect.Vib; 486 | Input.InputYesNo(S, V); 487 | CurInstr^.Operators[3].Effect.Vib := V; 488 | end; 489 | 53: 490 | begin 491 | V := CurInstr^.Operators[3].Effect.AmpMod; 492 | Input.InputYesNo(S, V); 493 | CurInstr^.Operators[3].Effect.AmpMod := V; 494 | end; 495 | end; 496 | 497 | if KBInput.ScanCode < $FE then 498 | case KBInput.ScanCode of 499 | SCAN_LEFT: 500 | begin 501 | if CurMenuPos = 28 then 502 | begin 503 | Input.InputCursor := 2; 504 | CurMenuPos := 15; 505 | end else 506 | if CurMenuPos = 41 then 507 | begin 508 | Input.InputCursor := 2; 509 | CurMenuPos := 28; 510 | end else 511 | if CurMenuPos >= 27 then 512 | begin 513 | Input.InputCursor := 2; 514 | Dec(CurMenuPos, 13); 515 | end else 516 | if CurMenuPos >= 14 then 517 | begin 518 | Input.InputCursor := 2; 519 | Dec(CurMenuPos, 14); 520 | end; 521 | if CurMenuPos = 0 then 522 | Inc(CurMenuPos); 523 | if CurMenuPos = 14 then 524 | Input.InputCursor := 1; 525 | end; 526 | SCAN_RIGHT: 527 | begin 528 | if CurMenuPos = 15 then 529 | begin 530 | Input.InputCursor := 1; 531 | CurMenuPos := 28; 532 | end else 533 | if CurMenuPos = 28 then 534 | begin 535 | Input.InputCursor := 1; 536 | CurMenuPos := 41; 537 | end else 538 | if CurMenuPos <= 14 then 539 | begin 540 | Input.InputCursor := 1; 541 | Inc(CurMenuPos, 14) 542 | end else 543 | if CurMenuPos <= 40 then 544 | begin 545 | Input.InputCursor := 1; 546 | Inc(CurMenuPos, 13) 547 | end; 548 | if CurMenuPos = 14 then 549 | Input.InputCursor := 1; 550 | end; 551 | SCAN_UP: 552 | begin 553 | if CurMenuPos > 1 then 554 | Dec(CurMenuPos); 555 | if (CurMenuPos = 14) or (CurMenuPos = 41) then 556 | Input.InputCursor := 1; 557 | end; 558 | SCAN_DOWN: 559 | begin 560 | if CurMenuPos < 53 then 561 | Inc(CurMenuPos); 562 | if (CurMenuPos = 14) or (CurMenuPos = 41) then 563 | Input.InputCursor := 1; 564 | end; 565 | SCAN_SPACE: 566 | begin 567 | if CurInstr^.Is4Op then 568 | V := 8 569 | else 570 | V := 5; 571 | Adlib.SetInstrument(V, CurInstr); 572 | AdLib.NoteClear(V); 573 | Adlib.NoteOn(V, TestNote.Note, TestNote.Octave, CurInstr^.FineTune); 574 | IsInstrTesting := True; 575 | end; 576 | SCAN_ENTER: 577 | begin 578 | Adlib.NoteClear(5); 579 | Adlib.NoteClear(8); 580 | IsInstrTesting := False; 581 | end; 582 | SCAN_F1: 583 | begin 584 | ShowHelpDialog('INSTR.TXT'); 585 | RenderTexts; 586 | RenderInstrInfo; 587 | Screen.SetCursorPosition(MenuList[CurMenuPos].X + Input.InputCursor - 1, MenuList[CurMenuPos].Y); 588 | Continue; 589 | end; 590 | SCAN_C: 591 | begin 592 | if IsCtrl then 593 | Clipbrd.ClipbrdInstr := CurInstr^; 594 | end; 595 | SCAN_V: 596 | begin 597 | if IsCtrl then 598 | begin 599 | CurInstr^ := Clipbrd.ClipbrdInstr; 600 | RenderInstrInfo; 601 | end; 602 | end; 603 | SCAN_F10: 604 | begin 605 | CurInstr^.Is4Op := not CurInstr^.Is4Op; 606 | RenderInstrInfo; 607 | end 608 | else 609 | begin 610 | case KBInput.CharCode of 611 | '+', '=': 612 | begin 613 | if TestNote.Octave <= ADLIB_MAX_OCTAVE - 1 then 614 | begin 615 | if TestNote.Note < 12 then 616 | begin 617 | TestNote.Note := TestNote.Note + 1; 618 | end else 619 | if TestNote.Octave < ADLIB_MAX_OCTAVE - 1 then 620 | begin 621 | TestNote.Octave := TestNote.Octave + 1; 622 | TestNote.Note := 1; 623 | end; 624 | end; 625 | Str(TestNote.Octave, S); 626 | WriteText(77, 22, $0F, ADLIB_NOTESYM_TABLE[TestNote.Note]); 627 | WriteText(79, 22, $0F, S); 628 | end; 629 | '-': 630 | begin 631 | if TestNote.Octave >= 0 then 632 | begin 633 | if TestNote.Note > 1 then 634 | begin 635 | TestNote.Note := TestNote.Note - 1; 636 | end else 637 | if TestNote.Octave > 0 then 638 | begin 639 | TestNote.Octave := TestNote.Octave - 1; 640 | TestNote.Note := 12; 641 | end; 642 | end; 643 | Str(TestNote.Octave, S); 644 | WriteText(77, 22, $0F, ADLIB_NOTESYM_TABLE[TestNote.Note]); 645 | WriteText(79, 22, $0F, S); 646 | end; 647 | '<', ',': 648 | begin 649 | if CurInstrPos > 0 then 650 | begin 651 | Adlib.NoteOff(CurInstrPos); 652 | Dec(CurInstrPos); 653 | CurInstr := @NepperRec.Instruments[CurInstrPos]; 654 | RenderInstrInfo; 655 | end; 656 | end; 657 | '>', '.': 658 | begin 659 | if CurInstrPos < High(NepperRec.Instruments) then 660 | begin 661 | Adlib.NoteOff(CurInstrPos); 662 | Inc(CurInstrPos); 663 | CurInstr := @NepperRec.Instruments[CurInstrPos]; 664 | RenderInstrInfo; 665 | end; 666 | end; 667 | 's': 668 | begin 669 | S := ''; 670 | if ShowInputDialog('Save Instrument', S) then 671 | begin 672 | SaveInstrument(S, CurInstr); 673 | S := ''; 674 | end; 675 | RenderTexts; 676 | RenderInstrInfo; 677 | Screen.SetCursorPosition(MenuList[CurMenuPos].X + Input.InputCursor - 1, MenuList[CurMenuPos].Y); 678 | Continue; 679 | end; 680 | 'l': 681 | begin 682 | S := ''; 683 | if ShowInputDialog('Load Instrument', S) then 684 | begin 685 | if not LoadInstrument(S, CurInstr) then 686 | ShowMessageDialog('Error', 'File not found / Invalid format!'); 687 | S := ''; 688 | end; 689 | RenderTexts; 690 | RenderInstrInfo; 691 | Screen.SetCursorPosition(MenuList[CurMenuPos].X + Input.InputCursor - 1, MenuList[CurMenuPos].Y); 692 | Continue; 693 | end; 694 | end; 695 | end; 696 | end; 697 | 698 | if KBInput.ScanCode = $FF then 699 | begin 700 | if CurMenuPos = 14 then 701 | Screen.WriteText(MenuList[CurMenuPos].X, MenuList[CurMenuPos].Y, $0F, S, 20) 702 | else 703 | Screen.WriteText(MenuList[CurMenuPos].X, MenuList[CurMenuPos].Y, $0F, S); 704 | end; 705 | if OldCurMenuPos <> CurMenuPos then 706 | begin 707 | if Input.InputCursor > 2 then 708 | Input.InputCursor := 2; 709 | Screen.SetCursorPosition(MenuList[CurMenuPos].X + Input.InputCursor - 1, MenuList[CurMenuPos].Y); 710 | end; 711 | until (KBInput.ScanCode = SCAN_ESC) or (KBInput.ScanCode = SCAN_F2); 712 | if CurInstr^.Is4Op then 713 | V := 8 714 | else 715 | V := 5; 716 | Adlib.NoteClear(V); 717 | IsInstr := False; 718 | end; 719 | 720 | var 721 | I: Byte; 722 | 723 | initialization 724 | CurInstr := @NepperRec.Instruments[0]; 725 | TestNote.Octave := 4; 726 | TestNote.Note := 1; 727 | // Fill up menu 728 | FillChar(MenuList[0], SizeOf(MenuList), $FF); 729 | // X 730 | for I := 0 to 13 do 731 | MenuList[I].X := OP1_X + 1; 732 | for I := 14 to 27 do 733 | MenuList[I].X := OP2_X + 1; 734 | for I := 28 to 40 do 735 | MenuList[I].X := OP3_X + 1; 736 | for I := 41 to 53 do 737 | MenuList[I].X := OP4_X + 1; 738 | // Y 739 | MenuList[0].Y := 3; 740 | MenuList[1].Y := 4; 741 | MenuList[14].Y := 3; 742 | MenuList[15].Y := 4; 743 | MenuList[28].Y := 4; 744 | MenuList[41].Y := 4; 745 | for I := 7 to 18 do 746 | begin 747 | MenuList[I - 5].Y := I; 748 | MenuList[I + 9].Y := I; 749 | MenuList[I + (29 - 7)].Y := I; 750 | MenuList[I + (42 - 7)].Y := I; 751 | end; 752 | 753 | end. 754 | 755 | -------------------------------------------------------------------------------- /src/edpattern.pas: -------------------------------------------------------------------------------- 1 | unit EdPattern; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | uses 8 | Adlib, Utils; 9 | 10 | var 11 | IsPatternEdit: Boolean = False; 12 | 13 | procedure RenderCommonTexts; 14 | procedure ResetParams; 15 | procedure RenderPatternInfo; 16 | procedure Loop; 17 | 18 | implementation 19 | 20 | uses 21 | Input, Keyboard, Screen, Formats, EdSong, Player, Dialogs, Clipbrd; 22 | 23 | const 24 | PATTERN_SCREEN_START_X = 4; 25 | PATTERN_SCREEN_START_Y = 11; 26 | PATTERN_SCREEN_SIZE = 11; 27 | PATTERN_CHANNEL_WIDE = 8; 28 | 29 | var 30 | VirtualSheetPointer: PWord; 31 | CurPattern: PNepperPattern; 32 | CurPatternIndex: Byte; 33 | Anchor: Byte = 0; 34 | CurChannel: Byte = 0; 35 | CurCell: Byte = 0; 36 | CurCellPart: Byte = 0; 37 | CurOctave: Byte = 4; 38 | CurStep: Byte = 1; 39 | CurInstrIndex: Byte = 0; 40 | IsEditMode: Boolean = True; 41 | GS2: String2; 42 | GS3: String3; 43 | IsMarked: Boolean = False; 44 | 45 | procedure ResetParams; 46 | begin 47 | if CurChannel > NepperRec.ChannelCount - 1 then 48 | CurChannel := NepperRec.ChannelCount - 1; 49 | CurCellPart := 0; 50 | IsMarked := False; 51 | end; 52 | 53 | procedure WriteTextSync(const X, Y, Attr: Byte; const S: String80; MaxLen: Byte = 0); 54 | begin 55 | WriteText(X, Y, Attr, S, MaxLen); 56 | ScreenPointer := VirtualSheetPointer; 57 | WriteText(X, Y - PATTERN_SCREEN_START_Y + Anchor, Attr, S, MaxLen); 58 | ScreenPointer := ScreenPointerBackup; 59 | end; 60 | 61 | procedure RenderEditModeText; 62 | begin 63 | if IsEditMode then 64 | WriteText(58, 9, $03, 'EDIT') 65 | else 66 | WriteText(58, 9, $03, '', 4); 67 | end; 68 | 69 | procedure RenderOctave; inline; 70 | begin 71 | WriteText(70, 9, $0F, Char(CurOctave + Byte('0'))); 72 | end; 73 | 74 | procedure RenderPatternIndex; inline; 75 | var 76 | S: String2; 77 | begin 78 | HexStrFast2(CurPatternIndex, S); 79 | WriteText(24, 9, $F, S, 2); 80 | end; 81 | 82 | procedure RenderInstrument; inline; 83 | var 84 | S: String2; 85 | PC: PNepperChannel; 86 | begin 87 | PC := @CurPattern^[CurChannel]; 88 | HexStrFast2(CurInstrIndex, S); 89 | WriteText(33, 9, $F, S, 2); 90 | WriteText(36, 9, $F, NepperRec.Instruments[CurInstrIndex].Name, 20); 91 | end; 92 | 93 | procedure RenderStep; 94 | begin 95 | HexStrFast2(CurStep, GS2); 96 | WriteText(78, 9, $0F, GS2); 97 | end; 98 | 99 | procedure RenderSpeed; 100 | begin 101 | HexStrFast2(NepperRec.Speed, GS2); 102 | WriteText(64, 8, COLOR_LABEL, 'Speed:'); 103 | WriteText(70, 8, $0F, GS2); 104 | HexStrFast2(NepperRec.Clock, GS2); 105 | WriteText(75, 8, COLOR_LABEL, 'Hz:'); 106 | WriteText(78, 8, $0F, GS2); 107 | end; 108 | 109 | procedure RenderMark; 110 | begin 111 | if IsMarked then 112 | begin 113 | HexStrFast2(ClipbrdCellStart, GS2); 114 | WriteText(72, 22, 3, 'Mark:'); 115 | WriteText(77, 22, 3, GS2); 116 | end else 117 | WriteText(72, 22, 3, '', 7); 118 | end; 119 | 120 | procedure RenderChannelStatus; 121 | var 122 | I: Byte; 123 | begin 124 | for I := 0 to MAX_CHANNELS - 1 do 125 | begin 126 | if not Player.ChannelEnabledList[I] then 127 | WriteText(PATTERN_SCREEN_START_X + PATTERN_CHANNEL_WIDE * I + 1, 10, $C, 'x') 128 | else 129 | WriteText(PATTERN_SCREEN_START_X + PATTERN_CHANNEL_WIDE * I + 1, 10, $C, ' '); 130 | end; 131 | end; 132 | 133 | // Time critical function, process all pattern data to a buffer for fast scrolling 134 | procedure RenderPatternInfo; 135 | var 136 | I, J: ShortInt; 137 | W: Word; 138 | B: Byte; 139 | PW: PWord; 140 | PC: PNepperChannelCells; 141 | begin 142 | FillChar(VirtualSheetPointer[0], 80*64*2, 0); 143 | PW := VirtualSheetPointer; 144 | for I := 0 to $3F do 145 | begin 146 | GS2[1] := BASE16_CHARS[Byte(I shr 4) and $F]; 147 | GS2[2] := BASE16_CHARS[Byte(I) and $F]; 148 | WriteTextFast2(PW, 03, GS2); 149 | Inc(PW, 80); 150 | end; 151 | for J := 0 to NepperRec.ChannelCount - 1 do 152 | begin 153 | PW := VirtualSheetPointer + (J * PATTERN_CHANNEL_WIDE + 4); 154 | PC := @CurPattern^[J].Cells; 155 | for I := 0 to $3F do 156 | begin 157 | if PC^[I].Note.Note = 0 then 158 | WriteTextFast3(PW, COLOR_LABEL, '---') 159 | else 160 | begin 161 | WriteTextFast2(PW, COLOR_LABEL, ADLIB_NOTESYM_TABLE[PC^[I].Note.Note]); 162 | WriteTextFast1(PW + 2, COLOR_LABEL, Char(PC^[I].Note.Octave + Byte('0'))); 163 | end; 164 | B := PC^[I].InstrumentIndex; 165 | GS2[1] := BASE16_CHARS[(B shr 4) and $F]; 166 | GS2[2] := BASE16_CHARS[B and $F]; 167 | WriteTextFast2(PW + 3, 07, GS2); 168 | W := Word(PC^[I].Effect); 169 | GS3[1] := Char(W shr 8); 170 | if Byte(GS3[1]) = 0 then 171 | GS3[1] := '0'; 172 | GS3[2] := BASE16_CHARS[Byte(W shr 4) and $F]; 173 | GS3[3] := BASE16_CHARS[Byte(W) and $F]; 174 | WriteTextFast3(PW + 5, $0F, GS3); 175 | PW := PW + 80; 176 | end; 177 | end; 178 | PW := ScreenPointer + 80 * PATTERN_SCREEN_START_Y; 179 | Move(VirtualSheetPointer[80 * Anchor], PW[0], PATTERN_SCREEN_SIZE*80*2); 180 | RenderEditModeText; 181 | RenderOctave; 182 | RenderPatternIndex; 183 | RenderInstrument; 184 | RenderStep; 185 | RenderChannelStatus; 186 | RenderSpeed; 187 | end; 188 | 189 | procedure RenderPatternInfoOneChannel(const Channel: Byte); 190 | var 191 | I, J: ShortInt; 192 | W: Word; 193 | B: Byte; 194 | PW: PWord; 195 | PC: PNepperChannelCells; 196 | begin 197 | J := Channel; 198 | PW := VirtualSheetPointer + (J * PATTERN_CHANNEL_WIDE + 4); 199 | PC := @CurPattern^[J].Cells; 200 | for I := 0 to $3F do 201 | begin 202 | if PC^[I].Note.Note = 0 then 203 | WriteTextFast3(PW, COLOR_LABEL, '---') 204 | else 205 | begin 206 | WriteTextFast2(PW, COLOR_LABEL, ADLIB_NOTESYM_TABLE[PC^[I].Note.Note]); 207 | WriteTextFast1(PW + 2, COLOR_LABEL, Char(PC^[I].Note.Octave + Byte('0'))); 208 | end; 209 | B := PC^[I].InstrumentIndex; 210 | GS2[1] := BASE16_CHARS[(B shr 4) and $F]; 211 | GS2[2] := BASE16_CHARS[B and $F]; 212 | WriteTextFast2(PW + 3, 07, GS2); 213 | W := Word(PC^[I].Effect); 214 | GS3[1] := Char(W shr 8); 215 | if Byte(GS3[1]) = 0 then 216 | GS3[1] := '0'; 217 | GS3[2] := BASE16_CHARS[Byte(W shr 4) and $F]; 218 | GS3[3] := BASE16_CHARS[Byte(W) and $F]; 219 | WriteTextFast3(PW + 5, $0F, GS3); 220 | PW := PW + 80; 221 | end; 222 | PW := ScreenPointer + 80 * PATTERN_SCREEN_START_Y; 223 | Move(VirtualSheetPointer[80 * Anchor], PW[0], PATTERN_SCREEN_SIZE*80*2); 224 | end; 225 | 226 | procedure RenderCommonTexts; 227 | begin 228 | WriteText(0, 0, $1F, ' - Nepper -', 80); 229 | WriteText(0, 1, $0E, ' [F1] Help [F2] Song/Pattern Editor [F3] Instrument Editor [ESC] Exit Nepper'); 230 | 231 | WriteText(0, 3, $4E, ' SONG DATA '); 232 | WriteText(0, 3, $4E, ' SONG DATA '); 233 | WriteText(0, 5, COLOR_LABEL, 'Song name:'); 234 | WriteText(63, 5, COLOR_LABEL, 'SPECIAL COMMANDS:'); 235 | WriteText(0, 6, COLOR_LABEL, ' Position:'); 236 | WriteText(63, 6, COLOR_LABEL, '[R] For Repeat'); 237 | WriteText(0, 7, COLOR_LABEL, ' Pattern:'); 238 | WriteText(63, 7, COLOR_LABEL, '[H] For Halt'); 239 | 240 | WriteText(0, 9, $4E, ' PATTERN DATA '); 241 | WriteText(16, 9, COLOR_LABEL, 'Pattern:'); 242 | WriteText(27, 9, COLOR_LABEL, 'Instr:'); 243 | WriteText(63, 9, COLOR_LABEL, 'Octave:'); 244 | WriteText(73, 9, COLOR_LABEL, 'Step:'); 245 | 246 | WriteText(0, 23, $0A, ''); 247 | WriteText(0, 24, $0A, ''); 248 | 249 | RenderSongInfo; 250 | RenderPatternInfo; 251 | end; 252 | 253 | procedure RenderTexts; 254 | begin 255 | WriteText(0, 0, $1A, 'PATTERN EDIT'); 256 | WriteText(0, 23, $0A, '[TAB] Song [INS-DEL] I/D [<>] Instr.sel [SF-UP/DN] Step [CTL-X/C/V] Ct/Cp/P', 80); 257 | WriteText(0, 24, $0A, '[SPC] P/S [CR] Edit mode [+-] Pattern.sel [SF-LF/RN] Octave [F5] Copy mark', 80); 258 | end; 259 | 260 | procedure LoopEditPattern; 261 | var 262 | S: String10; 263 | PC: PNepperChannel; 264 | W: Word; 265 | PW: PWord; 266 | OldInputCursor: Byte; 267 | OldCursorX, 268 | OldCursorY: Byte; 269 | 270 | procedure MoveDown(Step: Byte); 271 | begin 272 | if CurCell + Step > $3F then 273 | Step := $3F - CurCell; 274 | Inc(CurCell, Step); 275 | if CurCell - Anchor >= PATTERN_SCREEN_SIZE then 276 | begin 277 | Anchor := CurCell - PATTERN_SCREEN_SIZE + 1; 278 | PW := ScreenPointer + 80 * PATTERN_SCREEN_START_Y; 279 | Move(VirtualSheetPointer[80 * Anchor], PW[0], PATTERN_SCREEN_SIZE*80*2); 280 | Screen.SetCursorPosition(CursorX, PATTERN_SCREEN_START_Y + PATTERN_SCREEN_SIZE - 1); 281 | end else 282 | begin 283 | Screen.SetCursorPosition(CursorX, CursorY + Step); 284 | end; 285 | end; 286 | 287 | procedure MoveUp(Step: Byte); 288 | begin 289 | if ShortInt(CurCell) - ShortInt(Step) < 0 then 290 | Step := CurCell; 291 | Dec(CurCell, Step); 292 | if CurCell < Anchor then 293 | begin 294 | Anchor := CurCell; 295 | PW := ScreenPointer + 80 * PATTERN_SCREEN_START_Y; 296 | Move(VirtualSheetPointer[80 * Anchor], PW[0], PATTERN_SCREEN_SIZE*80*2); 297 | Screen.SetCursorPosition(CursorX, PATTERN_SCREEN_START_Y); 298 | end else 299 | begin 300 | Screen.SetCursorPosition(CursorX, CursorY - Step); 301 | end; 302 | end; 303 | 304 | procedure SetTone(const Note, Octave: Byte); 305 | begin 306 | if (Note <> 0) or (Octave <> 0) then 307 | begin 308 | Adlib.SetInstrument(CurChannel, @NepperRec.Instruments[CurInstrIndex]); 309 | AdLib.NoteClear(CurChannel); 310 | Adlib.NoteOn(CurChannel, Note, Octave); 311 | end; 312 | if IsEditMode then 313 | begin 314 | PC^.Cells[CurCell].Note.Note := Note; 315 | PC^.Cells[CurCell].Note.Octave := Octave; 316 | PC^.Cells[CurCell].InstrumentIndex := CurInstrIndex; 317 | if (Note = 0) and (Octave = 0) then 318 | begin 319 | PC^.Cells[CurCell].InstrumentIndex := 0; 320 | WriteTextSync(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE) , PATTERN_SCREEN_START_Y + CurCell - Anchor, COLOR_LABEL, '---', 3); 321 | WriteTextSync(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE) + 3, PATTERN_SCREEN_START_Y + CurCell - Anchor, $07, '00', 2); 322 | end else 323 | begin 324 | WriteTextSync(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE) , PATTERN_SCREEN_START_Y + CurCell - Anchor, COLOR_LABEL, ADLIB_NOTESYM_TABLE[Note], 2); 325 | WriteTextSync(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE) + 2, PATTERN_SCREEN_START_Y + CurCell - Anchor, COLOR_LABEL, Char(Octave + Byte('0')), 1); 326 | HexStrFast2(CurInstrIndex, GS2); 327 | WriteTextSync(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE) + 3, PATTERN_SCREEN_START_Y + CurCell - Anchor, $07, GS2, 2); 328 | MoveDown(CurStep); 329 | end; 330 | end; 331 | end; 332 | 333 | procedure InsertTone; 334 | var 335 | I: Byte; 336 | begin 337 | for I := $3F downto CurCell + 1 do 338 | begin 339 | PC^.Cells[I] := PC^.Cells[I - 1]; 340 | end; 341 | FillChar(PC^.Cells[CurCell], SizeOf(PC^.Cells[CurCell]), 0); 342 | RenderPatternInfoOneChannel(CurChannel); 343 | end; 344 | 345 | procedure DeleteTone; 346 | var 347 | I: Byte; 348 | begin 349 | for I := CurCell to $3E do 350 | begin 351 | PC^.Cells[I] := PC^.Cells[I + 1]; 352 | end; 353 | FillChar(PC^.Cells[$3F], SizeOf(PC^.Cells[$3F]), 0); 354 | RenderPatternInfoOneChannel(CurChannel); 355 | end; 356 | 357 | procedure EditTone; 358 | begin 359 | if IsCtrl then 360 | Exit; 361 | case KBInput.CharCode of 362 | 'z': 363 | begin 364 | SetTone(1, CurOctave); 365 | end; 366 | 's': 367 | begin 368 | SetTone(2, CurOctave); 369 | end; 370 | 'x': 371 | begin 372 | SetTone(3, CurOctave); 373 | end; 374 | 'd': 375 | begin 376 | SetTone(4, CurOctave); 377 | end; 378 | 'c': 379 | begin 380 | SetTone(5, CurOctave); 381 | end; 382 | 'v': 383 | begin 384 | SetTone(6, CurOctave); 385 | end; 386 | 'g': 387 | begin 388 | SetTone(7, CurOctave); 389 | end; 390 | 'b': 391 | begin 392 | SetTone(8, CurOctave); 393 | end; 394 | 'h': 395 | begin 396 | SetTone(9, CurOctave); 397 | end; 398 | 'n': 399 | begin 400 | SetTone(10, CurOctave); 401 | end; 402 | 'j': 403 | begin 404 | SetTone(11, CurOctave); 405 | end; 406 | 'm': 407 | begin 408 | SetTone(12, CurOctave); 409 | end; 410 | // 411 | 'q': 412 | begin 413 | SetTone(1, CurOctave + 1); 414 | end; 415 | '2': 416 | begin 417 | SetTone(2, CurOctave + 1); 418 | end; 419 | 'w': 420 | begin 421 | SetTone(3, CurOctave + 1); 422 | end; 423 | '3': 424 | begin 425 | SetTone(4, CurOctave + 1); 426 | end; 427 | 'e': 428 | begin 429 | SetTone(5, CurOctave + 1); 430 | end; 431 | 'r': 432 | begin 433 | SetTone(6, CurOctave + 1); 434 | end; 435 | '5': 436 | begin 437 | SetTone(7, CurOctave + 1); 438 | end; 439 | 't': 440 | begin 441 | SetTone(8, CurOctave + 1); 442 | end; 443 | '6': 444 | begin 445 | SetTone(9, CurOctave + 1); 446 | end; 447 | 'y': 448 | begin 449 | SetTone(10, CurOctave + 1); 450 | end; 451 | '7': 452 | begin 453 | SetTone(11, CurOctave + 1); 454 | end; 455 | 'u': 456 | begin 457 | SetTone(12, CurOctave + 1); 458 | end; 459 | '0': 460 | begin 461 | SetTone(0, 0); 462 | end 463 | else 464 | case KBInput.ScanCode of 465 | SCAN_INS: 466 | begin 467 | InsertTone; 468 | end; 469 | SCAN_DEL: 470 | begin 471 | DeleteTone; 472 | end; 473 | end; 474 | end; 475 | end; 476 | 477 | procedure DisableMark; 478 | begin 479 | IsMarked := False; 480 | RenderMark; 481 | end; 482 | 483 | procedure EnableMark; 484 | begin 485 | IsMarked := True; 486 | ClipbrdCellStart := CurCell; 487 | RenderMark; 488 | end; 489 | 490 | procedure PlotMark; 491 | begin 492 | if not IsMarked then 493 | begin 494 | EnableMark; 495 | end else 496 | begin 497 | DisableMark; 498 | end; 499 | end; 500 | 501 | procedure CopyNotes; 502 | var 503 | I: Byte; 504 | procedure CopyNote; 505 | begin 506 | ClipbrdCells[I].Note := PC^.Cells[I].Note; 507 | ClipbrdCells[I].InstrumentIndex := PC^.Cells[I].InstrumentIndex; 508 | end; 509 | begin 510 | if not IsMarked then 511 | begin 512 | Clipbrd.ClipbrdCellStart := -1; 513 | for I := 0 to $3F do 514 | begin 515 | CopyNote 516 | end; 517 | end else 518 | begin 519 | SwapIfBigger(Clipbrd.ClipbrdCellStart, Clipbrd.ClipbrdCellEnd); 520 | for I := Clipbrd.ClipbrdCellStart to Clipbrd.ClipbrdCellEnd do 521 | begin 522 | CopyNote; 523 | end; 524 | end; 525 | end; 526 | 527 | procedure CutNotes; 528 | var 529 | I: Byte; 530 | procedure CutNote; 531 | begin 532 | ClipbrdCells[I].Note := PC^.Cells[I].Note; 533 | ClipbrdCells[I].InstrumentIndex := PC^.Cells[I].InstrumentIndex; 534 | Byte(PC^.Cells[I].Note) := 0; 535 | PC^.Cells[I].InstrumentIndex := 0; 536 | end; 537 | begin 538 | if not IsMarked then 539 | begin 540 | Clipbrd.ClipbrdCellStart := -1; 541 | for I := 0 to $3F do 542 | begin 543 | CutNote; 544 | end; 545 | end else 546 | begin 547 | SwapIfBigger(Clipbrd.ClipbrdCellStart, Clipbrd.ClipbrdCellEnd); 548 | for I := Clipbrd.ClipbrdCellStart to Clipbrd.ClipbrdCellEnd do 549 | begin 550 | CutNote; 551 | end; 552 | end; 553 | end; 554 | 555 | procedure PasteNotes; 556 | var 557 | I: Byte; 558 | begin 559 | if Clipbrd.ClipbrdCellStart >= 0 then 560 | begin 561 | for I := 0 to Clipbrd.ClipbrdCellEnd - Clipbrd.ClipbrdCellStart do 562 | begin 563 | PC^.Cells[CurCell + I].Note := ClipbrdCells[I + Clipbrd.ClipbrdCellStart].Note; 564 | PC^.Cells[CurCell + I].InstrumentIndex := ClipbrdCells[I + Clipbrd.ClipbrdCellStart].InstrumentIndex; 565 | if I + CurCell >= $3F then 566 | Break; 567 | end; 568 | end else 569 | begin 570 | for I := 0 to $3F do 571 | begin 572 | PC^.Cells[CurCell + I].Note := ClipbrdCells[I].Note; 573 | PC^.Cells[CurCell + I].InstrumentIndex := ClipbrdCells[I].InstrumentIndex; 574 | if I + CurCell >= $3F then 575 | Break; 576 | end; 577 | end; 578 | end; 579 | 580 | procedure CopyEffects; 581 | var 582 | I: Byte; 583 | begin 584 | if not IsMarked then 585 | begin 586 | Clipbrd.ClipbrdCellStart := -1; 587 | for I := 0 to $3F do 588 | ClipbrdCells[I].Effect := PC^.Cells[I].Effect; 589 | end else 590 | begin 591 | SwapIfBigger(Clipbrd.ClipbrdCellStart, Clipbrd.ClipbrdCellEnd); 592 | for I := Clipbrd.ClipbrdCellStart to Clipbrd.ClipbrdCellEnd do 593 | ClipbrdCells[I].Effect := PC^.Cells[I].Effect; 594 | end; 595 | end; 596 | 597 | procedure CutEffects; 598 | var 599 | I: Byte; 600 | begin 601 | if not IsMarked then 602 | begin 603 | Clipbrd.ClipbrdCellStart := -1; 604 | for I := 0 to $3F do 605 | begin 606 | ClipbrdCells[I].Effect := PC^.Cells[I].Effect; 607 | Word(PC^.Cells[I].Effect) := 0; 608 | end; 609 | end else 610 | begin 611 | SwapIfBigger(Clipbrd.ClipbrdCellStart, Clipbrd.ClipbrdCellEnd); 612 | for I := Clipbrd.ClipbrdCellStart to Clipbrd.ClipbrdCellEnd do 613 | begin 614 | ClipbrdCells[I].Effect := PC^.Cells[I].Effect; 615 | Word(PC^.Cells[I].Effect) := 0; 616 | end; 617 | end; 618 | end; 619 | 620 | procedure PasteEffects; 621 | var 622 | I: Byte; 623 | begin 624 | if Clipbrd.ClipbrdCellStart >= 0 then 625 | begin 626 | for I := 0 to Clipbrd.ClipbrdCellEnd - Clipbrd.ClipbrdCellStart do 627 | begin 628 | PC^.Cells[CurCell + I].Effect := ClipbrdCells[I + Clipbrd.ClipbrdCellStart].Effect; 629 | if I + CurCell >= $3F then 630 | Break; 631 | end; 632 | end else 633 | begin 634 | for I := 0 to $3F do 635 | begin 636 | PC^.Cells[CurCell + I].Effect := ClipbrdCells[I].Effect; 637 | if I + CurCell >= $3F then 638 | Break; 639 | end; 640 | end; 641 | end; 642 | 643 | procedure DoCut; 644 | begin 645 | Clipbrd.ClipbrdCellEnd := CurCell; 646 | if CurCellPart = 0 then 647 | CutNotes 648 | else 649 | CutEffects; 650 | DisableMark; 651 | RenderPatternInfoOneChannel(CurChannel); 652 | end; 653 | 654 | procedure DoCopy; 655 | begin 656 | Clipbrd.ClipbrdCellEnd := CurCell; 657 | if CurCellPart = 0 then 658 | CopyNotes 659 | else 660 | CopyEffects; 661 | DisableMark; 662 | end; 663 | 664 | procedure DoPaste; 665 | begin 666 | if CurCellPart = 0 then 667 | PasteNotes 668 | else 669 | PasteEffects; 670 | RenderPatternInfoOneChannel(CurChannel); 671 | end; 672 | 673 | begin 674 | PC := @CurPattern^[CurChannel]; 675 | // Edit effect 676 | if CurCellPart = 1 then 677 | begin 678 | W := Word(PC^.Cells[CurCell].Effect); 679 | OldInputCursor := Input.InputCursor; 680 | Input.InputHex3(S, W); 681 | if IsEditMode then 682 | begin 683 | Word(PC^.Cells[CurCell].Effect) := W; 684 | WriteTextSync(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE) + (CurCellPart * 5), PATTERN_SCREEN_START_Y + CurCell - Anchor, $0F, S, 3); 685 | if KBInput.ScanCode = $FF then 686 | begin 687 | if Input.InputCursor <> OldInputCursor then 688 | begin 689 | Input.InputCursor := OldInputCursor; 690 | Dec(CursorX); 691 | end; 692 | MoveDown(CurStep); 693 | end; 694 | end; 695 | end else 696 | // Edit tone 697 | begin 698 | EditTone; 699 | end; 700 | // Navigate 701 | if KBInput.ScanCode < $FE then 702 | begin 703 | case KBInput.ScanCode of 704 | SCAN_LEFT: 705 | begin 706 | if CurCellPart = 0 then 707 | begin 708 | if CurChannel > 0 then 709 | begin 710 | CurCellPart := 1; 711 | Input.InputCursor := 3; 712 | Dec(CurChannel); 713 | Screen.SetCursorPosition(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE) + (CurCellPart * 5)+ (Input.InputCursor - 1), PATTERN_SCREEN_START_Y + CurCell - Anchor); 714 | RenderInstrument; 715 | DisableMark; 716 | end; 717 | end else 718 | begin 719 | CurCellPart := 0; 720 | DisableMark; 721 | Screen.SetCursorPosition(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE) + (CurCellPart * 5), PATTERN_SCREEN_START_Y + CurCell - Anchor); 722 | end; 723 | end; 724 | SCAN_RIGHT: 725 | begin 726 | if CurCellPart = 1 then 727 | begin 728 | if CurChannel < NepperRec.ChannelCount - 1 then 729 | begin 730 | CurCellPart := 0; 731 | Input.InputCursor := 1; 732 | Inc(CurChannel); 733 | RenderInstrument; 734 | DisableMark; 735 | Screen.SetCursorPosition(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE) + (CurCellPart * 5), PATTERN_SCREEN_START_Y + CurCell - Anchor); 736 | end; 737 | end else 738 | begin 739 | CurCellPart := 1; 740 | DisableMark; 741 | Screen.SetCursorPosition(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE) + (CurCellPart * 5), PATTERN_SCREEN_START_Y + CurCell - Anchor); 742 | end; 743 | end; 744 | SCAN_DOWN: 745 | begin 746 | MoveDown(1); 747 | end; 748 | SCAN_UP: 749 | begin 750 | MoveUp(1); 751 | end; 752 | SCAN_PGDN: 753 | begin 754 | MoveDown(8); 755 | end; 756 | SCAN_PGUP: 757 | begin 758 | MoveUp(8); 759 | end; 760 | SCAN_HOME: 761 | begin 762 | MoveUp($3F); 763 | end; 764 | SCAN_END: 765 | begin 766 | MoveDown($3F); 767 | end; 768 | SCAN_F1: 769 | begin 770 | OldCursorX := CursorX; 771 | OldCursorY := CursorY; 772 | ShowHelpDialog('PATTERN.TXT'); 773 | RenderCommonTexts; 774 | RenderSongInfo; 775 | RenderTexts; 776 | EdPattern.RenderPatternInfo; 777 | Screen.SetCursorPosition(OldCursorX, OldCursorY); 778 | end; 779 | SCAN_F5: 780 | begin 781 | PlotMark; 782 | end; 783 | SCAN_X: 784 | begin 785 | if IsCtrl then 786 | begin 787 | DoCut; 788 | end; 789 | end; 790 | SCAN_C: 791 | begin 792 | if IsCtrl then 793 | begin 794 | DoCopy; 795 | end; 796 | end; 797 | SCAN_V: 798 | begin 799 | if IsCtrl then 800 | begin 801 | DoPaste; 802 | end; 803 | end; 804 | SCAN_SPACE: 805 | begin 806 | if not IsPlaying then 807 | Player.Start(CurPatternIndex, True) 808 | else 809 | Player.Stop; 810 | end 811 | else 812 | case KBInput.CharCode of 813 | '+', '=': 814 | begin 815 | if CurPatternIndex < High(Formats.Patterns) then 816 | begin 817 | Inc(CurPatternIndex); 818 | CurPattern := Formats.Patterns[CurPatternIndex]; 819 | RenderPatternInfo; 820 | end; 821 | end; 822 | '-': 823 | begin 824 | if CurPatternIndex > 0 then 825 | begin 826 | Dec(CurPatternIndex); 827 | CurPattern := Formats.Patterns[CurPatternIndex]; 828 | RenderPatternInfo; 829 | end; 830 | end; 831 | '<', ',': 832 | begin 833 | if CurInstrIndex > 0 then 834 | begin 835 | Dec(CurInstrIndex); 836 | RenderInstrument; 837 | Adlib.SetInstrument(CurChannel, @NepperRec.Instruments[CurInstrIndex]); 838 | end; 839 | end; 840 | '>', '.': 841 | begin 842 | if CurInstrIndex < 31 then 843 | begin 844 | Inc(CurInstrIndex); 845 | RenderInstrument; 846 | Adlib.SetInstrument(CurChannel, @NepperRec.Instruments[CurInstrIndex]); 847 | end; 848 | end; 849 | end; 850 | end; 851 | end; 852 | end; 853 | 854 | procedure EnableDisableChannels; 855 | procedure SwitchChannelStatus(const V: Byte); 856 | begin 857 | Player.ChannelEnabledList[V] := not Player.ChannelEnabledList[V]; 858 | RenderChannelStatus; 859 | end; 860 | begin 861 | case KBInput.CharCode of 862 | '!': 863 | SwitchChannelStatus(0); 864 | '@': 865 | SwitchChannelStatus(1); 866 | '#': 867 | SwitchChannelStatus(2); 868 | '$': 869 | SwitchChannelStatus(3); 870 | '%': 871 | SwitchChannelStatus(4); 872 | '^': 873 | SwitchChannelStatus(5); 874 | '&': 875 | SwitchChannelStatus(6); 876 | '*': 877 | SwitchChannelStatus(7); 878 | '(': 879 | SwitchChannelStatus(8); 880 | end; 881 | end; 882 | 883 | function LoopEditOctave: Boolean; 884 | var 885 | PC: PNepperChannel; 886 | begin 887 | PC := @CurPattern^[CurChannel]; 888 | Result := False; 889 | if Keyboard.IsShift then 890 | case KBInput.ScanCode of 891 | SCAN_RIGHT: 892 | begin 893 | if CurOctave < 6 then 894 | begin 895 | Inc(CurOctave); 896 | RenderOctave; 897 | end; 898 | Result := True; 899 | end; 900 | SCAN_LEFT: 901 | begin 902 | if CurOctave > 0 then 903 | begin 904 | Dec(CurOctave); 905 | RenderOctave; 906 | end; 907 | Result := True; 908 | end; 909 | end; 910 | end; 911 | 912 | function LoopEditStep: Boolean; 913 | begin 914 | Result := False; 915 | if Keyboard.IsShift then 916 | case KBInput.ScanCode of 917 | SCAN_UP: 918 | begin 919 | if CurStep < $3F then 920 | begin 921 | Inc(CurStep); 922 | RenderStep; 923 | end; 924 | Result := True; 925 | end; 926 | SCAN_DOWN: 927 | begin 928 | if CurStep > 0 then 929 | begin 930 | Dec(CurStep); 931 | RenderStep; 932 | end; 933 | Result := True; 934 | end; 935 | end; 936 | end; 937 | 938 | procedure Loop; 939 | begin 940 | ResetParams; 941 | RenderTexts; 942 | Screen.SetCursorPosition(PATTERN_SCREEN_START_X + (CurChannel * PATTERN_CHANNEL_WIDE), PATTERN_SCREEN_START_Y + CurCell - Anchor); 943 | repeat 944 | Keyboard.WaitForInput; 945 | if LoopEditOctave then Continue; 946 | if LoopEditStep then Continue; 947 | LoopEditPattern; 948 | EnableDisableChannels; 949 | case KBInput.ScanCode of 950 | SCAN_ENTER: 951 | begin 952 | IsEditMode := not IsEditMode; 953 | RenderEditModeText; 954 | end; 955 | end; 956 | until (KBInput.ScanCode = SCAN_ESC) or (KBInput.ScanCode = SCAN_F3) or (KBInput.ScanCode = SCAN_TAB); 957 | if KBInput.ScanCode = SCAN_TAB then 958 | begin 959 | ResetParams; 960 | end; 961 | end; 962 | 963 | initialization 964 | VirtualSheetPointer := AllocMem(80*64*2); 965 | CurPattern := Formats.Patterns[0]; 966 | CurPatternIndex := 0; 967 | GS3[0] := Char(3); 968 | GS2[0] := Char(2); 969 | 970 | finalization 971 | Freemem(VirtualSheetPointer); 972 | 973 | end. 974 | 975 | -------------------------------------------------------------------------------- /src/edsong.pas: -------------------------------------------------------------------------------- 1 | unit EdSong; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | uses 8 | Adlib, Utils; 9 | 10 | var 11 | IsSongPlaying: Boolean = False; 12 | 13 | procedure Loop; 14 | procedure RenderSongInfo; 15 | 16 | implementation 17 | 18 | uses 19 | Input, Keyboard, Screen, Formats, EdPattern, Player, Dialogs; 20 | 21 | var 22 | IsEditSongName: Boolean = False; 23 | PatternAnchor: Byte = 0; 24 | PatternIndex: Byte = 0; 25 | 26 | procedure ResetParams; 27 | begin 28 | IsEditSongName := False; 29 | Input.InputCursor := 1; 30 | Screen.SetCursorPosition(10 + (PatternIndex - PatternAnchor) * 3, 7); 31 | end; 32 | 33 | procedure RenderTexts; 34 | begin 35 | WriteText(0, 0, $1A, 'SONG EDIT '); 36 | WriteText(0, 23, $0A, '[TAB] Pattern [INS] Ins Pos. [L] Load [>] Add Chan. [F10] OPL2/3', 80); 37 | WriteText(0, 24, $0A, '[SPC] Play/Stop [DEL] Del Pos. [S] Save [<] Sub Chan.', 80); 38 | end; 39 | 40 | procedure RenderSongInfoFast; 41 | var 42 | I, P: Byte; 43 | S: String2; 44 | begin 45 | WriteText(10, 5, $0F, NepperRec.Name, 40); 46 | for I := 0 to $F do 47 | begin 48 | P := PatternAnchor + I; 49 | HexStrFast2(P, S); 50 | WriteText(10 + 3 * I, 6, $0F, S, 2); 51 | case NepperRec.Orders[P] of 52 | $FE: 53 | WriteText(10 + 3 * I, 7, $0F, 'R', 2); 54 | $FF: 55 | WriteText(10 + 3 * I, 7, $0F, 'H', 2); 56 | else 57 | begin 58 | S := HexStr(NepperRec.Orders[P], 2); 59 | WriteText(10 + 3 * I, 7, $0F, S, 2); 60 | end; 61 | end; 62 | end; 63 | if TAdlibOPLKind(NepperRec.OPLKind) <> aokOPL2 then 64 | begin 65 | if TAdlibOPLKind(NepperRec.OPLKind) = aokOPL3Op2 then 66 | WriteText(53, 8, $03, 'OPL3 Op-2') 67 | else 68 | WriteText(53, 8, $03, 'OPL3 Op-4'); 69 | end else 70 | begin 71 | WriteText(53, 8, $03, '', 9); 72 | end; 73 | end; 74 | 75 | procedure RenderSongInfo; 76 | begin 77 | WriteText(10, 5, $0F, '', 40); 78 | RenderSongInfoFast; 79 | end; 80 | 81 | procedure LoopEditSongName; 82 | begin 83 | Input.InputText(NepperRec.Name, 40); 84 | WriteText(10, 5, $0F, NepperRec.Name, 40); 85 | case KBInput.ScanCode of 86 | SCAN_DOWN: 87 | begin 88 | IsEditSongName := False; 89 | Screen.SetCursorPosition(10, 7); 90 | Input.InputCursor := 1; 91 | PatternIndex := 0; 92 | end; 93 | end; 94 | end; 95 | 96 | procedure LoopEditSheet; 97 | procedure MoveLeft(Step: Byte); 98 | begin 99 | if Integer(PatternIndex) - Integer(Step) < 0 then 100 | Step := PatternIndex; 101 | if PatternIndex - Step >= 0 then 102 | begin 103 | Dec(PatternIndex, Step); 104 | if PatternIndex < PatternAnchor then 105 | begin 106 | PatternAnchor := PatternIndex; 107 | RenderSongInfoFast; 108 | Screen.SetCursorPosition(10 + 1, 7); 109 | end else 110 | Screen.SetCursorPosition(10 + (PatternIndex - PatternAnchor) * 3 + 1, 7); 111 | Input.InputCursor := 2; 112 | end; 113 | end; 114 | 115 | procedure MoveRight(Step: Byte); 116 | begin 117 | if Integer(PatternIndex) + Integer(Step) > $FF then 118 | Step := $FF - PatternIndex; 119 | if PatternIndex + Step <= High(NepperRec.Orders) then 120 | begin 121 | Inc(PatternIndex, Step); 122 | if PatternIndex > PatternAnchor + $F then 123 | begin 124 | PatternAnchor := PatternIndex - $F; 125 | RenderSongInfoFast; 126 | Screen.SetCursorPosition(10 + 15 * 3, 7); 127 | end else 128 | Screen.SetCursorPosition(10 + (PatternIndex - PatternAnchor) * 3, 7); 129 | Input.InputCursor := 1; 130 | end; 131 | end; 132 | 133 | procedure Insert; 134 | var 135 | I: Byte; 136 | begin 137 | if PatternIndex = $FF then 138 | NepperRec.Orders[$FF] := 0 139 | else 140 | begin 141 | for I := $FE downto PatternIndex do 142 | begin 143 | NepperRec.Orders[I + 1] := NepperRec.Orders[I]; 144 | end; 145 | NepperRec.Orders[PatternIndex] := 0; 146 | end; 147 | RenderSongInfoFast; 148 | end; 149 | 150 | procedure Delete; 151 | var 152 | I: Byte; 153 | begin 154 | if PatternIndex = $FF then 155 | NepperRec.Orders[$FF] := 0 156 | else 157 | begin 158 | for I := PatternIndex to $FE do 159 | begin 160 | NepperRec.Orders[I] := NepperRec.Orders[I + 1]; 161 | end; 162 | NepperRec.Orders[$FF] := 0; 163 | end; 164 | RenderSongInfoFast; 165 | end; 166 | 167 | var 168 | S: String20; 169 | I, 170 | OldCursorX, 171 | OldCursorY: Byte; 172 | begin 173 | Input.InputHex2(S, NepperRec.Orders[PatternIndex], $3F); 174 | case NepperRec.Orders[PatternIndex] of 175 | SONG_REPEAT: 176 | WriteText(10 + (PatternIndex - PatternAnchor) * 3, 7, $0F, 'R', 2); 177 | SONG_HALT: 178 | WriteText(10 + (PatternIndex - PatternAnchor) * 3, 7, $0F, 'H', 2); 179 | else 180 | WriteText(10 + (PatternIndex - PatternAnchor) * 3, 7, $0F, S); 181 | end; 182 | if KBInput.ScanCode < $FE then 183 | case KBInput.ScanCode of 184 | SCAN_UP: 185 | begin 186 | IsEditSongName := True; 187 | Screen.SetCursorPosition(10, 5); 188 | Input.InputCursor := 1; 189 | end; 190 | SCAN_LEFT: 191 | begin 192 | MoveLeft(1); 193 | end; 194 | SCAN_RIGHT: 195 | begin 196 | MoveRight(1); 197 | end; 198 | SCAN_PGUP: 199 | begin 200 | MoveLeft(8); 201 | end; 202 | SCAN_PGDN: 203 | begin 204 | MoveRight(8); 205 | end; 206 | SCAN_INS: 207 | begin 208 | Insert; 209 | end; 210 | SCAN_DEL: 211 | begin 212 | Delete; 213 | end; 214 | SCAN_HOME: 215 | begin 216 | MoveLeft($FF); 217 | end; 218 | SCAN_END: 219 | begin 220 | MoveRight($FF); 221 | end; 222 | SCAN_F10: 223 | begin 224 | Inc(NepperRec.OPLKind); 225 | if NepperRec.OPLKind > 2 then 226 | NepperRec.OPLKind := 0; 227 | Adlib.SetOPL3(TAdlibOPLKind(NepperRec.OPLKind)); 228 | RenderSongInfoFast; 229 | end; 230 | SCAN_F1: 231 | begin 232 | OldCursorX := CursorX; 233 | OldCursorY := CursorY; 234 | ShowHelpDialog('PATTERN.TXT'); 235 | RenderCommonTexts; 236 | RenderSongInfo; 237 | RenderTexts; 238 | EdPattern.RenderPatternInfo; 239 | Screen.SetCursorPosition(OldCursorX, OldCursorY); 240 | end; 241 | SCAN_SPACE: 242 | begin 243 | if not IsPlaying then 244 | Player.Start(PatternIndex, False) 245 | else 246 | Player.Stop; 247 | end 248 | else 249 | case KBInput.CharCode of 250 | 'h': 251 | begin 252 | NepperRec.Orders[PatternIndex] := SONG_HALT; 253 | WriteText(10 + (PatternIndex - PatternAnchor) * 3, 7, $0F, 'H', 2); 254 | end; 255 | 'r': 256 | begin 257 | NepperRec.Orders[PatternIndex] := SONG_REPEAT; 258 | WriteText(10 + (PatternIndex - PatternAnchor) * 3, 7, $0F, 'R', 2); 259 | end; 260 | '<', ',': 261 | begin 262 | if NepperRec.ChannelCount > 1 then 263 | begin 264 | Dec(NepperRec.ChannelCount); 265 | EdPattern.ResetParams; 266 | EdPattern.RenderPatternInfo; 267 | end; 268 | end; 269 | '>', '.': 270 | begin 271 | if NepperRec.ChannelCount < MAX_CHANNELS then 272 | begin 273 | Inc(NepperRec.ChannelCount); 274 | EdPattern.ResetParams; 275 | EdPattern.RenderPatternInfo; 276 | end; 277 | end; 278 | 's': 279 | begin 280 | S := ''; 281 | OldCursorX := CursorX; 282 | OldCursorY := CursorY; 283 | if ShowInputDialog('Save song', S) then 284 | begin 285 | SaveSong(S); 286 | S := ''; 287 | end; 288 | RenderSongInfo; 289 | EdPattern.RenderPatternInfo; 290 | Screen.SetCursorPosition(OldCursorX, OldCursorY); 291 | end; 292 | 'l': 293 | begin 294 | S := ''; 295 | OldCursorX := CursorX; 296 | OldCursorY := CursorY; 297 | if ShowInputDialog('Load song', S) then 298 | begin 299 | Player.Stop; 300 | if not LoadSong(S) then 301 | ShowMessageDialog('Error', 'File not found / Invalid format!'); 302 | S := ''; 303 | end; 304 | RenderSongInfo; 305 | EdPattern.RenderPatternInfo; 306 | Screen.SetCursorPosition(OldCursorX, OldCursorY); 307 | end; 308 | end; 309 | end; 310 | end; 311 | 312 | procedure Loop; 313 | begin 314 | RenderTexts; 315 | RenderSongInfo; 316 | ResetParams; 317 | repeat 318 | Keyboard.WaitForInput; 319 | 320 | if IsEditSongName then 321 | LoopEditSongName 322 | else 323 | LoopEditSheet; 324 | until (KBInput.ScanCode = SCAN_ESC) or (KBInput.ScanCode = SCAN_F3) or (KBInput.ScanCode = SCAN_TAB); 325 | end; 326 | 327 | end. 328 | 329 | -------------------------------------------------------------------------------- /src/formats.pas: -------------------------------------------------------------------------------- 1 | unit Formats; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | uses 8 | Adlib; 9 | 10 | const 11 | INSTRUMENT_MAGIC = $BAB0; 12 | SONG_MAGIC = $0BB0; 13 | SONG_VERSION = 1; 14 | SONG_HALT = $FF; 15 | SONG_REPEAT = $FE; 16 | 17 | type 18 | TNepperNote = bitpacked record 19 | Note: TBit4; 20 | Octave: TBit4; 21 | end; 22 | 23 | TNepperEffectValue = bitpacked record 24 | V2: TBit4; 25 | V1: TBit4; 26 | end; 27 | 28 | TNepperEffect = bitpacked record 29 | V2: TBit4; 30 | V1: TBit4; 31 | Effect: Byte; 32 | end; 33 | 34 | PNepperChannelCell = ^TNepperChannelCell; 35 | TNepperChannelCell = packed record 36 | Note : TNepperNote; 37 | Effect: TNepperEffect; 38 | InstrumentIndex: Byte; 39 | end; 40 | 41 | PNepperChannelCells = ^TNepperChannelCells; 42 | TNepperChannelCells = array[0..$3F] of TNepperChannelCell; 43 | 44 | PNepperChannel = ^TNepperChannel; 45 | TNepperChannel = packed record 46 | Cells: TNepperChannelCells; 47 | end; 48 | 49 | PNepperPattern = ^TNepperPattern; 50 | TNepperPattern = array[0..MAX_CHANNELS - 1] of TNepperChannel; 51 | 52 | TNepperRec = packed record 53 | Magic: Word; 54 | Version: Byte; 55 | Name: String[40]; 56 | Speed: Byte; 57 | Clock: Byte; 58 | OPLKind: Byte; 59 | ChannelCount: ShortInt; 60 | Instruments: array[0..31] of TAdlibInstrument; 61 | Orders: array[0..$FF] of Byte; 62 | end; 63 | 64 | var 65 | NepperRec: TNepperRec; 66 | Patterns: array[0..$3F] of PNepperPattern; 67 | 68 | procedure SaveInstrument(FileName: String; const Inst: PAdlibInstrument); 69 | function LoadInstrument(FileName: String; const Inst: PAdlibInstrument): Boolean; 70 | procedure SaveSong(FileName: String); 71 | function LoadSong(FileName: String): Boolean; 72 | 73 | implementation 74 | 75 | uses 76 | Utils, Player, Timer; 77 | 78 | type 79 | TNepperInstrumentHeader = packed record 80 | Magic: Word; 81 | Version: Byte; 82 | end; 83 | 84 | procedure SaveInstrument(FileName: String; const Inst: PAdlibInstrument); 85 | var 86 | H: TNepperInstrumentHeader; 87 | F: File; 88 | begin 89 | if FileName = '' then 90 | Exit; 91 | if FindCharPos(FileName, '.') = 0 then 92 | FileName := FileName + '.nis'; 93 | Assign(F, FileName); 94 | Rewrite(F, 1); 95 | H.Magic := INSTRUMENT_MAGIC; 96 | H.Version := 1; 97 | BlockWrite(F, H.Magic, SizeOf(TNepperInstrumentHeader)); 98 | BlockWrite(F, Inst^.Operators[0], SizeOf(TAdlibInstrument)); 99 | Close(F); 100 | end; 101 | 102 | function LoadInstrument(FileName: String; const Inst: PAdlibInstrument): Boolean; 103 | var 104 | H: TNepperInstrumentHeader; 105 | F: File; 106 | begin 107 | Result := False; 108 | if FileName = '' then 109 | Exit; 110 | if FindCharPos(FileName, '.') = 0 then 111 | FileName := FileName + '.nis'; 112 | Assign(F, FileName); 113 | {$I-} 114 | System.Reset(F, 1); 115 | {$I+} 116 | if IOResult = 0 then 117 | begin 118 | BlockRead(F, H.Magic, SizeOf(TNepperInstrumentHeader)); 119 | if H.Magic <> INSTRUMENT_MAGIC then 120 | begin 121 | Close(F); 122 | Exit; 123 | end; 124 | BlockRead(F, Inst^.Operators[0], SizeOf(TAdlibInstrument)); 125 | Close(F); 126 | Result := True; 127 | end; 128 | end; 129 | 130 | procedure SaveSong(FileName: String); 131 | var 132 | F: File; 133 | I, J, K: Byte; 134 | IsDirty: Boolean; 135 | begin 136 | if FindCharPos(FileName, '.') = 0 then 137 | FileName := FileName + '.ntr'; 138 | if FileName = '' then 139 | Exit; 140 | if FindCharPos(FileName, '.') = 0 then 141 | FileName := FileName + '.nis'; 142 | Assign(F, FileName); 143 | Rewrite(F, 1); 144 | NepperRec.Magic := SONG_MAGIC; 145 | NepperRec.Version := 1; 146 | BlockWrite(F, NepperRec, SizeOf(TNepperRec)); 147 | for I := 0 to High(Formats.Patterns) do 148 | begin 149 | for J := 0 to NepperRec.ChannelCount - 1 do 150 | begin 151 | IsDirty := False; 152 | for K := 0 to $3F do 153 | begin 154 | if (Byte(Formats.Patterns[I]^[J].Cells[K].Note) <> 0) or 155 | (Word(Formats.Patterns[I]^[J].Cells[K].Effect) <> 0) then 156 | begin 157 | IsDirty := True; 158 | Break; 159 | end; 160 | end; 161 | if IsDirty then 162 | begin 163 | BlockWrite(F, I, 1); 164 | BlockWrite(F, J, 1); 165 | BlockWrite(F, K, 1); 166 | BlockWrite(F, Formats.Patterns[I]^[J].Cells[K], SizeOf(TNepperChannelCells) - K); 167 | end; 168 | end; 169 | end; 170 | Close(F); 171 | end; 172 | 173 | function LoadSong(FileName: String): Boolean; 174 | var 175 | F: File; 176 | 177 | // Nepper's TRack 178 | function LoadNTR: Boolean; 179 | var 180 | I, J, K: Byte; 181 | H: TNepperRec; 182 | begin 183 | Result := False; 184 | BlockRead(F, H, SizeOf(TNepperRec)); 185 | if H.Magic <> SONG_MAGIC then 186 | Exit; 187 | 188 | NepperRec := H; 189 | for I := 0 to High(Formats.Patterns) do 190 | begin 191 | FillChar(Formats.Patterns[I]^[0], SizeOf(TNepperPattern), 0); 192 | end; 193 | 194 | while not EOF(F) do 195 | begin 196 | BlockRead(F, I, 1); 197 | BlockRead(F, J, 1); 198 | BlockRead(F, K, 1); 199 | BlockRead(F, Formats.Patterns[I]^[J].Cells[K], SizeOf(TNepperChannelCells) - K); 200 | end; 201 | Adlib.SetOPL3(TAdlibOPLKind(NepperRec.OPLKind)); 202 | Result := True; 203 | end; 204 | 205 | // Reality ADlib Tracker version 1.0 206 | // http://fileformats.archiveteam.org/wiki/Reality_AdLib_Tracker_module 207 | function LoadRAD: Boolean; 208 | type 209 | TRADSettingRec = bitpacked record 210 | InitSpeed: TBit5; 211 | Unused: TBit1; 212 | IsSlow: TBit1; 213 | IsDesc: TBit1; 214 | end; 215 | 216 | TRADHeaderRec = packed record 217 | Magic: array[0..$F] of Char; 218 | Version: Byte; 219 | Setting: TRADSettingRec; 220 | end; 221 | 222 | var 223 | B, I, J, OrderLen, LineData, ChannelData, ChannelNo, InstrNo, Octave, Note, Effect, EffectParam: Byte; 224 | W: Word; 225 | C: Char; 226 | H: TRADHeaderRec; 227 | InstrData: array[0..$A] of Byte; 228 | InstrUsed: array[0..$1F] of Boolean; 229 | PatternTable: array[0..31] of Word; 230 | begin 231 | Result := False; 232 | BlockRead(F, H, SizeOf(TRADHeaderRec)); 233 | if PDWord(@H.Magic[0])^ <> $20444152 then 234 | Exit; 235 | // Read desc 236 | NepperRec.Name := ''; 237 | if H.Setting.IsDesc = 1 then 238 | begin 239 | I := 1; 240 | repeat 241 | BlockRead(F, C, 1); 242 | if C <> #0 then 243 | begin 244 | if I <= 40 then 245 | begin 246 | NepperRec.Name[I] := C; 247 | end; 248 | Inc(I); 249 | end; 250 | until (C = #0) or EOF(F); 251 | end; 252 | NepperRec.Name[0] := Char(40); 253 | // Is slow? 254 | if H.Setting.IsSlow = 1 then 255 | NepperRec.Clock := 50 // TODO: 256 | else 257 | NepperRec.Clock := 50; 258 | // Read InstrData 259 | FillChar(InstrUsed[0], SizeOf(InstrUsed), 0); 260 | BlockRead(F, I, 1); 261 | while I <> 0 do 262 | begin 263 | BlockRead(F, InstrData[0], SizeOf(InstrData)); 264 | Byte(NepperRec.Instruments[I].Operators[1].Effect) := InstrData[0]; 265 | Byte(NepperRec.Instruments[I].Operators[0].Effect) := InstrData[1]; 266 | Byte(NepperRec.Instruments[I].Operators[1].Volume) := InstrData[2]; 267 | Byte(NepperRec.Instruments[I].Operators[0].Volume) := InstrData[3]; 268 | Byte(NepperRec.Instruments[I].Operators[1].AttackDecay) := InstrData[4]; 269 | Byte(NepperRec.Instruments[I].Operators[0].AttackDecay) := InstrData[5]; 270 | Byte(NepperRec.Instruments[I].Operators[1].SustainRelease) := InstrData[6]; 271 | Byte(NepperRec.Instruments[I].Operators[0].SustainRelease) := InstrData[7]; 272 | Byte(NepperRec.Instruments[I].AlgFeedback) := InstrData[8]; 273 | Byte(NepperRec.Instruments[I].Operators[1].Waveform) := InstrData[9]; 274 | Byte(NepperRec.Instruments[I].Operators[0].Waveform) := InstrData[$A]; 275 | InstrUsed[I] := True; 276 | BlockRead(F, I, 1); 277 | end; 278 | // Read order 279 | FillChar(NepperRec.Orders[0], SizeOf(NepperRec.Orders), 0); 280 | BlockRead(F, OrderLen, 1); 281 | for I := 0 to OrderLen - 1 do 282 | begin 283 | BlockRead(F, NepperRec.Orders[I], 1); 284 | NepperRec.Orders[I] := NepperRec.Orders[I] and $1F; // TODO: jump marker 285 | end; 286 | NepperRec.Orders[OrderLen] := $FF; // Stop mark 287 | // Read pattern table 288 | BlockRead(F, PatternTable[0], SizeOf(PatternTable)); 289 | // Cleanup pattern before reading .RAD patterns 290 | for I := 0 to High(Formats.Patterns) do 291 | begin 292 | FillChar(Formats.Patterns[I]^[0], SizeOf(TNepperPattern), 0); 293 | end; 294 | NepperRec.ChannelCount := 1; 295 | for I := 0 to 31 do 296 | begin 297 | if PatternTable[I] = 0 then 298 | Continue; 299 | Seek(F, PatternTable[I]); 300 | // Read line numbers 301 | repeat 302 | BlockRead(F, LineData, 1); 303 | J := LineData and %01111111; 304 | repeat 305 | BlockRead(F, ChannelData, 1); 306 | BlockRead(F, Note, 1); 307 | BlockRead(F, Effect, 1); 308 | ChannelNo := ChannelData and %01111111; 309 | if NepperRec.ChannelCount < ChannelNo then 310 | NepperRec.ChannelCount := ChannelNo + 1; 311 | // 312 | InstrNo := ((Note and %10000000) shr 3) or ((Effect and %11110000) shr 4); 313 | Octave := (Note and %01110000) shr 4; 314 | Note := Note and %00001111; 315 | Inc(Note); 316 | if Note > 12 then 317 | begin 318 | Note := 1; 319 | Inc(Octave); 320 | end; 321 | Formats.Patterns[I]^[ChannelNo].Cells[J].Note.Note := Note; 322 | Formats.Patterns[I]^[ChannelNo].Cells[J].Note.Octave := Octave; 323 | Formats.Patterns[I]^[ChannelNo].Cells[J].InstrumentIndex := InstrNo; 324 | if Effect and %00001111 = 0 then 325 | begin 326 | Word(Formats.Patterns[I]^[ChannelNo].Cells[J].Effect) := 0; 327 | end else 328 | begin 329 | // 330 | BlockRead(F, EffectParam, 1); 331 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V1 := (EffectParam and %11110000) shr 4; 332 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V2 := EffectParam and %00001111; 333 | case (Effect and %00001111) of 334 | $1: 335 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.Effect := Byte('2'); 336 | $2: 337 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.Effect := Byte('1'); 338 | $3: 339 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.Effect := Byte('3'); 340 | $5: 341 | begin 342 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.Effect := Byte('5'); 343 | if (EffectParam >= 1) and (EffectParam <= 49) then 344 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V2 := Min(EffectParam, $F) 345 | else 346 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V2 := 0; 347 | if (EffectParam >= 51) and (EffectParam <= 99) then 348 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V1 := Min(EffectParam - 51, $F) 349 | else 350 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V1 := 0; 351 | end; 352 | $A: 353 | begin 354 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.Effect := Byte('A'); 355 | if (EffectParam >= 1) and (EffectParam <= 49) then 356 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V2 := Min(EffectParam, $F) 357 | else 358 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V2 := 0; 359 | if (EffectParam >= 51) and (EffectParam <= 99) then 360 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V1 := Min(EffectParam - 51, $F) 361 | else 362 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V1 := 0; 363 | end; 364 | $C: 365 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.Effect := Byte('9'); 366 | $D: 367 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.Effect := Byte('D'); 368 | $F: 369 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.Effect := Byte('F'); 370 | else 371 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.Effect := 0; 372 | end; 373 | end; 374 | if not InstrUsed[InstrNo] then 375 | begin 376 | Byte(Formats.Patterns[I]^[ChannelNo].Cells[J].Note) := 0; 377 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.Effect := Byte('Z'); 378 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V1 := $F; 379 | Formats.Patterns[I]^[ChannelNo].Cells[J].Effect.V2 := 4; 380 | end; 381 | until ((ChannelData and %10000000) <> 0) or EOF(F); 382 | until ((LineData and %10000000) <> 0) or EOF(F); 383 | end; 384 | Adlib.SetOPL3(aokOPL2); 385 | Result := True; 386 | end; 387 | 388 | begin 389 | Result := False; 390 | if FileName = '' then 391 | Exit; 392 | if FindCharPos(FileName, '.') = 0 then 393 | FileName := FileName + '.ntr'; 394 | FileName := UpCase(FileName); 395 | 396 | Assign(F, FileName); 397 | {$I-} 398 | System.Reset(F, 1); 399 | {$I+} 400 | if IOResult = 0 then 401 | begin 402 | case PDWord(@FileName[Length(FileName) - 3])^ of 403 | $52544E2E: // .NTR 404 | begin 405 | Result := LoadNTR; 406 | end; 407 | $4441522E: // .RAD 408 | begin 409 | Result := LoadRAD; 410 | end; 411 | end; 412 | Close(F); 413 | end; 414 | end; 415 | 416 | var 417 | I: Byte; 418 | 419 | initialization 420 | FillChar(NepperRec, SizeOf(NepperRec), 0); 421 | for I := 0 to High(Formats.Patterns) do 422 | begin 423 | New(Formats.Patterns[I]); 424 | FillChar(Formats.Patterns[I]^[0], SizeOf(TNepperPattern), 0); 425 | end; 426 | for I := 0 to High(NepperRec.Instruments) do 427 | NepperRec.Instruments[I].AlgFeedback.Panning := 3; 428 | NepperRec.ChannelCount := 8; 429 | NepperRec.Speed := 6; // Unused for now 430 | NepperRec.Clock := 50; 431 | 432 | finalization 433 | for I := 0 to High(Formats.Patterns) do 434 | Dispose(Formats.Patterns[I]); 435 | 436 | end. 437 | 438 | -------------------------------------------------------------------------------- /src/input.pas: -------------------------------------------------------------------------------- 1 | unit Input; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | var 8 | InputCursor: Byte = 1; 9 | 10 | procedure InputText(var S: String; const MaxLen: Byte; const IsHex: Boolean = False); 11 | procedure InputHex2(var S: String; var Value: Byte; const MaxValue: Byte); 12 | procedure InputHex3(var S: String; var Value: Word); 13 | procedure InputYesNo(var S: String; var Value: Byte); 14 | procedure InputPanning(var S: String; var Value: Byte); 15 | 16 | implementation 17 | 18 | uses 19 | Keyboard, Screen, Utils; 20 | 21 | procedure InputText(var S: String; const MaxLen: Byte; const IsHex: Boolean = False); 22 | var 23 | Len: Byte; 24 | begin 25 | if IsCtrl then 26 | Exit; 27 | Len := Length(S); 28 | case KBInput.ScanCode of 29 | SCAN_LEFT: 30 | begin 31 | if InputCursor > 1 then 32 | begin 33 | Dec(InputCursor); 34 | Screen.DecCursorX; 35 | KBInput.ScanCode := $FE; 36 | end; 37 | end; 38 | SCAN_RIGHT: 39 | begin 40 | if (IsHex and (InputCursor < Len)) or ((not IsHex) and (InputCursor <= Len)) then 41 | begin 42 | Inc(InputCursor); 43 | Screen.IncCursorX; 44 | KBInput.ScanCode := $FE; 45 | end; 46 | end; 47 | SCAN_DEL: 48 | begin 49 | if IsHex then 50 | Exit; 51 | if InputCursor <= MaxLen then 52 | begin 53 | KBInput.ScanCode := $FF; 54 | Delete(S, InputCursor, 1); 55 | end; 56 | end; 57 | SCAN_BS: 58 | begin 59 | if IsHex then 60 | Exit; 61 | if InputCursor > 1 then 62 | begin 63 | KBInput.ScanCode := $FF; 64 | Dec(InputCursor); 65 | Delete(S, InputCursor, 1); 66 | Screen.DecCursorX; 67 | end; 68 | end; 69 | else 70 | if IsHex then 71 | case KBInput.CharCode of 72 | '0'..'9', 'A'..'F', 'a'..'f': 73 | begin 74 | KBInput.ScanCode := $FF; 75 | S[InputCursor] := KBInput.CharCode; 76 | if MaxLen > InputCursor then 77 | begin 78 | Inc(InputCursor); 79 | Screen.IncCursorX; 80 | end; 81 | if Length(S) > MaxLen then 82 | SetLength(S, MaxLen); 83 | end; 84 | end 85 | else 86 | case KBInput.CharCode of 87 | #32..#126: 88 | begin 89 | KBInput.ScanCode := $FF; 90 | Insert(KBInput.CharCode, S, InputCursor); 91 | if MaxLen > InputCursor then 92 | begin 93 | Inc(InputCursor); 94 | Screen.IncCursorX; 95 | end; 96 | if Length(S) > MaxLen then 97 | SetLength(S, MaxLen); 98 | end; 99 | end; 100 | end; 101 | end; 102 | 103 | procedure InputText2(var S: String; const MaxLen: Byte; const IsHex: Boolean = False); 104 | var 105 | Len: Byte; 106 | begin 107 | if IsCtrl then 108 | Exit; 109 | Len := Length(S); 110 | case KBInput.ScanCode of 111 | SCAN_LEFT: 112 | begin 113 | if InputCursor > 1 then 114 | begin 115 | Dec(InputCursor); 116 | Screen.DecCursorX; 117 | KBInput.ScanCode := $FE; 118 | end; 119 | end; 120 | SCAN_RIGHT: 121 | begin 122 | if (IsHex and (InputCursor < Len)) or ((not IsHex) and (InputCursor <= Len)) then 123 | begin 124 | Inc(InputCursor); 125 | Screen.IncCursorX; 126 | KBInput.ScanCode := $FE; 127 | end; 128 | end; 129 | else 130 | if IsHex then 131 | case KBInput.CharCode of 132 | '0'..'9', 'A'..'F', 'a'..'f': 133 | begin 134 | KBInput.ScanCode := $FF; 135 | S[InputCursor] := KBInput.CharCode; 136 | if MaxLen > InputCursor then 137 | begin 138 | Inc(InputCursor); 139 | Screen.IncCursorX; 140 | end; 141 | if Length(S) > MaxLen then 142 | SetLength(S, MaxLen); 143 | end; 144 | end 145 | else 146 | case KBInput.CharCode of 147 | '0'..'9', 'A'..'Z', 'a'..'z': 148 | begin 149 | KBInput.ScanCode := $FF; 150 | Insert(KBInput.CharCode, S, InputCursor); 151 | if MaxLen > InputCursor then 152 | begin 153 | Inc(InputCursor); 154 | Screen.IncCursorX; 155 | end; 156 | if Length(S) > MaxLen then 157 | SetLength(S, MaxLen); 158 | end; 159 | end; 160 | end; 161 | end; 162 | 163 | procedure InputHex2(var S: String; var Value: Byte; const MaxValue: Byte); 164 | begin 165 | HexStrFast2(Value, S); 166 | InputText(S, 2, True); 167 | if KBInput.ScanCode = $FF then 168 | begin 169 | S := UpCase(S); 170 | Value := HexToInt(S); 171 | if Value > MaxValue then 172 | begin 173 | HexStrFast2(MaxValue, S); 174 | Value := MaxValue; 175 | end; 176 | end; 177 | end; 178 | 179 | procedure InputHex3(var S: String; var Value: Word); 180 | var 181 | C: Char; 182 | begin 183 | HexStrFast2(Byte(Value), S); 184 | if Byte(Value shr 8) = 0 then 185 | Insert('0', S, 1) 186 | else 187 | Insert(Char(Value shr 8), S, 1); 188 | C := S[1]; 189 | InputText2(S, 4, InputCursor <> 1); 190 | if KBInput.ScanCode = $FF then 191 | begin 192 | if Length(S) > 3 then 193 | Delete(S, 2, 1); 194 | S := UpCase(S); 195 | C := S[1]; 196 | S[1] := '0'; 197 | Value := (Word(C) shl 8) + HexToInt(S); 198 | end; 199 | S[1] := C; 200 | end; 201 | 202 | procedure InputYesNo(var S: String; var Value: Byte); 203 | begin 204 | case KBInput.CharCode of 205 | 'y': 206 | begin 207 | KBInput.ScanCode := $FF; 208 | S := 'Yes'; 209 | Value := 1; 210 | end; 211 | 'n': 212 | begin 213 | KBInput.ScanCode := $FF; 214 | S := 'No '; 215 | Value := 0; 216 | end; 217 | end; 218 | end; 219 | 220 | procedure InputPanning(var S: String; var Value: Byte); 221 | begin 222 | case KBInput.CharCode of 223 | 'l': 224 | begin 225 | KBInput.ScanCode := $FF; 226 | S := 'L'; 227 | Value := 1; 228 | end; 229 | 'r': 230 | begin 231 | KBInput.ScanCode := $FF; 232 | S := 'R'; 233 | Value := 2; 234 | end; 235 | 'c', 'm': 236 | begin 237 | KBInput.ScanCode := $FF; 238 | S := 'C'; 239 | Value := 3; 240 | end; 241 | end; 242 | end; 243 | 244 | end. 245 | 246 | -------------------------------------------------------------------------------- /src/keyboard.pas: -------------------------------------------------------------------------------- 1 | { ref: https://stanislavs.org/helppc/int_16.html } 2 | 3 | unit Keyboard; 4 | 5 | {$mode objFPC} 6 | 7 | interface 8 | 9 | const 10 | SCAN_ESC = $01; 11 | 12 | SCAN_UP = $48; 13 | SCAN_DOWN = $50; 14 | SCAN_LEFT = $4B; 15 | SCAN_RIGHT = $4D; 16 | 17 | SCAN_CTRL_LEFT = $73; 18 | SCAN_CTRL_RIGHT = $74; 19 | SCAN_CTRL_UP = $8D; 20 | SCAN_CTRL_DOWN = $91; 21 | 22 | SCAN_INS = $52; 23 | SCAN_HOME = $47; 24 | SCAN_PGUP = $49; 25 | SCAN_DEL = $53; 26 | SCAN_END = $4F; 27 | SCAN_PGDN = $51; 28 | 29 | SCAN_CTRL_HOME = $77; 30 | SCAN_CTRL_PGUP = $84; 31 | SCAN_CTRL_END = $75; 32 | SCAN_CTRL_PGDN = $76; 33 | 34 | SCAN_F1 = $3B; 35 | SCAN_F2 = $3C; 36 | SCAN_F3 = $3D; 37 | SCAN_F4 = $3E; 38 | SCAN_F5 = $3F; 39 | SCAN_F6 = $40; 40 | SCAN_F7 = $41; 41 | SCAN_F8 = $42; 42 | SCAN_F9 = $43; 43 | SCAN_F10 = $44; 44 | SCAN_F11 = $85; 45 | SCAN_F12 = $86; 46 | 47 | SCAN_ALT_F1 = $68; 48 | SCAN_ALT_F2 = $69; 49 | SCAN_ALT_F3 = $6A; 50 | SCAN_ALT_F4 = $6B; 51 | SCAN_ALT_F5 = $6C; 52 | SCAN_ALT_F6 = $6D; 53 | SCAN_ALT_F7 = $6E; 54 | SCAN_ALT_F8 = $6F; 55 | SCAN_ALT_F9 = $70; 56 | SCAN_ALT_F10 = $71; 57 | SCAN_ALT_F11 = $8B; 58 | SCAN_ALT_F12 = $8C; 59 | 60 | SCAN_SHIFT_F1 = $54; 61 | SCAN_SHIFT_F2 = $55; 62 | SCAN_SHIFT_F3 = $56; 63 | SCAN_SHIFT_F4 = $57; 64 | SCAN_SHIFT_F5 = $58; 65 | SCAN_SHIFT_F6 = $59; 66 | SCAN_SHIFT_F7 = $5A; 67 | SCAN_SHIFT_F8 = $5B; 68 | SCAN_SHIFT_F9 = $5C; 69 | SCAN_SHIFT_F10 = $5D; 70 | SCAN_SHIFT_F11 = $87; 71 | SCAN_SHIFT_F12 = $88; 72 | 73 | SCAN_CTRL_F1 = $5E; 74 | SCAN_CTRL_F2 = $5F; 75 | SCAN_CTRL_F3 = $60; 76 | SCAN_CTRL_F4 = $61; 77 | SCAN_CTRL_F5 = $62; 78 | SCAN_CTRL_F6 = $63; 79 | SCAN_CTRL_F7 = $64; 80 | SCAN_CTRL_F8 = $65; 81 | SCAN_CTRL_F9 = $66; 82 | SCAN_CTRL_F10 = $67; 83 | SCAN_CTRL_F11 = $89; 84 | SCAN_CTRL_F12 = $8A; 85 | 86 | SCAN_TILDA = $29; 87 | SCAN_1 = $02; 88 | SCAN_2 = $03; 89 | SCAN_3 = $04; 90 | SCAN_4 = $05; 91 | SCAN_5 = $06; 92 | SCAN_6 = $07; 93 | SCAN_7 = $08; 94 | SCAN_8 = $09; 95 | SCAN_9 = $0A; 96 | SCAN_0 = $0B; 97 | SCAN_MINUS = $0C; 98 | SCAN_EQ = $0D; 99 | SCAN_BS = $0E; 100 | 101 | SCAN_TAB = $0F; 102 | SCAN_Q = $10; 103 | SCAN_W = $11; 104 | SCAN_E = $12; 105 | SCAN_R = $13; 106 | SCAN_T = $14; 107 | SCAN_Y = $15; 108 | SCAN_U = $16; 109 | SCAN_I = $17; 110 | SCAN_O = $18; 111 | SCAN_P = $19; 112 | SCAN_LBRAKET = $1A; 113 | SCAN_RBRAKET = $1B; 114 | SCAN_BACK_SLASH = $2B; 115 | 116 | SCAN_A = $1E; 117 | SCAN_S = $1F; 118 | SCAN_D = $20; 119 | SCAN_F = $21; 120 | SCAN_G = $22; 121 | SCAN_H = $23; 122 | SCAN_J = $24; 123 | SCAN_K = $25; 124 | SCAN_L = $26; 125 | SCAN_DOTCOMA = $27; 126 | SCAN_QUOTE = $28; 127 | SCAN_ENTER = $1c; 128 | 129 | SCAN_Z = $2C; 130 | SCAN_X = $2D; 131 | SCAN_C = $2E; 132 | SCAN_V = $2F; 133 | SCAN_B = $30; 134 | SCAN_N = $31; 135 | SCAN_M = $32; 136 | SCAN_COMA = $33; 137 | SCAN_DOT = $34; 138 | SCAN_SLASH = $35; 139 | 140 | SCAN_SPACE = $39; 141 | 142 | SCAN_GREY_MINUS = $4A; 143 | SCAN_GREY_PLUS = $4E; 144 | 145 | type 146 | TKeyboardInput = packed record 147 | case Byte of 148 | 0: ( 149 | CharCode: Char; 150 | ScanCode: Byte; 151 | ); 152 | 1: ( 153 | Data: Word; 154 | ); 155 | end; 156 | 157 | var 158 | KBInput: TKeyboardInput; 159 | KBFlags: Byte; 160 | 161 | procedure WaitForInput; 162 | function IsCtrl: ByteBool; 163 | function IsAlt: ByteBool; 164 | function IsShift: ByteBool; 165 | 166 | implementation 167 | 168 | uses 169 | Dos; 170 | 171 | var 172 | OldCtrlBreakHandle: Pointer; 173 | 174 | procedure WaitForInput; assembler; nostackframe; 175 | asm 176 | mov ax,$1000 177 | int $16 178 | mov KBInput.Data,ax 179 | mov ax,$1200 180 | int $16 181 | mov KBFlags,al 182 | end; 183 | 184 | function IsCtrl: ByteBool; assembler; 185 | asm 186 | mov al,KBFlags 187 | and al,$4 188 | end; 189 | 190 | function IsAlt: ByteBool; assembler; 191 | asm 192 | mov al,KBFlags 193 | and al,$8 194 | end; 195 | 196 | function IsShift: ByteBool; assembler; 197 | asm 198 | mov al,KBFlags 199 | and al,$3 200 | end; 201 | 202 | procedure BlankHandle; assembler; nostackframe; far; 203 | asm 204 | iret 205 | end; 206 | 207 | initialization 208 | GetIntVec($23, OldCtrlBreakHandle); 209 | SetIntVec($23, @BlankHandle); 210 | // Fast typing rate 211 | asm 212 | mov ax,$0305 213 | xor bx,bx 214 | int $16 215 | end; 216 | 217 | finalization 218 | SetIntVec($23, OldCtrlBreakHandle); 219 | // Default typing rate 220 | asm 221 | mov ax,$0300 222 | int $16 223 | end; 224 | 225 | end. 226 | 227 | -------------------------------------------------------------------------------- /src/nepper.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | <UseAppBundle Value="False"/> 15 | <ResourceType Value="res"/> 16 | </General> 17 | <BuildModes> 18 | <Item Name="Default" Default="True"/> 19 | <Item Name="80386"> 20 | <CompilerOptions> 21 | <Version Value="11"/> 22 | <PathDelim Value="\"/> 23 | <Target> 24 | <Filename Value="../bin/NEP386.EXE"/> 25 | </Target> 26 | <SearchPaths> 27 | <IncludeFiles Value="$(ProjOutDir)"/> 28 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 29 | </SearchPaths> 30 | <Parsing> 31 | <SyntaxOptions> 32 | <UseAnsiStrings Value="False"/> 33 | </SyntaxOptions> 34 | </Parsing> 35 | <CodeGeneration> 36 | <SmartLinkUnit Value="True"/> 37 | <StackSize Value="4096"/> 38 | <TargetProcessor Value="80386"/> 39 | <TargetCPU Value="i8086"/> 40 | <TargetOS Value="msdos"/> 41 | <Optimizations> 42 | <OptimizationLevel Value="3"/> 43 | </Optimizations> 44 | </CodeGeneration> 45 | <Linking> 46 | <Debugging> 47 | <GenerateDebugInfo Value="False"/> 48 | <RunWithoutDebug Value="True"/> 49 | </Debugging> 50 | <LinkSmart Value="True"/> 51 | </Linking> 52 | <Other> 53 | <CustomOptions Value="-dNO_INT10H"/> 54 | <OtherDefines Count="1"> 55 | <Define0 Value="NO_INT10H"/> 56 | </OtherDefines> 57 | </Other> 58 | </CompilerOptions> 59 | </Item> 60 | </BuildModes> 61 | <PublishOptions> 62 | <Version Value="2"/> 63 | <UseFileFilters Value="True"/> 64 | </PublishOptions> 65 | <RunParams> 66 | <FormatVersion Value="2"/> 67 | </RunParams> 68 | <Units> 69 | <Unit> 70 | <Filename Value="nepper.lpr"/> 71 | <IsPartOfProject Value="True"/> 72 | </Unit> 73 | <Unit> 74 | <Filename Value="adlib.pas"/> 75 | <IsPartOfProject Value="True"/> 76 | <UnitName Value="Adlib"/> 77 | </Unit> 78 | <Unit> 79 | <Filename Value="keyboard.pas"/> 80 | <IsPartOfProject Value="True"/> 81 | <UnitName Value="Keyboard"/> 82 | </Unit> 83 | <Unit> 84 | <Filename Value="input.pas"/> 85 | <IsPartOfProject Value="True"/> 86 | <UnitName Value="Input"/> 87 | </Unit> 88 | <Unit> 89 | <Filename Value="screen.pas"/> 90 | <IsPartOfProject Value="True"/> 91 | <UnitName Value="Screen"/> 92 | </Unit> 93 | <Unit> 94 | <Filename Value="utils.pas"/> 95 | <IsPartOfProject Value="True"/> 96 | <UnitName Value="Utils"/> 97 | </Unit> 98 | <Unit> 99 | <Filename Value="edinstr.pas"/> 100 | <IsPartOfProject Value="True"/> 101 | <UnitName Value="EdInstr"/> 102 | </Unit> 103 | <Unit> 104 | <Filename Value="formats.pas"/> 105 | <IsPartOfProject Value="True"/> 106 | <UnitName Value="Formats"/> 107 | </Unit> 108 | <Unit> 109 | <Filename Value="timer.pas"/> 110 | <IsPartOfProject Value="True"/> 111 | <UnitName Value="Timer"/> 112 | </Unit> 113 | <Unit> 114 | <Filename Value="player.pas"/> 115 | <IsPartOfProject Value="True"/> 116 | <UnitName Value="Player"/> 117 | </Unit> 118 | <Unit> 119 | <Filename Value="dialogs.pas"/> 120 | <IsPartOfProject Value="True"/> 121 | <UnitName Value="Dialogs"/> 122 | </Unit> 123 | <Unit> 124 | <Filename Value="edpattern.pas"/> 125 | <IsPartOfProject Value="True"/> 126 | <UnitName Value="EdPattern"/> 127 | </Unit> 128 | <Unit> 129 | <Filename Value="edsong.pas"/> 130 | <IsPartOfProject Value="True"/> 131 | <UnitName Value="EdSong"/> 132 | </Unit> 133 | <Unit> 134 | <Filename Value="clipbrd.pas"/> 135 | <IsPartOfProject Value="True"/> 136 | <UnitName Value="Clipbrd"/> 137 | </Unit> 138 | </Units> 139 | <Debugger> 140 | <ClassConfig Version="1"> 141 | <Config ConfigName="New" ConfigClass="TFpDebugDebugger" Active="True" UID="{778FAF89-062E-44DD-B0D5-747147D9C27A}"/> 142 | </ClassConfig> 143 | </Debugger> 144 | </ProjectOptions> 145 | <CompilerOptions> 146 | <Version Value="11"/> 147 | <PathDelim Value="\"/> 148 | <Target> 149 | <Filename Value="../bin/NEP88.EXE"/> 150 | </Target> 151 | <SearchPaths> 152 | <IncludeFiles Value="$(ProjOutDir)"/> 153 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 154 | </SearchPaths> 155 | <Parsing> 156 | <SyntaxOptions> 157 | <UseAnsiStrings Value="False"/> 158 | </SyntaxOptions> 159 | </Parsing> 160 | <CodeGeneration> 161 | <SmartLinkUnit Value="True"/> 162 | <StackSize Value="4096"/> 163 | <TargetProcessor Value="8086"/> 164 | <TargetCPU Value="i8086"/> 165 | <TargetOS Value="msdos"/> 166 | <Optimizations> 167 | <OptimizationLevel Value="3"/> 168 | </Optimizations> 169 | </CodeGeneration> 170 | <Linking> 171 | <Debugging> 172 | <GenerateDebugInfo Value="False"/> 173 | <RunWithoutDebug Value="True"/> 174 | </Debugging> 175 | <LinkSmart Value="True"/> 176 | </Linking> 177 | </CompilerOptions> 178 | <Debugging> 179 | <Exceptions> 180 | <Item> 181 | <Name Value="EAbort"/> 182 | </Item> 183 | <Item> 184 | <Name Value="ECodetoolError"/> 185 | </Item> 186 | <Item> 187 | <Name Value="EFOpenError"/> 188 | </Item> 189 | </Exceptions> 190 | </Debugging> 191 | </CONFIG> 192 | -------------------------------------------------------------------------------- /src/nepper.lpr: -------------------------------------------------------------------------------- 1 | program nepper; 2 | 3 | {$mode objFPC} 4 | 5 | uses 6 | Adlib, Keyboard, Input, Screen, Utils, EdInstr, Formats, Timer, Player, 7 | Dialogs, EdPattern, EdSong, Clipbrd; 8 | 9 | begin 10 | Adlib.Init; 11 | 12 | KBInput.ScanCode := SCAN_F2; 13 | IsPatternEdit := False; 14 | repeat 15 | case KBInput.ScanCode of 16 | SCAN_F2: 17 | begin 18 | ClrScr; 19 | RenderCommonTexts; 20 | repeat 21 | case IsPatternEdit of 22 | True: 23 | EdPattern.Loop; 24 | False: 25 | EdSong.Loop; 26 | end; 27 | case KBInput.ScanCode of 28 | SCAN_TAB: 29 | IsPatternEdit := not IsPatternEdit; 30 | end; 31 | until(KBInput.ScanCode = SCAN_ESC) or (KBInput.ScanCode = SCAN_F3); 32 | end; 33 | SCAN_F3: 34 | EdInstr.Loop; 35 | end; 36 | until KBInput.ScanCode = SCAN_ESC; 37 | Player.Stop; 38 | end. 39 | 40 | -------------------------------------------------------------------------------- /src/player.pas: -------------------------------------------------------------------------------- 1 | unit Player; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | uses 8 | Adlib; 9 | 10 | var 11 | IsPlaying: Boolean = False; 12 | ChannelEnabledList: array[0..MAX_CHANNELS - 1] of Boolean; 13 | 14 | procedure Start(const PatternIndex: Byte; const IsPatternOnlyLocal: Boolean); 15 | procedure Play; 16 | procedure Stop; 17 | 18 | implementation 19 | 20 | uses 21 | Formats, EdInstr, Screen, Utils, Timer; 22 | 23 | const 24 | SINE_TABLE: array[0..127] of ShortInt = ( 25 | $00, $06, $0C, $13, $19, $1F, $25, $2B, $31, $36, $3C, $41, $47, $4C, $51, $55, 26 | $5A, $5E, $62, $66, $6A, $6D, $70, $73, $75, $78, $7A, $7B, $7D, $7E, $7E, $7F, 27 | $7F, $7F, $7E, $7E, $7D, $7B, $7A, $78, $75, $73, $70, $6D, $6A, $66, $62, $5E, 28 | $5A, $55, $51, $4C, $47, $41, $3C, $36, $31, $2B, $25, $1F, $19, $13, $0C, $06, 29 | $00, $FA, $F4, $ED, $E7, $E1, $DB, $D5, $CF, $CA, $C4, $BF, $B9, $B4, $AF, $AB, 30 | $A6, $A2, $9E, $9A, $96, $93, $90, $8D, $8B, $88, $86, $85, $83, $82, $82, $81, 31 | $81, $81, $82, $82, $83, $85, $86, $88, $8B, $8D, $90, $93, $96, $9A, $9E, $A2, 32 | $A6, $AB, $AF, $B4, $B9, $BF, $C4, $CA, $CF, $D5, $DB, $E1, $E7, $ED, $F4, $FA 33 | ); 34 | 35 | var 36 | I: Byte; 37 | Short: ShortInt; 38 | CurPatternIndex: Byte; 39 | PInstrument: PAdlibInstrument; 40 | PPattern: PNepperPattern; 41 | PChannel: PNepperChannel; 42 | PCell: PNepperChannelCell; 43 | CurChannel: Byte; 44 | CurEffect: Byte; 45 | NextCell: Byte; 46 | CurCell: Byte; 47 | CurTicks: Byte = 0; 48 | CurSpeed: Byte = 6; // 40 for fmc? 49 | IsPatternOnly: Boolean; 50 | TmpByte: Byte; 51 | NoteByte: Byte; 52 | OctaveByte: Byte; 53 | LastNoteList: array[0..MAX_CHANNELS - 1] of TNepperNote; 54 | LastNoteFutureList: array[0..MAX_CHANNELS - 1] of TNepperNote; 55 | LastEffectList: array[0..MAX_CHANNELS - 1, 0..96] of TNepperEffect; 56 | LastInstrumentList: array[0..MAX_CHANNELS - 1] of Byte; 57 | LastArpeggioList: array[0..MAX_CHANNELS - 1, 0..1] of Byte; 58 | LastNoteDelayList: array[0..MAX_CHANNELS - 1] of Byte; 59 | LastNoteTimerList: array[0..MAX_CHANNELS - 1] of Word; 60 | GS2: String2; 61 | ColorStatus: Byte; 62 | Instruments: array[0..31] of TAdlibInstrument; 63 | BD: TAdlibRegBD; 64 | 65 | procedure CleanUpStates; 66 | begin 67 | FillChar(LastInstrumentList[0], SizeOf(LastInstrumentList), $FF); 68 | FillChar(LastNoteList[0], SizeOf(LastNoteList), 0); 69 | FillChar(LastEffectList[0], SizeOf(LastEffectList), 0); 70 | FillChar(LastNoteDelayList[0], SizeOf(LastNoteDelayList), 0); 71 | FillChar(LastNoteTimerList[0], SizeOf(LastNoteTimerList), 0); 72 | FillChar(VolumeModList[0], SizeOf(VolumeModList), 0); 73 | end; 74 | 75 | procedure Start(const PatternIndex: Byte; const IsPatternOnlyLocal: Boolean); 76 | begin 77 | Stop; 78 | CurTicks := 0; 79 | CurCell := 0; 80 | NextCell := 0; 81 | CurSpeed := NepperRec.Speed; 82 | BD.Vibrato := 1; 83 | BD.AMDepth := 1; 84 | Adlib.WriteReg($BD, Byte(BD)); 85 | CurPatternIndex := PatternIndex; 86 | IsPatternOnly := IsPatternOnlyLocal; 87 | if IsPatternOnlyLocal then 88 | begin 89 | PPattern := Formats.Patterns[PatternIndex]; 90 | ColorStatus := $19; 91 | Screen.WriteTextFast2(ScreenPointer + 72, ColorStatus, '--'); 92 | Screen.WriteTextFast1(ScreenPointer + 74, ColorStatus, '/'); 93 | HexStrFast2(CurPatternIndex, GS2); 94 | Screen.WriteTextFast2(ScreenPointer + 75, ColorStatus, GS2); 95 | Screen.WriteTextFast1(ScreenPointer + 77, ColorStatus, '/'); 96 | end else 97 | begin 98 | PPattern := Formats.Patterns[NepperRec.Orders[CurPatternIndex]]; 99 | ColorStatus := $1A; 100 | HexStrFast2(CurPatternIndex, GS2); 101 | Screen.WriteTextFast2(ScreenPointer + 72, ColorStatus, GS2); 102 | Screen.WriteTextFast1(ScreenPointer + 74, ColorStatus, '/'); 103 | HexStrFast2(NepperRec.Orders[CurPatternIndex], GS2); 104 | Screen.WriteTextFast2(ScreenPointer + 75, ColorStatus, GS2); 105 | Screen.WriteTextFast1(ScreenPointer + 77, ColorStatus, '/'); 106 | end; 107 | CleanUpStates; 108 | Move(NepperRec.Instruments[0], Instruments[0], SizeOf(Instruments)); 109 | InstallTimer(NepperRec.Clock); 110 | IsPlaying := True; 111 | end; 112 | 113 | procedure SetFreq(const Channel: Byte; const Freq: ShortInt); 114 | var 115 | Reg: PAdlibRegA0B8; 116 | begin 117 | Reg := @FreqRegs[Channel]; 118 | SetRegFreq(Channel, FreqRegsBack[Channel].Freq + Freq); 119 | WriteNoteReg(Channel, Reg); 120 | end; 121 | 122 | procedure SlideFreq(const Channel: Byte; const Freq: Integer); 123 | var 124 | Reg: PAdlibRegA0B8; 125 | begin 126 | Reg := @FreqRegs[Channel]; 127 | ModifyRegFreq(Channel, Freq, CurSpeed); 128 | if Reg^.Freq > ADLIB_FREQ_TABLE[13] then 129 | begin 130 | SetRegFreq(Channel, ADLIB_FREQ_TABLE[1]); 131 | Reg^.Octave := Reg^.Octave + 1; 132 | end else 133 | if Reg^.Freq < ADLIB_FREQ_TABLE[1] then 134 | begin 135 | SetRegFreq(Channel, ADLIB_FREQ_TABLE[13]); 136 | Reg^.Octave := Reg^.Octave - 1; 137 | end; 138 | WriteNoteReg(Channel, Reg); 139 | end; 140 | 141 | procedure SlideFreqUpdate(const Channel: Byte; const Freq: Integer); 142 | var 143 | Reg: PAdlibRegA0B8; 144 | begin 145 | Reg := @FreqRegs[Channel]; 146 | ModifyRegFreq(Channel, Freq, CurSpeed); 147 | if Reg^.Freq > ADLIB_FREQ_TABLE[13] then 148 | begin 149 | SetRegFreq(Channel, ADLIB_FREQ_TABLE[1]); 150 | Reg^.Octave := Reg^.Octave + 1; 151 | LastNoteList[Channel].Octave := Reg^.Octave; 152 | LastNoteList[Channel].Note := 1; 153 | end else 154 | if Reg^.Freq < ADLIB_FREQ_TABLE[1] then 155 | begin 156 | SetRegFreq(Channel, ADLIB_FREQ_TABLE[13]); 157 | Reg^.Octave := Reg^.Octave - 1; 158 | LastNoteList[Channel].Octave := Reg^.Octave; 159 | LastNoteList[Channel].Note := 13; 160 | end; 161 | if LastNoteList[Channel].Octave = LastNoteFutureList[Channel].Octave then 162 | begin 163 | if ((Freq < 0) and (Reg^.Freq < ADLIB_FREQ_TABLE[LastNoteFutureList[Channel].Note])) or 164 | ((Freq > 0) and (Reg^.Freq > ADLIB_FREQ_TABLE[LastNoteFutureList[Channel].Note])) then 165 | begin 166 | SetRegFreq(Channel, ADLIB_FREQ_TABLE[LastNoteFutureList[Channel].Note]); 167 | LastNoteList[Channel] := LastNoteFutureList[Channel]; 168 | end; 169 | end; 170 | WriteNoteReg(Channel, Reg); 171 | end; 172 | 173 | procedure Play; 174 | function GetEffectReady: Byte; inline; 175 | begin 176 | Result := Byte(Word(PCell^.Effect)); 177 | if Result = 0 then 178 | Result := Byte(Word(LastEffectList[CurChannel, CurEffect])); 179 | Word(LastEffectList[CurChannel, CurEffect]) := Result; 180 | LastEffectList[CurChannel, CurEffect].Effect := PCell^.Effect.Effect; 181 | end; 182 | 183 | function GetLastEffect(const E: Char): Byte; inline; 184 | begin 185 | Result := Byte(Word(LastEffectList[CurChannel, Byte(E)])); 186 | end; 187 | 188 | procedure AdjustVolume(const V: Byte); 189 | begin 190 | if (TAdlibOPLKind(NepperRec.OPLKind) = aokOPL3Op4) and ((CurChannel <= 2) or (CurChannel >= 6)) then 191 | case Instruments[PCell^.InstrumentIndex].AlgFeedback.Alg2 of 192 | 0: 193 | begin 194 | Instruments[PCell^.InstrumentIndex].Operators[3].Volume.Total := V; 195 | end; 196 | 1: 197 | begin 198 | Instruments[PCell^.InstrumentIndex].Operators[0].Volume.Total := V; 199 | Instruments[PCell^.InstrumentIndex].Operators[3].Volume.Total := V; 200 | 201 | end; 202 | 2: 203 | begin 204 | Instruments[PCell^.InstrumentIndex].Operators[1].Volume.Total := V; 205 | Instruments[PCell^.InstrumentIndex].Operators[3].Volume.Total := V; 206 | end; 207 | 3: 208 | begin 209 | Instruments[PCell^.InstrumentIndex].Operators[0].Volume.Total := V; 210 | Instruments[PCell^.InstrumentIndex].Operators[2].Volume.Total := V; 211 | Instruments[PCell^.InstrumentIndex].Operators[3].Volume.Total := V; 212 | end; 213 | end 214 | else 215 | case Instruments[PCell^.InstrumentIndex].AlgFeedback.Alg2 of 216 | 0: 217 | begin 218 | Instruments[PCell^.InstrumentIndex].Operators[0].Volume.Total := V; 219 | Instruments[PCell^.InstrumentIndex].Operators[1].Volume.Total := V; 220 | end; 221 | 1: 222 | begin 223 | Instruments[PCell^.InstrumentIndex].Operators[1].Volume.Total := V; 224 | end; 225 | end; 226 | end; 227 | 228 | procedure Vibrato; 229 | begin 230 | if CurTicks = 0 then 231 | begin 232 | if Byte(PCell^.Note) <> 0 then 233 | LastNoteTimerList[CurChannel] := 0; 234 | end; 235 | if LastEffectList[CurChannel, CurEffect].Effect <> PCell^.Effect.Effect then 236 | LastNoteTimerList[CurChannel] := 0; 237 | TmpByte := GetEffectReady; 238 | SetFreq(CurChannel, SINE_TABLE[LastNoteTimerList[CurChannel] mod (High(SINE_TABLE) + 1)] div ($10 - TNepperEffectValue(TmpByte).V2)); 239 | Inc(LastNoteTimerList[CurChannel], High(SINE_TABLE) div (CurSpeed * 4) * (TNepperEffectValue(TmpByte).V1 + 1)); 240 | end; 241 | 242 | procedure Tremolo; 243 | begin 244 | if CurTicks = 0 then 245 | begin 246 | if Byte(PCell^.Note) <> 0 then 247 | LastNoteTimerList[CurChannel] := 0; 248 | end; 249 | if LastEffectList[CurChannel, CurEffect].Effect <> PCell^.Effect.Effect then 250 | LastNoteTimerList[CurChannel] := 0; 251 | TmpByte := GetEffectReady; 252 | Short := SINE_TABLE[LastNoteTimerList[CurChannel] mod (High(SINE_TABLE) + 1)] div ($10 - TNepperEffectValue(TmpByte).V2); 253 | AdjustVolume(Max(Min(Integer(NepperRec.Instruments[PCell^.InstrumentIndex].Operators[3].Volume.Total) + Short, $3F), 0)); 254 | Inc(LastNoteTimerList[CurChannel], High(SINE_TABLE) div (CurSpeed * 4) * (TNepperEffectValue(TmpByte).V1 + 1)); 255 | Adlib.SetVolume(CurChannel, @Instruments[PCell^.InstrumentIndex]); 256 | end; 257 | 258 | procedure Tremor; 259 | begin 260 | if CurTicks = 0 then 261 | begin 262 | if Byte(PCell^.Note) <> 0 then 263 | LastNoteTimerList[CurChannel] := 0; 264 | end; 265 | TmpByte := GetEffectReady; 266 | I := LastNoteTimerList[CurChannel] mod (TNepperEffectValue(TmpByte).V1 + TNepperEffectValue(TmpByte).V2); 267 | if I < TNepperEffectValue(TmpByte).V1 then 268 | begin 269 | Instruments[PCell^.InstrumentIndex].Operators[0].Volume.Total := NepperRec.Instruments[PCell^.InstrumentIndex].Operators[0].Volume.Total; 270 | Instruments[PCell^.InstrumentIndex].Operators[1].Volume.Total := NepperRec.Instruments[PCell^.InstrumentIndex].Operators[1].Volume.Total; 271 | Instruments[PCell^.InstrumentIndex].Operators[2].Volume.Total := NepperRec.Instruments[PCell^.InstrumentIndex].Operators[2].Volume.Total; 272 | Instruments[PCell^.InstrumentIndex].Operators[3].Volume.Total := NepperRec.Instruments[PCell^.InstrumentIndex].Operators[3].Volume.Total; 273 | end else 274 | begin 275 | Instruments[PCell^.InstrumentIndex].Operators[0].Volume.Total := $3F; 276 | Instruments[PCell^.InstrumentIndex].Operators[1].Volume.Total := $3F; 277 | Instruments[PCell^.InstrumentIndex].Operators[2].Volume.Total := $3F; 278 | Instruments[PCell^.InstrumentIndex].Operators[3].Volume.Total := $3F; 279 | end; 280 | Adlib.SetVolume(CurChannel, @Instruments[PCell^.InstrumentIndex]); 281 | Inc(LastNoteTimerList[CurChannel]); 282 | end; 283 | 284 | procedure TonePortamento(const IsLastEffect: Boolean = False); 285 | begin 286 | if IsLastEffect then 287 | TmpByte := GetLastEffect('3') 288 | else 289 | TmpByte := GetEffectReady; 290 | if (LastNoteList[CurChannel].Octave < LastNoteFutureList[CurChannel].Octave) or ((LastNoteList[CurChannel].Octave = LastNoteFutureList[CurChannel].Octave) and (LastNoteList[CurChannel].Note < LastNoteFutureList[CurChannel].Note)) then 291 | SlideFreqUpdate(CurChannel, TmpByte) 292 | else 293 | if (LastNoteList[CurChannel].Octave > LastNoteFutureList[CurChannel].Octave) or ((LastNoteList[CurChannel].Octave = LastNoteFutureList[CurChannel].Octave) and (LastNoteList[CurChannel].Note > LastNoteFutureList[CurChannel].Note)) then 294 | SlideFreqUpdate(CurChannel, -TmpByte); 295 | end; 296 | 297 | procedure FreqSlideUp; 298 | begin 299 | TmpByte := GetEffectReady; 300 | SlideFreq(CurChannel, TmpByte); 301 | end; 302 | 303 | procedure FreqSlideDown; 304 | begin 305 | TmpByte := GetEffectReady; 306 | SlideFreq(CurChannel, -TmpByte); 307 | end; 308 | 309 | procedure VolumeSlide; 310 | begin 311 | //if CurTicks = 0 then 312 | begin 313 | TmpByte := GetEffectReady; 314 | Inc(Adlib.VolumeModList[CurChannel], TNepperEffectValue(TmpByte).V1 - TNepperEffectValue(TmpByte).V2); 315 | Adlib.VolumeModList[CurChannel] := Max(Min(Adlib.VolumeModList[CurChannel], 63), -63); 316 | Adlib.SetVolume(CurChannel, @Instruments[PCell^.InstrumentIndex]); 317 | end; 318 | end; 319 | 320 | label 321 | AtBeginning, 322 | AfterPlayingNote; 323 | begin 324 | // Is playing? 325 | if not IsPlaying then 326 | Exit; 327 | // Playing 328 | 329 | // Pre Effect 330 | AtBeginning: 331 | for CurChannel := 0 to NepperRec.ChannelCount - 1 do 332 | begin 333 | PChannel := @PPattern^[CurChannel]; 334 | PCell := @PChannel^.Cells[CurCell]; 335 | PInstrument := @Instruments[PCell^.InstrumentIndex]; 336 | CurEffect := PCell^.Effect.Effect; 337 | if Word(PCell^.Effect) <> 0 then 338 | begin 339 | case Char(CurEffect) of 340 | '0', #0: // Arpeggio 341 | begin 342 | if (CurTicks = 0) and (Byte(Word(PCell^.Effect)) <> 0) and (Byte(PCell^.Note) <> 0) then 343 | begin 344 | LastArpeggioList[CurChannel, 0] := PCell^.Effect.V1; 345 | LastArpeggioList[CurChannel, 1] := PCell^.Effect.V2; 346 | end; 347 | end; 348 | '4': // Vibrato 349 | begin 350 | Vibrato; 351 | end; 352 | '5': // Tone portamento with volume slide 353 | begin 354 | VolumeSlide; 355 | end; 356 | '9': // Volume 357 | begin 358 | if CurTicks = 0 then 359 | begin 360 | Adlib.VolumeModList[CurChannel] := 0; 361 | TmpByte := $3F - Max(Min(Byte(Word(PCell^.Effect)), $3F), 0); 362 | AdjustVolume(TmpByte); 363 | Adlib.SetVolume(CurChannel, @Instruments[PCell^.InstrumentIndex]); 364 | end; 365 | end; 366 | 'A': // Volume slide 367 | begin 368 | VolumeSlide; 369 | end; 370 | 'D': // Pattern break 371 | begin 372 | if CurTicks = 0 then 373 | begin 374 | CurCell := $40; 375 | NextCell := Byte(Word(PCell^.Effect)); 376 | end; 377 | end; 378 | 'E': // BPM 379 | begin 380 | if CurTicks = 0 then 381 | InstallTimer(Byte(Word(PCell^.Effect))); 382 | end; 383 | 'F': // Speed 384 | begin 385 | if CurTicks = 0 then 386 | CurSpeed := Byte(Word(PCell^.Effect)); 387 | end; 388 | 'M': // Tremolo 389 | begin 390 | Tremolo; 391 | end; 392 | 'N': // Tremor 393 | begin 394 | Tremor; 395 | end; 396 | 'Z': 397 | begin 398 | if CurTicks = 0 then 399 | begin 400 | case Byte(Word(PCell^.Effect.V1)) of 401 | $0: // Set tremolo depth 402 | begin 403 | BD.AMDepth := PCell^.Effect.V2; 404 | Adlib.WriteReg($BD, Byte(BD)); 405 | end; 406 | $1: // Set vibrato depth 407 | begin 408 | BD.Vibrato := PCell^.Effect.V2; 409 | Adlib.WriteReg($BD, Byte(BD)); 410 | end; 411 | $F: 412 | begin 413 | case Byte(Word(PCell^.Effect.V2)) of 414 | 0: // Stop note 415 | begin 416 | Adlib.NoteClear(CurChannel); 417 | LastInstrumentList[CurChannel] := $FF; 418 | end; 419 | 4: // Fade note 420 | begin 421 | Adlib.NoteOff(CurChannel); 422 | LastInstrumentList[CurChannel] := $FF; 423 | end; 424 | end; 425 | end; 426 | end; 427 | end; 428 | end; 429 | end; 430 | end; 431 | // Handle arpeggio 432 | if (CurTicks >= 1) and (CurTicks <= 2) then 433 | begin 434 | if LastArpeggioList[CurChannel, CurTicks - 1] <> 0 then 435 | begin 436 | NoteByte := LastNoteList[CurChannel].Note + LastArpeggioList[CurChannel, CurTicks - 1]; 437 | if NoteByte > 12 then 438 | begin 439 | NoteByte := NoteByte - 12; 440 | OctaveByte := LastNoteList[CurChannel].Octave + 1; 441 | end else 442 | OctaveByte := LastNoteList[CurChannel].Octave; 443 | Adlib.NoteOn(CurChannel, NoteByte, OctaveByte); 444 | LastArpeggioList[CurChannel, CurTicks - 1] := 0; 445 | end; 446 | end; 447 | // Play note 448 | if not ChannelEnabledList[CurChannel] then 449 | begin 450 | if not IsInstr then 451 | Adlib.NoteClear(CurChannel); 452 | goto AfterPlayingNote; 453 | end; 454 | if CurTicks = LastNoteDelayList[CurChannel] then 455 | begin 456 | // Note 457 | if Byte(PCell^.Note) <> 0 then 458 | begin 459 | if not (Char(PCell^.Effect.Effect) in ['3', '5']) then 460 | begin 461 | if IsInstr then 462 | begin 463 | Instruments[PCell^.InstrumentIndex] := NepperRec.Instruments[PCell^.InstrumentIndex]; 464 | Adlib.SetInstrument(CurChannel, @Instruments[PCell^.InstrumentIndex]); 465 | end else 466 | begin 467 | if LastInstrumentList[CurChannel] <> PCell^.InstrumentIndex then 468 | begin 469 | Adlib.SetInstrument(CurChannel, @Instruments[PCell^.InstrumentIndex]); 470 | LastInstrumentList[CurChannel] := PCell^.InstrumentIndex; 471 | end; 472 | end; 473 | LastNoteList[CurChannel] := PCell^.Note; 474 | Byte(LastNoteFutureList[CurChannel]) := 0; 475 | Adlib.NoteOn(CurChannel, PCell^.Note.Note, PCell^.Note.Octave, PInstrument^.FineTune); 476 | Screen.WriteTextFast1(ScreenPointer + 63 + CurChannel, $10 + PCell^.Note.Note + 1, #4); 477 | end else 478 | begin 479 | // Tone portamento 480 | LastNoteFutureList[CurChannel] := PCell^.Note; 481 | end; 482 | end else 483 | Screen.WriteTextFast1(ScreenPointer + 63 + CurChannel, $1F, ' '); 484 | end; 485 | AfterPlayingNote: 486 | // Post Effect 487 | if Word(PCell^.Effect) <> 0 then 488 | begin 489 | case Char(CurEffect) of 490 | '1': // Freq slide up 491 | begin 492 | FreqSlideUp; 493 | end; 494 | '2': // Freq slide down 495 | begin 496 | FreqSlideDown; 497 | end; 498 | '3': // Tone portamento 499 | begin 500 | if not ChannelEnabledList[CurChannel] then 501 | begin 502 | Continue; 503 | end else 504 | begin 505 | TonePortamento; 506 | end; 507 | end; 508 | '5': // Tone portamento 509 | begin 510 | if not ChannelEnabledList[CurChannel] then 511 | begin 512 | Continue; 513 | end else 514 | begin 515 | TonePortamento(True); 516 | end; 517 | end; 518 | end; 519 | end; 520 | end; 521 | // 522 | if CurTicks = 0 then 523 | begin 524 | HexStrFast2(CurCell, GS2); 525 | Screen.WriteTextFast2(ScreenPointer + 78, ColorStatus, GS2); 526 | end; 527 | // 528 | Inc(CurTicks); 529 | if CurTicks >= CurSpeed then 530 | begin 531 | CurTicks := 0; 532 | // Change to next PPattern 533 | if CurCell >= $3F then 534 | begin 535 | Move(NepperRec.Instruments[0], Instruments[0], SizeOf(Instruments)); 536 | FillChar(LastInstrumentList[0], SizeOf(LastInstrumentList), $FF); 537 | if IsPatternOnly then 538 | begin 539 | CurCell := NextCell; 540 | end else 541 | begin 542 | CurCell := NextCell; 543 | if CurPatternIndex = High(NepperRec.Orders) then 544 | begin 545 | Stop; 546 | Exit; 547 | end; 548 | Inc(CurPatternIndex); 549 | I := NepperRec.Orders[CurPatternIndex]; 550 | case I of 551 | SONG_HALT: 552 | begin 553 | Stop; 554 | Exit; 555 | end; 556 | SONG_REPEAT: 557 | begin 558 | CurPatternIndex := 0; 559 | end; 560 | end; 561 | PPattern := Formats.Patterns[NepperRec.Orders[CurPatternIndex]]; 562 | HexStrFast2(CurPatternIndex, GS2); 563 | Screen.WriteTextFast2(ScreenPointer + 72, ColorStatus, GS2); 564 | Screen.WriteTextFast1(ScreenPointer + 74, ColorStatus, '/'); 565 | HexStrFast2(NepperRec.Orders[CurPatternIndex], GS2); 566 | Screen.WriteTextFast2(ScreenPointer + 75, ColorStatus, GS2); 567 | Screen.WriteTextFast1(ScreenPointer + 77, ColorStatus, '/'); 568 | end; 569 | NextCell := 0; 570 | goto AtBeginning; 571 | end else 572 | Inc(CurCell); 573 | end; 574 | end; 575 | 576 | procedure Stop; 577 | var 578 | BlankInstr: TAdlibInstrument; 579 | begin 580 | IsPlaying := False; 581 | FillChar(BlankInstr, SizeOf(BlankInstr), 0); 582 | BlankInstr.Operators[0].Volume.Total := $3F; 583 | BlankInstr.Operators[1].Volume.Total := $3F; 584 | BlankInstr.Operators[2].Volume.Total := $3F; 585 | BlankInstr.Operators[3].Volume.Total := $3F; 586 | for I := 0 to 8 do 587 | begin 588 | Adlib.SetInstrument(I, @BlankInstr); 589 | Adlib.NoteClear(I); 590 | end; 591 | CleanUpStates; 592 | Screen.WriteText(63, 0, $1F, '', 17); 593 | BD.Vibrato := 1; 594 | BD.AMDepth := 1; 595 | Adlib.WriteReg($BD, Byte(BD)); 596 | end; 597 | 598 | initialization 599 | for I := 0 to High(ChannelEnabledList) do 600 | ChannelEnabledList[I] := True; 601 | 602 | end. 603 | 604 | -------------------------------------------------------------------------------- /src/screen.pas: -------------------------------------------------------------------------------- 1 | unit Screen; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | uses 8 | Utils; 9 | 10 | var 11 | ScreenPointer, 12 | ScreenPointerBackup: PWord; 13 | CursorX, 14 | CursorY: Byte; 15 | 16 | procedure ClrScr; 17 | procedure SetCursorPosition(const X, Y: Byte); 18 | procedure IncCursorX; 19 | procedure DecCursorX; 20 | procedure WriteTextFast1(const P: PWord; const Attr: Byte; const S: Char); inline; 21 | procedure WriteTextFast2(P: PWord; const Attr: Byte; const S: String2); inline; 22 | procedure WriteTextFast3(P: PWord; const Attr: Byte; const S: String3); inline; 23 | procedure WriteText(const X, Y, Attr: Byte; const S: String80; MaxLen: Byte = 0); 24 | procedure WriteTextBack(const X, Y, Attr: Byte; const S: String80; MaxLen: Byte = 0); 25 | procedure WriteTextMid(const X, Y, Attr: Byte; const S: String80; MaxLen: Byte = 0); 26 | 27 | implementation 28 | 29 | procedure ClrScr; 30 | begin 31 | FillByte(ScreenPointer[0], 80*25*2, 0); 32 | end; 33 | 34 | {$ifdef NO_INT10H} 35 | procedure SetCursorPosition(const X, Y: Byte); 36 | var 37 | P: Word; 38 | begin 39 | P := Y * 80 + X; 40 | Port[$3D4] := $E; 41 | Port[$3D5] := Byte(P shr 8); 42 | Port[$3D4] := $F; 43 | Port[$3D5] := Byte(P); 44 | CursorX := X; 45 | CursorY := Y; 46 | end; 47 | {$else} 48 | procedure SetCursorPosition(const X, Y: Byte); assembler; 49 | asm 50 | mov ah,2 51 | mov dh,Y 52 | mov dl,X 53 | mov CursorX,dl 54 | mov CursorY,dh 55 | xor bh,bh 56 | int $10 57 | end; 58 | {$endif} 59 | 60 | procedure IncCursorX; 61 | begin 62 | Inc(CursorX); 63 | SetCursorPosition(CursorX, CursorY); 64 | end; 65 | 66 | procedure DecCursorX; 67 | begin 68 | Dec(CursorX); 69 | SetCursorPosition(CursorX, CursorY); 70 | end; 71 | 72 | procedure WriteTextFast1(const P: PWord; const Attr: Byte; const S: Char); inline; 73 | begin 74 | P^ := (Word(Attr) shl 8) + Byte(S); 75 | end; 76 | 77 | procedure WriteTextFast2(P: PWord; const Attr: Byte; const S: String2); inline; 78 | var 79 | W: Word; 80 | begin 81 | W := Attr shl 8; 82 | P[0] := W + Byte(S[1]); 83 | P[1] := W + Byte(S[2]); 84 | end; 85 | 86 | procedure WriteTextFast3(P: PWord; const Attr: Byte; const S: String3); inline; 87 | var 88 | W: Word; 89 | begin 90 | W := Attr shl 8; 91 | P[0] := W + Byte(S[1]); 92 | P[1] := W + Byte(S[2]); 93 | P[2] := W + Byte(S[3]); 94 | end; 95 | 96 | procedure WriteText(const X, Y, Attr: Byte; const S: String80; MaxLen: Byte = 0); 97 | var 98 | I: Byte; 99 | P: PWord; 100 | W: Word; 101 | begin 102 | if MaxLen = 0 then 103 | MaxLen := Length(S); 104 | P := ScreenPointer + (80 * Y + X); 105 | W := Attr shl 8; 106 | for I := 1 to MaxLen do 107 | begin 108 | if I <= Length(S) then 109 | P^ := W + Byte(S[I]) 110 | else 111 | P^ := W; 112 | Inc(P); 113 | end; 114 | end; 115 | 116 | procedure WriteTextBack(const X, Y, Attr: Byte; const S: String80; MaxLen: Byte = 0); 117 | var 118 | I: Byte; 119 | P: PWord; 120 | W: Word; 121 | begin 122 | if MaxLen = 0 then 123 | MaxLen := Length(S); 124 | P := ScreenPointer + (80 * Y + X); 125 | W := Attr shl 8; 126 | for I := MaxLen downto 1 do 127 | begin 128 | if I <= Length(S) then 129 | P^ := W + Byte(S[I]) 130 | else 131 | P^ := W; 132 | Dec(P); 133 | end; 134 | end; 135 | 136 | procedure WriteTextMid(const X, Y, Attr: Byte; const S: String80; MaxLen: Byte = 0); 137 | var 138 | I: Byte; 139 | P: PWord; 140 | W: Word; 141 | begin 142 | if MaxLen = 0 then 143 | MaxLen := Length(S); 144 | P := ScreenPointer + (80 * Y + (X - MaxLen div 2)); 145 | W := Attr shl 8; 146 | for I := 1 to MaxLen do 147 | begin 148 | if I <= Length(S) then 149 | P^ := W + Byte(S[I]) 150 | else 151 | P^ := W; 152 | Inc(P); 153 | end; 154 | end; 155 | 156 | initialization 157 | ScreenPointer := Ptr($B800, $0000); 158 | ScreenPointerBackup := ScreenPointer; 159 | FillChar(ScreenPointer[0], 80*25*2, 0); 160 | 161 | finalization 162 | FillWord(ScreenPointer[0], 80*25, $0700); 163 | SetCursorPosition(0, 0); 164 | 165 | end. 166 | 167 | -------------------------------------------------------------------------------- /src/timer.pas: -------------------------------------------------------------------------------- 1 | unit Timer; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | procedure InstallTimer(const Hz: Byte); 8 | 9 | implementation 10 | 11 | uses 12 | Dos, Player; 13 | 14 | var 15 | OldTimerHandle: Pointer; 16 | 17 | procedure InstallTimer(const Hz: Byte); 18 | var 19 | Divisor: DWord; 20 | begin 21 | asm cli end; 22 | Divisor := 1193182 div Hz; 23 | Port[$43] := $36; 24 | Port[$40] := Byte(Divisor); 25 | Port[$40] := Byte(Divisor shr 8); 26 | asm sti end; 27 | end; 28 | 29 | procedure UninstallTimer; 30 | begin 31 | asm cli end; 32 | Port[$43] := $36; 33 | Port[$40] := 0; 34 | Port[$40] := 0; 35 | asm sti end; 36 | end; 37 | 38 | procedure TimerHandler; interrupt; far; 39 | begin 40 | Player.Play; 41 | end; 42 | 43 | initialization 44 | GetIntVec($1C, OldTimerHandle); 45 | SetIntVec($1C, @TimerHandler); 46 | InstallTimer(50); 47 | 48 | finalization 49 | SetIntVec($1C, OldTimerHandle); 50 | UninstallTimer; 51 | 52 | end. 53 | 54 | -------------------------------------------------------------------------------- /src/utils.pas: -------------------------------------------------------------------------------- 1 | unit Utils; 2 | 3 | {$mode ObjFPC} 4 | 5 | interface 6 | 7 | const 8 | BASE16_CHARS: array[0..15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'); 9 | COLOR_LABEL = $0D; 10 | 11 | type 12 | String2 = String[2]; 13 | String3 = String[3]; 14 | String10 = String[10]; 15 | String20 = String[20]; 16 | String40 = String[40]; 17 | String80 = String[80]; 18 | 19 | function HexToInt(const S: String): Word; 20 | function ByteToYesNo(const B: Byte): String3; 21 | function ByteToPanning(const B: Byte): Char; 22 | procedure HexStrFast2(const V: Byte; out S: String2); overload; 23 | procedure HexStrFast3(const V: Word; out S: String3); overload; 24 | function HexStrFast2(const V: Byte): String2; overload; 25 | function HexStrFast3(const V: Word): String3; overload; 26 | function FindCharPos(const S: String; const C: Char): Byte; 27 | function Min(const V1, V2: Integer): Integer; inline; 28 | function Max(const V1, V2: Integer): Integer; inline; 29 | procedure SwapIfBigger(var V1, V2: ShortInt); 30 | 31 | implementation 32 | 33 | function HexToInt(const S: String): Word; 34 | var 35 | I, Len: Byte; 36 | begin 37 | Len := Length(S); 38 | Result := 0; 39 | for I := 1 to Len do 40 | begin 41 | if Byte(S[I]) <= 57 then 42 | Inc(Result, (Byte(S[I]) - 48) * (1 shl (4 * (Len - I)))) 43 | else 44 | Inc(Result, (Byte(S[I]) - 55) * (1 shl (4 * (Len - I)))); 45 | end; 46 | end; 47 | 48 | function ByteToYesNo(const B: Byte): String3; 49 | begin 50 | if B = 0 then 51 | Result := 'No' 52 | else 53 | Result := 'Yes'; 54 | end; 55 | 56 | function ByteToPanning(const B: Byte): Char; 57 | begin 58 | case B of 59 | 0: 60 | Result := 'E'; 61 | 1: 62 | Result := 'L'; 63 | 2: 64 | Result := 'R'; 65 | 3: 66 | Result := 'C'; 67 | end; 68 | end; 69 | 70 | procedure HexStrFast2(const V: Byte; out S: String2); 71 | begin 72 | S[0] := Char(2); 73 | S[1] := BASE16_CHARS[Byte(V shr 4) and $F]; 74 | S[2] := BASE16_CHARS[Byte(V) and $F]; 75 | end; 76 | 77 | procedure HexStrFast3(const V: Word; out S: String3); 78 | begin 79 | S[0] := Char(3); 80 | S[1] := BASE16_CHARS[Byte(V shr 8) and $F]; 81 | S[2] := BASE16_CHARS[Byte(V shr 4) and $F]; 82 | S[3] := BASE16_CHARS[Byte(V) and $F]; 83 | end; 84 | 85 | function HexStrFast2(const V: Byte): String2; 86 | begin 87 | Result[0] := Char(2); 88 | Result[1] := BASE16_CHARS[Byte(V shr 4) and $F]; 89 | Result[2] := BASE16_CHARS[Byte(V) and $F]; 90 | end; 91 | 92 | function HexStrFast3(const V: Word): String3; 93 | begin 94 | Result[0] := Char(3); 95 | Result[1] := BASE16_CHARS[Byte(V shr 8) and $F]; 96 | Result[2] := BASE16_CHARS[Byte(V shr 4) and $F]; 97 | Result[3] := BASE16_CHARS[Byte(V) and $F]; 98 | end; 99 | 100 | function FindCharPos(const S: String; const C: Char): Byte; 101 | var 102 | I: Byte; 103 | begin 104 | for I := 1 to Length(S) do 105 | if S[I] = C then 106 | Exit(I); 107 | Result := 0; 108 | end; 109 | 110 | function Min(const V1, V2: Integer): Integer; inline; 111 | begin 112 | if V1 < V2 then 113 | Result := V1 114 | else 115 | Result := V2; 116 | end; 117 | 118 | function Max(const V1, V2: Integer): Integer; inline; 119 | begin 120 | if V1 > V2 then 121 | Result := V1 122 | else 123 | Result := V2; 124 | end; 125 | 126 | procedure SwapIfBigger(var V1, V2: ShortInt); 127 | var 128 | Tmp: ShortInt; 129 | begin 130 | if V1 > V2 then 131 | begin 132 | Tmp := V1; 133 | V1 := V2; 134 | V2 := Tmp; 135 | end; 136 | end; 137 | 138 | end. 139 | 140 | --------------------------------------------------------------------------------