home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 366.lha / Tetris / src / tetris.s < prev    next >
Encoding:
Text File  |  1990-04-10  |  40.1 KB  |  1,628 lines
  1. ;-----------------------------------------------------------------------------
  2. ; Tetris © Copyright 1990 Software Alchemy of Anselm Hook All Rights Reserved
  3. ; V1.0 18-jan-89 Code generated by Anselm Hook using CED, Aztek and Transform
  4. ;-----------------------------------------------------------------------------
  5.  
  6.     include    'tetris.i'
  7.  
  8.     public    _main            ; workbench support!
  9.     public    AmigaJunk
  10.  
  11. ;***************************************************************************
  12. ;***************************************************************************
  13. ;***************************************************************************
  14. ;***************************************************************************
  15. ;*
  16. ;*    This Amiga Port of Tetris is a public domain program which I am
  17. ;*    releasing in source code format as a tutorial on assembly
  18. ;*    language programming.  It is moderately accurate to the original
  19. ;*    product, featuring multiple players, beveled tiles, different
  20. ;*    levels and audio.  Has useful code on a software PAL/NTSC switch,
  21. ;*    interleaved-blitter, coppers, midi based music & raw serial i/o,
  22. ;*    CIAA,CIAB timer control, keyboard handler + extensive greetings also.
  23. ;*    Does 0 Dimensional Tetris, I'm not sure how else to describe it!
  24. ;*                            Andy Hook
  25. ;*
  26. ;***************************************************************************
  27.  
  28. ; I use the vertical beam for timing in two places, this will not work if
  29. ; you have light pen latch set for god knows what reason - Andy.
  30.  
  31. ; Note that the music score is a direct dump of the Yamaha Demo mode, I
  32. ; couldn't find any copyright on this data dump, and although the song itself
  33. ; is uncopyrighted, there might be some cause for concern - Andy.
  34.  
  35. ; The musical instruments you hear were graciously donated by Kevin Stratton.
  36. ; Kevin Stratton is the author of the fantastic music and Sound-FX in Vortex.
  37.  
  38. ; I must also thank Mark Vange for teaching me about MIDI.
  39.  
  40. ; Software pal switch is poke #32,$dff1dc for those who can't wait.
  41. ; As shown to me by David Black III coder and integrator extraordinare.
  42.  
  43. ; Note: I've decided that the technique I used here for multitasking the
  44. ; players was somewhat inefficient.  A better way to do it would be to have
  45. ; a true interupt driven multitasking exec.  Unfortunately that would be
  46. ; way too slow for this type of application.
  47.  
  48. SOUND_ROW    equ 14*16
  49. SOUND_LEVEL  equ 10*16
  50. SOUND_PIECE  equ 12*16
  51. SOUND_RAISER equ 9*16
  52.  
  53. ;
  54. ;    Revision History:
  55. ;        Dec 29  1989    -  Played Arcade Game today, made mock outline.
  56. ;        Jan  1  1990    -  Wrote MachineTakeover(), ColorFader()
  57. ;                   ContinueDraw(), KeyboardInterupt()
  58. ;                   SetupVideo(), CopperList:
  59. ;        Jan 2-7 1990    -  Fleshed out game logic
  60. ;        Jan 8   1990    -  Wrote SoundEngine();  PrintText();
  61. ;        Jan 12  1990    -  Revamped block format for PatchCutLine();
  62. ;        Jan 15    1990    -  Wrote Multitasking Collapsed Line Flasher.
  63. ;        Jan 16  1990    -  Wrote header text, put in AllocMem();
  64. ;                   Demonstrated Beta at AMUC General Meeting
  65. ;        Jan 18    1990    -  Raisers(); Inter-level-delay
  66. ;                   Done.
  67. ;                (but wait...even more goodies ;-)
  68. ;        Jan 29  1990    -  Added Simple MusicEngine() + SoundLoader();
  69. ;
  70. ;            (Bien Gott Mr. Fish is up to #308!!! mama mia)
  71. ;
  72. ;    Variables is used as an index to Tetris variables, this allows
  73. ;    a pc-relative destination, which the 68000 instruction set doesn't
  74. ;    support naturally.  The cost is one permanently allocated register.
  75. ;
  76.  
  77.  
  78. Variables                    ; Variables *must* be first
  79. Tetris
  80.     bra    AmigaJunk
  81. _main    bsr    SaveZero
  82.     lea    BaseSeed(pc),a0            ; (randomize the seed)
  83.     move.l    $dff006,(a0)
  84.     bsr    CheckCompilerFailure        ; See if Aztek had problems
  85.     bne.s    Exit
  86.     bsr    AllocatePieces            ; get some RAM for graphics
  87.     beq.s    Exit
  88.     bsr    JustPlayIt            ; Start muzak.
  89.     bra    TetrisSuccess
  90.  
  91. TetrisExit
  92.     bsr    StopTheMusic
  93. Exit2    bsr    FreePieces
  94. Exit    bsr    RestoreZero
  95.     moveq    #1,d0
  96.     move.l    d0,d1
  97.     rts
  98.  
  99. TetrisSuccess
  100.     bsr    GetTopaz            ; Find System Font
  101.     bsr    MachineTakeover            ; Borrow Amiga for a while
  102.     bsr    TetrisSetup            ; A5 = Variables, setup view
  103.     bsr    MakeMulu110            ; Make Blit Mulu Table
  104.     bsr    UnpackPieces            ; Colorize Tetris Images
  105.     bsr    ResolveDetails            ; Make Images look connectable
  106.     bsr    DoIntro                ; (instructions)
  107.     bsr    SayName                ; (Whoops Almost forgot!)
  108.     bsr    SuperDisplay            ; Show all player play fields
  109.  
  110. ;
  111. ;    Tetris Main Loop, calls all players in turn...
  112. ;        A5 = Pointer to Base of Variables
  113. ;
  114. MainLoop                    ; MAIN LOOP
  115.     bsr    WaitFrame            ; Syncronize to screen refresh
  116.     bsr    WatchInput            ; Always watch for input
  117.  
  118.     lea    SupervisorPlayerList(pc),a0
  119. 1$    move.l    (a0)+,d0            ; D0 = Next Player or -1
  120.     bmi.s    MainLoop
  121.     move.l    a0,-(a7)            ; (save)
  122.     lea    (a5,d0.l),a4            ; A4 = Player One Variables
  123.     bsr    PlayPlayer            ; Play game with A4 Variables
  124.     move.l    (a7)+,a0
  125.     bra.s    1$
  126.  
  127.  
  128. ;
  129. ;    Setup screen display for all supplied players
  130. ;
  131. SuperDisplay
  132.     lea    SupervisorPlayerList(pc),a0
  133. SuperDisplay100
  134.     move.l    (a0)+,d0            ; D0 = Next Player or -1
  135.     bmi.s    SuperDisplay900
  136.     move.l    a0,-(a7)
  137.     lea    (a5,d0.l),a4            ; A4 = Player #
  138.     lea    PlayFieldOutline(pc),a3        ; A3 = Draws a big empty box
  139.     move.w    PlayerArea(a4),d5        ; D5 = Player's area
  140.     bsr    RenderLines            ; (Draws big empty rectangle)
  141.     bsr    DumpScore
  142.     move.l    (a7)+,a0
  143.     bra.s    SuperDisplay100
  144. SuperDisplay900
  145.     rts
  146.  
  147. ;
  148. ;    Find level of any other living players, return such for this player
  149. ;    There may be a problem if all other players are inactive, but
  150. ;    I don't think that should be possible.
  151. ;
  152. SuperScan
  153.     moveq    #0,d0
  154.     lea    SupervisorPlayerList(pc),a0
  155. 1$    move.l    (a0)+,d1            ; D0 = Next Player or -1
  156.     bmi.s    2$
  157.     lea    (a5,d1.l),a1            ; A4 = Player #
  158.     cmp.l    a1,a4                ; don't scan myself
  159.     beq.s    1$
  160.     tst.w    PlayerStats(a1)
  161.     beq.s    1$
  162.     move.b    PlayerStats+2(a1),d0        ; use public level
  163.     subq.b    #1,d0
  164.     bpl.s    2$
  165.     moveq    #0,d0
  166. 2$    rts
  167.  
  168. ;
  169. ;    SuperWait Routine is called by a player wishing to advance levels.
  170. ;    Scan for no other active players, when no active players
  171. ;    stop the music, have a delay loop, start the music, continue,
  172. ;    also change the seed at this time.
  173. ;
  174. ;    You can join in a game at any point, but you can't advance to the
  175. ;    next level till all other players are done.
  176. ;
  177. SuperWait
  178.     lea    SupervisorPlayerList(pc),a0
  179. 1$    move.l    (a0)+,d1            ; D0 = Next Player or -1
  180.     bmi.s    SuperWait200
  181.     lea    (a5,d1.l),a1            ; A4 = Player #
  182.     cmp.l    a1,a4                ; don't scan myself
  183.     beq.s    1$
  184.     cmp.w    #12,PlayerStats(a1)        ; If Players Active then fail
  185.     bcs.s    1$
  186. 2$    moveq    #-1,d0                ; failure
  187.     rts
  188.  
  189. SuperWait200
  190.     bsr    MusicEnginePause
  191.  
  192.     move.w    #3*60,d0            ; 2 Second Delay at 60 Hz
  193. 1$    cmp.b    #30,$6(a6)
  194.     bne.s    1$
  195. 2$    cmp.b    #20,$6(a6)
  196.     bne.s    2$
  197.     dbf    d0,1$
  198.  
  199.     lea    speed(pc),a0            ; Allow Speed 24-18
  200.     move.b    (a0),d0
  201.     subq.b    #1,d0
  202.     cmp.b    #24,d0
  203.     bcs.s    3$
  204.     move.b    #24,d0
  205. 3$    cmp.b    #18,d0
  206.     bcc.s    4$
  207.     move.b    #17,d0
  208. 4$    move.b    d0,(a0)
  209.     bsr    MusicEngineUnPause
  210.  
  211.     move.l    BaseSeed(pc),d0
  212.     mulu    RndSeed(a4),d0
  213.     move.l    d0,BaseSeed(a5)            ; Randomize the shared seed!
  214.     moveq    #1,d0                ; Success
  215.     rts
  216.  
  217. SuperSearch
  218.     lea    SupervisorPlayerList(pc),a0
  219. 1$    move.l    (a0)+,d1            ; D0 = Next Player or -1
  220.     bmi.s    3$
  221.     lea    (a5,d1.l),a1            ; A4 = Player #
  222.     cmp.l    a1,a4                ; don't scan myself
  223.     beq.s    1$
  224.     tst.w    PlayerStats(a1)
  225.     beq.s    1$
  226. 2$    moveq    #-1,d0                ; failure
  227.     rts
  228. 3$    moveq    #1,d0
  229.     rts
  230.  
  231. ;
  232. ;  If any other players alive then return, else start music for everybody.
  233. ;  Start up any variables too while I'm at it...
  234. ;
  235. SuperMusic
  236.     bsr    SuperSearch            ; -1 = others alive
  237.     bmi.s    1$
  238.     bsr    SuperVariables
  239.     move.b    speed(pc),d0
  240.     bsr    MusicEngineUnPause
  241.     moveq    #0,d0
  242. 1$    rts
  243.  
  244. ;
  245. ;  If any other players alive return, else stop music for everybody.
  246. ;
  247. SuperUnMusic
  248.     bsr    SuperSearch            ; -1 = others alive
  249.     bmi.s    1$
  250.     bsr    MusicEnginePause
  251.     moveq    #0,d0
  252. 1$    rts
  253.  
  254.  
  255. ;
  256. ;    Setup System Public Variables, start of new game.
  257. ;    Scramble the seed even more!!!! (arg!)
  258. ;
  259. SuperVariables
  260.     lea    speed(pc),a0
  261.     move.b    #24,(a0)
  262.     move.l    BaseSeed(pc),d0
  263.     mulu    #47,d0
  264.     move.l    d0,BaseSeed(a5)
  265.     rts
  266.  
  267. speed: dc.b 24,0
  268.  
  269. SupervisorPlayerList
  270.         dc.l    PlayerOneStart,PlayerTwoStart,-1
  271.  
  272. ;-----------------------------------------------------------------------------
  273.  
  274.  
  275. ;
  276. ;    Support any player whose variable pointer is passed in A4
  277. ;
  278. PlayPlayer
  279.     move.w    PlayerStats(a4),d0
  280.     jmp    PlayArbitration(pc,d0.w)
  281.     nop
  282. PlayArbitration
  283.     bra.l    PlayerDead            ;  0 Just plain dead
  284.     bra.l    PlayerWaiting            ;  4 Wait for others to catch up
  285.     bra.l    PlayerNewLevel            ;  8 Setting up new level
  286.     bra.l    PlayerPlaying            ; 12 In process of playing
  287.     bra.l    PlayerEndLevel            ; 16 Doing end of level
  288.     bra.l    PlayerEndGame            ; 20 Doing High Score (if any)
  289.     bra.l    PlayerCheckLine            ; 24
  290.     bra.l    PlayerLine            ; 28 Special Collapse Line Mode
  291.  
  292.  
  293.  
  294. return    rts
  295. PlayerDead
  296.      move.w    PlayerPort+2(a4),d0        ; Which port?
  297.     move.b    $bfe001,d1            ; Amiga port Button Hardware
  298.     and.b    d0,d1                ; User Want to play?
  299.     bne.s    return
  300.     bsr    SuperMusic
  301.     bra    PlayerStart            ; User selected a game!
  302. PlayerWaiting
  303.     bsr    SuperWait            ; Any other players "ingame"
  304.     bmi.s    return                ; (wait till they aren't)
  305.     move.w    #8,PlayerStats(a4)        ; Goto New Level Mode
  306.     rts
  307. PlayerNewLevel
  308.     bsr    GenerateLevel            ; Setup Next Level
  309. PlayerPlaying
  310.     bsr    Raisers
  311.     bsr    BlockHandle            ; Get Input, Update Block X,Y
  312.     bra    MoveBlock            ; Move Block, Handle Hits
  313. PlayerEndLevel
  314.     move.w    #16,PlayerStats(a4)        ; (set myself)
  315.     move.w    #4,PlayerStats(a4)        ; Goto Wait for others mode
  316.     rts
  317. PlayerEndGame
  318.     move.w    #20,PlayerStats(a4)        ; (set myself)
  319.     move.w    #0,PlayerStats(a4)        ; Set "just plain dead" mode
  320.     bra    SuperUnMusic
  321.  
  322. ;
  323. ;    Collapse any finished lines, See if won or died, setup next piece.
  324. ;
  325. NextPiece
  326.     move.w    PlayerArea2(a4),d0
  327.     add.w    #4,d0
  328.     cmp.b    BlockPos+6(a4),d0        ; Stopped to High? (Game Over)
  329.     bcc.s    PlayerEndGame
  330.  
  331.     move.l    PlayerXY(a4),BlockPos(a4)    ; Start New Block at Top
  332.     bsr    rnd                ; D0 = Random(0-55)
  333.     and.w    #63-7,d0            ; Get (0-6) (*4*2)
  334.  
  335. ;
  336. ; See next piece please
  337. ;
  338.     move.w    d0,-(a7)
  339.     movem.w    PlayerArea2(a4),d0/d1        ; d1=x,d0=y
  340.     add.w    #2,d1
  341.     subq.w    #4,d0
  342.     bsr    Erase
  343.     move.l    RndSeed(a4),-(a7)
  344.     bsr    rnd
  345.     move.l    (a7)+,RndSeed(a4)
  346.     and.w    #63-7,d0            ; Get (0-6) (*4*2)
  347.     move.w    d0,BlockID(a4)
  348.     moveq    #0,d0
  349.     move.l    d0,d1
  350.     movem.w    PlayerArea2(a4),d0/d1        ; d1=x,d0=y
  351.     add.w    #2,d1
  352.     subq.w    #4,d0
  353.     clr.l    BlitRepairAddress(a4)        ; (No predecessor)
  354.     bsr    DrawBlockAt
  355.     move.w    (a7)+,d0
  356.  
  357.     clr.l    BlitRepairAddress(a4)        ; (No predecessor)
  358.     clr.b    RotateFlag(a4)            ; No special rotate state
  359.     move.w    d0,BlockID(a4)            ; Block # of default orient
  360. ;
  361. ;    Generalized Checkline routine, checks every single
  362. ;    screen line for possible completion.
  363. ;
  364. PlayerCheckLine
  365.     lea    TetrisByteMap(pc),a3        ; a3 = Player Space
  366.     add.w    PlayerArea(a4),a3        ; Where Am I?
  367.     add.w    #1,a3                ; Get active region
  368.     move.l    a3,a2                ; a2 = Current Line #
  369.     moveq    #0,d5
  370.     moveq    #RECT_Y-1,d7            ; Check tall
  371. 3$    moveq    #RECT_X-1,d6            ; Check across
  372.     move.l    a2,a1                ; a1 = Current Line
  373. 2$    tst.b    (a1)+                ; Any Holes?
  374.     beq.s    4$                ; Empty spot here, skip...
  375.     dbf    d6,2$                ; check rest of line
  376.     bra    FoundLine
  377. 4$    add.w    #44,a2                ; Next Line
  378.     dbf    d7,3$
  379.  
  380.     move.w    #12,PlayerStats(a4)        ; Return to normal mode
  381.  
  382.     tst.b    PlayerStats+3(a4)        ; Any rows left to solve?
  383.     bpl.s    5$
  384.     move.w    #SOUND_LEVEL,d0            ; End Level triumphant noise
  385.     bsr    SoundPlay
  386.     bra    PlayerEndLevel            ; Oh my God!!! I finished it..
  387. 5$    rts
  388.  
  389.  
  390.  
  391.  
  392. ;
  393. ;    Start a brand new player game
  394. ;
  395. PlayerStart
  396.     move.l    #'0000',d0            ; Wipe Score on New Game
  397.     move.l    d0,ScoreText+4(a4)
  398.     move.l    d0,ScoreText+8(a4)
  399.     bsr    SuperScan            ; D1.b = Level to start on
  400.     move.b    d0,PlayerStats+2(a4)        ; use public level
  401.     move.w    #8,PlayerStats(a4)        ; Set Generate Mode (no wait)
  402.     rts
  403.  
  404.  
  405. GenerateLevel
  406.     add.b    #1,PlayerStats+2(a4)        ; Level += 1;
  407.  
  408.     move.b    PlayerStats+2(a4),d0        ; Algorithm for # of Rows req.
  409.     lsl.b    #1,d0
  410.     cmp.b    #20,d0
  411.     bcs.s    0$
  412.     move.b    #20,d0
  413. 0$    cmp.b    #7,d0
  414.     bcc.s    1$
  415.     move.b    #7,d0
  416. 1$    move.b    d0,PlayerStats+3(a4)
  417.  
  418.     move.l    #$00400020,BlockSpeed(a4)
  419.     move.b    PlayerStats+2(a4),d0        ; Algorithm for Speed Per Lev
  420.     cmp.b    #15,d0
  421.     bcs.s    2$
  422.     move.b    #15,d0
  423. 2$    lsl.b    #3,d0
  424.     add.b    #$10,d0
  425.     move.b    d0,BlockSpeed+3(a4)        ; Speed up per level
  426.  
  427.     move.l    #$00000080,Counter(a4)
  428.     lea    PlayFieldClear(pc),a3        ; A3 = Draws a big empty box
  429.     move.w    PlayerArea(a4),d5        ; D5 = Player's area
  430.     bsr    RenderLines            ; (Draws big empty rectangle)
  431.     bsr    DumpScore
  432.     bsr    Difference            ; Make Unique Backdrop
  433.     move.w    #-1,BlockPos+6(a4)        ; Force Very Low First Entry!
  434.     move.l    BaseSeed(pc),d0            ; Get shared seed for game
  435.     move.w    PlayerStats+2(a4),d1        ; Modify according to level
  436.     mulu    d1,d0                ;
  437.     move.l    d0,RndSeed(a4)            ; My private seed per piece
  438.     bra    NextPiece            ; Setup Next Piece
  439.  
  440.  
  441.  
  442. ;
  443. ;    Generate each levels unique backdrop, enemies ect
  444. ;
  445.  
  446. Difference
  447.     moveq    #0,d0
  448.     move.b    PlayerStats+2(a4),d0
  449.     and.b    #15,d0                ; 16 different levels...
  450.     lea    TetrisLevels(pc),a3
  451.     mulu    #5*2,d0
  452.     add.w    d0,a3
  453.     move.b    1(a3),CollapseJunk+2(a4)    ; (stash mode here)
  454.  
  455.     moveq    #0,d4
  456.     move.w    PlayerArea(a4),d4        ; D4 = Player's area
  457.     add.l    #(RECT_Y-5)*44+1,d4        ; get to bottom
  458.  
  459.     moveq    #5,d2
  460.     moveq    #5-1,d7
  461. 0$    move.w    (a3)+,d3
  462.     moveq    #RECT_X-1,d6
  463. 1$    add.w    d3,d3
  464.     bcc.s    2$
  465.     add.w    #8*4,d2
  466.     and.w    #8*4*4-1,d2
  467.     bsr    PokeScreen
  468. 2$    add.w    #1,d4
  469.     dbf    d6,1$
  470.     add.w    #44-RECT_X,d4
  471.     dbf    d7,0$
  472.     rts
  473.  
  474. ;
  475. ;    "Physically" Move the Block, and handle any collisions with wall ect.
  476. ;
  477. MoveBlock
  478.     bsr    GetBlockPos            ; D4 = Block Pos
  479.     move.w    BlockID(a4),d2            ; D2 = Pointer to Block Image
  480.     bsr    TestCollision            ; Time to stop?
  481.     bne.s    BlockHit
  482.     move.l    BlockPos(a4),BlockPos+4(a4)    ; Remember Pos for Un-Move
  483.     bra    DrawBlock            ; Visibly Move Block
  484.  
  485. BlockHit
  486.     move.b    BlockPos+4(a4),d0        ; Detect Sideways Moves
  487.     cmp.b    BlockPos(a4),d0            ; Compare Old X to new X
  488.     bne.s    MoveItWall            ; Moved Sideways? XO != XN
  489.     move.w    #SOUND_PIECE,d0            ; Make "Click" Noise
  490.     bsr    SoundPlay
  491.     bsr    GetBlockOldPos            ; Where is block
  492.     move.w    BlockID(a4),d2            ; D2 = Block to byte screen
  493.     bsr    DrawBlockMem            ; Write to byte screen
  494.     bra    NextPiece
  495.  
  496. MoveItWall
  497.     move.w    BlockPos+4(a4),BlockPos(a4)    ; Discard XNew sideways move
  498.     rts
  499.  
  500.  
  501.  
  502.  
  503. ;
  504. ;    Handle users input, move block as requested, and also move it down.
  505. ;
  506. BlockHandle
  507.  
  508.     move.w    BlockSpeed+2(a4),d0        ; Get Suggested Speed Y
  509.     add.w    d0,BlockPos+2(a4)        ; Add Speed to Position Y
  510.     bsr    ReadJoy                ; D1 = Joystick %LU------RD
  511.     move.w    BlockSpeed+2(a4),d0        ; Get Y Speed
  512.     lsr.w    #1,d1                ; D1 = %LU-----R
  513.     bcc.s    BlockHandle100
  514.     add.w    d0,d0
  515.     add.w    d0,BlockPos+2(a4)
  516. BlockHandle100
  517.     move.b    BlockPos+6(a4),d0        ; Disallow Angle Movements
  518.     cmp.b    BlockPos+2(a4),d0
  519.     bne.s    BlockHandle500
  520.     move.w    BlockSpeed(a4),d0        ; Get X Speed
  521.     lsr.w    #1,d1                ; D1 = %LU------
  522.     bcs.s    BlockHandle400
  523.     add.b    d1,d1                ; D1 = %U-------
  524.     bcc.s    BlockHandle500
  525.     neg.w    d0
  526. BlockHandle400
  527.     add.w    d0,BlockPos(a4)
  528. BlockHandle500
  529.  
  530. ;Check for block rotate:
  531. ;    Done after move because when block stops the image is not redrawn
  532. ;    and if block rotated just before stop it would appear in previous
  533. ;    orientation.  Wheras rotate never occurs before impending collisions.
  534.  
  535.     move.b    $bfe001,d0            ; Test Left Port Button
  536.     move.w    PlayerPort+2(a4),d1        ; Get Amiga Hardware Bit #
  537.     and.b    d1,d0
  538.     cmp.b    LastButton(a4),d0        ; Any change in button state?
  539.     beq.s    BlockHandle900
  540.     move.b    d0,LastButton(a4)        ; Accept only Button Down
  541.     bne.s    BlockHandle900
  542.  
  543.     move.w    BlockID(a4),d5            ; Attempt Rotation
  544.     move.w    d5,d1
  545.     add.w    #2,d1                ; Get Next Rotation of Color
  546.     and.w    #6,d1                ; Allow rotate only
  547.     and.w    #$f8,d5                ; Clean
  548.     or.w    d1,d5                ; D5 = New Block Rotation
  549.     bsr    GetBlockPos            ; D4 = Block ByteMap pos
  550.     move.w    d5,d2                ; D2 = Rotation to check out
  551.     bsr    TestCollision
  552.     bne.s    BlockHandle900            ; 0 = Successful rotation
  553.     move.w    d5,BlockID(a4)            ; Rotation was possible
  554. BlockHandle900
  555.     rts
  556.  
  557.  
  558.     dc.b    "On dreamless night"
  559.     dc.b    "Ere the moon does rise"
  560.     dc.b    "Laughlight Shadows"
  561.     dc.b    "Across dreamless eyes,"
  562.  
  563.  
  564. ;
  565. ;    Found Line to Kill!!!
  566. ;
  567. FoundLine
  568.     move.w    #28,PlayerStats(a4)        ; Set Collapse Line Mode!!!
  569.     move.w    #$0805,CollapseJunk(a4)        ; Some stuff for collapse
  570.     move.l    a3,CollapseJunk+4(a4)        ; A3 = Top of Field
  571.     move.l    a2,CollapseJunk+8(a4)        ; A2 = Line Addr to Cut
  572.     sub.w    #RECT_Y-1,d7
  573.     neg.w    d7
  574.     move.w    d7,CollapseJunk+12(a4)        ; D7 = Line # to cut
  575.     move.w    d7,d0
  576.     subq.w    #1,d0
  577.     bsr    DrawLine            ; (Draw Patch)
  578.     move.w    d7,d0
  579.     addq.w    #1,d0
  580.     bsr    DrawLine            ; (Draw Patch if any)
  581.     move.w    #SOUND_ROW,d0            ; Make "Line Eat" Noise
  582.     bra    SoundPlay
  583.  
  584.  
  585.  
  586. ;
  587. ;    Separated to be multitasking with other players
  588. ;
  589. PlayerLine
  590.     move.l    CollapseJunk+4(a4),a3        ; A3 = Top of Field
  591.     move.l    CollapseJunk+8(a4),a2        ; A2 = Line to Cut
  592.     move.w    CollapseJunk+12(a4),d7        ; D7 = Line # to cut
  593.  
  594.     sub.b    #1,CollapseJunk(a4)
  595.     move.b    CollapseJunk(a4),d0
  596.     beq.s    PlayerLine100
  597.     bsr    GargleBlast
  598.     move.w    d7,d0                ; D0 = Line to draw
  599.     bra    DrawLine
  600.     rts
  601.  
  602. PlayerLine100
  603.     move.w    #24,PlayerStats(a4)        ; Be in PlayerLineDone Mode
  604.     bsr    CollapseLine            ; Kill Line in Byte Map
  605.     sub.b    #1,PlayerStats+3(a4)        ; Decrement Required Count
  606.     bsr    LineScore
  607.     bra    RedrawPlayField
  608.     rts
  609.  
  610. GargleBlast
  611.     move.l    a2,a0                ; A2 = Line to flash
  612.     move.b    CollapseJunk+3(a4),d0        ; Random # to flash of
  613.     or.b    #5,d0                ; (block)
  614.     add.b    #8*4,d0
  615.     move.b    d0,CollapseJunk+3(a4)        ; Random # to flash of
  616.     moveq    #RECT_X-1,d6            ; Flash Line Prettily
  617. 1$    add.b    #8*4,d0
  618.     and.b    #8*4*4-1,d0
  619.     move.b    d0,(a0)+
  620.     dbf    d6,1$
  621.     rts
  622.  
  623.  
  624. ;How to write Collapse Line:
  625. ;    -Collapse line will just set a new mode, that mode will flash the
  626. ;     line and collapse it itself, it will also add the score and count
  627. ;    required, finally it will go back to itself to check for more...
  628. ;    score count, single double triple tetris is computed at this time.
  629. ;
  630.  
  631.  
  632. ;
  633. ;    Collapse line on byte map
  634. ;
  635. CollapseLine
  636.     bsr    PatchCutLine            ; Breakup tiles, Pass A2
  637.  
  638.                         ; a3 = Top of Field
  639.                         ; a2 = Current Line to Kill
  640.     move.l    a2,a1                ; A1 = Line to Collapse
  641. CollapseLine100
  642.     cmp.l    a3,a1                ; Is at top?
  643.     beq.s    CollapseLine900
  644.     move.w    #RECT_X-1,d2            ; Do one Line
  645. 1$    move.b    -44(a1),(a1)+            ; Copy Down one line
  646.     dbf    d2,1$
  647.     sub.l    #RECT_X+44,a1            ; Goto Previous Line
  648.     bra.s    CollapseLine100
  649. CollapseLine900
  650.     rts
  651.  
  652.  
  653. PatchCutLine
  654.                         ; A2 = Current Line
  655.     lea    -44(a2),a1            ; A1 = Do Line above
  656.     move.w    #$ff-1,d3            ; D3 = Cut Bottom off
  657.     bsr    PatchCut100
  658.     lea    44(a2),a1            ; A1 = Do Line below
  659. PatchThisLine
  660.     move.w    #$ff-4,d3            ; D3 = Cut top off
  661. PatchCut100
  662.     move.w    #RECT_X-1,d2            ; Do one Line
  663. 1$    move.b    (a1),d0                ; READ
  664.     beq.s    2$
  665.     move.b    d0,d1                ; (save)
  666.     and.w    #31,d0
  667.     move.b    UnResolveType(pc,d0.w),d0    ; Get Originator type
  668.     and.b    d3,d0                ; Cut one side
  669.     move.b    ResolveType2(pc,d0.w),d0    ; Get proper back
  670.     and.b    #$e0,d1                ; Mask off old walls info
  671.     or.b    d1,d0                ; Insert new walls info
  672. 2$    move.b    d0,(a1)+            ; WRITE
  673.     dbf    d2,1$
  674.     rts
  675.  
  676. ;
  677. ;    Convert back to quirky resolve type format
  678. ;
  679. UnResolveType    dc.b    15,9, 5,4,13,0,0,0
  680.         dc.b    0,3,10,8,11,0,0,0
  681.         dc.b    0,6, 0,1, 7,0,0,0
  682.         dc.b    0,12,0,2,14,0,0,0
  683. ;
  684. ;    A handy copy of the ResolveType Table...
  685. ;
  686. ResolveType2    dc.b    5,2*8+3,3*8+3,8+1,3,2,2*8+1,2*8+4
  687.         dc.b    8+3,1,8+2,8+4,3*8+1,4,3*8+4,0
  688.  
  689.  
  690.  
  691. ;
  692. ;    Every x pieces raise up screen one.
  693. ;
  694. Raisers
  695.     move.b    CollapseJunk+2(a4),d0
  696.     btst    #1,d0
  697.     beq.s    RaisersStop
  698.     add.w    #1,Counter(a4)            ; Increment player counter
  699.     move.w    Counter(a4),d0
  700.     cmp.w    Counter+2(a4),d0
  701.     beq.s    RaisersGo
  702. RaisersStop
  703.     rts
  704. RaisersGo
  705.     add.w    #$200,d0            ; Till next time
  706.     move.w    d0,Counter+2(a4)
  707.  
  708.     move.w    PlayerArea2(a4),d0        ; Is block below here?
  709.     addq.w    #4,d0
  710.     cmp.b    BlockPos+6(a4),d0
  711.     bcc.s    RaisersStop
  712.  
  713.     move.l    d0,-(a7)            ; Raiser Noise
  714.     move.l    #SOUND_RAISER,d0
  715.     bsr    SoundPlay
  716.     move.l    (a7)+,d0
  717.  
  718.     sub.b    #1,BlockPos+6(a4)        ; Move Real Block Up!
  719.     move.b    BlockPos+6(a4),BlockPos+2(a4)
  720.  
  721.     bsr    RaisersDraw
  722.  
  723.     lea    TetrisByteMap(pc),a3
  724.     add.w    PlayerArea(a4),a3
  725.     add.w    #1,a3                ; A3 = top of player region
  726.     move.l    a3,a2
  727.                         ; Copy ByteMap up one line
  728.     move.w    #RECT_Y-2,d3            ; (don't do last line)
  729. 0$    move.w    #RECT_X-1,d2
  730. 1$    move.b    44(a2),(a2)+
  731.     dbf    d2,1$
  732.     add.w    #44-RECT_X,a2
  733.     dbf    d3,0$
  734.  
  735.     bsr    GargleBlast            ; Write random pattern once
  736.  
  737.     move.b    BlockPos(a4),d0            ; Force hole in pattern
  738.     sub.b    #RECT_X,d0
  739.     neg.b    d0
  740.     cmp.b    #RECT_X,d0
  741.     bcs.s    3$
  742.     and.w    #7,d0
  743. 3$    and.w    #15,d0
  744.     ;eor.b    #%111,d0            ; randomize
  745.     move.b    #0,(a2,d0.w)
  746.  
  747.     move.l    a3,a1                ; Patch top line
  748.     bsr    PatchThisLine
  749.  
  750.     moveq    #0,d0
  751.     bsr    DrawLine            ; Draw Top (was patched)
  752.     moveq    #RECT_Y-2,d0
  753.     bsr    DrawLine            ; hack, fix any teat glitch.
  754.     moveq    #RECT_Y-1,d0
  755.     bra    DrawLine            ; Draw Bot (was gargleblasted)
  756.  
  757.  
  758. RedrawPlayField
  759.     moveq    #0,d7
  760. 1$    move.l    d7,d0                ; D0 = Line # to Draw
  761.     bsr    DrawLine
  762.     add.w    #1,d7
  763.     cmp.w    #RECT_Y+1,d7            ; (over-do to get teats)
  764.     bne.s    1$
  765.     rts
  766.  
  767.  
  768. GetBlockPos
  769.     moveq    #0,d4
  770.     move.b    BlockPos+2(a4),d4        ; Y byte # pos of block
  771.     mulu    #44,d4                ; get raw
  772.     moveq    #0,d1
  773.     move.b    BlockPos(a4),d1            ; X byte # pos of block
  774.     add.w    d1,d4
  775.     rts
  776.  
  777.  
  778. GetBlockOldPos
  779.     moveq    #0,d4
  780.     move.b    BlockPos+6(a4),d4        ; Y byte # pos of block
  781.     mulu    #44,d4                ; get raw
  782.     moveq    #0,d1
  783.     move.b    BlockPos+4(a4),d1        ; X byte # pos of block
  784.     add.w    d1,d4
  785.     rts
  786.  
  787.  
  788. TestCollision
  789.                         ; D4 = Screen Pos of block
  790.     lea    TetrisShapes(pc),a0
  791.     move.w    (a0,d2.w),d2            ; D2 = Block Data
  792.     lea    TetrisByteMap(pc),a0        ; A0 = Byte Mapped Screen
  793.     add.w    d4,a0
  794.     moveq    #4-1,d0                ; Examine Each Block Byte
  795. TestIt200
  796.     moveq    #4-1,d1
  797. TestIt300
  798.     add.w    d2,d2                ; (<<BITSHIFT onto Carry Flag)
  799.     bcc.s    TestIt500            ; Anything in block here?
  800.     tst.b    (a0)                ; Coincident with Real World?
  801.     beq.s    TestIt500
  802.     moveq    #-1,d0                ; Whoops, hit something...
  803.     rts
  804. TestIt500
  805.     lea    1(a0),a0            ; Next HLine
  806.     dbf    d1,TestIt300
  807.     lea    40(a0),a0            ; Next VLine
  808.     dbf    d0,TestIt200
  809.     moveq    #0,d0
  810.     rts
  811.  
  812.  
  813.  
  814. DrawBlockMem
  815.                         ; D4 = Where to draw
  816.                         ; D2 = Block #
  817.     lsl.w    #3,d2                ; Get to multiples of 16
  818.     lea    TetrisDetails(pc),a1
  819.     lea    (a1,d2.w),a1            ; Pointer to Real Block Data
  820.     lea    TetrisByteMap(pc),a0        ; A0 = Byte Mapped Screen base
  821.     moveq    #4-1,d7                ; Examine Each Block Byte
  822. 1$    moveq    #4-1,d6
  823. 2$    move.b    (a1)+,d2            ; D2 = Data
  824.     beq.s    3$
  825.     move.b    d2,(a0,d4.w)            ; To Byte Mapped
  826. 3$    add.w    #1,d4                ; Next HLine of render
  827.     dbf    d6,2$
  828.     add.w    #40,d4                ; Next VLine of render
  829.     dbf    d7,1$
  830.     rts
  831.  
  832.  
  833. ;
  834. ;
  835. ;    Clear out work area + draw walls ect...
  836. ;    each play zone is 24 deep and 16 wide, centered
  837. ;                        ; A3 = Command List
  838. ;
  839. RenderLines
  840.     move.w    (a3)+,d4            ; D4 = Line Start,End
  841.     bmi    RenderLines900            ; Done?
  842.     add.w    d5,d4                ; + Offset
  843.     move.w    (a3)+,d3            ; D3 = Iterations to perform
  844.     move.w    (a3)+,d2            ; D2 = Color (byte graphic #)
  845.     move.b    -2(a3),d1            ; D1 = Horiz/Vert/Area?
  846.     bmi.s    RenderLinesArea
  847.     beq.s    RenderLinesHoriz
  848.     cmp.b    #2,d1
  849.     beq.s    RenderLinesAngled
  850. RenderLinesVert
  851.     bsr    PokeScreen            ; Put D2 at D4 + Show it
  852.     add.w    #44,d4
  853.     dbf    d3,RenderLinesVert
  854.     bra    RenderLines
  855. RenderLinesAngled
  856.     bsr    PokeScreen            ; Put D2 at D4 + Show it
  857.     add.w    #45,d4
  858.     dbf    d3,RenderLinesAngled
  859.     bra    RenderLines
  860. RenderLinesHoriz
  861.     bsr    PokeScreen            ; Put D2 at A0 + Show it
  862.     addq.w    #1,d4
  863.     dbf    d3,RenderLinesHoriz
  864.     bra    RenderLines
  865.  
  866. RenderLinesArea
  867.                         ; D3 = Horizontal Size to do
  868.     and.b    #$7f,d1                ; D1 = Vertical Area to do
  869.     ext.w    d1
  870.     move.w    d1,d6                ; D6 = Vertical Lines to do
  871.     move.w    d3,d7                ; Save Width
  872. RenderLinesArea100
  873.     bsr    PokeScreen
  874.     addq.w    #1,d4                ; Next H
  875.     dbf    d3,RenderLinesArea100        ; Next H Pos
  876.     move.w    d7,d3                ; Reset Horiz Count
  877.     add.w    #43,d4                ; Get to next vertical start
  878.     sub.w    d3,d4
  879.     dbf    d6,RenderLinesArea100
  880.     bra    RenderLines
  881. RenderLines900
  882.     rts
  883.  
  884.     dc.b    "A Knight there was"
  885.     dc.b    "And that a Noble man"
  886.     dc.b    "That fro the time he first bigan"
  887.     dc.b    "To Riden out, he loved"
  888.     dc.b    "Truthe and Honour"
  889.     dc.b    "Justyice and Curteysie."
  890.  
  891. PokeScreen
  892.     move.w    d4,d0                ; Screen Address
  893.     ext.l    d0
  894.     divu    #44,d0                ; Get vertical lines #
  895.     move.l    d0,d1                ; D0 = Vert Byte Pos
  896.     swap    d1                ; D1 = Horiz Byte Pos
  897.     bra    DrawOne                ; Draw one element at D0/D1
  898.  
  899. EraseByteMap
  900.     lea    TetrisByteMap(pc),a0
  901.     move.w    #11*29-1,d0            ; Wipe Byte Map
  902. 1$    clr.l    (a0)+
  903.     dbf    d0,1$
  904.     rts
  905.  
  906.  
  907. LineScore
  908.     moveq    #5,d2                ; add up new score
  909.     lea    ScoreText+4(a4),a0
  910.     moveq    #6,d0
  911. 0$    move.b    (a0,d0.w),d1
  912.     add.b    d2,d1
  913.     move.b    d1,(a0,d0.w)
  914.     cmp.b    #$3a,d1
  915.     bcs.s    1$
  916.     sub.b    #$39,d1
  917.     and.b    #15,d1
  918.     or.b    #$30,d1
  919.     move.b    d1,(a0,d0.w)
  920.     moveq    #1,d2
  921.     dbf    d0,0$
  922. 1$
  923.  
  924. DumpScore
  925.     lea    ScoreText(a4),a0        ; show new score
  926.     move.l    GameVideo(pc),a1        ; Dest
  927.     lea    44*4(a1),a1
  928.     bsr    PrintText            ; Print it!!!
  929.  
  930.     move.b    PlayerStats+3(a4),d0
  931.     bpl.s    4$
  932.     moveq    #0,d0
  933. 4$    divu    #10,d0                ; Get Decimal...
  934.     or.b    #$30,d0
  935.     move.b    d0,LayerText+4(a4)        ; 10's
  936.     swap    d0
  937.     or.b    #$30,d0
  938.     move.b    d0,LayerText+5(a4)        ; 1's
  939.     lea    LayerText(a4),a0
  940.     move.l    GameVideo(pc),a1
  941.     lea    44(a1),a1
  942.     bsr    PrintText
  943.  
  944.     move.b    PlayerStats+2(a4),d0
  945.     bpl.s    5$
  946.     moveq    #0,d0
  947. 5$    divu    #10,d0                ; Get Decimal...
  948.     or.b    #$30,d0
  949.     move.b    d0,LevelText+4(a4)        ; 10's
  950.     swap    d0
  951.     or.b    #$30,d0
  952.     move.b    d0,LevelText+5(a4)        ; 1's
  953.     lea    LevelText(a4),a0
  954.     move.l    GameVideo(pc),a1
  955.     lea    44*4(a1),a1
  956.     bra    PrintText
  957.  
  958.  
  959. ;---------------------------------------------------------------------
  960.  
  961. ;
  962. ;    Watch Keyboard, start a player game if requested
  963. ;
  964. WatchInput
  965.     moveq    #0,d0
  966.     lea    KeyEvent(pc),a0            ; Get Key
  967.     move.b    (a0),d0
  968.     clr.b    (a0)                ; Wipe Key from buffer
  969.     cmp.b    #'P',d0                ; P to Pause
  970.     beq.s    Pause
  971.     cmp.b    #$7b,d0                ; ESC == Return to System
  972.     beq    MachineReturn
  973.     cmp.b    #$11,d0                ; is ESC/F1 or greater?
  974.     bcs.s    TetrisHandle900
  975.     cmp.b    #$1b,d0                ; is F10 or lesser?
  976.     bcc.s    TetrisHandle900
  977.     sub.b    #$11,d0
  978.     lsl.b    #2,d0                ; Index subroutines
  979.     jmp    TetrisInputOptions(pc,d0.w)    ; Goto Subroutine
  980. TetrisHandle900
  981.     rts
  982.  
  983. Pause    lea    KeyEvent(pc),a0
  984.     btst    #6,$bfe001
  985.     beq.s    PauseEnd
  986.     btst    #7,$bfe001
  987.     beq.s    PauseEnd
  988.     move.b    (a0),d0
  989.     cmp.b    #$7b,d0                ; ESC == Return to System
  990.     beq    MachineReturn
  991.     tst.b    d0
  992.     beq.s    Pause
  993. PauseEnd
  994.     clr.b    (a0)
  995.     rts
  996.  
  997. TetrisInputOptions
  998.     bra.l    TetrisF1            ; (this wacko thing is
  999.     bra.l    TetrisF2            ;  due to p c relative code)
  1000.     bra.l    TetrisF3
  1001.     bra.l    TetrisF4
  1002.     bra.l    TetrisF5
  1003.     bra.l    TetrisF6
  1004.     bra.l    TetrisF7
  1005.     bra.l    TetrisF8
  1006.     bra.l    TetrisF9
  1007.     bra.l    TetrisFA
  1008.     nop                    ; (stop compiler optimizing)
  1009. TetrisF1
  1010. TetrisF2
  1011. TetrisF3
  1012. TetrisF4
  1013. TetrisF5
  1014. TetrisF6
  1015. TetrisF7
  1016. TetrisF8
  1017. TetrisF9
  1018. TetrisFA
  1019.     rts
  1020.  
  1021. ;
  1022. ;    Generate detailed tile face-pieces for Tetris Objects
  1023. ;    The first pass merely sets down used positions, the second
  1024. ;    pass actually sets up proper tile faces
  1025. ;
  1026.  
  1027. ResolveDetails
  1028.     bsr    ResolveDetails2
  1029. ResolveDetails2
  1030.     lea    TetrisShapes(pc),a0        ; A0 = Simple Tile Shape Data
  1031.     lea    TetrisDetails(pc),a1        ; A1 = Detailed Tiles (to be)
  1032.     moveq    #0,d7                ; Do 7 Sets of 4 Tiles
  1033. 0$    bsr    ResolveSet
  1034.     add.w    #32,d7                ; Every 4th tile has new color
  1035.     cmp.w    #32*7,d7            ; End of color spectrum?
  1036.     bne.s    0$
  1037.     rts
  1038.  
  1039.  
  1040. ResolveSet
  1041.     moveq    #4-1,d6                ; Do 4 tiles (1 set of rots)
  1042. 1$    move.w    (a0)+,d5            ; D5 = One Tile
  1043.     bsr    ResolveOne
  1044.     dbf    d6,1$
  1045.     rts
  1046.  
  1047.  
  1048. ResolveOne
  1049.     moveq    #16-1,d4            ; Bitscan 16 bits of one tile
  1050. 2$    add.w    d5,d5                ; Active bit here?
  1051.     bcc.s    3$
  1052.     bsr    DecideType            ; D0 = Decide what connectable
  1053.     move.b    d0,(a1)                ; Store Connection to Detailed
  1054. 3$    lea    1(a1),a1            ; Next Dest
  1055.     dbf    d4,2$
  1056.     rts
  1057.  
  1058. DecideType
  1059.     move.w    d4,d1                ; D1 = Position in array
  1060.     sub.w    #15,d1
  1061.     neg.w    d1
  1062.     clr.w    d0                ; D0 = Faces Active Bits
  1063.  
  1064.     cmp.b    #12,d1                ; On bottom row?
  1065.     bpl.s    1$
  1066.     tst.b    4(a1)                ; Anything below face?
  1067.     beq.s    1$
  1068.     or.b    #1,d0
  1069.  
  1070. 1$    cmp.b    #4,d1                ; On top row?
  1071.     bmi.s    2$
  1072.     tst.b    -4(a1)                ; Above face?
  1073.     beq.s    2$
  1074.     or.b    #4,d0
  1075.  
  1076. 2$    bclr    #2,d1                ; At Left Edge?
  1077.     tst.b    d1
  1078.     beq.s    3$
  1079.     tst.b    -1(a1)                ; Left of face?
  1080.     beq.s    3$
  1081.     or.b    #2,d0
  1082.                         ; (no pieces are like x00x)
  1083. 3$    tst.b    1(a1)                ; Right of face?
  1084.     beq.s    4$
  1085.     or.b    #8,d0
  1086. 4$
  1087.  
  1088. ;
  1089. ;    Convert from my random drawn format to logical format also.
  1090. ;
  1091.     and.w    #$000f,d0
  1092.     move.b    ResolveType(pc,d0.w),d0
  1093.     or.b    d7,d0                ; What color is face on?
  1094. 5$    rts
  1095.     ; format: something below / to left / to top / to right
  1096.  
  1097. ResolveType    dc.b    5,2*8+3,3*8+3,8+1,3,2,2*8+1,2*8+4
  1098.         dc.b    8+3,1,8+2,8+4,3*8+1,4,3*8+4,0
  1099.  
  1100.  
  1101. ;*****************************************************************************
  1102. ;*****************************************************************************
  1103. ;
  1104. ;    Returns D0 within range of 0-x, This rnd function is from MANX
  1105.  
  1106. rnd
  1107.     move.l    RndSeed(a4),d0
  1108.     add.l    d0,d0
  1109.     bhi.L    3$
  1110.     eori.l    #$1d872b41,d0
  1111. 3$    move.l    d0,RndSeed(a4)
  1112.     andi.l    #$0000ffff,d0
  1113.     divu    #7*4*2,d0            ; Range = 0 to 7 ((*4*2)-1)
  1114.     swap    d0
  1115.     rts
  1116.  
  1117.  
  1118.  
  1119. ; soon aztek, soon....
  1120.  
  1121. CheckCompilerFailure
  1122.     lea    Variables(pc),a5        ; A5 = Tetris Variables
  1123.     lea    TetrisByteMap(a5),a0
  1124.     lea    TetrisByteMap(pc),a1
  1125.     cmp.l    a0,a1
  1126.     bne.s    AztekFailedAsUsual
  1127.     lea    PlayerTwoStart(a5),a4
  1128.     move.l    PlayerPort(a4),d0
  1129.     cmp.l    #$000a0040,d0
  1130.     bne.s    AztekFailedAsUsual
  1131.     moveq    #0,d0            ; Compiler managed to compile
  1132.     rts
  1133. AztekFailedAsUsual
  1134.     moveq    #-1,d0
  1135.     rts
  1136.  
  1137.  
  1138.  
  1139.  
  1140. ;
  1141. ; This is for debugging purposes only.
  1142. ;
  1143. SaveZero
  1144.     lea    $60,a0                ; save zero page against use
  1145.     lea    zeropage(pc),a1
  1146. Cheat    moveq    #12-1,d0
  1147. 1$    move.l    (a0)+,(a1)+
  1148.     dbf    d0,1$
  1149.     rts
  1150. RestoreZero
  1151.     lea    $60,a1                ; restore zero page
  1152.     lea    zeropage(pc),a0
  1153.     bra.s    Cheat
  1154. zeropage:dcb.l    12,0
  1155.  
  1156.  
  1157. ;*****************************************************************************
  1158. ;*****************************************************************************
  1159. ;
  1160. ;    Initialize and Enter Tetris
  1161. ;
  1162. TetrisSetup
  1163.     lea    $dff000,a6            ; A6 = Amiga Hardware
  1164.     lea    Variables(pc),a5        ; A5 = Tetris Variables
  1165.     bsr    SetupVideo            ; Initialize Video
  1166.     bra    EraseByteMap            ; Erase bytemap
  1167.  
  1168.  
  1169. ;*****************************************************************************
  1170. ;*****************************************************************************
  1171. ; Amiga Hardware System Specific Support & Resources
  1172.  
  1173. SetupVideo
  1174.     bsr    VideoBitPlanes            ; Setup Copper Bitplanes
  1175.     bsr    VideoClear
  1176.  
  1177.     lea    CopperList(pc),a0        ; (copy list to chip alloced)
  1178.     move.l    GameCopper(pc),a1
  1179.     move.l    a1,d1
  1180.     move.w    #130-1,d0            ; (guestimate)
  1181. 1$    move.l    (a0)+,(a1)+
  1182.     dbf    d0,1$
  1183.  
  1184.     move.l    d1,$80(a6)            ; Turn on View
  1185.     move.w    d1,$88(a6)
  1186.     move.w    #$87c0,$96(a6)            ; All DMA On + Blitter Nasty
  1187.     move.w    #2,$2e(a6)            ; Allow Copper Blits
  1188.     rts
  1189.  
  1190. VideoClear
  1191.     move.l    GameVideo(pc),a0
  1192.     move.w    #11*240-1,d0
  1193. 1$    clr.l    (a0)+
  1194.     clr.l    (a0)+
  1195.     clr.l    (a0)+
  1196.     clr.l    (a0)+
  1197.     clr.l    (a0)+
  1198.     dbf    d0,1$
  1199.     rts
  1200.  
  1201. ;
  1202. ;  **** note this works only once, afterwards I use a copy of this list 
  1203. ;
  1204.  
  1205. VideoBitPlanes
  1206.     move.l    ScreenMem(pc),d0        ; D0 = Address for Screen
  1207.     move.l    d0,d1
  1208.     lsr.l    #1,d1
  1209.     move.l    d1,GameVideo2(a5)        ; 1/2 Screen for fast blits
  1210.     lea    CopperPlanes(pc),a0        ; A0 = Copper Plane Op codes
  1211.     move.l    d0,GameVideo(a5)
  1212.     moveq    #5-1,d1                ; Setup plane pointers
  1213. 1$    move.w    d0,6(a0)
  1214.     swap    d0
  1215.     move.w    d0,2(a0)
  1216.     swap    d0
  1217.     add.w    #8,a0                ; Next Copper Poke
  1218.     add.l    #44,d0                ; Next Interleave Start
  1219.     dbf    d1,1$
  1220.     rts
  1221.  
  1222. WaitFrame
  1223.     cmp.b    #$e0,$dff006            ; Wait till past animations
  1224.     bne.s    WaitFrame
  1225. 1$    cmp.b    #$e2,$dff006
  1226.     bne.s    1$
  1227.     rts
  1228.  
  1229.  
  1230. ;*****************************************************************************
  1231. ;*****************************************************************************
  1232. ;
  1233. ;    Perform an Ultra smooth and efficient Color Fade in or out
  1234. ;    Supply    A0 = Destination CopperList (pass it -4)
  1235. ;        A1 = Source Color Table
  1236. ;
  1237.  
  1238. ColorFader
  1239.     moveq    #0,d4                ; Start Pass on RED
  1240.     move.w    #48-1,d5            ; Takes 48 Passes to finish
  1241. 3$    bsr    WaitFrame            ; Syncronize to frame
  1242.  
  1243.  
  1244. ;    lea    CopperColors-4(pc),a0        ; A0 = Copper Color Opcodes-4
  1245.  
  1246. ; (lets find the list in chip...yawn)
  1247.  
  1248.  lea CopperColors(pc),a0
  1249.  lea CopperList(pc),a1
  1250.  sub.l a1,a0
  1251.  add.l GameCopper(pc),a0
  1252.  subq.w #4,a0            ; (its wants to be -4 of it)
  1253.  
  1254.  
  1255. ; **** note: the reason I always sub.w #4,address-register is because
  1256. ;            the MC68xxx chips always sign extend to longword internally
  1257. ;         and its a moderately faster operation, as well as taking less
  1258. ;         memory than the sub.l counterpart (sub.b is not-legal by the way).
  1259.  
  1260.  
  1261.  
  1262.     lea    ColorTable(pc),a1        ; A1 = Color Table to Seek
  1263.  
  1264.  
  1265.     bsr    Col200                ; Perform pass of seek
  1266.     dbf    d5,3$                ; till done
  1267.     rts
  1268. Col200    addq.w    #4,a0
  1269.     move.w    (a0),d0
  1270.     cmp.w    #$ffff,d0            ; End of Copper List?
  1271.     beq.s    Col500
  1272.     cmp.w    #$0180,d0            ; Valid Color?
  1273.     bmi.s    Col200
  1274.     cmp.w    #$01c0,d0
  1275.     bpl.s    Col200
  1276.     move.w    2(a0),d1            ; Source Color
  1277.     moveq    #$f,d0                ; R G or B
  1278.     lsl.w    d4,d0
  1279.     move.w    (a1)+,d3            ; D3 = Dest Color
  1280.     move.w    d1,d2
  1281.     and.w    d0,d3
  1282.     and.w    d0,d2                ; Mask out Color
  1283.     and.w    #$111,d0
  1284.     cmp.w    d3,d2
  1285.     beq.s    Col400
  1286.     bmi.s    Col300
  1287.     neg.w    d0
  1288. Col300    add.w    d0,d1
  1289. Col400    move.w    d1,2(a0)            ; DEST
  1290.     bra.s    Col200
  1291. Col500    addq.w    #4,d4                ; R G or B?
  1292.     cmp.w    #12,d4
  1293.     bne.s    Col600
  1294.     moveq    #0,d4
  1295. Col600    rts
  1296.  
  1297.  
  1298. ;*****************************************************************************
  1299. ;*****************************************************************************
  1300.  
  1301. AllocMem    equ    -30-168
  1302. FreeMem        equ    -30-180
  1303.  
  1304. piecessize    equ 7*(8*4)*(5*2*8)        ; #*pieces*rots * dep*wid*het
  1305. memorysize    equ 240*44*5+9000+piecessize    ; (scn het*wid*dep+snd+pieces)
  1306. memorysize2    equ memorysize + 80*4        ; (copper list too)
  1307.  
  1308.  
  1309. AllocatePieces
  1310.     move.l    #memorysize2,d0
  1311.     move.l    #2,d1
  1312.     move.l    4,a6                ; Exec base
  1313.     jsr    AllocMem(a6)
  1314.     tst.l    d0                ; D0 = 0 = Failed
  1315.     beq.s    AllocateMemory900
  1316.  
  1317.                         ; Divvy up the memory
  1318.     lea    GameCopper(pc),a0
  1319.     move.l    d0,(a0)
  1320.     add.l    #130*4,d0
  1321.  
  1322.     lea    ScreenMem(pc),a0
  1323.     move.l    d0,(a0)
  1324.     add.l    #240*44*5,d0
  1325.  
  1326.     ;lea    AudioMem(pc),a0        (used proper loader now jan 29 90)
  1327.     ;move.l    d0,(a0)
  1328.     ;add.l    #9000,d0
  1329.  
  1330.     lea    PiecesMem(pc),a0
  1331.     move.l    d0,(a0)
  1332.                         ; D0 != 0 = Success
  1333. AllocateMemory900
  1334.     rts
  1335.  
  1336. FreePieces
  1337.     move.l    4,a6
  1338.     move.l    GameCopper(pc),a1
  1339.     move.l    #memorysize2,d0
  1340.     jmp    FreeMem(a6)
  1341.  
  1342. ;*****************************************************************************
  1343. ;*****************************************************************************
  1344.  
  1345. ReadJoy    move.w    PlayerPort(a4),d0        ; Read Amiga Port Hardware
  1346.     move.w    (a6,d0.w),d0            ; Amiga Hardware
  1347.     and.w    #$0303,d0            ; (see hardware ref manual)
  1348.     move.w    d0,d1
  1349.     lsr.w    #1,d1
  1350.     eor.w    d0,d1                ; D0 = %LU------RD
  1351.     rts
  1352.  
  1353. ;*****************************************************************************
  1354. ;*****************************************************************************
  1355.  
  1356. ; When playing with custom registers be careful about $dff02a, because
  1357. ; you can physically damage the Amiga by de-syncronizing the vertical
  1358. ; framing, the same applies for $dff1dc (PAL/NTSC switch) on FAT AGNES ONLY.
  1359.  
  1360. MachineTakeover
  1361.     move.b    #32,$dff1dc            ; Goto PAL Mode
  1362.  
  1363.     move.l    4,a6                ; Exec
  1364.     lea    library(pc),a1            ; Find Amiga DosLibrary
  1365.     jsr    -408(a6)            ; D0 = Open Graphics Library
  1366.  
  1367.     lea    MachineVariables(pc),a3        ; a3 = Variable Workspace
  1368.     move.l    d0,a6                ; GraphicsBase
  1369.     move.l    38(a6),-(a3)            ; Save System Copper Ptr
  1370.  
  1371.     move.w #3*60,d1                ; Allow Amiga to Cool off
  1372. 9$    cmp.b  #$20,$dff006
  1373.     bne.s  9$
  1374. 8$    cmp.b  #$22,$dff006
  1375.     bne.s  8$
  1376.     move.w d1,$dff180
  1377.     dbf   d1,9$
  1378.                 ;(can't do this: overrides my music)
  1379.     ;move.l    4,a6                ; ExecBase
  1380.     ;jsr    -120(a6)            ; Call Disable();
  1381.  
  1382.     lea    $dff000,a6            ; A6 = Amiga Hardware
  1383.     move.w    $2(a6),-(a3)            ; Save DMA Enabled
  1384.     move.w    $1c(a6),-(a3)            ; Save Interupts Enabled
  1385.     move.l    $68,-(a3)            ; Save System Keyboard Handler
  1386.     move.l    $c,-(a3)            ; Trap Guru Meditations
  1387.     move.l    $10,-(a3)            ;
  1388.     lea    MachineCrash(pc),a0
  1389.     move.l    a0,$c
  1390.     move.l    a0,$10
  1391.                 ;(i decided to be nicer to the system here)
  1392.     ;move.w    #$7fff,$9a(a6)            ; Freeze Interupts
  1393.     ;move.w    #$7fff,$96(a6)            ; Freeze DMA
  1394.  
  1395.     lea    MachineReturn(pc),a0        ; Trap Gurus to my handler
  1396.     move.l    a0,$10                ;
  1397.     move.l    a0,$12                ;
  1398.     lea    KeyboardInterupt(pc),a0        ; A0 = Interupt Handler
  1399.     move.l    a0,$68                ; Setup My Keyboard Handler
  1400.     move.w    #$c008,$9a(a6)            ; Enable Keyboard Interupts
  1401.     lea    oldtrap(pc),a0
  1402.     move.l    $80,(a0)
  1403.     lea    Supervisor(pc),a0        ; Enter Supervisor Mode
  1404.     move.l    a0,$80                ; Setup Trap
  1405.     move.l    (a7)+,a0            ; A0 = Caller
  1406.     move.l    a7,-(a3)            ; Remember User Stack
  1407.     trap    #0                ; Goto Hardware Trap
  1408. library    dc.b    "graphics.library",0,0        ; Dos Library Name
  1409. Supervisor
  1410.     move.l    a7,-(a3)            ; Remember Supervisor Stack
  1411.     jmp    (a0)                ; Return to Caller
  1412. ;-----------------------------------------------------------------------------
  1413.  
  1414. MachineCrash
  1415.     lea    Variables(pc),a0
  1416.     move.l    a0,$7ff00            ; Store Crash to ABS place
  1417.     move.l    2(a7),$7ff04
  1418.     move.l    6(a7),$7ff08
  1419.     move.l    10(a7),$7ff0c
  1420.  
  1421. MachineReturn
  1422.     btst    #14,$02(a6)
  1423. 1$    btst    #14,$02(a6)            ; Blitter done?
  1424.     bne.s    1$
  1425.  
  1426.     move.b    #2,$1dc(a6)            ; Exit PAL, goto NTSC Mode
  1427.     ;move.w    #$7fff,$96(a6)            ; Stop all DMA
  1428.     ;move.w    #$7fff,$9a(a6)            ; Stop all Interupts
  1429.  
  1430.     lea    Supervisor2(pc),a0        ; Goto supervisor (again)
  1431.     move.l    a0,$80                ; Setup Trap
  1432.     trap    #0                ; Goto Hardware Trap
  1433. Supervisor2
  1434.     move.l    oldtrap(pc),$80
  1435.  
  1436.     lea    MachineVariables2(pc),a3    ; a3 = Machine Variables
  1437.     move.l    (a3)+,a7            ; Restore Supervisor stack
  1438.     move.w    #0,sr                ; Exit Supervisor Mode
  1439.     move.l    (a3)+,a7            ; Restore User stack
  1440.  
  1441.     move.l    (a3)+,$10            ; Restore Guru ""handlers""
  1442.     move.l    (a3)+,$c            ;
  1443.     move.l    (a3)+,$68            ; Replace Sys Keyboard Handler
  1444.     move.l    (a3)+,d1            ; System DMA bits
  1445.  
  1446.     lea    $dff000,a6            ; A6 = Hardware
  1447.     move.w    #0,$2e(a6)            ; Turn Off Copper Blits
  1448.     move.l    (a3),$80(a6)            ; Restore System Copper
  1449.     move.w    d0,$88(a6)            ; Forceload Copper
  1450.  
  1451. ; Note the super-fat agnes is using some undefined DMA channels, I
  1452. ; have found that I can no longer safely turn off all the DMA, so I just
  1453. ; try to manage what I can glean.
  1454.  
  1455.     or.w    #$8200,d1            ; Set Enable DMA Bit
  1456.     move.w    #$1ff,$96(a6)
  1457.     move.w    d1,$96(a6)            ; Reenable System DMA
  1458.  
  1459.     swap    d1                ; System Interupt Bits
  1460.     not.w    d1                ;
  1461.     bclr.l    #15,d1                ;
  1462.     move.w    d1,$9a(a6)            ; (verify off non-sys Ints)
  1463.     not.w    d1                ; (i do this as example only)
  1464.     move.w    #$7fff,$9c(a6)            ; Clear all Interupts Pending
  1465.     move.w    d1,$9a(a6)            ; Reenable System Interupts
  1466.  
  1467.     ;move.l    4,a6                ; ExecBase
  1468.     ;jsr    -126(a6)            ; Enable();
  1469.     bra    TetrisExit            ; Free system type resources
  1470.  
  1471. MachineVariables2                ; (list tail)
  1472.         dcb.l    7,0
  1473. MachineVariables
  1474. oldtrap        dc.l    0
  1475.  
  1476. ;-----------------------------------------------------------------------------
  1477. KeyboardInterupt
  1478.     movem.l    d0/a0,-(a7)            ; Save Registers
  1479.     move.b    $bfed01,d0            ; Clear Interupt Requests
  1480.     ;($bfed01 must be done pronto or next int will be cleared instead)
  1481.     btst.l    #3,d0                ; Not My Interupt?
  1482.     beq.s    KeyboardInterupt900
  1483.     move.b    $bfec01,d0            ; D0 = Read Keyboard
  1484.     or.b    #64,$bfee01            ; PULSE KDAT LOW FOR 75 usec
  1485.     eor.b    #254,d0                ; Mask of Hardware Shift
  1486.     lsr.b    #1,d0                ; Get to Real
  1487.     bcc.s    KeyboardInterupt500        ; Get Key Down Events Only
  1488.     ext.w    d0                ; Clean for 68030 indirect
  1489.     move.b    KeyMap(pc,d0.w),d0        ; Get Real Key
  1490.     lea    KeyEvent(pc),a0
  1491.     move.b    d0,(a0)                ; Remember Key
  1492. KeyboardInterupt500
  1493.     move.w    #999,d0                ; >= 75 usec(should be timed)
  1494. 1$    dbf    d0,1$
  1495.     and.b    #$bf,$bfee01            ; UNPULSE KEYBOARD
  1496. KeyboardInterupt900
  1497.     movem.l    (a7)+,d0/a0            ; Return Registers
  1498.     move.w    #8,$dff09c            ; Clear Interupt Bit
  1499.     rte                    ; Exit
  1500.  
  1501. ; (I used this for reference on doing SERIAL input for the MIDI stuff)
  1502.  
  1503. KeyMap        dc.l    $60313233,$34353637,$3839302d,$3d5c0000
  1504.         dc.l    $51574552,$54595549,$4f505b5d,$00313233
  1505.         dc.l    $41534446,$47484a4b,$4c3b270d,$00343536
  1506.         dc.l    $005a5843,$56424e4d,$2c2e2f00,$00373839
  1507.         dc.l    $200a000d,$0d7b0a00,$00002d00,$1c1d1e1f
  1508.         dc.l    $11121314,$15161718,$191a0000,$00000000
  1509.         dc.l    $00000000,$00000000,$00000000,$00000000
  1510.         dc.l    $00000000,$00000000,$00000000,$00000000
  1511.  
  1512.  
  1513. ;*****************************************************************************
  1514. ;*****************************************************************************
  1515.  
  1516. SayName
  1517.     lea    Name(pc),a0    ; (whoops, almost forgot)
  1518.     move.l    GameVideo(pc),a1
  1519.     lea    44(a1),a1    ; (change color)
  1520.     bra    PrintText
  1521. Name:    dc.w    14*8,29*8
  1522.     dc.b    'An Anselm Hook Game',0
  1523.     even
  1524.  
  1525. DoIntro
  1526.     lea    ScrollMessage(pc),a0
  1527.     lea    ScrollPos(pc),a1
  1528.     move.l    a0,(a1)
  1529.  
  1530.     lea    IntroText(pc),a0        ; Print Instructions
  1531.     move.l    GameVideo(pc),a1
  1532.     bsr    PrintText
  1533.     bsr    ColorFader            ; Bring on view nicely
  1534.  
  1535. 1$    lea    KeyEvent(pc),a0
  1536.     cmp.b    #$7b,(a0)
  1537.     beq    MachineReturn
  1538.     bsr    DoScrollText
  1539.  
  1540.     btst    #7,$bfe001            ; Wait for User Done
  1541.     beq.s    2$                ; Go right into game no pause
  1542.     btst    #6,$bfe001
  1543.     bne.s    1$
  1544. 2$    bra    VideoClear
  1545.  
  1546. DoScrollText
  1547.     lea    ScrollPos(pc),a0
  1548.     tst.l    4(a0)
  1549.     beq.s    2$
  1550.     subq.l    #1,4(a0)
  1551.     bra    WaitFrame
  1552. 2$    move.l    (a0),a1
  1553.     move.b    (a1)+,d0            ; D0 = Character #
  1554.     bne.s    1$
  1555.     lea    ScrollMessage(pc),a1
  1556.     move.b    (a1)+,d0            ; (prefetch!)
  1557. 1$    move.l    a1,(a0)
  1558.     moveq    #7,d1                ; D1 = Horiz Bit Pos #
  1559. 0$    movem.w    d0/d1,-(a7)
  1560.     bsr    PrintColumn
  1561.     movem.w    (a7)+,d0/d1
  1562.     dbf    d1,0$
  1563.     rts
  1564.  
  1565. ScrollPos:    dc.l    0,60*5
  1566.  
  1567. IntroText:
  1568.     dc.w    20,40
  1569.         ;0123456789012345678901234567890123456789
  1570.     dc.b    $84,"             Amiga Tetris",13
  1571.     dc.b    13
  1572.     dc.b    "   Press Escape to Exit to Workbench",13
  1573.     dc.b    "       Press ",$87,"Fire",$80,$82," Button to play",13
  1574.     dc.b    13
  1575.     dc.b    "   Move falling pieces with Joystick",13
  1576.     dc.b    "    Rotate pieces with fire button ",13
  1577.     dc.b    "  Interlock pieces to make an unbroken",13
  1578.     dc.b    " line before pieces overflow playfield ",13
  1579.     dc.b    "   Completed lines are automagically",13
  1580.     dc.b    "  zapped away.  Lines required to win",13
  1581.     dc.b    "   level are shown at left of field ",13
  1582.     dc.b    13
  1583.     dc.b    "     Amiga Tetris is public domain",13
  1584.     dc.b    " and is intended primarily as a tutorial",13
  1585.     dc.b    "     on Machine Language programming",13
  1586.     dc.b    13
  1587.     dc.b    " Due to Tetris.s running in PAL Mode you",13
  1588.     dc.b    " may have to:",13
  1589.     dc.b    $84,"                   ADJUST VERTICAL HOLD!",13
  1590.     dc.b    13
  1591.     dc.b    0
  1592.  
  1593. ;*****************************************************************************
  1594. ;*****************************************************************************
  1595.  
  1596. ;
  1597. ;    I reserve some address registers for specific use
  1598. ;
  1599. ;        A6  = Amiga Hardware
  1600. ;        A5  = Variables, allowing me to do  move.w d0,variable(a5)
  1601. ;              (which is more flexible than  move.w d0,variable(pc))
  1602. ;        A4  = Current player vars, allowing infinite # of players.
  1603. ;
  1604.  
  1605. ; To Do:
  1606. ; * - pause at level end, with music restart.
  1607. ; * - music 1/2 volume
  1608. ; * - different end of line sound
  1609. ; * - raisers later, and slower
  1610. ; * - (slow music, music speeds up every level)
  1611. ; * - tiles speed up every level
  1612. ; * - instructions
  1613. ; * - turn off sprites
  1614. ; * - make easier, raisers later
  1615. ; * - supervisor multi-player merge/scan
  1616. ; * - sound for end of line + bonuses + randoms + raisers
  1617. ; * - pause
  1618. ; * - less rows at start
  1619. ; * - inc rows, music speed algorithm of level
  1620. ;   - single, double, three, tetris bonuses
  1621. ;   - statistics on side bar
  1622. ;   - support rotate agains right wall
  1623. ;   - remove mulus
  1624.  
  1625.     end
  1626.  
  1627. ; end of tetris.s
  1628.