Prince-of-Persia-Apple-II

A running-jumping-swordfighting game Jordan Mechner made on the Apple II from 1985-89
Log | Files | Refs | README | LICENSE

COLL.S (21157B)


      1 * coll
      2 org = $4500
      3  tr on
      4  lst off
      5 *-------------------------------
      6 *
      7 *  PRINCE OF PERSIA
      8 *  Copyright 1989 Jordan Mechner
      9 *
     10 *-------------------------------
     11  org org
     12 
     13  jmp CHECKBARR
     14  jmp COLLISIONS
     15  jmp GETFWDDIST
     16  jmp CHECKCOLL
     17  jmp ANIMCHAR
     18 
     19  jmp CHECKSLICE
     20  jmp CHECKSLICE2
     21  jmp markmeters ;temp
     22  jmp CHECKGATE
     23  jmp firstguard ;temp
     24 
     25  jmp ENEMYCOLL
     26 
     27 *-------------------------------
     28  lst
     29  put eq
     30  lst
     31  put gameeq
     32  lst
     33  put seqdata
     34  lst
     35  put soundnames
     36  lst
     37  put movedata
     38  lst off
     39 
     40  dum $f0
     41 ztemp ds 1
     42 CollFace ds 1
     43 tempobjid ds 1
     44 tempstate ds 1
     45  dend
     46 
     47 *-------------------------------
     48 *  Distance in pixels from either edge of block to barrier
     49 *  BarL + BarR + BarWidth == 14
     50 *
     51 *  Indexed by barrier code:
     52 *  0 = clear, 1 = panel/gate, 2 = flask, 3 = mirror/slicer
     53 *  4 = block
     54 
     55 BarL db 0,12,2,0,0
     56 BarR db 0,0,9,11,0
     57 
     58 *-------------------------------
     59 DeathVelocity = 33
     60 OofVelocity = 22
     61 
     62 gatemargin = 6 ;higher = more generous
     63 
     64 ]rts rts
     65 *-------------------------------
     66 *
     67 *  C H E C K  B A R R I E R
     68 *
     69 *  Check for collisions with vertical barriers
     70 *
     71 *-------------------------------
     72 CHECKBARR
     73  lda #-1 ;"no-collision" flag
     74  sta collideL
     75  sta collideR
     76 
     77 * Check for situations where character is temporarily
     78 * "collision-proof"
     79 
     80  lda CharAction
     81  cmp #7 ;turning?
     82  beq ]rts
     83 
     84 * Initialize CD/SN buffers
     85 * (Copy "lastframe" data from "thisframe", "above", or "below";
     86 * init "thisframe" with FF)
     87 
     88  lda CharBlockY
     89  sta BlockYthis
     90 
     91  jsr initCDbufs
     92 
     93  lda BlockYthis
     94  sta BlockYlast
     95 
     96 * Get beginning & end of range
     97 
     98  lda CDRightEj
     99  jsr getblockxp
    100  clc
    101  adc #2
    102  cmp #11
    103  bcc :ok
    104  lda #11
    105   ;Last (rightmost) block in range +1
    106 :ok sta endrange
    107 
    108  lda CDLeftEj
    109  jsr getblockxp
    110  tax
    111  dex ;First (leftmost) block in range
    112  stx begrange
    113 
    114 * Get CD & SN data for every block in range [begrange..endrange]
    115 * on this level (BlockYthis) and on levels below & above
    116 
    117 * This level...
    118 
    119  lda BlockYthis
    120  sta blocky
    121 
    122  lda #SNthisframe
    123  ldx #CDthisframe
    124  jsr getCData
    125 
    126 * Level below...
    127 
    128  lda BlockYthis
    129  clc
    130  adc #1
    131  sta blocky
    132 
    133  lda #SNbelow
    134  ldx #CDbelow
    135  jsr getCData
    136 
    137 * ...and level above
    138 
    139  lda BlockYthis
    140  sec
    141  sbc #1
    142  sta blocky
    143 
    144  lda #SNabove
    145  ldx #CDabove
    146  jsr getCData
    147 
    148 * Got new data... now compare thisframe with lastframe
    149 * If a nybble has changed from 0 to 1, we have a collision.
    150 
    151  ldx #9
    152 :loop2
    153  lda SNthisframe,x
    154  bmi :no ;ff = no data for this frame
    155  cmp SNlastframe,x
    156  bne :no ;no corresponding data for last frame
    157 
    158  lda CDlastframe,x
    159  and #$0f ;low nybble first (L edge of barr)
    160  bne :noL
    161 
    162  lda CDthisframe,x
    163  and #$0f
    164  beq :noL
    165 
    166  stx collideL ;We have collision w/ L edge
    167 ;x = block # (0-9)
    168 
    169 :noL lda CDlastframe,x
    170  and #$f0 ;hi nybble (R edge of barr)
    171  bne :noR
    172 
    173  lda CDthisframe,x
    174  and #$f0
    175  beq :noR
    176 
    177  stx collideR ;collision w/ R edge
    178 :noR
    179 :no dex
    180  bpl :loop2
    181 
    182  ldx collideL
    183  ldy collideR
    184 
    185 ]rts rts
    186 
    187 *-------------------------------
    188 *
    189 *  G E T  C D A T A
    190 *
    191 *  Get "thisframe" data for specified blocky
    192 *
    193 *-------------------------------
    194 getCData
    195  sta :smodSN+1
    196  stx :smodCD+1
    197 
    198  lda begrange
    199  jsr getblockej ;left edge of block
    200  clc
    201  adc #angle ;perspective
    202  sta blockedge
    203 
    204  ldx begrange
    205 :loop stx bufindex
    206 
    207 * First compare L edge of barr with R edge of char
    208 
    209  lda CharScrn
    210  ldx bufindex
    211  ldy blocky
    212  jsr getleftbar ;Get left edge of barrier
    213 
    214  cmp CDRightEj
    215  bcc :RofL
    216  ;= means L of L
    217 :LofL lda #0
    218  beq :cont1
    219 
    220 :RofL lda #$f
    221 :cont1 sta ztemp
    222 
    223 * Now compare R edge of barr with L edge of char
    224 
    225  lda CharScrn
    226  ldx bufindex
    227  ldy blocky
    228  jsr getrightbar ;Get right edge of barrier
    229 
    230  cmp CDLeftEj
    231  bcc :RofR
    232  beq :RofR ;= means R of R
    233 
    234 :LofR lda #$f0
    235  bne :cont2
    236 
    237 :RofR lda #0
    238 :cont2 ora ztemp
    239 
    240  ldx tempblockx ;guaranteed 0-9 by rdblock
    241 :smodCD sta CDthisframe,x
    242 
    243  lda tempscrn
    244 :smodSN sta SNthisframe,x ;screen #
    245 
    246  lda blockedge
    247  clc
    248  adc #14
    249  sta blockedge
    250 
    251  ldx bufindex
    252  inx
    253  cpx endrange
    254  bne :loop
    255 
    256 ]rts rts
    257 
    258 *-------------------------------
    259 *
    260 *  I N I T   C D B U F S
    261 *
    262 *  Initialize SN and CD buffers
    263 *  (Take "lastframe" data from "thisframe", "above", or "below";
    264 *  init "thisframe" with FF)
    265 *
    266 *-------------------------------
    267 initCDbufs
    268  lda BlockYthis
    269  cmp BlockYlast ;same BlockY as last frame?
    270  beq :usethis ;yes--copy data from "thisframe"
    271 
    272  clc
    273  adc #3
    274  cmp BlockYlast
    275  beq :usethis
    276 
    277  sec
    278  sbc #6
    279  cmp BlockYlast
    280  beq :usethis
    281 
    282 * BlockY has changed--copy data from "above" or "below"
    283 
    284  lda BlockYthis
    285  clc
    286  adc #1
    287  cmp BlockYlast
    288  beq :useabove
    289  sec
    290  sbc #3
    291  cmp BlockYlast
    292  beq :useabove
    293 
    294 :usebelow
    295  lda #SNbelow
    296  ldx #CDbelow
    297  jmp :cont
    298 
    299 :useabove lda #SNabove
    300  ldx #CDabove
    301  jmp :cont
    302 
    303 :usethis lda #SNthisframe
    304  ldx #CDthisframe
    305 
    306 :cont sta :smodSN+1
    307  stx :smodCD+1
    308 
    309 * Copy contents of appropriate SN & CD buffers (thisframe,
    310 * below, or above) into lastframe buffers...
    311 * and initialize SN buffers with $ff
    312 
    313  ldx #9
    314 :zloop
    315 :smodSN lda SNbelow,x
    316  sta SNlastframe,x
    317 
    318 :smodCD lda CDbelow,x
    319  sta CDlastframe,x
    320 
    321  lda #$ff
    322  sta SNthisframe,x
    323  sta SNabove,x
    324  sta SNbelow,x
    325 
    326  dex
    327  bpl :zloop
    328 
    329 ]rts rts
    330 
    331 *-------------------------------
    332 *
    333 *  G E T   L E F T   B A R
    334 *
    335 *  Get X-coord of left edge of barrier
    336 *
    337 *  In:  X/Y/A = blockx/blocky/scrn
    338 *       blockedge
    339 *
    340 *  Out: A = screen X-coord (140)
    341 *       Return A = 255 if this block is no barrier
    342 *
    343 *-------------------------------
    344 getleftbar
    345  jsr rdblock ;get block ID
    346 
    347  jsr cmpbarr ;return A = barrier code #
    348  beq :clear ;or -1 if clear
    349  tay
    350 
    351  lda blockedge
    352  clc
    353  adc BarL,y ;barr dist from L edge of block
    354  sec
    355  rts
    356 
    357 :clear lda #255
    358  clc
    359  rts
    360 
    361 *-------------------------------
    362 *
    363 *  G E T   R I G H T   B A R
    364 *
    365 *  Get right edge of barrier, 0 if clear
    366 *
    367 *-------------------------------
    368 getrightbar
    369  jsr rdblock
    370 
    371  jsr cmpbarr
    372  beq :clear
    373  tay
    374 
    375  lda blockedge
    376  clc
    377  adc #13
    378  sec
    379  sbc BarR,y ;barr dist from R edge of block
    380  sec
    381  rts
    382 
    383 :clear lda #0
    384  clc
    385 ]rts rts
    386 
    387 *-------------------------------
    388 *
    389 *  C O L L I S I O N S
    390 *
    391 *  If a collision was detected, act on it
    392 *
    393 *  In: collideL/R: - if no coll, 0-9 refers to block in
    394 *      which collision occurred
    395 *
    396 *  (CollideL is collision with LEFT EDGE of barrier
    397 *  CollideR is collision with RIGHT EDGE of barrier)
    398 *
    399 *-------------------------------
    400 COLLISIONS
    401  lda AMtimer ;antimatter timer
    402  beq :cont
    403  lda $c030
    404  dec AMtimer
    405  rts
    406 :cont
    407 
    408 * Check for situations where we let character
    409 * pass thru barrier (e.g., climbing up onto ledge)
    410 
    411  lda CharAction
    412  cmp #2 ;hanging?
    413  beq ]rts
    414  cmp #6 ;hanging?
    415  beq ]rts
    416  lda CharPosn
    417  cmp #135
    418  bcc :cont2
    419  cmp #149
    420  bcc ]rts ;climbing?
    421 
    422 :cont2
    423  ldx collideL
    424  bmi :noL
    425  stx collX
    426  jmp leftcoll
    427 
    428 :noL ldx collideR
    429  bmi :noR
    430  stx collX
    431  jmp rightcoll
    432 :noR
    433 ]rts rts
    434 
    435 *-------------------------------
    436 *
    437 *  R I G H T   C O L L I S I O N
    438 *
    439 *-------------------------------
    440 rightcoll
    441  lda CharSword
    442  cmp #2 ;if in fighting mode,
    443  beq :1 ;waive front-facing requirement
    444 
    445  lda CharFace
    446  bpl ]rts
    447 :1
    448  jsr checkcoll1
    449  bcc ]rts
    450 
    451  lda tempscrn
    452  ldx tempblockx
    453  ldy tempblocky
    454 
    455  jsr getrightbar ;edge of barr
    456  sec
    457  sbc CDLeftEj ;dist to char
    458 
    459  ldx #0 ;right
    460  jmp collide
    461 
    462 *-------------------------------
    463 *
    464 *  L E F T   C O L L I S I O N
    465 *
    466 *-------------------------------
    467 leftcoll
    468  lda CharSword
    469  cmp #2
    470  beq :1
    471 
    472  lda CharFace
    473  bne ]rts
    474 :1
    475  jsr checkcoll1
    476  bcc ]rts
    477 
    478  lda tempscrn
    479  ldx tempblockx
    480  ldy tempblocky
    481  jsr getleftbar
    482  sec
    483  sbc CDRightEj ;- dist to char
    484 
    485  ldx #-1 ;left
    486  jmp collide
    487 
    488 *-------------------------------
    489 *
    490 * Call CHECKCOLL for block #X
    491 *
    492 * In: CD data; X = blockx
    493 *
    494 *-------------------------------
    495 checkcoll1
    496  stx tempblockx
    497 
    498  lda CharBlockY
    499  bpl :2
    500  clc
    501  adc #3
    502  bne :1
    503 
    504 :2 cmp #3
    505  bcc :1
    506  sec
    507  sbc #3
    508 :1 sta tempblocky
    509 
    510  lda SNthisframe,x
    511  sta tempscrn
    512 
    513  jsr rdblock1
    514 
    515  jmp CHECKCOLL
    516 
    517 *-------------------------------
    518 *
    519 *  C H E C K   C O L L
    520 *
    521 *  In: RDBLOCK results (A = objid)
    522 *
    523 *  Out: tempblockx,tempblocky,tempscrn
    524 *       cs if collision, cc if not
    525 *
    526 *-------------------------------
    527 CHECKCOLL
    528  cmp #flask
    529  beq :no ;flask is not really a barrier
    530 
    531  cmp #gate
    532  beq :gate
    533 
    534  cmp #slicer
    535  beq :slicer
    536 
    537  cmp #mirror
    538  beq :mirror
    539  bne :c1
    540 
    541 * You can pass thru mirror from R only if you take a
    542 * running jump
    543 
    544 :mirror
    545  lda CharID
    546  bne :c1 ;must be kid
    547  lda CharPosn
    548  cmp #39
    549  bcc :c1
    550  cmp #44
    551  bcs :c1
    552  lda CharFace
    553  bpl :c1
    554 
    555  jsr smashmirror
    556  lda #$ff
    557  sta createshad ;set flag
    558 
    559  clc
    560  rts
    561 
    562 * Is slicer closed?
    563 
    564 :slicer lda (BlueSpec),y
    565  cmp #slicerExt
    566  bne :no ;no--pass thru
    567  beq :c1
    568 
    569 * Is gate low enough to bar you?
    570 
    571 :gate jsr gatebarr? ;return cc if gate bars you
    572  bcc :c1
    573 
    574 * no collision--pass thru barrier
    575 
    576 :no clc
    577  rts
    578 
    579 * Yes, collision--get blockedge & return cs
    580 
    581 :c1
    582  lda tempblockx
    583  jsr getblockej
    584  jsr AdjustScrn
    585  clc
    586  adc #angle
    587  sta blockedge
    588 :yes sec
    589 ]rts rts
    590 
    591 *-------------------------------
    592 *
    593 * AdjustScrn
    594 *
    595 * In:  tempscrn, VisScrn
    596 *      scrnLeft/Right/BelowL/BelowR
    597 *      A = X-coord on tempscrn
    598 *
    599 * Out: A = X=coord on VisScrn
    600 *
    601 *-------------------------------
    602 AdjustScrn
    603  ldx tempscrn
    604  cpx VisScrn
    605  beq ]rts
    606  cpx scrnLeft
    607  beq :osL
    608  cpx scrnBelowL
    609  beq :osL
    610  cpx scrnRight
    611  beq :osR
    612  cpx scrnBelowR
    613  beq :osR
    614  rts
    615 :osR clc
    616  adc #ScrnWidth
    617  rts
    618 :osL sec
    619  sbc #ScrnWidth
    620 ]rts rts
    621 
    622 *-------------------------------
    623 *
    624 *  C O L L I D E
    625 *
    626 *  In: A = distance from barrier to character
    627 *      X = coll direction (-1 = left, 0 = right)
    628 *      tempblockx,y,scrn set for collision block
    629 *
    630 *-------------------------------
    631 collide
    632  stx CollFace ;temp var
    633 
    634  ldx CharLife ;dead?
    635  bpl ]rts ;yes--let him finish falling (or whatever)
    636 
    637  ldx CharPosn
    638  cpx #177 ;impaled?
    639  beq ]rts ;yes--ignore collision
    640 
    641  clc
    642  adc CharX
    643  sta CharX
    644 
    645 * In midair or on the ground?
    646 
    647  jsr rdblock1
    648 
    649  ldx CollFace
    650  bpl :faceL
    651 
    652  cmp #block ;If this block has no floor,
    653  beq :2 ;use the one in front of it
    654  bne :1
    655 
    656 :2 dec tempblockx
    657  jmp :3
    658 
    659 :faceL cmp #panelwof ;Panelwof is only a problem
    660  beq :4 ;when facing L
    661  cmp #panelwif
    662  beq :4
    663  cmp #block
    664  bne :1
    665 
    666 :4 inc tempblockx
    667  lda tempscrn
    668  bne :3
    669  lda tempblockx
    670  cmp #10
    671  bne :3
    672  lda CharScrn
    673  sta tempscrn
    674  lda #0
    675  sta tempblockx ;screen 0 block 10 = CharScrn block 0
    676 
    677 :3 jsr rdblock1
    678 
    679 :1 jsr cmpspace
    680  bne GroundBump
    681 
    682 *-------------------------------
    683 * Bump into barrier w/o floor
    684 
    685 AirBump
    686  lda #-4
    687  jsr addcharx
    688  sta CharX
    689 
    690  lda CharAction
    691  cmp #4 ;already falling?
    692  bne :3
    693 ;yes--just rebound off wall
    694  lda #0
    695  sta CharXVel
    696  beq :smackwall
    697 
    698 :3 lda #bumpfall
    699  jsr jumpseq
    700  jsr animchar
    701 
    702 :smackwall
    703 
    704 BumpSound
    705  lda #1
    706  sta alertguard
    707  lda #SmackWall
    708  jmp addsound
    709 
    710 *-------------------------------
    711 * Bump into barrier w/floor
    712 
    713 GroundBump
    714  ldx CharBlockY
    715 
    716  lda CharSword
    717  cmp #2
    718  beq :skipair ;no airbump if en garde
    719 
    720  lda FloorY+1,x
    721  sec
    722  sbc CharY
    723  cmp #15 ;constant
    724  bcs AirBump
    725 :skipair
    726  lda FloorY+1,x
    727  sta CharY
    728 
    729  lda CharYVel
    730  cmp #OofVelocity
    731  bcc :okvel
    732  lda #-5
    733  jsr addcharx
    734  sta CharX
    735  rts ;let checkfloor take care of it
    736 
    737 :okvel lda #0
    738  sta CharYVel
    739 
    740  lda CharLife
    741  beq :deadbump
    742 
    743 * Is he en garde?
    744 
    745  lda CharSword
    746  cmp #2
    747  beq :CollideEng ;yes--collide en garde
    748 
    749 * Should it be a hard or a soft bump?
    750 
    751 :normal
    752  ldx CharPosn ;last frame
    753 
    754  cpx #24
    755  beq :hard
    756  cpx #25
    757  beq :hard ;standjump-->hard
    758 
    759  cpx #40
    760  bcc :1
    761  cpx #43
    762  bcc :hard ;runjump-->hard
    763 
    764 :1 cpx #102
    765  bcc :2
    766  cpx #107
    767  bcc :hard ;freefall-->hard
    768 
    769 :2
    770 
    771 :soft lda #bump
    772  jsr jumpseq
    773  jsr BumpSound ;soft bump sound?
    774  jmp animchar
    775 
    776 :hard lda #hardbump
    777 :doit jsr jumpseq
    778  jsr animchar
    779 
    780  jmp BumpSound
    781 
    782 * dead when he hits the wall
    783 
    784 :deadbump
    785 ]rts rts
    786 
    787 *-------------------------------
    788 * Collide en garde
    789 
    790 :CollideEng
    791  lda CollFace
    792  cmp CharFace
    793  beq :collback
    794 
    795  lda #bumpengfwd
    796  bne :doit
    797 
    798 * Char is en garde & trying to back into barrier
    799 
    800 :collback
    801  lda #bumpengback
    802  jsr jumpseq
    803  jsr animchar ;get new frame
    804 
    805  lda #1
    806  jsr addcharx
    807  sta CharX
    808  rts
    809 
    810 *-------------------------------
    811 *
    812 *  G E T   F W D   D I S T
    813 *
    814 *  In: Char data
    815 *
    816 *  Out: A = size of "careful step" forward (0-14 pixels)
    817 *       X = what you're stepping up to
    818 *           (0 = edge, 1 = barrier, 2 = clear)
    819 *       RDBLOCK results for that block
    820 *
    821 *-------------------------------
    822 GETFWDDIST
    823 
    824 * Get edges
    825 
    826  jsr GetBaseBlock
    827  jsr setupchar
    828  jsr getedges
    829 
    830 * If this block contains barrier, get distance
    831 
    832  jsr getunderft ;read block underfoot
    833  sta tempobjid
    834 
    835  jsr cmpbarr
    836  beq :nextb ;This block is clear
    837 
    838  lda CharBlockX
    839  sta tempblockx
    840  jsr DBarr ;returns A = dist to barrier
    841  tax
    842  bpl :tobarr
    843 
    844 * If next block contains barrier, get distance
    845 
    846 :nextb
    847  jsr getinfront
    848  sta tempobjid
    849  cmp #panelwof
    850  bne :99 ;Panelwof is special case
    851  ldx CharFace ;if you're facing R
    852  bpl :toEOB
    853 
    854 :99 jsr cmpbarr
    855  beq :nobarr
    856 
    857  lda infrontx
    858  sta tempblockx
    859  jsr DBarr
    860  tax
    861  bpl :tobarr
    862 
    863 * If next block is dangerous (e.g., empty space)
    864 * or sword or potion, step to end of this block
    865 
    866 :nobarr
    867  jsr getinfront ;read block in front
    868  sta tempobjid
    869 
    870   cmp #loose
    871  beq :toEOB ;step to end of block
    872 
    873  cmp #pressplate
    874  beq :toEOB1
    875 
    876  cmp #sword
    877  beq :toEOB1
    878  cmp #flask
    879  beq :toEOB1
    880 
    881  jsr cmpspace
    882  beq :toEOB
    883 
    884 * All clear--take a full step forward
    885 
    886 :fullstep lda #11 ;natural step size
    887 
    888  ldx #2 ;clear
    889  bne :done
    890 
    891 * Step to end of block (no "testfoot")
    892 
    893 :toEOB1 jsr getdist
    894  beq :fullstep
    895  ldx #0
    896  beq :done
    897 
    898 * Step to end of block
    899 
    900 :toEOB jsr getdist ;returns # pixels to end of block (0-13)
    901 
    902  ldx #0 ;edge
    903 
    904 :done ldy tempobjid
    905 ]rts rts
    906 
    907 * Step up to barrier
    908 
    909 :tobarr
    910  cmp #14
    911  bcs :fullstep
    912 
    913  ldx #1 ;barrier
    914  bne :done
    915 
    916 *-------------------------------
    917 *
    918 * Get distance to barrier
    919 *
    920 * In: rdblock results; tempobjid
    921 *     Must have called setupchar/getedges
    922 * Out: A = distance to barrier (- if barr is behind char)
    923 *
    924 *-------------------------------
    925 DBarr
    926  lda tempobjid
    927  cmp #gate
    928  bne :ok
    929 ;treat gate as barrier only if down
    930  jsr gatebarr? ;returns cs if open
    931  bcs :clr
    932 
    933 :ok lda tempblockx
    934  jsr getblockej
    935  clc
    936  adc #angle
    937  sta blockedge ;L edge of this block
    938 
    939  lda CharFace
    940  bmi :checkL
    941 
    942 * Char facing R -- get distance to barrier
    943 
    944 :checkR
    945  lda tempobjid ;block ID
    946 
    947  jsr cmpbarr ;return A = barrier code #
    948  beq :clr
    949  tay
    950 
    951  lda blockedge
    952  clc
    953  adc BarL,y
    954  sta ztemp ;left edge of barr
    955 
    956  sec
    957  sbc CDRightEj
    958  rts ;If -, barr is behind char
    959 
    960 :clr lda #-1
    961  rts
    962 
    963 * Char facing L -- get distance to barr
    964 
    965 :checkL
    966  lda tempobjid
    967 
    968  jsr cmpbarr
    969  beq :clr
    970  tay
    971 
    972  lda blockedge
    973  clc
    974  adc #13
    975  sec
    976  sbc BarR,y
    977  sta ztemp ;R edge of barr
    978 
    979  lda CDLeftEj
    980  sec
    981  sbc ztemp
    982 
    983 ]rts rts
    984 
    985 *-------------------------------
    986 *
    987 *  A N I M   C H A R
    988 *
    989 *  Get next frame from sequence table;
    990 *  update char data accordingly.
    991 *  We're now ready to draw this frame.
    992 *
    993 *-------------------------------
    994 ANIMCHAR
    995 
    996 :next jsr getseq ;get next byte from seqtab
    997  ;& increment CharSeq
    998 
    999  cmp #chx ;"change x" instruction?
   1000  bne :no1
   1001 
   1002  jsr getseq ;next byte is delta-x
   1003 
   1004  jsr addcharx
   1005  sta CharX
   1006 
   1007  jmp :next
   1008 
   1009 *-------------------------------
   1010 :no1 cmp #chy
   1011  bne :no2
   1012 
   1013  jsr getseq
   1014 
   1015  clc
   1016  adc CharY
   1017  sta CharY
   1018 
   1019  jmp :next
   1020 
   1021 *-------------------------------
   1022 :no2 cmp #aboutface
   1023  bne :no3
   1024 
   1025  lda CharFace
   1026  eor #$ff
   1027  sta CharFace
   1028 
   1029  jmp :next
   1030 
   1031 *-------------------------------
   1032 :no3 cmp #goto
   1033  bne :no4
   1034 
   1035 :goto jsr getseq ;low byte of address
   1036  pha
   1037 
   1038  jsr getseq ;high byte
   1039 
   1040  sta CharSeq+1
   1041  pla
   1042  sta CharSeq
   1043 
   1044  jmp :next
   1045 
   1046 *-------------------------------
   1047 :no4 cmp #up
   1048  bne :no5
   1049 
   1050  dec CharBlockY
   1051 
   1052  jsr addslicers
   1053 
   1054  jmp :next
   1055 
   1056 *-------------------------------
   1057 :no5 cmp #down
   1058  bne :no6
   1059 
   1060  inc CharBlockY
   1061 
   1062  jsr addslicers
   1063 
   1064  jmp :next
   1065 
   1066 *-------------------------------
   1067 :no6 cmp #act
   1068  bne :no7
   1069 
   1070  jsr getseq
   1071  sta CharAction
   1072 
   1073  jmp :next
   1074 
   1075 :no7 cmp #setfall
   1076  bne :no8
   1077 
   1078  jsr getseq
   1079  sta CharXVel
   1080 
   1081  jsr getseq
   1082  sta CharYVel
   1083 
   1084  jmp :next
   1085 
   1086 :no8 cmp #ifwtless
   1087  bne :no9
   1088 
   1089  lda weightless ;weightless?
   1090  bne :goto ;yes--branch
   1091 
   1092  jsr getseq
   1093  jsr getseq ;skip 2 bytes
   1094  jmp :next ;& continue
   1095 
   1096 :no9 cmp #die
   1097  bne :no10
   1098  jmp :next
   1099 
   1100 :no10 cmp #jaru
   1101  bne :no11
   1102 
   1103  lda #1
   1104  sta jarabove ;jar floorboards above
   1105  jmp :next
   1106 
   1107 :no11 cmp #jard
   1108  bne :no12
   1109 
   1110  lda #-1
   1111  sta jarabove ;jar floorboards below
   1112  jmp :next
   1113 
   1114 *-------------------------------
   1115 :no12 cmp #tap
   1116  bne :no13
   1117 
   1118  jsr getseq ;sound #
   1119  cmp #0 ;0: alert guard
   1120  beq :0
   1121 
   1122  cmp #1 ;1: footstep
   1123  bne :1
   1124  lda #Footstep
   1125 :tap jsr addsound
   1126 :0 lda #1
   1127  sta alertguard
   1128  jmp :next
   1129 
   1130 :1 cmp #2 ;2: smack wall
   1131  bne :2
   1132  lda #SmackWall
   1133  bne :tap
   1134 :2 jmp :next
   1135 
   1136 :no13 cmp #nextlevel
   1137  bne :no14
   1138 
   1139  jsr GoneUpstairs
   1140  jmp :next
   1141 
   1142 :no14 cmp #effect
   1143  bne :no15
   1144 
   1145  jsr getseq ;effect #
   1146  cmp #1
   1147  bne :fx0
   1148 
   1149  jsr potioneffect
   1150 :fx0 jmp :next
   1151 
   1152 :no15
   1153 *-------------------------------
   1154  sta CharPosn ;frame #
   1155 
   1156 ]rts rts
   1157 
   1158 *-------------------------------
   1159 * Char has gone upstairs
   1160 * What do we do?
   1161 *-------------------------------
   1162 GoneUpstairs
   1163  lda level
   1164  cmp #13
   1165  beq :ok ;no music for level 13
   1166  cmp #4
   1167  bne :1 ;mirror level is special
   1168 :3 lda #s_Shadow
   1169  bne :2
   1170 
   1171 :1 lda #s_Upstairs
   1172 :2 ldx #25
   1173  jsr cuesong
   1174 
   1175 :ok inc NextLevel
   1176  rts
   1177 
   1178 *-------------------------------
   1179 *
   1180 *  Sliced by slicer? (Does CD buf show char overlapping
   1181 *  with a closed slicer?)
   1182 *
   1183 *  In: Char data, CD data
   1184 *
   1185 *-------------------------------
   1186 CHECKSLICE
   1187  lda CharBlockY
   1188  sta tempblocky
   1189 
   1190  ldx #9
   1191 
   1192 :loop stx tempblockx
   1193 
   1194  lda CDthisframe,x
   1195  cmp #$ff ;char overlapping barr?
   1196  bne :ok ;no
   1197 
   1198 * Yes--is it a slicer?
   1199 
   1200  lda SNthisframe,x
   1201  sta tempscrn
   1202 
   1203  jsr rdblock1
   1204  cmp #slicer
   1205  bne :ok
   1206 
   1207  lda (BlueSpec),y
   1208  and #$7f
   1209  cmp #slicerExt ;slicer closed?
   1210  beq :slice ;yes--slice!
   1211 
   1212 * No--keep checking
   1213 
   1214 :ok ldx tempblockx
   1215  dex
   1216  bpl :loop
   1217 ]rts rts
   1218 
   1219 * Slice!
   1220 * In: rdblock results for slicer block
   1221 
   1222 :slice
   1223 ]slice
   1224  lda (BlueSpec),y
   1225  ora #$80
   1226  sta (BlueSpec),y ;set hibit (smear)
   1227 
   1228 :cont lda CharPosn
   1229  cmp #178 ;if already cut in half (e.g. by another slicer),
   1230  beq ]rts ;leave him alone
   1231 
   1232  lda tempblockx
   1233  jsr getblockej ;edge of slicer block
   1234  clc
   1235  adc #7
   1236  sta CharX
   1237 
   1238  lda #8
   1239  jsr addcharx
   1240  sta CharX ;align char w/slicer
   1241 
   1242  ldx CharBlockY
   1243  inx
   1244  lda FloorY,x
   1245  sta CharY ;align char w/floor
   1246 
   1247  lda #100
   1248  jsr decstr
   1249 
   1250  lda #Splat
   1251  jsr addsound
   1252 
   1253  lda #halve
   1254  jsr jumpseq
   1255  jmp animchar
   1256 
   1257 *-------------------------------
   1258 *
   1259 *  Sliced by slicer?
   1260 *
   1261 *  (Use this routine for enemy, who has no CD data)
   1262 *
   1263 *  In: Char data; GETEDGES results
   1264 *
   1265 *-------------------------------
   1266 CHECKSLICE2
   1267  jsr getunderft
   1268  jsr :slice? ;return cs if sliced
   1269  bcs ]rts
   1270 
   1271  inc tempblockx
   1272  jsr rdblock1
   1273 
   1274 :slice?
   1275  cmp #slicer
   1276  bne :safe
   1277  lda (BlueSpec),y
   1278  and #$7f
   1279  cmp #slicerExt
   1280  bne :safe ;slicer open
   1281 
   1282  lda tempblockx
   1283  jsr getblockej
   1284  clc
   1285  adc #angle
   1286  sta blockedge
   1287 
   1288  lda tempscrn
   1289  ldx tempblockx
   1290  ldy tempblocky
   1291  jsr getleftbar
   1292  cmp CDRightEj
   1293  bcs :safe
   1294 
   1295  lda tempscrn
   1296  ldx tempblockx
   1297  ldy tempblocky
   1298  jsr getrightbar
   1299  cmp CDLeftEj
   1300  bcc :safe
   1301  beq :safe
   1302 
   1303  jsr rdblock1
   1304  jsr ]slice
   1305  sec
   1306  rts
   1307 
   1308 :safe clc
   1309 ]rts rts
   1310 
   1311 *-------------------------------
   1312 *
   1313 * Special situation: If char is standing directly under closing
   1314 * gate, it knocks him aside when it shuts.
   1315 *
   1316 * In: Char data, CD data
   1317 *
   1318 *-------------------------------
   1319 CHECKGATE
   1320  lda CharAction
   1321  cmp #7 ;turning
   1322  beq :1
   1323  lda CharPosn
   1324  cmp #15 ;standing?
   1325  beq :1
   1326  cmp #108
   1327  bcc ]rts
   1328  cmp #111 ;crouching?
   1329  bcs ]rts
   1330 :1
   1331  jsr getunderft
   1332  cmp #gate
   1333  beq :check
   1334 
   1335  dec tempblockx
   1336  jsr rdblock1
   1337  cmp #gate
   1338  bne ]rts
   1339 :check
   1340  ldx tempblockx
   1341  lda CDthisframe,x
   1342  and CDlastframe,x
   1343  cmp #$ff
   1344  bne ]rts
   1345 
   1346  jsr gatebarr?
   1347  bcs ]rts
   1348 
   1349  jsr BumpSound
   1350 
   1351 * bump him left or right?
   1352 
   1353  lda tempblockx
   1354  sta collX
   1355  jsr getunderft
   1356  lda tempblockx
   1357  cmp collX
   1358  beq :left
   1359  bcs :right
   1360 
   1361 :left lda #-5
   1362  bne :10
   1363 :right lda #5
   1364 :10 clc
   1365  adc CharX
   1366  sta CharX
   1367 ]rts rts
   1368 
   1369 *-------------------------------
   1370 *
   1371 * Return cc if gate bars you, cs if clear
   1372 *
   1373 *-------------------------------
   1374 gatebarr?
   1375  lda (BlueSpec),y
   1376  lsr
   1377  lsr
   1378  clc
   1379  adc #gatemargin
   1380  cmp imheight
   1381 ]rts rts
   1382 
   1383 *-------------------------------
   1384 *
   1385 * Limited collision detection for enemies
   1386 * (backing into wall or gate while fighting)
   1387 *
   1388 *-------------------------------
   1389 ENEMYCOLL
   1390  lda AMtimer ;antimatter timer
   1391  bne ]rts
   1392 
   1393  lda CharAction
   1394  cmp #1
   1395  bne ]rts ;must be on ground
   1396  lda CharLife
   1397  bpl ]rts ;& alive
   1398  lda CharSword
   1399  cmp #2
   1400  bcc ]rts ;& en garde
   1401 
   1402  jsr getunderft
   1403  cmp #block
   1404  beq :collide
   1405  cmp #panelwif
   1406  beq :collide
   1407  cmp #gate
   1408  bne :1
   1409  jsr gatebarr?
   1410  bcc :collide
   1411 
   1412 * If facing R, check block behind too
   1413 
   1414 :1 lda CharFace
   1415  bmi ]rts
   1416  dec tempblockx
   1417  jsr rdblock1
   1418  cmp #panelwif
   1419  beq :collide
   1420  cmp #gate
   1421  bne ]rts
   1422  jsr gatebarr?
   1423  bcc :collide
   1424 ]rts rts
   1425 
   1426 * Char is en garde & trying to back into barrier
   1427 * Put him right at edge
   1428 
   1429 :collide
   1430  jsr setupchar
   1431  jsr getedges ;get edges
   1432 
   1433  lda tempscrn
   1434  ldx tempblockx
   1435  ldy tempblocky
   1436  jsr rdblock
   1437  sta tempobjid
   1438  jsr checkcoll
   1439  bcc ]rts
   1440 
   1441  jsr DBarr2 ;get A = dist to barrier
   1442  tax
   1443  bpl ]rts
   1444  eor #$ff
   1445  clc
   1446  adc #1
   1447  jsr addcharx
   1448  sta CharX
   1449 
   1450  lda #bumpengback
   1451  jsr jumpseq
   1452  jsr animchar ;get new frame
   1453  jmp rereadblocks
   1454 
   1455 *-------------------------------
   1456 *
   1457 * Special version of DBarr for enemy collisions
   1458 *
   1459 * In: checkcoll results; tempobjid
   1460 *     Must have called setupchar/getedges
   1461 * Out: A = distance to barrier (- if barr is behind char)
   1462 *
   1463 *-------------------------------
   1464 DBarr2
   1465  lda CharFace
   1466  bpl :checkL ;Note: reversed from DBarr
   1467 
   1468 * Char's back facing R -- get distance to barrier
   1469 
   1470 :checkR
   1471  lda tempobjid ;block ID
   1472 
   1473  jsr cmpbarr ;return A = barrier code #
   1474  beq :clr
   1475  tay
   1476 
   1477  lda blockedge
   1478  clc
   1479  adc BarL,y
   1480  sta ztemp ;left edge of barr
   1481 
   1482  sec
   1483  sbc CDRightEj
   1484  rts ;If -, barr is behind char
   1485 
   1486 :clr lda #-1
   1487  rts
   1488 
   1489 * Char facing L -- get distance to barr
   1490 
   1491 :checkL
   1492  lda tempobjid
   1493 
   1494  jsr cmpbarr
   1495  beq :clr
   1496  tay
   1497 
   1498  lda blockedge
   1499  clc
   1500  adc #13
   1501  sec
   1502  sbc BarR,y
   1503  sta ztemp ;R edge of barr
   1504 
   1505  lda CDLeftEj
   1506  sec
   1507  sbc ztemp
   1508 
   1509 ]rts rts
   1510 
   1511 *-------------------------------
   1512  lst
   1513  ds 1
   1514  usr $a9,16,$b00,*-org
   1515  lst off