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

MOVER.S (28963B)


      1 * mover
      2 org = $ee00
      3 PalaceEditor = 0
      4  tr on
      5  lst off
      6 *-------------------------------
      7  org org
      8 
      9  jmp ANIMTRANS
     10  jmp TRIGSPIKES
     11  jmp PUSHPP
     12  jmp BREAKLOOSE1
     13  jmp BREAKLOOSE
     14 
     15  jmp ANIMMOBS
     16  jmp ADDMOBS
     17  jmp CLOSEEXIT
     18  jmp GETSPIKES
     19  jmp SHAKEM
     20 
     21  jmp TRIGSLICER
     22  jmp TRIGTORCH
     23  jmp GETFLAMEFRAME
     24  jmp SMASHMIRROR
     25  jmp JAMSPIKES
     26 
     27  jmp TRIGFLASK
     28  jmp GETFLASKFRAME
     29  jmp TRIGSWORD
     30  jmp JAMPP
     31 
     32 *-------------------------------
     33  lst
     34  put eq
     35  lst
     36  put gameeq
     37  lst
     38  put seqdata
     39  lst
     40  put movedata
     41  lst
     42  put soundnames
     43 
     44  dum locals
     45 state ds 1
     46 temp1 ds 2
     47 linkindex ds 1
     48 pptype ds 1
     49 mobframe ds 1
     50 underFF ds 1
     51  dend
     52 
     53 *-------------------------------
     54 gatevel db 0,0,0,20,40,60,80,100,120
     55 
     56 maxgatevel = *-gatevel-1
     57 
     58 *-------------------------------
     59 pptimer = 5 ;pressplate timer setting (min=3, max=30)
     60 ;(# cycles till plate pops up)
     61 
     62 spiketimer = 15+128 ;spike timer setting (2-127) +128
     63 ;(# cycles till spikes retract)
     64 
     65 slicetimer = 15 ;# cycles between slices
     66 
     67 gatetimer = gmaxval+50 ;# cycles gate stays open
     68 
     69 loosetimer = Ffalling ;# cycles till floor detaches
     70 
     71 * falling floor params
     72 
     73 wiggletime = 4 ;# wiggling frames
     74 FFaccel = 3
     75 FFtermvel = 29
     76 crumbletime = 2 ;# crumbling frames
     77 crumbletime2 = 10
     78 disappeartime = 2
     79 FFheight = 17
     80 CrushDist = 30
     81 
     82 * wipe heights
     83 
     84 loosewipe = 31 ;[might erase spikes]
     85 spikewipe = 31
     86 slicerwipe = 63
     87 platewipe = 16
     88 
     89 gateinc db -1,4,4 ;for trdirec = 0,1,2 (down,up,upjam)
     90 
     91 exitinc = 4
     92 emaxval = 43*4
     93 
     94 maxtr = trobspace-1
     95 maxmob = mobspace-1
     96 
     97 *-------------------------------
     98 *
     99 * Search trans list for object (trloc,trscrn)
    100 *
    101 * In: numtrans, trloc, trscrn
    102 * Out: X = index, 0 if not listed
    103 *
    104 *-------------------------------
    105 searchtrob
    106  ldx numtrans
    107  beq :rts
    108 
    109 :loop lda trloc,x
    110  cmp trloc
    111  bne :next
    112  lda trscrn,x
    113  cmp trscrn
    114  beq :rts ;found it
    115 
    116 :next dex
    117  bne :loop
    118 
    119 :rts rts
    120 
    121 *-------------------------------
    122 *
    123 *  Add a new object to transition list
    124 *  If it's already listed, just change trdirec to new value
    125 *
    126 *  In: trdirec, trloc, trscrn
    127 *
    128 *-------------------------------
    129 addtrob
    130  jsr searchtrob ;Is object already listed?
    131 
    132  cpx #0
    133  bne :chdir ;Yes--just change direc
    134 
    135 * It's not on the list - add it
    136 
    137  ldx numtrans
    138  cpx #maxtr
    139  beq :rts ;too many objects--trigger fails
    140 
    141  inx
    142  stx numtrans
    143 
    144  lda trdirec
    145  sta trdirec,x
    146  lda trloc
    147  sta trloc,x
    148  lda trscrn
    149  sta trscrn,x
    150  rts
    151 
    152 *  Object already listed - change direction
    153 
    154 :chdir lda trdirec
    155  sta trdirec,x
    156 :rts rts
    157 
    158 *-------------------------------
    159 *
    160 *  Add a MOB to MOB list
    161 *
    162 *-------------------------------
    163 addamob
    164  ldx nummob
    165  cpx #maxmob
    166  beq :rts
    167 
    168  inx
    169  stx nummob
    170 
    171  jmp savemob
    172 
    173 :rts rts
    174 
    175 *-------------------------------
    176 *
    177 *  S A V E / L O A D   M O B
    178 *
    179 *-------------------------------
    180 savemob
    181  lda mobx
    182  sta mobx,x
    183  lda moby
    184  sta moby,x
    185  lda mobscrn
    186  sta mobscrn,x
    187  lda mobvel
    188  sta mobvel,x
    189  lda mobtype
    190  sta mobtype,x
    191  lda moblevel
    192  sta moblevel,x
    193  rts
    194 
    195 loadmob
    196  lda mobx,x
    197  sta mobx
    198  lda moby,x
    199  sta moby
    200  lda mobscrn,x
    201  sta mobscrn
    202  lda mobvel,x
    203  sta mobvel
    204  lda mobtype,x
    205  sta mobtype
    206  lda moblevel,x
    207  sta moblevel
    208 ]rts rts
    209 
    210 *-------------------------------
    211 *
    212 *  Trigger slicer
    213 *
    214 *  In: A = initial state
    215 *
    216 *-------------------------------
    217 TRIGSLICER
    218  sta state ;temp
    219 
    220  lda (BlueSpec),y
    221  beq :ok
    222  cmp #slicerRet
    223  bcc ]rts ;in mid-slice--don't interfere
    224 
    225 * Between slices--OK to trigger
    226 
    227 :ok sty trloc
    228 
    229  lda state
    230  sta (BlueSpec),y
    231 
    232  lda VisScrn
    233  sta trscrn
    234 
    235  lda #1
    236  sta trdirec
    237 
    238  jmp addtrob ;add slicer to trans list
    239 
    240 *-------------------------------
    241 *
    242 * Close exit
    243 * (Open it all the way & let it slam shut)
    244 *
    245 *-------------------------------
    246 CLOSEEXIT
    247  sty trloc
    248  sta trscrn
    249 
    250  lda #emaxval ;all the way open
    251  sta (BlueSpec),y
    252 
    253  lda #3 ;coming down fast
    254  sta trdirec
    255 
    256  jmp addtrob ;add to trans list
    257 
    258 *-------------------------------
    259 SMASHMIRROR
    260  lda #86
    261  sta (BlueSpec),y
    262 ]rts rts
    263 
    264 *-------------------------------
    265 *
    266 * Trigger flask
    267 *
    268 *-------------------------------
    269 TRIGFLASK
    270  sty trloc
    271  sta trscrn
    272 
    273  lda #1
    274  sta trdirec
    275 
    276 * Get rnd starting frame
    277 
    278  jsr rnd
    279  and #7
    280  ora (BlueSpec),y
    281  sta (BlueSpec),y
    282  jmp addtrob
    283 
    284 *-------------------------------
    285 *
    286 * Trigger sword
    287 *
    288 *-------------------------------
    289 TRIGSWORD
    290  sty trloc
    291  sta trscrn
    292  lda #1
    293  sta trdirec
    294  jsr rnd
    295  and #$1f
    296  sta (BlueSpec),y
    297  jmp addtrob
    298 
    299 *-------------------------------
    300 *
    301 * Trigger torch
    302 *
    303 *-------------------------------
    304 TRIGTORCH
    305  sty trloc
    306  sta trscrn
    307 
    308  lda #1
    309  sta trdirec
    310 
    311 * Get rnd starting frame
    312 
    313  jsr rnd
    314  and #$f
    315  sta (BlueSpec),y
    316  jmp addtrob
    317 
    318 *-------------------------------
    319 *
    320 *  Trigger spikes
    321 *
    322 *-------------------------------
    323 TRIGSPIKES
    324  lda (BlueSpec),y
    325  beq :ready ;State = 0: spikes are fully retracted--
    326 ;spring 'em
    327  bpl ]rts ;Nonzero, hibit clear: spikes are in motion
    328  cmp #$ff
    329  beq ]rts ;jammed
    330  lda #spiketimer ;Nonzero, hibit set: spikes are fully
    331  sta (BlueSpec),y ;extended--reset timer to max value
    332 ]rts rts
    333 ;Spring spikes
    334 :ready ldx #1
    335 ]cont stx trdirec
    336  sty trloc
    337 
    338  lda tempscrn ;from rdblock
    339  sta trscrn
    340 
    341  jsr addtrob ;add spikes to trans list
    342  jsr redspikes
    343 
    344  lda #GateDown ;TEMP
    345  jmp addsound
    346 
    347 *-------------------------------
    348 *
    349 * Jam spikes (& remove from trans list)
    350 *
    351 * In: Same as TRIGSPIKES
    352 *
    353 *-------------------------------
    354 JAMSPIKES
    355  lda #$ff
    356  sta (BlueSpec),y
    357  ldx #-1 ;stop object
    358  bmi ]cont
    359 
    360 *-------------------------------
    361 *
    362 * Get spike status: 0 = safe, 1 = sprung, 2 = springing
    363 *
    364 *-------------------------------
    365 GETSPIKES
    366  lda (BlueSpec),y
    367  bmi :sprung
    368  beq :safe ;fully retracted
    369 
    370  cmp #spikeExt
    371  bcc :springing
    372 
    373 :safe lda #0 ;safe: retracted or retracting
    374  rts
    375 
    376 :sprung cmp #$ff ;jammed (body impaled on them)?
    377  beq :safe
    378  lda #1
    379  rts
    380 
    381 :springing lda #2
    382 ]rts rts
    383 
    384 *-------------------------------
    385 *
    386 *  Break off section of loose floor
    387 *
    388 *-------------------------------
    389 BREAKLOOSE
    390  lda #1
    391 
    392 BREAKLOOSE1 ;in: A = initial state
    393  sta state
    394 
    395  lda (BlueType),y
    396  and #reqmask ;required floorpiece?
    397  bne ]rts ;yes--blocked below
    398 
    399  lda (BlueSpec),y
    400  bmi :ok ;wiggling
    401  bne ]rts ;already triggered
    402 
    403 :ok lda state
    404  sta (BlueSpec),y
    405 
    406  sty trloc
    407 
    408  lda tempscrn ;from rdblock
    409  sta trscrn
    410 
    411  lda #0 ;down
    412  sta trdirec
    413 
    414  jsr addtrob ;add floor to trans list
    415  jmp redloose
    416 
    417 *-------------------------------
    418 *
    419 *  Depress pressplate
    420 *
    421 *  In: results of RDBLOCK
    422 *     (tempblockx-y, tempscrn refer to pressplate)
    423 *
    424 *-------------------------------
    425 PUSHPP
    426  lda (BlueType),y
    427  and #idmask
    428  sta pptype ;pressplate/upressplate/rubble
    429 pushpp1
    430  lda (BlueSpec),y ;LINKLOC index
    431  sta linkindex
    432  tax
    433  jsr gettimer
    434 
    435  cmp #31
    436  beq ]rts ;plate is permanently down
    437 
    438  cmp #2
    439  bcs :starttimer ;plate is temporarily down--
    440 ;just restart timer
    441 
    442 *  Fresh plate has been stepped on--reset timer
    443 
    444  lda #pptimer ;put plate down for the count
    445  jsr chgtimer
    446 
    447  sty trloc
    448 
    449  lda tempscrn ;from rdblock1
    450  sta trscrn
    451 
    452  lda #1
    453  sta trdirec
    454 
    455  jsr addtrob ;add to trans list
    456 
    457  jsr redplate ;add plate to redraw list
    458 
    459  lda #1
    460  sta alertguard
    461  lda #PlateDown
    462  jsr addsound
    463 
    464 :trig jmp trigger ;trigger something?
    465 
    466 * plate is already down--just restart timer
    467 * (& retrigger gates)
    468 
    469 :starttimer lda #pptimer
    470  jsr chgtimer
    471  jmp :trig
    472 
    473 *-------------------------------
    474 *
    475 * Jam pressplate (dead weight)
    476 *
    477 * In: Same as PUSHPP
    478 *
    479 *-------------------------------
    480 JAMPP
    481  lda (BlueType),y
    482  and #idmask
    483  sta pptype
    484  cmp #pressplate
    485  beq :1
    486 
    487  lda #floor
    488  sta (BlueType),y
    489  lda #0
    490  sta (BlueSpec),y
    491  lda #rubble
    492  sta pptype
    493  bne pushpp1
    494 
    495 :1 lda #dpressplate
    496  sta (BlueType),y
    497  bne pushpp1
    498 
    499 *-------------------------------
    500 *
    501 *  We just pushed a pressplate -- did we trigger something?
    502 *
    503 *  In: linkindex, pptype
    504 *
    505 *-------------------------------
    506 trigger
    507 :loop ldx linkindex
    508 
    509  lda LINKLOC,x
    510  cmp #$ff
    511  beq :rts ;linked to nothing
    512 
    513  jsr getloc
    514  sta trloc
    515 
    516  jsr getscrn ;get block # and screen # of
    517  sta trscrn ;gadget to trigger
    518 
    519  jsr calcblue
    520  ldy trloc
    521  lda (BlueType),y
    522  and #idmask ;get objid into A
    523 
    524  jsr trigobj ;call appropriate trigger routine
    525 
    526  lda trdirec
    527  bmi :skip ;trigger fails
    528 
    529  jsr addtrob ;add gadget to transition list
    530 
    531 :skip ldx linkindex
    532  inc linkindex
    533 
    534  jsr getlastflag
    535  beq :loop
    536 
    537 :rts rts
    538 
    539 *-------------------------------
    540 *
    541 *  Trigger object
    542 *
    543 *  Out: trdirec (-1 if trigger fails)
    544 *
    545 *-------------------------------
    546 trigobj
    547  cmp #gate
    548  bne :1
    549  jmp triggate
    550 :1
    551  cmp #exit
    552  bne :2
    553  jmp openexit
    554 :2
    555 ]rts rts
    556 
    557 *-------------------------------
    558 *
    559 * Open exit
    560 *
    561 *-------------------------------
    562 openexit
    563  lda (BlueSpec),y
    564  bne :fail ;Exit can only open, not close
    565 
    566  lda #1
    567  bpl :1
    568 
    569 :fail lda #-1
    570 :1 sta trdirec
    571  rts
    572 
    573 *-------------------------------
    574 *
    575 *  Trigger gate
    576 *
    577 *  In: BlueSpec, Y, pptype
    578 *  Out: trdirec
    579 *
    580 *-------------------------------
    581 triggate
    582  lda (BlueSpec),y ;current gate position
    583 
    584  ldx pptype
    585  cpx #upressplate
    586  beq :raise
    587  cpx #rubble
    588  beq :jam
    589 
    590 * Lower gate
    591 
    592 :lower cmp #gminval ;at bottom?
    593  bne :yeslower ;no--lower it
    594 ;yes--trigger fails
    595 :fail jmp stopobj
    596 
    597 :yeslower
    598  lda #3 ;down fast
    599  sta trdirec
    600  rts
    601 
    602 :jam ldx #2 ;open & jam
    603  stx trdirec
    604  cmp #gmaxval
    605  bcc :1
    606  lda #$ff ;"jammed open" state
    607  bmi :3
    608 
    609 :raise ldx #1 ;open
    610  stx trdirec
    611  cmp #$ff
    612  beq :fail ;jammed
    613  cmp #gmaxval
    614  bcc :1
    615  lda #gatetimer
    616 :3 sta (BlueSpec),y ;reset timer
    617  bne :fail
    618 :1
    619 ]rts rts
    620 
    621 *-------------------------------
    622 *
    623 *  Animate transitional objects
    624 *  (Advance each object to next frame in animation table)
    625 *
    626 *-------------------------------
    627 ]cleanflag ds 1
    628 
    629 ANIMTRANS
    630  lda #0
    631  sta trobcount
    632 
    633  ldx numtrans ;# objs in trans (0-maxtr)
    634  beq ]rts
    635 
    636  lda #0
    637  sta ]cleanflag
    638 
    639 :loop stx tempnt
    640 
    641  jsr animobj ;animate obj #x
    642 
    643  ldx tempnt
    644 
    645  lda trdirec ;has object stopped?
    646  bpl :1 ;no
    647 
    648  lda #-1 ;yes--mark it for deletion
    649  sta ]cleanflag ;& set cleanup flag
    650 
    651 :1 sta trdirec,x ;save direction change if any
    652 
    653  dex
    654  bne :loop
    655 
    656  lda ]cleanflag
    657  beq ]rts
    658 
    659 *  Delete all stopped objects (trdirec = ff)
    660 *  (i.e., copy entire list back onto
    661 *  itself, omitting stopped objects)
    662 
    663  ldx #1 ;source index (assume numtrans > 0)
    664  ldy #0 ;dest index
    665 
    666 :dloop lda trdirec,x
    667  cmp #$ff
    668  beq :next
    669 
    670  iny
    671  sta trdirec,y
    672  lda trloc,x
    673  sta trloc,y
    674  lda trscrn,x ;source
    675  sta trscrn,y ;dest
    676 
    677 :next inx
    678 
    679  cpx numtrans
    680  bcc :dloop
    681  beq :dloop
    682 
    683  sty numtrans
    684  rts
    685 
    686 *-------------------------------
    687 *
    688 *  Animate TROB #x
    689 *
    690 *-------------------------------
    691 animobj lda trloc,x
    692  sta trloc
    693  lda trscrn,x
    694  sta trscrn
    695  lda trdirec,x
    696  sta trdirec
    697 
    698 * Find out what kind of object it is
    699 
    700  lda trscrn
    701  jsr calcblue
    702 
    703  ldy trloc
    704  lda (BlueSpec),y
    705  sta state ;original state
    706 
    707  lda (BlueType),y
    708  and #idmask ;objid
    709 
    710 * and branch to appropriate subroutine
    711 
    712  cmp #torch
    713  bne :1
    714  jsr animtorch
    715  jmp :done
    716 
    717 :1 cmp #upressplate
    718  beq :plate
    719  cmp #pressplate
    720  bne :2
    721 :plate jsr animplate
    722  jmp :done
    723 
    724 :2 cmp #spikes
    725  bne :3
    726  jsr animspikes
    727  jmp :done
    728 
    729 :3 cmp #loose
    730  bne :31
    731  jsr animfloor
    732  jmp :done
    733 
    734 :31 cmp #space ;(loose floor turns into space)
    735  bne :4
    736  jsr animspace
    737  jmp :done
    738 
    739 :4 cmp #slicer
    740  bne :5
    741  jsr animslicer
    742  jmp :done
    743 
    744 :5 cmp #gate
    745  bne :6
    746  jsr animgate
    747  jmp :done
    748 
    749 :6 cmp #exit
    750  bne :7
    751  jsr animexit
    752  jmp :done
    753 
    754 :7 cmp #flask
    755  bne :8
    756  jsr animflask
    757  jmp :done
    758 
    759 :8 cmp #sword
    760  bne :9
    761  jsr animsword
    762  jmp :done
    763 
    764 :9 jsr stopobj ;obj is none of these--purge it from trans list!
    765 
    766 :done lda state
    767  ldy trloc
    768  sta (BlueSpec),y
    769 
    770 :rts rts
    771 
    772 *-------------------------------
    773 *
    774 * Animate exit
    775 *
    776 *-------------------------------
    777 animexit
    778  ldx trdirec
    779  bmi :cont
    780  cpx #3
    781  bcs :downfast ;>= 3: coming down fast
    782 
    783  lda #RaisingExit
    784  jsr addsound
    785 
    786  lda state
    787  clc
    788  adc #exitinc
    789  sta state
    790 
    791  cmp #emaxval
    792  bcs :stop
    793 
    794 :cont jmp redexit
    795 
    796 :stop jsr stopobj
    797 
    798  lda #GateDown
    799  jsr addsound
    800  lda #s_Stairs
    801  ldx #15
    802  jsr cuesong
    803  lda #1
    804  sta exitopen
    805  jsr mirappear
    806  jmp :cont
    807 
    808 * Exit coming down fast
    809 
    810 :downfast
    811  cpx #maxgatevel
    812  bcs :2
    813  inx
    814  stx trdirec
    815 :2 lda state
    816  sec
    817  sbc gatevel,x
    818  sta state
    819  beq :cont
    820  bcs :cont
    821 
    822  jsr stopobj
    823 
    824  lda #0
    825  sta state
    826 
    827  lda #GateSlam
    828  jsr addsound
    829 
    830  jmp :cont
    831 
    832 *-------------------------------
    833 *
    834 *  Animate gate
    835 *
    836 *-------------------------------
    837 animgate
    838  ldx trdirec
    839  bmi :cont ;gate has stopped
    840 
    841  cpx #3 ;trdirec >= 3: coming down fast
    842  bcs :downfast
    843 
    844  lda state
    845  cmp #$ff
    846  beq :stop ;jammed open
    847  clc
    848  adc gateinc,x
    849  sta state
    850 
    851  cpx #0
    852  beq :goingdown
    853 
    854  cmp #gmaxval
    855  bcs :attop ;stop at top
    856 
    857  lda #RaisingGate
    858  jsr addsound
    859 
    860  jmp :cont
    861 
    862 :goingdown
    863  cmp #gminval
    864  beq :stop
    865  bcc :stop
    866 
    867  cmp #gmaxval
    868  bcs :cont ;at top
    869  jsr addlowersound
    870 
    871 :cont jmp redgate ;mark gate for redrawing
    872 
    873 :stop jsr stopobj
    874 
    875  lda #GateDown
    876  jsr addsound
    877 
    878  jmp :cont
    879 
    880 * Gate has reached top
    881 * trdirec = 1: pause, then start to close again
    882 * trdirec = 2: jam at top
    883 
    884 :attop
    885  cpx #2
    886  bcc :tr1
    887  lda #$ff ;jammed-open value
    888  sta state
    889  jmp :stop
    890 
    891 :tr1 lda #gatetimer
    892  sta state
    893 
    894  lda #0 ;down
    895  sta trdirec
    896 ]rts rts
    897 
    898 * Down fast
    899 
    900 :downfast
    901  cpx #maxgatevel
    902  bcs :2
    903 
    904  inx
    905  stx trdirec ;trdirec is velocity index
    906 :2
    907  lda state
    908  sec
    909  sbc gatevel,x
    910  sta state
    911  beq :cont
    912  bcs :cont
    913 
    914  lda #0
    915  sta state
    916  jsr stopobj
    917 
    918  lda #GateSlam
    919  jsr addsound
    920  jmp :cont
    921 
    922 *-------------------------------
    923 *
    924 *  Animate pressplate
    925 *
    926 *-------------------------------
    927 animplate
    928  ldx trdirec
    929  bmi ]rts
    930 
    931  lda state
    932  tax
    933  jsr gettimer
    934  sec
    935  sbc #1
    936  pha
    937  jsr chgtimer
    938  pla
    939  cmp #2
    940  bcs ]rts ;timer stops at t=1
    941 
    942  lda #PlateUp
    943  jsr addsound
    944 
    945  jsr stopobj
    946 
    947  jmp redplate ;add obj to redraw buffer
    948 ]rts rts
    949 
    950 *-------------------------------
    951 *
    952 *  Animate slicer
    953 *
    954 *-------------------------------
    955 animslicer
    956  ldx trdirec
    957  bmi :done
    958 
    959  lda state
    960  tax
    961  and #$80
    962  sta state ;preserve hibit
    963  txa
    964  and #$7f
    965  clc
    966  adc #1
    967  cmp #slicetimer+1
    968  bcc :1
    969  lda #1 ;wrap around
    970 :1 ora state
    971  sta state
    972  and #$7f ;next frame #
    973  cmp #slicerExt
    974  bne :2
    975 
    976  lda #JawsClash
    977  jsr addsound
    978 
    979 :2 lda trscrn
    980  cmp VisScrn ;is slicer on visible screen?
    981  bne :os ;no
    982 
    983  lda trloc
    984  jsr unindex
    985  cpx KidBlockY ;on same level as kid?
    986  bne :os ;no
    987 
    988  lda KidLife
    989  bmi :done
    990  ;If kid is dead, stop all unbloodied slicers
    991  lda state
    992  and #$80
    993  bne :done
    994 
    995 * As soon as slicer is retracted, purge it from trans list
    996 
    997 :os lda state
    998  and #$7f
    999  cmp #slicerRet
   1000  bcc :done
   1001 
   1002 :purge jsr stopobj
   1003 
   1004 :done lda state
   1005  and #$7f
   1006  cmp #slicerRet ;retracted?
   1007  bcs ]rts ;yes--don't bother to redraw
   1008 
   1009  jmp redslicer
   1010 
   1011 *-------------------------------
   1012 *
   1013 * Animate flask
   1014 *
   1015 *-------------------------------
   1016 animflask
   1017  ldx trdirec
   1018  bmi ]rts
   1019 
   1020  lda trscrn
   1021  cmp VisScrn
   1022  bne :purge
   1023 
   1024  lda state
   1025  and #%11100000 ;potion #
   1026  sta temp1
   1027  lda state
   1028  and #%00011111 ;frame #
   1029  jsr GETFLASKFRAME
   1030  ora temp1
   1031  sta state
   1032 
   1033  jmp redflask
   1034 ]purge
   1035 :purge jmp stopobj
   1036 
   1037 *-------------------------------
   1038 *
   1039 * Animate gleaming sword
   1040 *
   1041 *-------------------------------
   1042 animsword
   1043  lda trscrn
   1044  cmp VisScrn
   1045  bne ]purge
   1046 
   1047  dec state
   1048  bne :1
   1049  jsr rnd
   1050  and #$3f
   1051  clc
   1052  adc #40
   1053  sta state
   1054 
   1055 :1 jmp redsword
   1056 ]rts rts
   1057 
   1058 *-------------------------------
   1059 *
   1060 * Animate torch
   1061 *
   1062 *-------------------------------
   1063 animtorch
   1064  ldx trdirec
   1065  bmi ]rts
   1066 
   1067  lda trscrn
   1068  cmp VisScrn
   1069  bne ]purge
   1070 
   1071  lda state
   1072  jsr GETFLAMEFRAME
   1073  sta state
   1074 
   1075  jmp redtorch
   1076 
   1077 *-------------------------------
   1078 *
   1079 * Get flame frame
   1080 *
   1081 * In/out: A = state
   1082 *
   1083 *-------------------------------
   1084 GETFLAMEFRAME
   1085  sta state
   1086 
   1087  jsr rnd
   1088 
   1089  cmp state
   1090  beq :2
   1091  cmp #torchLast+1
   1092  bcc :1
   1093 
   1094  lda state
   1095 :2 clc
   1096  adc #1
   1097  cmp #torchLast+1
   1098  bcc :1
   1099 
   1100  lda #0 ;wrap around
   1101 :1
   1102 ]rts rts
   1103 
   1104 *-------------------------------
   1105 *
   1106 * Get flask frame
   1107 *
   1108 * In/out: A = state (low 5 bits)
   1109 *
   1110 *-------------------------------
   1111 GETFLASKFRAME
   1112  clc
   1113  adc #1
   1114  cmp #bubbLast+1
   1115  bcc ]rts
   1116  lda #1
   1117 ]rts rts
   1118 
   1119 *-------------------------------
   1120 *
   1121 * Animate spikes
   1122 *
   1123 *-------------------------------
   1124 animspikes
   1125  ldx trdirec
   1126  bmi :done
   1127 
   1128  lda state
   1129  bmi :timerloop ;Hibit set: remaining 7 bits
   1130  ;represent timer value
   1131 
   1132 * Hibit clear: remaining 7 bits represent BGDATA frame #
   1133 
   1134  inc state
   1135 
   1136  cmp #spikeExt ;is extension complete?
   1137  beq :starttimer ;yes--start timer
   1138 
   1139  cmp #spikeRet ;is retraction complete?
   1140  bne :done ;not yet
   1141 
   1142  lda #0
   1143  sta state ;yes--reset to "ready" state
   1144 
   1145  jsr stopobj
   1146 
   1147 :done jmp redspikes
   1148 
   1149 * Spike timer loop
   1150 
   1151 :starttimer
   1152  lda #spiketimer
   1153  sta state
   1154 
   1155  bne :done
   1156 
   1157 :timerloop
   1158  dec state
   1159 
   1160  lda state
   1161  and #$7f
   1162  bne :rts
   1163 ;Time's up
   1164  lda #spikeExt+1 ;First "retracting" frame
   1165  sta state
   1166 
   1167  bne :done
   1168 :rts
   1169 ]rts rts
   1170 
   1171 *-------------------------------
   1172 *
   1173 * Animate loose floor
   1174 *
   1175 *-------------------------------
   1176 animfloor
   1177  ldx trdirec
   1178  bmi :red
   1179 
   1180 * When timer reaches max value & loose floor detaches:
   1181 *  (1)  Change objid from "loose floor" to "empty space"
   1182 *  (2)  Create a MOB to take over where TROB stopped
   1183 
   1184  inc state
   1185 
   1186  lda state
   1187  bmi :wiggle ;floor is only wiggling
   1188 
   1189  cmp #loosetimer
   1190  bcc :red
   1191 
   1192 * Timer has reached max value--detach floor
   1193 
   1194  jsr makespace
   1195  sta state
   1196 
   1197  jsr stopobj
   1198 
   1199 * and create new MOB
   1200 
   1201  lda trloc
   1202  jsr unindex
   1203 
   1204  asl
   1205  asl  ;x4
   1206  sta mobx
   1207  stx moblevel
   1208 
   1209  lda BlockBot+1,x
   1210  sta moby
   1211 
   1212  lda trscrn
   1213  sta mobscrn
   1214 
   1215  lda #0
   1216  sta mobvel
   1217  sta mobtype
   1218 
   1219  jsr addamob
   1220 
   1221 :red jmp redloose
   1222 
   1223 * Floor is only wiggling
   1224 
   1225 :wiggle ldx level
   1226  cpx #13
   1227  beq ]rts
   1228 
   1229  cmp #wiggletime+$80
   1230  bcc :red
   1231 
   1232  lda #0
   1233  sta state
   1234  jsr stopobj ;stop wiggling
   1235 
   1236  jmp :red
   1237 
   1238 animspace jsr stopobj
   1239  jmp redloose
   1240 
   1241 *-------------------------------
   1242 *
   1243 *  Stop object (set trdirec = -1)
   1244 *
   1245 *-------------------------------
   1246 stopobj lda #-1
   1247  sta trdirec
   1248  rts
   1249 
   1250 *-------------------------------
   1251 * General redraw-object routine
   1252 *-------------------------------
   1253 redtrobj
   1254  jsr check
   1255  lda #2
   1256  jsr markred
   1257  jsr markwipe
   1258  jsr checkright
   1259  lda #2
   1260  jsr markred
   1261  jmp markwipe
   1262 
   1263 *-------------------------------
   1264 * redraw torch/exit
   1265 *-------------------------------
   1266 redexit
   1267 redtorch
   1268  jsr checkright
   1269  lda #2
   1270  jmp markmove
   1271 
   1272 *-------------------------------
   1273 * redraw flask/sword
   1274 *-------------------------------
   1275 redsword
   1276 redflask
   1277  jsr check
   1278  lda #2
   1279  jmp markmove
   1280 
   1281 *-------------------------------
   1282 * redraw loose floor
   1283 *-------------------------------
   1284 redloose
   1285  inc trobcount
   1286  lda #loosewipe
   1287  sta height
   1288  jmp redtrobj
   1289 
   1290 *-------------------------------
   1291 * redraw gate
   1292 *-------------------------------
   1293 redgate
   1294  jsr checkright ;mark piece to right of gate
   1295  lda #2
   1296  jsr markmove
   1297  jsr markfred
   1298  jsr checkabover ;& piece to right of gate panel
   1299  lda #2
   1300  jmp markmove
   1301 
   1302 *-------------------------------
   1303 * redraw spikes
   1304 *-------------------------------
   1305 redspikes
   1306  inc trobcount
   1307  lda #spikewipe
   1308  sta height
   1309  jmp redtrobj
   1310 
   1311 *-------------------------------
   1312 * redraw slicer
   1313 *-------------------------------
   1314 redslicer
   1315  inc trobcount
   1316  lda #slicerwipe
   1317  sta height
   1318  jsr check
   1319  lda #2
   1320  jsr markred
   1321  jmp markwipe
   1322 
   1323 *-------------------------------
   1324 * redraw pressplate
   1325 *-------------------------------
   1326 redplate
   1327  lda #platewipe
   1328  sta height
   1329  jmp redtrobj
   1330 
   1331 *-------------------------------
   1332 *
   1333 *  Before marking a piece in redraw buffer,
   1334 *  check whether it's visible.
   1335 *
   1336 *  If piece is visible onscreen:
   1337 *    return with carry clear, y = redbuf index
   1338 *  If piece is not visible:
   1339 *    return with carry set
   1340 *
   1341 *-------------------------------
   1342 ]no ldy #30
   1343  sec
   1344 ]rts rts
   1345 
   1346 ]above cmp scrnAbove
   1347  bne ]rts
   1348 
   1349  lda trloc
   1350  sec
   1351  sbc #20 ;if on top row, return 0-9 and cs
   1352  tay
   1353 
   1354  sec
   1355  rts
   1356 
   1357 *-------------------------------
   1358 *  Check (trscrn, trloc)
   1359 *-------------------------------
   1360 check
   1361  lda trscrn
   1362  cmp VisScrn
   1363  bne ]above
   1364 
   1365  ldy trloc
   1366  cpy #30 ;i.e., "clc"
   1367  rts
   1368 
   1369 *-------------------------------
   1370 *  Check piece to left of (trscrn,trloc)
   1371 *-------------------------------
   1372 checkleft
   1373  lda trscrn
   1374  cmp VisScrn
   1375  bne :notonscrn
   1376 ;piece is on this screen
   1377  cpy #0
   1378  beq ]no
   1379  cpy #10
   1380  beq ]no
   1381  cpy #20
   1382  beq ]no
   1383 ;yes--piece is visible
   1384  dey
   1385  clc
   1386  rts
   1387 
   1388 :notonscrn
   1389  cmp scrnRight
   1390  bne ]above
   1391 ;piece is on screen to right
   1392  ldy trloc
   1393  cpy #0
   1394  beq :yesr
   1395  cpy #10
   1396  beq :yesr
   1397  cpy #20
   1398  bne :yesr
   1399 
   1400 :yesr tya
   1401  clc
   1402  adc #9 ;mark corresponding right-edge piece
   1403  tay ;on this screen
   1404 
   1405  clc
   1406  rts
   1407 
   1408 *-------------------------------
   1409 *  Check piece to right of (trscrn,trloc)
   1410 *-------------------------------
   1411 checkright
   1412  lda trscrn
   1413  cmp VisScrn
   1414  bne :notonscrn
   1415 ;piece is on this screen
   1416  ldy trloc
   1417  cpy #9
   1418  beq ]no
   1419 
   1420  cpy #19
   1421  beq ]no
   1422 
   1423  cpy #29
   1424  beq ]no
   1425 ;yes
   1426  iny
   1427  clc
   1428  rts
   1429 
   1430 :notonscrn
   1431  cmp scrnLeft
   1432  bne ]above
   1433 ;piece is on screen to left
   1434  ldy trloc
   1435  cpy #9
   1436  beq :yesl
   1437 
   1438  cpy #19
   1439  beq :yesl
   1440 
   1441  cpy #29
   1442  bne ]no
   1443 
   1444 :yesl tya
   1445  sec
   1446  sbc #9 ;mark corresponding left-edge piece
   1447  tay ;on this screen
   1448 
   1449  clc
   1450  rts
   1451 
   1452 ]no ldy #30
   1453  sec
   1454 ]rts rts
   1455 
   1456 *-------------------------------
   1457 *  Check piece above & to right of (trscrn,trloc)
   1458 *-------------------------------
   1459 checkabover
   1460  lda trscrn
   1461  cmp VisScrn
   1462  bne :notonscrn
   1463 ;piece is on this screen
   1464  ldy trloc
   1465  cpy #10
   1466  bcc :above ;piece is on top row
   1467 
   1468  cpy #19
   1469  beq ]no
   1470 
   1471  cpy #29
   1472  beq ]no
   1473 ;yes
   1474  tya
   1475  sec
   1476  sbc #9
   1477  tay
   1478 
   1479  clc
   1480  rts
   1481 
   1482 :above
   1483  iny
   1484  sec
   1485  rts
   1486 
   1487 :notonscrn
   1488  cmp scrnLeft
   1489  bne :notonleft
   1490 ;piece is on screen to left
   1491  ldy trloc
   1492  cpy #9
   1493  beq :yes0
   1494 
   1495  cpy #19
   1496  beq :yesl
   1497 
   1498  cpy #29
   1499  bne ]no
   1500 
   1501 :yesl tya
   1502  sec
   1503  sbc #19 ;mark corresponding left-edge piece
   1504  tay ;on this screen
   1505 
   1506  clc
   1507  rts
   1508 
   1509 :yes0 ldy #0
   1510  sec
   1511  rts
   1512 
   1513 :notonleft
   1514  cmp scrnBelow
   1515  bne :notbelow
   1516 ;piece is on screen below
   1517  ldy trloc
   1518  cpy #9
   1519  bcs ]no
   1520 ;yes--piece is on top row
   1521  tya
   1522  clc
   1523  adc #21
   1524  tay
   1525 
   1526  clc
   1527  rts
   1528 
   1529 :notbelow
   1530  cmp scrnBelowL
   1531  bne ]rts
   1532  ;piece is on scrn below & to left
   1533  ldy trloc
   1534  cpy #9
   1535  bne ]no
   1536 ;yes--piece is in u.r.
   1537  ldy #20
   1538  clc
   1539  rts
   1540 
   1541 *-------------------------------
   1542 *
   1543 *  Extract information from LINKLOC/LINKMAP
   1544 *
   1545 *  In: X = linkindex
   1546 *  Out: A = info
   1547 *
   1548 *-------------------------------
   1549 gettimer
   1550  lda LINKMAP,x
   1551  and #%00011111 ;pressplate timer (0-31)
   1552  rts
   1553 chgtimer ;In: A = new timer setting
   1554  and #%00011111
   1555  sta temp1
   1556  lda LINKMAP,x
   1557  and #%11100000
   1558  ora temp1
   1559  sta LINKMAP,x
   1560  rts
   1561 getloc
   1562  lda LINKLOC,x
   1563  and #%00011111 ;screen posn (0-29)
   1564  rts
   1565 getlastflag
   1566  lda LINKLOC,x
   1567  and #%10000000 ;last-entry flag (0-1)
   1568  rts
   1569 getscrn
   1570  lda LINKLOC,x
   1571  and #%01100000 ;low 2 bits
   1572  lsr
   1573  lsr
   1574  sta temp1
   1575  lda LINKMAP,x
   1576  and #%11100000 ;high 3 bits
   1577  adc temp1
   1578  lsr
   1579  lsr
   1580  lsr ;Result: screen # (0-31)
   1581 ]rts rts
   1582 
   1583 *-------------------------------
   1584 *
   1585 *  Update all MOBs (falling floors)
   1586 *
   1587 *-------------------------------
   1588 ANIMMOBS
   1589  ldx nummob ;# MOBs in motion (0-maxmob)
   1590  beq ]rts
   1591 
   1592 :loop stx tempnt
   1593  jsr loadmob
   1594 
   1595  jsr animmob ;animate MOB #x
   1596 
   1597  jsr checkcrush ;did we just crush a character?
   1598 
   1599  ldx tempnt
   1600  jsr savemob
   1601 
   1602  dex
   1603  bne :loop
   1604 
   1605 * Delete MOBs that have ceased to exist
   1606 
   1607  ldx #1 ;source index (assume nummob > 0)
   1608  ldy #0 ;dest index
   1609 
   1610 :dloop lda mobvel,x
   1611  cmp #$ff
   1612  beq :next
   1613 
   1614  iny
   1615  sta mobvel,y
   1616  lda mobx,x ;source
   1617  sta mobx,y ;dest
   1618  lda moby,x
   1619  sta moby,y
   1620  lda mobscrn,x
   1621  sta mobscrn,y
   1622  lda mobtype,x
   1623  sta mobtype,y
   1624  lda moblevel,x
   1625  sta moblevel,y
   1626 
   1627 :next inx
   1628 
   1629  cpx nummob
   1630  bcc :dloop
   1631  beq :dloop
   1632 
   1633  sty nummob
   1634 
   1635 ]rts rts
   1636 
   1637 *-------------------------------
   1638 *
   1639 *   Animate MOB #x
   1640 *
   1641 *-------------------------------
   1642 animmob
   1643  lda mobtype
   1644  bne :done
   1645  jsr mobfloor
   1646 :done
   1647  lda mobvel
   1648  bpl ]rts ;is object stopping?
   1649  inc mobvel ;yes
   1650 ]rts rts
   1651 
   1652 *-------------------------------
   1653 *
   1654 *  Animate falling floor
   1655 *
   1656 *-------------------------------
   1657 mobfloor
   1658  lda mobvel
   1659  bmi ]rts
   1660 :ok1
   1661  cmp #FFtermvel
   1662  bcs :tv
   1663  clc
   1664  adc #FFaccel
   1665  sta mobvel
   1666 
   1667 :tv clc
   1668  adc moby
   1669  sta moby
   1670 
   1671 * check for collision w/floor
   1672 
   1673  ldx mobscrn ;on null screen?
   1674  beq :null ;yes--fall on
   1675 
   1676  cmp #-30 ;negative?
   1677  bcs :fallon ;yes--fall on
   1678 
   1679  ldx moblevel
   1680  cmp BlockAy+1,x
   1681  bcc :fallon
   1682 
   1683 * Passing thru floor plane--what to do?
   1684 * First see what's there
   1685 
   1686  ldx moblevel
   1687  stx tempblocky
   1688 
   1689  lda mobx
   1690  lsr
   1691  lsr
   1692  sta tempblockx
   1693 
   1694  lda mobscrn
   1695  sta tempscrn
   1696 
   1697  jsr rdblock1 ;A = objid
   1698  sta underFF ;under falling floor
   1699 
   1700  cmp #space
   1701  beq :passthru
   1702 
   1703  cmp #loose
   1704  bne :crash
   1705 
   1706 * Lands on loose floor
   1707 * Knock out loose floor & continue
   1708 
   1709  jsr knockloose
   1710 
   1711  jmp :passthru
   1712 
   1713 * Lands on solid floor
   1714 
   1715 :crash
   1716  lda #LooseCrash
   1717  jsr addsound
   1718 
   1719  lda mobscrn
   1720  sta tempscrn
   1721  lda moblevel
   1722  sta tempblocky
   1723  jsr SHAKEM1 ;shake loose floors
   1724 
   1725  ldx moblevel
   1726  lda BlockAy+1,x
   1727  sta moby
   1728 
   1729  lda #-crumbletime
   1730  sta mobvel
   1731 
   1732  jmp makerubble
   1733 
   1734 * Passes thru floor plane
   1735 
   1736 :passthru
   1737  jsr passthru
   1738 :fallon
   1739 ]rts rts
   1740 
   1741 * Falling on null screen
   1742 
   1743 :null
   1744  lda moby
   1745  cmp #192+17
   1746  bcc ]rts
   1747 ;MOB has fallen off null screen--delete it
   1748  lda #-disappeartime
   1749  sta mobvel
   1750 
   1751 ]rts rts
   1752 
   1753 *-------------------------------
   1754 * Knock out loose floor
   1755 *-------------------------------
   1756 knockloose
   1757  jsr makespace
   1758  sta (BlueSpec),y
   1759 
   1760  lda mobvel
   1761  lsr
   1762  sta mobvel
   1763 
   1764  ldx tempnt
   1765  jsr savemob ;save this MOB
   1766 
   1767 * Create new MOB (add'l falling floor)
   1768 
   1769  lda moby
   1770  clc
   1771  adc #6
   1772  sta moby
   1773 
   1774  jsr passthru
   1775 
   1776  jsr addamob
   1777 
   1778 * Retrieve old MOB
   1779 
   1780  ldx tempnt
   1781  jsr loadmob
   1782 
   1783  jmp markmob
   1784 
   1785 *-------------------------------
   1786 * Make space
   1787 * Return A = BlueSpec
   1788 *-------------------------------
   1789 makespace lda #space ;change objid to empty space
   1790  sta (BlueType),y
   1791 
   1792  do PalaceEditor
   1793  lda #1
   1794  rts
   1795  fin
   1796 
   1797  lda #0
   1798  ldx BGset1
   1799  cpx #1 ;pal?
   1800  bne ]rts
   1801  lda #1 ;stripe
   1802 ]rts rts
   1803 
   1804 *-------------------------------
   1805 * Pass thru floor plane
   1806 *-------------------------------
   1807 passthru
   1808  inc moblevel
   1809 
   1810  lda moblevel
   1811  cmp #3
   1812  bcc ]rts
   1813 
   1814 * ... and onto next screen
   1815 * (NOTE: moby may be negative)
   1816 
   1817  lda moby
   1818  sec
   1819  sbc #192
   1820  sta moby
   1821 
   1822  lda #0
   1823  sta moblevel
   1824 
   1825  lda mobscrn
   1826  jsr getdown
   1827  sta mobscrn
   1828 ]rts rts
   1829 
   1830 *-------------------------------
   1831 * Delete MOB & change objid of floorpiece it landed on
   1832 * If pressplate, trigger before reducing it to rubble
   1833 *-------------------------------
   1834 makerubble
   1835  lda moblevel
   1836  sta tempblocky
   1837 
   1838  lda mobx
   1839  lsr
   1840  lsr
   1841  sta tempblockx
   1842 
   1843  lda mobscrn
   1844  sta tempscrn
   1845 
   1846  jsr rdblock1
   1847 
   1848  cmp #pressplate
   1849  beq :pp
   1850  cmp #upressplate
   1851  beq :jampp
   1852  cmp #floor
   1853  beq :notpp
   1854  cmp #spikes
   1855  beq :notpp
   1856  cmp #flask
   1857  beq :notpp
   1858  cmp #torch
   1859  beq :notpp
   1860  bne ]rts ;can't transform this piece into rubble
   1861 
   1862 :jampp lda #rubble
   1863  sta (BlueType),y
   1864 
   1865 :pp jsr PUSHPP ;block lands on pressplate--
   1866  jsr rdblock1 ;crush pp & jam open all gates
   1867 
   1868 :notpp lda #rubble
   1869  sta (BlueType),y
   1870  jmp markmob
   1871 
   1872 *-------------------------------
   1873 * Mark MOB
   1874 *-------------------------------
   1875 markmob
   1876  lda mobscrn
   1877  cmp VisScrn
   1878  bne ]rts
   1879 
   1880  lda #loosewipe
   1881  sta height
   1882 
   1883  jsr indexblock
   1884  lda #2
   1885  jsr markred
   1886  jsr markwipe
   1887 
   1888  inc tempblockx
   1889 
   1890  jsr indexblock
   1891  lda #2
   1892  jsr markred
   1893  jsr markfred
   1894  jmp markwipe
   1895 
   1896 ]rts rts
   1897 
   1898 *-------------------------------
   1899 *
   1900 *  Did falling floor crush anybody?
   1901 *
   1902 *-------------------------------
   1903 checkcrush
   1904  jsr LoadKid
   1905  jsr chcrush1 ;return cs if crush
   1906  bcc ]rts
   1907  jsr crushchar
   1908  jmp SaveKid
   1909 
   1910 chcrush1
   1911  lda mobscrn
   1912  cmp CharScrn ;on same screen as char?
   1913  bne :no
   1914 
   1915  lda mobx
   1916  lsr
   1917  lsr
   1918  cmp CharBlockX ;same blockx?
   1919  bne :no
   1920 
   1921  lda moby
   1922  cmp CharY
   1923  bcs :no ;mob is below char altogether
   1924 
   1925  lda CharY
   1926  sec
   1927  sbc #CrushDist
   1928  cmp moby
   1929  bcs :no
   1930  sec ;crush!
   1931  rts
   1932 
   1933 :no clc
   1934 ]rts rts
   1935 
   1936 *-------------------------------
   1937 *
   1938 *  Crush char with falling block
   1939 *  (Ordered by ANIMMOB)
   1940 *
   1941 *-------------------------------
   1942 crushchar
   1943  lda level
   1944  cmp #13
   1945  beq :1
   1946  lda CharPosn
   1947  cmp #5
   1948  bcc :1
   1949  cmp #15
   1950  bcc ]rts ;running-->escape
   1951 
   1952 :1 lda CharAction
   1953  cmp #2
   1954  bcc :ground
   1955  cmp #7
   1956  bne ]rts
   1957 
   1958 * Action code 0,1,7 -- on ground
   1959 
   1960 :ground
   1961  ldx CharBlockY
   1962  inx
   1963  lda FloorY,x
   1964  sta CharY ;align w/floor
   1965 
   1966  lda #1
   1967  jsr decstr
   1968  beq :kill
   1969 
   1970  lda CharPosn
   1971  cmp #109
   1972  beq ]rts
   1973  lda #crush
   1974  jmp jumpseq
   1975 
   1976 :kill lda #hardland ;temp
   1977  jmp jumpseq
   1978 
   1979 *-------------------------------
   1980 *
   1981 *  Add all visible MOBs to object table (to be drawn later)
   1982 *
   1983 *-------------------------------
   1984 ADDMOBS
   1985  ldx nummob ;# objs in motion (0-maxmob)
   1986  beq :rts
   1987 
   1988 :loop stx tempnt
   1989  jsr loadmob
   1990 
   1991  lda mobtype
   1992  bne :1
   1993  jsr ATM ;Add this MOB
   1994 :1
   1995  ldx tempnt
   1996  dex
   1997  bne :loop
   1998 :rts
   1999 ]rts rts
   2000 
   2001 *-------------------------------
   2002 *
   2003 *  Add this MOB to obj table (if visible)
   2004 *
   2005 *-------------------------------
   2006 ATM
   2007 
   2008 * Is floorpiece visible onscreen?
   2009 
   2010  lda mobscrn
   2011  cmp VisScrn
   2012  bne :ok2
   2013 
   2014  lda moby
   2015  cmp #192+17 ;17 is generous estimate of image height
   2016  bcc :ok
   2017  rts
   2018 :ok2
   2019  cmp scrnBelow
   2020  bne ]rts ;not on screen below
   2021 
   2022  lda moby
   2023  cmp #-17
   2024  bcs :ok1
   2025  cmp #17
   2026  bcs ]rts
   2027 :ok1
   2028  clc
   2029  adc #192
   2030  sta moby ;(this change won't be saved)
   2031 :ok
   2032 
   2033 * Get block #; index char
   2034 
   2035  lda moby
   2036  jsr getblocky ;return blocky (0-3)
   2037  sta tempblocky
   2038 
   2039  lda mobx
   2040  lsr
   2041  lsr
   2042  sta tempblockx
   2043 
   2044  jsr indexblock
   2045  sty FCharIndex
   2046 
   2047 * Mark floorbuf & fredbuf of affected blocks to R
   2048 
   2049 :cont1
   2050  inc tempblockx
   2051  jsr indexblock  ;block to R
   2052 
   2053  lda #2
   2054  jsr markfloor
   2055  jsr markfred
   2056 
   2057  lda moby
   2058  sec
   2059  sbc #FFheight
   2060  jsr getblocky ;highest affected blocky
   2061  cmp tempblocky
   2062  beq :same
   2063 
   2064  sta tempblocky
   2065  jsr indexblock ;block to U.R.
   2066 
   2067  lda #2
   2068  jsr markfloor
   2069  jsr markfred
   2070 :same
   2071 
   2072 * Get frame #
   2073 
   2074  lda #Ffalling
   2075  sta mobframe
   2076 
   2077  jmp addmobobj ;add MOB to object table
   2078 
   2079 *-------------------------------
   2080 *
   2081 *  Add MOB to object table
   2082 *
   2083 *  In: mob data
   2084 *
   2085 *-------------------------------
   2086 addmobobj
   2087  inc objX
   2088  ldx objX
   2089 
   2090  lda mobtype ;0 = falling floor
   2091  ora #$80
   2092  sta objTYP,x
   2093 
   2094  lda mobx
   2095  sta objX,x
   2096  lda #0
   2097  sta objOFF,x
   2098 
   2099  lda moby
   2100  sta objY,x
   2101 
   2102  lda mobframe
   2103  sta objIMG,x
   2104 
   2105  lda #0
   2106  sta objCU,x
   2107  sta objCL,x
   2108  lda #40
   2109  sta objCR,x
   2110 
   2111  jmp setobjindx
   2112 ]rts rts
   2113 *-------------------------------
   2114 *
   2115 * Shake floors
   2116 *
   2117 * In: A = CharBlockY
   2118 *
   2119 *-------------------------------
   2120 SHAKEM
   2121  ldx level
   2122  cpx #13
   2123  beq ]rts
   2124 
   2125  sta tempblocky
   2126 
   2127  lda VisScrn
   2128  sta tempscrn
   2129 
   2130 SHAKEM1
   2131  ldx #9
   2132 :loop txa
   2133  pha
   2134  sta tempblockx
   2135 
   2136  jsr rdblock1
   2137  cmp #loose
   2138  bne :cont
   2139 
   2140  jsr shakeit
   2141 
   2142 :cont pla
   2143  tax
   2144  dex
   2145  bpl :loop
   2146 
   2147 ]rts rts
   2148 
   2149 *-------------------------------
   2150 * Shake loose floor
   2151 *-------------------------------
   2152 shakeit
   2153  lda (BlueSpec),y
   2154  bmi ]rts ;already wiggling
   2155  bne ]rts ;active
   2156 
   2157  lda #$80
   2158  sta (BlueSpec),y
   2159 
   2160  sty trloc
   2161 
   2162  lda tempscrn ;from rdblock
   2163  sta trscrn
   2164 
   2165  lda #1
   2166  sta trdirec
   2167 
   2168  jmp addtrob ;add floor to trans list
   2169 
   2170 *-------------------------------
   2171  lst
   2172  ds 1
   2173  usr $a9,21,$00,*-org
   2174  lst off