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