Archipelagos is one of the more unique strategy games, where the player traverses procedurally generated worlds to cleanse the islands of boulders and obelisks.
Source Code Fragments#
Several huge chunks of the game's code was included on the disk. They can be found in the .stx dump at the addresses listed below.
F900:
w d1,d2
and.w #$0007,d2 AND blue component
move.b d2,(a1)+ stick it in palBt2
addq.l #1,a1
dbf d0,ptp_l1
rts
*******************************************************************
RGB
lea palBt2,a0
asl.w #2,d7 TO col
lea (a0),a6
lea 0(a0,d7),a5
RGB2 lea RGBincs,a4
lea permRGB,a3
moveq #15,d2 for 16 cols..
rgb_l1
moveq #0,d4
move.b (a5),d4 RED component of col
swap d4 in high word
moveq #0,d1
move.b (a6),d1 target RED component
swap d1
move.l d1,(a3)+
sub.l d1,d4 red difference
asr.l #5,d4 16 steps on col change
move.l d4,(a4)+
moveq #0,d4
move.b 1(a5),d4 GREEN component of col
swap d4 in high word
moveq #0,d1
move.b 1(a6),d1 target GREEN component
swap d1
move.l d1,(a3)+
sub.l d1,d4 green difference
asr.l #5,d4 16 steps on col change
move.l d4,(a4)+
moveq #0,d4
move.b 2(a5),d4 BLUE component of col
swap d4 in high word
moveq #0,d1
move.b 2(a6),d1 target BLUE component
swap d1
move.l d1,(a3)+
sub.l d1,d4 blue difference
asr.l #5,d4 16 steps on col change
move.l d4,(a4)+
addq.l #4,a6
add.l #4,a4
add.l #4,a3
dbf d2,rgb_l1
rts
*******************************************************************
tBsub
movem.w d6-d7,-(sp)
lea currntpal,a2
lea currntRGB,a0
lea RGBincs,a1
moveq #15,d6 15 cols
tBs_l1
move.l (a1)+,d0
add.l d0,(a0)+
move.l (a1)+,d0
add.l d0,(a0)+
move.l (a1)+,d0
add.l d0,(a0)+
move.b -11(a0),d7 RED into d7
lsl.w #4,d7 shove up
or.b -7(a0),d7 or in GREEN
lsl.w #4,d7 shove up
or.b -3(a0),d7 or in BLUE
move.w d7,(a2)+ new col
addq.l #4,a0
addq.l #4,a1
dbf d6,tBs_l1
movem.w (sp)+,d6-d7
rts
*******************************************************************
tBsub2
movem.w d6-d7,-(sp)
lea currntpal,a2
lea currntRGB,a0
lea RGBincs,a1
moveq #15,d6 15 cols
tBs_l2
move.l (a1)+,d0
sub.l d0,(a0)+
move.l (a1)+,d0
sub.l d0,(a0)+
move.l (a1)+,d0
sub.l d0,(a0)+
move.b -11(a0),d7 RED into d7
lsl.w #4,d7 shove 8240+2,a1 display registers
move.l (a0)+,(a1)+ ..set reg
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
dbf d7,spl_l1
cmp.w #32,d6
beq spl_o1
move.w d6,d7
subq.w #1,d7
spl_l2
bsr tBsub2
jsr wait_fly
lea currntpal+2,a0 pal addr
lea $FF8240+2,a1 display registers
move.l (a0)+,(a1)+ ..set reg
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
dbf d7,spl_l2
lea permRGB,a0 pal addr
lea currntRGB,a1 display registers
move.w #$3F,d0 for 16 colours
spl_l4 move.l (a0)+,(a1)+ ..set reg
dbf d0,spl_l4 next reg
add.w #6,d6
cmp.w #32,d6
ble spl_l3
spl_o1
move.w aimcol(pc),d0 get final (logical) col no.
moveq #0,d1 make up screen fill words
moveq #0,d2 in d1,d2
btst #0,d0 test bits for colour and set
beq spl_o2 d1 & d2 accordingly
move.l #$FFFF0000,d1
spl_o2
btst #1,d0
beq spl_o3
move.w #$FFFF,d1
spl_o3
btst #2,d0
beq spl_o4
move.l #$FFFF0000,d2
spl_o4
btst #3,d0
beq spl_o5
move.w #$FFFF,d2
spl_o5
lea screen1,a0
bsr spl_s1
lea screen2,a0
bsr spl_s1
move.w -2(a0),skycol
rts
* fills pic frame part of screen with d1,d2 as long words
spl_s1
lea 16+8*160(a0),a0 top lh corner of pic frame
move.w #171,d4 172 pix rows
spl_l9
moveq #15,d3 16 16blocks in 256 pix
spl_l8
move.l d1,(a0)+ fill with colour
move.l d2,(a0)+
dbf d3,spl_l8
lea 32(a0),a0
dbf d4,spl_l9 next pix row
rts
*******************************************************************
to_black
bsr pal_to_perm
move.l #dievbl,$70.w
lea palBt2,a0
lea (a0),a6
lea zero,a5
bsr RGB2
lea permRGB,a0 pal addr
lea currntRGB,a1 display registers
move.w #$3F,d0 for 16 colours
spl_l6 move.l (a0)+,(a1)+ ..set reg
dbf d0,spl_l6 next reg
move.w #31,d7
spl_l7
tst.b volflag did we want fade ?
beq tun_o5
tst.b jingle else jingles always on
bne tun_o7
tst.b mustate is music off ?
beq tun_o5
tun_o7
move.w d7,d0
asr.w #1,d0
move.b d0,snd+$191
tun_o5
bsr tBsub
jsr wait_fly
lea currntpal,a0 pal addr
lea $FF8240,a1 display registers
move.l (a0)+,(a1)+ ..set reg
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
move.l (a0)+,(a1)+
dbf d7,spl_l7
clr.b volflag
move.w -2(a0),skycol
bclr #0,$FFFFFA07.w
; lea altscreen,a0
; bsr tbl_s1
lea screen1,a0
bsr tbl_s1
lea screen2,a0
bsr tbl_s1
rts
tbl_s1
move.w #7999,d0
tbl_l1
clr.l (a0)+
dbf d0,tbl_l1
rts
*******************************************************************
pal_to_perm
jsr wait_fly
lea palBt2,a1
lea $FF8240,a0
moveq #15,d0
ptp_l1
move.w (a0)+,d1 get colour 0
move.w d1,d2
lsr.w #8,d2
and.w #$0007,d2 red component
move.b d2,(a1)+
move.w d1,d2
lsr.w #4,d2
and.w #$0007,d2 green component
move.b d2,(a1)+
move.312E0:
ca_o1
move.b #4,(a2)+
bra ca_o2
ca_o1
move.b #6,(a2)+
ca_o2
dbf d0,ca_l4
dbf d2,ca_l3
lea 128(a2),a2
dbf d3,ca_l2
ca_out
rts
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
rand_block
bsr make_block
bsr create_arch
bsr gen_vars
move.w Nstones,noofstones
move.w Nbeggs,noofeggs
rts
pony
movem.l d0-d7/a0-a6,-(sp)
move.w #0,d0
move.w rcount,d1
moveq #0,d4
move.w countar,d4
bsr print_num
addq.w #1,rcount
movem.l (sp)+,a0-a6/d0-d7
rts
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
* create arch creation data block
make_block
move.w currntlvl(pc),d0
asl.w #2,d0
add.w #5000,d0
move.w d0,ran2 seed for level creation = lvl+5000
bsr randx
moveq #40,d2
bsr rand_range
add.w #20,d2
move.w d2,noofisles noofisles = 20 to 60
bsr randx
moveq #100,d2
bsr rand_range
add.w #100,d2
move.w d2,isle_f1 isle_f1 = 100 to 200
asr.w #1,d2
move.w d2,isle_f2 isle_f2 = 50 to 100
bsr randx
moveq #32,d2
bsr rand_range
add.w #15,d2
move.w d2,ip1 ip1 = 15 to 47 ave 31
move.w d2,d3
bsr randx
moveq #32,d2
bsr rand_range
add.w d3,d2
add.w #15,d2
move.w d2,ip2 ip2 = ip1+15 to ip1+15+32 ave 62
move.w d2,d3
bsr randx
moveq #32,d2
bsr rand_range
add.w d3,d2
add.w #15,d2
cmp.w #100,d2
blt mb_o1
moveq #100,d2
mb_o1
move.w d2,ip3 ip3 = ip2+5 to ip2+5+15 (or 100) ave 93
move.w #100,ip4 ip4 = ip3 to 100
bsr randx
move.w #80,d2
bsr rand_range
add.w #10,d2
move.w d2,mergeprob
move.w currntlvl(pc),d0
asl.w #2,d0
add.w #12345,d0
move.w d0,level_seed
move.w noofisles,d0
mulu #3,d0
sub.w #20,d0
move.b d0,archparms
move.b d0,archparms+1
move.b #$FF,d1
sub.b d0,d1
move.b d1,d0
lsr.b #1,d0
move.b d0,archparms+2
move.b d0,archparms+3
move.w #1,archparms+4
move.w #0,archparms+10
move.w #0,archparms+16
move.w #0,archparms+22
rts
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
* generate variables,trees,eggs,etc. etc.
gen_vars
move.w #31,Ntrees
bsr randx
moveq #6,d2
bsr rand_range
addq.w #1,d2
move.w d2,Nbeggs no. of eggs = 1 to 7
bsr randx
moveq #4,d2
bsr rand_range
addq.w #4,d2
move.w d2,Nbboys no. of bboys = 4 to 8
bsr randx
moveq #6,d2
bsr rand_range
add.w #4,d2
move.w d2,Nstones no. of stones = 4 to 10
bsr randx
and.w #$00FF,d0
move.w d0,theta
lsl.w #1,d0
move.w d0,mse_angle
move.b isle_seeds(pc),heroY
move.b #128,heroY+1
move.b isle_seeds+1(pc),heroX
move.b #128,heroX+1
moveq #0,d6
bsr randx
cmp.b #220,d0
bcs gv_o1
moveq #1,d6
asr.w Nstones
gv_o1
move.w d6,eat_or_pois
move.w Nbeggs,d3
addq.w #1,d3
move.w timing(pc),d1
mulu #60*20,d1
divu d3,d1
move.w d1,Leggcntr
move.w #600,eggcntr
move.w #$F00,poodist
move.w #10,d0
move.w #20,d1
tst.w eat_or_pois
bne gv_o2
asl.w #1,d0
asl.w #1,d1
gv_o2
move.w d0,podfreq
move.w d0,podcnt
move.w d1,powecnt
move.w d1,powe_lev
move.w level_seed(pc),ran2323E0:
eYrange+1 x range of that block
move.b 1(a0),isleXrange+1 y range of that block
clr.b isleXrange ... as words
clr.b isleYrange
move.w 2(a0),archpos top lh corner offset
gapend
movem.w (sp)+,d6-d7/d0
rts
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
sea_it
lea maz,a1
move.w #$FFFF,d0
ca_l5
move.b #4,(a1)+
dbf d0,ca_l5
rts
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
* compact arch data to arch
c_to_a
lea maz,a1
move.l screen,d1
eor.l #$8000,d1
move.l d1,a0
lea (a1),a2
moveq #-1,d1
ca_l1
move.b #4,(a2)+
dbf d1,ca_l1
tst.b d0
bne ca_out
lea 64*256+64(a1),a2
moveq #127,d3
ca_l2
moveq #3,d2
ca_l3
move.l (a0)+,d1
moveq #31,d0
ca_l4
lsl.l #1,d1
bcs3A8B0:
dc.w 20*256 mse x/y (absolute)
Xpos dc.w 128*256
dc.w 0 theta
;screen dc.l $78000
jmp start
htab incbin hts.bin
sinAtab incbin TANTAB
dcb.w 100,$7FFF
tant equ sinAtab+722
angfact equ 4
trees equ 32
bboys equ 2
badegg equ 2
d2ntab incbin D2N.BIN
dcb.w 20,$8000
atm1 MACRO
move.w 0(a0,d2),d3
cmp.w d3,d0
bcs.s atn\@
add.w d1,d2 current+inc
bra.s atn2\@
atn\@
sub.w d1,d2 current+inc
atn2\@
asr.w #1,d1 inc+inc/2
ENDM
clear_icons
move.l screen(pc),d7
add.l #160*20+16,d7
move.l d7,a0
move.w #160,d2
moveq #$00000000,d0
move.l #$0000FFFF,d1
move.w #92,d3
ci_l6
REPT 16
move.l d0,(a0)+
move.l d1,(a0)+
ENDR
add.w d2,d7
move.l d7,a0
dbf d3,ci_l6
rts
move.l screen,d7
move.l d7,a1
add.l #32000,a1
add.l #113*160,d7
ci_l2
move.l (a1)+,a0
cmp.l #0,a0
beq ci_out
cmp.l #-1,a0
beq ci_l2
move.w #160,d2
move.l #$FFFF0000,d0
move.l #$FFFFFFFF,d1
move.l a0,d3
bclr #31,d3
bne ci_o1
bclr #30,d3
bne ci_o2
ci_l1
move.l d0,(a0)+
move.l d1,(a0)+
move.l d0,(a0)+
move.l d1,(a0)+
add.w d2,d3
move.l d3,a0
cmp.l d7,d3
blt ci_l1
bra ci_l2
ci_o1
move.l d3,a0
ci_l3
move.l d0,(a0)+
move.l d1,(a0)+
move.l d0,(a0)+
move.l d1,(a0)+
move.l d0,(a0)+
move.l d1,(a0)+
add.w d2,d3
move.l d3,a0
cmp.l d7,d3
blt ci_l3
bra ci_l2
ci_o2
move.l d3,a0
ci_l4
move.l d0,(a0)+
move.l d1,(a0)+
move.l d0,(a0)+
move.l d1,(a0)+
move.l d0,(a0)+
move.l d1,(a0)+
move.l d0,(a0)+
move.l d1,(a0)+
add.w d2,d3
move.l d3,a0
cmp.l d7,d3
blt ci_l4
bra ci_l2
ci_out
move.w #160,d2
moveq #0,d0
moveq #0,d1
move.l screen,d3
add.l #144+160*20,d3
move.l d3,a0
ci_l5
move.l d0,(a0)+
move.l d1,(a0)+
add.w d2,d3
move.l d3,a0
cmp.l d7,d3
blt ci_l5
rts
dyer
move.w (a2)+,sprtyp
move.l screen,a3
lea 186*160+176/2(a3),a3
tst.w sprtyp
bne dyr_o1
lea (a3),a4
move.b #0,d0
move.b #-1,d2
move.w #95,d1
dyr_l5
move.b d2,(a4)
move.b d0,2(a4)
move.b d0,4(a4)
move.b d0,6(a4)
lea -160(a4),a4
dbf d1,dyr_l5
dyr_o1
move.w (a2)+,d3 number in sequence
move.w #0,d0 sequence pointer
move.w #160/2,d6 x start posn
move.w #160,d7 x end posn
move.w #0,d1 (x posn) AND 15
move.w #8,d5 trunk width
move.w #1,d2 y posn for full height
move.w #96,d4 trunk height
move.w #300,countup
dyr_l1
movem.l d0-d7/a1-a3,-(sp)
bsr wait_fly
asl.w #1,d0
move.w 0(a2,d0),sprnum
; move.l screen,d0
; eor.l #$8000,d0
; move.l d0,a2
; lea 186*160+160/2(a2),a2
lea -8(a3),a4
tst.w sprtyp
bne dyr_o2
lea -96*160(a4),a4
dyr_o2
move.w #48,d3
dyr_l2
move.w #5,d0
dyr_l3
clr.l -(a4)
dbf d0,dyr_l3
; lea -160+24(a2),a2
lea -160+24(a4),a4
dbf d3,dyr_l2
bsr dyersb1
movem.l (sp)+,a1-a3/d0-d7
btst #7,keydat
beq dyr_out
bsr wait_fly
btst #7,keydat
beq dyr_out
bsr wait_fly
btst #7,keydat
beq dyr_out
bsr wait_fly
btst #7,keydat
beq dyr_out
bsr wait_fly
btst #7,keydat
beq dyr_out
bsr wait_fly
subq.w #1,countup
beq dyr_out
addq.w #1,d0
cmp.w d3,d0
bne dyr_l1
clr.w d0
bra dyr_l1
dyr_out
rts
dyersb1
movem.w d2/d6,-(sp)
bra dyersb
line_atXY
jsr XYtoxy(pc)
tst.w d2
beq lXY_out
bmi lXY_out3
movem.w d2/d6,-(sp)
move.w #179,d3
sub.w d2,d3 d3=pix row (from screen top)
lsl.w #2,d2
lea htab(pc),a3
move.w 0(a3,d2),d4 d4 = height
move.w 2(a3,d2),d2 d2 = trunk width ( tw )
move.w d2,d5 d5 = width
; subq.w #1,d4
mulu tree1ht(pc),d4
swap d4
asr.w #1,d2
sub.w d2,d6 wp = wp - tw/2
add.w #64,d6
; tst.w d6
; bmi lXY_out
move.w d6,d1
and.w #$FFF0,d6
lsr.w #1,d6 d6=[16pix] block no.
* 8 bytes per [16pix] .. yes, I know
; add.w #16,d6 black border
sub.w #16,d63B860:
not begg. Maybe stone
bne.s XY_o11
move.w #18,sprnum
move.w d1,stoneposn record stone's current posn
bra XY_o5
XY_o11
cmp.w #5,d0 not stone. Maybe obelisk
bne.s XY_o12
move.w #16,sprnum
bra XY_o5
XY_o12
cmp.w #6,d0 Maybe poo
bne.s XY_o15
lea pooanim(pc),a6
move.w pooP(pc),d6
; and.w #$07,d6
move.b 0(a6,d6),sprnum+1
bra XY_o5
XY_o15
cmp.w #7,d0 Maybe palm
bne.s XY_o5
move.w #22,sprnum
moveq #0,d0
move.w #$C000,tree1ht 3/4 size trunk
XY_o5
move.w d1,stoneposn sprite's current offset
move.w d0,sprtyp save spr type 0=tree 1=bboy etc
cmp.w #$06,d0 Poo ?
bne.s XY_o13
lea POOblk-16(pc),a6
moveq #16,d6
XY_l3
add.l #16,a6
move.w 2(a6),d0 pooY
move.b 0(a6),d0 pooX
cmp.w d1,d0 that poo's posn equal to currnt offset ?
beq.s XY_o20
dbf d6,XY_l3
nop
XY_o20
move.w 0(a6),d1 yes - get X,Y coords in d1,d0
move.w 2(a6),d0
bra XY_o14
* d1 is a cell offset from maz. Turn it into true coords in d0,d1
XY_o13 move.w d1,d0
and.w #$00FF,d1 mmove.w d3,d7
asl.w #7,d7
asl.w #5,d3
add.w d7,d3 mulu #160,d3
move.w d1,d7
and.w #15,d1 d1=pix posn in block ( wp )
add.w d6,d3
ext.l d3
add.l screen(pc),d3
move.l d3,a3 a3 = absolute screen addr ( ps )
; move.w sprnum,d0
; and.w #$FFFE,d0 tree ?
dyersb
tst.w sprtyp
bne lXY_out2 out if not
add.w d1,d5 start x + width = end x
add.w d5,d7
; cmp.w #256,d7
; bge lXY_out
bclr #4,d5 into next [16block]
bne lXY_o2
asl.w #1,d1 *2
asl.w #1,d5
lea Lmasktab(pc),a2
move.w 0(a2,d1),d3 get lh mask
move.w 0(a2,d5),d5 get rh mask
not.w d3
or.w d5,d3
move.w d3,d7
swap d3
move.w d7,d3
; not.l d3
move.w #160,d2
move.l a3,d1 d1 is copy of ps
lXY_l2
; or.l d3,(a3)+
; or.l d3,(a3)+
and.l d3,(a3)+
and.l d3,(a3)+
sub.w d2,d1 ps=ps-160 ie next pix row
move.l d1,a3
dbf d4,lXY_l2
bra lXY_out2
rts
lXY_o2
asl.w #1,d1 *2
asl.w #1,d5
lea Lmasktab(pc),a2
move.w 0(a2,d1),d3 get lh mask
move.w 0(a2,d5),d5 get rh mask
not.w d3
move.w d3,d7
swap d3
move.w d7,d3
move.w d5,d7
swap d5
move.w d7,d5
; not.l d3
; not.l d5
move.w #160,d2
move.l a3,d1 d1 is copy of ps
lXY_l1
; or.l d3,(a3)+
; or.l d3,(a3)+
; or.l d5,(a3)+
; or.l d5,(a3)+
and.l d3,(a3)+
and.l d3,(a3)+
and.l d5,(a3)+
and.l d5,(a3)+
sub.w d2,d1 ps=ps-160 ie next pix row
move.l d1,a3
dbf d4,lXY_l1
bset #31,d1
move.l d1,a3
lXY_out2
move.w d6,d7
movem.w (sp)+,d6/d2
move.l a3,-(sp)
jsr sprite_engine(pc)
move.l (sp)+,a3
tst.l d4
beq lXY_o4
move.l d4,a3
lXY_o4
rts
clr_bords
move.w #160,d2
moveq #0,d0
move.l screen,d3
add.l #160*20+144,d3
move.l d3,a0
move.w #92+68,d1
lXY_l3
; move.l d0,144(a0)
; move.l d0,148(a0)
; move.l d0,152(a0)
; move.l d0,156(a0)
move.l d0,(a0)+
move.l d0,(a0)+
move.l d0,(a0)+
move.l d0,(a0)+
move.l d0,(a0)+
move.l d0,(a0)+
move.l d0,(a0)+
move.l d0,(a0)+
add.w d2,d3
move.l d3,a0
dbf d1,lXY_l3
rts
lXY_out
lea maze,a1
move.w stoneposn(pc),d3
bclr #7,0(a1,d3)
moveq #-1,d3
move.l d3,a3
lXY_out3
rts
;****************************************************************
XYtoxy
lea iQbuff(pc),a1
move.w iconQ(pc),d1
move.w -2(a1,d1),d1 next sprite item
lea maze,a1
move.b 0(a1,d1),d0 what's on it's cell ?
lsr.w #4,d0
and.w #7,d0 just look at sprite bits
bne.s XY_o4 tree ?
lea treeposns(pc),a2 ok let's find out which tree exactly
move.w Ntrees(pc),d2
subq.w #1,d2
XY_l1
cmp.w (a2)+,d1 by searching through treeposns
beq.s XY_o3 until we find it
dbf d2,XY_l1
bra XY_o5 maybe none found (shouldn't)
XY_o3
move.w 2*trees-2(a2),tree1ht this is it. Get its current height
move.w -2*trees-2(a2),d2 get its current anim frame
lea treeanim(pc),a2
move.w 0(a2,d2),sprnum put in sprnum (the one to draw)
bra XY_o5 and carry on
XY_o4
cmp.w #1,d0 not tree. Maybe bboy ?
bne.s XY_o7
move.w #30,sprnum
lea 0(a1,d1),a2 yes - a2 point to that cell
lea bboyblk(pc),a1 a1 points to bboy info
move.w Nbboys(pc),d3 for each bboy...
subq.w #1,d3
XY_l2
cmp.l bboyP(a1),a2 search for same addr
beq.s XY_o6
add.l #bboyblksize,a1
dbf d3,XY_l2
bra XY_o5
XY_o6
move.l a1,bboyuse aha found it
bra XY_o5
XY_o7
cmp.w #2,d0 not bboy. Maybe pod
bne.s XY_o8
move.w #14,sprnum
cmp.w podposn(pc),d1 currently opening pod ?
bne.s XY_o16
lea podanim(pc),a2
move.w podP(pc),d3 yes - where in anim ?
bpl.s XY_o18 end ?
move.w #$8000,podposn yes - mark it
move.w #14,sprnum & draw ordinary pod
bra XY_o5
XY_o16
cmp.w podoff(pc),d1 currently closing pod ?
bne XY_o5
lea podcanim(pc),a2
move.w podcP(pc),d3 yes - where in anim ?
bpl.s XY_o18 end ?
lea maze,a1
and.b #$0F,0(a1,d1)
or.b #$80,0(a1,d1)
move.w #$8000,podoff yes - mark it
moveq #-1,d2 pretend off screen so not drawn
rts
XY_o18
move.w 0(a2,d3),sprnum
bra XY_o5
XY_o8
cmp.w #3,d0 not bboy. Maybe badegg ?
bne.s XY_o9
move.w #6,sprnum
bra XY_o5
XY_o9
cmp.w #4,d0