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

GRAFIX.S (28760B)


      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  jsr normspeed ;IIGS
   1234 
   1235  lda #$ff
   1236  sta joyon ;Joystick on
   1237 
   1238  lda #0
   1239  sta jvert
   1240  sta jhoriz
   1241  sta jbtns ;set normal params
   1242 
   1243  jsr PREAD ;get raw jstk values
   1244 
   1245  lda joyX
   1246  ora joyY
   1247  bmi :nojoy ;No joystick connected
   1248 
   1249  lda joyX
   1250  sec
   1251  sbc #cwidthx
   1252  sta jthres1x
   1253  lda joyX
   1254  clc
   1255  adc #cwidthx
   1256  sta jthres2x
   1257 
   1258  lda joyY
   1259  sec
   1260  sbc #cwidthy
   1261  sta jthres1y
   1262  lda joyY
   1263  clc
   1264  adc #cwidthy
   1265  sta jthres2y
   1266  rts
   1267 
   1268 :nojoy lda #0
   1269  sta joyon
   1270 ]rts rts
   1271 
   1272 *-------------------------------
   1273 *
   1274 *  Move a block of memory
   1275 *
   1276 *  In: A < X.Y
   1277 *
   1278 *  20 < 40.60 means 2000 < 4000.5fffm
   1279 *  WARNING: If x >= y, routine will wipe out 64k
   1280 *
   1281 *-------------------------------
   1282 MOVEMEM sta ]dest+1
   1283  stx ]source+1
   1284  sty ]endsourc+1
   1285 
   1286  ldy #0
   1287  sty ]dest
   1288  sty ]source
   1289  sty ]endsourc
   1290 
   1291 :loop lda (]source),y
   1292  sta (]dest),y
   1293  iny
   1294  bne :loop
   1295 
   1296  inc ]source+1
   1297  inc ]dest+1
   1298  lda ]source+1
   1299  cmp ]endsourc+1
   1300  bne :loop
   1301  rts
   1302 
   1303 *-------------------------------
   1304 *
   1305 *  G  T  O  N  E
   1306 *
   1307 *  Call this routine to confirm special-key presses
   1308 *  & any other time we want to bypass normal sound interface
   1309 *
   1310 *-------------------------------
   1311 SK1Pitch = 15
   1312 SK1Dur = 50
   1313 
   1314 GTONE ldy #SK1Pitch
   1315  ldx #>SK1Pitch
   1316  lda #SK1Dur
   1317  jmp tone
   1318 
   1319 *-------------------------------
   1320 *
   1321 *  Whoop speaker (like RW18)
   1322 *
   1323 *-------------------------------
   1324 WHOOP
   1325  ldy #0
   1326 :1 tya
   1327  bit $c030
   1328 :2 sec
   1329  sbc #1
   1330  bne :2
   1331  dey
   1332  bne :1
   1333 ]rts rts
   1334 
   1335 *-------------------------------
   1336 *
   1337 *  Produce tone
   1338 *
   1339 *  In: y-x = pitch lo-hi
   1340 *      a = duration
   1341 *
   1342 *-------------------------------
   1343 tone
   1344  sty :pitch
   1345  stx :pitch+1
   1346 :outloop bit $c030
   1347  ldx #0
   1348 :midloop ldy #0
   1349 :inloop iny
   1350  cpy :pitch
   1351  bcc :inloop
   1352  inx
   1353  cpx :pitch+1
   1354  bcc :midloop
   1355  sec
   1356  sbc #1
   1357  bne :outloop
   1358  rts
   1359 
   1360 :pitch ds 2
   1361 
   1362 *-------------------------------
   1363 *
   1364 * Copy one hires page to the other
   1365 *
   1366 * In: PAGE = dest scrn (00/20)
   1367 *
   1368 *-------------------------------
   1369 COPYSCRN
   1370  lda PAGE
   1371  clc
   1372  adc #$20
   1373  sta IMAGE+1 ;dest addr
   1374  eor #$60
   1375  sta IMAGE ;org addr
   1376 
   1377  jmp copy2000
   1378 
   1379 *-------------------------------
   1380 *
   1381 *  Generate random number
   1382 *
   1383 *  RNDseed := (5 * RNDseed + 23) mod 256
   1384 *
   1385 *-------------------------------
   1386 RND
   1387  lda RNDseed
   1388  asl
   1389  asl
   1390  clc
   1391  adc RNDseed
   1392  clc
   1393  adc #23
   1394  sta RNDseed
   1395 ]rts rts
   1396 
   1397 *-------------------------------
   1398 *
   1399 *  Calls to hires & master routines
   1400 *
   1401 *  Hires & master routines are in main lc & use main zp;
   1402 *  rest of code uses aux lc, zp.
   1403 *
   1404 *-------------------------------
   1405 *
   1406 *  Master
   1407 *
   1408 *-------------------------------
   1409 LOADLEVEL sta ALTZPoff ;main l.c.
   1410  jsr _loadlevel
   1411  sta ALTZPon ;aux l.c.
   1412  rts
   1413 
   1414 ATTRACTMODE sta ALTZPoff
   1415  jsr _attractmode
   1416  sta ALTZPon
   1417  rts
   1418 
   1419 CUTPRINCESS sta ALTZPoff
   1420  jsr _cutprincess
   1421  sta ALTZPon
   1422  rts
   1423 
   1424 RELOAD sta ALTZPoff
   1425  jsr _reload
   1426  sta ALTZPon
   1427  rts
   1428 
   1429 LOADSTAGE2 sta ALTZPoff
   1430  jsr _loadstage2
   1431  sta ALTZPon
   1432  rts
   1433 
   1434 SAVEGAME sta ALTZPoff
   1435  jsr _savegame
   1436  sta ALTZPon
   1437  rts
   1438 
   1439 LOADGAME sta ALTZPoff
   1440  jsr _loadgame
   1441  sta ALTZPon
   1442  rts
   1443 
   1444 DOSTARTGAME sta ALTZPoff
   1445  jmp _dostartgame
   1446 
   1447 EPILOG sta ALTZPoff
   1448  jmp _epilog
   1449 
   1450 LOADALTSET sta ALTZPoff
   1451  jsr _loadaltset
   1452  sta ALTZPon
   1453  rts
   1454 
   1455 SCREENDUMP sta ALTZPoff
   1456  jsr _screendump
   1457  sta ALTZPon
   1458  rts
   1459 
   1460 *-------------------------------
   1461 *
   1462 * Edmaster (editor disk only)
   1463 *
   1464 *-------------------------------
   1465  do EditorDisk
   1466 
   1467 SAVELEVEL sta ALTZPoff
   1468  jsr _savelevel
   1469  sta ALTZPon
   1470  rts
   1471 
   1472 SAVELEVELG sta ALTZPoff
   1473  jsr _savelevelg
   1474  sta ALTZPon
   1475  rts
   1476 
   1477 READDIR sta ALTZPoff
   1478  jsr _readdir
   1479  sta ALTZPon
   1480  rts
   1481 
   1482 WRITEDIR sta ALTZPoff
   1483  jsr _writedir
   1484  sta ALTZPon
   1485  rts
   1486 
   1487 GOBUILD sta ALTZPoff
   1488  jsr _gobuild
   1489  sta ALTZPon
   1490  rts
   1491 
   1492 GOGAME sta ALTZPoff
   1493  jsr _gogame
   1494  sta ALTZPon
   1495  rts
   1496 
   1497 EDREBOOT sta ALTZPoff
   1498  jsr _edreboot
   1499  sta ALTZPon
   1500  rts
   1501 
   1502  else
   1503 SAVELEVEL
   1504 SAVELEVELG
   1505 READDIR
   1506 WRITEDIR
   1507 GOBUILD
   1508 GOGAME
   1509 EDREBOOT rts
   1510  fin
   1511 
   1512 *-------------------------------
   1513 *
   1514 *  Hires
   1515 *
   1516 *-------------------------------
   1517 CLS jsr prehr
   1518  sta ALTZPoff
   1519  jsr _cls
   1520  sta ALTZPon
   1521  rts
   1522 
   1523 LAY jsr prehr
   1524  sta ALTZPoff
   1525  jsr _lay
   1526  sta ALTZPon
   1527  rts
   1528 
   1529 FASTLAY jsr prehr
   1530  sta ALTZPoff
   1531  jsr _fastlay
   1532  sta ALTZPon
   1533  rts
   1534 
   1535 LAYRSAVE jsr prehr
   1536  sta ALTZPoff
   1537  jsr _layrsave
   1538  sta ALTZPon
   1539  jmp posthr
   1540 
   1541 LRCLS sta scrncolor ;In: A = screen color
   1542  sta ALTZPoff
   1543  jsr _lrcls
   1544  sta ALTZPon
   1545  rts
   1546 
   1547 FASTMASK jsr prehr
   1548  sta ALTZPoff
   1549  jsr _fastmask
   1550  sta ALTZPon
   1551  rts
   1552 
   1553 FASTBLACK jsr prehr
   1554  sta ALTZPoff
   1555  jsr _fastblack
   1556  sta ALTZPon
   1557  rts
   1558 
   1559 PEEL jsr prehr
   1560  sta ALTZPoff
   1561  jsr _peel
   1562  sta ALTZPon
   1563  rts
   1564 
   1565 GETWIDTH jsr prehr
   1566  sta ALTZPoff
   1567  jsr _getwidth
   1568  sta ALTZPon
   1569  rts
   1570 
   1571 COPY2000 jsr prehr
   1572  sta ALTZPoff
   1573  jsr _copy2000
   1574  sta ALTZPon
   1575  rts
   1576 
   1577 COPY2000AM jsr prehr
   1578  sta ALTZPoff
   1579  jsr _copy2000am
   1580  sta ALTZPon
   1581  rts
   1582 
   1583 COPY2000MA jsr prehr
   1584  sta ALTZPoff
   1585  jsr _copy2000ma
   1586  sta ALTZPon
   1587  rts
   1588 
   1589 SETFASTAUX
   1590  sta ALTZPoff
   1591  jsr _setfastaux
   1592  sta ALTZPon
   1593  rts
   1594 
   1595 SETFASTMAIN
   1596  sta ALTZPoff
   1597  jsr _setfastmain
   1598  sta ALTZPon
   1599  rts
   1600 
   1601 INVERTY
   1602  sta ALTZPoff
   1603  jsr _inverty
   1604  sta ALTZPon
   1605  rts
   1606 
   1607 *-------------------------------
   1608 *
   1609 *  Call sound routines (in aux l.c. bank 1)
   1610 *  Exit with bank 2 switched in
   1611 *
   1612 *-------------------------------
   1613 ]bank1in bit RWBANK1
   1614  bit RWBANK1
   1615  rts
   1616 
   1617 MINIT jsr ]bank1in
   1618  jsr CALLMINIT
   1619 ]bank2in bit RWBANK2
   1620  bit RWBANK2
   1621  rts
   1622 
   1623 MPLAY jsr ]bank1in
   1624  jsr CALLMPLAY
   1625  jmp ]bank2in
   1626 
   1627 *-------------------------------
   1628 *
   1629 *  Call aux l.c. routines from MASTER (main l.c.)
   1630 *
   1631 *-------------------------------
   1632 XMINIT sta ALTZPon
   1633  jsr MINIT
   1634  sta ALTZPoff
   1635  rts
   1636 
   1637 XMPLAY sta ALTZPon
   1638  jsr MPLAY
   1639  sta ALTZPoff
   1640  rts
   1641 
   1642 XTITLE sta ALTZPon
   1643  jsr titlescreen
   1644  sta ALTZPoff
   1645  rts
   1646 
   1647 XPLAYCUT sta ALTZPon
   1648  jsr playcut ;in subs
   1649  sta ALTZPoff
   1650  rts
   1651 
   1652 XMOVEMUSIC sta ALTZPon
   1653  jsr movemusic ;in misc
   1654  sta ALTZPoff
   1655  rts
   1656 
   1657 *-------------------------------
   1658 *
   1659 * Copy hires params from aux to main z.p.
   1660 *
   1661 * (Enter & exit w/ ALTZP on)
   1662 *
   1663 *-------------------------------
   1664 prehr
   1665  ldx #$17
   1666 :loop sta ALTZPon ;aux zp
   1667  lda $00,x
   1668  sta ALTZPoff ;main zp
   1669  sta $00,x
   1670  dex
   1671  bpl :loop
   1672  sta ALTZPon
   1673  rts
   1674 
   1675 *-------------------------------
   1676 *
   1677 * Copy hires params from main to aux z.p.
   1678 *
   1679 * (Enter & exit w/ ALTZP on)
   1680 *
   1681 *-------------------------------
   1682 posthr
   1683  ldx #$17
   1684 :loop sta ALTZPoff
   1685  lda $00,x
   1686  sta ALTZPon
   1687  sta $00,x
   1688  dex
   1689  bpl :loop
   1690 ]rts rts
   1691 
   1692 *-------------------------------
   1693 *
   1694 *  Save master copy of blueprint in l.c. bank 1
   1695 *
   1696 *-------------------------------
   1697 SAVEBLUE
   1698  jsr ]bank1in
   1699  lda #>$d700
   1700  ldx #>$b700
   1701  ldy #>$b700+$900
   1702  jsr movemem
   1703  jmp ]bank2in
   1704 
   1705 SAVEBINFO
   1706  jsr ]bank1in
   1707  lda #>$d000
   1708  ldx #>$a600
   1709  ldy #>$a600+$600
   1710  jsr movemem
   1711  jmp ]bank2in
   1712 
   1713 *-------------------------------
   1714 *
   1715 * Reload master copy of blueprint from l.c. bank 1
   1716 *
   1717 *-------------------------------
   1718 RELOADBLUE
   1719  jsr ]bank1in
   1720  lda #>$b700
   1721  ldx #>$d700
   1722  ldy #>$d700+$900
   1723  jsr movemem
   1724  jmp ]bank2in
   1725 
   1726 RELOADBINFO
   1727  jsr ]bank1in
   1728  lda #>$a600
   1729  ldx #>$d000
   1730  ldy #>$d000+$600
   1731  jsr movemem
   1732  jmp ]bank2in
   1733 
   1734 *-------------------------------
   1735 *
   1736 *  Display lo-res page 1
   1737 *
   1738 *-------------------------------
   1739 GR jmp gtone ;temp!
   1740 
   1741 *-------------------------------
   1742 * The following routines properly belong to FRAMEADV
   1743 * but have been moved here for lack of space
   1744 *-------------------------------
   1745 *
   1746 *  C A L C   B L U E
   1747 *
   1748 *  Given:  screen #, 1-24 (in acc)
   1749 *  Return: start of BLUETYPE table (in BlueType)
   1750 *          start of BLUESPEC table (in BlueSpec)
   1751 *
   1752 *  If A = 0...
   1753 *    In game: returns garbage
   1754 *    In builder: returns menu data
   1755 *
   1756 *-------------------------------
   1757 CALCBLUE
   1758  cmp #0
   1759  beq calcmenu
   1760 
   1761  sec
   1762  sbc #1 ;reduce to 0-23
   1763  asl
   1764  tax ;x2
   1765 
   1766  lda Mult30,x
   1767  clc
   1768  adc #blueprnt
   1769  sta BlueType
   1770 
   1771  lda Mult30+1,x
   1772  adc #>blueprnt
   1773  sta BlueType+1
   1774 
   1775  lda BlueType
   1776  clc
   1777  adc #24*30
   1778  sta BlueSpec
   1779 
   1780  lda BlueType+1
   1781  adc #>24*30
   1782  sta BlueSpec+1
   1783 
   1784 ]rts rts
   1785 
   1786 calcmenu
   1787  lda #menutype
   1788  sta BlueType
   1789  lda #>menutype
   1790  sta BlueType+1
   1791 
   1792  lda #menuspec
   1793  sta BlueSpec
   1794  lda #>menuspec
   1795  sta BlueSpec+1
   1796  rts
   1797 
   1798 *-------------------------------
   1799 *
   1800 *  Z E R O   R E D
   1801 *
   1802 *  zero redraw buffers
   1803 *
   1804 *-------------------------------
   1805 ZERORED
   1806  lda #0
   1807  ldy #29
   1808 :loop sta redbuf,y
   1809  sta fredbuf,y
   1810  sta floorbuf,y
   1811  sta halfbuf,y
   1812  sta wipebuf,y
   1813  sta movebuf,y
   1814  sta objbuf,y
   1815  dey
   1816  bpl :loop
   1817 
   1818  ldy #9
   1819 :loop2 sta topbuf,y
   1820  dey
   1821  bpl :loop2
   1822 
   1823  rts
   1824 
   1825 *-------------------------------
   1826 *
   1827 *  Routines to interface with MSYS (Music System II)
   1828 *
   1829 *-------------------------------
   1830 *
   1831 * Switch zero page
   1832 *
   1833 *-------------------------------
   1834 switchzp
   1835  ldx #31
   1836 :loop ldy savezp,x
   1837  lda $00,x
   1838  sta savezp,x
   1839  tya
   1840  sta $00,x
   1841  dex
   1842  bpl :loop
   1843  rts
   1844 
   1845 *-------------------------------
   1846 *
   1847 *  Call MINIT
   1848 *
   1849 *  In: A = song #
   1850 *
   1851 *-------------------------------
   1852 CALLMINIT
   1853  pha
   1854  jsr switchzp
   1855  pla
   1856  jsr _minit
   1857  jmp switchzp
   1858 
   1859 *-------------------------------
   1860 *
   1861 *  Call MPLAY
   1862 *
   1863 *  Out: A = song #
   1864 *  (Most songs set song # = 0 when finished)
   1865 *
   1866 *-------------------------------
   1867 CALLMPLAY
   1868  lda soundon
   1869  and musicon
   1870  beq :silent
   1871 
   1872  jsr switchzp
   1873  jsr _mplay ;returns INDEX
   1874  pha
   1875  jsr switchzp
   1876  pla
   1877  rts
   1878 
   1879 :silent lda #0
   1880 ]rts rts
   1881 
   1882 *-------------------------------
   1883 *
   1884 *  M U S I C   K E Y S
   1885 *
   1886 *  Call while music is playing
   1887 *
   1888 *  Esc to pause, Ctrl-S to turn sound off
   1889 *  Return A = ASCII value (FF for button)
   1890 *  Clear hibit if it's a key we've handled
   1891 *
   1892 *-------------------------------
   1893 MUSICKEYS
   1894  lda $c000
   1895  sta keypress
   1896  bpl :nokey
   1897  sta $c010
   1898 
   1899  cmp #ESC
   1900  bne :cont
   1901 :froze lda $c000
   1902  sta keypress
   1903  bpl :froze
   1904  sta $c010
   1905  cmp #ESC
   1906  bne :cont
   1907  and #$7f
   1908  rts
   1909 
   1910 :cont cmp #ksound
   1911  bne :3
   1912  lda soundon
   1913  eor #1
   1914  sta soundon
   1915 :21 beq :2
   1916  jsr gtone
   1917 :2 lda #0
   1918  rts
   1919 
   1920 :3 cmp #kmusic
   1921  bne :1
   1922  lda musicon
   1923  eor #1
   1924  sta musicon
   1925  jmp :21
   1926 
   1927 :nobtn lda keypress
   1928  rts
   1929 :1
   1930 :nokey lda $c061
   1931  ora $c062
   1932  bpl :nobtn
   1933  lda #$ff
   1934 ]rts rts
   1935 
   1936 *===============================
   1937 vblflag ds 1
   1938 *-------------------------------
   1939 *
   1940 * Wait for vertical blank (IIe/IIGS)
   1941 *
   1942 *-------------------------------
   1943 VBLANK
   1944 :loop1 lda $c019
   1945  bpl :loop1
   1946 :loop lda $c019
   1947  bmi :loop ;wait for beginning of VBL interval
   1948 ]rts rts
   1949 
   1950 *-------------------------------
   1951 *
   1952 * Wait for vertical blank (IIc)
   1953 *
   1954 *-------------------------------
   1955 VBLANKIIc
   1956  cli ;enable interrupts
   1957 
   1958 :loop1 bit vblflag
   1959  bpl :loop1 ;wait for vblflag = 1
   1960  lsr vblflag ;...& set vblflag = 0
   1961 
   1962 :loop2 bit vblflag
   1963  bpl :loop2
   1964  lsr vblflag
   1965 
   1966  sei
   1967  rts
   1968 
   1969 * Interrupt jumps to ($FFFE) which points back to VBLI
   1970 
   1971 VBLI
   1972  bit $c019
   1973  sta $c079 ;enable IOU access
   1974  sta $c05b ;enable VBL int
   1975  sta $c078 ;disable IOU access
   1976  sec
   1977  ror vblflag ;set hibit
   1978 :notvbl rti
   1979 
   1980 *-------------------------------
   1981 *
   1982 * Initialize VBLANK vector with correct routine
   1983 * depending on whether or not machine is IIc
   1984 *
   1985 *-------------------------------
   1986 InitVBLANK
   1987  lda $FBC0
   1988  bne ]rts ;not a IIc--use VBLANK
   1989 
   1990  sta RAMWRTaux
   1991 
   1992  lda #VBLANKIIc
   1993  sta VBLvect+1
   1994  lda #>VBLANKIIc
   1995  sta VBLvect+2
   1996 
   1997  sei ;disable interrupts
   1998  sta $c079 ;enable IOU access
   1999  sta $c05b ;enable VBL int
   2000  sta $c078 ;disable IOU access
   2001 
   2002 ]rts rts
   2003 
   2004 *-------------------------------
   2005 *
   2006 *  Is this a IIGS?
   2007 *
   2008 *  Out: IIGS (0 = no, 1 = yes)
   2009 *       If yes, set control panel to default settings
   2010 *       Exit w/RAM bank 2 switched in
   2011 *
   2012 *  Also initializes VBLANK routine
   2013 *
   2014 *-------------------------------
   2015 CHECKIIGS
   2016  do EditorDisk
   2017  else
   2018 
   2019  bit USEROM
   2020  bit USEROM
   2021 
   2022  lda $FBB3
   2023  cmp #6
   2024  bne * ;II/II+/III--we shouldn't even be here
   2025  sec
   2026  jsr $FE1F
   2027  bcs :notGS
   2028 
   2029  lda #1
   2030  bne :set
   2031 
   2032 :notGS lda #0
   2033 :set sta IIGS
   2034 
   2035  jsr InitVBLANK
   2036 
   2037  bit RWBANK2
   2038  bit RWBANK2
   2039 ]rts rts
   2040 
   2041 *-------------------------------
   2042 *
   2043 *  Temporarily set fast speed (IIGS)
   2044 *
   2045 *-------------------------------
   2046  xc
   2047 FASTSPEED
   2048  lda IIGS
   2049  beq ]rts
   2050 
   2051  lda #$80
   2052  tsb $C036 ;fast speed
   2053 ]rts rts
   2054 
   2055 *-------------------------------
   2056 *
   2057 * Restore speed to normal (& bg & border to black)
   2058 *
   2059 *-------------------------------
   2060 NORMSPEED
   2061  lda IIGS
   2062  beq ]rts
   2063 
   2064  xc
   2065  lda $c034
   2066  and #$f0
   2067  sta $c034 ;black border
   2068 
   2069  lda #$f0
   2070  sta $c022 ;black bg, white text
   2071 
   2072  lda #$80
   2073  trb $c036 ;normal speed
   2074  xc off
   2075 
   2076  rts
   2077 
   2078 *-------------------------------
   2079 *
   2080 *  Read control panel parameter (IIGS)
   2081 *
   2082 *  In: Y = location
   2083 *  Out: A = current setting
   2084 *
   2085 *-------------------------------
   2086  xc
   2087  xc
   2088 getparam
   2089  lda IIGS
   2090  beq ]rts
   2091 
   2092  clc
   2093  xce
   2094  rep $30
   2095  pha
   2096  phy
   2097  ldx #$0C03
   2098  hex 22,00,00,E1 ;jsl E10000
   2099  pla
   2100  sec
   2101  xce
   2102  tay
   2103  rts
   2104 
   2105 *-------------------------------
   2106 *
   2107 * Set control panel parameter (IIGS only)
   2108 *
   2109 * In: A = desired value, Y = location
   2110 *
   2111 *-------------------------------
   2112 setparam
   2113  clc
   2114  xce
   2115  rep $30
   2116  and #$ff
   2117  pha
   2118  phy
   2119  ldx #$B03
   2120  hex 22,00,00,E1 ;jsl E10000
   2121  sec
   2122  xce
   2123  rts
   2124 
   2125  xc off
   2126 
   2127 *-------------------------------
   2128  lst
   2129 eof ds 1
   2130  usr $a9,4,$0000,*-org
   2131  lst off