16/PCGPE10/GUS.TXT

   1 ÚÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\r
   2 ³ GUSDOC ³\r
   3 ÀÄÄÄÄÄÄÄÄÙ\r
   4 \r
   5 \r
   6 \r
   7 \r
   8 \r
   9                                THE OFFICAL\r
  10 \r
  11 \r
  12 \r
  13                 GRAVIS ULTRASOUND PROGRAMMERS ENCYCLOPEDIA\r
  14 \r
  15                                ( G.U.P.E )\r
  16 \r
  17 \r
  18 \r
  19                                  v 0.1\r
  20 \r
  21 \r
  22                            Written by Mark Dixon.\r
  23 \r
  24 \r
  25 \r
  26 \r
  27 \r
  28 \r
  29   -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\r
  30 \r
  31  INTRODUCTION\r
  32  ~~~~~~~~~~~~\r
  33     The Gravis Ultrasound is by far the best & easiest sound card to\r
  34   program. Why? Because the card does all the hard stuff for you, leaving\r
  35   you and the CPU to do other things! This reference will document some\r
  36   (but not all) of the Gravis Ultrasound's hardware functions, allowing\r
  37   you to play music & sound effects on your GUS.\r
  38 \r
  39     We will not be going into great detail as to the theory behind\r
  40   everything - if you want to get technical information then read the\r
  41   GUS SDK. We will be merely providing you with the routines necessary\r
  42   to play samples on the GUS, and a basic explanation of how they work.\r
  43   \r
  44     This document will NOT go into DMA transfer or MIDI specifications.\r
  45   If someone knows something about them, and would like to write some\r
  46   info on them, we would appreciate it very much.\r
  47 \r
  48     All source code is in Pascal (tested under Turbo Pascal v7.0, but\r
  49   should work with TP 6.0 and possibly older versions). This document\r
  50   will assume reasonable knowledge of programming, and some knowledge of\r
  51   soundcards & music.\r
  52 \r
  53 \r
  54  INITIALISATION & AUTODETECTION\r
  55  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\r
  56    Since we are not using DMA, we only need to find the GUS's I/O port,\r
  57  which can be done from the DOS environment space, or preferably from a\r
  58  routine that will scan all possible I/O ports until it finds a GUS.\r
  59 \r
  60    The theory behind the detection routine is to store some values into\r
  61  GUS memory, and then read them back. If we have the I/O port correct,\r
  62  we will read back exactly what we wrote. So first, we need a routine\r
  63  that will write data to the memory of the GUS :\r
  64 \r
  65 \r
  66   Function  GUSPeek(Loc : Longint) : Byte;\r
  67 \r
  68   { Read a value from GUS memory }\r
  69 \r
  70   Var\r
  71     B : Byte;\r
  72     AddLo : Word;\r
  73     AddHi : Byte;\r
  74   Begin\r
  75     AddLo := Loc AND $FFFF;\r
  76     AddHi := LongInt(Loc AND $FF0000) SHR 16;\r
  77 \r
  78     Port [Base+$103] := $43;\r
  79     Portw[Base+$104] := AddLo;\r
  80     Port [Base+$103] := $44;\r
  81     Port [Base+$105] := AddHi;\r
  82 \r
  83     B := Port[Base+$107];\r
  84     GUSPeek := B;\r
  85   End;\r
  86 \r
  87 \r
  88   Procedure GUSPoke(Loc : Longint; B : Byte);\r
  89 \r
  90   { Write a value into GUS memory }\r
  91 \r
  92   Var\r
  93     AddLo : Word;\r
  94     AddHi : Byte;\r
  95   Begin\r
  96     AddLo := Loc AND $FFFF;\r
  97     AddHi := LongInt(Loc AND $FF0000) SHR 16;\r
  98     Port [Base+$103] := $43;\r
  99     Portw[Base+$104] := AddLo;\r
 100     Port [Base+$103] := $44;\r
 101     Port [Base+$105] := AddHi;\r
 102     Port [Base+$107] := B;\r
 103   End;\r
 104 \r
 105 \r
 106    Since the GUS can have up to 1meg of memory, we need to use a 32bit\r
 107  word to address all possible memory locations. However, the hardware of\r
 108  the GUS will only accept a 24bit word, which means we have to change\r
 109  the 32bit address into a 24bit address. The first two lines of each\r
 110  procedure does exactly that.\r
 111 \r
 112    The rest of the procedures simply send commands and data out through\r
 113  the GUS I/O port defined by the variable BASE (A word). So to test for\r
 114  the presence of the GUS, we simply write a routine to read/write memory\r
 115  for all possible values of BASE :\r
 116 \r
 117 \r
 118   Function GUSProbe : Boolean;\r
 119 \r
 120   { Returns TRUE if there is a GUS at I/O address BASE }\r
 121 \r
 122   Var\r
 123     B : Byte;\r
 124   Begin\r
 125     Port [Base+$103] := $4C;\r
 126     Port [Base+$105] := 0;\r
 127     GUSDelay;\r
 128     GUSDelay;\r
 129     Port [Base+$103] := $4C;\r
 130     Port [Base+$105] := 1;\r
 131     GUSPoke(0, $AA);\r
 132     GUSPoke($100, $55);\r
 133     B := GUSPeek(0);\r
 134     If B = $AA then GUSProbe := True else GUSProbe := False;\r
 135   End;\r
 136 \r
 137 \r
 138   Procedure GUSFind;\r
 139 \r
 140   { Search all possible I/O addresses for the GUS }\r
 141 \r
 142   Var\r
 143     I : Word;\r
 144   Begin\r
 145     for I := 1 to 8 do\r
 146     Begin\r
 147       Base := $200 + I*$10;\r
 148       If GUSProbe then I := 8;\r
 149     End;\r
 150     If Base < $280 then\r
 151       Write('Found your GUS at ', Base, ' ');\r
 152   End;\r
 153 \r
 154 \r
 155    The above routines will obviously need to be customised for your own\r
 156  use - for example, setting a boolean flag to TRUE if you find a GUS,\r
 157  rather than just displaying a message.\r
 158 \r
 159    It is also a good idea to find out exactly how much RAM is on the\r
 160  GUS, and this can be done in a similar process to the above routine.\r
 161  Since the memory can either be 256k, 512k, 768k or 1024k, all we have\r
 162  to do is to read/write values on the boundaries of these memory\r
 163  addresses. If we read the same value as we wrote, then we know exactly\r
 164  how much memory is available.\r
 165 \r
 166 \r
 167   Function  GUSFindMem : Longint;\r
 168 \r
 169   { Returns how much RAM is available on the GUS }\r
 170 \r
 171   Var\r
 172     I : Longint;\r
 173     B : Byte;\r
 174   Begin\r
 175     GUSPoke($40000, $AA);\r
 176     If GUSPeek($40000) <> $AA then I := $3FFFF\r
 177       else\r
 178     Begin\r
 179       GUSPoke($80000, $AA);\r
 180       If GUSPeek($80000) <> $AA then I := $8FFFF\r
 181         else\r
 182       Begin\r
 183         GUSPoke($C0000, $AA);\r
 184         If GUSPeek($C0000) <> $AA then I := $CFFFF\r
 185           else I := $FFFFF;\r
 186       End;\r
 187     End;\r
 188     GUSFindMem := I;\r
 189   End;\r
 190 \r
 191 \r
 192    Now that we know where the GUS is, and how much memory it has, we\r
 193  need to initialise it for output. Unfortunately, the below routine is\r
 194  slightly buggy. If you run certain programs (I discovered this after\r
 195  running Second Reality demo) that use the GUS, and then your program\r
 196  using this init routine, it will not initialise the GUS correctly.\r
 197 \r
 198    It appears that I am not doing everything that is necessary to\r
 199  initialise the GUS. However, I managed to correct the problem by\r
 200  either re-booting (not a brilliant solution) or running Dual Module\r
 201  Player, which seems to initialise it properly. If someone knows where\r
 202  i'm going wrong, please say so!\r
 203 \r
 204    Anyway, the following routine should be called after you have found\r
 205  the GUS, and before you start doing anything else with the GUS.\r
 206 \r
 207 \r
 208 \r
 209   Procedure GUSDelay; Assembler;\r
 210 \r
 211   { Pause for approx. 7 cycles. }\r
 212 \r
 213   ASM\r
 214     mov   dx, 0300h\r
 215     in    al, dx\r
 216     in    al, dx\r
 217     in    al, dx\r
 218     in    al, dx\r
 219     in    al, dx\r
 220     in    al, dx\r
 221     in    al, dx\r
 222   End;\r
 223 \r
 224  \r
 225   Procedure GUSReset;\r
 226 \r
 227   { An incomplete routine to initialise the GUS for output. }\r
 228 \r
 229   Begin\r
 230     port [Base+$103]   := $4C;\r
 231     port [Base+$105] := 1;\r
 232     GUSDelay;\r
 233     port [Base+$103]   := $4C;\r
 234     port [Base+$105] := 7;\r
 235     port [Base+$103]   := $0E;\r
 236     port [Base+$105] := (14 OR $0C0);\r
 237   End;\r
 238 \r
 239 \r
 240    Now you have all the routine necessary to find and initialise the\r
 241  GUS, let's see just what we can get the GUS to do!\r
 242 \r
 243 \r
 244  MAKING SOUNDS\r
 245  ~~~~~~~~~~~~~\r
 246    The GUS is unique in that it allows you to store the data to be\r
 247  played in it's onboard DRAM. To play the sample, you then tell it what\r
 248  frequency to play it at, what volume and pan position, and which sample\r
 249  to play. The GUS will then do everything in the background, it will\r
 250  interpolate the data to give an effective 44khz (or less, depending on\r
 251  how many active voices) sample. This means that an 8khz sample will\r
 252  sound better on the GUS than most other cards, since the GUS will play\r
 253  it at 44khz!\r
 254 \r
 255    The GUS also has 32 seperate digital channels (that are mixed by a\r
 256  processor on the GUS) which all have their own individual samples,\r
 257  frequencies, volumes and panning positions. For some reason, however,\r
 258  the GUS can only maintain 44khz output with 16 channels - the more\r
 259  channels, the lower the playback rate (which basically means, lower\r
 260  quality). If you are using all 32 channels (unlikely), then playback is\r
 261  reduced to 22khz.\r
 262 \r
 263    Since you allready know how to store samples in the GUS dram (simply\r
 264  use the GUSPoke routine to store the bytes) we will now look at various\r
 265  routines to change the way the gus plays a sample. The first routine we\r
 266  will look at will set the volume of an individual channel :\r
 267 \r
 268   Procedure GUSSetVolume( Voi : Byte; Vol : Word);\r
 269 \r
 270   { Set the volume of channel VOI to Vol, a 16bit logarithmic scale\r
 271     volume value -  0 is off, $ffff is full volume, $e0000 is half\r
 272     volume, etc }\r
 273 \r
 274   Begin\r
 275     Port [Base+$102] := Voi;\r
 276     Port [Base+$102] := Voi;\r
 277     Port [Base+$102] := Voi;\r
 278     Port [Base+$103] := 9;\r
 279     Portw[Base+$104] := Vol;  { 0-0ffffh, log scale not linear }\r
 280   End;\r
 281 \r
 282    The volume (and pan position & frequency) can be changed at ANY time\r
 283  regardless of weather the GUS is allready playing the sample or not.\r
 284  This means that to fade out a sample, you simply make several calls to\r
 285  the GUSSetVolume routine with exponentially (to account for the\r
 286  logarithmic scale) decreasing values.\r
 287 \r
 288    The next two routines will set the pan position (from 0 to 15, 0\r
 289    being left, 15 right and 7 middle) and the frequency respectively :\r
 290 \r
 291   Procedure GUSSetBalance( V, B : Byte);\r
 292   Begin\r
 293     Port [Base+$102] := V;\r
 294     Port [Base+$102] := V;\r
 295     Port [Base+$102] := V;\r
 296     Port [Base+$103] := $C;\r
 297     Port [Base+$105] := B;\r
 298   End;\r
 299 \r
 300   Procedure GUSSetFreq( V : Byte; F : Word);\r
 301   Begin\r
 302     Port [Base+$102] := V;\r
 303     Port [Base+$102] := V;\r
 304     Port [Base+$102] := V;\r
 305     Port [Base+$103] := 1;\r
 306     Portw[Base+$104] := F;\r
 307   End;\r
 308 \r
 309    I'm not sure the the value F in the set frequency procedure. The GUS\r
 310  SDK claims that it is the exact frequency at which the sample should be\r
 311  played.\r
 312 \r
 313    When playing a sample, it is necessary to set the volume, position\r
 314  and frequency BEFORE playing the sample. In order to start playing a\r
 315  sample, you need to tell the GUS where abouts in memory the sample is\r
 316  stored, and how big the sample is  :\r
 317 \r
 318  \r
 319   Procedure GUSPlayVoice( V, Mode : Byte;VBegin, VStart, VEnd : Longint);\r
 320 \r
 321   { This routine tells the GUS to play a sample commencing at VBegin,\r
 322     starting at location VStart, and stopping at VEnd }\r
 323 \r
 324   Var\r
 325     GUS_Register : Word;\r
 326   Begin\r
 327     Port [Base+$102] := V;\r
 328     Port [Base+$102] := V;\r
 329     Port [Base+$103] := $0A;\r
 330     Portw[Base+$104] := (VBegin SHR 7) AND 8191;\r
 331     Port [Base+$103] := $0B;\r
 332     Portw[Base+$104] := (VBegin AND $127) SHL 8;\r
 333     Port [Base+$103] := $02;\r
 334     Portw[Base+$104] := (VStart SHR 7) AND 8191;\r
 335     Port [Base+$103] := $03;\r
 336     Portw[Base+$104] := (VStart AND $127) SHL 8;\r
 337     Port [Base+$103] := $04;\r
 338     Portw[Base+$104] := ((VEnd)   SHR 7) AND 8191;\r
 339     Port [Base+$103] := $05;\r
 340     Portw[Base+$104] := ((VEnd)   AND $127) SHL 8;\r
 341     Port [Base+$103] := $0;\r
 342     Port [Base+$105] := Mode;\r
 343 \r
 344     { The below part isn't mentioned as necessary, but the card won't\r
 345       play anything without it! }\r
 346 \r
 347     Port[Base] := 1;\r
 348     Port[Base+$103] := $4C;\r
 349     Port[Base+$105] := 3;\r
 350   end;\r
 351 \r
 352    There are a few important things to note about this routine. Firstly,\r
 353  the value VEnd refers to the location in memory, not the length of the\r
 354  sample. So if the sample commenced at location 1000, and was 5000 bytes\r
 355  long, the VEnd would be 6000 if you wanted the sample to play to the\r
 356  end. VBegin and VStart are two weird values, one of them defines the\r
 357  start of the sample, and the other defines where abouts to actually\r
 358  start playing. I'm not sure why both are needed, since I have allways\r
 359  set them to the same value.\r
 360 \r
 361    Now that the gus is buisy playing a sample, the CPU is totally free\r
 362  to be doing other things. We might, for example, want to spy on the gus\r
 363  and see where it is currently up to in playing the sample :\r
 364 \r
 365   Function VoicePos( V : Byte) : Longint;\r
 366   Var\r
 367     P : Longint;\r
 368     Temp0, Temp1 : Word;\r
 369   Begin\r
 370     Port [Base+$102] := V;\r
 371     Port [Base+$102] := V;\r
 372     Port [Base+$102] := V;\r
 373     Port [Base+$103] := $8A;\r
 374     Temp0 := Portw[Base+$104];\r
 375     Port [Base+$103] := $8B;\r
 376     Temp1 := Portw[Base+$104];\r
 377     VoicePos := (Temp0 SHL 7)+ (Temp1 SHR 8);\r
 378   End;\r
 379 \r
 380    This routine will return the memory location that the channel V is\r
 381  currently playing. If the GUS has reached the end of the sample, then\r
 382  the returned value will be VEnd. If you want to see what BYTE value is\r
 383  currently being played (for visual output of the sample's waveform),\r
 384  then you simply PEEK the location pointed to by this routine.\r
 385 \r
 386    Finally, we might want to stop playing the sample before it has\r
 387  reached it's end - the following routine will halt the playback on\r
 388  channel V.\r
 389 \r
 390 \r
 391   Procedure GUSStopVoice( V : Byte);\r
 392   Var\r
 393     Temp : Byte;\r
 394   Begin\r
 395     Port [Base+$102] := V;\r
 396     Port [Base+$102] := V;\r
 397     Port [Base+$102] := V;\r
 398     Port [Base+$103] := $80;\r
 399     Temp := Port[Base+$105];\r
 400     Port [Base+$103] := 0;\r
 401     Port [Base+$105] := (Temp AND $df) OR 3;\r
 402     GUSDelay;\r
 403     Port [Base+$103] := 0;\r
 404     Port [Base+$105] := (Temp AND $df) OR 3;\r
 405   End;\r
 406 \r
 407 \r
 408  SPECIAL EFFECTS\r
 409  ~~~~~~~~~~~~~~~\r
 410    There are a few extra features of the GUS that are worthy of mention,\r
 411  the main one being hardware controlled sample looping. The GUS has a\r
 412  control byte for each of the 32 channels. This control byte consists of\r
 413  8 flags that effect the way the sample is played, as follows :\r
 414   ( The table is taken directly from the GUS Software Developers Kit )\r
 415 \r
 416            =================================\r
 417            | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 |\r
 418            =================================\r
 419              |   |   |   |   |   |   |   |\r
 420              |   |   |   |   |   |   |   +---- Voice Stopped\r
 421              |   |   |   |   |   |   +-------- Stop Voice\r
 422              |   |   |   |   |   +------------ 16 bit data\r
 423              |   |   |   |   +---------------- Loop enable\r
 424              |   |   |   +-------------------- Bi-directional loop enable\r
 425              |   |   +------------------------ Wave table IRQ\r
 426              |   +---------------------------- Direction of movement\r
 427              +-------------------------------- IRQ pending\r
 428         (*)Bit 0 = 1 : Voice is stopped. This gets set by hitting the end\r
 429                    address (not looping) or by setting bit 1 in this reg.\r
 430            Bit 1 = 1 : Stop Voice. Manually force voice to stop.\r
 431            Bit 2 = 1 : 16 bit wave data, 0 = 8 bit data\r
 432            Bit 3 = 1 : Loop to begin address when it hits the end address.\r
 433            Bit 4 = 1 : Bi-directional looping enabled\r
 434            Bit 5 = 1 : Enable wavetable IRQ. Generate an irq when the voice\r
 435                        hits the end address. Will generate irq even if looping\r
 436                        is enabled.\r
 437         (*)Bit 6 = 1 - Decreasing addresses, 0 = increasing addresses. It is\r
 438                        self-modifying because it might shift directions when\r
 439                        it hits one of the loop boundaries and looping is enabled.\r
 440         (*)Bit 7 = 1 - Wavetable IRQ pending. If IRQ's are enabled and\r
 441                        looping is NOT enabled, an IRQ will be constantly\r
 442                        generated until voice is stopped. This means that\r
 443                        you may get more than 1 IRQ if it isn't handled\r
 444                        properly.\r
 445 \r
 446 \r
 447   Procedure GUSVoiceControl( V, B : Byte);\r
 448   Begin\r
 449     Port [Base+$102] := V;\r
 450     Port [Base+$102] := V;\r
 451     Port [Base+$103] := $0;\r
 452     Port [Base+$105] := B;\r
 453   End;\r
 454 \r
 455 \r
 456    The above routine will set the Voice Control byte for the channel\r
 457  defined in V. For example, if you want channel 1 to play the sample in\r
 458  a continuous loop, you would use the procedure like this :\r
 459 \r
 460     GUSVoiceControl( 1, $F );  { Bit 3 ON = $F }\r
 461 \r
 462 \r
 463  CONCLUSION\r
 464  ~~~~~~~~~~\r
 465 \r
 466    The above routines are all that is necessary to get the GUS to start\r
 467  playing music. To prove this, I have included my 669 player & source\r
 468  code in the package as a practical example. The GUSUnit contains all\r
 469  the routines discussed above. I won't go into the theory of the 669\r
 470  player, but it is a good starting point if you want to learn about\r
 471  modplayers. The player is contained within the archive 669UNIT.ARJ\r
 472 \r
 473 \r
 474 \r
 475 ÚÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\r
 476 ³ README ³\r
 477 ÀÄÄÄÄÄÄÄÄÙ\r
 478 \r
 479 \r
 480   GUS669 Unit  v0.2b\r
 481   Copyright 1994 Mark Dixon.\r
 482   (aka C.D. of Silicon Logic)\r
 483 \r
 484 \r
 485   LEGAL STUFF\r
 486   ~~~~~~~~~~~\r
 487   I'd like to avoid this, but it has to be done. Basically, if anything\r
 488   in this archive causes any kind of damage, I cannot be held\r
 489   responsable - USE AT YOUR OWN RISK.\r
 490 \r
 491   In adition, since I spent long hours working on this project, and\r
 492   attempting to decode the GUS SDK, I would appreciate it if people\r
 493   didn't rip off my work. Give me credit for what I have done, and if\r
 494   your planning to use my routines for commercial purposes, talk to me\r
 495   first, or you might find yourself on the wrong side of a legal battle.\r
 496   (Hey, let's sound tough while i'm at it, I have lawyer's in the\r
 497   family, so it's not gonna cost me much to sue someone. And don't\r
 498   criticise my spelling! :)\r
 499 \r
 500 \r
 501 \r
 502   BORING STUFF\r
 503   ~~~~~~~~~~~~\r
 504   Well, if your the sort of person who likes to ignore all the rubishy\r
 505   bits that go into a README text file, then you'd better stop now and\r
 506   go and try out the source code!\r
 507 \r
 508   Basically, this readme isn't going to say much more than what the\r
 509   source code is, and then go dribling on for five pages about\r
 510   absolutely nothing.\r
 511 \r
 512 \r
 513   SOURCE CODE! DID SOMEONE SAY - SOURCE CODE!! - ????\r
 514   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\r
 515   Yes, that's right, free with every download of this wonderful archive\r
 516   comes the complete Pascal source code to a 669 module player for the\r
 517   GUS. I'd have included my MOD player, but I haven't been able to get\r
 518   all the MOD commands working, so you'll just have to make do with a\r
 519   669 player :)\r
 520 \r
 521   Feel free to make use of this source code for any non-commercial\r
 522   purposes you might be able to think of - and mention my name while\r
 523   your at it! Since the source code is here, people are bound to modify\r
 524   it for their personal uses. If you do this, I would very much like to\r
 525   see your modifications - so that I can include them in the next\r
 526   release of the player.\r
 527 \r
 528 \r
 529   Well, I don't want to bore you anymore, and it's getting late (not!)\r
 530   so i'd better let you go and play around with the source code :)\r
 531 \r
 532 \r
 533   SILICON LOGIC\r
 534   ~~~~~~~~~~~~~\r
 535   What ever happened to Silicon Logic? Well, after being killed off over\r
 536   in Perth, a major revival is underway here in Canberra, with a more\r
 537   commercial view - more on that later.\r
 538 \r
 539   For those of you who have never heard of Silicon Logic, then you're\r
 540   either not Australian, or not into the ausie demo scene. But then,\r
 541   that covers about 99.999999999999% of the world population :)\r
 542 \r
 543 \r
 544   GREETINGS\r
 545   ~~~~~~~~~\r
 546   I've allways wanted to dribble some thanks, so here goes.\r
 547 \r
 548    Thanks go to...\r
 549 \r
 550     Darren Lyon    - Who got me into this programming lark in the first\r
 551                      place. Finally wrote myself a mod player :)\r
 552     Tran           - Your source code really helped!\r
 553     Kitsune        - Love those mods, keep up the good work!\r
 554 \r
 555     ... and Advanced Gravis, for making the best sound card ever.\r
 556 \r
 557    Greetings to...\r
 558 \r
 559     FiRE members   - I'll probably never join you guys, but good luck\r
 560                      anyway!\r
 561     UNiQUE         - How's the board going?\r
 562     CRaSH          - Still ripping other peoples source code?\r
 563     Old SL members - Thanks for the support, good luck with your new\r
 564                      group!\r
 565     Oliver White   - G'day... just thought i'd say hi, since you so\r
 566                      kindly beta tested the player for me.\r
 567     Murray Head    - Rick Price sux! :-) SoundBlaster sux too! :-)\r
 568     Perth people   - I'm coming back... someday!\r
 569 \r
 570 \r
 571     THE PICK / MINNOW   -  Hey, give me a call sometime, long time no\r
 572                            talk...\r
 573 \r
 574 \r
 575 \r
 576   INTERESTED IN A DEMO GROUP IN CANBERRA?\r
 577   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\r
 578   If there is anyone interested in joining a demo / coding group in\r
 579   Canberra (ACT), then drop me a line.\r
 580 \r
 581 \r
 582 \r
 583 ÚÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\r
 584 ³ GUSUNIT.PAS³\r
 585 ÀÄÄÄÄÄÄÄÄÄÄÄÄÙ\r
 586 \r
 587 Unit  GUSUnit;\r
 588 \r
 589 {\r
 590   GUS DigiUnit  v1.0\r
 591   Copyright 1994 Mark Dixon.\r
 592 \r
 593   This product is "Learnware".\r
 594 \r
 595   All contents of this archive, including source and executables, are the\r
 596   intellectual property of the author, Mark Dixon. Use of this product for\r
 597   commercial programs, or commercial gain in ANY way, is illegal. Private\r
 598   use, or non-commercial use (such as demos, PD games, etc) is allowed,\r
 599   provided you give credit to the author for these routines.\r
 600 \r
 601   Feel free to make any modifications to these routines, but I would\r
 602   appreciate it if you sent me these modifications, so that I can include\r
 603   them in the next version of the Gus669 Unit.\r
 604 \r
 605   If you wish to use these routines for commercial purposes, then you will\r
 606   need a special agreement. Please contact me, Mark Dixon, and we can work\r
 607   something out.\r
 608 \r
 609   What's "Learnware"? Well, I think I just made it up actually. What i'm\r
 610   getting at is that the source code is provided for LEARNING purposes only.\r
 611   I'd get really angry if someone ripped off my work and tried to make out\r
 612   that they wrote a mod player.\r
 613 \r
 614   As of this release (Gus699 Unit), the Gus DigiUnit has moved to version\r
 615   1.0, and left the beta stage. I feel these routines are fairly sound,\r
 616   and I haven't made any changes to them in weeks.\r
 617 \r
 618 \r
 619   Notice the complete absence of comments here? Well, that's partially\r
 620   the fault of Gravis and their SDK, since it was so hard to follow, I\r
 621   was more worried about getting it working than commenting it. No offense\r
 622   to Gravis though, since they created this wonderful card! :-) It helps\r
 623   a lot if you have the SDK as a reference when you read this code,\r
 624   otherwise you might as well not bother reading it.\r
 625 \r
 626 }\r
 627 \r
 628 \r
 629 \r
 630 INTERFACE\r
 631 \r
 632 Procedure GUSPoke(Loc : Longint; B : Byte);\r
 633 Function  GUSPeek(Loc : Longint) : Byte;\r
 634 Procedure GUSSetFreq( V : Byte; F : Word);\r
 635 Procedure GUSSetBalance( V, B : Byte);\r
 636 Procedure GUSSetVolume( Voi : Byte; Vol : Word);\r
 637 Procedure GUSPlayVoice( V, Mode : Byte;VBegin, VStart, VEnd : Longint);\r
 638 Procedure GUSVoiceControl( V, B : Byte);\r
 639 Procedure GUSReset;\r
 640 Function VoicePos( V : Byte) : Longint;\r
 641 \r
 642 Const\r
 643   Base : Word = $200;\r
 644   Mode : Byte = 0;\r
 645 \r
 646 IMPLEMENTATION\r
 647 \r
 648 \r
 649 Uses Crt;\r
 650 \r
 651 Function Hex( W : Word) : String;\r
 652 Var\r
 653   I, J : Word;\r
 654   S : String;\r
 655   C : Char;\r
 656 Const\r
 657   H : Array[0..15] of Char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');\r
 658 Begin\r
 659   S := '';\r
 660   S := S + H[(W DIV $1000) MOD 16];\r
 661   S := S + H[(W DIV $100 ) MOD 16];\r
 662   S := S + H[(W DIV $10  ) MOD 16];\r
 663   S := S + H[(W DIV $1   ) MOD 16];\r
 664   Hex := S+'h';\r
 665 End;\r
 666 \r
 667 \r
 668 Procedure GUSDelay; Assembler;\r
 669 ASM\r
 670   mov   dx, 0300h\r
 671   in    al, dx\r
 672   in    al, dx\r
 673   in    al, dx\r
 674   in    al, dx\r
 675   in    al, dx\r
 676   in    al, dx\r
 677   in    al, dx\r
 678 End;\r
 679 \r
 680 \r
 681 \r
 682 Function VoicePos( V : Byte) : Longint;\r
 683 Var\r
 684   P : Longint;\r
 685   I, Temp0, Temp1 : Word;\r
 686 Begin\r
 687   Port [Base+$102] := V;\r
 688   Port [Base+$103] := $8A;\r
 689   Temp0 := Portw[Base+$104];\r
 690   Port [Base+$103] := $8B;\r
 691   Temp1 := Portw[Base+$104];\r
 692   VoicePos := (Temp0 SHL 7)+ (Temp1 SHR 8);\r
 693   For I := 1 to 10 do GusDelay;\r
 694 End;\r
 695 \r
 696 \r
 697 Function  GUSPeek(Loc : Longint) : Byte;\r
 698 Var\r
 699   B : Byte;\r
 700   AddLo : Word;\r
 701   AddHi : Byte;\r
 702 Begin\r
 703   AddLo := Loc AND $FFFF;\r
 704   AddHi := LongInt(Loc AND $FF0000) SHR 16;\r
 705 \r
 706   Port [Base+$103] := $43;\r
 707   Portw[Base+$104] := AddLo;\r
 708   Port [Base+$103] := $44;\r
 709   Port [Base+$105] := AddHi;\r
 710 \r
 711   B := Port[Base+$107];\r
 712   GUSPeek := B;\r
 713 End;\r
 714 \r
 715 \r
 716 Procedure GUSPoke(Loc : Longint; B : Byte);\r
 717 Var\r
 718   AddLo : Word;\r
 719   AddHi : Byte;\r
 720 Begin\r
 721   AddLo := Loc AND $FFFF;\r
 722   AddHi := LongInt(Loc AND $FF0000) SHR 16;\r
 723 {  Write('POKE  HI :', AddHi:5, '  LO : ', AddLo:5, '    ');}\r
 724   Port [Base+$103] := $43;\r
 725   Portw[Base+$104] := AddLo;\r
 726   Port [Base+$103] := $44;\r
 727   Port [Base+$105] := AddHi;\r
 728   Port [Base+$107] := B;\r
 729 {  Writeln(B:3);}\r
 730 End;\r
 731 \r
 732 \r
 733 Function GUSProbe : Boolean;\r
 734 Var\r
 735   B : Byte;\r
 736 Begin\r
 737   Port [Base+$103] := $4C;\r
 738   Port [Base+$105] := 0;\r
 739   GUSDelay;\r
 740   GUSDelay;\r
 741   Port [Base+$103] := $4C;\r
 742   Port [Base+$105] := 1;\r
 743   GUSPoke(0, $AA);\r
 744   GUSPoke($100, $55);\r
 745   B := GUSPeek(0);\r
 746 {  Port [Base+$103] := $4C;\r
 747   Port [Base+$105] := 0;}\r
 748   { Above bit disabled since it appears to prevent the GUS from accessing\r
 749     it's memory correctly.. in some bizare way.... }\r
 750 \r
 751   If B = $AA then GUSProbe := True else GUSProbe := False;\r
 752 End;\r
 753 \r
 754 \r
 755 Procedure GUSFind;\r
 756 Var\r
 757   I : Word;\r
 758 Begin\r
 759   for I := 1 to 8 do\r
 760   Begin\r
 761     Base := $200 + I*$10;\r
 762     If GUSProbe then I := 8;\r
 763   End;\r
 764   If Base < $280 then\r
 765     Write('Found your GUS at ', Hex(Base), ' ');\r
 766 End;\r
 767 \r
 768 \r
 769 Function  GUSFindMem : Longint;\r
 770 { Returns how much RAM is available on the GUS }\r
 771 Var\r
 772   I : Longint;\r
 773   B : Byte;\r
 774 Begin\r
 775   GUSPoke($40000, $AA);\r
 776   If GUSPeek($40000) <> $AA then I := $3FFFF\r
 777     else\r
 778   Begin\r
 779     GUSPoke($80000, $AA);\r
 780     If GUSPeek($80000) <> $AA then I := $8FFFF\r
 781       else\r
 782     Begin\r
 783       GUSPoke($C0000, $AA);\r
 784       If GUSPeek($C0000) <> $AA then I := $CFFFF\r
 785         else I := $FFFFF;\r
 786     End;\r
 787   End;\r
 788   GUSFindMem := I;\r
 789 End;\r
 790 \r
 791 \r
 792 Procedure GUSSetFreq( V : Byte; F : Word);\r
 793 Begin\r
 794   Port [Base+$102] := V;\r
 795   Port [Base+$102] := V;\r
 796   Port [Base+$102] := V;\r
 797   Port [Base+$103] := 1;\r
 798   Portw[Base+$104] := (F { DIV 19}); { actual frequency / 19.0579083837 }\r
 799 End;\r
 800 \r
 801 Procedure GUSVoiceControl( V, B : Byte);\r
 802 Begin\r
 803   Port [Base+$102] := V;\r
 804   Port [Base+$102] := V;\r
 805   Port [Base+$103] := $0;\r
 806   Port [Base+$105] := B;\r
 807 End;\r
 808 \r
 809 \r
 810 \r
 811 Procedure GUSSetBalance( V, B : Byte);\r
 812 Begin\r
 813   Port [Base+$102] := V;\r
 814   Port [Base+$102] := V;\r
 815   Port [Base+$102] := V;\r
 816   Port [Base+$103] := $C;\r
 817   Port [Base+$105] := B;\r
 818 End;\r
 819 \r
 820 \r
 821 Procedure GUSSetVolume( Voi : Byte; Vol : Word);\r
 822 Begin\r
 823   Port [Base+$102] := Voi;\r
 824   Port [Base+$102] := Voi;\r
 825   Port [Base+$102] := Voi;\r
 826   Port [Base+$103] := 9;\r
 827   Portw[Base+$104] := Vol;  { 0-0ffffh, log ... not linear }\r
 828 End;\r
 829 \r
 830 \r
 831 Procedure GUSSetLoopMode( V : Byte);\r
 832 Var\r
 833   Temp : Byte;\r
 834 Begin\r
 835   Port [Base+$102] := V;\r
 836   Port [Base+$102] := V;\r
 837   Port [Base+$102] := V;\r
 838   Port [Base+$103] := $80;\r
 839   Temp := Port[Base+$105];\r
 840   Port [Base+$103] := 0;\r
 841   Port [Base+$105] := (Temp AND $E7) OR Mode;\r
 842 End;\r
 843 \r
 844 \r
 845 Procedure GUSStopVoice( V : Byte);\r
 846 Var\r
 847   Temp : Byte;\r
 848 Begin\r
 849   Port [Base+$102] := V;\r
 850   Port [Base+$102] := V;\r
 851   Port [Base+$102] := V;\r
 852   Port [Base+$103] := $80;\r
 853   Temp := Port[Base+$105];\r
 854   Port [Base+$103] := 0;\r
 855   Port [Base+$105] := (Temp AND $df) OR 3;\r
 856   GUSDelay;\r
 857   Port [Base+$103] := 0;\r
 858   Port [Base+$105] := (Temp AND $df) OR 3;\r
 859 End;\r
 860 \r
 861 \r
 862 Procedure GUSPlayVoice( V, Mode : Byte;VBegin, VStart, VEnd : Longint);\r
 863 Var\r
 864   GUS_Register : Word;\r
 865 Begin\r
 866   Port [Base+$102] := V;\r
 867   Port [Base+$102] := V;\r
 868   Port [Base+$103] := $0A;\r
 869   Portw[Base+$104] := (VBegin SHR 7) AND 8191;\r
 870   Port [Base+$103] := $0B;\r
 871   Portw[Base+$104] := (VBegin AND $127) SHL 8;\r
 872   Port [Base+$103] := $02;\r
 873   Portw[Base+$104] := (VStart SHR 7) AND 8191;\r
 874   Port [Base+$103] := $03;\r
 875   Portw[Base+$104] := (VStart AND $127) SHL 8;\r
 876   Port [Base+$103] := $04;\r
 877   Portw[Base+$104] := ((VEnd)   SHR 7) AND 8191;\r
 878   Port [Base+$103] := $05;\r
 879   Portw[Base+$104] := ((VEnd)   AND $127) SHL 8;\r
 880   Port [Base+$103] := $0;\r
 881   Port [Base+$105] := Mode;\r
 882 \r
 883   { The below part isn't mentioned as necessary, but the card won't\r
 884     play anything without it! }\r
 885 \r
 886   Port[Base] := 1;\r
 887   Port[Base+$103] := $4C;\r
 888   Port[Base+$105] := 3;\r
 889 \r
 890 end;\r
 891 \r
 892 \r
 893 Procedure GUSReset;\r
 894 Begin\r
 895   port [Base+$103]   := $4C;\r
 896   port [Base+$105] := 1;\r
 897   GUSDelay;\r
 898   port [Base+$103]   := $4C;\r
 899   port [Base+$105] := 7;\r
 900   port [Base+$103]   := $0E;\r
 901   port [Base+$105] := (14 OR $0C0);\r
 902 End;\r
 903 \r
 904 \r
 905 \r
 906 Var\r
 907   I : Longint;\r
 908   F : File;\r
 909   Buf : Array[1..20000] of Byte;\r
 910   S : Word;\r
 911 \r
 912 \r
 913 Begin\r
 914   Clrscr;\r
 915   Writeln('GUS DigiUnit V1.0');\r
 916   Writeln('Copyright 1994 Mark Dixon.');\r
 917   Writeln;\r
 918   GUSFind;\r
 919   Writeln('with ', GUSFindMem, ' bytes onboard.');\r
 920   Writeln;\r
 921   GUSReset;\r
 922 End.\r
 923 \r
 924 \r
 925 ÚÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\r
 926 ³ GUS669.PAS ³\r
 927 ÀÄÄÄÄÄÄÄÄÄÄÄÄÙ\r
 928 \r
 929 UNIT Gus669;\r
 930 \r
 931 {\r
 932   GUS669 Unit  v0.2b\r
 933   Copyright 1994 Mark Dixon.\r
 934 \r
 935   This product is "Learnware".\r
 936 \r
 937   All contents of this archive, including source and executables, are the\r
 938   intellectual property of the author, Mark Dixon. Use of this product for\r
 939   commercial programs, or commercial gain in ANY way, is illegal. Private\r
 940   use, or non-commercial use (such as demos, PD games, etc) is allowed,\r
 941   provided you give credit to the author for these routines.\r
 942 \r
 943   Feel free to make any modifications to these routines, but I would\r
 944   appreciate it if you sent me these modifications, so that I can include\r
 945   them in the next version of the Gus669 Unit.\r
 946 \r
 947   If you wish to use these routines for commercial purposes, then you will\r
 948   need a special agreement. Please contact me, Mark Dixon, and we can work\r
 949   something out.\r
 950 \r
 951   What's "Learnware"? Well, I think I just made it up actually. What i'm\r
 952   getting at is that the source code is provided for LEARNING purposes only.\r
 953   I'd get really angry if someone ripped off my work and tried to make out\r
 954   that they wrote a mod player.\r
 955 \r
 956   Beta version? Yes, since the product is still slightly unstable, I feel\r
 957   it is right to keep it under beta status until I find and fix a few\r
 958   bugs.\r
 959 \r
 960   FEATURES\r
 961     - Only works with the GUS!\r
 962     - 8 channel, 669 music format.\r
 963     - That's about it really.\r
 964     - Oh, 100% Pascal high level source code = NO ASSEMBLER!\r
 965       (So if you want to learn about how to write your own MOD player, this\r
 966        should make it easier for you)\r
 967     - Tested & compiled with Turbo Pascal v7.0\r
 968 \r
 969   BUGS\r
 970     - Not yet, give me a chance!\r
 971       (If you find any, I would very much appreciate it if you could take\r
 972        the time to notify me)\r
 973     - Doesn't sound right with some modules, advice anyone??\r
 974     - Could do with some better I/O handling routines when loading the\r
 975       669 to give better feedback to the user about what went wrong\r
 976       if the module didn't load.\r
 977 \r
 978 \r
 979  You can contact me at any of the following :\r
 980 \r
 981  FidoNet  : Mark Dixon  3:620/243\r
 982  ItnerNet : markd@cairo.anu.edu.au         ( prefered )\r
 983             d9404616@karajan.anu.edu.au    ( might not work for mail :) )\r
 984             sdixonmj@cc.curtin.edu.au      ( Don't use this one often )\r
 985             sdixonmj01@cc.curtin.edu.au    ( Might not exist any more,\r
 986                                              that's how often it's used! )\r
 987             I collect internet accounts.... :)\r
 988 \r
 989  If you happen to live in the Australian Capital Territory, you can\r
 990  call me on  231-2000, but at respectable hours please.\r
 991 \r
 992 \r
 993  "Want more comments? Write em!"\r
 994  Sorry, I just had to quote that. I'm not in the mood for writing lots\r
 995  of comments just yet. The main reason for writing it in Pascal is so\r
 996  that it would be easy to understand. Comments may (or may not) come later\r
 997  on.\r
 998 \r
 999  Okay, enough of me dribbling, here's the source your after!\r
1000 \r
1001 }\r
1002 \r
1003 \r
1004 \r
1005 \r
1006 Interface\r
1007 \r
1008 Procedure Load669(N : String);\r
1009 Procedure PlayMusic;\r
1010 Procedure StopMusic;\r
1011 \r
1012 Type\r
1013   { This is so that we can keep a record of what each channel is\r
1014     currently doing, so that we can inc/dec the Frequency or volume,\r
1015     or pan left/right, etc }\r
1016   Channel_Type    = Record\r
1017                       Vol : Word;\r
1018                       Freq : Word;\r
1019                       Pan : Byte;\r
1020                     End;\r
1021 \r
1022 Var\r
1023   Channels : Array[1..8] of Channel_Type;\r
1024   Flags : Array[0..15] of Byte;\r
1025   { Programmer flags. This will be explained when it is fully implemented. }\r
1026 \r
1027 Const\r
1028   Loaded : Boolean = False;    { Is a module loaded? }\r
1029   Playing : Boolean = False;   { Is a module playing? }\r
1030   WaitState : Boolean = False; { Set to TRUE whenever a new note is played }\r
1031                                { Helpful for timing in with the player }\r
1032 \r
1033 \r
1034 Const\r
1035   NumChannels = 8;\r
1036 \r
1037   { Thanks to Tran for releasing the Hell demo source code, from which\r
1038     I managed to find these very helpfull volume and frequency value\r
1039     tables, without which this player would not have worked! }\r
1040 \r
1041   voltbl : Array[0..15] of Byte =\r
1042                      (  $004,$0a0,$0b0,$0c0,$0c8,$0d0,$0d8,$0e0,\r
1043                         $0e4,$0e8,$0ec,$0f1,$0f4,$0f6,$0fa,$0ff);\r
1044   freqtbl : Array[1..60] of Word = (\r
1045                         56,59,62,66,70,74,79,83,88,94,99,105,\r
1046                         112,118,125,133,141,149,158,167,177,188,199,211,\r
1047                         224,237,251,266,282,299,317,335,355,377,399,423,\r
1048                         448,475,503,532,564,598,634,671,711,754,798,846,\r
1049                         896,950,1006,1065,1129,1197,1268,1343,1423,1508,1597,1692 );\r
1050 \r
1051 \r
1052 \r
1053 Type\r
1054   Header_669_Type = Record\r
1055                       Marker      : Word;\r
1056                       Title       : Array[1..108] of Char;\r
1057                       NOS,                     { No of Samples  0 - 64 }\r
1058                       NOP         : Byte;      { No of Patterns 0 - 128 }\r
1059                       LoopOrder   : Byte;\r
1060                       Order       : Array[0..127] of Byte;\r
1061                       Tempo       : Array[0..127] of Byte;\r
1062                       Break       : Array[0..127] of Byte;\r
1063                     End;\r
1064   Sample_Type     = Record\r
1065                       FileName  : Array[1..13] of Char;\r
1066                       Length    : Longint;\r
1067                       LoopStart : Longint;\r
1068                       LoopLen   : Longint;\r
1069                     End;\r
1070   Sample_Pointer  = ^Sample_Type;\r
1071   Note_Type       = Record\r
1072                       Info,  { <- Don't worry about this little bit here }\r
1073                       Note,\r
1074                       Sample,\r
1075                       Volume,\r
1076                       Command,\r
1077                       Data    : Byte;\r
1078                     End;\r
1079   Event_Type      = Array[1..8] of Note_Type;\r
1080   Pattern_Type    = Array[0..63] of Event_Type;\r
1081   Pattern_Pointer = ^Pattern_Type;\r
1082 \r
1083 \r
1084 \r
1085 Var\r
1086   Header : Header_669_Type;\r
1087   Samples : Array[0..64] of Sample_Pointer;\r
1088   Patterns : Array[0..128] of Pattern_Pointer;\r
1089   GusTable : Array[0..64] of Longint;\r
1090   GusPos : Longint;\r
1091   Speed : Byte;\r
1092   Count : Word;\r
1093   OldTimer : Procedure;\r
1094   CurrentPat, CurrentEvent : Byte;\r
1095 \r
1096 \r
1097 Implementation\r
1098 \r
1099 Uses Dos, Crt, GUSUnit;\r
1100 \r
1101 \r
1102 Procedure Load669(N : String);\r
1103 Var\r
1104   F : File;\r
1105   I, J, K : Byte;\r
1106   T : Array[1..8,1..3] of Byte;\r
1107 \r
1108   Procedure LoadSample(No, Size : Longint);\r
1109   Var\r
1110     Buf : Array[1..1024] of Byte;\r
1111     I : Longint;\r
1112     J, K : Integer;\r
1113   Begin\r
1114     GusTable[No] := GusPos;\r
1115 \r
1116     I := Size;\r
1117     While I > 1024 do\r
1118     Begin\r
1119       BlockRead(F, Buf, SizeOf(Buf), J);\r
1120       For K := 1 to J do GusPoke(GusPos+K-1, Buf[K] XOR 127);\r
1121       Dec(I, J);\r
1122       Inc(GusPos, J);\r
1123     End;\r
1124     BlockRead(F, Buf, I, J);\r
1125     For K := 1 to J do GusPoke(GusPos+K-1, Buf[K] XOR 127);\r
1126     Inc(GusPos, J);\r
1127   End;\r
1128 \r
1129 Begin\r
1130   {$I-}\r
1131   Assign(F, N);\r
1132   Reset(F, 1);\r
1133   BlockRead(F, Header, SizeOf(Header));\r
1134   If Header.Marker = $6669 then\r
1135   Begin\r
1136     For I := 1 to Header.NOS do\r
1137     Begin\r
1138       New(Samples[I-1]);\r
1139       BlockRead(F, Samples[I-1]^, SizeOf(Samples[I-1]^));\r
1140     End;\r
1141 \r
1142     For I := 0 to Header.NOP-1 do\r
1143     Begin\r
1144       New(Patterns[I]);\r
1145       For J := 0 to 63 do\r
1146       Begin\r
1147         BlockRead(F, T, SizeOf(T));\r
1148         For K := 1 to 8 do\r
1149         Begin\r
1150           Patterns[I]^[J,K].Info    := t[K,1];\r
1151           Patterns[I]^[J,K].Note    := ( t[K,1] shr 2);\r
1152           Patterns[I]^[J,K].Sample  := ((t[K,1] AND 3) SHL 4) +  (t[K,2] SHR 4);\r
1153           Patterns[I]^[J,K].Volume  := ( t[K,2] AND 15);\r
1154           Patterns[I]^[J,K].Command := ( t[K,3] shr 4);\r
1155           Patterns[I]^[J,K].Data    := ( t[K,3] AND 15);\r
1156         End;\r
1157       End;\r
1158     End;\r
1159 \r
1160     For I := 1 to Header.NOS do\r
1161       LoadSample(I-1, Samples[I-1]^.Length);\r
1162   End;\r
1163 \r
1164   Close(F);\r
1165   {$I+}\r
1166   If (IOResult <> 0) OR (Header.Marker <> $6669) then\r
1167     Loaded := False else Loaded := True;\r
1168 \r
1169 End;\r
1170 \r
1171 \r
1172 \r
1173 \r
1174 Procedure UpDateNotes;\r
1175 Var\r
1176   I : Word;\r
1177   Inst : Byte;\r
1178   Note : Word;\r
1179 Begin\r
1180   WaitState := True;\r
1181   For I := 1 to NumChannels do\r
1182   With Patterns[Header.Order[CurrentPat]]^[CurrentEvent, I] do\r
1183 \r
1184   For I := 1 to NumChannels do\r
1185   If (Patterns[Header.Order[CurrentPat]]^[CurrentEvent, I].Info < $FE) then\r
1186   Begin\r
1187     Inst := Patterns[Header.Order[CurrentPat]]^[CurrentEvent, I].Sample;\r
1188     Note := Patterns[Header.Order[CurrentPat]]^[CurrentEvent, I].Note;\r
1189     Channels[I].Freq := FreqTbl[Note];\r
1190 {    Channels[I].Pan  := (1-(I AND 1)) * 15;}\r
1191     Channels[I].Vol  := $100*VolTbl[Patterns[Header.Order[CurrentPat]]^[CurrentEvent, I].Volume];\r
1192 {    Write(Note:3,Inst:3,' -');}\r
1193 \r
1194     GUSSetVolume    (I, 0);\r
1195     GUSVoiceControl (I, 1);\r
1196     GUSSetBalance   (I, Channels[I].Pan);\r
1197     GusSetFreq      ( I, Channels[I].Freq);\r
1198 {    GUSPlayVoice    ( I, 0, GusTable[Inst],\r
1199                             GusTable[Inst],\r
1200                             GusTable[Inst]+Samples[Inst]^.Length  );}\r
1201 \r
1202 {    Write(Samples[Inst]^.LoopLen:5);}\r
1203     If Samples[Inst]^.LoopLen < 1048575 then\r
1204     Begin\r
1205     GUSPlayVoice    ( I, 8, GusTable[Inst],\r
1206                             GusTable[Inst]+Samples[Inst]^.LoopStart,\r
1207                             GusTable[Inst]+Samples[Inst]^.LoopLen  );\r
1208     End\r
1209       Else\r
1210     Begin\r
1211     GUSPlayVoice    ( I, 0, GusTable[Inst],\r
1212                             GusTable[Inst],\r
1213                             GusTable[Inst]+Samples[Inst]^.Length  );\r
1214     End;\r
1215 \r
1216 \r
1217   End;\r
1218 \r
1219 {  Writeln;}\r
1220 \r
1221   For I := 1 to NumChannels do\r
1222     If (Patterns[Header.Order[CurrentPat]]^[CurrentEvent, I].Info < $FF) then\r
1223       GUSSetVolume (I, $100*VolTbl[Patterns[Header.Order[CurrentPat]]^[CurrentEvent, I].Volume]);\r
1224 \r
1225   For I := 1 to NumChannels do\r
1226   With Patterns[Header.Order[CurrentPat]]^[CurrentEvent, I] do\r
1227   Case Command of\r
1228     5 : Speed := Data;\r
1229     3 : Begin\r
1230           Channels[I].Freq := Channels[I].Freq + 10;\r
1231           GUSSetFreq(I, Channels[I].Freq);\r
1232         End;\r
1233     8 : Inc(Flags[Data]);\r
1234     6 : Case Data of\r
1235           0 : If Channels[I].Pan > 0 then\r
1236               Begin\r
1237                 Dec(Channels[I].Pan);\r
1238                 GusSetBalance(I, Channels[I].Pan);\r
1239               End;\r
1240           1 : If Channels[I].Pan < 15 then\r
1241               Begin\r
1242                 Inc(Channels[I].Pan);\r
1243                 GusSetBalance(I, Channels[I].Pan);\r
1244               End;\r
1245         End;\r
1246   End;\r
1247 \r
1248 \r
1249 \r
1250 \r
1251 \r
1252   Inc(CurrentEvent);\r
1253   If CurrentEvent > Header.Break[CurrentPat] then Begin CurrentEvent := 0; Inc(CurrentPat) End;\r
1254   If Header.Order[CurrentPat] > (Header.NOP) then Begin CurrentEvent := 0; CurrentPat := 0; End;\r
1255 \r
1256 End;\r
1257 \r
1258 \r
1259 Procedure UpDateEffects;\r
1260 Var\r
1261   I : Word;\r
1262 Begin\r
1263   For I := 1 to 4 do\r
1264   With Patterns[Header.Order[CurrentPat]]^[CurrentEvent, I] do\r
1265   Begin\r
1266     Case Command of\r
1267       0 : Begin\r
1268             Inc(Channels[I].Freq, Data);\r
1269             GusSetFreq(I, Channels[I].Freq);\r
1270           End;\r
1271       1 : Begin\r
1272             Dec(Channels[I].Freq, Data);\r
1273             GusSetFreq(I, Channels[I].Freq);\r
1274           End;\r
1275     End;\r
1276   End;\r
1277 End;\r
1278 \r
1279 \r
1280 \r
1281 \r
1282 { $ F+,S-,W-}\r
1283 Procedure ModInterrupt; Interrupt;\r
1284 Begin\r
1285   Inc(Count);\r
1286   If Count = Speed then\r
1287   Begin\r
1288     UpDateNotes;\r
1289     Count := 0;\r
1290   End;\r
1291   UpDateEffects;\r
1292   If (Count MOD 27) = 1 then\r
1293   Begin\r
1294     inline ($9C);\r
1295     OldTimer;\r
1296   End;\r
1297   Port[$20] := $20;\r
1298 End;\r
1299 { $ F-,S+}\r
1300 \r
1301 Procedure TimerSpeedup(Speed : Word);\r
1302 Begin\r
1303   Port[$43] := $36;\r
1304   Port[$40] := Lo(Speed);\r
1305   Port[$40] := Hi(Speed);\r
1306 end;\r
1307 \r
1308 Procedure PlayMusic;\r
1309 Begin\r
1310   If Loaded then\r
1311   Begin\r
1312     TimerSpeedUp( (1192755 DIV 32));\r
1313     GetIntVec($8, Addr(OldTimer));\r
1314     SetIntVec($8, Addr(ModInterrupt));\r
1315     Speed := Header.Tempo[0];\r
1316     Playing := True;\r
1317   End\r
1318   { If the module is not loaded, then the Playing flag will not be set,\r
1319     so your program should check the playing flag just after calling\r
1320     PlayMusic to see if everything was okay. }\r
1321 End;\r
1322 \r
1323 \r
1324 Procedure StopMusic;\r
1325 Var\r
1326   I : Byte;\r
1327 Begin\r
1328   If Playing then\r
1329   Begin\r
1330     SetIntVec($8, Addr(OldTimer));\r
1331     For I := 1 to NumChannels do GusSetVolume(I, 0);\r
1332   End;\r
1333   TimerSpeedUp($FFFF);\r
1334 End;\r
1335 \r
1336 \r
1337 Procedure Init;\r
1338 Var\r
1339   I : Byte;\r
1340 Begin\r
1341   GusPos := 1;\r
1342   Count := 0;\r
1343   Speed := 6;\r
1344   CurrentPat := 0;\r
1345   CurrentEvent := 0;\r
1346   For I := 1 to NumChannels do Channels[I].Pan  := (1-(I AND 1)) * 15;\r
1347   For I := 1 to NumChannels do GUSVoiceControl(I, 1);\r
1348   For I := 0 to 15 do Flags[I] := 0;\r
1349 End;\r
1350 \r
1351 \r
1352 Var\r
1353   I, J : Byte;\r
1354 \r
1355 \r
1356 Begin\r
1357   Init;\r
1358   Writeln('GUS669 Unit V0.2b');\r
1359   Writeln('Copyright 1994 Mark Dixon.');\r
1360   Writeln;\r
1361 End.\r
1362 \r
1363 \r
1364 ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\r
1365 ³ PLAY669.PAS ³\r
1366 ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÙ\r
1367 \r
1368 Program Testout_Gus669_Unit;\r
1369 \r
1370 Uses Crt, GUS669;\r
1371 \r
1372 Begin\r
1373 \r
1374   If ParamCount > 0 then Load669(Paramstr(1))\r
1375     else\r
1376   Begin\r
1377     Writeln;\r
1378     Writeln('Please specify the name of the 669 module you wish to play');\r
1379     Writeln('from the command line.');\r
1380     Writeln;\r
1381     Writeln('eg :    Play669  Hardwired.669 ');\r
1382     Writeln;\r
1383     Halt(1);\r
1384   End;\r
1385   PlayMusic;\r
1386   If Playing then\r
1387   Begin\r
1388     Writeln('Playing ', ParamStr(1) );\r
1389     Writeln('Press any key to stop and return to DOS.');\r
1390     Repeat\r
1391     Until Keypressed\r
1392   End\r
1393     else\r
1394   Begin\r
1395     Writeln;\r
1396     Writeln('Couldn''t load or play the module for some reason!');\r
1397     Writeln;\r
1398     Writeln('Please check your GUS is working correctly, and that you have');\r
1399     Writeln('correctly specified the 669 filename.');\r
1400     Writeln;\r
1401   End;\r
1402   StopMusic;\r
1403 End.\r