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

GRAFIX525.S (29036B)


      1 * grafix
      2 CopyProtect = 1
      3 EditorDisk = 0
      4 org = $400
      5  tr on
      6  lst off
      7  lstdo off
      8 *-------------------------------
      9 *
     10 *  PRINCE OF PERSIA
     11 *  Copyright 1989 Jordan Mechner
     12 *
     13 *-------------------------------
     14  org org
     15 
     16  jmp GR
     17  jmp DRAWALL
     18  jmp CONTROLLER
     19  jmp dispversion
     20  jmp SAVEBLUE
     21 
     22  jmp RELOADBLUE
     23  jmp MOVEMEM
     24  jmp BUTTONS ;ed
     25  jmp GTONE
     26  jmp SETCENTER
     27 
     28  jmp DIMCHAR
     29  jmp CVTX
     30  jmp ZEROPEEL
     31  jmp ZEROPEELS
     32  jmp PREAD
     33 
     34  jmp ADDPEEL
     35  jmp COPYSCRN
     36  jmp SNGPEEL
     37  jmp RND
     38  jmp CLS
     39 
     40  jmp LAY
     41  jmp FASTLAY
     42  jmp LAYRSAVE
     43  jmp LRCLS
     44  jmp FASTMASK
     45 
     46  jmp FASTBLACK
     47  jmp PEEL
     48  jmp GETWIDTH
     49  jmp COPY2000
     50  jmp COPY2000MA
     51 
     52  jmp SETFASTAUX
     53  jmp SETFASTMAIN
     54  jmp LOADLEVEL
     55  jmp ATTRACTMODE
     56  jmp XMINIT
     57 
     58  jmp XMPLAY
     59  jmp CUTPRINCESS
     60  jmp XTITLE
     61  jmp COPY2000AM
     62  jmp RELOAD
     63 
     64  jmp LOADSTAGE2
     65  jmp RELOAD
     66  jmp GETSELECT
     67  jmp GETDESEL
     68  jmp EDREBOOT ;ed
     69 
     70  jmp GOBUILD ;ed
     71  jmp GOGAME ;ed
     72  jmp WRITEDIR ;ed
     73  jmp READDIR ;ed
     74  jmp SAVELEVEL ;ed
     75 
     76  jmp SAVELEVELG ;ed
     77  jmp ADDBACK
     78  jmp ADDFORE
     79  jmp ADDMID
     80  jmp ADDMIDEZ
     81 
     82  jmp ADDWIPE
     83  jmp ADDMSG
     84  jmp SAVEGAME
     85  jmp LOADGAME
     86  jmp ZEROLSTS
     87 
     88  jmp SCREENDUMP
     89  jmp MINIT
     90  jmp MPLAY
     91  jmp SAVEBINFO
     92  jmp RELOADBINFO
     93 
     94  jmp INVERTY
     95  jmp NORMSPEED
     96  jmp ADDMIDEZO
     97  jmp CALCBLUE
     98  jmp ZERORED
     99 
    100  jmp XPLAYCUT
    101  jmp CHECKIIGS
    102  jmp FASTSPEED
    103  jmp MUSICKEYS
    104  jmp DOSTARTGAME
    105 
    106  jmp EPILOG
    107  jmp LOADALTSET
    108  jmp XMOVEMUSIC
    109  jmp WHOOP
    110 VBLvect jmp VBLANK ;changed by InitVBLANK if IIc
    111 
    112  jmp VBLI ;VBL interrupt
    113 
    114 *-------------------------------
    115  lst
    116  put eq
    117  lst
    118  put gameeq
    119  lst
    120  put soundnames
    121  lst off
    122 *-------------------------------
    123  dum locals
    124 ]temp
    125 ]dest ds 2
    126 ]source ds 2
    127 ]endsourc ds 2
    128 index ds 1
    129 
    130  dend
    131 
    132 *-------------------------------
    133 *  Apple soft switches
    134 
    135 IOUDISoff = $c07f
    136 IOUDISon = $c07e
    137 DHIRESoff = $c05f
    138 DHIRESon = $c05e
    139 HIRESon = $c057
    140 HIRESoff = $c056
    141 PAGE2on = $c055
    142 PAGE2off = $c054
    143 MIXEDon = $c053
    144 MIXEDoff = $c052
    145 TEXTon = $c051
    146 TEXToff = $c050
    147 ALTCHARon = $c00f
    148 ALTCHARoff = $c00e
    149 ADCOLon = $c00d
    150 ADCOLoff = $c00c
    151 ALTZPon = $c009
    152 ALTZPoff = $c008
    153 RAMWRTaux = $c005
    154 RAMWRTmain = $c004
    155 RAMRDaux = $c003
    156 RAMRDmain = $c002
    157 ADSTOREon = $c001
    158 ADSTOREoff = $c000
    159 RWBANK2 = $c083
    160 RWBANK1 = $c08b
    161 USEROM = $c082
    162 
    163 *-------------------------------
    164 *  Key equates
    165 
    166 CTRL = $60
    167 ESC = $9b
    168 DELETE = $7f
    169 SHIFT = $20
    170 
    171 ksound = "s"-CTRL
    172 kmusic = "n"-CTRL
    173 
    174 *-------------------------------
    175 *  Joystick "center" width (increase for bigger center)
    176 
    177 cwidthx = 10 ;15
    178 cwidthy = 15 ;21
    179 
    180 *-------------------------------
    181 *  Addresses of character image tables
    182 *  (Bank: 2 = main, 3 = aux)
    183 
    184 chtabbank db 2,2,2,3,2,3,3
    185 
    186 chtablist db #>chtable1,#>chtable2,#>chtable3,#>chtable4
    187  db #>chtable5,#>chtable6,#>chtable7
    188 
    189 dummy db maxpeel,maxpeel
    190 
    191 *-------------------------------
    192 *
    193 *  A D D B A C K
    194 *
    195 *  Add an image to BACKGROUND image list
    196 *
    197 *  In: XCO, YCO, IMAGE (coded), OPACITY
    198 *
    199 *  IMAGE bit 7 specifies image table (0 = bgtable1,
    200 *  1 = bgtable2); low 6 bits = image # within table
    201 *
    202 *-------------------------------
    203 ADDBACK ldx bgX ;# images already in list
    204  inx
    205  cpx #maxback
    206  bcs :rts ;list full (shouldn't happen)
    207 
    208  lda XCO
    209  sta bgX,x
    210 
    211  lda YCO
    212  cmp #192
    213  bcs :rts
    214  sta bgY,X
    215 
    216  lda IMAGE
    217  sta bgIMG,X
    218 
    219  lda OPACITY
    220  sta bgOP,X
    221 
    222  stx bgX
    223 :rts
    224 ]rts rts
    225 
    226 *-------------------------------
    227 *
    228 *  A D D F O R E
    229 *
    230 *  Add an image to FOREGROUND image list
    231 *
    232 *  In: same as ADDBACK
    233 *
    234 *-------------------------------
    235 ADDFORE ldx fgX
    236  inx
    237  cpx #maxfore
    238  bcs ]rts
    239 
    240  lda XCO
    241  sta fgX,X
    242 
    243  lda YCO
    244  cmp #192
    245  bcs ]rts
    246  sta fgY,X
    247 
    248  lda IMAGE
    249  sta fgIMG,X
    250 
    251  lda OPACITY
    252  sta fgOP,X
    253 
    254  stx fgX
    255 ]rts rts
    256 
    257 *-------------------------------
    258 *
    259 *  A D D M S G
    260 *
    261 *  Add an image to MESSAGE image list (uses bg tables)
    262 *
    263 *  In:  XCO, OFFSET, YCO, IMAGE (coded), OPACITY (bit 6 coded)
    264 *
    265 *-------------------------------
    266 ADDMSG ldx msgX
    267  inx
    268  cpx #maxmsg
    269  bcs ]rts
    270 
    271  lda XCO
    272  sta msgX,X
    273  lda OFFSET
    274  sta msgOFF,X
    275 
    276  lda YCO
    277  sta msgY,X
    278 
    279  lda IMAGE
    280  sta msgIMG,X
    281 
    282  lda OPACITY
    283  sta msgOP,X
    284 
    285  stx msgX
    286 ]rts rts
    287 
    288 *-------------------------------
    289 *
    290 *  A D D  W I P E
    291 *
    292 *  Add image to wipe list
    293 *
    294 *  In: XCO, YCO, height, width; A = color
    295 *
    296 *-------------------------------
    297 ADDWIPE ldx wipeX
    298  inx
    299  cpx #maxwipe
    300  bcs ]rts
    301 
    302  sta wipeCOL,x
    303  lda blackflag ;TEMP
    304  beq :1 ;
    305  lda #$ff ;
    306  sta wipeCOL,x ;
    307 :1
    308  lda XCO
    309  sta wipeX,x
    310  lda YCO
    311  sta wipeY,x
    312 
    313  lda height
    314  sta wipeH,x
    315  lda width
    316  sta wipeW,x
    317 
    318  stx wipeX
    319 ]rts rts
    320 
    321 *-------------------------------
    322 *
    323 *  A D D   M I D
    324 *
    325 *  Add an image to mid table
    326 *
    327 *  In:  XCO, OFFSET, YCO, IMAGE, TABLE, OPACITY
    328 *       FCharFace, FCharCU-CD-CL-CR
    329 *       A = midTYP
    330 *
    331 *  midTYP bit 7: 1 = char tables, 0 = bg tables
    332 *  midTYP bits 0-6:
    333 *    0 = use fastlay (normal for floorpieces)
    334 *    1 = use lay alone
    335 *    2 = use lay with layrsave (normal for characters)
    336 *
    337 *  For char tables: IMAGE = image #, TABLE = table #
    338 *  For bg tables: IMAGE bits 0-6 = image #, bit 7 = table #
    339 *
    340 *-------------------------------
    341 ADDMID ldx midX
    342  inx
    343  cpx #maxmid
    344  bcs ]rts
    345 
    346  sta midTYP,x
    347 
    348  lda XCO
    349  sta midX,x
    350  lda OFFSET
    351  sta midOFF,x
    352 
    353  lda YCO
    354  sta midY,x
    355 
    356  lda IMAGE
    357  sta midIMG,x
    358 
    359  lda TABLE
    360  sta midTAB,x
    361 
    362  lda FCharFace ;- left, + right
    363  eor #$ff ;+ normal, - mirror
    364  and #$80
    365  ora OPACITY
    366  sta midOP,x
    367 
    368  lda FCharCU
    369  sta midCU,x
    370  lda FCharCD
    371  sta midCD,x
    372  lda FCharCL
    373  sta midCL,x
    374  lda FCharCR
    375  sta midCR,x
    376 
    377  stx midX
    378 ]rts rts
    379 
    380 *-------------------------------
    381 *
    382 *  ADDMID "E-Z" version
    383 *
    384 *  No offset, no mirroring, no cropping
    385 *
    386 *  In: XCO, YCO, IMAGE, TABLE, OPACITY
    387 *      A = midTYP
    388 *
    389 *-------------------------------
    390 ADDMIDEZ lda #0
    391  sta OFFSET
    392 ADDMIDEZO
    393  ldx midX
    394  inx
    395  cpx #maxmid
    396  bcs ]rts
    397 
    398  sta midTYP,x
    399 
    400  lda XCO
    401  sta midX,x
    402  lda OFFSET
    403  sta midOFF,x
    404 
    405  lda YCO
    406  sta midY,x
    407 
    408  lda IMAGE
    409  sta midIMG,x
    410 
    411  lda TABLE
    412  sta midTAB,x
    413 
    414  lda OPACITY
    415  sta midOP,x
    416 
    417  lda #0
    418  sta midCU,x
    419  sta midCL,x
    420  lda #40
    421  sta midCR,x
    422  lda #192
    423  sta midCD,x
    424 
    425  stx midX
    426 ]rts rts
    427 
    428 *-------------------------------
    429 *
    430 *  A D D P E E L
    431 *
    432 *  (Call immediately after layrsave)
    433 *  Add newly generated image to peel list
    434 *
    435 *-------------------------------
    436 ADDPEEL lda PEELIMG+1
    437  beq ]rts ;0 is layersave's signal to skip it
    438 
    439  lda PAGE
    440  beq :1
    441 
    442  do CopyProtect
    443  ldx purpleflag ;should be 1!
    444  lda dummy,x
    445 
    446  else
    447  lda #maxpeel
    448  fin
    449 
    450 :1 sta :sm+1 ;self-mod
    451 
    452  tax
    453  lda peelX,x ;# of images in peel list
    454  clc
    455  adc #1
    456  cmp #maxpeel
    457  bcs ]rts
    458  sta peelX,x
    459  clc
    460 :sm adc #0 ;0/maxpeel
    461  tax
    462 
    463  lda PEELXCO
    464  sta peelX,x
    465  lda PEELYCO
    466  sta peelY,x ;x & y coords of saved image
    467 
    468  lda PEELIMG
    469  sta peelIMGL,x
    470  lda PEELIMG+1
    471  sta peelIMGH,x ;2-byte image address (in peel buffer)
    472 
    473 ]rts rts
    474 
    475 *-------------------------------
    476 *
    477 *  D R A W A L L
    478 *
    479 *  Draw everything in image lists
    480 *
    481 *  This is the only routine that calls HIRES routines.
    482 *
    483 *-------------------------------
    484 DRAWALL
    485  jsr DOGEN ;Do general stuff like cls
    486 
    487  lda blackflag ;TEMP
    488  bne :1 ;
    489 
    490  jsr SNGPEEL ;"Peel off" characters
    491 ;(using the peel list we
    492 ;set up 2 frames ago)
    493 
    494 :1 jsr ZEROPEEL ;Zero just-used peel list
    495 
    496  jsr DRAWWIPE ;Draw wipes
    497 
    498  jsr DRAWBACK ;Draw background plane images
    499 
    500  jsr DRAWMID ;Draw middle plane images
    501 ;(& save underlayers to now-clear peel list)
    502 
    503  jsr DRAWFORE ;Draw foreground plane images
    504 
    505  jmp DRAWMSG ;Draw messages
    506 
    507 *-------------------------------
    508 *
    509 *  D O  G E N
    510 *
    511 *  Do general stuff like clear screen
    512 *
    513 *-------------------------------
    514 DOGEN
    515  lda genCLS
    516  beq :1
    517  jsr cls
    518 
    519 * purple copy-protection
    520 
    521 :1 ldx BGset1
    522  cpx #1
    523  bne ]rts
    524  lda #0
    525  sta dummy-1,x
    526 
    527 ]rts rts
    528 
    529 *-------------------------------
    530 *
    531 *  D R A W W I P E
    532 *
    533 *  Draw wipe list (using "fastblack")
    534 *
    535 *-------------------------------
    536 DRAWWIPE
    537  lda wipeX ;# of images in list
    538  beq ]rts ;list is empty
    539 
    540  lda #1 ;start with image #1
    541 :loop pha
    542  tax
    543 
    544  lda wipeH,x
    545  sta IMAGE ;height
    546  lda wipeW,x
    547  sta IMAGE+1 ;width
    548  lda wipeX,X
    549  sta XCO ;x-coord
    550  lda wipeY,X
    551  sta YCO ;y-coord
    552  lda wipeCOL,X
    553  sta OPACITY ;color
    554  jsr fastblack
    555 
    556  pla
    557  clc
    558  adc #1
    559  cmp wipeX
    560  bcc :loop
    561  beq :loop
    562 ]rts rts
    563 
    564 *-------------------------------
    565 *
    566 *  D R A W B A C K
    567 *
    568 *  Draw b.g. list (using fastlay)
    569 *
    570 *-------------------------------
    571 DRAWBACK lda bgX ;# of images in list
    572  beq ]rts
    573 
    574  ldx #1
    575 :loop stx index
    576 
    577  lda bgIMG,x
    578  sta IMAGE ;coded image #
    579  jsr setbgimg ;extract TABLE, BANK, IMAGE
    580 
    581  lda bgX,x
    582  sta XCO
    583  lda bgY,X
    584  sta YCO
    585  lda bgOP,x
    586  sta OPACITY
    587  jsr fastlay
    588 
    589  ldx index
    590  inx
    591  cpx bgX
    592  bcc :loop
    593  beq :loop
    594 ]rts rts
    595 
    596 *-------------------------------
    597 *
    598 *  D R A W F O R E
    599 *
    600 *  Draw foreground list (using fastmask/fastlay)
    601 *
    602 *-------------------------------
    603 DRAWFORE lda fgX
    604  beq ]rts
    605 
    606  ldx #1
    607 :loop stx index
    608 
    609  lda fgIMG,x
    610  sta IMAGE
    611  jsr setbgimg
    612 
    613  lda fgX,x
    614  sta XCO
    615  lda fgY,x
    616  sta YCO
    617 
    618  lda fgOP,x ;opacity
    619  cmp #mask
    620  bne :1
    621  jsr fastmask
    622  jmp :cont
    623 
    624 :1 sta OPACITY ;fastlay for everything else
    625  jsr fastlay
    626 
    627 :cont ldx index
    628  inx
    629  cpx fgX
    630  bcc :loop
    631  beq :loop
    632 ]rts rts
    633 
    634 *-------------------------------
    635 *
    636 *  S N G   P E E L
    637 *
    638 *  Draw peel list (in reverse order) using "peel" (fastlay)
    639 *
    640 *-------------------------------
    641 SNGPEEL
    642  ldx PAGE
    643  beq :1
    644  ldx #maxpeel
    645 :1 stx :sm+1
    646  lda peelX,x ;# of images in list
    647  beq ]rts
    648 
    649 :loop pha
    650  clc
    651 :sm adc #0 ;self-mod: 0 or maxpeel
    652  tax
    653 
    654  lda peelIMGL,x
    655  sta IMAGE
    656  lda peelIMGH,x
    657  sta IMAGE+1
    658  lda peelX,x
    659  sta XCO
    660  lda peelY,x
    661  sta YCO
    662  lda #sta
    663  sta OPACITY
    664  jsr peel
    665 
    666  pla
    667  sec
    668  sbc #1
    669  bne :loop
    670 ]rts rts
    671 
    672 *-------------------------------
    673 *
    674 *  D R A W M I D
    675 *
    676 *  Draw middle list (floorpieces & characters)
    677 *
    678 *-------------------------------
    679 DRAWMID
    680  lda midX ;# of images in list
    681  beq ]rts
    682 
    683  ldx #1
    684 :loop stx index
    685 
    686  lda midIMG,x
    687  sta IMAGE
    688  lda midTAB,x
    689  sta TABLE
    690  lda midX,x
    691  sta XCO
    692  lda midY,x
    693  sta YCO
    694  lda midOP,x
    695  sta OPACITY
    696 
    697  lda midTYP,x ;+ use bg tables
    698  bmi :UseChar ;- use char tables
    699  jsr setbgimg ;protects A,X
    700  jmp :GotTable
    701 
    702 :UseChar jsr setcharimg ;protects A,X
    703 
    704 :GotTable ;A = midTYP,x
    705  and #$7f ;low 7 bits: 0 = fastlay, 1 = lay, 2 = layrsave
    706  beq :fastlay
    707  cmp #1
    708  beq :lay
    709  cmp #2
    710  beq :layrsave
    711 
    712 :Done ldx index
    713  inx
    714  cpx midX
    715  bcc :loop
    716  beq :loop
    717 ]rts rts
    718 
    719 * midTYP values:
    720 *    0 = use fastlay (normal for floorpieces)
    721 *    1 = use lay alone
    722 *    2 = use lay with layrsave (normal for characters)
    723 
    724 :fastlay
    725  jsr fastlay
    726  jmp :Done
    727 
    728 :layrsave
    729  jsr :setaddl ;set additional params for lay
    730 
    731  jsr layrsave ;save underlayer in peel buffer
    732  jsr ADDPEEL ;& add to peel list
    733 
    734  jsr lay ;then lay down image
    735 
    736  jmp :Done
    737 
    738 :lay jsr :setaddl
    739  jsr lay
    740  jmp :Done
    741 
    742 :setaddl lda midOFF,x
    743  sta OFFSET
    744  lda midCL,x
    745  sta LEFTCUT
    746  lda midCR,x
    747  sta RIGHTCUT
    748  lda midCU,x
    749  sta TOPCUT
    750  lda midCD,x
    751  sta BOTCUT
    752  rts
    753 
    754 *-------------------------------
    755 *
    756 *  D R A W M S G
    757 *
    758 *  Draw message list (using bg tables & lay)
    759 *
    760 *  OPACITY bit 6: 1 = layrsave, 0 = no layrsave
    761 *
    762 *-------------------------------
    763 DRAWMSG
    764  lda msgX
    765  beq ]rts
    766 
    767  ldx #1
    768 :loop stx index
    769 
    770  lda msgIMG,x
    771  sta IMAGE
    772  jsr setbgimg
    773 
    774  lda msgX,x
    775  sta XCO
    776  lda msgOFF,x
    777  sta OFFSET
    778  lda msgY,x
    779  sta YCO
    780 
    781  lda #0
    782  sta LEFTCUT
    783  sta TOPCUT
    784  lda #40
    785  sta RIGHTCUT
    786  lda #192
    787  sta BOTCUT
    788 
    789  lda msgOP,x
    790  sta OPACITY
    791  and #%01000000
    792  beq :1
    793  lda OPACITY
    794  and #%10111111 ;bit 6 set: use layrsave
    795  sta OPACITY
    796 
    797  jsr layrsave
    798  jsr ADDPEEL
    799 
    800 :1 jsr lay
    801 
    802  ldx index
    803  inx
    804  cpx msgX
    805  bcc :loop
    806  beq :loop
    807 ]rts rts
    808 
    809 *-------------------------------
    810 *
    811 *  S E T   B  G   I M A G E
    812 *
    813 *  In: IMAGE = coded image #
    814 *  Out: BANK, TABLE, IMAGE set for hires call
    815 *
    816 *  Protect A,X
    817 *
    818 *-------------------------------
    819 setbgimg
    820  tay
    821 
    822  lda #3 ;auxmem
    823  sta BANK
    824 
    825  lda #0
    826  sta TABLE
    827 
    828  lda IMAGE ;Bit 7: 0 = bgtable1, 1 = bgtable2
    829  bpl :bg1
    830 
    831  and #$7f
    832  sta IMAGE
    833 
    834  lda #>bgtable2
    835  bne :ok
    836 
    837 :bg1 lda #>bgtable1
    838 :ok sta TABLE+1
    839 
    840  tya
    841  rts
    842 
    843 *-------------------------------
    844 *
    845 *  S E T   C H A R   I M A G E
    846 *
    847 *  In: TABLE = chtable # (0-7)
    848 *  Out: BANK, TABLE set for hires call
    849 *
    850 *  Protect A,X
    851 *
    852 *-------------------------------
    853 setcharimg
    854  pha
    855 
    856  ldy TABLE
    857  lda chtabbank,y
    858  sta BANK
    859 
    860  lda #0
    861  sta TABLE
    862  lda chtablist,y
    863  sta TABLE+1
    864 
    865  pla
    866  rts
    867 
    868 *-------------------------------
    869 *
    870 *  D I M C H A R
    871 *
    872 *  Get dimensions of character
    873 *  (Misc. routine for use by CTRL)
    874 *
    875 *  In: A = image #, X = table #
    876 *  Out: A = width, X = height
    877 *
    878 *-------------------------------
    879 DIMCHAR
    880  sta IMAGE
    881  stx TABLE
    882  jsr setcharimg
    883  jmp getwidth
    884 
    885 *-------------------------------
    886 *
    887 *  C V T X
    888 *
    889 *  Convert X-coord to byte & offset
    890 *  Works for both single & double hires
    891 *
    892 *  In: XCO/OFFSET = X-coord (2 bytes)
    893 *  Out: XCO/OFFSET = byte/offset
    894 *
    895 *  Hires scrn: X-coord range 0-279, byte range 0-39
    896 *  Dbl hires scrn: X-coord range 0-559, byte range 0-79
    897 *
    898 *  Trashes Y-register
    899 *
    900 *  Returns accurate results for all input (-32767 to 32767)
    901 *  but wildly offscreen values will slow it down
    902 *
    903 *-------------------------------
    904 ]XL = XCO
    905 ]XH = OFFSET
    906 
    907 range = 36*7 ;largest multiple of 7 under 256
    908 
    909 CVTX
    910  lda #0
    911  sta ]temp
    912 
    913  lda ]XH
    914  bmi :negative ;X < 0
    915  beq :ok ;0 <= X <= 255
    916 
    917 :loop lda ]temp
    918  clc
    919  adc #36
    920  sta ]temp
    921 
    922  lda ]XL
    923  sec
    924  sbc #range
    925  sta ]XL
    926 
    927  lda ]XH
    928  sbc #0
    929  sta ]XH
    930 
    931  bne :loop
    932 
    933 :ok ldy ]XL
    934  lda ByteTable,y
    935  clc
    936  adc ]temp
    937  sta XCO
    938 
    939  lda OffsetTable,y
    940  sta OFFSET
    941  rts
    942 
    943 :negative
    944  lda ]temp
    945  sec
    946  sbc #36
    947  sta ]temp
    948 
    949  lda ]XL
    950  clc
    951  adc #range
    952  sta ]XL
    953 
    954  lda ]XH
    955  adc #0
    956  sta ]XH
    957  bne :negative
    958  beq :ok
    959 ]rts rts
    960 
    961 *-------------------------------
    962 *
    963 *  Z E R O L I S T S
    964 *
    965 *  Zero image lists (except peel lists)
    966 *
    967 *-------------------------------
    968 ZEROLSTS lda #0
    969  sta genCLS
    970  sta wipeX
    971  sta bgX
    972  sta midX
    973  sta objX
    974  sta fgX
    975  sta msgX
    976  rts
    977 
    978 *-------------------------------
    979 *
    980 *  Zero both peel lists
    981 *
    982 *-------------------------------
    983 ZEROPEELS
    984  lda #0
    985  sta peelX
    986  sta peelX+maxpeel
    987 ]rts rts
    988 
    989 *-------------------------------
    990 *
    991 *  Z E R O P E E L
    992 *
    993 *  Zero peel list & buffer for whichever page we're on
    994 *
    995 *  (Point PEELBUF to beginning of appropriate peel buffer
    996 *  & set #-of-images byte to zero)
    997 *
    998 *-------------------------------
    999 ZEROPEEL
   1000  lda #0
   1001  ldx PAGE
   1002  beq :page1
   1003 :page2 sta peelX+maxpeel
   1004  lda #peelbuf2
   1005  sta PEELBUF
   1006  lda #>peelbuf2
   1007  sta PEELBUF+1
   1008  rts
   1009 
   1010 :page1 sta peelX
   1011  lda #peelbuf1
   1012  sta PEELBUF
   1013  lda #>peelbuf1
   1014  sta PEELBUF+1
   1015  rts
   1016 
   1017 *-------------------------------
   1018 *
   1019 *  Joystick/keyboard routines
   1020 *
   1021 *-------------------------------
   1022 *
   1023 *  Get input from selected/deselected device
   1024 *
   1025 *  In: kbdX, kbdY, joyX, joyY, BTN0, BTN1, ManCtrl
   1026 *
   1027 *  Out: JSTKX, JSTKY, btn
   1028 *
   1029 *-------------------------------
   1030 GETSELECT
   1031  lda joyon ;joystick selected?
   1032  bne getjoy ;yes--use jstk
   1033  beq getkbd ;no--use kbd
   1034 
   1035 GETDESEL
   1036  lda joyon
   1037  bne getkbd
   1038  beq getjoy
   1039 
   1040 getjoy lda joyX
   1041  sta JSTKX
   1042  lda joyY
   1043  sta JSTKY
   1044 
   1045  lda BTN1
   1046  ldx ManCtrl ;When manual ctrl is on, btn 0 belongs
   1047  bmi :1 ;to kbd and btn 1 to jstk.  With manual ctrl
   1048  ora BTN0 ;off, btns can be used interchangeably.
   1049 :1 sta btn
   1050  rts
   1051 
   1052 getkbd lda kbdX
   1053  sta JSTKX
   1054  lda kbdY
   1055  sta JSTKY
   1056 
   1057  lda BTN0
   1058  ldx ManCtrl
   1059  bmi :1
   1060  ora BTN1
   1061 :1 sta btn
   1062 ]rts rts
   1063 
   1064 *-------------------------------
   1065 *
   1066 *  Read controller (jstk & buttons)
   1067 *
   1068 *  Out: joyX-Y, BTN0-1
   1069 *
   1070 *-------------------------------
   1071 CONTROLLER
   1072  jsr JREAD ;read jstk
   1073 
   1074  jmp BREAD ;& btns
   1075 
   1076 *-------------------------------
   1077 *
   1078 *  Read joystick
   1079 *
   1080 *  Out: joyX-Y
   1081 *
   1082 *  joyX: -1 = left, 0 = center, +1 = right
   1083 *  joyY: -1 = up, 0 = center, +1 = down
   1084 *
   1085 *-------------------------------
   1086 JREAD
   1087  lda joyon
   1088  beq ]rts
   1089  jsr PREAD ;read game pots
   1090 
   1091  ldx #0
   1092  jsr cvtpdl
   1093  inx
   1094  jsr cvtpdl
   1095 
   1096 * Reverse joyY?
   1097 
   1098  lda jvert
   1099  beq :1
   1100 
   1101  lda #0
   1102  sec
   1103  sbc joyY
   1104  sta joyY
   1105 
   1106 * Reverse joyX?
   1107 
   1108 :1 lda jhoriz
   1109  beq ]rts
   1110 
   1111  lda #0
   1112  sec
   1113  sbc joyX
   1114  sta joyX
   1115 ]rts rts
   1116 
   1117 *-------------------------------
   1118 *
   1119 *  Read buttons
   1120 *
   1121 *  Out: BTN0-1
   1122 *
   1123 *-------------------------------
   1124 BREAD
   1125  lda jbtns
   1126  bne :1 ;buttons switched
   1127 
   1128  lda $c061
   1129  ldx $c062
   1130 :2 sta BTN0
   1131  stx BTN1
   1132  rts
   1133 
   1134 :1 ldx $c062
   1135  lda $c061
   1136  jmp :2
   1137 
   1138 *-------------------------------
   1139 *
   1140 *  (Temp routine--for builder only)
   1141 *
   1142 *-------------------------------
   1143 BUTTONS
   1144  do EditorDisk
   1145  ldx BTN0 ;"raw"
   1146  lda #0
   1147  sta BUTT0
   1148  lda b0down ;last button value
   1149  stx b0down
   1150  and #$80
   1151  bne :rdbtn1
   1152  stx BUTT0
   1153 
   1154 :rdbtn1 ldx BTN1
   1155  lda #0
   1156  sta BUTT1
   1157  lda b1down
   1158  stx b1down
   1159  and #$80
   1160  bne :rdjup
   1161  stx BUTT1
   1162 
   1163 :rdjup lda joyY
   1164  bmi ]rts
   1165  lda #0
   1166  sta JSTKUP ;jstk is not up--clear JSTKUP
   1167  fin
   1168 
   1169 ]rts rts
   1170 
   1171 *-------------------------------
   1172 *
   1173 *  Convert raw counter value (approx. 0-70) to -1/0/1
   1174 *
   1175 *  In: X = paddle # (0 = horiz, 1 = vert)
   1176 *
   1177 *-------------------------------
   1178 cvtpdl
   1179  lda joyX,x
   1180  cmp jthres1x,x
   1181  bcs :1
   1182  lda #-1
   1183  bne :3
   1184 :1 cmp jthres2x,x
   1185  bcs :2
   1186  lda #0
   1187  beq :3
   1188 :2 lda #1
   1189 :3 sta joyX,x
   1190 ]rts rts
   1191 
   1192 *-------------------------------
   1193 *
   1194 *  Read game pots
   1195 *
   1196 *  Out: Raw counter values (approx. 0-70) in joyX-Y
   1197 *
   1198 *-------------------------------
   1199 PREAD
   1200  lda #0
   1201  sta joyX
   1202  sta joyY
   1203 
   1204  lda $c070 ;Reset timers
   1205 
   1206 :loop ldx #1
   1207 :1 lda $c064,x ;Check timer input
   1208  bpl :beat
   1209  inc joyX,x ;Still high; increment counter
   1210 :nextpdl dex
   1211  bpl :1
   1212 
   1213  lda $C064
   1214  ora $C065
   1215  bpl ]rts ;Both inputs low: we're done
   1216 
   1217  lda joyX
   1218  ora joyY
   1219  bpl :loop ;Do it again
   1220 ]rts rts
   1221 
   1222 :beat nop
   1223  bpl :nextpdl ;Kill time
   1224 
   1225 *-------------------------------
   1226 *
   1227 *  Select jstk & define current joystick posn as center
   1228 *
   1229 *  Out: jthres1-2x, jthres1-2y
   1230 *
   1231 *-------------------------------
   1232 SETCENTER
   1233  lda #$ff
   1234  sta joyon ;Joystick on
   1235 
   1236  lda #0
   1237  sta jvert
   1238  sta jhoriz
   1239  sta jbtns ;set normal params
   1240 
   1241  jsr PREAD ;get raw jstk values
   1242 
   1243  lda joyX
   1244  ora joyY
   1245  bmi :nojoy ;No joystick connected
   1246 
   1247  lda joyX
   1248  sec
   1249  sbc #cwidthx
   1250  sta jthres1x
   1251  lda joyX
   1252  clc
   1253  adc #cwidthx
   1254  sta jthres2x
   1255 
   1256  lda joyY
   1257  sec
   1258  sbc #cwidthy
   1259  sta jthres1y
   1260  lda joyY
   1261  clc
   1262  adc #cwidthy
   1263  sta jthres2y
   1264  rts
   1265 
   1266 :nojoy lda #0
   1267  sta joyon
   1268 ]rts rts
   1269 
   1270 *-------------------------------
   1271 *
   1272 *  Move a block of memory
   1273 *
   1274 *  In: A < X.Y
   1275 *
   1276 *  20 < 40.60 means 2000 < 4000.5fffm
   1277 *  WARNING: If x >= y, routine will wipe out 64k
   1278 *
   1279 *-------------------------------
   1280 MOVEMEM sta ]dest+1
   1281  stx ]source+1
   1282  sty ]endsourc+1
   1283 
   1284  ldy #0
   1285  sty ]dest
   1286  sty ]source
   1287  sty ]endsourc
   1288 
   1289 :loop lda (]source),y
   1290  sta (]dest),y
   1291  iny
   1292  bne :loop
   1293 
   1294  inc ]source+1
   1295  inc ]dest+1
   1296  lda ]source+1
   1297  cmp ]endsourc+1
   1298  bne :loop
   1299  rts
   1300 
   1301 *-------------------------------
   1302 *
   1303 *  G  T  O  N  E
   1304 *
   1305 *  Call this routine to confirm special-key presses
   1306 *  & any other time we want to bypass normal sound interface
   1307 *
   1308 *-------------------------------
   1309 SK1Pitch = 15
   1310 SK1Dur = 50
   1311 
   1312 GTONE ldy #SK1Pitch
   1313  ldx #>SK1Pitch
   1314  lda #SK1Dur
   1315  jmp tone
   1316 
   1317 *-------------------------------
   1318 *
   1319 *  Whoop speaker (like RW18)
   1320 *
   1321 *-------------------------------
   1322 WHOOP
   1323  ldy #0
   1324 :1 tya
   1325  bit $c030
   1326 :2 sec
   1327  sbc #1
   1328  bne :2
   1329  dey
   1330  bne :1
   1331 ]rts rts
   1332 
   1333 *-------------------------------
   1334 *
   1335 *  Produce tone
   1336 *
   1337 *  In: y-x = pitch lo-hi
   1338 *      a = duration
   1339 *
   1340 *-------------------------------
   1341 tone
   1342  sty :pitch
   1343  stx :pitch+1
   1344 :outloop bit $c030
   1345  ldx #0
   1346 :midloop ldy #0
   1347 :inloop iny
   1348  cpy :pitch
   1349  bcc :inloop
   1350  inx
   1351  cpx :pitch+1
   1352  bcc :midloop
   1353  sec
   1354  sbc #1
   1355  bne :outloop
   1356  rts
   1357 
   1358 :pitch ds 2
   1359 
   1360 *-------------------------------
   1361 *
   1362 * Copy one hires page to the other
   1363 *
   1364 * In: PAGE = dest scrn (00/20)
   1365 *
   1366 *-------------------------------
   1367 COPYSCRN
   1368  lda PAGE
   1369  clc
   1370  adc #$20
   1371  sta IMAGE+1 ;dest addr
   1372  eor #$60
   1373  sta IMAGE ;org addr
   1374 
   1375  jmp copy2000
   1376 
   1377 *-------------------------------
   1378 *
   1379 *  Generate random number
   1380 *
   1381 *  RNDseed := (5 * RNDseed + 23) mod 256
   1382 *
   1383 *-------------------------------
   1384 RND
   1385  lda RNDseed
   1386  asl
   1387  asl
   1388  clc
   1389  adc RNDseed
   1390  clc
   1391  adc #23
   1392  sta RNDseed
   1393 ]rts rts
   1394 
   1395 *-------------------------------
   1396 *
   1397 *  Calls to hires & master routines
   1398 *
   1399 *  Hires & master routines are in main lc & use main zp;
   1400 *  rest of code uses aux lc, zp.
   1401 *
   1402 *-------------------------------
   1403 *
   1404 *  Master
   1405 *
   1406 *-------------------------------
   1407 LOADLEVEL sta ALTZPoff ;main l.c.
   1408  jsr _loadlevel
   1409  sta ALTZPon ;aux l.c.
   1410  rts
   1411 
   1412 ATTRACTMODE sta ALTZPoff
   1413  jsr _attractmode
   1414  sta ALTZPon
   1415  rts
   1416 
   1417 CUTPRINCESS sta ALTZPoff
   1418  jsr _cutprincess
   1419  sta ALTZPon
   1420  rts
   1421 
   1422 RELOAD sta ALTZPoff
   1423  jsr _reload
   1424  sta ALTZPon
   1425  rts
   1426 
   1427 LOADSTAGE2 sta ALTZPoff
   1428  jsr _loadstage2
   1429  sta ALTZPon
   1430  rts
   1431 
   1432 SAVEGAME sta ALTZPoff
   1433  jsr _savegame
   1434  sta ALTZPon
   1435  rts
   1436 
   1437 LOADGAME sta ALTZPoff
   1438  jsr _loadgame
   1439  sta ALTZPon
   1440  rts
   1441 
   1442 DOSTARTGAME sta ALTZPoff
   1443  jmp _dostartgame
   1444 
   1445 EPILOG sta ALTZPoff
   1446  jmp _epilog
   1447 
   1448 LOADALTSET sta ALTZPoff
   1449  jsr _loadaltset
   1450  sta ALTZPon
   1451  rts
   1452 
   1453 SCREENDUMP sta ALTZPoff
   1454  jsr _screendump
   1455  sta ALTZPon
   1456  rts
   1457 
   1458 *-------------------------------
   1459 *
   1460 * Edmaster (editor disk only)
   1461 *
   1462 *-------------------------------
   1463  do EditorDisk
   1464 
   1465 SAVELEVEL sta ALTZPoff
   1466  jsr _savelevel
   1467  sta ALTZPon
   1468  rts
   1469 
   1470 SAVELEVELG sta ALTZPoff
   1471  jsr _savelevelg
   1472  sta ALTZPon
   1473  rts
   1474 
   1475 READDIR sta ALTZPoff
   1476  jsr _readdir
   1477  sta ALTZPon
   1478  rts
   1479 
   1480 WRITEDIR sta ALTZPoff
   1481  jsr _writedir
   1482  sta ALTZPon
   1483  rts
   1484 
   1485 GOBUILD sta ALTZPoff
   1486  jsr _gobuild
   1487  sta ALTZPon
   1488  rts
   1489 
   1490 GOGAME sta ALTZPoff
   1491  jsr _gogame
   1492  sta ALTZPon
   1493  rts
   1494 
   1495 EDREBOOT sta ALTZPoff
   1496  jsr _edreboot
   1497  sta ALTZPon
   1498  rts
   1499 
   1500  else
   1501 SAVELEVEL
   1502 SAVELEVELG
   1503 READDIR
   1504 WRITEDIR
   1505 GOBUILD
   1506 GOGAME
   1507 EDREBOOT rts
   1508  fin
   1509 
   1510 *-------------------------------
   1511 *
   1512 *  Hires
   1513 *
   1514 *-------------------------------
   1515 CLS jsr prehr
   1516  sta ALTZPoff
   1517  jsr _cls
   1518  sta ALTZPon
   1519  rts
   1520 
   1521 LAY jsr prehr
   1522  sta ALTZPoff
   1523  jsr _lay
   1524  sta ALTZPon
   1525  rts
   1526 
   1527 FASTLAY jsr prehr
   1528  sta ALTZPoff
   1529  jsr _fastlay
   1530  sta ALTZPon
   1531  rts
   1532 
   1533 LAYRSAVE jsr prehr
   1534  sta ALTZPoff
   1535  jsr _layrsave
   1536  sta ALTZPon
   1537  jmp posthr
   1538 
   1539 LRCLS sta scrncolor ;In: A = screen color
   1540  sta ALTZPoff
   1541  jsr _lrcls
   1542  sta ALTZPon
   1543  rts
   1544 
   1545 FASTMASK jsr prehr
   1546  sta ALTZPoff
   1547  jsr _fastmask
   1548  sta ALTZPon
   1549  rts
   1550 
   1551 FASTBLACK jsr prehr
   1552  sta ALTZPoff
   1553  jsr _fastblack
   1554  sta ALTZPon
   1555  rts
   1556 
   1557 PEEL jsr prehr
   1558  sta ALTZPoff
   1559  jsr _peel
   1560  sta ALTZPon
   1561  rts
   1562 
   1563 GETWIDTH jsr prehr
   1564  sta ALTZPoff
   1565  jsr _getwidth
   1566  sta ALTZPon
   1567  rts
   1568 
   1569 COPY2000 jsr prehr
   1570  sta ALTZPoff
   1571  jsr _copy2000
   1572  sta ALTZPon
   1573  rts
   1574 
   1575 COPY2000AM jsr prehr
   1576  sta ALTZPoff
   1577  jsr _copy2000am
   1578  sta ALTZPon
   1579  rts
   1580 
   1581 COPY2000MA jsr prehr
   1582  sta ALTZPoff
   1583  jsr _copy2000ma
   1584  sta ALTZPon
   1585  rts
   1586 
   1587 SETFASTAUX
   1588  sta ALTZPoff
   1589  jsr _setfastaux
   1590  sta ALTZPon
   1591  rts
   1592 
   1593 SETFASTMAIN
   1594  sta ALTZPoff
   1595  jsr _setfastmain
   1596  sta ALTZPon
   1597  rts
   1598 
   1599 INVERTY
   1600  sta ALTZPoff
   1601  jsr _inverty
   1602  sta ALTZPon
   1603  rts
   1604 
   1605 *-------------------------------
   1606 *
   1607 *  Call sound routines (in aux l.c. bank 1)
   1608 *  Exit with bank 2 switched in
   1609 *
   1610 *-------------------------------
   1611 ]bank1in bit RWBANK1
   1612  bit RWBANK1
   1613  rts
   1614 
   1615 MINIT jsr ]bank1in
   1616  jsr CALLMINIT
   1617 ]bank2in bit RWBANK2
   1618  bit RWBANK2
   1619  rts
   1620 
   1621 MPLAY jsr ]bank1in
   1622  jsr CALLMPLAY
   1623  jmp ]bank2in
   1624 
   1625 *-------------------------------
   1626 *
   1627 *  Call aux l.c. routines from MASTER (main l.c.)
   1628 *
   1629 *-------------------------------
   1630 XMINIT sta ALTZPon
   1631  jsr MINIT
   1632  sta ALTZPoff
   1633  rts
   1634 
   1635 XMPLAY sta ALTZPon
   1636  jsr MPLAY
   1637  sta ALTZPoff
   1638  rts
   1639 
   1640 XTITLE sta ALTZPon
   1641  jsr titlescreen
   1642  sta ALTZPoff
   1643  rts
   1644 
   1645 XPLAYCUT sta ALTZPon
   1646  jsr playcut ;in subs
   1647  sta ALTZPoff
   1648  rts
   1649 
   1650 XMOVEMUSIC sta ALTZPon
   1651  jsr movemusic ;in misc
   1652  sta ALTZPoff
   1653  rts
   1654 
   1655 *-------------------------------
   1656 *
   1657 * Copy hires params from aux to main z.p.
   1658 *
   1659 * (Enter & exit w/ ALTZP on)
   1660 *
   1661 *-------------------------------
   1662 prehr
   1663  ldx #$17
   1664 :loop sta ALTZPon ;aux zp
   1665  lda $00,x
   1666  sta ALTZPoff ;main zp
   1667  sta $00,x
   1668  dex
   1669  bpl :loop
   1670  sta ALTZPon
   1671  rts
   1672 
   1673 *-------------------------------
   1674 *
   1675 * Copy hires params from main to aux z.p.
   1676 *
   1677 * (Enter & exit w/ ALTZP on)
   1678 *
   1679 *-------------------------------
   1680 posthr
   1681  ldx #$17
   1682 :loop sta ALTZPoff
   1683  lda $00,x
   1684  sta ALTZPon
   1685  sta $00,x
   1686  dex
   1687  bpl :loop
   1688 ]rts rts
   1689 
   1690 *-------------------------------
   1691 *
   1692 *  Save master copy of blueprint in l.c. bank 1
   1693 *
   1694 *-------------------------------
   1695 SAVEBLUE
   1696  jsr ]bank1in
   1697  lda #>$d700
   1698  ldx #>$b700
   1699  ldy #>$b700+$900
   1700  jsr movemem
   1701  jmp ]bank2in
   1702 
   1703 SAVEBINFO
   1704  jsr ]bank1in
   1705  lda #>$d000
   1706  ldx #>$a600
   1707  ldy #>$a600+$600
   1708  jsr movemem
   1709  jmp ]bank2in
   1710 
   1711 *-------------------------------
   1712 *
   1713 * Reload master copy of blueprint from l.c. bank 1
   1714 *
   1715 *-------------------------------
   1716 RELOADBLUE
   1717  jsr ]bank1in
   1718  lda #>$b700
   1719  ldx #>$d700
   1720  ldy #>$d700+$900
   1721  jsr movemem
   1722  jmp ]bank2in
   1723 
   1724 RELOADBINFO
   1725  jsr ]bank1in
   1726  lda #>$a600
   1727  ldx #>$d000
   1728  ldy #>$d000+$600
   1729  jsr movemem
   1730  jmp ]bank2in
   1731 
   1732 *-------------------------------
   1733 *
   1734 *  Display lo-res page 1
   1735 *
   1736 *-------------------------------
   1737 GR jmp gtone ;temp!
   1738 
   1739 *-------------------------------
   1740 * The following routines properly belong to FRAMEADV
   1741 * but have been moved here for lack of space
   1742 *-------------------------------
   1743 *
   1744 *  C A L C   B L U E
   1745 *
   1746 *  Given:  screen #, 1-24 (in acc)
   1747 *  Return: start of BLUETYPE table (in BlueType)
   1748 *          start of BLUESPEC table (in BlueSpec)
   1749 *
   1750 *  If A = 0...
   1751 *    In game: returns garbage
   1752 *    In builder: returns menu data
   1753 *
   1754 *-------------------------------
   1755 CALCBLUE
   1756  cmp #0
   1757  beq calcmenu
   1758 
   1759  sec
   1760  sbc #1 ;reduce to 0-23
   1761  asl
   1762  tax ;x2
   1763 
   1764  lda Mult30,x
   1765  clc
   1766  adc #blueprnt
   1767  sta BlueType
   1768 
   1769  lda Mult30+1,x
   1770  adc #>blueprnt
   1771  sta BlueType+1
   1772 
   1773  lda BlueType
   1774  clc
   1775  adc #24*30
   1776  sta BlueSpec
   1777 
   1778  lda BlueType+1
   1779  adc #>24*30
   1780  sta BlueSpec+1
   1781 
   1782 ]rts rts
   1783 
   1784 calcmenu
   1785  lda #menutype
   1786  sta BlueType
   1787  lda #>menutype
   1788  sta BlueType+1
   1789 
   1790  lda #menuspec
   1791  sta BlueSpec
   1792  lda #>menuspec
   1793  sta BlueSpec+1
   1794  rts
   1795 
   1796 *-------------------------------
   1797 *
   1798 *  Z E R O   R E D
   1799 *
   1800 *  zero redraw buffers
   1801 *
   1802 *-------------------------------
   1803 ZERORED
   1804  lda #0
   1805  ldy #29
   1806 :loop sta redbuf,y
   1807  sta fredbuf,y
   1808  sta floorbuf,y
   1809  sta halfbuf,y
   1810  sta wipebuf,y
   1811  sta movebuf,y
   1812  sta objbuf,y
   1813  dey
   1814  bpl :loop
   1815 
   1816  ldy #9
   1817 :loop2 sta topbuf,y
   1818  dey
   1819  bpl :loop2
   1820 
   1821  rts
   1822 
   1823 *-------------------------------
   1824 *
   1825 *  Routines to interface with MSYS (Music System II)
   1826 *
   1827 *-------------------------------
   1828 *
   1829 * Switch zero page
   1830 *
   1831 *-------------------------------
   1832 switchzp
   1833  ldx #31
   1834 :loop ldy savezp,x
   1835  lda $00,x
   1836  sta savezp,x
   1837  tya
   1838  sta $00,x
   1839  dex
   1840  bpl :loop
   1841  rts
   1842 
   1843 *-------------------------------
   1844 *
   1845 *  Call MINIT
   1846 *
   1847 *  In: A = song #
   1848 *
   1849 *-------------------------------
   1850 CALLMINIT
   1851  pha
   1852  jsr switchzp
   1853  pla
   1854  jsr _minit
   1855  jmp switchzp
   1856 
   1857 *-------------------------------
   1858 *
   1859 *  Call MPLAY
   1860 *
   1861 *  Out: A = song #
   1862 *  (Most songs set song # = 0 when finished)
   1863 *
   1864 *-------------------------------
   1865 CALLMPLAY
   1866  lda soundon
   1867  and musicon
   1868  beq :silent
   1869 
   1870  jsr switchzp
   1871  jsr _mplay ;returns INDEX
   1872  pha
   1873  jsr switchzp
   1874  pla
   1875  rts
   1876 
   1877 :silent lda #0
   1878 ]rts rts
   1879 
   1880 *-------------------------------
   1881 *
   1882 *  M U S I C   K E Y S
   1883 *
   1884 *  Call while music is playing
   1885 *
   1886 *  Esc to pause, Ctrl-S to turn sound off
   1887 *  Return A = ASCII value (FF for button)
   1888 *  Clear hibit if it's a key we've handled
   1889 *
   1890 *-------------------------------
   1891 MUSICKEYS
   1892  lda $c000
   1893  sta keypress
   1894  bpl :nokey
   1895  sta $c010
   1896 
   1897  cmp #ESC
   1898  bne :cont
   1899 :froze lda $c000
   1900  sta keypress
   1901  bpl :froze
   1902  sta $c010
   1903  cmp #ESC
   1904  bne :cont
   1905  and #$7f
   1906  rts
   1907 
   1908 :cont cmp #ksound
   1909  bne :3
   1910  lda soundon
   1911  eor #1
   1912  sta soundon
   1913 :21 beq :2
   1914  jsr gtone
   1915 :2 lda #0
   1916  rts
   1917 
   1918 :3 cmp #kmusic
   1919  bne :1
   1920  lda musicon
   1921  eor #1
   1922  sta musicon
   1923  jmp :21
   1924 
   1925 :nobtn lda keypress
   1926  rts
   1927 :1
   1928 :nokey lda $c061
   1929  ora $c062
   1930  bpl :nobtn
   1931  lda #$ff
   1932 ]rts rts
   1933 
   1934 *===============================
   1935 vblflag ds 1
   1936 *-------------------------------
   1937 *
   1938 * Wait for vertical blank (IIe/IIGS)
   1939 *
   1940 *-------------------------------
   1941 VBLANK
   1942 :loop1 lda $c019
   1943  bpl :loop1
   1944 :loop lda $c019
   1945  bmi :loop ;wait for beginning of VBL interval
   1946 ]rts rts
   1947 
   1948 *-------------------------------
   1949 *
   1950 * Wait for vertical blank (IIc)
   1951 *
   1952 *-------------------------------
   1953 VBLANKIIc
   1954  cli ;enable interrupts
   1955 
   1956 :loop1 bit vblflag
   1957  bpl :loop1 ;wait for vblflag = 1
   1958  lsr vblflag ;...& set vblflag = 0
   1959 
   1960 :loop2 bit vblflag
   1961  bpl :loop2
   1962  lsr vblflag
   1963 
   1964  sei
   1965  rts
   1966 
   1967 * Interrupt jumps to ($FFFE) which points back to VBLI
   1968 
   1969 VBLI
   1970  bit $c019
   1971  sta $c079 ;enable IOU access
   1972  sta $c05b ;enable VBL int
   1973  sta $c078 ;disable IOU access
   1974  sec
   1975  ror vblflag ;set hibit
   1976 :notvbl rti
   1977 
   1978 *-------------------------------
   1979 *
   1980 * Initialize VBLANK vector with correct routine
   1981 * depending on whether or not machine is IIc
   1982 *
   1983 *-------------------------------
   1984 InitVBLANK
   1985  lda $FBC0
   1986  bne ]rts ;not a IIc--use VBLANK
   1987 
   1988  sta RAMWRTaux
   1989 
   1990  lda #VBLANKIIc
   1991  sta VBLvect+1
   1992  lda #>VBLANKIIc
   1993  sta VBLvect+2
   1994 
   1995  sei ;disable interrupts
   1996  sta $c079 ;enable IOU access
   1997  sta $c05b ;enable VBL int
   1998  sta $c078 ;disable IOU access
   1999 
   2000 ]rts rts
   2001 
   2002 *-------------------------------
   2003 *
   2004 *  Is this a IIGS?
   2005 *
   2006 *  Out: IIGS (0 = no, 1 = yes)
   2007 *       If yes, set control panel to default settings
   2008 *       Exit w/RAM bank 2 switched in
   2009 *
   2010 *  Also initializes VBLANK routine
   2011 *
   2012 *-------------------------------
   2013 CHECKIIGS
   2014  do EditorDisk
   2015  else
   2016 
   2017  bit USEROM
   2018  bit USEROM
   2019 
   2020  lda $FBB3
   2021  cmp #6
   2022  bne * ;II/II+/III--we shouldn't even be here
   2023  sec
   2024  jsr $FE1F
   2025  bcs :notGS
   2026 
   2027 * Set default settings
   2028 
   2029  xc
   2030  lda $c034
   2031  and #$f0
   2032  sta $c034 ;black border
   2033 
   2034  lda #$f0
   2035  sta $c022 ;black bg, white text
   2036 
   2037  lda #$80
   2038  trb $c036 ;normal speed
   2039 
   2040 * & set control panel to match the new reality
   2041 
   2042  lda #$00
   2043  ldy #$1c ;border
   2044  jsr setparam
   2045 
   2046  lda #$00
   2047  ldy #$1b ;bg
   2048  jsr setparam
   2049 
   2050  lda #$0f
   2051  ldy #$1a ;text
   2052  jsr setparam
   2053 
   2054  lda #$00
   2055  ldy #$20 ;speed
   2056  jsr setparam
   2057 
   2058  lda #1
   2059  bne :set
   2060  xc off
   2061  fin
   2062 
   2063 :notGS lda #0
   2064 :set sta IIGS
   2065 
   2066  jsr InitVBLANK
   2067 
   2068  bit RWBANK2
   2069  bit RWBANK2
   2070 ]rts rts
   2071 
   2072 *-------------------------------
   2073 *
   2074 *  Temporarily set fast speed (IIGS)
   2075 *
   2076 *-------------------------------
   2077  xc
   2078 FASTSPEED
   2079  lda IIGS
   2080  beq ]rts
   2081 
   2082  lda #$80
   2083  tsb $C036 ;fast speed
   2084 ]rts rts
   2085 
   2086 *-------------------------------
   2087 *
   2088 * Restore speed to normal
   2089 *
   2090 *-------------------------------
   2091 NORMSPEED
   2092  lda IIGS
   2093  beq ]rts
   2094 
   2095  ldy #$20
   2096  jsr getparam ;ctrl panel speed
   2097  bne ]rts
   2098  lda #$80
   2099  trb $C036
   2100  rts
   2101  xc off
   2102 
   2103 *-------------------------------
   2104 *
   2105 *  Read control panel parameter (IIGS)
   2106 *
   2107 *  In: Y = location
   2108 *  Out: A = current setting
   2109 *
   2110 *-------------------------------
   2111  xc
   2112  xc
   2113 getparam
   2114  lda IIGS
   2115  beq ]rts
   2116 
   2117  clc
   2118  xce
   2119  rep $30
   2120  pha
   2121  phy
   2122  ldx #$0C03
   2123  hex 22,00,00,E1 ;jsl E10000
   2124  pla
   2125  sec
   2126  xce
   2127  tay
   2128  rts
   2129 
   2130 *-------------------------------
   2131 *
   2132 * Set control panel parameter (IIGS only)
   2133 *
   2134 * In: A = desired value, Y = location
   2135 *
   2136 *-------------------------------
   2137 setparam
   2138  clc
   2139  xce
   2140  rep $30
   2141  and #$ff
   2142  pha
   2143  phy
   2144  ldx #$B03
   2145  hex 22,00,00,E1 ;jsl E10000
   2146  sec
   2147  xce
   2148  rts
   2149 
   2150  xc off
   2151 
   2152 *-------------------------------
   2153  lst
   2154 eof ds 1
   2155  usr $a9,4,$0000,*-org
   2156  lst off