; 4/30 NTSC ; 5/6 PAL ; 5/25/83 SECAM ; ***************************************** ; * * ; * RIDDLE OF THE SPHINX * ; * AKA * ; * DANK TOWER * ; * * ; ***************************************** ; DANK TOWER FEBRUARY 11, 1982 ; ; Transcribed by T. Mathys, December 2003 ; ; Tabulators should be set to 8. ; ; You need dasm and vcs.h to assemble the ; program. Get them from ; ; http://www.atari2600.org/dasm ; ; How to assemble: ; ; dasm riddle-pal.asm -f3 -oriddle-pal.bin ; processor 6502 include "vcs.h" ; set ORIGIN to $1000 to get the original rom ;ORIGIN equ $f000 ORIGIN equ $1000 ; ; GAME EQUATES ; PAL equ 1 SECAM equ 0 ; ***************************************** ; * PAL * ; ***************************************** NULIST equ 7 SECOND equ 50 TOP equ $a0 ; d0 BOTTOM equ $f0 DEAD equ $d0 ; dead object PHLOCK equ $38 ISLOCK equ $58 ANLOCK equ $98 SXLOCK equ $d8 ENDLOCK equ $fe SANDCLR equ $0e ; c2 CURCOLOR equ $00 SCORECLR equ $28 SCBAKCLR equ SANDCLR ENDCLR equ $46 MAXWOUND equ 9 ; max. wounds before you die MAXTHROW equ $6a ; max. throw distance MAXHIT equ 10 ; max. # of hits the shield blocks ; ; data segment ; seg.u data org $80 version ds 1 ; 0 = no locks, lives ; 1 = no locks, wounds ; 2 = locks, wounds sand ds 1 ; sand color status ds 1 ; d7 = 0 no logo ; d6 = 0 select depressed ; d2 = 0 allow p1 collision ; d1 = 0 stop game motion ; d0 = 0 do version number attrmask ds 1 ; ff = full lume, f3 = low lume randl ds 1 ; random number randh ds 1 frame ds 2 ; 16 bit frame counter code ds 2 ; indirect pointer to code index ds 1 indexsh ds 1 indexlo ds 1 lastix ds 1 ; last index for collision debounce lastdig ds 1 ; debounce dig ; p0grx ds 2 ; pointers to player graphics data p1grx ds 2 colorp0 ds 2 ; pointers to player color data colorp1 ds 2 ; zerost ; ; projectile positions and deltas ; m0x ds 1 m1x ds 1 m0y ds 1 m1y ds 1 m1dx ds 1 ; curpos ds 1 ; cursor position, 0-11 wounds ds 1 ; 0 = not wounded thirst ds 1 ; 0 = not thirsty throw ds 1 ; distance of throw ; clockl ds 1 ; time one second clocks ds 1 ; seconds clockm ds 1 ; minutes ; scoreh ds 1 ; hi score byte scorem ds 1 ; mid score scorel ds 1 ; lo score ; v0point ds 1 ; sound id v1point ds 1 ; sound id shcount ds 1 ; shield duration counters ; zeroend v1time ds 1 ; lockix ds 1 ; territory lock riddle ds 1 ; tablet choice (sphinx) ; my ds 1 ; projectile ypos p1y ds 1 p1point ds 1 ; playerx ds 1 ; player xpos ; posses ds 12 ; list of possessions ; stepp1 ds NULIST+1 hmovep1 ds NULIST indirp1 ds NULIST p1ys ds NULIST p1dx ds NULIST ; p1 deltas ; t0 ds 1 t1 ds 1 t2 ds 1 p1step t3 ds 1 count t4 ds 1 ; countsh ; zeroed byte t5 ds 1 ; char0 ds 2 ; graphics data pointers char1 ds 2 ; for 6 digit kernel char2 ds 2 char3 ds 2 char4 ds 2 char5 ds 2 ; ; main program ; seg code org ORIGIN start sei cld ; no decimal ldx #$00 txa ; clear stella and ram clp sta $0,x txs ; set stack pointer to end of ram inx bne clp ; ; initializations ; ldx #>ra stx p0grx+1 ; init high bytes of player stx p1grx+1 ; graphics data pointers stx randh ; init random number generator inx ; move to next page (contains color data) stx randl stx colorp0+1 ; init high bytes of player stx colorp1+1 ; color data pointers lda #$12 ; init high byte of code pointer sta code+1 ; jsr clear ; clear posses, p1 list lda #$80 ; status = $80 -> show logo sta status ; ; synch for new frame ; scrntop lda #2 sta WSYNC ; and synch for 3 lines sta VSYNC ; init digit pointers ldx #11 ; x = index/loop counter lda #>numbers ; a = page of number graphics bit status ; bit 7 of status set ? bpl hiordlp ; no -> ok lda #>logo ; yes -> a = page of logo graphics hiordlp: sta char0,x ; set high bytes of digit pointers dex dex bpl hiordlp ; ; colors ; lda sand ; get sand color and attrmask ; adjust brightness sta COLUBK ; set ; inc frame ; low frame inc sta WSYNC bne noinc ; branch if no high inc inc frame+1 ; high frame inc bne noattr ; no overflow -> ok lda #$f3 ; set attrmask to low lume sta attrmask noattr lda status and #%11111011 ; reset d2 for p1 collisions sta status and #2 ; mask out d1 (stop game motion flag) lsr ; do every other roll and frame+1 lsr bcc noinc ; skip if d0 of frame+1 clear (or game stopped) dec wounds ; heal 1 point bpl skip64 ; no underflow -> ok inc wounds ; underflow -> wounds = 0 skip64 sed lda thirst adc #0 ; increment thirst if carry was set bcs skip120 ; carry set -> max. thirst reached sta thirst ; set thirst skip120 cld noinc inx ; force x = 0 sta WSYNC stx VSYNC ; vsync off lda #$3d ; PAL timer value sta TIM64T ; ; p1 intelligence ; scan list of p1s ; lda status ; stop game motion ? and #2 beq out14 ; yes -> do nothing ldx #NULIST-1 lda frame ; get lowest 3 bits of frame counter bit SWCHB ; check p0 difficulty and #7 bvc skip90 ; amateur -> continue lsr ; pro -> speed up by 2 skip90 bne out14 ; p1s are updated when d2,d1 (and d0 in ; amateur mode) are zero homelp lda p1ys,x ; check for dead cmp #DEAD beq next00 ; object is dead -> do next one lda indirp1,x ; load identity cmp # don't move cmp # don't move neither ; fire missile cmp # don't fire missile lda frame ; limit fire rate: and #$3f ; fire only if d0-d5 of frame are 0 ora m1x ; and m1x is 0 (m1x=0 means no p1 missile) bne skip43 lda p1ys,x ; don't fire if off screen cmp #$f0 bcs skip43 sta m1y ; missile y = object y lda hmovep1,x ; missile x = object x sta m1x ldy #0 ; aim sty t1 jsr aim sty m1dx ; save dx skip43 jsr home ; home on player lda frame ; don't do every frame and #$f bne skip16 lda p1dx,x sta t1 jsr aim lda indirp1,x ; clones don't move in x direction: sec sbc # skip tay ; yes -> set dx to zero skip130 sty p1dx,x skip16 next00 dex bpl homelp out14 ; ; read right joystick and move cursor ; lda frame ; get frame counter and #$f ; do only every 16th frame bne out11 ldx curpos ; load cursor position lda SWCHA ; load joystick state lsr ; get left lsr lsr bcs noleft dex ; move cursor to the left bpl noleft ldx #11 ; catch underflow noleft lsr ; get right bcs noright inx ; move cursor to the right cpx #12 bcc noright ldx #0 ; catch overflow noright stx curpos ; save new cursor position out11 ; ; game select ; lda SWCHB ; load select switch lsr ; carry = reset switch state php ; save for later lsr ; carry = game select switch state bcc pushed ; not depressed lda #$40 ; mark select as pressed ora status sta status bne out28 ; always taken ; depressed pushed bit status ; check last select switch state bvc out28 ; already pressed -> do nothing ldx version ; get game variant inx ; change to next variant cpx #3 ; overflow ? bne skip61 ; no -> ok ldx #0 ; yes -> wrap around skip61 stx version ; save new game variant lda #0 sta status ; reset game jsr clear ; clear possession list ldx version ; get game version inx ; bring it into range [1,3] txa ; a = x * 8: asl ; this is the lower byte asl ; of the number graphic, asl ; which is stored in the possession list, sta posses ; so that the game version is displayed out28 ; ; game reset ; plp ; get reset switch state bcs nonew ; not pressed -> skip ; init game jsr clear ldy # continue ; ; end game !!! ; cmp #9 bcc end0 lda #9 end0 sta wounds lda #%11111101 ; clear d1 (stop game motion) and status sta status lda #ENDCLR ; change sand color sta sand out30 ; ; check for stopped game ; lda status ; d1 zero ? and #2 beq out24 ; yes -> game stopped, do nothing ; ; clock ; ldx clockl ; low clock (actually a frame counter) inx cpx #SECOND ; did a second pass ? bcc wrlow ; nope -> skip ldx #0 ; reset counter ; sed lda clocks ; seconds adc #0 ; one second more sta clocks cmp #$60 bcc wrlow ; skip if no wrap stx clocks ; zero seconds lda clockm ; load minutes adc #0 ; one minute more sta clockm wrlow stx clockl ; write low clock back cld ; ; handle right button ; bit INPT5 ; right button pressed ? bmi out51 ; nope -> skip ldx curpos ; x = cursor position ; right fire and right down pressed -> drop selected item lda SWCHA lsr ; down ? lsr bcs skip55 ; no -> skip lda # use selected item lda posses,x ; get item number sec ; make zero based (ignore digits) sbc #objects - numbers lsr ; divide by 8, since posses stores lsr ; lower bytes of object graphics data lsr ; addresses (each object is 8 bytes). tay lda objservs,y ; get low byte of object service address sta t0 ; save lda #>oservice ; get hi byte of object service address sta t1 ; save lda # skip ldy m0x ; see if missile 0 dead bne out24 ; no -> can't fire another one yet ; calculate throw distance lda wounds asl ; weight wounds asl asl adc thirst ; add thirst bcs wrap00 ; overflow -> wrap00 cmp #MAXTHROW-2 ; a < MAXTHROW-2 -> wrap01 bcc wrap01 wrap00 lda #MAXTHROW-2 ; load max. value wrap01 sta t1 ; save lda #MAXTHROW ; throw = MAXTHROW - t1 sbc t1 sta throw ldy #0 ; missile y = 0 sty m0y ldy playerx ; missile x = player x sty m0x out24 ; ; delta missiles ; lda frame ; alter delta lsr php ; save carry rol and #3 bne out19 dloop lda m1x ; zero = dead beq next01 lda m1dx ; load delta beq next01 sta t0 asl lda m1x ; reload xpos jsr domove ; move missile bcc skip70 lda #1 ; kill if attempted wrap sta t0 lda #0 skip70 sta m1x ; write new xpos ror t0 bcs next01 ; delta only once pha ; save xpos lda m1dx asl pla ; get xpos jsr domove sta m1x next01 out19 ; delta y - kill if offscreen ldx m0y ; missile 0 inx plp php bcs skip77 inx skip77 dec throw ; decrement throw distance beq killrock ; zero reached -> kill rock cpx #TOP ; top of screen reached ? bcc donext ; nope -> ok killrock ldx #0 ; kill stx m0x donext stx m0y ; write new y position ldx m1y ; missile 1 dex plp bcc skip103 dex skip103 cpx #BOTTOM-6 ; bottom of screen reached ? bcc ok03 cpx #BOTTOM bcs ok03 ldx #0 ; yes -> kill stx m1x ok03 stx m1y ; write new y position ; ; remove one empty slot in list of p1's ; ldx #0 stx t0 loop2 ldy p1ys,x cpy #DEAD bne skip18 inc t0 loop3 inx ; bump loop count cpx #NULIST bne loop2 beq out06 skip18 lda t0 beq loop3 ; reading valid entry loop4 lda indirp1,x pha lda hmovep1,x pha lda p1dx,x dex sta p1dx,x pla sta hmovep1,x pla sta indirp1,x sty p1ys,x inx ; point to old entry inx ; point over cpx #NULIST ; check for max beq out06 ldy p1ys,x bcc loop4 ; always taken out06 ; ; set up step values ; ldx #0 loop5 ldy p1ys,x beq zero00 cpy #BOTTOM ; below screen ? bcs zero00 ; yes cpy #DEAD ; blank slot bne skip19 zero00 ldy #1 skip19 inx cpx #NULIST beq out07 dey sty stepp1,x bcc loop5 out07 ; ; set up ball ; the ball is used to draw both the prince's and the thief's ; stones: ; ; - during even frames, the prince's stone is drawn ; - during odd frames, the thief's stone is drawn ; ldx #0 ; default ball size stx COLUPF lda frame lsr bcs oddfr ; go if odd frame evenfr ldy m0y ; y = missile 0 ypos lda m0x ; a = missile 0 xpos bne out09 ; if x is nonzero doshield lda #SANDCLR and attrmask sta COLUPF lda playerx ldx #$20 ldy #1 ; ypos bne out09 oddfr ldy m1y ; y = missile 1 ypos lda m1x ; a = missile 1 xpos beq doshield out09 sta WSYNC stx CTRLPF ; 0 +3 waste 3 nop ; 3 +2 stx CTRLPF ; 5 +3 ball size sty my ; 8 +3 save missile ypos sta HMBL ; 11 +3 and #$0f ; 14 +2 tay ; 16 +2 rloop1 dey bpl rloop1 sta RESBL sta WSYNC sta HMOVE ; ; sound routines ; sound lda v1point beq skip88 skip80 cmp #1 bne skip81 ; bonus sound jsr random and #7 ora #3 tay lda frame and #3 beq skip101 lda #$f skip101 ldx #5 bne skip83 ; leave (always taken) skip81 cmp #2 bne skip82 ; steal sound ldy v1time ldx #5 lda #$f skip82 cmp #3 bne skip83 ; raspberry lda #$f ldx #$c ldy #$1f ; gong sound skip83 cmp #4 bne skip88 ldx #$d ldy #4 lda v1time asl skip88 sta AUDV1 stx AUDC1 sty AUDF1 skip102 dec v1time bpl skip84 lda #0 sta AUDV1 sta v1point skip84 ldx v0point dex bpl dov0 inx dov0 stx v0point lda knock,x sta AUDV0 jsr random ; vbout lda INTIM ; wait for vb over bne vbout sta WSYNC sta VBLANK ; enable beam (a = 0) ; ; set up for kernels ; sta count sta p1point sta t1 ; p1 graphics sta t0 ; pad count lda indexlo cmp #16 bcc skip06 sbc #16 tay sty t0 ; pad count lda #16 skip06 sta countsh skip07 ldx #ENABL txs sta HMCLR ldx #TOP ; line counter stx p1y stx stepp1 jmp padloop ; ; add to score ; a has delta, x and y get trashed ; add subroutine ldx #2 ; digit index / loop counter addm sed .addloop clc adc scoreh,x ; add current digit sta scoreh,x bcc .out03 ; no carry -> done lda #1 ; a is now the carry dex ; next digit bpl .addloop .out03 cld rts ; ; subtract from score ; a has delta, x and y get trashed ; subtract subroutine ldx #2 sta t0 sed .subloop sec lda scoreh,x sbc t0 sta scoreh,x bcs .out22 lda #1 sta t0 cpx #2 bne .skip44 ; not low lda scorem ; if borrom from lo, check highs ora scoreh bne .skip44 ; go if something to borrow sta scorel ; zero lo score beq .out22 .skip44 dex bpl .subloop .out22 cld ldx #3 stx v1point ldx #$10 stx v1time rts ; ; move player left or right ; a has xpos, if carry, move right ; domove subroutine tay bcs .mright cmp #0 ; already at leftmost position ? beq .back ; yes -> bye clc adc #$10 bpl .ok00 cmp #$90 ; time to step ? bcs .ok00 ; no sbc #$f0 ; carry clear .ok00 clc .skip08 .back rts ; if carry, attempted wrap .mright cmp #$88 ; already at rightmost position ? beq .back ; yes -> bye sec sbc #$10 bmi .ok01 cmp #$70 ; time to step ? bcc .ok01 adc #$f0 ; carry set .ok01 clc .skip09 rts ; ; six character kernel ; sixchar subroutine ldy #8 .sckrnl dey ; 59 +2 sty t1 ; 61 +3 lda (char5),Y ; 64 +5 sta GRP0 ; 69 +3 sta WSYNC ; 72 +3 75 cycles total lda (char4),y ; 0 +5 cycle count starts here sta GRP1 ; 5 +3 lda (char3),y ; 8 +5 sta GRP0 ; 13 +3 lda (char2),y ; 16 +5 sta t2 ; 21 +3 lda (char1),y ; 24 +5 tax ; 29 +2 lda (char0),y ; 31 +5 tay ; 36 +2 lda t2 ; 38 +3 sta GRP1 ; 41 +3 stx GRP0 ; 44 +3 sty GRP1 ; 47 +3 sty GRP0 ; 50 +3 ldy t1 ; 53 +3 bne .sckrnl ; 56 +3 (2) sty GRP0 sty GRP1 sty GRP0 sty GRP1 rts servtabl .byte # go on ldy shcount ; yeah -> damage shield iny cpy #MAXHIT ; max. # of hits reached ? bcc skip133 ; nope -> go on jsr steal ; yeah -> remove shield ldy #0 skip133 sty shcount jmp skip89 skip132 cmp # no damage ; inc wounds bit SWCHB ; difficulty ? bvc skip89 ; amateur -> done inc wounds ; pro -> hurt a bit more skip89 lda #BOTTOM-3 sta m1y lda #$1f sta AUDF0 lda #1 sta frame sta AUDC0 lda #knocke-knock sta v0point out27 ; ; players rock collision ; lda frame lsr bcs out101 lda m0x beq out101 bit t4 ; p1 collision bvc out20 ; ldx #NULIST-1 hitloop lda my ; ball ypos sec sbc p1ys,x and #$f0 beq hit dex bpl hitloop bmi out20 ; always taken ; scan list for hit hit ldy #1 ; kill rock sty throw lda indirp1,x ; load identity cmp # score ldy #$80 ; yes -> minus score sub00 tya jsr subtract jmp out20 scorepl lda #$60 jsr add contcx lda #$17 sta AUDF0 lda #1 sta AUDC0 lda #knocke-knock sta v0point out20 bit t3 ; player 0 cx bvc out101 ldy #1 sty throw out101 ; ; p1 collision detect ; lda status ; p1 cx timer and game stop and #6 eor #2 bne out21 ; d2 set, leave (no p1 collisions) lda index cmp lastix beq out21 lda frame lsr bcs ckp1 lda m0x bne out21 beq docx ; always taken ckp1 lda m1x bne out21 docx bit t4 ; p1/ball cx bvc out21 ; collision, but which ? lda index sta lastix lda status ora #4 sta status lda #$80 sta frame ; cx timer ldx #NULIST-1 scanloop lda p1ys,x beq yup cmp #$f6 bcs yup dex bpl scanloop bmi out21 ; none !! yup lda indirp1,x pha cmp #services sta t1 stx t2 ; save for isis ldx curpos lda posses,x jmp (t0) indiret out21 ; ; move playfield if attract ; lda attrmask cmp #$f8 bcs out31 ldx #1 jmp moveix ; always move out31 lda status ; skip if game stopped and #2 bne doinput jmp out01 doinput ; ; read joystick and scroll screen ; ; speed depends on health ; ; check for chariot or sceptre first ; ldx curpos lda posses,x ; holding sceptre ? cmp # move at full speed lda thirst ; calculate index speed mask to use, lsr ; depending on thirst and health lsr lsr lsr adc wounds cmp #8 bcc wrap02 lda #7 wrap02 tax lda frame and speedmsk,x ; (frame & speedmsk) == 0 ? beq skip52 ; yes -> move jmp out01 ; no -> do nothing skip52 ldx #0 lda SWCHA asl asl bmi skip14 dex skip14 asl bmi skip11 inx ; ; x has delta, disallow motion when in contact with terrain ; skip11 bit t3 ; ball/p0 collision bvs skip39 ; cx bit t4 ; ball/p1 bvc out08 skip39 lda indexlo ; hit top or bottom cmp #7 bcs hitbott txa ; get delta bmi out08 zerox0 ldx #0 beq out08 ; always taken hitbott txa bmi zerox0 out08 txa bmi ndelt ; minus delta lda index cmp lockix ; locked ? bne moveix ldx #$10 stx v1time ldx #3 stx v1point ldx #0 ; stop motion ndelt lda index bne moveix tax moveix txa clc adc indexlo bmi skip12 cmp #22 bcc skip13 lda #0 inc index bcs skip13 skip12 lda #21 dec index skip13 sta indexlo ; ; scroll p1 list ; txa ; get delta eor #$ff clc adc #1 tay ldx #NULIST-1 deltalp tya clc adc p1ys,x cmp #BOTTOM ; bottom bcs on1 cmp #TOP-2 ; top bcc on1 lda #DEAD on1 sta p1ys,x dex bpl deltalp ; y has delta jsr bbirth ; if moving, check for bldg birth ; ; move player left or right ; lda playerx bit SWCHA clc bvc dostick ; left with no carry bmi out01 sec dostick jsr domove lsr frame+1 sta playerx out01 sta WSYNC ; ; ovout lda INTIM ; overscan timeout bne ovout jmp scrntop ; new frame ! ; ; subroutines ; ; ; give an object ; ; input : carry = 1 give magical object ; carry = 0 give normal object ; ; output : carry = 0 duplicate given ; give subroutine php jsr random plp and #7 ; lo 3 bcc .skip45 ora #8 ; set d3 .skip45 tay lda treatabl,y ; load treasure givest subroutine ; entry with a = # give object inx ; check next slot cpx #12 bne .searloop beq .out23 ; no free slot, can't give object .giveit sta posses,x lda #1 sta v1point lda #$10 sta v1time .out23 rts ; ; move horizontally to player ; x points to p1 ; home subroutine lda p1dx,x ; load delta beq .out15 sta t0 ; save asl ; use d7 (if carry, move right) lda hmovep1,x ; load xpos jsr domove ror t0 ; divide delta by two bcs .wrxpos pha ; push xpos lda p1dx,x ; reload delta asl pla ; get xpos jsr domove .wrxpos sta hmovep1,x .out15 ; ; walk down screen ; ; see if building coming lda index and #$f ; use lo nibble cmp #9 beq .skip34 cmp #7 beq .skip34 cmp #8 bne .walk ; check if critical area .skip34 lda p1ys,x ; load ypos cmp #$f0 bcs .out12 cmp #$20 bcc .out12 ; don't walk down screen ; .walk lda p1ys,x tay sec sbc #1 cmp #TOP bcc .ok02 ; still on screen cmp #BOTTOM bcs .ok02 lda #DEAD ; kill p1 bne .out12 ; check distance to next p1 .ok02 inx ; point down list pha ; save ypos lda p1ys,x ; see if dead cmp #DEAD beq .out02 ; pop, and leave with set carry ; pla pha sec sbc p1ys,x cmp #$28 ; safe distance .out02 pla ; get ypos back bcs .out13 ; go if room .nowalk tya ; get old ypos .out13 dex ; point back to desired entry .out12 sta p1ys,x rts ; ; aim toward p1 ; delta x returned in y, x points to p1 ; aim subroutine ldy #0 lda playerx and #$f sta t0 lda hmovep1,x and #$f sec sbc t0 bne .skip17 ; go if delays not equal ldy t1 ; get old delta jmp .out17 ; .skip17 bcc .dodec ; dec delta iny cmp #2 bcc .out16 iny .out16 rts .dodec dey cmp #$ff bcs .out17 dey .out17 rts ; ; building birth ; bbirth subroutine lda #0 sta t2 tya ; get delta y beq .out04 bpl .bkward ; ; moving forward, building to top slot ; ldy index tya and #$f bne .nobldg ; no building lda indexlo cmp #0 beq .skip21 ; ; check for p1 to top slot ; .nobldg inc t2 ; make t2 nonzero tya ; get index and #$f ; use lo nibble cmp #$e ; cut off for bldg bcs .out04 ; =F lda p1ys ; check for entry cmp #DEAD beq .skip21 cmp #TOP-$30 ; for vert separation bcs .out04 ; ; look for first blank slot ; .skip21 ldx #$ff .searchlp inx cpx #NULIST beq .out04 lda p1ys,x cmp #DEAD bne .searchlp ; move list down onto blank slot .wrslot dex bmi .skip20 ; top slot empty .downlp lda p1ys,x pha lda hmovep1,x pha ldy indirp1,x lda p1dx,x inx sta p1dx,x sty indirp1,x pla sta hmovep1,x pla sta p1ys,x dex dex bpl .downlp ; choose an identity .skip20 ldx #0 ; point to top entry ldy index lda t2 beq .skip22 jsr p1ident ; it's p1 jmp .out10 .skip22 jsr bdident .out10 lda #TOP-6 sta p1ys ; first slot .out04 rts ; ; moving backward, find last entry ; .bkward ldy index tya and #$f cmp #7 bne .dop1 ; no building lda indexlo cmp #$e beq .skip23 ; no building ; ; don't put p1's near buildings ; .dop1 lda index and #$f cmp #7 beq .out05 ; rts cmp #8 beq .out05 cmp #9 beq .out05 ; inc t2 ; make it a p1 ; ; find last entry and write below it ; .skip23 ldx #NULIST-2 .lasloop lda p1ys,x cmp #DEAD bne .dowrite dex bpl .lasloop lda t2 bne .dop111 .dowrite lda t2 ; if nonzero, do p1 bne .dop11 ; ; building ; inx tya ; get index sec sbc #7 ; correct for bottom of screen tay jsr bdident ; choose building identity jmp .skip24 ; ; check for room ; .dop11 lda p1ys,x ; last nonzero entry cmp #$20 bcc .out05 ; no room cmp #$f0 bcs .out05 ; also no room .dop111 inx ; point to new entry jsr p1ident .skip24 lda #$f2 ; bottom sta p1ys,x .out05 rts ; ; derive p1 characteristics ; p1ident subroutine jsr random tay and #$f cmp #9 bcc .ok99 ; 9 is max delay count ldy #$55 .ok99 cmp #0 bne .ok98 iny .ok98 sty hmovep1,x jsr random and #$f ; weight god appearances cmp #2 ; weight gods bcs .skip56 bit SWCHB ; check left diff bvs .skip54 lda #0 ; make more clones bvc .skip56 .skip54 lda #1 ; make more thieves .skip56 tay cpy #$f ; weight anubis and isis bne .skip131 lsr randh bcs .skip131 iny .skip131 lda p1ind,y sta indirp1,x lda #0 sta p1dx,x rts ; ; derive building graphics and ypos ; bdident tya stx t3 lsr lsr lsr lsr tax lda bldgind,x ldx t3 sta indirp1,x ; first slot lda (code),y and #7 tay lda hmovtabl,y sta hmovep1,x ; first slot rts ; ; clear subroutine ; clear subroutine ldx #zeroend-zerost ldy # no success sta lastdig ; save new dig position lda randl bit SWCHB ; give more for b difficulty bvs skip58 asl ; happen more often skip58 and #3 bne snd18 ; no success lda # ok lda # put spade ldx curpos ; back into possession list sta posses,x bpl snd19 snd18 lda v1point bne out18 snd19 lda #4 sta v1point lda #$f sta v1time out18 jmp return2 ; ; steal most valuable item ; steal subroutine ldx #11 ; x = loop counter/index stx v1time stx t0 ; t0 = highest value found so far .steallp lda posses,x ; get item from possession list cmp # continue stx t1 ; yes -> save index of this object sta t0 ; save new highest value .next dex ; next item bpl .steallp ldx t1 ; get index of most valuable item .takechar lda # set counter to 0 sta shcount rts ; lo bytes of object service handler addresses objservs .byte #