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

CTRL.S (29542B)


      1 * ctrl
      2 org = $3a00
      3  tr on
      4  lst off
      5 *-------------------------------
      6  org org
      7 
      8  jmp PLAYERCTRL
      9  jmp CHECKFLOOR
     10  jmp SHADCTRL
     11  jmp REREADBLOCKS
     12  jmp CHECKPRESS
     13 
     14  jmp DOIMPALE
     15  jmp GENCTRL
     16  jmp CHECKIMPALE
     17 
     18 *-------------------------------
     19  lst
     20  put eq
     21  lst
     22  put gameeq
     23  lst
     24  put seqdata
     25  lst
     26  put soundnames
     27  lst
     28  put movedata
     29  lst off
     30 
     31  dum $f0
     32 ztemp ds 1
     33 jxtemp ds 1
     34 jytemp ds 1
     35 jbtemp ds 1
     36 atemp ds 1
     37  dend
     38 
     39 *-------------------------------
     40 *  Misc. changeable parameters
     41 
     42 DeathVelocity = 33
     43 OofVelocity = 22
     44 
     45 grabreach = -8
     46 grabspeed = 32 ;max Y-vel to grab ledge
     47 grablead = 25 ;increase to grab ledge earlier
     48 stuntime = 12
     49 
     50 jumpupreach = 0
     51 jumpupangle = -6
     52 
     53 JumpBackThres = 6
     54 StepOffFwd = 3
     55 StepOffBack = 8
     56 
     57 swordthres = 90 ;to go en garde (facing fwd)
     58 swordthresN = -10 ;" " (behind you)
     59 blockthres = 32
     60 graceperiod = 9
     61 gdpatience = 15
     62 
     63 gclimbthres = 6
     64 
     65 stairthres = 30
     66 
     67 plus1 db -1,1
     68 minus1 db 1,-1
     69 
     70 *-------------------------------
     71 *
     72 *  If he's passed thru floor plane, change CharBlockY
     73 *  If floor is solid, stop him
     74 *
     75 *-------------------------------
     76 falling
     77  lda CharY
     78 
     79  ldx CharBlockY
     80  inx
     81  cmp FloorY,x
     82  bcs :1
     83 
     84  jmp fallon ;Hasn't reached floor yet
     85 
     86 * Character is passing thru floor plane
     87 
     88 :1 jsr getunderft ;Check if there's
     89  ;solid floor underfoot
     90  cmp #block
     91  bne :2 ;Solid block is special case--
     92  jsr InsideBlock ;reset him to either side of block
     93 
     94 :2 jsr cmpspace
     95  bne hitflr
     96 
     97  inc CharBlockY ;Fall thru floor plane
     98 
     99 ]rts rts
    100 *-------------------------------
    101 *
    102 *  C H E C K  F L O O R
    103 *
    104 *-------------------------------
    105 
    106 CHECKFLOOR
    107  lda CharAction
    108  cmp #6 ;hanging?
    109  beq ]rts
    110 
    111  cmp #5 ;bumped?
    112  bne :2
    113  lda CharPosn
    114  cmp #109 ;crouched (e.g. on loose floor)
    115  beq :ong
    116  cmp #185 ;dead
    117  bne ]rts
    118 :ong jmp onground
    119 
    120 :2 cmp #4 ;freefall
    121  beq falling
    122  cmp #3
    123  bne :1
    124  lda CharPosn
    125  cmp #102
    126  bcc ]rts
    127  cmp #106
    128  bcs ]rts
    129  jmp fallon
    130 
    131 :1 cmp #2 ;hanging
    132  beq ]rts
    133  jmp onground ;7, 0, or 1: on the ground
    134 
    135 *-------------------------------
    136 *
    137 *  Floor stops him -- Choose appropriate landing
    138 *
    139 *-------------------------------
    140 hitflr
    141  ldx CharBlockY
    142  inx
    143  lda FloorY,x
    144  sta CharY ;align char w/floor
    145 
    146  jsr getunderft
    147  cmp #spikes
    148  beq :hitspikes
    149 
    150 * Has he landed too close to edge?
    151 
    152  jsr getinfront
    153  jsr cmpspace
    154  bne :cont ;no
    155 
    156  jsr getdist ;# pixels to edge
    157  cmp #4 ;was 2
    158  bcs :cont
    159 ;Yes--move him back a little
    160  lda #-3
    161  jsr addcharx
    162  sta CharX
    163 
    164 :cont jsr addslicers ;trigger slicers on this level
    165 
    166  lda CharLife
    167  bpl :hardland ;dead before he hits the ground
    168 
    169  jsr getdist
    170  cmp #12
    171  bcc :nc
    172  jsr getbehind
    173  cmp #spikes
    174  beq :hitspikes ;check block behind if dist>=12
    175 
    176 :nc jsr getunderft ;what has he landed on?
    177  cmp #spikes
    178  bne :notspikes
    179 
    180 :hitspikes
    181  jsr getspikes ;are spikes lethal?
    182  bne :impale ;yes
    183 
    184 :notspikes
    185  lda CharYVel
    186  cmp #OofVelocity
    187  bcc :softland
    188 
    189  cmp #DeathVelocity
    190  bcc :medland
    191 
    192 :hardland
    193  lda #100
    194  jsr decstr
    195 :hdland1
    196  lda #Splat
    197  jsr addsound
    198 
    199  lda #hardland
    200  bne :doland
    201 
    202 :medland
    203  lda CharID
    204  cmp #1
    205  beq :softland ;shad lands easy
    206  cmp #2
    207  bcs :hardland ;guards can't survive 2 stories
    208 
    209  lda #1
    210  jsr decstr
    211  beq :hdland1
    212 
    213  lda #Splat
    214  jsr addsound
    215 
    216  lda #medland
    217  bne :doland
    218 
    219 :softland
    220  lda CharID
    221  cmp #2
    222  bcs :gd ;guard always lands en garde
    223  lda CharSword
    224  cmp #2
    225  bne :1
    226 :gd lda #2
    227  sta CharSword
    228  lda #landengarde
    229  bne :doland
    230 
    231 :1 lda #softland
    232  bne :doland
    233 
    234 :impale jmp DoImpale
    235 
    236 :doland jsr jumpseq
    237  jsr animchar
    238 
    239  lda #0
    240  sta CharYVel
    241 ]rts rts
    242 
    243 *-------------------------------
    244 *
    245 *  Hasn't hit floor yet -- can he grab edge above?
    246 *
    247 *-------------------------------
    248 fallon
    249  lda btn ;is button down?
    250  and CharLife ;& is he alive?
    251  bpl ]rts
    252  ;yes--can he grab edge?
    253  lda CharYVel
    254  cmp #grabspeed
    255  bcs ]rts ;no--falling too fast
    256 
    257  lda CharY
    258  clc
    259  adc #grablead
    260  ldx CharBlockY
    261  inx
    262  cmp FloorY,x
    263  bcc ]rts  ;not within grabbing range yet
    264 
    265 *  Char is within vertical range, and button is down
    266 *  Is there a ledge within reach?
    267 
    268  lda CharX
    269  sta savekidx
    270  lda #grabreach
    271  jsr addcharx
    272  sta CharX
    273  jsr rereadblocks
    274 
    275  jsr :test ;can you grab ledge?
    276  bne :ok ;yes--do it
    277  lda savekidx
    278  sta CharX
    279  jmp rereadblocks
    280 :ok ;do it!
    281 
    282 * Align char with block
    283 
    284  jsr getdist
    285 
    286  jsr addcharx
    287  sta CharX
    288 
    289  ldx CharBlockY
    290  inx
    291  lda FloorY,x
    292  sta CharY
    293 
    294  lda #0
    295  sta CharYVel
    296 
    297  lda #fallhang
    298  jsr jumpseq
    299  jsr animchar
    300 
    301  lda #stuntime
    302  sta stunned
    303 ]rts rts
    304 
    305 :test jsr getabove
    306  sta blockid
    307  jsr getaboveinf
    308  jmp checkledge
    309 
    310 *-------------------------------
    311 *  Is there floor underfoot?  If not, start to fall
    312 
    313 onground
    314  lda Fcheck
    315  and #fcheckmark
    316  beq ]rts ;0--no need to check
    317 
    318  jsr getunderft
    319  cmp #block
    320  bne :1
    321  jsr InsideBlock ;If "inside" block, bump him outside
    322 :1
    323  jsr cmpspace
    324  bne ]rts
    325 
    326 * Level 12: Phantom bridge
    327 
    328  lda level
    329  cmp #12
    330  bne :no
    331  lda mergetimer
    332  bpl :no
    333  lda CharBlockY
    334  bne :no
    335  lda CharScrn
    336  cmp #2
    337  beq :yes
    338  cmp #13
    339  bne :no
    340  lda tempblockx
    341  cmp #6
    342  bcc :no
    343 ;Create floorboards on the fly
    344 :yes lda #floor
    345  sta (BlueType),y
    346  jsr indexblock
    347  lda #2
    348  jsr :sub
    349  iny
    350 :sub jsr markwipe
    351  jmp markred
    352 :no
    353 *-------------------------------
    354 *  No floor underfoot--commence falling
    355 
    356 startfall
    357  lda #0
    358  sta rjumpflag
    359  sta CharSword ;so you can grab on
    360 
    361  inc CharBlockY ;# of floor just below your feet
    362  jsr addslicers
    363 
    364  lda CharPosn ;upcoming frame
    365 ;(the one we're about to replace
    366 ;with first frame of falling seq)
    367  sta rjumpflag
    368 
    369  cmp #9 ;run-12
    370  beq :stepfall
    371  cmp #13 ;run-16
    372  beq :stepfall2
    373  cmp #26 ;standjump-19
    374  beq :jumpfall
    375  cmp #44 ;runjump-11
    376  beq :rjumpfall
    377  cmp #81
    378  bcc :2
    379  cmp #86
    380  bcc :hdropfall
    381 :2 cmp #150
    382  bcc :1
    383  cmp #180
    384  bcc :fightfall ;from fighting stance
    385 :1
    386 
    387 :stepfall lda #stepfall
    388  bne :doit
    389 
    390 :stepfall2 lda #stepfall2
    391  bne :doit
    392 
    393 :jumpfall lda #jumpfall
    394  bne :doit
    395 
    396 :rjumpfall lda #rjumpfall
    397  bne :doit
    398 
    399 :hdropfall
    400  lda #5
    401  jsr addcharx
    402  sta CharX
    403  jsr rereadblocks
    404  jmp :stepfall2
    405 ]rts rts
    406 
    407 :fightfall lda CharID
    408  cmp #2
    409  bcc :player
    410  lda CharXVel
    411  bmi :fb ;did gd step off fwd or bkwd?
    412  lda #0
    413  sta droppedout
    414  lda #efightfallfwd
    415  bne :doit
    416 :fb lda #efightfall
    417  bne :doit
    418 :player lda #1
    419  sta droppedout ;for guard's benefit
    420  lda #fightfall
    421  bne :doit
    422 
    423 *-------------------------------
    424 :doit jsr jumpseq
    425  jsr animchar ;advance 1 frame into fall
    426 
    427  jsr rereadblocks
    428  jsr getunderft
    429  jsr cmpwall
    430  beq :bump
    431  jsr getinfront
    432  jsr cmpwall
    433  bne ]rts
    434  jmp CDpatch
    435 
    436 :bump jmp InsideBlock ;If "inside" block, bump him outside
    437 
    438 CDpatch
    439  lda rjumpflag
    440  cmp #44 ;running jump?
    441  bne :patchX
    442 
    443  jsr getdist
    444  cmp #6
    445  bcs :patchX ;dist >= 6...we're OK
    446 
    447  lda #patchfall
    448  jsr jumpseq
    449  jsr animchar
    450  jmp rereadblocks
    451 
    452 :patchX lda #-1
    453 :1 jsr addcharx
    454  sta CharX
    455  jmp rereadblocks
    456 
    457 *-------------------------------
    458 *
    459 * Char is "inside" a block--bump him outside
    460 * (hopefully the same side from which he entered)
    461 *
    462 * Change Char X & return rdblock results
    463 *
    464 *-------------------------------
    465 InsideBlock
    466  jsr getdist ;to EOB
    467  cmp #8
    468  bcs :bumpback
    469 
    470 :bumpfwd
    471  jsr getinfront
    472  cmp #block
    473  beq :bumpback
    474 
    475  jsr getdist ;to EOB
    476  clc
    477  adc #4
    478 :reland
    479  jsr addcharx
    480  sta CharX
    481  jsr rereadblocks ;reposition char
    482  jmp getunderft
    483 
    484 :bumpback
    485  jsr getbehind
    486  cmp #block
    487  bne :1
    488   ;we're screwed
    489 ;bump 2 back (what the hell)
    490  jsr getdist
    491  clc
    492  adc #14
    493  eor #$ff
    494  clc
    495  adc #8
    496  jmp :reland
    497 :1
    498  jsr getdist
    499  eor #$ff
    500  clc
    501  adc #8
    502  jmp :reland
    503 
    504 *-------------------------------
    505 *
    506 *  S H A D O W   C O N T R O L
    507 *
    508 *-------------------------------
    509 SHADCTRL
    510  lda CharID
    511  cmp #24 ;mouse?
    512  bne :1
    513  jmp AutoCtrl
    514 
    515 :1 lda CharLife
    516  bpl :dead
    517 ;Has char's life run out?
    518  lda OppStrength
    519  bne :cont
    520  lda #0
    521  sta CharLife
    522  jsr deadenemy
    523 
    524 :dead lda CharID
    525  cmp #1 ;shadow man?
    526  bne :cont
    527  jmp VanishChar
    528 
    529 :cont lda ManCtrl
    530  bne :manualctrl
    531 
    532  jsr AutoCtrl
    533 
    534  jmp GenCtrl
    535 
    536 * Manual ctrl: enemy controlled by deselected device
    537 
    538 :manualctrl
    539  jsr LoadDesel
    540 
    541  jsr getdesel
    542 
    543  jsr clrjstk
    544 
    545  jsr UserCtrl
    546 
    547  jmp SaveDesel
    548 
    549 *-------------------------------
    550 *
    551 *  P L A Y E R   C O N T R O L
    552 *
    553 *-------------------------------
    554 PLAYERCTRL
    555  lda CharLife
    556  bpl :cont1 ;dead
    557  lda KidStrength
    558  bne :cont1
    559  lda #0
    560  sta CharLife
    561 :cont1
    562  lda stunned
    563  beq :cont
    564  dec stunned
    565 
    566 :cont lda level
    567  bne :game
    568 :demo jsr DemoCtrl
    569  jmp GenCtrl
    570 
    571 * Character controlled by selected device
    572 
    573 :game jsr LoadSelect ;load jstk-push flags for selected device
    574 
    575  jsr getselect ;get current input from selected device
    576 
    577  jsr clrjstk ;clear appropriate jstk-push flags
    578 
    579  lda #2
    580  jsr UserCtrl
    581 
    582  jmp SaveSelect ;save updated jstk-push flags
    583 
    584 *-------------------------------
    585 * Player ctrl in demo
    586 
    587 DemoCtrl
    588  lda milestone
    589  bne :finish
    590  lda CharSword
    591  beq :preprog
    592 
    593  lda #10
    594  sta guardprog
    595  jsr AutoCtrl
    596  lda #11
    597  sta guardprog
    598  rts
    599 
    600 :preprog jmp demo
    601 
    602 :finish jsr clrall
    603  sta clrbtn
    604  lda #-1
    605  sta clrF
    606  sta JSTKX ;run o.s.
    607 ]rts rts
    608 
    609 *-------------------------------
    610 UserCtrl
    611  lda CharFace
    612  bpl :faceL
    613 
    614  jmp GenCtrl
    615 
    616 * If char is facing right, reverse JSTK & clrF/clrB
    617 
    618 :faceL jsr facejstk
    619 
    620  jsr GenCtrl
    621 
    622  jmp facejstk
    623 
    624 *-------------------------------
    625 clrall
    626  lda #0
    627  sta clrB
    628  sta clrF
    629  sta clrU
    630  sta clrD
    631  lda #1
    632 ]rts rts
    633 
    634 *-------------------------------
    635 *
    636 *  G E N E R A L   C O N T R O L
    637 *
    638 *  In: Raw input
    639 *        JSTKX (- fwd, + back, 0 center)
    640 *        JSTKY (- up, + down, 0 center)
    641 *        btn (- down, + up)
    642 *      Smart input
    643 *        clrF-B-U-D-btn (- = fresh press)
    644 *
    645 *  Set clr = 1 after using a press
    646 *
    647 *-------------------------------
    648 GENCTRL
    649  lda CharLife
    650  bmi :alive
    651 
    652 * Dead character (If he's standing, collapse)
    653 
    654 :dead lda CharPosn
    655  cmp #15
    656  beq :drop
    657  cmp #166
    658  beq :drop
    659  cmp #158
    660  beq :drop
    661  cmp #171
    662  bne ]rts
    663 :drop lda #dropdead
    664  jmp jumpseq
    665 
    666 * Live character
    667 
    668 :alive lda CharAction
    669  cmp #5 ;is char in mid-bump?
    670  beq :clr
    671  cmp #4 ;or falling?
    672  beq :clr
    673  bne :underctrl
    674 :clr
    675 ]clr jmp clrall
    676 
    677 :underctrl
    678  lda CharSword
    679  cmp #2 ;in fighting mode?
    680  beq FightCtrl ;yes
    681 
    682  lda CharID
    683  cmp #2 ;kid or shadowman?
    684  bcc :cont
    685  jmp GuardCtrl ;no
    686 
    687 * First question: what is char doing now?
    688 
    689 :cont ldx CharPosn ;previous frame #
    690 
    691  cpx #15
    692  beq :standing
    693 
    694  cpx #48
    695  beq :turning
    696 
    697  cpx #50
    698  bcc :0
    699  cpx #53
    700  bcc :standing ;turn7-8-9/crouch
    701 :0
    702  cpx #4
    703  bcc :starting ;run4-5-6
    704 
    705  cpx #67
    706  bcc :4
    707  cpx #70
    708  bcc :stjumpup ;starting to jump up
    709 
    710 :4 cpx #15
    711  bcs :2
    712  jmp :running ;run8-17
    713 
    714 :2 cpx #87
    715  bcc :1
    716  cpx #100
    717  bcs :1
    718  jmp :hanging ;jumphang22-34
    719 
    720 :1 cpx #109 ;crouching?
    721  beq :crouching
    722 :3
    723 ]rts rts
    724 
    725 :standing jmp standing
    726 :starting jmp starting
    727 :stjumpup jmp stjumpup
    728 :running jmp arunning
    729 :hanging jmp hanging
    730 :turning jmp turning
    731 :crouching jmp crouching
    732 
    733 *-------------------------------
    734 * Similar routine for guard
    735 
    736 GuardCtrl
    737  ldx CharPosn
    738  cpx #166 ;standing?
    739  beq :alert
    740 ]rts rts
    741 
    742 :alert
    743  lda clrD
    744  bpl ]rts
    745  lda clrF
    746  bmi :engarde
    747  bpl :turn
    748 
    749 :engarde jmp DoEngarde
    750 
    751 :turn lda #1
    752  sta clrD
    753  lda #alertturn
    754  jmp jumpseq
    755 
    756 *-------------------------------
    757 * Char is en garde (CharSword = 2)
    758 
    759 FightCtrl
    760  lda CharAction
    761  cmp #2
    762  bcs ]rts ;Must be on level ground (Action = 1)
    763 
    764 * If Enemy Alert is over, put away your sword
    765 
    766  jsr getunderft
    767  cmp #loose
    768  beq :skip ;unless you're standing on loose floor
    769 
    770  lda EnemyAlert
    771  cmp #2
    772  bcc :dropgd
    773 
    774 * If opponent is behind you, turn to face him
    775 
    776 :skip jsr getopdist ;fwd distance to opponent
    777  cmp #swordthres
    778  bcc :onalert
    779  cmp #128
    780  bcc :dropgd
    781  cmp #-4
    782  bcs :onalert ;overlapping
    783  jmp DoTurnEng
    784 
    785 * Enemy out of range--drop your guard
    786 * (kid & shadman only)
    787 
    788 :dropgd lda CharID
    789  bne :1
    790  sta heroic
    791  beq :2
    792 :1 cmp #2
    793  bcs :onalert ;guard: remain en garde
    794 :2
    795  ldx CharPosn
    796  cpx #171 ;wait for ready posn
    797  bne ]rts
    798 
    799  lda #0
    800  sta CharSword
    801 
    802  lda #resheathe
    803  jmp jumpseq
    804 ]rts rts
    805 
    806 *-------------------------------
    807 * Remain en garde
    808 
    809 :onalert
    810  ldx CharPosn ;prev frame #
    811  cpx #161 ;successful block?
    812  bne :nobloc
    813  lda clrbtn ;yes--restrike or retreat?
    814  bmi :bts
    815  lda #retreat
    816  jmp jumpseq
    817 
    818 * Fresh button press to strike
    819 
    820 :nobloc lda clrbtn
    821  bpl :10
    822 :bts
    823  lda CharID
    824  bne :11
    825  lda #gdpatience
    826  sta gdtimer
    827 
    828 :11 jsr DoStrike
    829 
    830  lda clrbtn
    831  cmp #1
    832  beq ]rts ;struck
    833 :10 ;else didn't strike
    834 
    835 * Down to lower your sword
    836 
    837  lda clrD
    838  bpl :nodrop
    839 
    840  ldx CharPosn
    841  cpx #158 ;ready
    842  beq :ready1
    843  cpx #170
    844  beq :ready1
    845  cpx #171
    846  bne ]rts
    847 :ready1
    848  lda #1
    849  sta clrD
    850 
    851  lda #0
    852  sta CharSword
    853 
    854  lda CharID
    855  beq :drop ;for kid
    856  cmp #1
    857  beq :sstand ;for shadman
    858 
    859 :alert lda #goalertstand
    860  jmp jumpseq ;for guard
    861 
    862 :drop lda #1
    863  sta offguard
    864  lda #graceperiod
    865  sta refract
    866  lda #0
    867  sta heroic
    868  lda #fastsheathe
    869  jmp jumpseq
    870 
    871 :sstand lda #resheathe
    872  jmp jumpseq
    873 
    874 * Fwd to advance, up to block, back to retreat
    875 
    876 :nodrop
    877  lda clrU
    878  bmi :up
    879  lda clrF
    880  bmi :fwd
    881  lda clrB
    882  bmi :back
    883 
    884 ]rts rts
    885 
    886 :fwd jmp DoAdvance
    887 :up jmp DoBlock
    888 :back jmp DoRetreat
    889 
    890 *-------------------------------
    891 DoTurnEng
    892  lda #turnengarde
    893  jmp jumpseq
    894 
    895 *-------------------------------
    896 DoBlock
    897  ldx CharPosn
    898  cpx #158 ;ready
    899  beq :2
    900  cpx #170
    901  beq :2
    902  cpx #171
    903  beq :2
    904  cpx #168 ;guy-2
    905  beq :2
    906 
    907  cpx #165 ;adv
    908  beq :2
    909  cpx #167 ;blocked strike
    910  beq :3
    911 
    912 ]rts rts
    913 
    914 * From ready position: Block if appropriate
    915 
    916 :2 jsr getopdist
    917  cmp #blockthres
    918  bcs :blockmiss ;too far
    919 
    920  lda #readyblock
    921  ldx CharID
    922  beq :kid
    923  ldx OpPosn ;enemy sees kid 1 frame ahead
    924  cpx #152 ;guy4
    925  beq :doit
    926 ]rts rts
    927 
    928 :kid ldx OpPosn
    929  cpx #168 ;1 frame too early?
    930  beq ]rts  ;yes--wait 1 frame
    931 
    932  cpx #151 ;guy3
    933  beq :doit
    934  cpx #152 ;guy4
    935  beq :doit
    936  cpx #162 ;guy22
    937  beq :doit
    938 
    939  cpx #153 ;1 frame too late?
    940  bne :blockmiss
    941   ;yes--skip 1 frame
    942  jsr :doit
    943  jmp animchar
    944 
    945 * Strike-to-block
    946 
    947 :3 lda #strikeblock
    948 :doit ldx #1
    949  stx clrU
    950  jmp jumpseq
    951 :blockmiss
    952  lda CharID
    953  bne DoRetreat ;enemy doesn't waste blocks
    954  lda #readyblock
    955  bne :doit
    956 
    957 *-------------------------------
    958 DoStrike
    959  cpx #157
    960  beq :1
    961  cpx #158
    962  beq :1
    963  cpx #170
    964  beq :1
    965  cpx #171
    966  beq :1 ;strike from ready posn
    967  cpx #165
    968  beq :1 ;from advance
    969  cpx #150
    970  beq :2 ;from missed block
    971  cpx #161
    972  beq :2 ;from successful block
    973 
    974 ]rts rts
    975 
    976 :1 lda CharID
    977  bne :slo ;kid is fast, others slow
    978 
    979  lda #faststrike
    980  bne :dostr
    981 
    982 :slo lda #strike
    983 :dostr ldx #1
    984  stx clrbtn
    985  jmp jumpseq
    986 
    987 :2 lda #blocktostrike
    988  bne :dostr
    989 
    990 *-------------------------------
    991 DoRetreat
    992  ldx CharPosn
    993  cpx #158
    994  beq :1 ;strike from ready posn
    995  cpx #170
    996  beq :1
    997  cpx #171
    998  beq :1
    999 ]rts rts
   1000 
   1001 :1 lda #retreat
   1002  ldx #1
   1003  stx clrB
   1004  jmp jumpseq
   1005 
   1006 *-------------------------------
   1007 DoAdvance
   1008  ldx CharPosn
   1009  cpx #158
   1010  beq :1
   1011  cpx #170
   1012  beq :1
   1013  cpx #171
   1014  beq :1
   1015 ]rts rts
   1016 
   1017 :1 lda CharID
   1018  bne :slo ;kid is faster
   1019  lda #fastadvance
   1020  bne :doit
   1021 :slo lda #advance
   1022 :doit ldx #1
   1023  stx clrF
   1024  jmp jumpseq
   1025 
   1026 *-------------------------------
   1027 *
   1028 *  S T A N D I N G
   1029 *
   1030 *-------------------------------
   1031 standing
   1032 
   1033 * Fresh button click: pick up object?
   1034 
   1035  lda clrbtn
   1036  bpl :noclick
   1037  lda btn
   1038  bpl :noclick
   1039  jsr TryPickup
   1040  bne ]rts ;yes
   1041 :noclick
   1042 
   1043 * Shadman only: down & fwd to go en garde
   1044 
   1045  lda CharID
   1046  beq :kid
   1047  lda clrD
   1048  bpl :1
   1049  lda clrF
   1050  bpl :1
   1051  jmp DoEngarde
   1052 
   1053 * If opponent is within range, go en garde
   1054 * (For kid only)
   1055 
   1056 :kid lda gotsword
   1057  beq :1 ;no sword
   1058 
   1059  lda offguard
   1060  beq :notoffg
   1061  lda btn ;off guard--push btn to draw sword
   1062  bpl :btnup
   1063 :notoffg
   1064  lda EnemyAlert
   1065  cmp #2
   1066  bcc :safe
   1067  jsr getopdist ;fwd distance to opponent
   1068  cmp #swordthresN
   1069  bcs :danger
   1070  cmp #swordthres
   1071  bcs :safe
   1072 
   1073 :danger ldx #1
   1074  stx heroic
   1075  cmp #-6
   1076  bcs :behindyou
   1077 
   1078  lda OpID
   1079  cmp #1
   1080  bne :engarde
   1081  lda OpAction
   1082  cmp #3
   1083  beq :safe
   1084  lda OpPosn
   1085  cmp #107
   1086  bcc :engarde
   1087  cmp #118
   1088  bcc :safe ;let shadow land
   1089 :engarde jmp DoEngarde
   1090 
   1091 :behindyou jmp DoTurn
   1092 
   1093 :safe lda #0
   1094  sta offguard
   1095 
   1096 :1 lda btn
   1097  bpl :btnup
   1098 
   1099 *-------------------------------
   1100 * Standing, button down
   1101 
   1102 :2 lda clrB
   1103  bmi :backB
   1104 
   1105  lda clrU
   1106  bmi :up
   1107 
   1108  lda clrD
   1109  bmi :down
   1110 
   1111  lda JSTKX
   1112  bpl :rts
   1113 
   1114  lda clrF
   1115  bmi :fwdB
   1116 :rts
   1117 ]rts rts
   1118 
   1119 *-------------------------------
   1120 * Standing, button up
   1121 
   1122 :btnup
   1123  lda clrF
   1124  bmi :fwd
   1125  lda clrB
   1126  bmi :back
   1127  lda clrU
   1128  bmi :up
   1129  lda clrD
   1130  bmi :down
   1131 
   1132  lda JSTKX
   1133  bmi :fwd
   1134 
   1135 ]rts rts
   1136 
   1137 :fwd jmp DoStartrun
   1138 :fwdB jmp DoStepfwd
   1139 
   1140 :back jmp DoTurn
   1141 :backB jmp DoTurn
   1142 
   1143 :fwdup jmp DoStandjump
   1144 
   1145 *-------------------------------
   1146 * Standing, joystick up
   1147 
   1148 :up
   1149 
   1150 * In front of open stairs?
   1151 
   1152  jsr getunderft
   1153  cmp #exit
   1154  beq :stairs
   1155  jsr getbehind
   1156  cmp #exit
   1157  beq :stairs
   1158  jsr getinfront
   1159  cmp #exit
   1160  bne :nostairs
   1161 
   1162 :stairs lda (BlueSpec),y
   1163  lsr
   1164  lsr
   1165  cmp #stairthres
   1166  bcc :nostairs
   1167 
   1168  jmp Stairs
   1169 
   1170 * No -- normal control
   1171 
   1172 :nostairs
   1173  lda JSTKX
   1174  bmi :fwdup
   1175 
   1176 * Straight up...jump up & grab ledge if you can
   1177 
   1178  jmp DoJumpup
   1179 
   1180 *-------------------------------
   1181 * Standing, joystick down
   1182 
   1183 :down
   1184  lda #1
   1185  sta clrD
   1186 
   1187 * If you're standing w/back to edge, down
   1188 * means "climb down & hang from ledge"
   1189 
   1190 * If facing edge, "down" means "step off"
   1191 
   1192  jsr getinfront
   1193  jsr cmpspace
   1194  bne :notfwd ;no cliff in front of you
   1195 
   1196  jsr getdist
   1197  cmp #StepOffFwd
   1198  bcs :notfwd ;not close enough to edge
   1199  lda #5
   1200  jsr addcharx
   1201  sta CharX
   1202  jmp rereadblocks ;move fwd
   1203 
   1204 :notfwd jsr getbehind
   1205  jsr cmpspace
   1206  bne :no ;no cliff behind you
   1207 
   1208  jsr getdist
   1209  cmp #StepOffBack
   1210  bcc :no ;not close enough to edge
   1211 
   1212 * Climb down & hang from ledge
   1213 
   1214  jsr getbehind
   1215  sta blockid
   1216  jsr getunderft
   1217  jsr checkledge
   1218  beq :no
   1219 
   1220  ldx CharFace
   1221  bpl :succeed
   1222  jsr getunderft
   1223  cmp #gate
   1224  bne :succeed
   1225 
   1226  lda (BlueSpec),y
   1227  lsr
   1228  lsr
   1229  cmp #gclimbthres
   1230  bcc :no
   1231 
   1232 :succeed jsr getdist
   1233  sec
   1234  sbc #9
   1235 
   1236  jsr addcharx
   1237  sta CharX
   1238 
   1239  lda #climbdown
   1240  jmp jumpseq
   1241 
   1242 * Otherwise "down" means "crouch"
   1243 
   1244 :no jmp DoCrouch
   1245 
   1246 *-------------------------------
   1247 * Climb stairs
   1248 
   1249 Stairs
   1250  lda tempblockx ;stairs block
   1251  jsr getblockej
   1252  clc
   1253  adc #10
   1254  sta CharX
   1255  lda #-1
   1256  sta CharFace
   1257 
   1258  lda #climbstairs
   1259  jmp jumpseq
   1260 
   1261 ]rts rts
   1262 
   1263 *-------------------------------
   1264 *
   1265 *  C R O U C H I N G
   1266 *
   1267 *-------------------------------
   1268 crouching
   1269 
   1270 * Fresh button click?
   1271 
   1272  lda clrbtn
   1273  bpl :noclick
   1274 
   1275  jsr TryPickup
   1276  bne ]rts
   1277 
   1278 * Still crouching?
   1279 
   1280 :noclick
   1281  lda JSTKY
   1282  cmp #1
   1283  beq :1
   1284  lda #standup
   1285  jmp jumpseq
   1286 
   1287 :1 lda clrF
   1288  bpl ]rts
   1289  lda #1
   1290  sta clrF
   1291  lda #crawl
   1292  jmp jumpseq
   1293 
   1294 *-------------------------------
   1295 *
   1296 *  S T A R T I N G
   1297 *
   1298 *  First few frames of "startrun"
   1299 *
   1300 *-------------------------------
   1301 starting
   1302  lda JSTKY
   1303  bmi :jump
   1304 ]rts rts
   1305 
   1306 :jump
   1307  lda JSTKX
   1308  bpl ]rts
   1309 
   1310  jmp DoStandjump
   1311 
   1312 *-------------------------------
   1313 * First few frames of "jumpup"
   1314 
   1315 stjumpup
   1316  lda JSTKX
   1317  bmi :fwd
   1318  lda clrF
   1319  bmi :fwd
   1320 ]rts rts
   1321 :fwd jmp DoStandjump
   1322 
   1323 *-------------------------------
   1324 *
   1325 * T U R N I N G
   1326 *
   1327 *-------------------------------
   1328 turning
   1329  lda btn
   1330  bmi ]rts
   1331 
   1332  lda JSTKX
   1333  bpl ]rts
   1334 
   1335  lda JSTKY
   1336  bmi ]rts
   1337 
   1338 * Jstk still fwd--convert turn to turnrun
   1339 
   1340  lda #turnrun
   1341  jmp jumpseq
   1342 
   1343 *-------------------------------
   1344 *
   1345 *  R U N N I N G
   1346 *
   1347 *-------------------------------
   1348 arunning
   1349  lda JSTKX
   1350  beq :runstop ;jstk centered...stop running
   1351  bpl :runturn ;jstk back...turn around
   1352 
   1353 * Jstk is forward... keep running
   1354 * & wait for signal to runjump or diveroll
   1355 
   1356  lda JSTKY
   1357  bmi :runjump ;jstk up... take a running jump
   1358 
   1359  lda clrD
   1360  bmi :diveroll ;jstk down... running dive & roll
   1361 
   1362 ]rts rts
   1363 
   1364 *  Running dive & roll
   1365 
   1366 :diveroll lda #1
   1367  sta clrD
   1368 
   1369  lda #rdiveroll
   1370  jmp jumpseq
   1371 
   1372 *  Running jump
   1373 
   1374 :runjump
   1375  lda clrU
   1376  bpl ]rts
   1377 
   1378  jmp DoRunjump
   1379 
   1380 *  Stop running
   1381 
   1382 :runstop lda CharPosn
   1383  cmp #7 ;run-10
   1384  beq :rs
   1385  cmp #11 ;run-14
   1386  bne ]rts
   1387 
   1388 :rs jsr ]clr
   1389  sta clrF
   1390 
   1391  lda #runstop
   1392  jmp jumpseq
   1393 
   1394 *  Turn around & run the other way
   1395 
   1396 :runturn
   1397  jsr ]clr
   1398  sta clrB
   1399 
   1400  lda #runturn
   1401  jmp jumpseq
   1402 
   1403 *-------------------------------
   1404 *
   1405 *  H A N G I N G
   1406 *
   1407 *-------------------------------
   1408 hanging
   1409  lda stunned
   1410  bne :9 ;can't climb up
   1411 
   1412  lda JSTKY
   1413  bmi :climbup ;jstk up-->climb up
   1414 :9
   1415  lda btn
   1416  bpl :drop
   1417 
   1418 * If hanging on right-hand side of a panel
   1419 * or either side of block,
   1420 * switch to "hangstraight"
   1421 
   1422  lda CharAction
   1423  cmp #6
   1424  beq :cont ;already hanging straight
   1425 
   1426  jsr getunderft
   1427  cmp #block
   1428  beq :hangstrt
   1429 
   1430  ldx CharFace
   1431  cpx #-1 ;left
   1432  bne :cont
   1433 
   1434  cmp #panelwif
   1435  beq :hangstrt
   1436  cmp #panelwof
   1437  beq :hangstrt
   1438 
   1439 * If ledge crumbles away, fall with it
   1440 
   1441 :cont
   1442  jsr getabove
   1443 
   1444  jsr cmpspace ;still there?
   1445  beq :drop ;no
   1446 
   1447 * just keep swinging
   1448 
   1449 :rts
   1450 ]rts rts
   1451 
   1452 :hangstrt lda #hangstraight
   1453  jmp jumpseq
   1454 
   1455 *-------------------------------
   1456 * climb up (if you can)
   1457 
   1458 :climbup
   1459  jsr ]clr
   1460  sta clrU
   1461  sta clrbtn
   1462 
   1463  jsr getabove
   1464 
   1465  cmp #mirror
   1466  beq :10
   1467  cmp #slicer
   1468  bne :1
   1469 
   1470 :10 ldx CharFace
   1471  beq :fail
   1472  bne :succeed ;can only mount mirror facing L
   1473 
   1474 :1 cmp #gate
   1475  bne :2
   1476 
   1477  ldx CharFace
   1478  beq :succeed
   1479 ;can only mount closed gate facing R
   1480  lda (BlueSpec),y
   1481  lsr
   1482  lsr
   1483  cmp #gclimbthres
   1484  bcc :fail
   1485  bcs :succeed
   1486 
   1487 :2
   1488 :succeed lda #climbup
   1489  jmp jumpseq
   1490 
   1491 :fail lda #climbfail
   1492  jmp jumpseq
   1493 
   1494 
   1495 *-------------------------------
   1496 :drop
   1497  jsr ]clr
   1498  sta clrD ;clrD = 1, all others = 0
   1499 
   1500  jsr getbehind
   1501  jsr cmpspace
   1502  bne :hangdrop
   1503 
   1504  jsr getunderft
   1505  jsr cmpspace
   1506  beq :hangfall
   1507 
   1508 :hangdrop
   1509  jsr getunderft
   1510  cmp #block
   1511  beq :sheer
   1512 
   1513  ldx CharFace
   1514  bpl :clear
   1515  cmp #panelwof
   1516  beq :sheer
   1517  cmp #panelwif
   1518  bne :clear
   1519 
   1520 :sheer lda #-7
   1521  jsr addcharx
   1522  sta CharX
   1523 
   1524 :clear lda #hangdrop
   1525  jmp jumpseq
   1526 
   1527 :hangfall
   1528  lda #hangfall
   1529  jmp jumpseq
   1530 ]rts rts
   1531 
   1532 *-------------------------------
   1533 *
   1534 *  D o  S t a r t r u n
   1535 *
   1536 *-------------------------------
   1537 DoStartrun
   1538 
   1539 * If very close to a barrier, do a Stepfwd instead
   1540 * (Exceptions: slicer & open gate)
   1541 
   1542  jsr getfwddist
   1543  cpx #1 ;barrier?
   1544  bne :startrun ;no
   1545 
   1546  cpy #slicer
   1547  beq :startrun
   1548 
   1549 :solidbarr
   1550  jsr getfwddist
   1551  cmp #8
   1552  bcs :startrun
   1553 
   1554  lda clrF
   1555  bpl ]rts
   1556 
   1557  jmp DoStepfwd
   1558 
   1559 :startrun
   1560  lda #startrun
   1561  jmp jumpseq ;...start running
   1562 
   1563 DoTurn jsr ]clr
   1564  sta clrB
   1565 ;if enemy is behind you, draw as you turn
   1566  lda gotsword
   1567  beq :1
   1568  lda EnemyAlert
   1569  cmp #2
   1570  bcc :1
   1571  jsr getopdist
   1572  bpl :1
   1573  jsr getdist ;to EOB
   1574  cmp #2
   1575  bcc :1
   1576 
   1577  lda #2
   1578  sta CharSword ;en garde
   1579  lda #0
   1580  sta offguard
   1581  lda #turndraw
   1582  bne :2
   1583 :1 lda #turn
   1584 :2 jmp jumpseq ;...turn around
   1585 
   1586 DoStandjump lda #1
   1587  sta clrU
   1588  sta clrF
   1589 
   1590  lda #standjump
   1591  jmp jumpseq ;...standing jump
   1592 
   1593 DoSdiveroll lda #1
   1594  sta clrD
   1595 
   1596  lda #sdiveroll
   1597  jmp jumpseq ;...standing dive & roll
   1598 
   1599 DoCrouch
   1600  lda #stoop
   1601  jsr jumpseq
   1602 
   1603  jsr ]clr
   1604  sta clrD
   1605  rts
   1606 
   1607 DoEngarde
   1608  jsr ]clr
   1609  sta clrF
   1610  sta clrbtn
   1611 
   1612  lda #2
   1613  sta CharSword ;en garde
   1614 
   1615  lda CharID
   1616  beq :1
   1617  cmp #1
   1618  beq :3 ;shad
   1619  lda #guardengarde
   1620  bne :2
   1621 :1 lda #0
   1622  sta offguard
   1623 :3 lda #engarde
   1624 :2 jmp jumpseq
   1625 
   1626 *-------------------------------
   1627 *
   1628 *  D o  J u m p u p
   1629 *
   1630 *  & grab ledge if you can
   1631 *
   1632 *-------------------------------
   1633 DoJumpup
   1634  jsr ]clr
   1635  sta clrU
   1636 
   1637  jsr getabove
   1638  sta blockid
   1639 
   1640  jsr getaboveinf
   1641 
   1642  jsr checkledge ;Can you jump up & grab ledge?
   1643  ;Returns 1 if you can, 0 if you can't
   1644  bne  DoJumphang ;yes--do it
   1645 
   1646  jsr getabovebeh
   1647  sta blockid
   1648 
   1649  jsr getabove
   1650 
   1651  jsr checkledge ;could you do it if you were 1 space back?
   1652  bne :jumpback ;yes--move back & do it
   1653 
   1654 :jumphi jmp DoJumphigh
   1655 
   1656 *-------------------------------
   1657 * Jump up & back to grab block directly overhead
   1658 
   1659 :jumpback
   1660  jsr getdist ;dist to front of block
   1661  cmp #JumpBackThres
   1662  bcc :jumphi ;too far to fudge
   1663 
   1664  jsr getbehind
   1665  jsr cmpspace ;floor behind you?
   1666  beq DoJumpedge ;no
   1667 
   1668 * "Jump back" to block behind you & then proceed as usual
   1669 
   1670  jsr getdist
   1671  sec
   1672  sbc #14
   1673  jsr addcharx
   1674  sta CharX
   1675 
   1676  jsr rereadblocks
   1677 
   1678  jmp DoJumphang
   1679 
   1680 *-------------------------------
   1681 * Your back is to ledge -- so do a "jumpbackhang"
   1682 
   1683 DoJumpedge
   1684  jsr getabove
   1685 
   1686 * Get all the way back on this block
   1687 
   1688  jsr getdist
   1689  sec
   1690  sbc #10
   1691 
   1692  jsr addcharx
   1693  sta CharX
   1694 
   1695 * now jump
   1696 
   1697  lda #jumpbackhang
   1698  jmp jumpseq
   1699 
   1700 *-------------------------------
   1701 DoJumphang
   1702  jsr getaboveinf
   1703 
   1704 *  Choose the jumphang sequence (Long/Med) that
   1705 *  will bring us closest to edge, then fudge the X-coord
   1706 *  to make it come out exactly
   1707 
   1708  jsr getdist ;get distance to front of block
   1709  sta atemp ;# pixels (0-13) returned in A
   1710 
   1711  cmp #4
   1712  bcc :Med
   1713 
   1714 :Long lda atemp
   1715  sec ;"Long" will add 4 to CharX
   1716  sbc #4
   1717  jsr addcharx
   1718  sta CharX
   1719 
   1720  lda #jumphangLong
   1721  jmp jumpseq
   1722 :Med
   1723  jsr getfwddist
   1724  cmp #4
   1725  bcs :okMed
   1726 
   1727  cpx #1 ;close to wall?
   1728  beq :Long ;yes--step back & do Long
   1729 
   1730 :okMed lda atemp
   1731  jsr addcharx
   1732  sta CharX
   1733 
   1734  lda #jumphangMed
   1735  jmp jumpseq
   1736 
   1737 ]rts rts
   1738 
   1739 *-------------------------------
   1740 *
   1741 *  D o  R u n  J u m p
   1742 *
   1743 *  Calibrate jump so that foot will push off at edge.
   1744 *
   1745 *-------------------------------
   1746 RJChange = 4 ;projected change in CharX
   1747 RJLookahead = 1 ;# blocks you can look ahead
   1748 RJLeadDist = 14 ;required leading distance in pixels
   1749 RJMaxFujBak = 8 ;# pixels we're willing to fudge back
   1750 RJMaxFujFwd = 2 ;and forward
   1751 
   1752 DoRunjump
   1753  lda CharPosn
   1754  cmp #7
   1755  bcc ]rts ;must be in full run
   1756 
   1757 * Count # of blocks to edge
   1758 * (Use actual CharX)
   1759 
   1760  lda #0
   1761  sta bufindex ;block counter
   1762 
   1763  lda #RJChange
   1764  jsr addcharx
   1765  sta ztemp ;projected CharX
   1766 
   1767  jsr getblockxp
   1768  sta blockx
   1769 
   1770 :loop lda blockx
   1771  ldx CharFace
   1772  inx
   1773  clc
   1774  adc plus1,x
   1775  sta blockx
   1776 
   1777  tax
   1778  ldy CharBlockY
   1779  lda CharScrn
   1780  jsr rdblock
   1781 
   1782  cmp #spikes
   1783  beq :done
   1784 
   1785  jsr cmpspace
   1786  beq :done
   1787 
   1788  inc bufindex
   1789 
   1790  lda bufindex
   1791  cmp #RJLookahead+1
   1792  bcc :loop
   1793  bcs :noedge ;no edge in sight--jump anyway
   1794 :done
   1795 
   1796 * Calculate # of pixels to end of floor
   1797 
   1798  lda ztemp
   1799  jsr getdist1 ;# pixels to end of block
   1800 
   1801  ldx bufindex ;# of blocks to end of floor
   1802  clc
   1803  adc Mult7,x
   1804  clc
   1805  adc Mult7,x ;# of pixels to end of floor
   1806 
   1807  sec
   1808  sbc #RJLeadDist
   1809 ;A = difference between actual dist to edge
   1810 ;and distance covered by RunJump
   1811  cmp #-RJMaxFujBak
   1812  bcs :ok ;move back a little & jump
   1813 
   1814  cmp #RJMaxFujFwd
   1815  bcc  :ok ;move fwd a little & jump
   1816 
   1817  cmp #$80
   1818  bcc ]rts ;still too far away--wait till next frame
   1819 
   1820  lda #-3 ;He jumped too late; he'll miss edge
   1821 ;But let's make it look good anyway
   1822 :ok clc
   1823  adc #RJChange
   1824 
   1825  jsr addcharx
   1826  sta CharX
   1827 
   1828 * No edge in sight -- just do any old long jump
   1829 
   1830 :noedge
   1831  jsr ]clr
   1832  sta clrU
   1833 
   1834  lda #runjump
   1835  jmp jumpseq
   1836 
   1837 ]rts rts
   1838 
   1839 *-------------------------------
   1840 *
   1841 *  D o  S t e p  F o r w a r d
   1842 *
   1843 *-------------------------------
   1844 
   1845 DoStepfwd
   1846  lda #1
   1847  sta clrF
   1848  sta clrbtn
   1849 
   1850  jsr getfwddist ;returns A = distance to step (0-13)
   1851 
   1852  cmp #0
   1853  beq :1
   1854 
   1855 :2 sta CharRepeat ;non-0 value
   1856 
   1857  clc
   1858  adc #stepfwd1-1
   1859  jmp jumpseq
   1860 
   1861 :1 cpx #1
   1862  beq :thru ;If barrier, step thru
   1863 
   1864  cmp CharRepeat
   1865  bne :3 ;First time, test w/foot
   1866 
   1867 :thru lda #11
   1868  bne :2 ;Second time, step off edge
   1869 
   1870 :3 sta CharRepeat ;0
   1871 
   1872  lda #testfoot
   1873  jmp jumpseq
   1874 
   1875 *-------------------------------
   1876 *
   1877 *  D o  J u m p  H i g h
   1878 *
   1879 *-------------------------------
   1880 DoJumphigh
   1881  jsr ]clr
   1882  sta clrU
   1883 
   1884  jsr getfwddist
   1885  cmp #4
   1886  bcs :ok
   1887  cpx #1 ;barrier?
   1888  bne :ok ;no
   1889 
   1890  sec
   1891  sbc #3
   1892  jsr addcharx
   1893  sta CharX
   1894 :ok
   1895  lda #jumpupreach
   1896  jsr facedx
   1897  sta ztemp
   1898 
   1899  jsr getbasex ;assume char standing still
   1900  clc
   1901  adc #jumpupangle
   1902  clc
   1903  adc ztemp ;get X-coord at which hand touches ceiling
   1904 
   1905  jsr getblockx
   1906  tax
   1907 
   1908  ldy CharBlockY
   1909  dey
   1910 
   1911  lda CharScrn
   1912  jsr rdblock ;read this block
   1913 
   1914  cmp #block
   1915  beq :jumpup
   1916  jsr cmpspace
   1917  bne :jumpup
   1918 
   1919  lda #highjump
   1920  jmp jumpseq ;no ceiling above
   1921 
   1922 :jumpup lda #jumpup
   1923  jsr jumpseq ;touch ceiling
   1924 ]rts rts ;& don't forget to crop top
   1925 
   1926 *-------------------------------
   1927 *  reread blocks
   1928 *-------------------------------
   1929 REREADBLOCKS
   1930  jsr GetFrameInfo
   1931  jmp GetBaseBlock
   1932 
   1933 *-------------------------------
   1934 *
   1935 *  Is character stepping on a pressure plate?
   1936 *  or on loose floor?
   1937 *
   1938 *-------------------------------
   1939 CHECKPRESS
   1940  lda CharPosn
   1941  cmp #87
   1942  bcc :1
   1943  cmp #100
   1944  bcc :hanging ;87-99: jumphang22-34
   1945  cmp #135
   1946  bcc :1
   1947  cmp #141
   1948  bcc :hanging ;135-140: climb up/down
   1949 :1
   1950  lda CharAction
   1951  cmp #7
   1952  beq :ground ;turning
   1953  cmp #5
   1954  beq :ground ;bumped
   1955  cmp #2
   1956  bcs ]rts
   1957 
   1958 * Action code 7, 0 or 1: on the ground
   1959 
   1960 :ground
   1961  lda CharPosn
   1962  cmp #79 ;jumpup/touch ceiling
   1963  beq :touchceil
   1964 
   1965  lda Fcheck
   1966  and #fcheckmark
   1967  beq ]rts ;foot isn't touching floor
   1968 
   1969 *  Standing on a pressplate?
   1970 
   1971  jsr getunderft
   1972 :checkit
   1973  cmp #upressplate
   1974  beq :PP
   1975  cmp #pressplate
   1976  bne :notPP
   1977 
   1978 :PP lda CharLife
   1979  bmi :push
   1980  jmp jampp ;dead weight
   1981 :push jmp pushpp
   1982 
   1983 :notPP cmp #loose
   1984  bne ]rts
   1985 
   1986  lda #1
   1987  sta alertguard
   1988  jmp breakloose
   1989 
   1990 *  Hanging on a pressplate?
   1991 
   1992 :hanging
   1993  jsr getabove
   1994  jmp :checkit
   1995 ]rts rts
   1996 
   1997 * Jumping up to touch ceiling?
   1998 
   1999 :touchceil
   2000  jsr getabove
   2001 
   2002  cmp #loose
   2003  bne ]rts
   2004 
   2005  jmp breakloose
   2006 
   2007 *-------------------------------
   2008 *
   2009 *  C H E C K   I M P A L E
   2010 *
   2011 *  Impalement by running or jumping onto spikes
   2012 *  (Impalement by landing on spikes is covered by
   2013 *  CHECKFLOOR:falling)
   2014 *
   2015 *-------------------------------
   2016 CHECKIMPALE
   2017  ldx CharBlockX
   2018  ldy CharBlockY
   2019  lda CharScrn
   2020  jsr rdblock
   2021  cmp #spikes
   2022  bne ]rts ;not spikes
   2023 
   2024  ldx CharPosn
   2025 
   2026  cpx #7
   2027  bcc ]rts
   2028 
   2029  cpx #15
   2030  bcs :2
   2031  jmp :running
   2032 
   2033 :2 cpx #43 ;runjump-10
   2034  beq :jumpland
   2035 
   2036  cpx #26 ;standjump-19
   2037  beq :jumpland
   2038 
   2039 ]rts rts
   2040 
   2041 :running
   2042  jsr getspikes
   2043  cmp #2
   2044  bcc ]rts ;must be springing
   2045  bcs :impale
   2046 
   2047 :jumpland
   2048  jsr getspikes ;are spikes lethal?
   2049  beq ]rts ;no
   2050 
   2051 :impale jmp DoImpale
   2052 
   2053 *-------------------------------
   2054 * Impale char on spikes
   2055 *
   2056 * In: rdblock results
   2057 *-------------------------------
   2058 DOIMPALE
   2059  jsr jamspikes
   2060 
   2061  ldx CharBlockY
   2062  inx
   2063  lda FloorY,x
   2064  sta CharY ;align char w/floor
   2065 
   2066  lda tempblockx
   2067  jsr getblockej ;edge of spikes
   2068  clc
   2069  adc #10
   2070  sta CharX
   2071  lda #8
   2072  jsr addcharx
   2073  sta CharX ;center char on spikes
   2074 
   2075  lda #0
   2076  sta CharYVel
   2077 
   2078  lda #Impaled
   2079  jsr addsound
   2080 
   2081  lda #100
   2082  jsr decstr
   2083 
   2084  lda #impale
   2085  jsr jumpseq
   2086  jmp animchar
   2087 
   2088 *-------------------------------
   2089 *
   2090 *  Pick up object
   2091 *  Return 0 if no result
   2092 *
   2093 *-------------------------------
   2094 TryPickup
   2095  jsr getunderft
   2096  cmp #flask
   2097  beq :2
   2098  cmp #sword
   2099  bne :1
   2100 :2 jsr getbehind
   2101  jsr cmpspace
   2102  beq :no
   2103  lda CharX
   2104  lda #-14
   2105  jsr addcharx
   2106  sta CharX ;move char 1 block back
   2107  jsr rereadblocks
   2108 :1 jsr getinfront
   2109  cmp #flask
   2110  beq :pickup
   2111  cmp #sword
   2112  beq :pickup
   2113 :no lda #0
   2114  rts
   2115 
   2116 :pickup jsr PickItUp
   2117  lda #1
   2118  rts
   2119 
   2120 *-------------------------------
   2121 *
   2122 * Pick something up
   2123 *
   2124 * In: rdblock results for object block ("infront")
   2125 *
   2126 *-------------------------------
   2127 PickItUp
   2128  ldx CharPosn
   2129  cpx #109 ;crouch first, then pick up obj
   2130  beq :ok
   2131  jsr getfwddist
   2132  cpx #2
   2133  beq :0 ;right at edge
   2134  jsr addcharx
   2135  sta CharX
   2136 :0 lda CharFace
   2137  bmi :1
   2138  lda #-2
   2139  jsr addcharx
   2140  sta CharX ;put char within reach of obj
   2141 :1 jmp DoCrouch
   2142 
   2143 :ok cmp #sword
   2144  beq :PickupSword
   2145 
   2146  lda (BlueSpec),y
   2147  lsr
   2148  lsr
   2149  lsr
   2150  lsr
   2151  lsr ;potion # (0-7)
   2152  jsr RemoveObj
   2153 
   2154  lda #drinkpotion ;pick up & drink potion
   2155  jmp jumpseq
   2156 
   2157 :PickupSword
   2158  lda #-1 ;sword
   2159  jsr RemoveObj
   2160 
   2161  lda #pickupsword
   2162  jmp jumpseq ;pick up, brandish & sheathe sword
   2163 
   2164 *-------------------------------
   2165  lst
   2166  ds 1
   2167  usr $a9,16,$00,*-org
   2168  lst off