home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 423.lha / FurLess / FurLess.a < prev    next >
Encoding:
Text File  |  1990-09-03  |  25.6 KB  |  708 lines
  1. *********************************************************
  2. *                            *
  3. * FurLess.a - Produced for an entry to the 'neatest    *
  4. *    program under 2K' contest at the ASDF 010th    *
  5. *    annual GURU meditation by:            *
  6. *                            *
  7. *        Wesley Howe                *
  8. *        10-Jun-90                *
  9. *                            *
  10. * Assembled with CAPE (of course.)            *
  11. *                            *
  12. *********************************************************
  13. *
  14.     EXEOBJ            ;generate free-standing executable
  15.     OBJFILE    "FurLess"    ;output filename
  16.     INCLUDE    "FurLess.i"    ;definitions
  17. *
  18. * some register equates
  19. *
  20. BR    EQUR    A5        ;data area
  21. WN    EQUR    A4        ;Window Pointer
  22. CST    EQUR    A3        ;CUSTOM chips
  23. *
  24. * some specific equates for this program
  25. *
  26. TEMPO1        EQU    48000
  27. TEMPO2        EQU    42000
  28. TEMPO3        EQU    40000
  29. TEMPO4        EQU    40000
  30. TEMPO5        EQU    30000
  31. TEMPO6        EQU    40000
  32. NUMSONGS    EQU    6
  33. SAMPLELEN    EQU    32
  34. BEETLEN     EQU    (124*10)*4
  35. BACHLEN        EQU    (124*10)*4
  36. SCARLEN        EQU    (108*10)*4
  37. LARLEN        EQU    (96*10)*4
  38. RSUNLEN        EQU    (192*10)*4 ;9680 (192beats*10pairs/beat)*4bytes/pair
  39. TEARLEN        EQU    (128*10)*4
  40. *
  41. * define our general data memory offsets
  42. *
  43. DDEF    MACRO    ;name,size
  44. \1    EQU    stemp
  45. stemp    SET    stemp+\2
  46.     ENDM
  47. *
  48. stemp    SET    0            ;for DDEF macro
  49.     DDEF    IntuitionBase,4        ;to hold a pointer
  50.     DDEF    GfxBase,4        ;to hold a pointer
  51.     DDEF    Screen,4        ;to hold a pointer
  52.     DDEF    Window,4        ;to hold a pointer
  53.     DDEF    NewPointer,12        ;used for an empty sprite structure
  54.     DDEF    MyScrn,NewScreen.SIZE    ;we'll build a NewScreen here
  55.     DDEF    MyWin,NewWindow.SIZE    ;and a NewWindow here
  56.     DDEF    Tempo,2            ;runtime copy of Tempo in use
  57.     DDEF    CurSong,2        ;becomes an array index
  58.     DDEF    seed,4            ;random number seed goes here
  59.     DDEF    NewX,4            ;vars for screen fill routine
  60.     DDEF    NewY,4
  61.     DDEF    NewH,4
  62.     DDEF    NewV,4
  63.     DDEF    NewF,4
  64.     DDEF    NewB,4
  65.     DDEF    WBenchMsg,4        ;saved from startup
  66.     DDEF    FMAudio,IOAudio.SIZE    ;build an IOAudio struct here
  67.     DDEF    BodyIText,IntuiText.SIZE ;and a couple IntuiText structs
  68.     DDEF    PosIText,IntuiText.SIZE
  69.     DDEF    Note1,SAMPLELEN        ;our waveform gets copied here
  70.     DDEF    Data0,RSUNLEN*2        ;twice the size of the LARGEST one
  71. ChipSize    EQU    stemp
  72.     IFGE    ChipSize-32768        ;make sure we don't exceed signed
  73.     FAIL    "DataSize too Large"    ;limits for addressing mode used
  74.     ENDC
  75. *
  76. *-------------------------------------------------------------------------
  77. * This is our startup initialization and main program loop
  78. *-------------------------------------------------------------------------
  79. *
  80. Strt:    movem.l    a2-a6/d2-d7,-(sp) ;save the regs in case someone calls us
  81.     movea.l    4,A6            ;good ole execbase
  82.     move.l    #ChipSize,d0        ;size defined by the DDEF macros
  83.     move.l    #MEMF_CHIP!MEMF_CLEAR,d1 ;put it in chip for the audio stuff
  84.     jsr    AllocMem(A6)        ;but do it all so we only need one
  85.     movea.l    d0,BR            ;data area for baseregister addressing
  86.     tst.l    d0
  87.     bne.s    10$
  88.     moveq    #103,d0            ;insufficient free store error code
  89.     bra    999$
  90. 10$:    movea.l    ExecBase.ThisTask(a6),a2 ;our task address
  91.     tst.l    Process.pr_CLI(a2)    ;see if we came from a CLI
  92.     bne.s    40$
  93.     lea    Process.pr_MsgPort(a2),a0 ;else get the WorkBench message
  94.     jsr    WaitPort(a6)        ;so we can reply it later
  95.     lea    Process.pr_MsgPort(a2),a0 ;or else we'll eat memory
  96.     jsr    GetMsg(a6)        ;as WorkBench won't unload us
  97.     move.l    d0,WBenchMsg(BR)    ;if we don't reply
  98. 40$:    lea    CUSTOM,CST        ;for the hardware hacking
  99.     lea    IntuitionName(pc),a1    ;open needed libs
  100.     moveq    #33,d0            ;version 33
  101.     jsr    OpenLibrary(a6)
  102.     move.l    d0,IntuitionBase(BR)
  103.     beq    980$            ;handle unlikely failure
  104.     lea    GfxName(pc),a1
  105.     moveq    #33,d0
  106.     jsr    OpenLibrary(a6)
  107.     move.l    d0,GfxBase(BR)
  108.     beq    980$            ;handle unlikely failure
  109.     bsr    ScrnSet            ;this routine initializes the screen
  110.     beq    900$
  111.     bsr    HogAudio        ;this allocates all the audio chans
  112.     tst.l    d0            ;so we can hack on the hardware
  113.     bne    900$
  114.     lea    wavedata(pc),a0        ;build a waveform in chip ram
  115.     lea    Note1(BR),a1
  116.     moveq    #(SAMPLELEN/2)-1,d1    ;samples in note
  117. 70$:    move.b    (a0)+,d0
  118.     move.b    d0,(a1)+        ;copy of first half
  119.     neg.b    d0            ;second half is mirror image
  120.     move.b    d0,((SAMPLELEN/2)-1)(a1) ;we preincremented this!
  121.     dbra    d1,70$
  122.     bsr    NewSong            ;start the music
  123. 100$:    bsr    ColorOne        ;draw a pretty square
  124.     movea.l    Window.UserPort(WN),a0    ;and see if we have any key-presses
  125.     jsr    GetMsg(a6)
  126.     tst.l    d0
  127.     beq.s    100$            ;nada, reloop
  128.     movea.l    d0,a1
  129.     move.l    IntuiMessage.Code(a1),d2 ;stash Code & Qualifier
  130.     jsr    ReplyMsg(a6)
  131.     andi.b    #$3f,d2        ;LSHIFT!RSHIFT!CAPSLOCK!CONTROL!LALT!RALT
  132.     bne.s    100$        ;if any of above, reject 'em
  133.     swap    d2        ;we got two words with one long read
  134.     cmpi.b    #$45,d2        ;ESC raw keycode
  135.     beq.s    200$
  136.     cmpi.b    #$4c,d2        ;UP ARROW raw keycode
  137.     bne.s    120$
  138.     move.w    Tempo(BR),d2    ;to go faster, we make the period smaller
  139.     cmpi.w    #5000,d2    ;but let's not get too small
  140.     bls    100$
  141.     sub.w    #400,d2        ;a handy step size
  142.     move.w    d2,Tempo(BR)
  143.     jsr    Disable(a6)    ;so the next 2 instructions aren't apart
  144.     move.w    d2,AUD0PER(CST)    ;note here the order.. when we step the
  145.     move.w    d2,AUD2PER(CST)    ;other way, we'll reverse this order
  146.     jsr    Enable(a6)    ;restore normal state
  147.     bra    100$
  148. 120$:    cmpi.b    #$4d,d2        ;DOWN ARROW raw keycode
  149.     bne.s    130$
  150.     move.w    Tempo(BR),d2
  151.     cmpi.w    #65000,d2    ;we can't get larger than 64K
  152.     bhi    100$
  153.     add.w    #400,d2
  154.     move.w    d2,Tempo(BR)
  155.     jsr    Disable(a6)    ;the order is changed because the audio
  156.     move.w    d2,AUD2PER(CST)    ;state machine will keep going and we can't
  157.     move.w    d2,AUD0PER(CST)    ;actually write both at once. This way we
  158.     jsr    Enable(a6)    ;will erase the small accumulated error.
  159.     bra    100$
  160. 130$:    cmpi.b    #$5f,d2        ;HELP raw keycode
  161.     bne.s    150$
  162.     bsr    DoRequest    ;routine to pop up our Auto Requester
  163.     bra    100$
  164. 150$:    cmpi.b    #$50,d2        ;F1 raw keycode
  165.     bne    100$
  166.     bsr    musoff    ;stop the old song
  167.     bsr    Slower    ;make sure audio stays shut off a while so it won't
  168.     bsr    NewSong    ;restart at the same location it was at.
  169.     bra    100$
  170. 200$:    bsr    musoff
  171.     bsr    ShareAudio    ;return the resources
  172. 900$:    movea.l    IntuitionBase(BR),a6    ;close the window
  173.     move.l    Window(BR),d0
  174.     beq.s    910$
  175.     movea.l    d0,a0
  176.     jsr    CloseWindow(a6)
  177. 910$:    move.l    Screen(BR),d0        ;and the screen
  178.     beq.s    980$
  179.     movea.l    d0,a0
  180.     jsr    CloseScreen(a6)
  181. 980$:    movea.l    4,a6            ;and the libraries we opened
  182.     move.l    IntuitionBase(BR),d0
  183.     beq.s    990$
  184.     movea.l    d0,a1
  185.     jsr    CloseLibrary(a6)
  186.     move.l    GfxBase(BR),d0
  187.     beq.s    990$
  188.     movea.l    d0,a1
  189.     jsr    CloseLibrary(a6)
  190. 990$:    move.l    WBenchMsg(BR),d2    ;if we came from WorkBench
  191.     beq.s    995$            ;we need to reply our startup msg
  192.     jsr    Forbid(a6)        ;so we don't get unloaded early
  193.     movea.l    d2,a1
  194.     jsr    ReplyMsg(a6)
  195. 995$:    movea.l BR,a1        ;return the memory to the system
  196.     move.l    #ChipSize,d0
  197.     jsr    FreeMem(A6)
  198.     moveq    #0,d0
  199. 999$:    movem.l    (sp)+,a2-a6/d2-d7    ;restore the saved registers
  200.     rts            ;this send us back to our caller
  201. *
  202. *------------------------------------------------------------------------
  203. * This routine is based on code developed by Erik Quackenbush. I just
  204. * shamelessly expropriated it for my own use, by permission. Thanks, Erik.
  205. * It uses a dithering pattern to get many effective colors out of a 3 plane
  206. * (8-color) screen.
  207. *------------------------------------------------------------------------
  208. *
  209. MyFlags    EQU    BORDERLESS!BACKDROP!ACTIVATE!SMART_REFRESH!NOCAREREFRESH
  210. ColorOne:
  211.     movem.l    a6/d2-d3,-(sp)    ;save the regs we use
  212.     movea.l    GfxBase(BR),a6    ;we need this here
  213.     bsr    Rand        ;get a new number
  214.     move.l    d0,d1        ;here we chop it up into the pieces we
  215.     andi.l    #7,d0        ;will need later
  216.     move.l    d0,NewF(BR)
  217.     lsr.l    #3,d1
  218.     move.l    d1,d0
  219.     andi.l    #7,d0
  220.     move.l    d0,NewB(BR)
  221.     lsr.l    #3,d1
  222.     move.l    d1,d0
  223.     andi.l    #127,d0
  224.     move.l    d0,NewH(BR)
  225.     lsr.l    #7,d1
  226.     move.l    d1,d0
  227.     andi.l    #127,d0
  228.     move.l    d0,NewV(BR)
  229.     lsr.l    #7,d1
  230.     move.l    d1,d0
  231.     andi.l    #1023,d0
  232.     subi.l    #200,d0
  233.     move.l    d0,NewX(BR)
  234.     move.l    NewF(BR),d0
  235.     add.l    NewB(BR),d0
  236.     move.l    seed(BR),d1
  237.     lsr.l    d0,d1
  238.     andi.l    #511,d1
  239.     subi.l    #75,d1
  240.     move.l    d1,NewY(BR)
  241.     movea.l    Window.RPort(WN),a1
  242.     move.l    NewF(BR),d0
  243.     jsr    SetAPen(a6)        ;set a new Front Pen color
  244.     movea.l    Window.RPort(WN),a1
  245.     move.l    NewB(BR),d0
  246.     jsr    SetBPen(a6)        ;and a new Back Pen color
  247.     movea.l    Window.RPort(WN),a1
  248.     move.l    NewX(BR),d0
  249.     move.l    NewY(BR),d1
  250.     move.l    d0,d2
  251.     add.l    NewH(BR),d2
  252.     move.l    d1,d3
  253.     add.l    NewV(BR),d3
  254.     jsr    RectFill(a6)        ;this does the coloring for us
  255.     movem.l    (sp)+,a6/d2-d3
  256.     rts
  257. *
  258. *---------------------------------------------------------------------------
  259. * This routine opens the screen and window. If it returns a zero (NULL)
  260. * the calling code will know that we had a failure to open one or the
  261. * other. The cleanup code will only close what was opened, so all resources
  262. * will get returned even if only the OpenWindow fails. In order to stay
  263. * pure, we initialize everything on the fly here, and some of the word sized
  264. * fields that are adjacent get initialized as a single longword write.
  265. *---------------------------------------------------------------------------
  266. *
  267. ScrnSet:
  268.     movem.l    a6/d2-d3,-(sp)
  269.     lea    MyScrn(BR),a0
  270.     move.l    #(640<<16)!400,NewScreen.Width(a0)
  271.     move.l    #(3<<16)!1,NewScreen.Depth(a0)
  272.     move.l    #((HIRES!LACE)<<16)!CUSTOMSCREEN,NewScreen.ViewModes(a0)
  273.     lea    furname(pc),a1
  274.     move.l    a1,NewScreen.DefaultTitle(a0)
  275.     movea.l    IntuitionBase(BR),a6
  276.     jsr    OpenScreen(A6)
  277.     move.l    d0,Screen(BR)        ;sets flags
  278.     beq    999$            ;a failure if zero
  279.     lea    MyWin(BR),a0
  280.     move.l    d0,NewWindow.Screen(a0)
  281.     move.l    #(640<<16)!400,NewWindow.Width(a0)
  282.     move.b    #1,NewWindow.DetailPen(a0)
  283.     move.l    #RAWKEY,NewWindow.IDCMPFlags(a0)
  284.     move.l    #MyFlags,NewWindow.Flags(a0)
  285.     move.l    #(256<<16)!20,NewWindow.MinWidth(a0)
  286.     move.l    #(640<<16)!400,NewWindow.MaxWidth(a0)
  287.     move.w    #CUSTOMSCREEN,NewWindow.Type(a0)
  288.     jsr    OpenWindow(a6)
  289.     move.l    d0,Window(BR)        ;sets flags
  290.     beq.s    999$            ;a failure if zero
  291.     movea.l    d0,WN            ;Window
  292.     movea.l    WN,a0
  293.     lea    NewPointer(BR),a1
  294.     moveq    #1,d0
  295.     moveq    #16,d1
  296.     moveq    #0,d2
  297.     move.l    #0,d3
  298.     jsr    SetPointer(a6)        ;sets an invisible pointer up
  299.     movea.l    Window.RPort(WN),a1    ;this is the same as the
  300.     lea    pattern(pc),a0        ;SetAfPt macro
  301.     move.l    a0,RastPort.AreaPtrn(a1)
  302.     move.b    #1,RastPort.AreaPtSz(a1)
  303.     movea.l    WN,a0
  304.     jsr    ViewPortAddress(a6)
  305.     movea.l    d0,a0
  306.     lea    palette(pc),a1
  307.     moveq    #8,d0
  308.     movea.l    GfxBase(BR),a6
  309.     jsr    LoadRGB4(a6)        ;our colors
  310.     moveq    #1,d0            ;flag set! shows we were successful
  311. 999$:    movem.l    (sp)+,a6/d2-d3        ;don't disturb the flags here
  312.     rts
  313. *
  314. *--------------------------------------------------------------------------
  315. * The next routine initializes an IOAudio structure and uses it to
  316. * allocate all 4 audio channels for us. It returns NON-ZERO if we failed
  317. * to get all 4 channels. Once we have allocated all the channels, we can
  318. * ignore the audio.device and bang on the hardware registers ourselves
  319. * for our own magic stuff.
  320. *--------------------------------------------------------------------------
  321. *
  322. HogAudio:            ;Err:D0 = HogAudio(execBase:A6)
  323.     lea    FMAudio(BR),a1
  324.     lea    AllUnits(pc),a0
  325.     move.l    a0,IOAudio.ioa_Data(a1)    ;allocation map
  326.     moveq    #1,d0            ;map size
  327.     move.l    d0,IOAudio.ioa_Length(a1)
  328.     move.b    #127,Node.ln_Pri(a1)    ;full priority.. no stealing!
  329.     move.w    #ADCMD_ALLOCATE,IORequest.io_Command(a1)
  330.     move.b    #ADIOF_NOWAIT,IORequest.io_Flags(a1)
  331.     lea    AudName(pc),a0        ;devname
  332.     moveq    #0,d0            ;unit
  333.     moveq    #0,d1            ;flags
  334.     jmp    OpenDevice(a6)        ;this will rts for us
  335. *
  336. *--------------------------------------------------------------------------
  337. * Pretty simple, just closes the device. Just be sure not to call this
  338. * if the open wasn't successful.
  339. *--------------------------------------------------------------------------
  340. *
  341. ShareAudio:
  342.     lea    FMAudio(BR),a1
  343.     jmp    CloseDevice(a6)        ;this will rts for us
  344. *
  345. *--------------------------------------------------------------------------
  346. * A quick and dirty pseudo-random number generator.
  347. *--------------------------------------------------------------------------
  348. *
  349. Rand:    move.l    seed(BR),d0    ;get the old seed
  350.     add.l    d0,d0        ;double it
  351.     bhi.s    999$        ;branch if no carry OR not zero
  352.     eori.l    #$2de1ad29,d0    ;somewhat random bits flipped
  353. 999$:    move.l    d0,seed(BR)    ;save the new value as the next seed
  354.     rts
  355. *
  356. *--------------------------------------------------------------------------
  357. * This initializes and pops up an Auto Requester, giving information about
  358. * the program usage. In order to stay pure, all the initialization of the
  359. * IntuiText structures is done on the fly here.
  360. *--------------------------------------------------------------------------
  361. *
  362. DoRequest:
  363.     movem.l    a2-a3/a6/d2-d3,-(sp)
  364.     lea    BodyIText(BR),a1
  365.     lea    BodyText(pc),a0
  366.     move.l    a0,IntuiText.IText(a1)
  367.     lea    PosIText(BR),a2
  368.     movea.l    a2,a3
  369.     lea    PosText(pc),a0
  370.     move.l    a0,IntuiText.IText(a2)
  371.     moveq    #2,d0
  372.     move.b    d0,IntuiText.FrontPen(a1)
  373.     move.b    d0,IntuiText.FrontPen(a2)
  374.     move.b    d0,IntuiText.FrontPen(a3)
  375.     moveq    #4,d0
  376.     move.w    d0,IntuiText.LeftEdge(a2)
  377.     move.w    d0,IntuiText.LeftEdge(a3)
  378.     move.w    d0,IntuiText.TopEdge(a2)
  379.     move.w    d0,IntuiText.TopEdge(a3)
  380.     moveq    #10,d0
  381.     move.w    d0,IntuiText.LeftEdge(a1)
  382.     move.w    d0,IntuiText.TopEdge(a1)
  383.     movea.l    WN,a0
  384.     moveq    #0,d0
  385.     move.l    d0,d1
  386.     move.w    #640,d2            ;width
  387.     moveq    #66,d3            ;height
  388.     movea.l    IntuitionBase(BR),a6
  389.     jsr    AutoRequest(a6)        ;won't return until 'OK' is clicked
  390.     movem.l    (sp)+,a2-a3/a6/d2-d3
  391.     rts
  392. *
  393. *--------------------------------------------------------------------------
  394. * This routine is here merely to ensure that more than two cycle times for
  395. * the audio channels passes so that when we restart we will be starting at
  396. * the beginning instead of part way through a previous song. This would be
  397. * bad if the new song was shorter than the old one was.
  398. *--------------------------------------------------------------------------
  399. *
  400. Slower    move.l    a6,-(sp)
  401.     movea.l    GfxBase(BR),a6
  402.     jsr    WaitTOF(a6)    ;waits for the next VBlank interval
  403.     jsr    WaitTOF(a6)    ;twice to be sure of one whole frame time
  404.     movea.l    (sp)+,a6
  405.     rts
  406. *
  407. *-----------------------------------------------------------------------
  408. * This is the workhorse that builds the sequence tables that will be used
  409. * by audio channels 0 and 2 (which we will set up to control channels
  410. * 1 and 3). These table will become pairs of words alternating volume
  411. * and period. The volume is computed by steadily decreasing the initial
  412. * value used, while the period comes from a table which was indexed by
  413. * a note number in the lower nibble of the song table. The upper nibble
  414. * is the number of 'beats' for this note. The routine executes the code
  415. * twice, once to build the right channels, and the second for the left.
  416. *-----------------------------------------------------------------------
  417. *
  418. buildtab:        ;newbuff:a1 = buildtab(nibtab:a0, buff:a1)
  419.     movem.l    a2/d2-d5,-(sp)
  420.     lea    note_table(pc),a2    ;used for the whole routine
  421.     moveq    #0,d1        ;controls the execution path for left
  422. 10$:    move.b    (a0)+,d2    ;null-term tables for each side
  423.     beq.s    990$
  424.     moveq    #64,d5        ;full volume for right
  425.     tst.w    d1
  426.     beq.s    12$
  427.     moveq    #44,d5        ;a little softer for the accompaniement
  428. 12$:    move.b    d2,d3
  429.     lsr.b    #4,d3        ;upper nibble to lower nibble
  430.     ext.w    d3        ;zeroes upper byte of word
  431.     mulu    #10,d3        ;times ten gives beats for this note
  432.     andi.w    #15,d2        ;extract lower nibble
  433.     add.w    d2,d2        ;time 2 for word sized table
  434.     move.w    0(a2,d2.w),d4    ;get the period from the table
  435.     bne.s    20$
  436.     moveq    #0,d5        ;silence indicated by note nibble of zero
  437.     moveq    #127,d4        ;some period needed for audio chip
  438. 20$:    cmpi.w    #1,d3        ;make the last sample always a lower volume
  439.     bne.s    25$        ;to provide some wave shaping
  440.     lsr.w    #1,d5        ;by cutting it in half
  441. 25$:    move.w    d5,(a1)+    ;write the volume
  442.     beq.s    30$        ;never go below zero
  443.     subq.w    #1,d5        ;volume decremented here
  444. 30$:    move.w    d4,d0        ;retreive the period we got
  445.     tst.b    d1        ;for left half we use a lower octave
  446.     beq.s    40$
  447.     add.w    d0,d0        ;which we get by doubling the period here
  448. 40$:    move.w    d0,(a1)+    ;we write the period
  449.     subq.w    #1,d3        ;reduce the count
  450.     bne.s    20$        ;needs more beats to complete this note
  451.     bra.s    10$        ;else do next note
  452. 990$:    tst.w    d1
  453.     bne.s    999$        ;if nonzero we did two sides
  454.     moveq    #1,d1        ;otherwise, make nonzero and reloop
  455.     bra.s    10$
  456. 999$:    movem.l    (sp)+,a2/d2-d5
  457.     rts
  458. *
  459. *-------------------------------------------------------------------------
  460. * This builds a table for the next song, wrapping from the last song back
  461. * to the first one. When initially called, the song number is zero, and we
  462. * start out on song number one. Thereafter, every time it is called it
  463. * increments the current song.
  464. *-------------------------------------------------------------------------
  465. *
  466. NewSong:
  467.     move.l    d2,-(sp)
  468.     move.w    CurSong(BR),d2    ;get former song number
  469.     addq.w    #1,d2        ;and bump it up one
  470.     cmpi.w    #NUMSONGS,d2    ;check our limits
  471.     bls.s    10$
  472.     moveq    #1,d2        ;wrap back to the first one after the last
  473. 10$:    move.w    d2,CurSong(BR)    ;save computed number
  474.     add.w    d2,d2        ;double it.. we're using word-sized tables
  475.     lea    TempoTab(pc),a0
  476.     move.w    -2(a0,d2.w),Tempo(BR) ;lets us have element 1 in slot 0
  477.     lea    Data0(BR),a1    ;our buffer (in chip ram!)
  478.     lea    SongTab(pc),a0    ;some address arithmetic
  479.     adda.w    -2(a0,d2.w),a0
  480.     bsr    buildtab    ;build the table
  481.     lea    LenTab(pc),a0    ;lookup the length
  482.     move.w    -2(a0,d2.w),d1
  483.     bsr.s    muson        ;start (or restart) the music
  484.     move.l    (sp)+,d2
  485.     rts
  486. *
  487. *------------------------------------------------------------------------
  488. * Way down here is where we write to the hardware registers. What we will
  489. * do is attach channels 0 and 2 to channels 1 and 3 for period and volume.
  490. * This pairing makes one channel write the volume and period alternately
  491. * to the next numbered channel. Channels 1 and 3 always play the same
  492. * waveform, but by being controlled by channels 0 and 2 the actual pitch
  493. * and volume vary depending on the data used by channels 0 and 2. This data
  494. * came from the buildtab() routine, which expanded the compressed stuff
  495. * in the nibbleized song tables.
  496. *------------------------------------------------------------------------
  497. *
  498. muson:                ;muson(LEN:D1)
  499.     lea    Data0(BR),a0    ;the chip ram buffer we used
  500.     move.l    a0,AUD0LC(CST)    ;right table starts at the start
  501.     adda.w    d1,a0        ;while the left table is right after it
  502.     move.l    a0,AUD2LC(CST)
  503.     lsr.w    #1,d1        ;half for len_in_words (chip requirement)
  504.     move.w    d1,AUD0LEN(CST)    ;set length to channels
  505.     move.w    d1,AUD2LEN(CST)
  506.     move.w    Tempo(BR),d0    ;speed for our particular song
  507.     move.w    d0,AUD0PER(CST)
  508.     move.w    d0,AUD2PER(CST)
  509.     lea    Note1(BR),a0    ;the modified sine wave we used
  510.     move.l    a0,AUD1LC(CST)    ;initialize registers
  511.     move.l    a0,AUD3LC(CST)
  512.     moveq    #SAMPLELEN/2,d0    ;half for len_in_words (chip requirement)
  513.     move.w    d0,AUD1LEN(CST)    ;length of wave data to chip registers
  514.     move.w    d0,AUD3LEN(CST)
  515.     move.w    #MSET!ATVOL0!ATPER0!ATVOL2!ATPER2,ADKCONW(CST) ;attach stuff
  516.     move.w    #MSET!DMAEN!AUD3EN!AUD2EN!AUD1EN!AUD0EN,DMACONW(CST) ;Play it!
  517.     rts
  518. *
  519. *--------------------------------------------------------------------------
  520. * This just shuts the sound channels off and unattaches them from each
  521. * other, to restore things to more or less normal.
  522. *--------------------------------------------------------------------------
  523. *
  524. musoff:    move.w    #CLEAR!AUD3EN!AUD2EN!AUD1EN!AUD0EN,DMACONW(CST) ;sound off
  525.     move.w    #CLEAR!ATVOL0!ATPER0!ATVOL2!ATPER2,ADKCONW(CST) ;unattach
  526.     rts
  527. *
  528. *--------------------------------------------------------------------------
  529. * From here on are all static data tables used by various of the routines.
  530. *--------------------------------------------------------------------------
  531. *
  532. *--------------------------------------------------------------------------
  533. * The addresses of these two arrays are passed to the graphics routines.
  534. *--------------------------------------------------------------------------
  535. *
  536. palette    DC.W    $888,$111,$f11,$1f1,$11f,$ff1,$f1f,$1ff
  537. pattern    DC.L    $AAAA5555
  538. *
  539. *--------------------------------------------------------------------------
  540. * The wave was computed by creating a sine wave, and adding 10% third
  541. * harmonic and 1% fifth harmonic content. Only the positive half of the
  542. * wave form is here, the negative half is computed at the time we copy
  543. * this data to the chip ram area.
  544. *--------------------------------------------------------------------------
  545. *
  546. wavedata
  547.     DC.B    0,32,61,84,98,106,112,114,115,114,112,106,98,84,61,32
  548. *
  549. *--------------------------------------------------------------------------
  550. * This table is the lookup for each note's proper period value. We shift
  551. * this value left once to double the duration for a lower octave when we
  552. * are building the left channel (accompaniement voice).
  553. *--------------------------------------------------------------------------
  554. *
  555. note_table
  556.     DC.W    0    ;dummy note = silence
  557.     DC.W    285    ;G  1
  558.     DC.W    269    ;G# 2
  559.     DC.W    254    ;A  3
  560.     DC.W    240    ;A# 4
  561.     DC.W    226    ;B  5
  562.     DC.W    214    ;C  6
  563.     DC.W    202    ;C# 7
  564.     DC.W    190    ;D  8
  565.     DC.W    180    ;D# 9
  566.     DC.W    170    ;E  A
  567.     DC.W    160    ;F  B
  568.     DC.W    151    ;F# C
  569.     DC.W    144    ;G  D
  570.     DC.W    135    ;G# E
  571.     DC.W    127    ;A  F
  572. *
  573. *--------------------------------------------------------------------------
  574. * These lengths are used in address arithmetic to split the larger buffer
  575. * into two halves and to calculate the correct length for the chip regs.
  576. *--------------------------------------------------------------------------
  577. *
  578. LenTab:    DC.W    BEETLEN
  579.     DC.W    BACHLEN
  580.     DC.W    SCARLEN
  581.     DC.W    LARLEN
  582.     DC.W    RSUNLEN
  583.     DC.W    TEARLEN
  584. *
  585. *--------------------------------------------------------------------------
  586. * These are the default speeds for each song.
  587. *--------------------------------------------------------------------------
  588. *
  589. TempoTab:
  590.     DC.W    TEMPO1
  591.     DC.W    TEMPO2
  592.     DC.W    TEMPO3
  593.     DC.W    TEMPO4
  594.     DC.W    TEMPO5
  595.     DC.W    TEMPO6
  596. *
  597. *--------------------------------------------------------------------------
  598. * The address of the base of this table plus the difference stored at the
  599. * proper offset gives us the start of the proper nibble table.
  600. *--------------------------------------------------------------------------
  601. *
  602. SongTab    DC.W    beettab-SongTab
  603.     DC.W    bachtab-SongTab
  604.     DC.W    scbftab-SongTab
  605.     DC.W    lrdotab-SongTab
  606.     DC.W    rsuntab-SongTab
  607.     DC.W    teartab-SongTab
  608. *
  609. *-------------------------------------------------------------------------
  610. * This is where data for the actual songs is stored. It is compressed into
  611. * bytes containing packed nibbles of duration:note. A note nibble of zero
  612. * means silence, while the number in the duration is the number of beats
  613. * each note is to play. Each beat will be multiplied by 10 samples when
  614. * the sequences are used. Each song's data here is the right channel first,
  615. * with a null byte marking the end, followed by the left channel, which is
  616. * also null-terminated. It is important that the two halves contain the
  617. * same number of beats. The number of beats in one side is counted and is
  618. * used 'way up top to calculate the length needed for each song. The memory
  619. * required is calculated from the largest song in these tables. For proper
  620. * operation, this part should be right after the SongTab table.
  621. *-------------------------------------------------------------------------
  622. *
  623. beettab    DC.B    $1A,$19,$1A,$19,$1A,$15,$18,$16,$63,$65,$46        ;24
  624.     DC.B    $1A,$19,$1A,$19,$1A,$15,$18,$16,$63,$45,$16,$15,$43    ;24
  625.     DC.B    $1A,$19,$1A,$19,$1A,$15,$18,$16,$63,$65,$46        ;24
  626.     DC.B    $1A,$19,$1A,$19,$1A,$15,$18,$16,$63,$45,$16,$15,$43     ;24
  627.     DC.B    $18,$16,$18,$4A,$1B,$1A,$48,$1A,$18,$46,$18,$16,$75,0    ;28
  628.     DC.B    $A0,$13,$16,$2A,$20,$15,$1A,$2D,$20,$16,$1A        ;24
  629.     DC.B    $A0,$13,$16,$2A,$20,$15,$1A,$2D,$46            ;24
  630.     DC.B    $A0,$13,$16,$2A,$20,$15,$1A,$2D,$20,$16,$1A        ;24
  631.     DC.B    $A0,$13,$16,$2A,$20,$15,$1A,$2D,$46            ;24
  632.     DC.B    $50,$13,$16,$40,$1D,$15,$40,$1A,$1D,$40,$1A,$2E,$20,0    ;28
  633. bachtab    DC.B    $1D,$11,$13,$15,$18,$16,$16,$1A,$18,$18,$1D,$1C
  634.     DC.B    $1D,$18,$15,$11,$13,$15,$16,$18,$1A,$18,$16,$15
  635.     DC.B    $13,$15,$13,$13,$15,$18                    ;30
  636.     DC.B    $1D,$11,$13,$15,$18,$16,$16,$1A,$18,$18,$1D,$1C
  637.     DC.B    $1D,$18,$15,$11,$13,$25,$1A,$18,$16,$15,$13
  638.     DC.B    $13,$11,$13,$31                        ;30
  639.     DC.B    $65,$36,$38,$31,$38,$36,$35,$63                ;30
  640.     DC.B    $1D,$11,$13,$15,$18,$16,$16,$1A,$18,$18,$1D,$1C
  641.     DC.B    $1D,$18,$15,$11,$13,$25,$1A,$18,$16,$15,$13
  642.     DC.B    $11,$15,$18,$7D,0                    ;34
  643.     DC.B    $30,$31,$3A,$38,$31,$35,$36,$38,$33,$33            ;30
  644.     DC.B    $38,$31,$3A,$38,$31,$35,$36,$35,$33,$31            ;30
  645.     DC.B    $65,$3A,$33,$35,$38,$36,$35,$63                ;30
  646.     DC.B    $38,$31,$3A,$38,$31,$35,$36,$35,$38,$71,0        ;34
  647. scbftab    DC.B    $33,$33,$2A,$2A,$2A,$25,$26,$25,$93            ;27
  648.     DC.B    $3A,$3D,$4F,$2D,$2A,$2C,$2A,$6A,$3F            ;27
  649.     DC.B    $3F,$3F,$2D,$2A,$2A,$2A,$28,$26,$28,$75            ;27
  650.     DC.B    $33,$3A,$38,$36,$25,$23,$21,$93,0            ;27
  651.     DC.B    $63,$61,$6A,$93,$66,$68,$6A,$9A
  652.     DC.B    $63,$61,$6B,$9A,$63,$61,$6A,$93,0            ;120
  653. lrdotab    DC.B    $2d,$2d,$2b,$2a,$2b,$2d,$2b,$2a,$28,$26,$25,$31        ;25
  654.     DC.B    $11,$26,$26,$26,$28,$2a,$2b,$2a,$28,$26,$48        ;23
  655.     DC.B    $2d,$2d,$2b,$2a,$2b,$2d,$2b,$2a,$28,$26,$25,$31        ;25
  656.     DC.B    $11,$26,$26,$26,$28,$2a,$2b,$2a,$26,$26,$46,0        ;23
  657.     DC.B    $20,$66,$6f,$66,$61,$66,$61,$66,$61
  658.     DC.B    $66,$6b,$66,$61,$66,$61,$66,$46,0            ;96
  659. rsuntab    DC.B    $30,$33,$93,$33,$96,$3a,$98,$23,$13,$96            ;51
  660.     DC.B    $3f,$9f,$3f,$9d,$2a,$18,$aa,$b0                ;48
  661.     DC.B    $2f,$1f,$9f,$3f,$2d,$7a,$38,$2a,$53,$23,$33,$96        ;48
  662.     DC.B    $33,$93,$33,$91,$33,$a3,$80,0                ;45
  663.     DC.B    $2a,$25,$22,$23,$26,$2A,$2f,$2A,$26        ;18 E,Am
  664.     DC.B    $26,$2a,$2d,$26,$2a,$2d                ;12 C
  665.     DC.B    $28,$2c,$2f,$28,$2f,$2c                ;12 D
  666.     DC.B    $2b,$23,$26,$2b,$26,$23                ;12 F
  667.     DC.B    $23,$26,$2A,$2f,$2A,$26                ;12 Am
  668.     DC.B    $26,$2a,$2d,$26,$2a,$2d                ;12 C
  669.     DC.B    $2a,$22,$25,$2a,$25,$22                ;12 E
  670.     DC.B    $2a,$22,$25,$2a,$25,$22                ;12 E
  671.     DC.B    $23,$26,$2A,$2f,$2A,$26                ;12 Am
  672.     DC.B    $26,$2a,$2d,$26,$2a,$2d                ;12 C
  673.     DC.B    $28,$2c,$2f,$28,$2f,$2c                ;12 D
  674.     DC.B    $2b,$23,$26,$2b,$26,$23                ;12 F
  675.     DC.B    $23,$26,$2A,$2f,$2A,$26                ;12 Am
  676.     DC.B    $2a,$22,$25,$2a,$25,$22                ;12 E
  677.     DC.B    $23,$26,$2A,$2f,$2A,$26                ;12 Am
  678.     DC.B    $2a,$22,$25,0                    ;6  E
  679. teartab    DC.B    $20,$26,$28,$2a,$28,$28,$23,$26,$56,$13,$26,$a5        ;34
  680.     DC.B    $26,$28,$2a,$28,$28,$23,$26,$56,$13,$26,$a5        ;32
  681.     DC.B    $1b,$1b,$2b,$2a,$28,$28,$26,$48,$2a,$2a,$28,$26,$83    ;32
  682.     DC.B    $2f,$2f,$2f,$3f,$13,$25,$26,$58,$16,$18,$16,$85,0    ;30
  683.     DC.B    $46,$46,$48,$48,$4b,$4b,$4d,$4b                ;32
  684.     DC.B    $46,$46,$48,$48,$4b,$4b,$4d,$4b                ;32
  685.     DC.B    $4b,$4b,$4d,$4d,$46,$46,$43,$43                ;32
  686.     DC.B    $4b,$4b,$4b,$4b,$41,$41,$4d,$4b,0            ;32
  687. *
  688. *---------------------------------------------------------------------------
  689. * These are just strings for some of the routines.
  690. *---------------------------------------------------------------------------
  691. *
  692. furname        CSTRING    '  FurLess by Wesley Howe  '
  693. AudName        CSTRING 'audio.device'
  694. IntuitionName    CSTRING    'intuition.library'
  695. GfxName        CSTRING    'graphics.library'
  696. BodyText    CSTRING    ' ESC=QUIT, F1=Song, UP/DOWN=Chg Tempo'
  697. PosText        CSTRING    'OK'
  698. *
  699. *---------------------------------------------------------------------------
  700. * This is the allocation map for all four audio channelsthat we used to
  701. * indicate we wanted all the channels when we opened the audio.device.
  702. *---------------------------------------------------------------------------
  703. AllUnits    DC.B    $0f
  704.         DS.W    0
  705. *
  706.         END    ;and that's all, folks!
  707. *
  708.