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

EDITOR.S (32062B)


      1 * ed/editor
      2 DunjDisk = 1 ;0 for palace
      3 org = $9600
      4  lst off
      5 *-------------------------------
      6 *
      7 *  E D I T O R
      8 *
      9 *-------------------------------
     10  org org
     11 
     12  jmp EDSTART
     13  JMP CLRBLOCK
     14  jmp RELINK
     15  ds 3
     16  ds 3
     17 
     18 *-------------------------------
     19 * MENU DATA
     20  do DunjDisk
     21 menuType ;(BlueType)
     22  hex 0d,12,02,0b,06,0f,04,10,11,0e
     23  hex 01,00,14,00,03,13,00,00,0c,09
     24  hex 00,00,00,00,0a,15,16,0c,0c,08
     25 
     26 menuSpec  ;(BlueSpec)
     27  hex 00,00,00,00,00,00,02,00,02,00
     28  hex 00,00,00,00,00,00,02,01,01,00
     29  hex 00,00,00,03,00,00,00,02,00,00
     30  else
     31 
     32 menuType ;(BlueType)
     33  hex 0d,12,02,0b,06,0f,04,10,00,0e
     34  hex 01,00,14,1c,03,13,00,00,0c,09
     35  hex 00,00,00,0a,19,1a,1b,0c,0c,08
     36 
     37 menuSpec  ;(BlueSpec)
     38  hex 00,00,00,00,00,00,02,00,03,00
     39  hex 00,00,00,00,00,00,02,01,01,00
     40  hex 00,00,00,00,00,00,00,02,00,00
     41  fin
     42 
     43 menubSpec ;(bLinkIndex)
     44  hex 00,00,00,00,00,00,00,00,00,00
     45  hex 00,00,00,00,00,00,00,00,00,00
     46  hex 02,03,01,00,00,00,00,00,00,00
     47 
     48 *-------------------------------
     49 * "menubSpec" is index # of special symbol to
     50 * appear in this space:
     51 *
     52 * 1 = kid
     53 * 2 = eye
     54 * 3 = guard
     55 *
     56 * "menuSpec": for gadgets, initial bluespec value
     57 *
     58 * 1 = "up"
     59 * 2 = "down"
     60 *
     61 * for panels, panel pattern (0,1,2...)
     62 *
     63 *-------------------------------
     64  put eq
     65  put buildereq
     66  put movedata
     67  put eddata
     68 
     69 *-------------------------------
     70 * Local vars
     71 
     72  dum locals
     73 
     74 TEMPX ds 1
     75 TEMPY ds 1
     76 TEMPMX ds 1
     77 TEMPMY ds 1
     78 TEMPULX ds 1
     79 TEMPULY ds 1
     80 TEMPBX ds 2
     81 TEMPBY ds 1
     82 TEMPPX ds 1
     83 TEMPPY ds 1
     84 andwhat ds 1
     85 origscrn ds 1
     86 tempid ds 1
     87 propose ds 1
     88 existobj ds 1
     89 existspec ds 1
     90 tempdata ds 6
     91 
     92  dend
     93 
     94 kspeed = 8 ;determine marquee speeds
     95 jspeed = 20 ;in kbd & jstk modes
     96 
     97 bkspeed = 15
     98 bjspeed = 50 ;beth blink speed
     99 
    100 boxtimer = 90 ;cursor repeat-move speeds
    101 bethtimer = 120 ;(higher = slower)
    102 
    103 unreqmask = %11011111
    104 
    105 bethxco db 0,1,2
    106 bethoffset db 0,2,4
    107 bethyco hex 00,08,10,18,20,28,30,38
    108 
    109 bethbits hex 01,02,04,08,10,20,40,80
    110 
    111 * size:        00,01,02,03,04,05
    112 rtlist hex 01,01,02,03,04,01
    113 uplist hex 01,01,01,01,01,02
    114 
    115 * special menu symbols
    116 
    117 sstartkid = 1
    118 seye = 2
    119 sstartguard = 3
    120 
    121 *-------------------------------
    122 ctrl = $60
    123 shift = $20
    124 
    125 kleft = $88
    126 kright = $95
    127 kup = $8b
    128 kdown = $8a ;arrows
    129 kbtn0 = " "
    130 kbtn1 = $8d ;return
    131 
    132 kunreq = "q"-ctrl
    133 
    134 *-------------------------------
    135 *
    136 *  NOTE: Editor uses image lists, redraw buffers, etc.
    137 *  in the approved way -- but only for the background.
    138 *  The cursor, flashing arrows, and other misc. stuff
    139 *  (mostly from EDTABLE) are superimposed manually.
    140 *
    141 *-------------------------------
    142 EDSTART jsr INITPOINT
    143 
    144  lda #0
    145  sta THIRD
    146  sta inmenu
    147  sta linkmode
    148  sta blackflag
    149 
    150  jsr zerolsts
    151  jsr zeropeel
    152 
    153  lda #1
    154  sta antcount
    155 
    156  jsr getneighs
    157 
    158  jsr DoCleanCut
    159 
    160  jmp inploop
    161 
    162 *-------------------------------
    163 *
    164 * Clear scrn & redraw entire b.g.
    165 *
    166 *-------------------------------
    167 DoSure
    168  jsr sure
    169 
    170  jsr zeropeels
    171  jsr zerored
    172 
    173  jsr drawall
    174  jsr zerolsts
    175 
    176  jsr menuspecial
    177 
    178  jsr specialsyms
    179 
    180  jmp edges
    181 
    182 *-------------------------------
    183 *
    184 *  I N P U T   L O O P
    185 *
    186 *-------------------------------
    187 inploop
    188  lda $c000
    189  sta keypress
    190 
    191  lda $c010
    192  sta keydown
    193 
    194  lda keypress
    195  bpl :j
    196 
    197  jsr edkeys ;Always check special keys
    198 
    199  jsr actkey
    200  jmp :cont
    201 
    202 :j jsr actjoy
    203 
    204 :cont jsr marquee
    205  jmp inploop
    206 
    207 *-------------------------------
    208 *
    209 *  E D I T O R   K E Y S
    210 *
    211 *-------------------------------
    212 edkeys lda keypress
    213  jsr specialk
    214 
    215  lda keypress
    216  cmp #$9b ;esc
    217  bne :1
    218  jmp EXIT
    219 
    220 :1 cmp #kunreq
    221  bne :2
    222  jsr gtone
    223  jmp UnRequire
    224 
    225 :2 cmp #"0" ;0-9 set guard prog
    226  bcc :nonn
    227  cmp #"9"+1
    228  bcs :nonn
    229  sec
    230  sbc #"0"
    231  jmp setguardprog
    232 
    233 :nonn
    234 :rts rts
    235 
    236 *-------------------------------
    237 *
    238 *  A C T   O N   K E Y P R E S S
    239 *
    240 *-------------------------------
    241 actkey LDY #kspeed
    242 :0 LDX #0
    243 :1 DEX
    244  bne :2
    245  DEY
    246  BNE :0
    247  jmp PMOVE ;Run ant tracks
    248 
    249 :2 lda keypress
    250  BPL :1
    251 
    252  CMP #kleft
    253  BNE :3
    254  JMP PLEFT
    255 
    256 :3 CMP #kright
    257  BNE :4
    258  JMP PRIGHT
    259 
    260 :4 CMP #kup
    261  BNE :5
    262  JMP PUP
    263 
    264 :5 CMP #kdown
    265  BNE :6
    266  JMP PDOWN
    267 
    268 :6 CMP #kbtn1
    269  BNE :9
    270  jmp butt1
    271 
    272 :9 CMP #kbtn0
    273  BNE :10
    274  jmp butt0
    275 
    276 :10 RTS
    277 
    278 *-------------------------------
    279 *
    280 *  A C T   O N   J O Y S T I C K
    281 *
    282 *-------------------------------
    283 actjoy jsr controller
    284  jsr buttons
    285  jsr getselect
    286 
    287  lda JSTKX
    288  bpl :1
    289 
    290  lda #1
    291  cmp jlast
    292  bne :jleft
    293 
    294  lda jcount
    295  beq :jleft1
    296  dec jcount
    297  rts
    298 
    299 :jleft jsr jmove
    300  jmp PLEFT
    301 
    302 :jleft1 jsr jrepeat
    303  jmp PLEFT
    304 
    305 *-------------------------------
    306 :1 beq :2
    307 
    308  lda #2
    309  cmp jlast
    310  bne :jright
    311 
    312  lda jcount
    313  beq :jright1
    314  dec jcount
    315  rts
    316 
    317 :jright jsr jmove
    318  jmp PRIGHT
    319 
    320 :jright1 jsr jrepeat
    321  jmp PRIGHT
    322 
    323 *-------------------------------
    324 :2 lda JSTKY
    325  bpl :3
    326 
    327  lda #3
    328  cmp jlast
    329  bne :jup
    330 
    331  lda jcount
    332  beq :jup1
    333  dec jcount
    334  rts
    335 
    336 :jup jsr jmove
    337  jmp PUP
    338 
    339 :jup1 jsr jrepeat
    340  jmp PUP
    341 
    342 *-------------------------------
    343 :3 beq :nomove
    344 
    345  lda #4
    346  cmp jlast
    347  bne :jdown
    348 
    349  lda jcount
    350  beq :jdown1
    351  dec jcount
    352  rts
    353 
    354 :jdown jsr jmove
    355  jmp PDOWN
    356 
    357 :jdown1 jsr jrepeat
    358  jmp PDOWN
    359 
    360 *-------------------------------
    361 :nomove lda #0
    362  sta jlast
    363 
    364  lda BUTT0
    365  bpl :nobtn0
    366  jmp butt0
    367 
    368 :nobtn0 lda BUTT1
    369  bpl :rts
    370  jmp butt1
    371 
    372 :rts rts
    373 
    374 *-------------------------------
    375 *
    376 *  M A R Q U E E
    377 *
    378 *  run marquee
    379 *
    380 *-------------------------------
    381 marquee dec antcount
    382  bne :ant1
    383 
    384  lda #jspeed
    385  sta antcount
    386 
    387  jmp PMOVE
    388 
    389 :ant1 rts
    390 
    391 *-------------------------------
    392 *
    393 *  J M O V E
    394 *
    395 *-------------------------------
    396 jmove sta jlast
    397 
    398  lda #boxtimer
    399  sta jcount
    400  rts
    401 
    402 bmove sta jlast
    403 
    404  lda #bethtimer
    405  sta jcount
    406  rts
    407 
    408 jrepeat lda #1
    409  sta jcount
    410  rts
    411 
    412 *-------------------------------
    413 *
    414 *  B U T T O N   0
    415 *
    416 *-------------------------------
    417 butt0
    418 
    419 * In editor: put down/delete piece
    420 * In editor with links shown: change links
    421 * In menu: pick up piece & exit menu
    422 
    423  lda inmenu
    424  beq :1
    425  jmp PICKUP
    426 
    427 :1 lda linkmode ;links shown?
    428  beq :2 ;no
    429  jmp chglinks
    430 
    431 :2 jmp PUT
    432 
    433 *-------------------------------
    434 *
    435 *  B U T T O N   1
    436 *
    437 *-------------------------------
    438 butt1
    439 
    440 * In editor: go to menu
    441 * In menu: return to builder
    442 
    443  lda inmenu
    444  beq :1
    445  jmp EXIT
    446 
    447 :1 jmp MENU
    448 
    449 *-------------------------------
    450 * Temp development feature: Remove "required" mark from a block
    451 
    452 UnRequire
    453  lda inmenu
    454  bne :rts
    455 
    456  jsr GET
    457  and #unreqmask
    458  jmp putblock
    459 
    460 :rts
    461 ]rts rts
    462 
    463 *-------------------------------
    464 *
    465 * C U T
    466 *
    467 * Cut to new screen
    468 *
    469 *-------------------------------
    470 CUT lda inmenu
    471  bne ]rts
    472 
    473  jsr calcmat1
    474 
    475  LDY #0
    476  LDA (MATPTR),Y
    477  BEQ CANTCUT ;Screen 0 doesn't exist (officially)
    478 
    479  STA SCRNUM
    480 
    481  jsr getneighs
    482 
    483  jmp DoCleanCut
    484 
    485 CANTCUT jmp rstorptr
    486 
    487 *-------------------------------
    488 CutToMenu
    489  jsr gr
    490 
    491  jsr retrievemenu
    492 
    493  jsr zeropeels
    494 
    495  jsr PMOVE
    496 
    497  lda $c057
    498 
    499  rts
    500 
    501 *-------------------------------
    502 DoCleanCut
    503  jsr gr
    504 
    505  lda #$20
    506  sta PAGE
    507  jsr DoSure
    508 
    509  lda #0
    510  sta PAGE
    511  jsr copyscrn
    512 
    513  jsr PMOVE
    514  lda $c057
    515 
    516  rts
    517 
    518 *-------------------------------
    519 * DoCut2: no blackout
    520 
    521 DoCut2
    522  jsr DoSure
    523 
    524  jsr pageflip
    525 
    526  jsr copyscrn
    527 
    528  jmp PMOVE
    529 
    530 *-------------------------------
    531 *
    532 * G E T N E I G H S
    533 *
    534 * Get neighboring screen #s
    535 *
    536 *-------------------------------
    537 getneighs
    538  ldx #-1
    539  ldy #0
    540  jsr getneigh
    541  sta scrnLeft
    542 
    543  ldx #1
    544  ldy #0
    545  jsr getneigh
    546  sta scrnRight
    547 
    548  ldx #0
    549  ldy #-1
    550  jsr getneigh
    551  sta scrnAbove
    552 
    553  ldx #0
    554  ldy #1
    555  jsr getneigh
    556  sta scrnBelow
    557 
    558 * & diagonals
    559 
    560  ldx #-1
    561  ldy #-1
    562  jsr getneigh
    563  sta scrnAboveL
    564 
    565  ldx #-1
    566  ldy #1
    567  jsr getneigh
    568  sta scrnBelowL
    569 
    570  ldx #1
    571  ldy #-1
    572  jsr getneigh
    573  sta scrnAboveR
    574 
    575  ldx #1
    576  ldy #1
    577  jsr getneigh
    578  sta scrnBelowR
    579 
    580  rts
    581 
    582 *-------------------------------
    583 *
    584 * I N I T P O I N T
    585 *
    586 * initial placement of pointer
    587 *
    588 *-------------------------------
    589 INITPOINT lda virgin ;first time in editor?
    590  beq :rts ;no
    591  lda #0
    592  sta virgin
    593 
    594 * Put "pointer" (i.e., box) somewhere
    595 * (X = 0-9, Y = 0-2)
    596 
    597  LDA #0
    598  STA POINTX
    599  LDA #1
    600  STA POINTY
    601 
    602  LDA #1 ;floor
    603  STA HELD ;Image id# of object in hand
    604  lda #0
    605  sta heldspec
    606 
    607 * Put menu pointer in u.l. of menu screen 0
    608 
    609  lda #0
    610  sta savescrn
    611  sta savepx
    612  lda #1
    613  sta savepy
    614 
    615 :rts lda #1
    616  sta size
    617  jsr gdist
    618 
    619  ldx HELD
    620  lda sizelist,x
    621  sta size
    622  rts
    623 
    624 *-------------------------------
    625 *
    626 * P O I N T E R   L E F T / R I G H T / U P / D O W N
    627 *
    628 *-------------------------------
    629 PLEFT jsr saveptr
    630 
    631  LDA POINTX
    632  SEC
    633  SBC #1
    634  BMI :1
    635  STA POINTX
    636 
    637  jsr getsize
    638  JMP PMOVE
    639 
    640 :1 LDA #9
    641  STA POINTX
    642 
    643  jsr getsize
    644  jmp MLEFT
    645 
    646 *-------------------------------
    647 PRIGHT jsr saveptr
    648  jsr getdist
    649 
    650  LDA POINTX
    651  CLC
    652  ADC dright
    653  CMP #10
    654  BCS :1
    655  STA POINTX
    656 
    657  jsr getsize
    658  JMP PMOVE
    659 
    660 :1 LDA #0
    661  STA POINTX
    662 
    663  jsr getsize
    664  jmp MRIGHT
    665 
    666 *-------------------------------
    667 PUP jsr saveptr
    668  jsr getdist
    669 
    670  LDA POINTY
    671  SEC
    672  SBC dup
    673  BMI :1
    674  STA POINTY
    675 
    676  jsr getsize
    677  JMP PMOVE
    678 
    679 :1 LDA #2
    680  STA POINTY
    681 
    682  jsr getsize
    683  JSR MUP
    684  jmp CUT
    685 
    686 *-------------------------------
    687 PDOWN jsr saveptr
    688 
    689  LDA POINTY
    690  CLC
    691  ADC #1
    692  CMP #3
    693  BCS :1
    694  STA POINTY
    695 
    696  jsr getsize
    697  JMP PMOVE
    698 
    699 :1 LDA #0
    700  STA POINTY
    701 
    702  jsr getsize
    703  JSR MDOWN
    704  jmp CUT
    705 
    706 *-------------------------------
    707 *
    708 *  S A V E / R E S T O R E   P O I N T E R   P O S N
    709 *
    710 *-------------------------------
    711 saveptr lda POINTX
    712  sta TEMPX
    713  lda POINTY
    714  sta TEMPY
    715 
    716  lda MATX
    717  sta TEMPMX
    718  lda MATY
    719  sta TEMPMY
    720 
    721  lda ULX
    722  sta TEMPULX
    723  lda ULY
    724  sta TEMPULY
    725 
    726  lda BLOCKX
    727  sta TEMPBX
    728  lda BLOCKX+1
    729  sta TEMPBX+1
    730  lda BLOCKY
    731  sta TEMPBY
    732 
    733  lda PTRX
    734  sta TEMPPX
    735  lda PTRY
    736  sta TEMPPY
    737 
    738  rts
    739 
    740 *-------------------------------
    741 rstorptr lda TEMPX
    742  sta POINTX
    743  lda TEMPY
    744  sta POINTY
    745 
    746  lda TEMPMX
    747  sta MATX
    748  lda TEMPMY
    749  sta MATY
    750 
    751  lda TEMPULX
    752  sta ULX
    753  lda TEMPULY
    754  sta ULY
    755 
    756  lda TEMPBX
    757  sta BLOCKX
    758  lda TEMPBX+1
    759  sta BLOCKX+1
    760  lda TEMPBY
    761  sta BLOCKY
    762 
    763  lda TEMPPX
    764  sta PTRX
    765  lda TEMPPY
    766  sta PTRY
    767 
    768  rts
    769 
    770 *-------------------------------
    771 *
    772 *  P O I N T E R M O V E
    773 *
    774 *-------------------------------
    775 PMOVE
    776  jsr sngpeel ;peel off old pointer
    777 
    778  jsr zeropeel ;zero just-used peelbuf
    779 
    780  DEC THIRD
    781  BPL :1
    782  LDA #2
    783  STA THIRD
    784 :1
    785  LDA POINTX
    786  ASL
    787  ASL
    788  STA XCO
    789 
    790  LDA #0
    791  STA OFFSET
    792 
    793  LDY POINTY
    794  LDA BlockBot+1,Y
    795  STA YCO
    796 
    797  LDA #ora
    798  STA OPACITY
    799 
    800  LDA #1
    801  CLC
    802  ADC THIRD
    803  STA IMAGE
    804 
    805  jsr seted ;use edtable
    806 
    807  jsr layrsave
    808  jsr addpeel
    809 
    810  jsr lay
    811 
    812 * Done
    813 
    814  jmp pageflip
    815 
    816 *-------------------------------
    817 *
    818 *  G E T   S I Z E
    819 *
    820 *  size cursor to fit object it's holding
    821 *  (only in menu)
    822 *
    823 *-------------------------------
    824 ]rts rts
    825 
    826 getsize lda inmenu
    827  beq ]rts
    828 
    829  jmp gsize
    830 
    831 *-------------------------------
    832 *
    833 *  G S I Z E
    834 *
    835 *  Get size of object under cursor
    836 *  & move cursor to base piece
    837 *
    838 *-------------------------------
    839 gsize jsr GET ;obj id#
    840  and #idmask
    841  sta tempid
    842 
    843  tax
    844  lda sizelist,x
    845  sta size
    846 
    847  lda baselist,x ;is cursor on base piece (l.l)?
    848  cmp tempid
    849  beq :rts ;yes--we're OK
    850 
    851 * no--move cursor to base piece
    852 
    853  sta tempid
    854 
    855  lda size
    856  cmp #5
    857  bcc :wide
    858 
    859 :tall lda POINTY
    860  clc
    861  adc posnlist,x
    862  sta POINTY
    863  cmp #3
    864  bcc :rts
    865  jmp cutdown
    866 
    867 :wide lda POINTX
    868  sec
    869  sbc posnlist,x
    870  sta POINTX
    871  bpl :rts
    872  jmp cutleft
    873 
    874 * Assume that in menu, pieces never
    875 * overlap screen edges
    876 
    877 :rts rts
    878 
    879 
    880 *-------------------------------
    881 getdist lda inmenu
    882  beq :rts
    883  jmp gdist
    884 :rts rts
    885 
    886 gdist ldx size
    887  lda uplist,x
    888  sta dup
    889  lda rtlist,x
    890  sta dright
    891  rts
    892 
    893 *-------------------------------
    894 *
    895 *  G E T
    896 *
    897 *  Return contents of (SCRNUM: POINTX,POINTY) in A
    898 *  (Sets BlueType, BlueSpec, bLinkIndex and Y)
    899 *
    900 *-------------------------------
    901 GET LDA SCRNUM
    902  jsr bcalcblue
    903 
    904  LDY POINTY
    905  LDA Mult10,Y
    906 
    907  CLC
    908  ADC POINTX
    909 
    910  TAY
    911 
    912  LDA (BlueType),Y
    913 
    914  RTS
    915 
    916 *-------------------------------
    917 *
    918 * P I C K U P
    919 * (in menu)
    920 *
    921 *-------------------------------
    922 PICKUP jsr GET
    923  and #idmask
    924  sta HELD
    925 
    926  lda (bLinkIndex),y
    927  sta special ;1=kid, 2=eye, etc.
    928 
    929  lda (BlueSpec),y
    930  sta heldspec
    931 
    932  jsr getsize
    933 
    934  lda #1
    935  sta dup
    936  sta dright
    937 
    938 * picked up a special symbol?
    939 
    940  lda special
    941  beq :go
    942 
    943  cmp #seye
    944  bne :2
    945 
    946  lda #1
    947  sta linkmode ;show links
    948  jmp :go
    949 
    950 :2
    951 
    952 :go jsr leavem
    953  jmp CUT
    954 
    955 *-------------------------------
    956 *
    957 *  C L E A R   M A T
    958 *
    959 *  Put object #objid on screen at (POINTX,POINTY)
    960 *  Pass 1 (clearmat): clear away underlying objects
    961 *
    962 *  Return X = 0 if we can do it, -1 if we can't
    963 *
    964 *-------------------------------
    965 clearmat lda SCRNUM
    966  sta origscrn
    967 
    968  lda objid
    969  pha
    970  lda POINTX
    971  pha
    972  lda POINTY
    973  pha
    974  lda MATX
    975  pha
    976  lda MATY
    977  pha
    978 
    979 :loop jsr clearsec ;clear this section
    980 
    981  ldx objid
    982  lda linklist,x ;pointer to next section
    983  bmi :done ;ff is "end-of-list" code
    984 
    985  sta objid
    986  jsr getnext ;get position (up or right 1)
    987  jmp :loop ;& clear next section
    988 
    989 :done ldx #0 ;can-do code
    990 
    991  lda SCRNUM
    992  bne :ok
    993 
    994 * we ended up on screen 0--can't do it
    995 
    996  jsr gtone
    997  ldx #-1 ;can't-do-it code
    998 
    999 :ok lda origscrn
   1000  sta SCRNUM
   1001 
   1002  pla
   1003  sta MATY
   1004  pla
   1005  sta MATX
   1006  pla
   1007  sta POINTY
   1008  pla
   1009  sta POINTX
   1010  pla
   1011  sta objid
   1012  rts
   1013 
   1014 *-------------------------------
   1015 *
   1016 *  P L A C E   M A T
   1017 *
   1018 *  Pass 2: place new object
   1019 *
   1020 *-------------------------------
   1021 placemat lda SCRNUM
   1022  sta origscrn
   1023 
   1024  lda objid
   1025  pha
   1026  lda POINTX
   1027  pha
   1028  lda POINTY
   1029  pha
   1030  lda MATX
   1031  pha
   1032  lda MATY
   1033  pha
   1034 
   1035 :loop jsr placesec
   1036 
   1037  ldx objid
   1038  lda linklist,x ;pointer to next section
   1039  bmi :end ;ff is "end-of-list" code
   1040 
   1041  sta objid
   1042  jsr getnext ;get next section (up or right 1)
   1043  jmp :loop
   1044 
   1045 * Done -- but does this object need floorpiece above?
   1046 
   1047 :end cmp #$fe ;requires floorpiece on top?
   1048  bne :done ;no
   1049  jsr getabove
   1050 
   1051  lda andwhat
   1052  bne :placing
   1053 
   1054 * Removing object -- so unmark extra floorpiece
   1055 * (it's no longer required)
   1056 
   1057  jsr GET
   1058  and #unreqmask ;turn off "required" flag
   1059  jsr putblock
   1060  jmp :done
   1061 
   1062 * Placing object -- so mark floorpiece above it
   1063 * (or put a floorpiece there if there isn't one)
   1064 
   1065 :placing jsr GET
   1066  and #idmask
   1067  bne :1
   1068 
   1069  jsr addsqr ;to redraw list
   1070  jsr GET
   1071  lda #1 ;floorpiece
   1072 
   1073 :1 ora #reqmask
   1074  jsr putblock
   1075 
   1076 :done lda origscrn
   1077  sta SCRNUM
   1078 
   1079  pla
   1080  sta MATY
   1081  pla
   1082  sta MATX
   1083  pla
   1084  sta POINTY
   1085  pla
   1086  sta POINTX
   1087  pla
   1088  sta objid
   1089  rts
   1090 
   1091 *-------------------------------
   1092 *
   1093 *  C L E A R   S E C
   1094 *
   1095 *  Clear section; delete links
   1096 *  (If section is part of a composite object, remove
   1097 *  the whole thing)
   1098 *
   1099 *-------------------------------
   1100 clearsec
   1101  lda size
   1102  pha
   1103  lda SCRNUM
   1104  pha
   1105  lda objid
   1106  pha
   1107  lda POINTX
   1108  pha
   1109  lda POINTY
   1110  pha
   1111  lda MATX
   1112  pha
   1113  lda MATY
   1114  pha
   1115 
   1116  jsr gsize ;Get size--move POINTX,Y to base
   1117 
   1118  jsr GET ;base section
   1119 
   1120  jsr deletelink
   1121 
   1122  lda tempid
   1123  sta objid
   1124 
   1125 :loop lda #0
   1126  sta propose ;what we want
   1127  jsr GET
   1128  jsr reqchek ;what we'll settle for
   1129  jsr putblock
   1130  jsr addsqr
   1131 
   1132  ldx objid
   1133  lda linklist,x ;pointer to next section
   1134  bmi :end ;ff is "end-of-list" code
   1135 
   1136  sta objid
   1137  jsr getnext ;get next section (up or right 1)
   1138  jmp :loop
   1139 
   1140 :end cmp #$fe ;requires floorpiece on top or at right?
   1141  bne :done ;no
   1142 
   1143  jsr getabove
   1144  jsr GET
   1145  and #unreqmask
   1146  jsr putblock
   1147 
   1148 :done pla
   1149  sta MATY
   1150  pla
   1151  sta MATX
   1152  pla
   1153  sta POINTY
   1154  pla
   1155  sta POINTX
   1156  pla
   1157  sta objid
   1158  pla
   1159  sta SCRNUM
   1160  pla
   1161  sta size
   1162 
   1163 :rts rts
   1164 
   1165 *-------------------------------
   1166 *
   1167 *  P L A C E   S E C
   1168 *
   1169 *-------------------------------
   1170 placesec lda objid
   1171  and andwhat ;placing or removing?
   1172  sta propose
   1173  jsr GET
   1174  jsr reqchek
   1175  jsr putblock
   1176 
   1177  lda heldspec
   1178  sta (BlueSpec),y ;initial state of gadget
   1179 
   1180  jsr addsqr ;add square to list
   1181 ]rts rts
   1182 
   1183 *-------------------------------
   1184 * put A in (BlueType),Y
   1185 * In: A,Y ... trashes X
   1186 
   1187 putblock ldx SCRNUM
   1188  beq ]rts ;not scrn 0
   1189  sta (BlueType),y
   1190 ]rts rts
   1191 
   1192 *-------------------------------
   1193 *
   1194 *  A D D   S Q R
   1195 *
   1196 * add this square to redraw buffer
   1197 *
   1198 * In: Y = block index
   1199 *
   1200 *-------------------------------
   1201 addsqr lda SCRNUM
   1202  cmp origscrn
   1203  bne ]rts
   1204 addsqr1
   1205  jsr redsqr ;redraw this square
   1206 
   1207  iny ;& the one to right
   1208  jsr redsqr
   1209 
   1210  tya
   1211  sec
   1212  sbc #10
   1213  tay ;& the one to u.r.
   1214  jsr redsqr
   1215 
   1216  dey ;& the one above
   1217  jsr redsqr
   1218 
   1219 ]rts rts
   1220 
   1221 *-------------------------------
   1222 redsqr cpy #30
   1223  bcs ]rts
   1224 
   1225  lda #2
   1226  sta redbuf,y
   1227  sta wipebuf,y
   1228  sta fredbuf,y
   1229 
   1230  lda #63 ;block height
   1231  sta whitebuf,y
   1232 
   1233  rts
   1234 
   1235 *-------------------------------
   1236 *
   1237 *  R E Q  C H E K
   1238 *
   1239 *  In:  A = id # of object currently occupying this space
   1240 *       propose = id # of object we'd like to put here
   1241 *
   1242 *-------------------------------
   1243 reqchek and #reqmask
   1244  bne :requird
   1245  lda propose ;carte blanche
   1246  rts
   1247 
   1248 :requird lda propose
   1249  bne :ok
   1250  lda #1 ;no--make it a floorboard instead
   1251 :ok ora #reqmask ;and mark it
   1252  rts
   1253 
   1254 *-------------------------------
   1255 getnext lda size
   1256  cmp #5
   1257  bcs tall
   1258 
   1259 :wide inc POINTX
   1260  lda POINTX
   1261  cmp #10
   1262  bcs cutrt
   1263  rts
   1264 
   1265 getabove
   1266 tall dec POINTY
   1267  bmi cutup
   1268  rts
   1269 
   1270 *-------------------------------
   1271 getscrn jsr getscrn1
   1272  sta SCRNUM
   1273  rts
   1274 
   1275 getscrn1 lda MATX
   1276  bmi :1
   1277  cmp #31
   1278  bcs :1
   1279  lda MATY
   1280  bmi :1
   1281  cmp #31
   1282  bcs :1 ;off edge?
   1283  jsr calcmat1
   1284  ldy #0
   1285  lda (MATPTR),y
   1286  rts
   1287 :1 lda #0
   1288  rts
   1289 
   1290 cutleft lda POINTX
   1291  clc
   1292  adc #10
   1293  sta POINTX
   1294  dec MATX
   1295  jmp getscrn
   1296 
   1297 cutdown lda POINTY
   1298  sec
   1299  sbc #3
   1300  sta POINTY
   1301  inc MATY
   1302  jmp getscrn
   1303 
   1304 cutrt lda #0
   1305  sta POINTX
   1306  inc MATX
   1307  jmp getscrn
   1308 
   1309 cutup lda #2
   1310  sta POINTY
   1311  dec MATY
   1312  jmp getscrn
   1313 
   1314 *-------------------------------
   1315 * set kid starting block
   1316 
   1317 setstart
   1318  lda KidStartScrn
   1319  cmp SCRNUM ;this screen?
   1320  bne :cont
   1321 
   1322  ldy KidStartBlock
   1323  jsr addsqr1 ;for redraw
   1324 :cont
   1325  jsr GET
   1326  cpy KidStartBlock ;kid already here?
   1327  bne :1 ;no
   1328 ;yes--toggle face
   1329  lda KidStartFace
   1330  eor #$ff
   1331  sta KidStartFace
   1332  jmp :2
   1333 
   1334 :1 lda #-1
   1335  sta KidStartFace
   1336 
   1337  sty KidStartBlock
   1338 
   1339  lda SCRNUM
   1340  sta KidStartScrn
   1341 
   1342 :2 jmp addsqr1 ;& redraw this block
   1343 
   1344 *-------------------------------
   1345 * set guard starting block
   1346 * repeat clicks change guard position & delete guard
   1347 
   1348 setguard
   1349  ldx SCRNUM
   1350  lda GdStartBlock-1,x ;previous starting posn for this scrn
   1351  cmp #30
   1352  bcs :cont ;none
   1353 
   1354  tay
   1355  jsr addsqr1 ;redraw this square too
   1356 
   1357 :cont
   1358  jsr GET
   1359  tya
   1360 
   1361  ldx SCRNUM
   1362  cmp GdStartBlock-1,x
   1363  bne :1
   1364 
   1365  lda GdStartFace-1,x
   1366  bmi :3
   1367 ;3rd press--delete guard
   1368  lda #30 ;o.s.
   1369  bne :4
   1370 
   1371 :3 eor #$ff
   1372  sta GdStartFace-1,x
   1373  jmp :2
   1374 
   1375 :1 lda #-1
   1376  sta GdStartFace-1,x
   1377 
   1378  tya
   1379 :4 sta GdStartBlock-1,x
   1380 
   1381 :2 jmp addsqr1 ;& redraw this block
   1382 
   1383 *-------------------------------
   1384 *
   1385 * P U T
   1386 *
   1387 * Put down a copy of the piece you're holding
   1388 * (If this space already contains a piece identical to the one
   1389 * you're holding, then instead of placing it, remove it)
   1390 *
   1391 * Complication: if object partially overlaps a large-sized
   1392 * object, we have to delete the whole object, not just those
   1393 * portions overlapped by the new one.
   1394 *
   1395 * Also, if object is potentially linkable, assign it a
   1396 * link table index; if deleting or replacing a linkable
   1397 * object, remove its existing link table entry
   1398 *
   1399 *-------------------------------
   1400 SaveSpec ds 1
   1401 
   1402 PUT
   1403  lda heldspec
   1404  sta SaveSpec
   1405 
   1406  lda special
   1407  cmp #sstartkid
   1408  bne :1
   1409 
   1410  jsr setstart ;set starting block
   1411  jmp Cont1
   1412 
   1413 :1 cmp #sstartguard
   1414  bne :2
   1415 
   1416  jsr setguard
   1417  jmp Cont1
   1418 
   1419 :2
   1420  lda #$ff
   1421  sta andwhat ;ff if placing, 00 if removing
   1422 
   1423  jsr GET
   1424  and #idmask
   1425  sta existobj ;existing objid
   1426  lda (BlueSpec),y
   1427  sta existspec ;existing spec
   1428 
   1429  lda HELD
   1430  sta objid
   1431 
   1432  cmp #panelwof
   1433  beq SpPanel ;special handling for panels
   1434 
   1435  do DunjDisk
   1436  else
   1437  cmp #block
   1438  beq SpBlock ;& blocks
   1439  fin
   1440 
   1441  cmp #floor
   1442  bne :11
   1443  jmp SpFloor ;& for floorpieces placed on panels
   1444 :11
   1445  cmp #gate
   1446  bne :12
   1447  jmp SpGate ;& for gates
   1448 :12
   1449  cmp #flask
   1450  bne :10
   1451  jmp SpFlask ;& for flasks
   1452 :10
   1453  cmp #space
   1454  bne :15
   1455  jmp SpSpace ;& for back panels
   1456 
   1457 :15 cmp #exit
   1458  bne :16
   1459  jmp SpExit
   1460 :16
   1461 
   1462 * Everything else: just place or remove
   1463 
   1464 Continue lda existobj
   1465  cmp objid
   1466  bne Place
   1467 
   1468 ]remove lda #0
   1469  sta andwhat
   1470 
   1471 Place jsr clearmat ;update matrix (and keep track of which
   1472   ;squares will need to be redrawn)
   1473  cpx #-1
   1474  beq Cont1 ;can't do it
   1475 
   1476  jsr placemat
   1477 
   1478  jsr assignlink
   1479 
   1480 Cont1 lda SaveSpec
   1481  sta heldspec
   1482 
   1483  jmp UpdateBG
   1484 
   1485 *-------------------------------
   1486 * Placing gate on gate?
   1487 
   1488 SpGate
   1489  lda existobj
   1490  cmp #gate
   1491  bne Continue
   1492 ;Yes--just change state
   1493  lda existspec
   1494  eor #3 ;toggle 1/2
   1495 ;(Preserve existing links)
   1496  sta (BlueSpec),y
   1497 
   1498  jsr addsqr1
   1499 ]cont1 jmp Cont1
   1500 ]cont jmp Continue
   1501 ]place jmp Place
   1502 *-------------------------------
   1503 *  Placing a block
   1504 
   1505 SpBlock
   1506  lda existobj
   1507  cmp #block
   1508  bne ]cont
   1509 
   1510  lda existspec ;existing pattern
   1511  bne ]remove
   1512  lda #1
   1513  sta heldspec
   1514  bne ]place
   1515 
   1516 *-------------------------------
   1517 *  Placing a panel
   1518 
   1519 SpPanel
   1520  lda existobj
   1521  cmp #panelwof
   1522  beq :ispanel
   1523  cmp #panelwif
   1524  beq :ispanel
   1525 
   1526 * put panel on top of something else
   1527 
   1528  cmp #floor
   1529  bne ]place ;panelwof
   1530 
   1531  lda #panelwif
   1532  sta objid
   1533  bne ]place ;panelwif
   1534 
   1535 * put panel on top of panel
   1536 
   1537 :ispanel lda heldspec ;desired pattern
   1538  cmp existspec ;existing pattern
   1539  beq :rempanel
   1540 
   1541 * change only pattern
   1542 
   1543  lda existobj
   1544  sta objid
   1545  bne ]place
   1546 
   1547 * remove panel
   1548 
   1549 :rempanel lda existobj
   1550  cmp #panelwof
   1551  beq ]remove
   1552 
   1553  lda #floor
   1554  sta objid
   1555  bne ]place ;but leave floorpiece
   1556 
   1557 * putting floor on top of panel
   1558 
   1559 SpFloor
   1560  lda existobj
   1561  cmp #panelwof
   1562  beq :addfloor
   1563  cmp #panelwif
   1564  beq :remfloor
   1565 
   1566  bne ]cont ;continue as usual
   1567 
   1568 :addfloor lda #panelwif
   1569  sta objid
   1570  lda existspec
   1571  sta heldspec
   1572  jmp ]place
   1573 
   1574 :remfloor lda #panelwof
   1575  sta objid
   1576  lda existspec
   1577  sta heldspec
   1578  jmp ]place
   1579 
   1580 *-------------------------------
   1581 * Placing a flask
   1582 
   1583 SpFlask
   1584  lda existobj
   1585  cmp #flask
   1586  beq :y
   1587 
   1588  lda #0
   1589  sta existspec
   1590  jmp ]cont
   1591 :y ;Yes--just change state
   1592  lda existspec
   1593  clc
   1594  adc #1
   1595 
   1596  cmp #8
   1597  bcc :07
   1598  lda #0
   1599 
   1600 :07 sta (BlueSpec),y
   1601 
   1602  lda #1
   1603  sta blackflag ;redraw entire screen
   1604 
   1605  jmp ]cont1
   1606 
   1607 ]cont jmp Continue
   1608 ]place jmp Place
   1609 *-------------------------------
   1610 * Placing a back wall pattern on space or floor
   1611 
   1612 SpSpace
   1613  lda existobj
   1614  cmp #space
   1615  beq :1
   1616  cmp #floor
   1617  bne ]cont
   1618 :1
   1619  ldx heldspec ;desired pattern
   1620  beq ]cont
   1621  sta objid
   1622  cpx existspec ;existing pattern
   1623  bne ]place ;add pattern
   1624  lda #0
   1625  sta heldspec
   1626  beq ]place ;remove pattern
   1627 
   1628 *-------------------------------
   1629 * Exit on exit-->window
   1630 
   1631 SpExit
   1632  lda existobj
   1633  cmp #exit
   1634  bne ]cont
   1635  lda #window
   1636  sta objid
   1637  bne ]cont
   1638 
   1639 *-------------------------------
   1640 *
   1641 * U P D A T E   B G
   1642 *
   1643 * We've added or deleted or changed an object --
   1644 * redraw as much of the screen as we have to
   1645 *
   1646 *-------------------------------
   1647 UpdateBG
   1648  lda blackflag
   1649  beq :1
   1650 
   1651  lda #0
   1652  sta blackflag
   1653 ;if blackflag set,
   1654  jmp DoCut2 ;redraw entire scrn
   1655 
   1656 :1
   1657  jsr sngpeel ;peel off cursor
   1658  jsr zeropeel
   1659  jsr upscrn ;update screen squares listed in table
   1660 
   1661  jsr pageflip
   1662 
   1663  jsr sngpeel
   1664  jsr zeropeel
   1665  jsr upscrn ;other page too
   1666 
   1667  jsr PMOVE
   1668  jmp PMOVE ;put cursor back on both scrns
   1669 
   1670 *-------------------------------
   1671 upscrn jsr fast
   1672  jsr drawall
   1673 
   1674  jsr zerolsts
   1675 
   1676  jsr specialsyms ;add special symbols
   1677 
   1678  jmp edges ;add edge arrows
   1679 
   1680 *-------------------------------
   1681 *
   1682 *  A S S I G N   L I N K   I N D E X
   1683 *
   1684 * In: objid
   1685 *     Results of GET
   1686 * Out: X = link index
   1687 *
   1688 * Link table setup is different in editor than in game.
   1689 * Each controller (e.g. pressplate) and each gadget
   1690 * (e.g. portcullis) gets 4 bytes in link tables:
   1691 *
   1692 * L1 ... bLINK1,x     (where x=link index, 0-127)
   1693 * L2 ... bLINK2,x
   1694 * L3 ... bLINK3,x
   1695 * L4 ... bLINK4,x
   1696 *
   1697 * 21 bits of L1-L3 indicate whether each of the 21
   1698 * symbols is on or off (0=off) for this piece.
   1699 * Bit 7 of L4 indicates whether this link index has been
   1700 * assigned (0=free).
   1701 * Bits 1-6 of L4, and bit 7 of L1,L2 & L3, are unused for now.
   1702 *
   1703 *-------------------------------
   1704 assignlink
   1705 
   1706 * First delete existing link index for this space (if any)
   1707 
   1708  jsr GET
   1709  jsr deletelink
   1710 
   1711 * Then create new link if appropriate
   1712 
   1713  sty ysave
   1714 
   1715  lda objid
   1716  and andwhat
   1717  tax
   1718  lda linkable,x ;in eddata
   1719  beq :rts ;object unlinkable
   1720 
   1721 * Search thru link table to find first empty space
   1722 
   1723  ldx #0
   1724 :loop lda bLINK4,x
   1725  bpl :gotit
   1726  inx
   1727  bpl :loop
   1728 
   1729 * x=128 -- link table full
   1730 
   1731  jmp gtone
   1732 
   1733 :gotit lda bLINK4,x
   1734  ora #$80 ;set L4 hibit
   1735  sta bLINK4,x
   1736 
   1737  lda #0
   1738  sta bLINK1,x
   1739  sta bLINK2,x
   1740  sta bLINK3,x ;zero L1-3
   1741 
   1742  txa
   1743  ldy ysave
   1744  sta (bLinkIndex),y ;link index
   1745 
   1746 * Link complete
   1747 
   1748 :rts rts
   1749 
   1750 *-------------------------------
   1751 *
   1752 *  D E L E T E   L I N K
   1753 *
   1754 *-------------------------------
   1755 deletelink
   1756  lda (bLinkIndex),y
   1757  bmi :rts ;unlinked
   1758 
   1759  tax ;link index
   1760 
   1761  lda #$7f
   1762  and bLINK4,x ;clear hibit of bLINK4
   1763  sta bLINK4,x ;to clear entry in linktable
   1764 
   1765  lda #$ff
   1766  sta (bLinkIndex),y ;and unlink object
   1767 
   1768 :rts rts
   1769 
   1770 *-------------------------------
   1771 *
   1772 *  C L E A R   B L O C K
   1773 *
   1774 *  In: SCRNUM
   1775 *
   1776 *-------------------------------
   1777 CLRBLOCK lda SCRNUM
   1778  jsr bcalcblue ;get bLinkIndex too (bBLUESPEC)
   1779 
   1780  LDY #29
   1781 
   1782 :1 lda #0 ;initialize 30 spaces
   1783  sta (BlueType),Y ;with linkless blanks
   1784 
   1785  lda #$ff
   1786  sta (bLinkIndex),y
   1787  sta (BlueSpec),y
   1788 
   1789  DEY
   1790  BPL :1
   1791 
   1792 * clr guard start posn
   1793 
   1794  ldx SCRNUM
   1795  lda #30
   1796  sta GdStartBlock-1,x
   1797  lda #1
   1798  sta GdStartProg-1,x
   1799 
   1800 ]rts RTS
   1801 
   1802 *-------------------------------
   1803 * Set guard program #
   1804 * In: A = prog # (0-9)
   1805 
   1806 setguardprog
   1807  ldx SCRNUM
   1808  sta GdStartProg-1,x
   1809  lda #1
   1810  sta blackflag ;redraw entire scrn
   1811  jmp UpdateBG
   1812 
   1813 *-------------------------------
   1814 *
   1815 *  M O V E   L / R / U / D
   1816 *
   1817 * Move from one screen to another
   1818 *
   1819 *-------------------------------
   1820 MLEFT lda inmenu
   1821  bne :1
   1822  jsr mleft
   1823  jmp CUT
   1824 :1 rts
   1825 
   1826 MRIGHT lda inmenu
   1827  bne :1
   1828  jsr mright
   1829  jmp CUT
   1830 :1 rts
   1831 
   1832 MUP lda inmenu
   1833  bne :1
   1834  jmp mup
   1835 :1 jmp menuup
   1836 
   1837 MDOWN lda inmenu
   1838  bne :1
   1839  jmp mdown
   1840 :1 jmp menudown
   1841 
   1842 *-------------------------------
   1843 menuup lda SCRNUM
   1844  sec
   1845  sbc #1
   1846  sta nextscrn
   1847  rts
   1848 
   1849 menudown lda SCRNUM
   1850  clc
   1851  adc #1
   1852  sta nextscrn
   1853  rts
   1854 
   1855 *-------------------------------
   1856 *
   1857 * M E N U
   1858 *
   1859 * Cut to menu screen
   1860 *
   1861 *-------------------------------
   1862 MENU lda #1
   1863  sta inmenu
   1864  lda #0
   1865  sta linkmode
   1866 
   1867  jsr switchem
   1868 
   1869  lda SCRNUM
   1870  sta nextscrn
   1871 
   1872  jsr bcalcblue
   1873 
   1874  jmp CutToMenu
   1875 
   1876 *-------------------------------
   1877 switchem ldx savescrn
   1878  lda SCRNUM
   1879  sta savescrn
   1880  stx SCRNUM
   1881 
   1882  ldx savepx
   1883  lda POINTX
   1884  sta savepx
   1885  stx POINTX
   1886 
   1887  ldx savepy
   1888  lda POINTY
   1889  sta savepy
   1890  stx POINTY
   1891 
   1892  rts
   1893 
   1894 *-------------------------------
   1895 *
   1896 * L E A V E M
   1897 *
   1898 * Leave menu
   1899 * (pass object id# in HELD)
   1900 *
   1901 *-------------------------------
   1902 leavem jsr switchem
   1903 
   1904  lda #0
   1905  sta inmenu
   1906  rts
   1907 
   1908 *-------------------------------
   1909 *
   1910 * E X I T
   1911 *
   1912 * Back to builder (make sure we're out of menu first)
   1913 *
   1914 *-------------------------------
   1915 EXIT lda inmenu
   1916  beq :1
   1917  jsr leavem
   1918 
   1919 :1 jmp rtnbuild
   1920 
   1921 *-------------------------------
   1922 *
   1923 *  E D G E S
   1924 *
   1925 *-------------------------------
   1926 edges
   1927  lda inmenu
   1928  bne :rts
   1929 
   1930  lda SCRNUM
   1931  sta number
   1932  jsr prscrnum ;print screen # at u.l.
   1933 
   1934  ldx SCRNUM
   1935  lda GdStartBlock-1,x
   1936  cmp #30
   1937  bcs :99 ;no guard on this screen
   1938  lda GdStartProg-1,x
   1939  cmp #10
   1940  bcc :ok ;correct screens created w/earlier versions
   1941  lda #1 ;of editor--default to 1
   1942  sta GdStartProg-1,x
   1943 :ok sta number
   1944  jsr prgdprog ;print guard prog # in l.l.
   1945 
   1946 :99 lda SCRNUM
   1947  jsr getneighs
   1948 
   1949  lda scrnRight
   1950  beq :1
   1951  jsr rtedge
   1952 
   1953 :1 lda scrnLeft
   1954  beq :2
   1955  jsr leftedge
   1956 
   1957 :2 lda scrnBelow
   1958  beq :3
   1959  jsr botedge
   1960 
   1961 :3 lda scrnAbove
   1962  beq :4
   1963  jsr topedge
   1964 :4
   1965 
   1966 :rts
   1967 ]rts rts
   1968 
   1969 *-------------------------------
   1970 *
   1971 * S P E C I A L   S Y M S
   1972 *
   1973 * Add special symbols (kid, guard, etc.)
   1974 * not covered by FRAMEADV
   1975 *
   1976 *-------------------------------
   1977 specialsyms
   1978  jsr AddKid
   1979  jsr AddGuard
   1980  rts
   1981 
   1982 *-------------------------------
   1983 AddKid
   1984  lda KidStartScrn
   1985  cmp SCRNUM ;this screen?
   1986  bne ]rts
   1987 
   1988  lda KidStartBlock
   1989  jsr getxy
   1990 
   1991  lda KidStartFace
   1992  eor #$ff
   1993  sta OPACITY
   1994 
   1995  ldx #sstartkid
   1996  jmp drawmenusym
   1997 
   1998 AddGuard
   1999  ldx SCRNUM
   2000  lda GdStartBlock-1,x
   2001  cmp #30
   2002  bcs ]rts
   2003 
   2004  jsr getxy
   2005 
   2006  ldx SCRNUM
   2007  lda GdStartFace-1,x
   2008  eor #$ff
   2009  sta OPACITY
   2010 
   2011  ldx #sstartguard
   2012  jmp drawmenusym
   2013 
   2014 *-------------------------------
   2015 * In: A = block # (0-29)
   2016 * Out: XCO, YCO
   2017 
   2018 getxy
   2019  jsr unindex
   2020 
   2021  asl
   2022  asl
   2023  sta XCO
   2024 
   2025  lda BlockBot+1,x
   2026  sta YCO
   2027  rts
   2028 
   2029 *-------------------------------
   2030 *
   2031 * C H A N G E   L I N K S
   2032 *
   2033 *-------------------------------
   2034 chglinks
   2035  jsr GET
   2036  and #idmask
   2037  sta objid
   2038  lda (bLinkIndex),y
   2039  ;sta objspec
   2040  bmi :skipit ;unlinkable object
   2041  sta linkindex
   2042 
   2043  jmp bethmode
   2044 
   2045 :skipit rts
   2046 
   2047 *-------------------------------
   2048 *
   2049 *  B E T H   M O D E
   2050 *
   2051 * Within the selected block:
   2052 *  Jstk moves blinking square (Beth) U-D, L-R
   2053 *  btn 0 adds/removes symbol
   2054 *  btn 1 exits link change mode
   2055 *
   2056 *-------------------------------
   2057 bethmode
   2058  jsr initbeth ;start in l.r
   2059 
   2060 :input lda $c000
   2061  sta keypress
   2062  bpl :nokey
   2063 
   2064  jsr edkeys ;always!
   2065 
   2066 :nokey lda joyon
   2067  beq :k
   2068 
   2069 :j jsr bethjoy
   2070  jsr blinkbeth
   2071 
   2072  lda BUTT1
   2073  bpl :input
   2074  bmi exitbeth ;exit link change mode
   2075 
   2076 :k jsr bethkbd
   2077 
   2078  lda BUTT1
   2079  bpl :input
   2080  bmi exitbeth ;exit link change mode
   2081 
   2082 *-------------------------------
   2083 exitbeth jsr sngpeel
   2084  jsr pageflip
   2085  jsr sngpeel ;take off beth
   2086 
   2087  jsr zeropeels
   2088 
   2089  jsr PMOVE
   2090  jmp PMOVE ;put cursor back
   2091 
   2092 *-------------------------------
   2093 initbeth
   2094  lda #0 ;start in l.r.
   2095  sta bethx ;0-2
   2096  sta bethy ;0-6
   2097  lda #1
   2098  sta bethstatus ;on
   2099  sta antcount
   2100  rts
   2101 
   2102 *-------------------------------
   2103 blinkbeth
   2104  dec antcount
   2105  bne :ant1
   2106 
   2107  lda #bjspeed
   2108  sta antcount
   2109 
   2110  lda bethstatus
   2111  eor #1
   2112  sta bethstatus ;1/0
   2113 
   2114  jmp movebeth
   2115 :ant1 rts
   2116 
   2117 *-------------------------------
   2118 bethkbd ;someday
   2119 
   2120 *-------------------------------
   2121 bethjoy jsr controller
   2122  jsr buttons
   2123  jsr getselect
   2124 
   2125  lda JSTKX
   2126  bpl :1
   2127 
   2128  lda #1
   2129  cmp jlast
   2130  bne :jleft
   2131 
   2132  lda jcount
   2133  beq :jleft1
   2134  dec jcount
   2135  rts
   2136 
   2137 :jleft jsr bmove
   2138  jmp bethl
   2139 
   2140 :jleft1 jsr jrepeat
   2141  jmp bethl
   2142 
   2143 *-------------------------------
   2144 :1 beq :2
   2145 
   2146  lda #2
   2147  cmp jlast
   2148  bne :jright
   2149 
   2150  lda jcount
   2151  beq :jright1
   2152  dec jcount
   2153  rts
   2154 
   2155 :jright jsr bmove
   2156  jmp bethr
   2157 
   2158 :jright1 jsr jrepeat
   2159  jmp bethr
   2160 
   2161 *-------------------------------
   2162 :2 lda JSTKY
   2163  bpl :3
   2164 
   2165  lda #3
   2166  cmp jlast
   2167  bne :jup
   2168 
   2169  lda jcount
   2170  beq :jup1
   2171  dec jcount
   2172  rts
   2173 
   2174 :jup jsr bmove
   2175  jmp bethu
   2176 
   2177 :jup1 jsr jrepeat
   2178  jmp bethu
   2179 
   2180 *-------------------------------
   2181 :3 beq :nomove
   2182 
   2183  lda #4
   2184  cmp jlast
   2185  bne :jdown
   2186 
   2187  lda jcount
   2188  beq :jdown1
   2189  dec jcount
   2190  rts
   2191 
   2192 :jdown jsr bmove
   2193  jmp bethd
   2194 
   2195 :jdown1 jsr jrepeat
   2196  jmp bethd
   2197 
   2198 *-------------------------------
   2199 :nomove lda #0
   2200  sta jlast
   2201 
   2202  lda BUTT0
   2203  bmi bethbtn0
   2204 
   2205  rts
   2206 
   2207 *-------------------------------
   2208 * Turn this symbol on/off
   2209 
   2210 bethbtn0
   2211  jsr togglebit
   2212 
   2213  ldy POINTY
   2214  lda POINTX
   2215  clc
   2216  adc Mult10,y
   2217  tay ;block index
   2218  jsr redsqr
   2219 
   2220  lda SCRNUM
   2221  jsr bcalcblue
   2222 
   2223  lda (bLinkIndex),y
   2224  sta objspec
   2225 
   2226 * update both scrns
   2227 
   2228  jsr sngpeel ;peel off cursor
   2229  jsr zeropeel
   2230  jsr upscrn ;update screen squares listed in table
   2231 
   2232  jsr redrawbeth
   2233 
   2234  jsr pageflip
   2235 
   2236  jsr sngpeel
   2237  jsr zeropeel
   2238  jsr upscrn ;other page too
   2239 
   2240  jsr redrawbeth
   2241 
   2242 * put back beth cursor
   2243 
   2244  jsr movebeth
   2245  jmp movebeth
   2246 
   2247 *-------------------------------
   2248 togglebit
   2249  ldx bethy
   2250  lda bethbits,x ;bitmask--changing bit = 1, others 0
   2251  ldx linkindex
   2252 
   2253  ldy bethx
   2254  beq :L1
   2255  cpy #1
   2256  beq :L2
   2257 
   2258 :L3 eor bLINK3,x
   2259  sta bLINK3,x
   2260  rts
   2261 
   2262 :L1 eor bLINK1,x
   2263  sta bLINK1,x
   2264  rts
   2265 
   2266 :L2 eor bLINK2,x
   2267  sta bLINK2,x
   2268 :rts rts
   2269 
   2270 *-------------------------------
   2271 * beth l,r,u,d
   2272 
   2273 bethl lda bethx
   2274  beq :rts
   2275  dec bethx
   2276 
   2277 :rts jmp movebeth
   2278 
   2279 bethr lda bethx
   2280  cmp #2
   2281  bcs :rts
   2282  inc bethx
   2283 
   2284 :rts jmp movebeth
   2285 
   2286 bethu lda bethy
   2287  cmp #6
   2288  bcs :rts
   2289  inc bethy
   2290 :rts jmp movebeth
   2291 
   2292 bethd lda bethy
   2293  beq :rts
   2294  dec bethy
   2295 :rts jmp movebeth
   2296 
   2297 *-------------------------------
   2298 movebeth
   2299  jsr sngpeel ;peel off old beth
   2300  jsr zeropeel
   2301 
   2302  lda POINTX
   2303  asl
   2304  asl
   2305  ldx bethx
   2306  clc
   2307  adc bethxco,x
   2308  sta XCO
   2309 
   2310  lda bethoffset,x
   2311  sta OFFSET
   2312 
   2313  ldx POINTY
   2314  lda BlockBot+1,x
   2315  ldx bethy
   2316  sec
   2317  sbc bethyco,x
   2318  sta YCO
   2319 
   2320  lda bethstatus
   2321  beq :bethoff
   2322 
   2323 * Beth on: draw symbol normal or inverse depending
   2324 * on what's underneath
   2325 
   2326  jsr getbit
   2327  beq :norm
   2328 
   2329 :inv jsr invbethsym
   2330  jmp pageflip
   2331 
   2332 :norm jsr drawbethsym
   2333 
   2334 * Beth off: invisible
   2335 
   2336 :bethoff jmp pageflip
   2337 
   2338 *-------------------------------
   2339 * Get bit -- 0 or nonzero
   2340 
   2341 getbit ldx bethy
   2342  lda bethbits,x
   2343  ldx linkindex
   2344  ldy bethx
   2345  beq :L1
   2346  dey
   2347  beq :L2
   2348 :L3 and bLINK3,x
   2349  rts
   2350 :L1 and bLINK1,x
   2351  rts
   2352 :L2 and bLINK2,x
   2353  rts
   2354 
   2355 *-------------------------------
   2356 seted
   2357  jsr zerocrop
   2358 
   2359  lda #edtable
   2360  sta TABLE
   2361  lda #>edtable
   2362  sta TABLE+1
   2363  rts
   2364 
   2365 *-------------------------------
   2366 zerocrop
   2367  lda #0
   2368  sta TOPCUT
   2369  sta LEFTCUT
   2370 
   2371  lda #40
   2372  sta RIGHTCUT
   2373  rts
   2374 
   2375 *-------------------------------
   2376 *
   2377 *  R E D R A W   B E T H
   2378 *
   2379 * In: POINTY (0-2)
   2380 *     POINTX (0-9)
   2381 *     objspec
   2382 *
   2383 *-------------------------------
   2384 redrawbeth
   2385  lda bethx
   2386  pha
   2387  lda bethy
   2388  pha
   2389 
   2390  lda POINTX
   2391  asl
   2392  asl
   2393  sta XCO
   2394 
   2395  lda #0
   2396  sta OFFSET
   2397 
   2398  lda POINTY
   2399  tay
   2400  lda BlockBot+1,y
   2401  sta loy
   2402 
   2403  jsr drawallsymb
   2404 
   2405 :done pla
   2406  sta bethy
   2407  pla
   2408  sta bethx
   2409 
   2410  rts
   2411 
   2412 *-------------------------------
   2413 *
   2414 *  R E L I N K
   2415 *
   2416 *  Emergency measure should link data get messed up
   2417 *  Erases all links
   2418 *
   2419 *-------------------------------
   2420 RELINK
   2421 ; jsr showpage
   2422 
   2423 * Step 1: clear link tables
   2424 
   2425  jsr clrlinks
   2426 
   2427 * Step 2: go through every object in every screen
   2428 * and assign a new link index to every linkable object
   2429 
   2430  lda #0 ;running counter (points to
   2431  sta linkindex ;first available link index)
   2432 
   2433  lda SCRNUM
   2434  pha
   2435 
   2436  lda NUMNEXT
   2437  sec
   2438  sbc #1
   2439  sta SCRNUM
   2440 
   2441 :loop jsr RelinkScrn ;do a screen
   2442 
   2443  dec SCRNUM
   2444  bne :loop
   2445 
   2446  pla
   2447  sta SCRNUM
   2448  rts
   2449 
   2450 *-------------------------------
   2451 RelinkScrn
   2452  lda SCRNUM
   2453  jsr bcalcblue
   2454 
   2455  ldy #29
   2456 
   2457 :loop lda (BlueType),y
   2458  and #idmask ;objid
   2459  tax
   2460  lda linkable,x ;in eddata
   2461  beq :nolink ;object unlinkable
   2462 
   2463  lda linkindex
   2464  bmi :nolink ;only space for 128 links
   2465 
   2466  sta (bLinkIndex),y ;link index
   2467  tax
   2468 
   2469  lda #$80 ;set hibit
   2470  sta bLINK4,x ;of bLINK4
   2471 
   2472  inc linkindex
   2473  bne :next
   2474 
   2475 :nolink lda #$ff ;no link
   2476  sta (bLinkIndex),y
   2477 :next
   2478  dey
   2479  bpl :loop
   2480 
   2481 ]rts rts
   2482 
   2483 *-------------------------------
   2484  lst
   2485 eof ds 1
   2486  usr $a9,25,$0000,*-org
   2487  lst off