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

DIALOGER.S (26352B)


      1 * ed/dialoger
      2 org = $6000
      3  lst off
      4 *-------------------------------
      5 *
      6 *  D I A L O G E R
      7 *
      8 *-------------------------------
      9  org org
     10 
     11  jmp PRINT
     12  jmp DIALOG
     13  jmp SETMASTERDISK
     14  jmp SETDATADISK
     15  jmp READDISK
     16 
     17  jmp DLOADLEVEL
     18  jmp DSAVELEVEL
     19  jmp INITGETLNBUF
     20  jmp DSAVELEVELG
     21  jmp SETGAMEDISK1
     22  jmp SETGAMEDISK2
     23 
     24 *-------------------------------
     25 getlnbuf ds $10
     26 filelist ds $20
     27 
     28 *-------------------------------
     29  put eq
     30  put buildereq
     31 
     32  dum locals
     33 
     34 savechr ds 3
     35 numfiles ds 1
     36 listptr ds 1
     37 
     38  dend
     39 
     40 *-------------------------------
     41 *
     42 * DIRECTORY FORMAT:
     43 *
     44 * $200 bytes: 32 fields, 16 bytes each
     45 *
     46 * diroffset,x is directory offset for field #x (0-21)
     47 *
     48 * Fields #0-29 (max 30 files):
     49 *   Bytes 0-11: file name (12 chars max)
     50 *   Byte 12: blueprint track #
     51 *   Byte 13: blueprint region (0-1)
     52 *   Byte 14: binfo track #
     53 *   Byte 15: binfo region (0-2)
     54 *
     55 * Field #30:
     56 *   Bytes 0-11: disk title
     57 *
     58 * Field #31:
     59 *   Byte 0: disk ID
     60 *
     61 *-------------------------------
     62 dirofflo hex 00,10,20,30,40,50,60,70,80,90,a0,b0,c0,d0,e0,f0
     63  hex 00,10,20,30,40,50,60,70,80,90,a0,b0,c0,d0,e0,f0
     64 
     65 diroffhi hex 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00
     66  hex 01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01
     67 
     68 maxfilesDD = 30 ;max # of files on data disk
     69 maxfilesMD = 6 ;& on master disk
     70 maxfilesGD1 = 4 ;& on game disk side 1
     71 maxfilesGD2 = 20 ;& on game disk side 2
     72 
     73 fieldleng = 16
     74 fnameleng = 12
     75 
     76 titlefield = 30
     77 idfield = 31
     78 
     79 *-------------------------------
     80 * RW18 ID bytes (intrinsic to disk)
     81 
     82 IDside1 = $a9 ;game disk side 1
     83 IDside2 = $ad ;game disk side 2
     84 
     85 * $f5-f6 also available
     86 
     87 * NOTE--master & data disks use $a9 (for now)
     88 
     89 *-------------------------------
     90 * Builder ID bytes (stored as 31st byte of directory track)
     91 
     92 gamedisk1id = $77
     93 gamedisk2id = $99
     94 
     95 datadiskid = $dd
     96 masterdiskid = $11
     97 
     98 *-------------------------------
     99 *
    100 * DISK FORMAT:
    101 *
    102 * Directory on track 34 ($200 bytes)
    103 *
    104 * Master disk stores 6 levels as follows:
    105 *  BLUEPRINT ($900 bytes) on tracks 30-33 (2 levels/track)
    106 *  BINFO ($600 bytes) on tracks 29-30 (3 levels/track)
    107 *
    108 * Data disk follows same pattern, repeated 5 times,
    109 * to make space for 30 levels on 25 tracks.
    110 *
    111 * Game disk stores only BLUEPRINT, 2 levels/track:
    112 *  Side 1: 4 levels on tracks 32-33
    113 *  Side 2: 20 levels on tracks 24-33
    114 *
    115 *-------------------------------
    116 * Blueprint & binfo TRACK & REGION indexed by level # (0-n)
    117 
    118 * game disk
    119 
    120 gameTRKlst
    121  db 33,33,32,32,31,31
    122  db 30,30,29,29,28,28
    123  db 27,27,26,26,25,25
    124  db 24,24
    125 
    126 gameREGlst
    127 
    128 * master & data disk
    129 
    130 bluepREGlst
    131  db 0,1,0,1,0,1
    132  db 0,1,0,1,0,1
    133  db 0,1,0,1,0,1
    134  db 0,1,0,1,0,1
    135  db 0,1,0,1,0,1
    136 
    137 bluepTRKlst
    138  db 33,33,32,32,31,31
    139  db 28,28,27,27,26,26
    140  db 23,23,22,22,21,21
    141  db 18,18,17,17,16,16
    142  db 13,13,12,12,11,11
    143 
    144 binfoTRKlst
    145  db 30,30,30,29,29,29
    146  db 25,25,25,24,24,24
    147  db 20,20,20,19,19,19
    148  db 15,15,15,14,14,14
    149  db 10,10,10,9,9,9
    150 
    151 binfoREGlst
    152  db 0,1,2,0,1,2
    153  db 0,1,2,0,1,2
    154  db 0,1,2,0,1,2
    155  db 0,1,2,0,1,2
    156  db 0,1,2,0,1,2
    157 
    158 *-------------------------------
    159 kDELETE = $ff
    160 kESC = $9b
    161 
    162 *-------------------------------
    163 * Useful background colors:
    164 
    165 black = 0
    166 magenta = 1
    167 brown = 2
    168 dkgreen = 4
    169 dkblue = 8
    170 
    171 *-------------------------------
    172 *
    173 * Format for box data:
    174 *  Width (80)
    175 *  Height (192)
    176 *  Color (16)
    177 *  XCO (80)
    178 *  YCO (192)
    179 *
    180 *-------------------------------
    181 fnlength = 12 ;including <CR>... max = 16
    182 
    183 numnames = 5 ;# of names in box
    184 
    185 boxmarg = 5
    186 boxwid = 80-boxmarg-boxmarg
    187 boxrt = 79-boxmarg
    188 boxtop = 33
    189 topline = 36
    190 firstname = 49
    191 linespace = 10
    192 boxheight = 65
    193 boxbottom = boxtop+boxheight
    194 boxcolor = dkblue
    195 okx = 425
    196 oky = firstname+30
    197 
    198 fnwid = 52
    199 okwid = boxwid-fnwid
    200 okleft = boxmarg+fnwid
    201 
    202 msgline = 53
    203 
    204 fnamey db firstname,firstname+10,firstname+20
    205  db firstname+30,firstname+40
    206 
    207 loadbox db boxwid,boxheight-1,boxcolor,boxmarg,boxtop+1
    208 loadbord1 db boxwid,1,15,boxmarg,boxtop
    209 loadbord2 db boxwid,1,15,boxmarg,boxtop+13
    210 loadbord3 db boxwid,1,15,boxmarg,boxbottom
    211 loadbordL db 1,boxheight+1,$f0,boxmarg-1,boxtop
    212 loadbordM db 1,boxheight-14,$0f,okleft,boxtop+14
    213 loadbordR db 1,boxheight+1,$0f,boxrt+1,boxtop
    214 
    215 okfix db 1,11,$0f,okleft,oky
    216 
    217 msgbox db boxwid,boxheight-1,boxcolor,boxmarg,boxtop+1
    218 msgbord1 db boxwid,1,15,boxmarg,boxtop
    219 msgbord3 db boxwid,1,15,boxmarg,boxbottom
    220 msgbordL db 1,boxheight+1,$f0,boxmarg-1,boxtop
    221 msgbordM db 1,boxheight-1,$0f,okleft,boxtop+1
    222 msgbordR db 1,boxheight+1,$0f,boxrt+1,boxtop
    223 
    224 listwipe1 db 46,38,boxcolor,10,firstname+10
    225 listwipe2 db 46,38,boxcolor,10,firstname
    226 
    227 fnwipe db fnwid,11,black,5,firstname
    228 fnunwipe db fnwid,11,boxcolor,5,firstname
    229 
    230 okwipe db okwid,11,black,okleft,oky
    231 okunwipe db okwid,11,boxcolor,okleft,oky
    232 
    233 linewipe db 35,9,boxcolor,40,topline
    234 
    235 *-------------------------------
    236 loadwhat asc 'Load level named: ',8d
    237 savewhat asc 'Save level named: ',8d
    238 deletewhat asc 'Delete level named: ',8d
    239 okmsg asc 'OK',8d
    240 cancelmsg asc 'Cancel',8d
    241 askMD asc 'Put master disk in drive 1',8d
    242 askGD asc 'Put game disk in drive 1',8d
    243 askDD asc 'Put data disk in drive 1',8d
    244 createwarn asc 'WARNING!  Directory track',8d
    245 createwarn2 asc 'will be erased',8d
    246 
    247 *-------------------------------
    248 *
    249 * I N I T  G E T L N  B U F
    250 *
    251 *-------------------------------
    252 INITGETLNBUF
    253  lda #$8d ;RETURN
    254  sta getlnbuf
    255  rts
    256 
    257 *-------------------------------
    258 *
    259 *   P R I N T
    260 *
    261 *   Print a character & advance cursor
    262 *
    263 *   In:  charx (560), chary (192)
    264 *        A = ASCII value of character
    265 *   Out: new charx
    266 *
    267 *-------------------------------
    268 PRINT
    269 
    270 * convert ASCII to textset index
    271 * Text set covers ASCII 32-122
    272 
    273  and #$7f
    274  cmp #32
    275  bcc :braap
    276  cmp #123
    277  bcs :braap
    278 
    279  sec
    280  sbc #31
    281 
    282 * call dblhires print routine
    283 
    284  sta IMAGE
    285 
    286  lda chary
    287  sta YCO
    288  lda charx
    289  sta XCO
    290  lda charx+1
    291  sta OFFSET
    292  jsr cvtx
    293 
    294  jsr dodblprint
    295 
    296 * advance cursor
    297 
    298  ldx XCO
    299  lda Mult7,x
    300  clc
    301  adc OFFSET ;convert bits & bytes to 560-res
    302  clc
    303  adc #3 ;fudge factor
    304  clc
    305  adc charx
    306  sta charx
    307 
    308  lda #0
    309  adc charx+1
    310  sta charx+1
    311 
    312  lda #0 ;pl = "ok"
    313  rts
    314 
    315 :braap lda #$ff ;mi = "braap"
    316  rts
    317 *-------------------------------
    318 *
    319 * D I A L O G
    320 *
    321 * Dialog box # passed in accumulator:
    322 *  0 = PLAY LEVEL, 1 = LOAD LEVEL, 2 = SAVE LEVEL,
    323 *  3 = DELETE LEVEL, 4 = CLEAR LEVEL, 5 = CREATE DISK
    324 *
    325 * Steps:
    326 *  (1) Draw dialog box on hidden page
    327 *  (2) Page-flip to show dialog box
    328 *  (3) Have the dialog on visible page
    329 *  (4) Page-flip to hide dialog box
    330 *
    331 *-------------------------------
    332 DIALOG
    333  cmp #0
    334  bne :1
    335  jsr diaplay
    336  jmp return
    337 
    338 :1 cmp #1
    339  bne :2
    340  jsr diaload
    341  jmp return
    342 
    343 :2 cmp #2
    344  bne :3
    345  jsr diasave
    346  jmp return
    347 
    348 :3 cmp #3
    349  bne :4
    350  jsr diadelete
    351  jmp return
    352 
    353 :4 cmp #4
    354  bne :5
    355  jsr diaclear
    356  jmp return
    357 
    358 :5 cmp #5
    359  bne :6
    360  jsr diacreate
    361  jmp return
    362 
    363 :6 rts
    364 *-------------------------------
    365 return
    366  sta $c010
    367  rts
    368 *-------------------------------
    369 *
    370 *  Set idcompare (disk we expect to be in drive)
    371 *  & corresponding maxfiles value
    372 *
    373 *-------------------------------
    374 SETDATADISK
    375  lda #datadiskid
    376  ldx #maxfilesDD
    377 ]si sta idcompare
    378  stx maxfiles
    379  rts
    380 
    381 SETMASTERDISK
    382  lda #masterdiskid
    383  ldx #maxfilesMD
    384  bne ]si
    385 
    386 SETGAMEDISK1
    387  lda #gamedisk1id
    388  ldx #maxfilesGD1
    389  bne ]si
    390 
    391 SETGAMEDISK2
    392  lda #gamedisk2id
    393  ldx #maxfilesGD2
    394  bne ]si
    395 
    396 *-------------------------------
    397 dmsgbox
    398  ldx #msgbox
    399  ldy #>msgbox
    400  jsr drawbox
    401  ldx #msgbord1
    402  ldy #>msgbord1
    403  jsr drawbox
    404  ldx #msgbord3
    405  ldy #>msgbord3
    406  jsr drawbox
    407 
    408  ldx #msgbordL
    409  ldy #>msgbordL
    410  jsr drawline
    411  ldx #msgbordM
    412  ldy #>msgbordM
    413  jsr drawline
    414  ldx #msgbordR
    415  ldy #>msgbordR
    416  jsr drawline
    417 
    418  jsr okcan
    419  jmp flipshow
    420 
    421 dloadbox
    422  ldx #loadbox
    423  ldy #>loadbox
    424  jsr drawbox
    425  ldx #loadbord1
    426 
    427  ldy #>loadbord1
    428  jsr drawbox
    429  ldx #loadbord2
    430  ldy #>loadbord2
    431  jsr drawbox
    432  ldx #loadbord3
    433  ldy #>loadbord3
    434  jsr drawbox
    435 
    436  ldx #loadbordL
    437  ldy #>loadbordL
    438  jsr drawline
    439  ldx #loadbordM
    440  ldy #>loadbordM
    441  jsr drawline
    442  ldx #loadbordR
    443  ldy #>loadbordR
    444  jsr drawline
    445 
    446  jsr okcan
    447  jmp flipshow
    448 
    449 okcan ;OK/cancel
    450  lda #okx
    451  sta charx
    452  lda #>okx
    453  sta charx+1
    454  lda #oky
    455  sta chary
    456 
    457  lda #okmsg
    458  sta stringptr
    459  lda #>okmsg
    460  sta stringptr+1
    461  jsr printline
    462 
    463  lda #okx
    464  sta charx
    465  lda #>okx
    466  sta charx+1
    467 
    468  jsr nextline
    469 
    470  lda #cancelmsg
    471  sta stringptr
    472  lda #>cancelmsg
    473  sta stringptr+1
    474  jmp printline
    475 
    476 *-------------------------------
    477 * dialog: wrong disk is in drive--ask for right one
    478 
    479 askfordisk
    480  lda idcompare
    481  cmp #gamedisk1id
    482  beq askforgame
    483  cmp #gamedisk2id
    484  beq askforgame
    485  cmp #masterdiskid
    486  beq askformaster
    487  bne askfordata
    488 
    489 ]t1 jsr dmsgbox
    490  jmp setmsg
    491 
    492 askfordata
    493  jsr ]t1
    494  lda #askDD
    495  ldx #>askDD
    496 ]t2 sta stringptr
    497  stx stringptr+1
    498  jsr printline
    499  jsr canok
    500  ldx okcancel
    501 ]rts rts
    502 
    503 askforgame
    504  jsr ]t1
    505  lda #askGD
    506  ldx #>askGD
    507  bne ]t2
    508 
    509 askformaster
    510  jsr ]t1
    511  lda #askMD
    512  ldx #>askMD
    513  bne ]t2
    514 
    515 *-------------------------------
    516 * d i a l o g : p l a y
    517 
    518 diaplay
    519  jsr setmasterdisk ;we want master disk
    520 
    521 * is it the right disk?
    522 
    523  jsr readdisk
    524  beq ]rts ;yes--no dialog necessary
    525 
    526 * no-- print switch-disks msg
    527 
    528 :again
    529  jsr askformaster
    530  cpx #$ff
    531  beq :done ;cancelled--no need to check disk
    532 
    533 * now is it the right disk?
    534 
    535  jsr readdisk
    536  bne :again
    537 
    538 :done jsr fliphide
    539  ldx okcancel
    540  rts
    541 
    542 *-------------------------------
    543 * d i a l o g : l o a d
    544 *
    545 * only from data & master disks
    546 *-------------------------------
    547 diaload
    548  jsr dloadbox
    549 
    550 * print prompt message
    551 
    552  jsr setprompt
    553  lda #loadwhat
    554  sta stringptr
    555  lda #>loadwhat
    556  sta stringptr+1
    557  jsr printline
    558 
    559 * print directory
    560 
    561  jsr readanydisk
    562 
    563  lda idcompare
    564  cmp #datadiskid
    565  beq :ok
    566  cmp #masterdiskid
    567  bne :notadatadisk
    568 
    569 :ok jsr makelist
    570  jsr listfiles
    571 
    572 * get filename
    573 
    574  jsr setcursor
    575  jsr setbar
    576 
    577  lda #$8d
    578  sta getlnbuf
    579  jsr printbuf
    580 
    581  jsr getline
    582  ldx okcancel ;1/-1
    583  bmi :done
    584 
    585 * search for filename
    586 
    587  jsr searchfile
    588 
    589 :done jsr clrbuf ;clear getlnbuf if x=ff
    590  jsr fliphide
    591  rts ;with file# or ff in x-reg
    592 
    593 * err--not a data disk
    594 
    595 :notadatadisk
    596  jsr askfordata ;or master
    597  ldx okcancel
    598  bpl :tryagain
    599  rts ;cancelled
    600 
    601 :tryagain jmp diaload
    602 
    603 *-------------------------------
    604 * d i a l o g : s a v e
    605 *
    606 * In: idcompare
    607 *-------------------------------
    608 diasave
    609  jsr dloadbox
    610 
    611 * print prompt message
    612 
    613  jsr setprompt
    614  lda #savewhat
    615  sta stringptr
    616  lda #>savewhat
    617  sta stringptr+1
    618  jsr printline
    619 
    620 * print directory
    621 
    622  jsr readdisk
    623  bpl :rightdisk ;Disk must match idcompare
    624 
    625  lda idcompare
    626  cmp #masterdiskid
    627  bne :wrongdisk
    628  jsr GETIDBYTE
    629  cmp #datadiskid
    630  bne :wrongdisk ;Exception:
    631   jsr setdatadisk ;Data disk can sub for master disk
    632 
    633 :rightdisk
    634  jsr makelist
    635  jsr listfiles
    636 
    637 * get filename
    638 
    639  jsr setcursor
    640  jsr setbar
    641 
    642  jsr printbuf ;current file name in buffer
    643  jsr getline
    644 
    645  lda getlnptr
    646  bne :cont ;fname must be at least 1 char
    647 
    648  lda #-1
    649  sta okcancel
    650 :cont
    651  ldx okcancel
    652  bmi :done ;cancel
    653 
    654 * search for filename
    655 
    656  jsr searchfile
    657  cpx #$ff
    658  bne :done ;save level as file #x
    659 
    660  jsr namefile
    661 
    662 :done jsr clrbuf
    663  jsr fliphide
    664  rts
    665 
    666 * err: wrong disk
    667 
    668 :wrongdisk
    669  jsr askfordisk
    670  ldx okcancel
    671  cpx #-1
    672  bne :tryagain
    673  rts ;cancelled
    674 
    675 :tryagain jmp diasave
    676 
    677 *-------------------------------
    678 * d i a l o g : d e l e t e
    679 
    680 diadelete
    681  jsr dloadbox
    682 
    683 * print prompt message
    684 
    685  jsr setprompt
    686  lda #deletewhat
    687  sta stringptr
    688  lda #>deletewhat
    689  sta stringptr+1
    690  jsr printline
    691 
    692 * print directory
    693 
    694  jsr readanydisk
    695  bmi :notadatadisk
    696 
    697  jsr makelist
    698  jsr listfiles
    699 
    700 * get filename
    701 
    702  jsr setcursor
    703  jsr setbar
    704 
    705  lda #$8d
    706  sta getlnbuf
    707  jsr printbuf
    708 
    709  jsr getline
    710 
    711  ldx okcancel
    712  bmi :done ;cancel
    713 
    714 * search for filename
    715 
    716  jsr searchfile
    717 
    718  jsr clrbuf ;clear getlnbuf if x=ff
    719  jsr deletefile ;delete file if x<>ff
    720 
    721 :done lda #$8d
    722  sta getlnbuf
    723 
    724  jsr fliphide
    725  rts
    726 
    727 * err--not a data disk
    728 
    729 :notadatadisk
    730  jsr askfordata
    731  ldx okcancel
    732  cpx #-1
    733  bne :tryagain
    734  rts ;cancelled
    735 
    736 :tryagain jmp diadelete
    737 *-------------------------------
    738 * d i a l o g : c l e a r
    739 
    740 diaclear
    741  ldx #0 ;not $ff
    742  rts
    743 
    744 *-------------------------------
    745 *
    746 * d i a l o g : c r e a t e
    747 *
    748 * (i.e., zero directory)
    749 *
    750 * In: idcompare = desired disk id
    751 *
    752 *-------------------------------
    753 diacreate
    754  jsr dmsgbox
    755  jsr setmsg
    756 
    757 * game disk, data disk or master disk?
    758 
    759  lda idcompare
    760  cmp #datadiskid
    761  beq :dd
    762  cmp #gamedisk1id
    763  beq :gd
    764  cmp #gamedisk2id
    765  beq :gd
    766  cmp #masterdiskid
    767  bne :done
    768 
    769 :md lda #askMD
    770  ldx #>askMD
    771 ]ask sta stringptr
    772  stx stringptr+1
    773  jsr printline
    774  jmp :cont
    775 
    776 :gd lda #askGD
    777  ldx #>askGD
    778  bne ]ask
    779 
    780 :dd lda #askDD
    781  ldx #>askDD
    782  bne ]ask
    783 
    784 * print warning message
    785 
    786 :cont jsr nextline
    787  jsr setleftej
    788 
    789  lda #createwarn
    790  sta stringptr
    791  lda #>createwarn
    792  sta stringptr+1
    793  jsr printline
    794 
    795  jsr nextline
    796  jsr setleftej
    797 
    798  lda #createwarn2
    799  sta stringptr
    800  lda #>createwarn2
    801  sta stringptr+1
    802  jsr printline
    803 
    804 * OK/cancel
    805 
    806  jsr canok
    807  ldx okcancel
    808  cpx #-1
    809  beq :done
    810 
    811 * zero directory
    812 
    813  jsr ZERODIR
    814 
    815 * set id byte to "idcompare"
    816 
    817  jsr GETIDBYTE
    818  lda idcompare
    819  sta (stringptr),y
    820 
    821 * write out directory
    822 
    823  jsr writedir
    824 
    825 :done jsr fliphide
    826  rts ;with file# or ff in x-reg
    827 
    828 *===============================
    829 GETIDBYTE
    830  ldx #idfield ;disk id field
    831 
    832 getfield ;X = field # (0-31)
    833  lda #directory
    834  clc
    835  adc dirofflo,x
    836  sta stringptr
    837 
    838  lda #>directory
    839  adc diroffhi,x
    840  sta stringptr+1 ;set stringptr
    841 
    842  ldy #0 ;first char
    843  lda (stringptr),y
    844  rts
    845 *-------------------------------
    846 * delete file #x if x <> ff
    847 
    848 deletefile
    849  cpx #$ff
    850  beq :skip
    851 
    852  jsr getfield
    853 
    854  lda #$ff
    855  sta (stringptr),y ;first char of filename
    856 
    857  jsr writedir
    858 
    859 :skip rts
    860 *-------------------------------
    861 * clear getln buffer
    862 
    863 clrbuf cpx #$ff
    864  bne :rts
    865  lda #$8d
    866  sta getlnbuf
    867 :rts rts
    868 *-------------------------------
    869 * p r i n t b u f
    870 
    871 * print current contents of getln buffer
    872 * return getlnptr
    873 
    874 printbuf
    875  ldx #0
    876 :loop lda getlnbuf,x
    877  cmp #$8d
    878  beq :done
    879  inx
    880  cpx #fnlength
    881  bcc :loop
    882  jsr gtone
    883 
    884 :done stx getlnptr
    885  cpx #0
    886  beq :rts
    887 
    888  lda #getlnbuf
    889  sta stringptr
    890  lda #>getlnbuf
    891  sta stringptr+1
    892 
    893  jsr printline
    894 
    895 :rts rts
    896 *-------------------------------
    897 * n a m e f i l e
    898 
    899 * In: filename in getln buffer
    900 * Search directory for blank space, and name it
    901 * Return in x: # (0-19); if direc full, return #$ff
    902 
    903 namefile
    904  lda #directory
    905  sta stringptr
    906 
    907  lda #>directory
    908  sta stringptr+1 ;set stringptr
    909 
    910  ldx #0 ;file # (0-19)
    911 
    912 :nextfile
    913  ldy #0
    914  lda (stringptr),y
    915  cmp #$ff ;empty code
    916  beq :foundblank
    917 
    918  lda stringptr
    919  clc
    920  adc #fieldleng
    921  sta stringptr
    922 
    923  lda stringptr+1
    924  adc #0
    925  sta stringptr+1 ;next direc entry
    926 
    927  inx
    928  cpx maxfiles
    929  bcc :nextfile
    930 
    931 :dirfull jsr gtone
    932 
    933  ldx #$ff
    934  rts
    935 
    936 * name blank file with getlnbuf
    937 
    938 :foundblank
    939  ldy #0
    940 :nextchar lda getlnbuf,y
    941  sta (stringptr),y
    942  iny
    943  cpy #fnameleng
    944  bcc :nextchar
    945 
    946 * add track & region data bytes
    947 
    948  lda bluepTRKlst,x
    949  sta (stringptr),y
    950 
    951  iny
    952  lda bluepREGlst,x
    953  sta (stringptr),y
    954 
    955  iny
    956  lda binfoTRKlst,x
    957  sta (stringptr),y
    958 
    959  iny
    960  lda binfoREGlst,x
    961  sta (stringptr),y
    962 
    963  rts ;with level # in x-reg.
    964 
    965 *-------------------------------
    966 * s e a r c h f i l e
    967 
    968 * In: filename in getln buffer
    969 * Search directory for this filename
    970 * Return in x: # (0-19); if not found, return #$ff
    971 
    972 searchfile
    973  lda #directory
    974  sta stringptr
    975 
    976  lda #>directory
    977  sta stringptr+1 ;set stringptr
    978 
    979  ldx #0 ;file # (0-19)
    980 
    981 :nextfile
    982  ldy #0
    983 :nextchar
    984  lda (stringptr),y ;next char of filename
    985  cmp getlnbuf,y
    986  bne :miss
    987  cmp #$8d ;return
    988  beq :match
    989 
    990  iny
    991  cpy #fnameleng
    992  bcc :nextchar
    993  jsr gtone ;kludge errcheck
    994 
    995 :miss lda stringptr
    996  clc
    997  adc #fieldleng
    998  sta stringptr
    999 
   1000  lda stringptr+1
   1001  adc #0
   1002  sta stringptr+1 ;next direc entry
   1003 
   1004  inx
   1005  cpx maxfiles
   1006  bcc :nextfile
   1007 
   1008 :notfound ldx #$ff
   1009  rts
   1010 
   1011 :match rts
   1012 *-------------------------------
   1013 *
   1014 * R E A D  D I S K
   1015 *
   1016 * Read directory
   1017 *
   1018 * READANYDISK: change idcompare to match disk in drive--
   1019 *  return 0
   1020 *
   1021 * READDISK: look for desired idcompare--return 0 if disk
   1022 *   matches, ff if it doesn't
   1023 *
   1024 *-------------------------------
   1025 READANYDISK
   1026 readanydisk
   1027  lda #0
   1028  sta idcompare
   1029 READDISK
   1030  jsr readdir ;read directory from disk
   1031 
   1032  lda idcompare
   1033  bne :mustmatch
   1034 
   1035  jsr GETIDBYTE
   1036  sta idcompare
   1037 
   1038  cmp #datadiskid
   1039  bne :1
   1040  jsr setdatadisk
   1041  jmp :ok
   1042 
   1043 :1 cmp #masterdiskid
   1044  bne :2
   1045  jsr setmasterdisk
   1046  jmp :ok
   1047 
   1048 :2 cmp #gamedisk1id
   1049  bne :3
   1050  jsr setgamedisk1
   1051  jmp :ok
   1052 
   1053 :3 cmp #gamedisk2id
   1054  bne :notok
   1055  jsr setgamedisk2
   1056  jmp :ok
   1057 
   1058 :mustmatch
   1059  jsr GETIDBYTE
   1060  cmp idcompare
   1061  bne :notok
   1062 
   1063 :ok lda #0
   1064  rts
   1065 
   1066 :notok lda #$ff
   1067  rts
   1068 
   1069 *-------------------------------
   1070 * m a k e l i s t
   1071 
   1072 * Transfer file numbers (0-29) from directory to
   1073 * file list, leaving out "empty" files
   1074 
   1075 makelist
   1076 
   1077 :ok jsr zerofilelist ;set every slot to ff
   1078 
   1079  ldx #0
   1080  stx direcptr
   1081  jsr getfield
   1082 
   1083  ldx #0 ;filelist index
   1084 
   1085  ldy #0
   1086 
   1087 :loop lda (stringptr),y ;first char
   1088  cmp #$ff ;"empty" code
   1089  beq :skip
   1090 
   1091  lda direcptr
   1092  sta filelist,x
   1093  inx
   1094 
   1095 :skip inc direcptr
   1096  lda direcptr
   1097  cmp maxfiles
   1098  bcs :done
   1099 
   1100  lda stringptr
   1101  clc
   1102  adc #fieldleng
   1103  sta stringptr
   1104 
   1105  lda stringptr+1
   1106  adc #0
   1107  sta stringptr+1 ;next direc entry
   1108  bne :loop
   1109 
   1110 :done stx numfiles ;# of files in filelist (0-20)
   1111 
   1112  lda #0
   1113  sta topolist ;start with 1st file in dir
   1114  rts
   1115 
   1116 *-------------------------------
   1117 * l i s t f i l e s
   1118 
   1119 * Starting with file #topolist,
   1120 * print names of next five files in file list
   1121 
   1122 listfiles
   1123  lda topolist
   1124  sta listptr ;list ptr (0-19)
   1125 
   1126  lda #1
   1127  sta linenum
   1128 
   1129  jsr setlist ;set cursor to top of list area
   1130 
   1131 :nextfile
   1132  ldx listptr
   1133  cpx maxfiles
   1134  bcs :rts ;out of files
   1135 
   1136  lda filelist,x ;get direcptr
   1137  bmi :rts ;out of files
   1138 
   1139  tax
   1140  jsr getfield ;get stringptr
   1141 
   1142  jsr printfname
   1143 
   1144  jsr nextline ;next line down
   1145 
   1146  inc linenum
   1147  inc listptr
   1148 
   1149  lda linenum
   1150  cmp #numnames+1
   1151  bcc :nextfile
   1152 
   1153 :rts rts
   1154 *-------------------------------
   1155 * zero filelist
   1156 * (put ff in every slot)
   1157 
   1158 zerofilelist
   1159  ldx #0
   1160  lda #$ff ;"no file" code
   1161 :loop sta filelist,x
   1162  inx
   1163  cpx maxfiles
   1164  bne :loop
   1165  rts
   1166 *-------------------------------
   1167 * print filename
   1168 *
   1169 * In: stringptr, chary
   1170 
   1171 printfname
   1172  ldy #0
   1173  lda (stringptr),y ;first char of filename
   1174  cmp #$ff ;"empty" code
   1175  beq :rts
   1176 
   1177  jsr setleftej
   1178  jsr printline
   1179 :rts rts
   1180 
   1181 *-------------------------------
   1182 * wipe filename
   1183 *
   1184 * In: chary
   1185 
   1186 wipefname
   1187  ldx #fnwipe
   1188  ldy #>fnwipe
   1189 wipe1 jsr setupbox
   1190 
   1191  lda chary
   1192  sec
   1193  sbc #2
   1194  sta YCO
   1195  jmp dodblwipe
   1196 
   1197 unwipefname
   1198  ldx #fnunwipe
   1199  ldy #>fnunwipe
   1200  jmp wipe1
   1201 
   1202 wipe2 jsr setupbox
   1203 
   1204  lda chary
   1205  sec
   1206  sbc #2
   1207  sta YCO
   1208  jmp dodblora
   1209 
   1210 *-------------------------------
   1211 * wipe ok/cursor
   1212 
   1213 wipeok
   1214  ldx #okwipe
   1215  ldy #>okwipe
   1216  jsr wipe1
   1217 
   1218  ldx #okfix
   1219  ldy #>okfix
   1220  jmp wipe2
   1221 
   1222 unwipeok
   1223  ldx #okunwipe
   1224  ldy #>okunwipe
   1225  jsr wipe1
   1226 
   1227  ldx #okfix
   1228  ldy #>okfix
   1229  jmp wipe2
   1230 
   1231 *-------------------------------
   1232 * Set cursor to beginning of entry field
   1233 
   1234 setcursor lda #280
   1235  sta charx
   1236  lda #>280
   1237  sta charx+1
   1238  lda #topline
   1239  sta chary
   1240  rts
   1241 *-------------------------------
   1242 * Set bar to top of filename list
   1243 
   1244 * bary: 0 = top, 4 = bottom
   1245 * barx: 0 = left (filenames), 1 = right (OK/cancel)
   1246 
   1247 setbar
   1248  lda #0
   1249  sta bary
   1250  sta barx
   1251  sta okcancel
   1252 
   1253  lda numfiles
   1254  beq setbarok ;no files in list
   1255 
   1256 :rts rts
   1257 
   1258 *-------------------------------
   1259 * Set bar to "OK"
   1260 
   1261 setbarok
   1262  lda #3
   1263  sta bary
   1264  lda #1
   1265  sta barx
   1266 
   1267  lda #0
   1268  sta okcancel ;1 = ok, -1 = cancel, 0 = waiting
   1269  rts
   1270 *-------------------------------
   1271 setprompt lda #78
   1272  sta charx
   1273  lda #0
   1274  sta charx+1
   1275  lda #topline
   1276  sta chary
   1277  rts
   1278 *-------------------------------
   1279 setmsg lda #78
   1280  sta charx
   1281  lda #0
   1282  sta charx+1
   1283  lda #msgline
   1284  sta chary
   1285  rts
   1286 *-------------------------------
   1287 setlist lda #firstname
   1288  sta chary
   1289 setleftej
   1290  lda #78
   1291  sta charx
   1292  lda #0
   1293  sta charx+1
   1294  rts
   1295 *-------------------------------
   1296 nextline lda chary
   1297  clc
   1298  adc #linespace
   1299  sta chary
   1300  rts
   1301 *-------------------------------
   1302 flipshow lda $c055
   1303  lda PAGE
   1304  bne :rts
   1305  lda $c054
   1306 :rts rts
   1307 
   1308 fliphide lda $c054
   1309  lda PAGE
   1310  bne :rts
   1311  lda $c055
   1312 :rts rts
   1313 *-------------------------------
   1314 * print line of text
   1315 
   1316 printline
   1317  ldy #0
   1318 :loop sty ytemp
   1319  lda (stringptr),y
   1320  jsr print
   1321  bmi :rts ;"braap"
   1322  ldy ytemp
   1323  iny
   1324  bne :loop
   1325 :rts rts
   1326 *-------------------------------
   1327 savechrs lda charx
   1328  sta savechr
   1329  lda charx+1
   1330  sta savechr+1
   1331  lda chary
   1332  sta savechr+2 ;save current charx/chary
   1333  rts
   1334 
   1335 retrievechrs lda savechr+2
   1336  sta chary
   1337  lda savechr+1
   1338  sta charx+1
   1339  lda savechr
   1340  sta charx ;retrieve charx/chary
   1341  rts
   1342 *-------------------------------
   1343 * get cancel/OK
   1344 *
   1345 * Return okcancel: 1 = OK, ff = cancel
   1346 
   1347 canok
   1348  jsr setbarok
   1349  jsr drawbar
   1350 
   1351 :loop jsr input ;get kbd or jstk cmd (in A)
   1352 
   1353  cmp #Cdown
   1354  bne :1
   1355  jsr bardown
   1356  jmp :loop
   1357 
   1358 :1 cmp #Cup
   1359  bne :2
   1360  jsr barup
   1361  jmp :loop
   1362 
   1363 :2 cmp #Cbtn0
   1364  bne :3
   1365  jmp select
   1366 
   1367 :3 cmp #Cbtn1
   1368  bne :4
   1369  jmp select
   1370 :4
   1371  jmp :loop
   1372 
   1373 *-------------------------------
   1374 * Get line of input
   1375 
   1376 * In: getlnptr (0=beginning)
   1377 
   1378 * Out: A = okcancel = 1 (OK) or -1 (cancel)
   1379 
   1380 getline
   1381  jsr savechrs
   1382  jsr drawbar
   1383  jsr retrievechrs
   1384 
   1385  lda $c010
   1386 
   1387 :loop jsr savechrs
   1388  jsr ctrlbar ;while we're waiting for user to
   1389 ;type in a line, he can use jstk
   1390 ;or kbd to control hilite bar
   1391  jsr retrievechrs
   1392 
   1393  lda okcancel
   1394  bne :eol ;OK/cancel was selected
   1395 
   1396  lda $c000
   1397  bpl :loop
   1398  sta chartemp
   1399 
   1400  cmp #kDELETE
   1401  beq :bkspace
   1402 
   1403  ldx getlnptr
   1404  cpx #fnlength-1
   1405  bcs :rtncheck
   1406 
   1407  jsr print
   1408  bmi :rtncheck ;braap--nogood char
   1409 
   1410  ldx getlnptr
   1411  lda chartemp
   1412  sta getlnbuf,x
   1413  inc getlnptr
   1414 
   1415 :rtncheck lda chartemp
   1416  cmp #$8d ;return
   1417  bne :loop
   1418 
   1419  lda #1
   1420  sta okcancel ;<CR> means OK
   1421 
   1422 * Detected a <CR> or OK/cancel
   1423 
   1424 :eol lda #$8d
   1425  ldx getlnptr
   1426  sta getlnbuf,x ;put <CR> at end of fname
   1427 
   1428  lda okcancel ;-1 = cancel, 1 = OK
   1429  rts
   1430 
   1431 :bkspace ldx getlnptr
   1432  beq :loop ;buffer empty--nothing to delete
   1433 
   1434  dec getlnptr
   1435 
   1436  jsr redoline ;wipe & reprint entire line
   1437  jmp :loop
   1438 
   1439 *-------------------------------
   1440 *
   1441 *  C O N T R O L   H I L I T E   B A R
   1442 *  with jstk or kbd
   1443 *
   1444 *-------------------------------
   1445 ctrlbar
   1446  jsr input ;get kbd or jstk cmd (in A)
   1447 
   1448  cmp #Cdown
   1449  bne :1
   1450  jmp bardown
   1451 
   1452 :1 cmp #Cup
   1453  bne :2
   1454  jmp barup
   1455 
   1456 :2 cmp #Cbtn0
   1457  bne :3
   1458  jmp select
   1459 
   1460 :3 cmp #Cbtn1
   1461  bne :4
   1462  jmp select
   1463 
   1464 :4 cmp #Cright
   1465  bne :5
   1466  jmp barright
   1467 
   1468 :5 cmp #Cleft
   1469  bne :6
   1470  jmp barleft
   1471 
   1472 :6
   1473 :rts rts
   1474 *-------------------------------
   1475 barleft lda barx
   1476  beq :rts
   1477 
   1478  lda numfiles ;no files in list
   1479  beq :rts ;--limit bar to OK/cancel
   1480 
   1481  jsr erasebar
   1482 
   1483  lda numfiles
   1484  sec
   1485  sbc topolist
   1486  sbc #1 ;bary of bottommost file
   1487 
   1488  cmp bary
   1489  bcs :ok
   1490 
   1491  sta bary ;move bar to bottommost file
   1492 :ok
   1493  dec barx
   1494  jmp drawbar
   1495 
   1496 :rts rts
   1497 *-------------------------------
   1498 barright lda barx
   1499  bne :rts
   1500 
   1501  jsr erasebar
   1502  inc barx
   1503 
   1504  lda bary ;Filename column has 5 choices (bary = 0-4)
   1505  cmp #4
   1506  beq :can
   1507  lda #3 ;OK/cancel column has only 2 choices:
   1508  sta bary ;bary = 3 (OK) or 4 (cancel)
   1509 :can
   1510  jmp drawbar
   1511 
   1512 :rts rts
   1513 *-------------------------------
   1514 bardown lda barx
   1515  beq :fn
   1516 
   1517 :ok lda bary
   1518  cmp #4
   1519  bcc :movebar
   1520  rts
   1521 
   1522 :movebar jsr erasebar
   1523  inc bary
   1524  jmp drawbar
   1525 
   1526 :fn lda bary
   1527  cmp #4
   1528  bcs :offbot
   1529 
   1530  clc
   1531  adc topolist
   1532  clc
   1533  adc #1 ;# of next file
   1534  cmp numfiles
   1535  bcc :movebar
   1536  rts ;no more files
   1537 
   1538 * move bar off bottom
   1539 
   1540 :offbot lda topolist
   1541  clc
   1542  adc #5 ;# of next offscreen file
   1543  cmp numfiles
   1544  bcs :rts ;no more files
   1545 
   1546  inc topolist
   1547 
   1548  jsr drawbar
   1549 
   1550  ldx #listwipe2
   1551  ldy #>listwipe2
   1552  jsr drawbox
   1553 
   1554  jsr listfiles
   1555 
   1556 :rts rts
   1557 *-------------------------------
   1558 barup lda barx
   1559  beq :fn
   1560 
   1561 :ok lda bary
   1562  cmp #4
   1563  bcs :movebar
   1564  rts
   1565 
   1566 :movebar jsr erasebar
   1567  dec bary
   1568  jmp drawbar
   1569 
   1570 :fn lda bary
   1571  bne :movebar
   1572 
   1573 * move bar off top
   1574 
   1575 :offtop lda topolist
   1576  beq :rts ;no more files
   1577 
   1578  dec topolist
   1579 
   1580  jsr drawbar
   1581 
   1582  ldx #listwipe1
   1583  ldy #>listwipe1
   1584  jsr drawbox
   1585 
   1586  jsr listfiles
   1587 
   1588 :rts rts
   1589 *-------------------------------
   1590 *
   1591 *  Select what's highlighted
   1592 *
   1593 *-------------------------------
   1594 select
   1595  lda barx
   1596  beq selectfn ;select filename
   1597  bne selectok ;select OK/cancel
   1598 
   1599 *-------------------------------
   1600 * select filename
   1601 
   1602 selectfn
   1603 
   1604 * copy hilited filename into getlnbuf
   1605 
   1606  jsr setupfnwipe
   1607  jsr copyfname
   1608 
   1609 * print filename in entry field
   1610 
   1611  jsr redoline
   1612 
   1613  jmp savechrs
   1614 *-------------------------------
   1615 * select OK/cancel
   1616 
   1617 selectok
   1618  lda bary
   1619  cmp #3
   1620  beq :ok
   1621 
   1622 :cancel lda #-1
   1623  sta okcancel
   1624  rts
   1625 
   1626 :ok lda #1
   1627  sta okcancel
   1628  rts
   1629 *-------------------------------
   1630 * read filename under hilite & copy into getlnbuf
   1631 * In: stringptr
   1632 
   1633 copyfname
   1634  ldy #0
   1635 :loop lda (stringptr),y
   1636  sta getlnbuf,y
   1637  cmp #$8d
   1638  beq :done
   1639 
   1640  iny
   1641  cpy #fnameleng
   1642  bcc :loop
   1643  jsr gtone
   1644 
   1645 :done sty getlnptr
   1646  rts
   1647 
   1648 *-------------------------------
   1649 redoline
   1650  ldx #linewipe
   1651  ldy #>linewipe
   1652  jsr drawbox
   1653 
   1654  lda #getlnbuf
   1655  sta stringptr
   1656  lda #>getlnbuf
   1657  sta stringptr+1
   1658 
   1659  ldx getlnptr
   1660  lda #$8d ;return
   1661  sta getlnbuf,x
   1662 
   1663  jsr setcursor
   1664  jsr printline
   1665 
   1666  rts
   1667 *-------------------------------
   1668 * Draw a blank dialog box
   1669 * In: x = addr lo, y = addr hi
   1670 
   1671 setupbox
   1672  stx IMAGE
   1673  sty IMAGE+1
   1674 
   1675  ldy #3
   1676  lda (IMAGE),y
   1677  sta XCO
   1678  iny
   1679  lda (IMAGE),y
   1680  sta YCO
   1681  lda #0
   1682  sta OFFSET
   1683  lda #2 sta
   1684  sta OPACITY
   1685 
   1686  rts
   1687 
   1688 drawbox jsr setupbox
   1689  jmp dodblwipe
   1690 
   1691 drawline jsr setupbox
   1692  jmp dodblora
   1693 
   1694 *-------------------------------
   1695 * zero directory (development routine)
   1696 
   1697 ZERODIR ldy #0
   1698  ldx maxfiles
   1699  dex
   1700 :loop jsr getfield
   1701  lda #$ff
   1702  sta (stringptr),y
   1703  dex
   1704  bpl :loop
   1705  rts
   1706 *-------------------------------
   1707 * erase hilite bar
   1708 * In: barx, bary
   1709 
   1710 erasebar lda barx
   1711  bne :okcan
   1712 
   1713  jmp unhilitename
   1714 
   1715 :okcan jmp unhiliteok
   1716 *-------------------------------
   1717 * draw hilite bar
   1718 * In: barx, bary
   1719 
   1720 drawbar lda barx
   1721  bne :okcan
   1722 
   1723  jmp hilitename
   1724 
   1725 :okcan jmp hiliteok
   1726 *-------------------------------
   1727 hilitename
   1728  lda numfiles
   1729  beq :rts
   1730 
   1731  jsr setupfnwipe
   1732  jsr wipefname
   1733  jmp printfname
   1734 
   1735 :rts rts
   1736 
   1737 unhilitename
   1738  jsr setupfnwipe
   1739  jsr unwipefname
   1740  jmp printfname
   1741 
   1742 :rts rts
   1743 
   1744 setupfnwipe
   1745  lda topolist ;filelist # of top filename in window
   1746  clc
   1747  adc bary
   1748  tax ;filelist # of hilited filename
   1749  lda filelist,x
   1750  tax ;direcptr
   1751 
   1752  jsr getfield ;get stringptr
   1753 
   1754  ldx bary
   1755  lda fnamey,x
   1756  sta chary ;get screen y-cooord
   1757 
   1758  rts
   1759 *-------------------------------
   1760 hiliteok
   1761  jsr setupokwipe
   1762  jsr wipeok
   1763  jmp printline
   1764 
   1765 unhiliteok
   1766  jsr setupokwipe
   1767  jsr unwipeok
   1768  jmp printline
   1769 
   1770 setupokwipe
   1771  lda #oky
   1772  sta chary
   1773 
   1774  lda #okx
   1775  sta charx
   1776  lda #>okx
   1777  sta charx+1
   1778 
   1779  lda bary ;0=ok, 1=cancel
   1780  cmp #4
   1781  beq :can
   1782 
   1783  lda #okmsg
   1784  sta stringptr
   1785  lda #>okmsg
   1786  sta stringptr+1
   1787  rts
   1788 
   1789 :can jsr nextline
   1790 
   1791  lda #cancelmsg
   1792  sta stringptr
   1793  lda #>cancelmsg
   1794  sta stringptr+1
   1795  rts
   1796 
   1797 *===============================
   1798 *
   1799 *
   1800 *    D   I   S   K
   1801 *
   1802 *
   1803 *-------------------------------
   1804 *
   1805 *  S A V E   L E V E L
   1806 *
   1807 *  In: level (0-n)
   1808 *
   1809 *-------------------------------
   1810 DSAVELEVEL
   1811  jsr setlevel
   1812 
   1813  jmp savelevel ;in master
   1814 
   1815 *-------------------------------
   1816 *
   1817 *  Save level to game disk
   1818 *
   1819 *-------------------------------
   1820 DSAVELEVELG
   1821  jsr setlevelg
   1822 
   1823  jmp savelevelg ;in master
   1824 
   1825 *-------------------------------
   1826 *
   1827 *  L O A D   L E V E L
   1828 *
   1829 *  In: level (0-n)
   1830 *
   1831 *-------------------------------
   1832 DLOADLEVEL
   1833  jsr setlevel
   1834 
   1835  jmp loadlevel
   1836 
   1837 *-------------------------------
   1838 * Set level (for master & data disk)
   1839 
   1840 setlevel
   1841  ldx level
   1842 
   1843  lda bluepTRKlst,x
   1844  sta bluepTRK
   1845  lda bluepREGlst,x
   1846  sta bluepREG
   1847 
   1848  lda binfoTRKlst,x
   1849  sta binfoTRK
   1850  lda binfoREGlst,x
   1851  sta binfoREG
   1852 
   1853  rts
   1854 
   1855 *-------------------------------
   1856 * Set level (for game disk)
   1857 
   1858 setlevelg
   1859  ldx level
   1860 
   1861  lda gameTRKlst,x
   1862  sta bluepTRK
   1863  lda gameREGlst,x
   1864  sta bluepREG
   1865 
   1866  rts
   1867 
   1868 *-------------------------------
   1869  lst
   1870 eof ds 1
   1871  usr $a9,22,$00,*-org
   1872  lst off