; Area 51. ; (C) Copyright 2004 Jonathan Cauldwell. ; A game inspired by Manic Miner, an entry for the 2004 Minigame ; Competition, 4k category. ; This game could easily have been made much faster, but in order to ; capture the "feel" of Matthew Smith's games the frame rate has been ; reduced to 12.5 per second. If you want to speed it up to feel ; more like an Egghead game take out a couple of halt instructions. ; This will increase the speed to a smooth 25 frames per second, ; though you will also need to double the number of animation frames ; for the main player sprite or it will look silly. ; As ever in my games coordinates are the reverse of what you'd expect. ; for point (x,y) x indicates the displacement (chars or pixels) from ; the top of the screen, y gives the displacement from the left edge. ; Project started 22.02.2004 @ 22:03. ; Project completed 04.06.2004 @ 20:24. ; 16K version done 04.05.2005 @ ??:??. ; Definitions of constants. SPCATT equ 71 ; space attributes. DEDATT equ 69 ; deadly items attributes. PL1ATT equ 68 ; green platform. OBJATT equ 16+128+1 ; objects attributes. KEYATT equ 16+128+6 ; magic floor attributes. TELATT equ 8+64+6 ; teleporter attributes. ROOMNO equ 31 ; room number bit mask. ALNTYP equ 224 ; alien type bit mask. NUMSCR equ 16 ; number of screens. DPLATF equ 10 ; disappearing platform. FORCEF equ 13 ; forcefield gun. DWALL equ 14 ; disappearing wall. D equ 10 ; disappearing platform. W equ 11 ; blue wall. P equ 12 ; panel. F equ 13 ; forcefield gun. V equ 14 ; vanishing wall. M equ 15 ; magic floor. T equ 16 ; teleport. A equ 18 ; planet A. B equ 19 ; planet B. X equ 20 ; star A. Y equ 21 ; star B. ; Start address to which we're compiling. ; 4K isn't a lot to work with so we'll stick the whole thing in a ; BASIC REM statement located at address 23770. org 24000 xor a ; zero is always black. call 8859 ; set permanent border colour. ; Let's start with the intro screen code. intro ld hl,32000 ; address of second attributes screen. ld de,32001 ; next byte along. ld bc,736 ; length of dummy attributes. ld (hl),2 ; blank first byte. ldir ; blank the rest. ld (hl),69 ; bright cyan on black for bottom line. ld bc,31 ; length of final line. ldir ; colour rest in. xor a ; want zero value in a. ld (23560),a ; load into last keypress system variable. ld hl,text ; start of scrolling message. ld (txtpos),hl ; scrolling text pointer. intro0 ld a,(23672) ; low byte of system clock. rra ; shift right twice to rra ; divide by 4. and 6 ; this gives us our framex2. ld e,a ; put frame number x 2 in e. ld d,0 ; zeroise d so de=e. ld hl,playfr ; player frames. add hl,de ; this is the address of our frame pointer. ld e,(hl) ; low byte of address of sprite. inc hl ; next byte of pointer. ld d,(hl) ; this is the high byte, de=address of graphic. call dpix ld hl,32000 ; dummy attributes area. ld de,22528 ; physical attributes. ld bc,768 ; size of attribute blocks. halt ; wait for electron beam to return. ldir ; transfer to screen. call scrol ; scrolling message. ld a,(23560) ; get keypress. cp 13 ; is it ENTER? jr nz,intro0 ; no, go round again. ; Player pressed enter so initiate the game sequence. ld hl,23693 ; permanent attributes system variable. ld (hl),70 ; bright yellow on black. call 3503 ; clear screen and open screen channel. xor a ; zero in accumulator. ld h,a ; zero in h. ld l,a ; zero in hl pair. ld (score),hl ; score. ld a,5 ; number of lives. ld (lives),a ; set lives counter. ; Now display the extra lives icon at the bottom of the screen. defb 33,164,12 ; load coordinates of extra lives sprite into hl. ld (dispx),hl ; sprite routine coordinates. ld hl,playr2 ; player sprite - facing right. call sprite ; show lives icon. ; Restart here when player completes the game. again ld hl,rmbuff ; no rooms entered yet. ld de,rmbuff+1 ; set room flags to off. ld bc,NUMSCR-1 ; number of screens. ld (hl),b ; erase first byte. ldir ; clear all rooms. xor a ; zero room count. ld (scdone),a ; set number done. getrm call random ; random room number. and 15 ; want in range 0-15. ld (scno),a ; store screen. call rmdis ; get address of room in hl. and a ; is it set? jr nz,getrm ; yes, try another one. ; This is the point at which we start each new screen. rstart xor a ; zeroise accumulator. ld (numobj),a ; number of objects to collect. ld (dflag),a ; player dead flag. ld (toofar),a ; fallen too far flag. ld (fallf),a ; reset "in mid-air" flag. ld (framec),a ; reset frame count. ; Clear alien buffer. ld hl,albuff ; alien buffer. ld (hl),255 ; set first alien to off. ld de,albuff+1 ; alien buffer. ld bc,23 ; size of buffer. ldir ; set all bytes to 255 to switch aliens off. ; Clear forcefield table. ld hl,fftab ; initialise forcefield table. ld de,fftab+1 ld bc,8 ; 3 x 3 = 9 bytes to clear. ld (hl),b ldir ; Reset rocket launch sequence. ld hl,rokseq ; rocket sequence. ld (rokptr),hl ; store rocket sequence pointer. ; Find aliens for present room. ld a,(scno) ; screen number. ld c,a ; put it in c for comparisons. ld ix,albuff ; data for present room. cp 14 ; is it the heavy water screen? jp z,hwinit ; initialise that instead. ld hl,alndat ; alien data table. fndal ld a,(hl) ; get alien entry. cp 255 ; is this the end of the table? jr z,draw ; yes - we're done. and ROOMNO ; mask off the non-room bits. cp c ; is alien located in this room? jr z,fndal0 ; yes, put him in alien buffer. ld de,5 ; 5 bytes/alien. add hl,de ; look for next alien. jr fndal ; go round again. fndal0 ld a,(hl) ; get alien type. and ALNTYP ; mask off non-type bits. ld (ix),a ; put in alien buffer. inc hl ; next byte. ld a,(hl) ; starting x. ld (ix+2),a ; alien starting x coord. ld b,a ; remember starting x. inc hl ; next byte. ld a,(hl) ; starting y. ld d,a ; store starting y. ld (ix+3),a ; put into alien buffer. inc hl ; next byte. ld a,(hl) ; finishing x. cp b ; is it the same as the starting x coord? jr z,fndal1 ; yes, so alien patrols left/right. ld (ix+1),3 ; patrolling up/down. ld (ix+4),b ; starting x position. inc hl ; end y coord. fndal3 ld (ix+5),a ; end coordinate. inc hl ; first byte of next alien in table. ld de,6 add ix,de ; next 6 bytes of buffer. jr fndal ; repeat until all aliens searched. fndal1 ld (ix+1),2 ; patrolling left/right. ld (ix+4),d ; starting y position. inc hl ; next byte of table. ld a,(hl) ; finishing y. jr fndal3 ; put into alien buffer. draw call droom ; draw current room. ; Display the name of the screen below the playfield. ; First we set the coordinates. ld a,22 ; Spectrum's ASCII code for AT control. rst 16 ; print character. ld a,18 ; line 18=screen name. rst 16 ; print character. xor a ; column zero. rst 16 ; print character. ; Now tab across 8 chars leaving a bar behind us. ld hl,23695 ; temporary attributes system variable. ld (hl),79 ; bright white on blue. ld a,23 ; Spectrum's ASCII code for TAB control. rst 16 ; print character. ld a,8 ; column 8. rst 16 ; print character. rst 16 ; ROM needs an extra character but it's ignored. ; Next find the miscellaneous data for this screen. ld a,(scno) ; screen number. rlca ; shift left twice to rlca ; multiply by 4. ld e,a ld d,0 ; put a*4 in de. ld hl,misc ; miscellaneous data. add hl,de ; point to miscellaneous data for this screen. ld e,(hl) ; x coord of player start. inc hl ; next byte. ld d,(hl) ; y coord of player start. inc hl ; next byte. ld (newx),de ; player starts here. ld e,(hl) ; screen title low byte. inc hl ; next byte. ld d,(hl) ; screen title high byte. ; Screen name now pointed to by de registers. ; display characters until we encounter a byte with bit d7 set. pname ld a,(de) ; get char. rla ; shift leftmost bit into carry. ld a,(de) ; get char again. jr c,pname0 ; d7 was set so this is last char of title. rst 16 ; display it. inc de ; next character of string. jr pname ; repeat until we hit the end. pname0 and 127 ; don't want bit d7. rst 16 ; Now tab to end of line leaving bar behind. ld a,23 ; Spectrum's ASCII code for TAB control. rst 16 ; print character. xor a ; start of next line. rst 16 ; print character. rst 16 ; ROM needs an extra character but it's ignored. ; Show status panel text. ld hl,23695 ; temporary attributes system variable. ld (hl),69 ; cyan ink on black background. ld a,22 ; Spectrum's ASCII code for AT control. rst 16 ; print character. ld a,21 ; line 21=score panel. rst 16 ; print character. ld a,4 ; column 4 is lives counter. rst 16 ; print character. ld a,(lives) ; number of lives remaining. add a,'0' ; add ASCII code for zero. rst 16 ; display character. call dscore ; display score. ld de,hitxt ; high score text. ld bc,hilen-hitxt ; length of string. call 8252 ; print string. ld bc,(hisc) ; get score in bc. call 6683 ; ROM routine to display 4-digit number in bc. ; Initially draw the aliens that will patrol this room. ld ix,albuff ; point to first alien. ld b,4 ; number of aliens to draw. draw0 push bc ; store loop counter. call draln ; draw this alien. ld de,6 ; 6 bytes per alien in buffer. add ix,de ; next alien in buffer. pop bc ; restore loop counter. djnz draw0 ; repeat for 3 aliens. ; Draw the player for the first time. call dplayr ; display player. ld hl,ch1dat ; start of music data for channel 1. ld (chptr1),hl ; store channel marker. call chan2c ; call music player for first time. ; Okay, initialisation is over so let's enter the main game loop. mloop ld a,(fallf) ; are we in mid-air? and a jr nz,gravit ; yes. ; So we're walking on solid ground - allow player to move left and right. xor a ; temporary direction. ld (tdir),a ; set marker to say we haven't moved left/right. ld bc,64510 ; port 64510=keyboard row Q-T. in a,(c) ; read this row. ld d,a ; store in d for now. ld b,247 ; port 63486=keyboard row 6-0. in a,(c) ; read this row. and d ; combine with keys Q and T. rra ; Q pressed? push af call nc,mpl ; move player left. pop af rra ; W pressed? call nc,mpr ; move player right. ld a,(tpcdir) ; teleporter colour direction. and a ; is it set? jp nz,telpt ; yes, do teleport stuff. ld bc,32766 ; bottom row keys B - SPACE. in a,(c) ; read port. cpl ; reverse all bits. and 31 ; jump key pressed? jp nz,jump ; yes. ld b,247 ; port 63486=keyboard row 6-0. in a,(c) ; read port. and 16 ; was innermost key pressed? jp z,jump ; fire pressed, so jump. ; Now for the gravity processing. grav call getxy ; get x/y collision positions in dispx. ld a,(dispx) ; vertical position. add a,16 ; look 16 pixels down at what's underfoot. ld (dispx),a ; we'll use these coords then. call fpblk ; find floor, test for objects and spikes etc. cp SPCATT ; is it space colours? jp nz,grav0 ; not falling. call endxy ; right edge collision coordinates. call fpblk ; what's under the player. cp SPCATT ; space colours? jp nz,grav0 ; not falling. ; We are moving vertically at this point. gravit ld a,(fallf) ; were we falling already? and a jr nz,gravd0 ; yes. ; We weren't falling before - need to set up jump so we're falling. ld (jdir),a ; set jump direction so no left/right. ld hl,jtabd ; beginning of fall sequence. ld (jptr),hl ; set jump pointer. inc a ld (fallf),a ; set falling flag. ; In mid-air, we could be ascending or descending. gravd0 ld a,(jdir) ; left/right movement. rra ; moving left? push af ; store accumulator and flags. call c,mpl ; yes - go left. pop af ; restore accumulator. rra ; moving right? call c,mpr ; yes - go right then. ld hl,(jptr) ; pointer to jump table. ld a,(hl) ; x displacement. cp 128 ; 128=we've fallen too far. call z,gravd1 ; call routine to set "death from falling" flag. inc hl ; next vertical displacement in jump table. ld (jptr),hl ; set new pointer. cp 0 ; no movement. jp z,grav2 cp 128 ; in which direction are we heading? jr nc,gravd2 ; going down. ; Ascending. ld b,a ; going up - set counter. gravu0 push bc ; put loop count on stack. call getxy ; put x+y displacement coordinates in dispx. ld hl,dispx ; displacement. dec (hl) ; look up. ld a,(hl) ; check x coordinate. inc a ; are we going off the top of the screen? jr z,gravu1 ; yes, so can go no further. call fnpblk ; get block and test for deadly spikes etc. cp SPCATT ; solid? jr nz,gravu1 ; yes - we've hit the roof. call endxy ; get right edge x+y displacements in dispx. call fnpblk ; find block at this position. cp SPCATT ; solid? jr nz,gravu1 ; yes - we've hit the roof. ld hl,newx ; move okay, get x coord (vertical). dec (hl) ; move up. pop bc ; fetch loop count from stack. djnz gravu0 ; keep going until move complete. jp grav2 gravu1 pop bc ; pop bc from stack and discard. ld hl,jtabd ; start of descent table. ld (jptr),hl ; set jump pointer so player starts to fall. jp grav2 ; Descending. gravd2 neg ; going down - negate displacement. ld b,a gravd4 push bc call getxy ; x/y collision coords in dispx. ld a,(newx) ; x coordinate of player. add a,16 ; look under feet - 16 pixels down. ld (dispx),a ; new x coord. call fpblk ; landed yet? cp SPCATT ; space colours? jr nz,gravd5 ; Not falling. call endxy ; right edge collision coordinates. call fpblk ; do test for objects, spikes etc. cp SPCATT ; space colours? jr nz,gravd5 ; Not falling. ld hl,newx ; x coord (vertical). inc (hl) ; move down. pop bc djnz gravd4 ; repeat until we've fallen correct distance. jp grav2 gravd1 ld (toofar),a ; set flag to say too far. dec hl ld a,(hl) ret gravd5 pop bc ; hit a surface so stop falling. ; So we've hit or are standing on the ground then. grav0 ld a,(fallf) ; were we falling previously? cp 0 jr z,grav2 ; no - we're just standing. xor a ld (fallf),a ld a,(toofar) ; we've landed - have we fallen too far? cp 0 jr z,grav2 ; no, the fall wasn't fatal. call die ; strawberry jam! ; Okay, we now know the new coordinates of the player. Delete the old ; sprite and redisplay the new one at the new position. grav2 call dplayr ; redisplay sprite with exclusive-or to delete it. ld hl,(newx) ; new coords. ld (playx),hl ; make these the next coordinates. ld a,(ndirec) ; new direction. ld (direct),a ; set new direction. call dplayr ; display new sprite. ld a,(dflag) ; is player dead or alive? and a ; zero result indicates he's alive. jr nz,killim ; he's dead. ld a,(numobj) ; objects left to collect. and a ; zero means screen is finished. jr z,nexlev ; screen complete. ld ix,albuff+18 ; address of final hard water droplets. ld a,(scno) ; get screen number. cp 14 ; is it the hard water one? call z,dmraln ; yes, display 4th set of hard water. halt ; wait for screen refresh. ld ix,albuff ; address of the first alien table entry. call dmrals ; delete, move and redraw alien. call drff ; draw forcefields. call ffcol ; forcefield collision detection. halt ; wait for screen refresh. ld ix,albuff+6 ; address of alien. call dmraln ; delete, move and redraw alien. ld bc,49150 ; port 49150 reads the keyboard row H-ENTER. in a,(c) ; read port. cpl ; turn zeroes into ones and vice versa. and 31 ; test all keyboard bits. call nz,pause ; pause pressed. ld a,(23672) ; system clock low byte. and 12 call z,chan2 ; music. halt ; wait for screen refresh. ld ix,albuff+12 ; third alien. call dmraln ; delete, move and redraw alien. ld hl,framec ; frame counter. inc (hl) ld a,(hl) ; check its value. and 31 call z,toggle ; toggle platforms off. halt ; wait for screen refresh. jp mloop ; back to beginning of main loop. ; Death sequence. killim ld hl,15616 ; address of ROM character set. ld b,l ; zero in b register. kill0 ld a,(hl) ; byte from character set. out (254),a ; drive border/speaker/ear socket. kill1 dec a ; decrement byte. jr nz,kill1 ; repeat delay loop. inc hl ; next byte of ROM. djnz kill0 ; repeat 256 times. ld hl,lives ; lives counter. dec (hl) ; subtract life. jr z,lost ; zero remaining so player has lost. call fade ; fade to black. jp rstart ; not reached zero so restart screen. ; Next level. ; First of all let's animate a bonus of 100. nexlev ld b,100 ; bonus = 100 points. nexlv0 push bc ; store counter. ld l,b ; make hl=b (pitch of sound). ld h,0 ; high byte = zero. ld de,1 ; duration. call 949 ; make sound. ld hl,(score) ; read new score. inc hl ; add 1. ld (score),hl ; write new score. call dscore ; display score. pop bc ; restore loop control. djnz nexlv0 ; repeat. ; Now fade to black and move onto the next level. call fade ; fade to black ld a,(scno) ; get screen number. call rmdis ; get room status. ld (hl),h ; set it so we don't hit it again. ld hl,scdone ; screens completed. inc (hl) ; next one please. ld a,(hl) ; how many done so far? cp NUMSCR ; gone past last one? jp c,getrm ; no, carry on. ld (hl),0 ; restart on first level. ld hl,lives ; lives counter. inc (hl) ; give player one more life. jp again ; clear room buffer and restart. ; Find room flag byte to see if it has been encountered before. rmdis ld e,a ; low byte of displacement. ld d,0 ; buffer is small, so no high byte. ld hl,rmbuff ; room uffer address. add hl,de ; add displacement for this room. ld a,(hl) ; get flag for this room. ret ; Player has lost all lives. lost ld hl,23695 ; temporary attributes system variable. ld (hl),87 ; bright white on red. ld de,gotxt ; game over text. ld bc,gotxt0-gotxt ; length of string. call 8252 ; call ROM routine to display it. ; Three second delay - waits for 150 interrupts. ld b,150 ; 50 iterations required. delay0 halt ; wait for an interrupt. djnz delay0 ; decrement b and loop until zero. ld hl,(hisc) ; high score. ld de,(score) ; player's final score. and a ; reset carry flag. sbc hl,de ; is player's score the higher of the two? jp nc,intro ; no, restart intro. ld hl,(score) ; final score. ld (hisc),hl ; make this the new high score. jp intro ; restart game. ; Game over message, displayed at end of game. gotxt defb 22,9,10 defb ' GAME OVER ' gotxt0 equ $ ; Move player left. mpl ld a,1 ; direction 1 = left. ld (tdir),a ; set temp direction. call getxy ; get coords in dispx. ld hl,dispy ; horizontal position of player. dec (hl) ; look one pixel left. call fnpblk ; find block here. cp SPCATT ; is there a wall in the way? ret nz ; yes, so can't move left. ld de,32 ; next block = 32 bytes down. add hl,de ; one row down. call npblk ; do test for objects, spikes etc. cp SPCATT ; is there a wall in the way? ret nz ; yes, so can't move left. ld a,(newx) ; player's x coord. and 7 ; are we on a character boundary? jr z,mpl0 ; yes - no need to check third block then. add hl,de ; one row down. call npblk ; do test for objects, spikes etc. cp SPCATT ; is there a wall in the way? ret nz ; yes, so can't move left. mpl0 ld hl,newy ; y coord of player. ld a,(hl) ; test it. cp 2 ; are we already at left edge? ret c ; 'fraid so, can't go any further. dec (hl) dec (hl) ; 2 pixels left. xor a ; zeroise accumulator. ld (ndirec),a ; facing direction = left. ret ; Move player right. mpr ld a,2 ; direction 2 = right. ld (tdir),a ; set temp direction. call endxy ; get right side coords in dispx. ld hl,dispy ; horizontal position of player. inc (hl) ; look one pixel right. call fnpblk ; find block here. cp SPCATT ; is there a wall in the way? ret nz ; yes, so can't move right. ld de,32 ; next block = 32 bytes down. add hl,de ; one row down. call npblk ; do test for objects, spikes etc. cp SPCATT ; is there a wall in the way? ret nz ; yes, so can't move left. ld a,(newx) ; player's x coord. and 7 ; are we on a character boundary? jr z,mpr0 ; yes - no need to check third block then. add hl,de ; one row down. call npblk ; do test for objects, spikes etc. cp SPCATT ; is there a wall in the way? ret nz ; yes, so can't move left. mpr0 ld hl,newy ; y coord of ship. ld a,(hl) cp 244 ; at right edge? ret nc ; yes - can't move right. inc (hl) inc (hl) ; 2 pixels right. ld a,8 ; 8 = right. ld (ndirec),a ; facing direction = right. ret ; Display score. dscore ld de,sctxt ; score text. ld bc,sclen-sctxt ; length of string. call 8252 ; print string. ld bc,(score) ; get score in bc. jp 6683 ; ROM routine to display 4-digit number in bc. sctxt defb 22,21,9 defb 'Score: ' sclen equ $ hitxt defb 22,21,21 defb 'High: ' hilen equ $ ; Pause routine. There's no need to switch off the music as it uses the ; envelope generator which takes care of itself. pause di ; switch off system variable clock. pause0 in a,(c) ; read port. cpl ; reverse bits. and 31 ; test keyboard bits. jr nz,pause0 ; wait for release. pause1 in a,(c) ; read port. cpl ; reverse bits. and 31 ; test keyboard bits. jr z,pause1 ; wait for keypress. pause2 in a,(c) ; read port. cpl ; reverse bits. and 31 ; test keyboard bits. jr nz,pause2 ; wait for release. ei ; clock back on. ret ; Heavy water initialisation. hwinit ld bc,12*256+11 ; amount to initialise and starting y. hwini0 call random ; give me a random number please. and 127 ; don't want it off the screen. ld (ix),a ; set the x coordinate. ld (ix+1),c ; set the y coordinate. ld a,24 ; 24 pixels along. add a,c ; add to last y coordinate. ld c,a ; set new position. inc ix ; move ix on 2 bytes. inc ix djnz hwini0 ; repeat for rest of water. jp draw ; done, so draw screen. ; Draw the heavy water. hwat ld l,(ix) ; get x coordinate. ld h,(ix+1) ; same for y. ld (dispx),hl ; set up general coordinates. call plot ; plot the position. ld l,(ix+2) ; get x coordinate. ld h,(ix+3) ; same for y. ld (dispx),hl ; set up general coordinates. call plot ; plot the position. ld l,(ix+4) ; get x coordinate. ld h,(ix+5) ; same for y. ld (dispx),hl ; set up general coordinates. jp plot ; plot the position. ; Forcefield data table. ; First byte = x coord (0=off) ; Second byte = y coord ; Third byte = period. fftab defb 0,0,0 defb 0,0,0 defb 0,0,0 ffchr defb 0 ffchar defb 24,12,6,12,24 defb 48,96,48,24 defb 48,96,48,24 defb 12,6,12 defb 0,32,112,216 defb 141,7,2,0 defb 0,2,7,141 defb 216,112,32,0 drff ld ix,fftab ; forcefield table. ld b,3 ; up to 3 can be present on screen. drff0 push bc ; keep count. ld a,(ix) ; get x position. and a ; is it switched on? call nz,drff1 ; yes, draw the forcefield then. ld de,3 ; distance to next one. add ix,de ; point to it. pop bc ; restore count. djnz drff0 ; repeat until all drawn. ret ; Draw our forcefield. drff1 inc (ix+2) ; increment period byte. ld a,(ix+2) ; see what it is. and 32 ; is bit d5 set? ret z ; no, nothing to display. ld a,(ix+2) ; get period byte again. and 3 ; check lowest 3 bits. jr z,drff2 ; set to zero. cp 3 ; all bits set? ret nz ; no, nothing to do. drff2 ld l,(ix) ; get x byte. ld h,(ix+1) ; get y byte. ld (dispx),hl ; set up in general purpose dispx. ld b,2 ; height of field. drff3 push bc ; store height byte. ld a,(ix+2) ; period byte. rla ; multiply by 2. ; rla ; multiply by 4. and 8 ; use period as zero or eight. ld hl,ffchar ; forcefield image chars. ld e,a ; place in low byte of de. ld d,0 ; no high byte. add hl,de ; add char displacement. call chadd ; get char address in de. ex de,hl ; swap source and target. ld b,8 ; bytes to write. drff4 ld a,(de) ; get source. xor (hl) ; merge with screen image. ld (hl),a ; write new image. inc de ; next source byte. inc h ; next screen line. djnz drff4 ; repeat until character drawn. ld hl,dispx ; x coordinate. inc (hl) ; next one down. pop bc ; restore char count. djnz drff3 ; do second character. jr drff1 ; move on and draw next frame. ; Forcefield collision detection routine. ffcol ld ix,fftab ; table of forcefields. ld b,3 ; maximum allowed on screen. ffcol1 push bc ; remember which one we're on. ld a,(ix) ; check if enabled. and a ; is this forcefield set up? call nz,ffcol0 ; yes - check for collision with player. pop bc ; restore forcefield count. ld de,3 ; distance to next one. add ix,de ; point to next forcefield. djnz ffcol1 ; next in table. ret ffcol0 call getxy ; get x/y collision positions in dispx. ld a,(ix) ; forcefield x. rlca ; multiply by 8. rlca rlca ld b,a ; place in b register for comparison. ld a,(dispx) ; player's x coordinate. cp b ; check against field x coordinate. ret nz ; not the same, so no collision. ld a,(ix+1) ; forcefield y. rlca ; multiply by 8. rlca rlca ld b,a ; place in b register for comparison. ld a,(dispy) ; player's y coordinate. sub b ; subtract field y coordinate. cp 8 ; is player left edge within field cell? jr c,ffcol2 ; yes, player is within range. call endxy ; get player's right edge coordinate. sub b ; subtract field y position. cp 8 ; is player's edge within field cell? ret nc ; no, we're okay then. ffcol2 ld a,(ix+2) ; get period to see if currently on. and 32 ; is it on? ret z ; no, it's okay. jp die ; Looks like we're fried. ; Plots a 4-pixel square on the screen. ; Calls scadd to calculate screen address and uses small table of pixel ; values to write to this address. plot call scadd ; get pixel address in de. ex de,hl ; let's have the result in hl instead. ld a,(hl) ; see what's already there. xor 24 ; XOR with pixels. ld (hl),a ; put back on screen. ld a,(dispx) ; fetch vertical position. inc a ; look one square down. and 63 ; are we moving to another segment? jr z,plot1 ; yes, point to next one. and 7 ; are we changing to another cell? jr z,plot2 ; yes, change address accordingly. inc h ; next pixel line down within current cell. plot0 ld a,(hl) ; present screen image. xor 24 ; set middle two pixels. ld (hl),a ; write to screen. ret plot1 ld de,32 ; 32 bytes to start of next segment. add hl,de ; point there. jr plot0 plot2 ld de,63776 ; minus 1760 bytes to start of next cell. add hl,de ; point there. jr plot0 ; Pseudo-random number generator. ; Steps a pointer through the ROM (held in seed), returning the contents ; of the byte at that location. random ld hl,(seed) ; pointer to ROM. ld a,h cp 58 ; approaching end of "random" area? jr nc,rand0 ; yes - reset pointer. ld a,r ; god knows what this might be set to. xor (hl) ; get "random" number from location. xor l ; more randomness. inc hl ; increment pointer. ld (seed),hl ret rand0 ld hl,0 ; Reset pointer. ld (seed),hl ret seed defw 0 ; Table of pointers to compressed screen data. comptr defw lev1sc,lev2sc,lev3sc,lev4sc defw lev5sc,lev6sc,lev7sc,lev8sc defw lev9sc,lev10s,lev11s,lev12s defw lev13s,lev14s,lev15s,lev16s ; Display room we're in. ; Each room is made up of 18 rows and 32 columns of character blocks, ; which means that each room takes up 576 bytes. To find the address ; of the data for a room we multiply the room number by 576. Normally ; we would achieve this with a few shifts and a couple of additions ; but for the sake of saving memory we'll have a simple addition loop. droom ld hl,0 ; x and y at origin (0,0). ld (dispx),hl ; set cursor position. ld hl,22528 ; address of attributes. ld (tmp0),hl ; store in tmp0 for later. ld a,(scno) ; current room. rlca ; multiply by 2. ld e,a ; displacement in e. ld d,0 ; make high byte of de zero. ld hl,comptr ; table of compressed screens pointers. add hl,de ; point to relevant screen. ; HL now points to the address at which the screen pointer is held. ld e,(hl) ; first byte of address. inc hl ; point to high byte. ld d,(hl) ; next byte of address. ex de,hl ; put screen address in hl. call decomp ; decompress screen layouts. ; Right then, our screen should now be set up in scdata. ld hl,scdata ; point to start of screen. droom3 ld b,18 ; screen is 18 rows high. droom2 push bc ; push row counter. ld b,32 ; screen is 32 columns wide. droom1 push bc ; push column counter. push hl ; store pointer to data block. ; Find address displacement for character block at (dispx, dispy). ld a,(hl) ; get block number. push af ; store block number. cp FORCEF ; is it a forcefield? call z,ffbeg ; yes, begin forcefield here. pop af ; block number. push af ; store block number. call bladd ; get block address in hl. call chadd ; get character cell address. ld b,8 ; 8 bytes per block. droom0 ld a,(hl) ; block graphic data. ld (de),a ; transfer to screen. inc hl ; next byte to transfer. inc d ; next pixel line on screen. djnz droom0 ; repeat for rest of character block. pop af ld hl,blcols ; block colours. ld e,a ld d,0 add hl,de ld a,(hl) ; get block attributes. ld hl,(tmp0) ; next attribute address to write. ld (hl),a ; place on screen. inc hl ; point to next attribute square. ld (tmp0),hl ; store in tmp0 for next iteration. cp OBJATT ; is it an object for the player to collect? jr nz,droom4 ; no, skip object count. ld hl,numobj ; number of objects on screen. inc (hl) ; add 1. droom4 ld hl,dispy ; current column. inc (hl) ; move display position 1 char right. pop hl ; restore address of room data. inc hl ; next byte of room data. pop bc ; pop column counter. djnz droom1 ; next column. ld de,(dispx) ; row and column in de. inc e ; move 1 row down. ld d,0 ; start again at column 0. ld (dispx),de ; return new row and column positions. pop bc ; pop row counter. djnz droom2 ; next row. ret ; This routine places entries in the forcefield table. ffbeg ld hl,fftab ; address of forcefield table. ld b,3 ; maximum forcefields. ffbeg1 ld a,(hl) ; get entry. and a ; is this entry empty? jr z,ffbeg0 ; yes - fill it. ld de,3 ; distance to next forcefield entry. add hl,de djnz ffbeg1 ; next entry in table. ret ffbeg0 ld a,(dispx) ; get x character position. inc a ; field starts one cell down. ld (hl),a ; place in table. inc hl ; point to y coordinate element. ld a,(dispy) ; y char position. ld (hl),a ; put that into table. inc hl push hl call random ; get random start time. ffper3 and 31 pop hl ld (hl),a ; put start time in table. ret ; Patrolling alien handling routines. ; Draw the alien to which ix points. ; Each sprite type has a list of four two-byte pointers which ; give the address of the sprite to be used for each frame. ; The sprites position on the screen determines which of these ; four frames are to be used. draln ld a,(scno) ; get screen number. cp 14 ; is it the heavy water one? jp z,hwat ; do that instead. ld a,(ix) ; does alien exist? inc a ; is it switched on? ret z ; no, he's been switched off. dec a ; get alien. ; and 127 ld l,(ix+2) ; get vertical position. ld h,(ix+3) ; get horizontal position. ld (dispx),hl ; sprite coords. ld a,(ix) ; get contents of sprite type byte. rra ; type is in bits d5-d7, so rotate rra ; into bits d3-d5 for multiples of 8. and 56 ; discard the bits we don't want. ld e,a ; put sprite type in e. ld d,0 ; now in de. ld hl,alnptr ; pointer to alien sprite pointers. add hl,de ; now pointing to a table of 4 pointers. ld a,(dispx) ; get vertical position. ld b,a ld a,(dispy) ; horizontal position. or b ; combine horizontal and vertical. and 6 ; position on screen tells us frame. ld e,a ; this is the frame displacement. add hl,de ; this one of the four frames. ld e,(hl) ; low byte of sprite address. inc hl ; next byte of pointer. ld d,(hl) ; high byte of sprite address. ex de,hl ; put the sprite address in hl. jp sprite ; draw the sprite. rokptr defw rokseq ; rocket sequence pointer. rokseq defb 240,8,240,32,0,104,240,80 DEFB 0,56,0,80,240,32,0,104 defb 255 ; end of table, restart launch sequence. ; Move a rocket left or right. movrk ld a,(ix) ; get alien type. cp 160 ; is it left-to-right? jr z,movrk0 ; yes, move right. ld a,(ix+3) ; y coordinate. sub 16 ; sixteen pixels left. jr c,movrk1 ; hit edge of screen, switch rocket off. ld (ix+3),a ; new position. ret movrk0 ld a,(ix+3) ; y coordinate. add a,16 ; sixteen pixels right. jr c,movrk1 ; hit edge of screen, switch rocket off. ld (ix+3),a ; new position. ret movrk1 ld (ix),255 ; switch off rocket. ret ; Move the alien to which the ix registers are pointing. movals ld a,(scno) ; get current screen. cp 8 ; is it the rocket screen? jr nz,movaln ; no, just do normal alien patrol. ; Move rockets. Only works for first in buffer. ld a,(framec) ; get frame counter. and 31 ; reached launch point? jr nz,movrk ; not yet, move rocket. ld hl,(rokptr) ; rocket sequence pointer. ld a,(hl) ; get type. cp 255 ; reached end of table yet? jr nz,launc0 ; no, don't restart. ld hl,rokseq ; rocket sequence. ld a,(hl) ; get first byte. launc0 ld (ix+3),a ; set y position. inc hl ; next element. and a ; is it left? jr nz,launc1 ; no, it's right. ld (ix),160 ; alien types 160, number 8. jr launc2 launc1 ld (ix),192 ; alien type 192, number 9. launc2 ld a,(hl) ; get x position. ld (ix+2),a ; set coordinate. inc hl ; next element. ld (rokptr),hl ; store rocket sequence pointer. ret ; Traditional alien movement. movaln ld a,(scno) ; get screen number. cp 14 ; is it the heavy water one? jp z,movhw ; do that instead. ld a,(ix+1) ; alien movement type (0=vertical, 1=horizontal). rra jr c,movav ; move vertical. rra jr c,movar ; move alien right. ; Move alien left. moval ld a,(ix+3) ; get y coordinate. sub 2 ; move left. ld (ix+3),a cp (ix+4) ; reached mimimum yet? jr z,movax ; yes - change direction. jr c,movax ret ; Move alien right. movar ld a,(ix+3) ; get y coordinate. add a,2 ; move right. ld (ix+3),a cp (ix+5) ; reached maximum yet? jr nc,movax ; yes - change direction. ret ; Move alien vertically. movav rra jr c,movad ; Move alien up. movau ld a,(ix+2) ; get x coordinate. sub 2 ; move up. ld (ix+2),a cp (ix+4) ; reached mimimum yet? jr z,movax ; yes - change direction. ret ; Move alien down. movad ld a,(ix+2) ; get x coordinate. add a,2 ; move down. ld (ix+2),a cp (ix+5) ; reached maximum yet? jr nc,movax ; yes - change direction. ret ; Change alien direction. movax ld a,(ix+1) ; direction flag. xor 2 ; switch direction. ld (ix+1),a ret dmrals call draln ; delete it. call movals ; move alien. call draln ; re-draw it. jr alcol dmraln call draln ; delete it. call movaln ; move alien. call draln ; re-draw it. ; Now drop through into alcol to check for collision with player sprite. ; Alien collision detection. alcol ld a,(scno) ; get screen number. cp 14 ; is it the hard water screen? jr z,hwcol ; yes, so treat differently. ld a,(ix) ; does this alien exist? inc a ; all bits set means off. ret z ; no, he's been switched off. call getxy ; get x/y collision positions in dispx. ld a,(dispx) ; player's x coordinate. sub (ix+2) ; subtract alien's x coordinate. jr nc,alcol0 ; result is positive. neg ; result is negative so make positive. alcol0 cp 16 ; are they less than 16 pixels apart vertically? ret nc ; no, so they cannot have collided. ld a,(dispy) ; player y coord. sub (ix+3) ; subtract y coordinate of alien. cp 16 ; is result less than 16? jr c,die ; yes, so sprites have collided. call endxy ; player's right edge coordinates. ; ld a,(dispy) ; put player right edge coord in accumulator. sub (ix+3) ; subtract alien left edge coordinate. cp 16 ; is result less than 16? ret nc ; no, so there's no collision. ; Set a flag to say player is dead. die ld hl,dflag ; flag indicates when player is dead. ld (hl),h ; non-zero value means it's curtains. ret ; job done! ; Hard water collision detection. hwcol ld b,3 ; droplets to check. push ix ; store pointer to drop. hwcol0 call getxy ; put positions in dispx and dispy. ld a,(dispx) ; want x coordinate of player. sub (ix) ; check against raindrop x. add a,15 ; make sure it's positive. cp 17 ; in range 0-16? jr nc,hwcol1 ; no, check next drop. ld a,(dispy) ; get y coordinate of player. sub 2 ; look left as drop is two pixels wide. sub (ix+1) ; subtract y coordinate of drop. jr nc,hwcol1 ; drop is left of player so check another. call endxy ; get player's right edge. sub (ix+1) ; subtract dot position. call nc,die ; not to the right, so kill player. hwcol1 inc ix ; move drop pointer on. inc ix djnz hwcol0 ; repeat for all droplets. pop ix ; restore drop pointer. ret jump ld a,(fallf) ; get falling flag. cp 0 ; already in mid-air? ret nz ; yes, so we can't jump. ld hl,jtabu ; start of leap table. ld (jptr),hl ; set leap pointer. inc a ; accumulator now set to 1. ld (fallf),a ; set flag to say we're moving vertically. ld a,(tdir) ; direction in which we are moving. ld (jdir),a ; set jump direction. ld a,(playy) ; player's y position. ld (newy),a ; restore it. jp gravd0 movhw ld l,(ix) ; x position. ld h,(ix+1) ; y position. call movhw1 ; move raindrop. ld (ix+1),h ; set y if changed. ld (ix),l ; new x coordinate. ld l,(ix+2) ; x position. ld h,(ix+3) ; y position. call movhw1 ; move raindrop. ld (ix+3),h ; set y if changed. ld (ix+2),l ; new x coordinate. ld l,(ix+4) ; x position. ld h,(ix+5) ; y position. call movhw1 ; move raindrop. ld (ix+5),h ; set y if changed. ld (ix+4),l ; new x coordinate. ret ;movhw1 push hl movhw1 inc l ; 1 pixel down. ld a,l ; check coordinate. cp 144 ; hit bottom of screen? jr nc,movhw0 ; yes, start a new one then. ; inc l ; look down for second pixel. ld (dispx),hl ; set up coords in dispx. ; dec l ; only want to fall one pixel per frame. call scadd ; get address for this coordinate. ld a,(de) ; get screen byte there. and 24 ; check middle 2 pixels. ret z ; nothing there, we're okay. ; Hit something on the way down. call hwcol ; kill player if it's him. ; Start a new dot at the top of the screen. movhw0 call random ; get random y coordinate. and 248 ; multiples of 8 only. add a,3 ; only want middle pixels of byte. ld h,a ; that's the y. ld l,0 ; x coordinate is zero for the top of the screen. ret newx defb 20 newy defb 20 playx defb 20 playy defb 20 ; Jump table. ; Values 1-6 are going up, 250-255 are going down. ; When we hit value 128 the player has fallen too far. jptr defw 0 jtabu defb 6,5,4,3,2,2 defb 1,1,1,0,1,0 jtabd defb 255,0,255 defb 255,255,254 defb 254,253,252 defb 251,250,250 defb 250,250,128 tpcdir defb 0 ; teleport sequence colour "direction". tpaptr defw 0 ; teleporter attribute pointer. telpt call telseq ; do next bit of sequence. jp grav ; back to main loop. ; Start the teleportation sequence. telpl ld de,65472 ; effectively minus 64. add hl,de ; 2 character cells above. ld (tpaptr),hl ; teleport attribute pointer. ld a,255 ; direction = minus one. ld (tpcdir),a ; set teleporter colour direction (7 to zero). ret telseq ld hl,(tpaptr) ; get attributes address. ld a,(tpcdir) ; get colour direction, up or down. add a,(hl) ; get new colour. telsq1 ld (hl),a ; apply to screen. ld de,32 ; next attribute row. add hl,de ; look down. ld (hl),a ; write this attribute. and 7 ; check ink bits. jr z,telsq0 ; it's black. cp 7 ; reached white yet? ret nz ; no. xor a ; zero accumulator. ld (tpcdir),a ; teleportation complete, resume game. ret telsq0 ld a,1 ; going up from black to white now. ld (tpcdir),a ; set new direction. defb 33,0,238 ; coordinates at which to re-appear. ld (newx),hl ; set coords. ld hl,22558 ; new attributes location. ld (tpaptr),hl ; set attribute pointer. ld a,65 ; blue ink on black paper. jr telsq1 ; Toggle on/off platforms. toggle ld hl,scdata ; screen address. ld (tmp0),hl ; address of char at this point. ld hl,22528 ; address of attributes. ld (tmp1),hl ; store away for later. ld hl,(dispx) ; take coordinates. push hl ; place on stack for later. xor a ; zeroise accumulator. ld (dispx),a ; start at top. toggl2 xor a ld (dispy),a toggl1 ld hl,(tmp0) ; get block pointer. ld a,(hl) ; find block. frig1 cp DPLATF ; we're looking for disappearing platform. call z,toggl0 ; found that kind of block. ld hl,(tmp0) ; get block pointer. inc hl ; next pointer. ld (tmp0),hl ; store new pointer. ld hl,(tmp1) ; attribute address. inc hl ; move to next attribute cell. ld (tmp1),hl ; store new address. ld hl,dispy ld a,(hl) ; check position. inc a ; move one char to right. and 31 ; reached right edge? ld (hl),a ; new position. jp nz,toggl1 ; no, so keep going. dec hl ; dispx. inc (hl) ; move down one line. ld a,(hl) ; check position. cp 18 ; hit the bottom yet? jp nz,toggl2 ; no, continue. pop hl ; retrieve coordinates from stack. ld (dispx),hl ; restore dispx coordinates. ret toggl0 ld a,(hl) ; what is char at this position? call bladd ; find block address. call chadd ; get cell's screen address. ld b,8 toggl3 ld a,(de) ; screen contents. xor (hl) ; xor with graphic. ld (de),a ; put new value back. inc d ; next line on screen. inc hl ; next bit of block. djnz toggl3 ld a,(framec) ; frame counter dictates what we're putting here. and 32 ; is it a platform? frig2 jr z,toggl4 ; yes. ld a,SPCATT ; background colour. toggl5 ld hl,(tmp1) ; attribute address. ld (hl),a ret toggl4 ld hl,(tmp0) ; byte which points to char. ld e,(hl) ; low byte of displacement. ld hl,blcols ; block colours. ld d,0 ; de = displacement for this block. add hl,de ; point to source attribute address. ld a,(hl) ; colour of square. jr toggl5 ; fnpblk just calls fblk then does a relative jump to npblk. ; It's basically just there to save a few bytes. fnpblk call fblk ; find floor. jr npblk ; non-passable block test. ; fpblk just calls fblk then drops through to pblk. fpblk call fblk ; find floor. ; Test block. Does checking for items, spikes and platforms. ; We set b=1 if platforms are solid, zero for walk-through. pblk ld b,1 ; platforms are solid. jr tblk npblk ld b,0 ; platforms are passable. tblk ld a,(hl) ; what attribute does the current block have? cp SPCATT ; empty space? ret z ; okay to move there then. cp DEDATT ; deadly? jr z,tblk0 ; yep, set flag to say player is dead. cp OBJATT ; is it a collectable object? jp z,getit ; it is, let's pick it up then. rr b ; are platforms solid? jr nc,tblk2 ; no - allow player through. ; So platforms are solid. We must be checking attributes underfoot, ; therefore we don't need to check when the player is straddling ; character rows, otherwise he'll walk "inside" platforms. ld a,(newx) ; player's x position. and 7 ; is he straddling blocks? jr nz,tblk1 ; yes, he's missed this platform. ; Okay, let's see if player is walking on a wall or platform. ld a,(hl) ; get attribute again. cp TELATT ; is it the teleporter? jp z,telpl ; teleport player. cp KEYATT ; is it magic floor? ret nz ; return - anything other than SPACE is solid. ; Player is standing on a magic floor. res 7,(hl) ; stop magic floor flashing. ; Utilise the platform toggle code to open a magic door for the player. ; We're working in 16K so self-modifying code is probably the only option. ld a,DWALL ; disappearing walls. ld (frig1+1),a ; that's what to look for. ld a,62 ; opcode to load accumulator - no purpose. ld (frig2),a ; that's what to look for. call toggle ; open sesame. ; Now put the platform toggle code back to the way it was. ld a,DPLATF ; disappearing platforms. ld (frig1+1),a ; that's what to look for. ld a,40 ; opcode for jump relative if zero set. ld (frig2),a ; that's what to look for. ret ; return, accumulator says block is solid. ; Okay, let's see if player is going through a platform or wall. tblk2 and 56 ; all platforms are black (0) PAPER. jr z,tblk1 ; it's a platform so can go through. ret ; it must be a wall then - block progress. tblk0 call die ; set death flag. tblk1 ld a,SPCATT ; allow player to progress through block. ret ; Picked up an item. getit ld (hl),SPCATT ; set attribute to white on black. push hl ld hl,numobj ; number of objects left to collect. dec (hl) ; subtract 1. ld hl,(score) ; get score. ld de,10 ; 10 points per item. add hl,de ; increment score. ld (score),hl ; increment it. call dscore ; display score. pop hl jr tblk1 ; return with SPCATT to say we can pass. ; Find character block at (dispx, dispy) for collision detection. fblk ld a,(dispx) ; displacement from top of screen. rlca ; for each 8 pixels down we move 32 rlca ; bytes down screen data. ld c,a ; store in c for later. and 224 ; rows are multiples of 32. ld l,a ; part of low byte. ld a,(dispy) ; displacement from left edge. rra ; 3 right shifts rra ; effectively divide rra ; coordinate by 8. and 31 ; discard anything shifted into high bits. add a,l ; splice with low byte. ld l,a ld a,c and 3 or 88 ; 88 x 256 = 22528 = start of attributes data. ld h,a ld a,(hl) ; return with attribute in accumulator. ret ; Find graphic address for character block in accumulator. bladd rlca ; multiply by 8. rlca ; shift left 3 times rlca ; to achieve this. ld c,a ; remember result - we need it in a minute. and 7 ; 3 leftmost bits shifted into high byte. ld b,a ; want these in b register (high). ld a,c ; restore result of shifts. and 248 ; take the bits for the low byte this time. ld c,a ; put these in c, bc=a*8. ld hl,blkgfx ; address of block graphics. add hl,bc ; add bc to find address of block's graphic. ret ; Return character cell address of block at (dispx, dispy). chadd ld a,(dispx) ; vertical position. ld e,a ; store in e. and 24 ; which segment, 1 to 3? add a,64 ; 64*256 = 16384, Spectrum's screen memory. ld d,a ; this is our high byte. ld a,e ; what was that vertical position again? and 7 ; which row within segment? rrca ; multiply row by 32. rrca rrca ld e,a ; low byte. ld a,(dispy) ; add on y coordinate. add a,e ; mix with low byte. ld e,a ; displacement to screen address in DE. ret ; Finds horizontal displacement from left edge of sprite. ; On exit hl points to first of 2 bytes, 1st=start, 2nd=end. getxy ld a,(newx) ; player's vertical position from top of screen. ld (dispx),a ; put in displacement coords. getxy0 ld a,(newy) ; player's new horizontal position. and 6 ; find frame position. ld e,a ; put into e. ld d,0 ; frame in de. ld hl,coldis ; collision displacement table. add hl,de ; hl points to offset from left edge of sprite. getxy1 ld a,(newy) ; sprite y position. add a,(hl) ; add offset. ld (dispy),a ; y displacement. ret endxy call getxy0 ; get x+y displacement. inc hl ; get right edge. jr getxy1 ; return with this displacement instead. ; Display player sprite. dplayr ld hl,(playx) ; player's coordinates. ld (dispx),hl ; coords used by sprite routine. ld a,h ; y coordinate determines which frame to use. and 6 ; 0, 2, 4 or 6. ld e,a ld a,(direct) ; direction facing, 0=left, 8=right. add a,e ; add to frame. ld e,a ; put in e. ld d,0 ; address of pointer in de. ld hl,playfr ; player frames. add hl,de ; point to frame pointer. ld e,(hl) ; low byte of frame address. inc hl ; next byte of pointer. ld d,(hl) ; high byte of frame address. ex de,hl ; hl points to frame. jr sprite ; This is my main sprite routine and expects coordinates in (dispx,dispy) ; where dispx is the vertical coord from the top of the screen (0-176), and ; dispy is the horizontal coord from the left of the screen (0 to 240). ; Sprite data is stored as you'd expect in its unshifted form as this ; routine takes care of all the shifting itself. This means that sprite ; handling isn't particularly fast but the graphics only take 1/8th of the ; space they would require in pre-shifted form. ; On entry BC must point to the unshifted sprite data. sprit7 xor 7 ; complement last 3 bits. inc a ; add one for luck! sprit3 rl d ; rotate left... rl c ; ...into middle byte... rl e ; ...and finally into left character cell. dec a ; count shifts we've done. jr nz,sprit3 ; return until all shifts complete. ; Line of sprite image is now in e + c + d, we need it in form c + d + e. ld a,e ; left edge of image is currently in e. ld e,d ; put right edge there instead. ld d,c ; middle bit goes in d. ld c,a ; and the left edge back into c. jr sprit0 ; we've done the switch so transfer to screen. sprite ld a,(dispx) ; draws sprite (hl). ld (tmp1),a ; store vertical. call scadd ; calculate screen address. ld a,16 ; height of sprite in pixels. sprit1 ex af,af' ; store loop counter. push de ; store screen address. ld c,(hl) ; first sprite graphic. inc hl ; increment poiinter to sprite data. ld d,(hl) ; next bit of sprite image. inc hl ; point to next row of sprite data. ld (tmp0),hl ; store in tmp0 for later. ld e,0 ; blank right byte for now. ld a,b ; b holds y position. and 7 ; how are we straddling character cells? jr z,sprit0 ; we're not straddling them, don't bother shifting. cp 5 ; 5 or more right shifts needed? jr nc,sprit7 ; yes, shift from left as it's quicker. and a ; oops, carry flag is set so clear it. sprit2 rr c ; rotate left byte right... rr d ; ...through middle byte... rr e ; ...into right byte. dec a ; one less shift to do. jr nz,sprit2 ; return until all shifts complete. sprit0 pop hl ; pop screen address from stack. ld a,(hl) ; what's there already. xor c ; merge in image data. ld (hl),a ; place onto screen. inc l ; next character cell to right please. ld a,(hl) ; what's there already. xor d ; merge with middle bit of image. ld (hl),a ; put back onto screen. inc hl ; next bit of screen area. ld a,(hl) ; what's already there. xor e ; right edge of sprite image data. ld (hl),a ; plonk it on screen. ld a,(tmp1) ; temporary vertical coordinate. inc a ; next line down. ld (tmp1),a ; store new position. and 63 ; are we moving to next third of screen? jr z,sprit4 ; yes so find next segment. and 7 ; moving into character cell below? jr z,sprit5 ; yes, find next row. dec hl ; left 2 bytes. dec l ; not straddling 256-byte boundary here. inc h ; next row of this character cell. sprit6 ex de,hl ; screen address in de. ld hl,(tmp0) ; restore graphic address. ex af,af' ; restore loop counter. dec a ; decrement it. jp nz,sprit1 ; not reached bottom of sprite yet to repeat. ret ; job done. sprit4 ld de,30 ; next segment is 30 bytes on. add hl,de ; add to screen address. jp sprit6 ; repeat. sprit5 ld de,63774 ; minus 1762. add hl,de ; subtract 1762 from physical screen address. jp sprit6 ; rejoin loop. ; Calculating a screen address from a pixel coordinate can be tricky! ; The Spectrum screen display is organized into 3 segments of 2048 bytes, ; all containing 8 rows of 32 character squares, each with 8 lines. ; Hence 8 * 32 * 8 * 3 = 6144 bytes. ; Low resolution colour filter = 32 * 8 character squares = 768 bytes. ; Total = 6144 + 768 = 6912 bytes, 16384 to 23295 inclusive. scadd ld a,(dispx) ; Returns screen address of coordinates ld b,a ; (dispx, dispy) in de. and 7 ; Line 0-7 within character square. add a,64 ; 64 * 256 = 16384 (Start of screen display) ld d,a ; Line * 256. ld a,b ; fetch x coord again. rrca ; divide pixel displacement by 8. rrca rrca and 24 ; Segment 0-2 multiplied by 8. add a,d ; Add to h (so multiply by 8 * 256 = 2048) ld d,a ld a,b ; 8 character squares per segment. rlca ; Divide x by 8 and multiply by 32, rlca ; net calculation: multiply by 4. and 224 ; Mask off bits we don't want. ld e,a ; Vertical coordinate calculation done. ld a,(dispy) ; y coordinate. ld b,a ; remember horizontal position for later. rrca ; now need to divide by 8. rrca rrca and 31 ; Squares 0 - 31 across screen. add a,e ; Add to total so far. ld e,a ; de = address of screen. ret ; Display Fizzog sprite in large attribute blocks instead of pixels. dpix ld hl,32000+89 ; 3 quarters of the way across the screen. ld a,16 ; sprite is 16 pixels tall. dpix3 ex af,af' ; store loop counter. ex de,hl ; swap de and hl temporarily. ld b,(hl) ; 1st byte of graphic data. inc hl ; move along. ld c,(hl) ; 2nd byte. ex de,hl ; restore source and target addresses. ld a,16 ; sprite is 16 pixels across. dpix0 rr b ; rotate right bit of b into c. rr c ; rotate right edge of c into carry. jr c,dpix1 ; carry set, so pixel is set. ld (hl),2 ; black square, red ink. jr dpix2 dpix1 ld (hl),36 ; set block green. dpix2 dec hl ; next screen block left. dec a ; horizontal pixel count. jp nz,dpix0 ; repeat for 16 pixels. push de ; store source graphic address. ld de,48 ; move to end of next line on screen. add hl,de ; make hl point there. pop de ; restoer graphic. inc de ; next line of sprite. ex af,af' ; line counter. dec a ; decrement it. jr nz,dpix3 ; repeat for 16 pixel lines. ; We'll have to fill in Fizzog's eyes ourselves. ld a,189 ; flashing white/cyan. ld hl,32141 ; address of left eye. call eyes ld l,173 ; address of left eye. eyes ld (hl),a inc l ; 2 bytes along = right eye. inc l ld (hl),a inc l ; next bit of right eye. ld (hl),a ret ; Attribute fade routine. fade ld b,7 ; brightest colour = 7 (white). fade3 push bc ; store main loop counter. ld hl,22528 ; address of screen attributes. ld bc,576 ; play area = 18x32 = 576 bytes. fade2 ld a,(hl) ; get attribute. and 7 ; get ink colour. jr z,fade0 ; already zero so don't fade it. dec a fade0 ld e,a ; ink in e register. ld a,(hl) ; get attribute. and 56 ; get paper colour. jr z,fade1 ; already black so can't fade it. sub 8 ; paper colour - 1. fade1 or e ; combine paper with ink. ld (hl),a ; write new attribute. inc hl ; next attribute position. dec bc ; loop counter. ld a,b ; b register in a. or c ; combine with c to see if bc is zero. jr nz,fade2 ; repeat until bc counts down to zero. halt ; wait for an interrupt. halt ; do it again. pop bc ; restore main loop counter. djnz fade3 ; repeat until screen is black. ret ; Table of sprite pointers for player. playfr defw playl0,playl2,playl0,playl1 defw playr1,playr0,playr2,playr0 ; Table of horizontal collision displacements for each frame. coldis defb 3,8,2,9,1,10,2,9 ; Player sprites, 3 frames facing right. playr0 defb 15,0,31,128,25,0,25,0,15,128,15,0,6,0,15,0 defb 15,0,31,128,61,192,30,128,15,0,13,0,27,128,29,192 playr1 defb 15,0,31,128,25,0,25,0,15,128,15,0,6,0,15,0 defb 15,0,31,128,31,128,9,0,15,0,6,0,6,0,7,0 playr2 defb 15,0,31,128,25,0,25,0,15,128,15,0,6,0,15,0 defb 31,128,63,192,111,96,111,96,15,128,29,160,48,224,56,192 ; Next 3 frames face left. playl2 defb 15,0,31,128,9,128,9,128,31,0,15,0,6,0,15,0 defb 31,128,63,192,111,96,111,96,31,0,91,128,112,192,49,192 playl1 defb 15,0,31,128,9,128,9,128,31,0,15,0,6,0,15,0 defb 15,0,31,128,31,128,9,0,15,0,6,0,6,0,14,0 playl0 defb 15,0,31,128,9,128,9,128,31,0,15,0,6,0,15,0 defb 15,0,31,128,59,192,23,128,15,0,11,0,29,128,59,128 ; Table of sprite pointers for patrolling aliens. alnptr defw cart1,cart0,cart2,cart0 ; cart. defw frog0,frog1,frog0,frog2 ; frog. defw spin0,spin1,spin2,spin3 ; spinning thing. defw comp0,comp1,comp2,comp1 ; computer. defw trun0,trun0,trun1,trun1 ; trundlebot. defw rock1,rock1,rock1,rock1 ; rockets. defw rock0,rock0,rock0,rock0 ; rockets. defw land0,land0,land1,land1 ; lander. ; Alien sprite graphics. cart0 defb 223,251,223,251,192,3,223,251,223,251,192,3,223,251,223,251 defb 192,3,223,251,7,224,112,14,171,213,219,219,168,21,112,14 cart1 defb 223,251,223,251,192,3,223,251,223,251,192,3,223,251,223,251 defb 192,3,223,251,7,224,112,14,219,219,139,209,216,27,112,14 cart2 defb 0,0,223,251,223,251,192,3,223,251,223,251,192,3,223,251 defb 223,251,192,3,7,224,115,206,216,27,139,209,219,219,112,14 frog0 defb 1,128,67,194,101,166,229,167,191,253,31,248,15,240,15,240 defb 15,240,7,224,7,224,15,240,29,184,28,56,120,30,56,28 frog1 defb 25,152,115,206,53,172,53,172,31,252,15,248,15,240,15,240 defb 15,240,7,224,7,224,15,240,13,176,28,56,28,56,60,60 frog2 defb 1,128,3,192,69,162,69,162,255,255,255,255,143,241,15,240 defb 15,240,7,224,7,224,15,240,29,184,216,27,112,14,48,12 spin0 defb 3,192,87,234,167,213,87,202,167,213,87,234,7,224,63,252 defb 63,252,7,224,87,234,171,229,83,234,171,229,87,234,3,192 spin1 defb 3,192,23,170,39,85,23,42,39,85,23,170,7,192,127,254 defb 127,254,7,224,85,232,170,228,84,232,170,228,85,232,3,192 spin2 defb 3,192,10,168,21,84,10,168,21,84,10,168,3,192,255,255 defb 255,255,3,192,21,80,42,168,21,80,42,168,21,80,3,192 spin3 defb 3,192,85,232,170,228,84,232,170,228,85,232,3,224,127,254 defb 127,254,7,224,23,170,39,85,23,42,39,85,23,170,3,192 comp0 defb 124,0,255,192,195,254,192,63,192,3,192,27,192,11,192,3 defb 192,3,124,3,32,255,31,86,106,171,85,87,234,254,127,0 comp2 defb 0,62,7,255,127,195,248,27,192,11,192,3,192,3,192,3 defb 192,3,128,63,127,6,106,248,213,86,234,170,127,87,0,254 comp1 defb 127,254,255,255,192,3,192,27,192,11,192,3,192,3,192,3 defb 192,3,255,255,96,6,31,248,106,174,85,87,234,171,127,254 trun0 defb 63,252,127,254,255,255,0,0,127,254,63,252,15,240,3,192 defb 27,216,127,254,103,230,211,203,203,211,102,102,126,126,24,24 trun1 defb 0,0,63,252,127,254,255,255,0,0,127,254,63,252,7,224 defb 27,216,127,254,103,230,203,211,211,203,102,102,126,126,24,24 rock0 defb 0,0,0,63,0,252,3,240,7,224,0,0,127,243,255,247 defb 255,247,127,243,0,0,7,224,3,240,0,252,0,63,0,0 rock1 defb 0,0,252,0,63,0,15,192,7,224,0,0,207,254,239,255 defb 239,255,207,254,0,0,7,224,15,192,63,0,252,0,0,0 land0 defb 7,224,25,184,51,156,99,142,99,142,99,142,99,142,51,140 defb 31,248,0,0,31,248,59,220,97,134,65,130,243,207,243,207 land1 defb 7,224,30,120,44,116,92,122,92,122,92,122,92,114,44,100 defb 31,248,0,0,31,248,59,220,97,134,65,130,243,207,243,207 blkgfx defb 0,0,0,0,0,0,0,0 defb 0,0,0,0,0,0,0,0 ; item to collect. defb 255,255,170,170,42,34,32,0 ; green platform. defb 254,254,254,0,239,239,239,0 ; magenta wall. defb 255,255,60,60,0,0,0,0 ; yellow platform. defb 238,238,68,68,228,78,68,4 ; downward spikes. defb 119,0,221,0,119,0,221,0 ; blue wall. defb 255,254,88,16,0,0,0,0 ; cyan platform. defb 4,68,78,228,68,68,238,238 ; upward spikes. defb 255,255,12,24,52,98,255,255 ; red girder. defb 255,255,24,24,24,24,255,255 ; disappearing platform. defb 0,111,111,96,14,238,238,0 ; blue horizontal wall. defb 0,126,66,122,122,122,126,0 ; yellow/green panel. defb 0,126,126,60,60,24,24,0 ; forcefield gun. defb 0,102,102,0,0,102,102,0 ; disappearing wall. defb 255,129,189,165,165,189,129,255 ; magic floor. defb 0,16,16,56,56,124,124,0 ; teleport up. defb 0,124,124,56,56,16,16,0 ; teleport down. defb 195,161,64,64,96,114,189,195 ; planet 1. defb 195,129,104,244,248,252,249,195 ; planet 2. defb 0,0,0,0,2,0,0,0 ; star. defb 0,64,0,0,0,0,0,0 ; star. blcols defb SPCATT ; blank space. defb OBJATT ; key. defb PL1ATT ; green platform. defb 51 ; magenta wall. defb 6 ; yellow platform. defb DEDATT ; downward spikes. defb 57 ; blue wall. defb 5 ; cyan platform. defb DEDATT ; upward spikes. defb 66 ; red platform. defb 66 ; disappearing platform. defb 13 ; cyan/blue wall. defb 38 ; yellow/green panel. defb 34 ; forcefield gun. defb 23 ; vanishing wall. defb KEYATT ; magic floor. defb TELATT ; teleporter. defb 79 ; re-appearance square. defb 32 ; green planet. defb 24 ; magenta planet. defb SPCATT,SPCATT ; stars. ; Now decompress level data into upper RAM. decomp ld bc,576 ; size of target area. ld de,scdata ; address of screen data. decom2 ld a,(hl) ; source byte. cp 255 ; is it a control code code? jr z,decom0 ; it is, process it. ld (de),a ; write target byte. inc de ; next target address. inc hl ; next source address. dec bc ; decrement counter. ld a,b ; loop counter high byte. or c ; combine with low byte for zero check. jr nz,decom2 ; not done, go round again. ret decom0 inc hl ; next source byte. ld a,(hl) ; fill byte we're expanding. ld (dbyte),a ; store it here. inc hl ld a,(hl) ; loop counter. inc hl decom1 ex af,af' ; store counter. ld a,(dbyte) ld (de),a ; fill byte in. inc de ; next byte of screen. dec bc ; decrement overall counter. ld a,b ; loop counter high. or c ; hit zero? ret z ; yes, decompression finished. ex af,af' ; restore mini loop counter. dec a ; decrement it. jr nz,decom1 ; not finished expanding yet. jr decom2 lev1sc defb 1,255,0,4,255,5,6,255,0,6,5,1,255,0,10,5,0,1,255,0,66 defb 255,6,11,0,0,255,7,6,6,1,255,0,11,6,6,255,0,17,6,255,0,6,6,0,0 defb 4,4,255,0,20,255,6,4,255,0,3,6,255,0,31,6,255,0,12,255,7,4 defb 255,0,14,4,6,4,255,0,5,255,7,4,255,0,8,255,6,7,255,0,32,255,7,3 defb 255,0,7,4,4,255,0,25,255,6,5,255,0,31,1,255,0,3,255,7,4,0,0 defb 255,7,4,0,0,255,7,4,255,0,23,1,255,0,5,1,255,0,38,255,7,4 defb 255,0,36,255,6,8,0,0,255,6,4,0,0,255,6,4,255,0,11,255,6,9 defb 0,0,255,6,4,0,0,255,6,4,255,0,10,255,6,3 lev2sc defb 0,1,255,0,10,255,5,6,3,255,0,5,5,5,255,0,4,1,255,0,18,1,3 defb 255,0,31,3,255,0,13,255,4,5,255,0,4,255,3,10,4,4,255,0,12,1 defb 255,0,9,255,5,4,0,0,1,3,255,0,10,255,4,3,255,0,18,3,255,0,3 defb 255,3,4,255,0,4,1,255,0,5,255,4,5,255,0,9,3,255,0,4,255,5,3 defb 255,0,24,3,255,0,9,4,255,0,3,4,4,255,0,14,4,4,3,255,0,30,1,3,0 defb 1,3,255,0,19,255,3,5,255,0,4,3,0,0,3,255,0,5,255,4,5,255,0,4 defb 4,4,255,0,4,5,0,1,3,255,0,4,3,0,0,255,3,4,255,0,20,255,3,6 defb 255,0,26,3,1,255,0,3,3,255,0,18,255,3,9,255,0,4,255,3,12,0,0 defb 4,4,255,0,5,5,0,0,5,1,0,3,10,10,0,0,5,0,1,0,5,0,1,0,5,255,0,69 lev3sc defb 5,5,5,255,0,10,1,255,0,12,5,0,1,255,0,22,1,255,0,68,255,3,4 defb 255,0,16,2,2,2,255,0,20,3,255,0,31,3,255,0,16,255,2,4,255,0,7,1 defb 255,0,3,3,255,0,30,1,3,255,4,3,255,0,8,255,3,5,255,0,15,3 defb 255,0,31,3,255,0,26,4,4,255,3,4,255,0,4,255,3,4,255,0,20,5,5 defb 1,3,255,0,10,255,2,4,255,0,17,3,255,0,25,255,3,3,255,0,3,3 defb 255,2,4,255,0,21,5,0,1,255,0,14,255,3,12,255,0,29,1,3,3 defb 255,0,30,3,3,255,0,6 lev4sc defb 0,1,255,0,104,255,6,11,0,0,6,255,0,18,6,1,255,0,11,6,255,4,4 defb 255,0,4,255,4,8,0,0,6,255,0,12,6,255,0,9,1,255,0,8,6,255,0,29 defb 255,6,6,0,0,255,6,5,255,0,5,255,4,6,255,0,8,1,0,6,255,0,5 defb 6,0,1,0,5,255,0,9,1,0,255,4,3,255,0,7,6,255,0,5,6,255,0,25 defb 255,6,7,255,0,3,255,4,7,6,255,0,10,4,4,255,0,8,6,255,0,10,6 defb 255,0,20,6,255,0,10,6,0,0,8,8,255,0,16,6,255,4,5,255,0,5,6 defb 255,4,17,255,0,14,6,1,255,0,4,1,255,0,22,255,4,3,6,255,0,50,8 defb 255,0,17 lev5sc defb 0,1,255,0,4,1,255,0,4,5,255,0,14,1,0,0,5,255,0,71,8,255,0,12 defb 8,255,0,13,255,9,24,255,0,9,1,0,5,255,0,3,1,5,255,0,4,5,0,1 defb 0,5,255,0,11,255,9,3,255,0,88,255,9,5,255,0,3,255,9,6,255,0,10 defb 9,9,255,0,15,1,255,0,54,8,255,0,10,255,4,11,255,0,5,255,9,7 defb 255,0,9,1,255,0,17,1,255,0,70,255,9,6,255,0,41,8,255,0,3,8 defb 255,0,5,8,255,0,10 lev6sc defb 255,0,5,5,0,0,1,0,0,5,255,0,7,5,255,0,9,1,255,0,126,6,255,0,5 defb 255,6,22,255,0,4,6,0,0,8,255,0,3,1,6,255,0,9,5,255,0,12,255,6,5 defb 255,0,4,6,255,0,23,5,0,1,0,255,6,5,0,0,255,2,4,255,0,22,1,5 defb 255,0,12,2,2,255,0,4,255,2,5,255,0,36,2,2,255,0,7,255,6,4 defb 255,0,28,255,6,4,255,0,5,255,6,8,255,0,8,255,6,11,255,0,5 defb 255,6,8,255,0,5,255,2,3,255,6,11,255,0,9,5,255,0,16,1,0,5 defb 255,0,50,6,6,255,0,30,6,6,8,255,0,3 lev7sc defb 0,1,255,0,60,1,255,0,23,1,255,0,46,7,7,255,0,54,255,9,3,255,7,3 defb 255,0,10,8,255,0,16,1,255,0,11,255,7,7,255,0,4,255,7,7,255,0,19 defb 1,255,0,6,1,255,0,45,255,9,3,255,0,19,255,9,6,255,0,40,8,0,0,8 defb 255,0,4,8,255,0,15,9,9,255,0,4,6,255,7,10,255,0,6,255,9,3 defb 255,0,12,6,1,255,0,14,1,255,0,15,6,255,0,22,255,7,3,255,0,4,9,9 defb 6,255,0,23,1,255,0,7,6,255,0,7,8,0,0,8,255,0,14 lev8sc defb 255,0,6,6,255,0,3,1,255,0,4,5,255,0,5,5,255,0,11,1,255,0,29,1 defb 255,0,58,255,7,3,255,0,5,255,2,9,255,0,41,255,7,4,255,0,8,2 defb 255,0,42,255,10,7,255,0,11,3,255,0,8,255,2,3,255,0,16,7,3,0,0 defb 3,0,1,255,0,15,1,255,0,7,1,0,0,3,0,0,3,0,0,2,2,255,0,24,3,0,0 defb 3,255,0,13,1,255,0,12,10,10,3,7,7,3,7,7,255,0,14,2,2,0,1 defb 255,0,8,3,0,0,3,1,0,0,10,10,3,255,0,22,3,255,0,7,1,3,255,0,31 defb 3,255,2,3,255,0,4,255,2,3,0,0,255,2,3,255,0,73,8,8,0,0 lev9sc defb 0,1,255,0,14,1,255,0,13,1,255,0,65,11,11,255,0,11,255,11,9 defb 255,0,7,255,9,3,0,1,255,0,63,255,11,3,0,0,255,11,3,0,0,255,11,3 defb 255,0,8,255,9,8,255,0,80,11,11,255,0,14,9,9,255,0,72,255,11,5 defb 255,0,13,255,9,4,255,0,68,255,11,5,255,0,11,255,9,5,0,0,8 defb 255,0,3,255,9,3,255,0,5,1,255,11,3,255,0,15,9,9,255,0,4,1,0,11 defb 255,0,8,11,11,0,0,255,8,4,255,0,9,9,9,255,0,4 lev10s defb 255,0,64,255,12,4,0,0,255,12,3,0,0,255,12,8,0,0,12,12,0,0 defb 255,12,3,255,0,4,255,12,4,0,0,255,12,3,0,0,12,12,5,1,255,0,6 defb 12,12,0,0,12,1,255,0,5,255,12,9,10,10,12,12,255,0,6,255,12,7 defb 255,0,5,12,0,1,5,0,12,12,255,0,16,1,255,0,6,255,12,3,255,0,4 defb 12,12,255,0,22,255,12,4,255,0,4,13,255,0,3,255,4,15,255,0,4 defb 255,12,5,255,0,19,1,255,0,8,255,12,4,255,0,29,255,12,9,0,4 defb 255,0,22,12,12,0,5,1,0,12,12,255,0,7,255,4,3,255,0,14,1,12 defb 255,0,4,12,12,255,0,8,1,255,0,22,13,0,0,255,10,3,255,0,7 defb 255,12,3,255,0,30,5,255,0,3,255,4,8,255,0,31,1,255,0,5 defb 255,12,3,255,0,14,12,255,0,10,8,255,0,3,255,12,3,255,0,13,12,12 defb 255,0,10 lev11s defb 255,0,25,5,255,0,4,1,255,0,14,1,255,0,79,255,7,3,255,0,30,1 defb 255,0,3,255,12,3,255,0,7,255,12,3,255,0,8,8,255,0,9,1,255,12,3 defb 0,0,255,12,3,0,0,255,12,3,0,0,255,12,10,255,0,7,12,13,12,0,0 defb 255,12,3,0,0,255,12,3,255,0,3,12,12,1,0,5,255,0,3,12,12 defb 255,0,22,12,12,255,0,7,12,12,13,255,0,20,13,12,7,10,10,255,0,9 defb 255,12,7,255,0,26,1,255,0,26,255,12,4,255,0,7,255,10,3,255,0,7 defb 255,7,6,255,0,5,5,0,1,255,0,13,255,7,3,255,0,11,7,7,255,0,7 defb 255,7,3,255,0,7,1,255,0,56,255,7,3,255,0,8,255,12,9,255,10,4 defb 12,12,0,0,8,255,0,10,8,255,0,3,255,12,9,255,8,4,12,12 lev12s defb 255,0,10,1,11,1,255,0,15,13,255,0,14,3,255,0,29,2,2,6,2,2 defb 255,0,21,255,4,4,0,0,1,0,12,0,1,255,0,3,255,10,3,255,0,8 defb 255,12,4,255,0,11,11,255,0,31,6,255,0,8,255,4,4,255,0,15 defb 255,2,4,12,255,2,4,255,0,9,255,4,3,255,0,4,255,10,4,255,0,4 defb 1,0,0,3,0,0,1,255,0,28,11,255,0,7,4,4,255,0,7,255,4,3,255,0,12 defb 3,255,0,25,255,2,6,11,255,2,5,255,0,14,4,0,4,4,255,0,4,1,0,1,0 defb 6,0,1,0,1,0,2,2,255,0,24,14,255,0,15,15,0,0,1,255,0,12,14 defb 255,0,15,11,255,0,7,255,2,8,11,255,2,8,255,0,6,2,6,2,255,0,3 defb 4,4,255,0,5,1,255,0,3,12,0,1,255,0,3,1,255,0,9,3,255,0,15,11 defb 255,0,13,2,2,11,2,2,255,0,13,3,255,0,15,12,255,0,4 lev13s defb 0,1,0,5,255,0,14,255,5,4,255,0,74,255,9,7,0,255,9,5,255,0,6,6,9 defb 9,6,255,0,10,1,255,0,9,5,255,0,7,6,0,0,6,255,0,23,4,4,255,0,3,6 defb 0,0,6,255,0,28,6,0,0,6,0,0,6,9,9,6,255,0,7,8,255,0,14,6,0,0,6,1 defb 0,6,0,0,6,255,0,3,255,10,3,255,9,5,255,0,3,255,9,3,0,0,6,9,9,6 defb 0,0,6,0,0,6,0,0,6,255,0,6,1,0,0,5,12,255,0,4,5,1,0,0,6,1,0,6,0 defb 0,6,8,8,6,0,0,6,0,4,4,255,0,7,12,255,0,8,6,0,0,6,0,0,6,9,9,6,0 defb 0,6,255,0,10,12,0,0,12,255,0,3,9,9,6,0,0,6,0,0,6,0,0,6,0,0,6 defb 255,0,3,15,0,255,9,3,0,0,12,0,0,12,12,255,0,4,6,0,4,6,0,0,6,0,0 defb 6,0,0,6,4,4,255,0,8,12,0,0,12,12,255,0,4,6,0,0,6,0,0,6,0,0,6,0,0 defb 6,255,0,9,255,12,6,255,0,4,6,0,0,6,0,0,6,0,0,6,0,0,6,255,0,3 defb 255,9,4,10,10,12,0,1,12,255,0,6,6,10,10,13,0,0,13,0,0,6,0,0 defb 6,0,0,4,255,0,16,14,255,0,31,14,255,0,15 lev14s defb 255,0,20,12,255,0,10,12,1,255,0,18,1,12,255,0,10,12,255,0,20,12 defb 1,255,0,8,17,12,255,0,14,8,255,0,5,12,255,0,10,12,0,0,8,255,0,3 defb 8,255,0,6,255,11,7,12,255,0,7,255,10,3,12,11,10,255,11,7 defb 255,0,11,12,0,8,255,0,8,12,11,0,11,1,255,0,16,255,12,5,255,0,4 defb 8,8,12,11,0,11,255,0,17,12,255,0,8,255,12,3,11,16,255,11,15 defb 255,10,3,12,255,0,9,1,255,0,3,1,255,0,17,5,255,0,60,7,7,255,0,7 defb 12,255,0,7,7,7,255,0,22,12,255,0,3,7,7,255,0,11,255,7,5,255,0,8 defb 7,7,12,255,0,3,1,255,0,14,1,255,0,11,1,12,255,0,5,1,7,7,255,0,3 defb 255,7,3,255,0,13,7,7,0,0,12,0,0,255,7,3,255,0,26,12,0,0,1 defb 255,0,28,12,255,0,5 lev15s defb 255,0,63,1,255,0,126,4,4,255,0,4,4,255,0,5,4,255,0,3,4,4,255,0,3 defb 4,255,0,6,4,255,0,69,4,4,255,0,34,4,4,255,0,4,4,4,255,0,3 defb 4,0,0,4,4,255,0,3,4,0,0,4,4,255,0,66,4,4,255,0,37,4,255,0,4,4 defb 255,0,3,4,4,255,0,3,4,255,0,6,4,4,255,0,4,3,255,0,31,3,255,0,31 defb 3,255,0,6,8,255,0,10,8,255,0,4,8,255,0,8 ; a=18 ; b=19 ; x=20 ; y=21 lev16s defb 0,5,255,0,11,6,1,255,0,17,1,255,0,11,1,6,255,0,5,21,255,0,8,20 defb 255,0,16,6,255,0,7,21,255,0,23,6,255,0,17,21,255,7,5,255,0,4,8 defb 255,0,3,6,0,19,255,0,9,20,255,0,13,255,7,6,6,255,0,6,18,255,0,24 defb 6,255,0,10,19,255,0,18,1,0,6,255,0,4,21,20,255,0,14,255,7,3 defb 255,0,8,6,255,0,14,20,255,0,16,6,7,7,255,0,8,20,0,0,18,255,0,11 defb 255,7,4,0,0,13,255,0,7,20,255,0,36,21,255,0,6,255,7,4,255,0,22 defb 20,0,255,7,3,255,0,11,255,6,8,255,0,12,1,255,0,13,255,6,6,7,7 defb 255,0,11,7,7,255,0,11,255,6,3,0,1,13,255,0,8,7,7,255,0,3,1 defb 255,0,3,255,6,3,255,0,6,255,6,3,255,0,20,255,6,3,255,0,3,8,0,0 defb 255,6,3,255,0,5,8,255,0,10 ; Alien data table. ; byte 0: bits d0-d4 = screen number ; d5-d7 = alien type. ; byte 1: x start ; byte 2: y start ; byte 3: x end ; byte 4: y end alndat defb 64,32,56,128,56 ; screen 0 spinning thing. defb 64,0,104,128,104 ; screen 0 spinning thing. defb 01,128,0,128,240 ; screen 1 cart. defb 34,128,0,128,168 ; screen 2 frog. defb 98,0,32,48,32 ; screen 2 computer. defb 98,80,208,128,208 ; screen 2 computer. defb 03,128,0,128,96 ; screen 3 cart. defb 03,128,120,128,240 ; screen 3 cart. defb 36,80,24,80,96 ; screen 4 frog. defb 05,128,0,128,192 ; screen 5 cart. defb 37,24,16,24,176 ; screen 5 frog. defb 101,56,208,112,208 ; screen 5 computer. defb 70,0,144,128,144 ; screen 6 spinning thing. defb 38,40,168,40,208 ; screen 6 frog. defb 135,16,16,16,72 ; screen 7 trundlebot. defb 135,128,96,128,200 ; screen 7 trundlebot. defb 233,64,128,128,128 ; screen 9 lander. defb 233,64,88,128,88 ; screen 9 lander. defb 74,0,40,64,40 ; screen 10 satellite. defb 234,16,80,120,80 ; screen 10 lander. defb 74,8,120,128,40 ; screen 10 satellite. defb 11,96,24,96,72 ; screen 11 cart. defb 43,96,96,96,144 ; screen 11 frog. defb 108,32,160,128,160 ; screen 12 computer. defb 140,128,0,128,112 ; screen 12 trundlebot. defb 45,48,32,48,120 ; screen 13 frog. defb 13,128,0,128,192 ; screen 13 cart. defb 143,128,176,128,240 ; screen 15 trundlebot. defb 239,0,176,112,176 ; screen 15 lander. defb 79,0,40,112,40 ; screen 15 satellite. defb 255 ; Miscellaneous data for each screen. ; First two bytes give the player's starting coordinates, ; the next two point to address of each screen's title. misc defb 112,0 defw 5061 ; Out of memory. defb 8,152 defw 5146 ; Invalid argument. defb 88,240 defw 5356 ; Statement lost. defb 64,88 defw 5413 ; Tape loading error. defb 128,240 defw 5310 ; Invalid colour. defb 128,128 defw 5074 ; Out of screen. defb 128,0 defw 5121 ; End of file. defb 128,0 defw scnm0 ; Some Trundlebots. defb 120,72 defw scnm1 ; Rocket test range. defb 0,0 defw scnm2 ; Faked moonlanding. defb 88,208 defw scnm3 ; Spy Satellites. defb 8,240 defw scnm4 ; The Purga-tree. defb 128,136 defw scnm5 ; A Mir formality. defb 128,136 defw scnm6 ; Membrane theory. defb 128,240 defw scnm7 ; Heavy water plant. defb 128,92 defw scnm8 ; Hubble trouble. scnm0 defb 'Some Trundlebot','s'+128 scnm1 defb 'Rocket test rang','e'+128 scnm2 defb 'Faked moonlandin','g'+128 scnm3 defb 'Spy satellite','s'+128 scnm4 defb 'The Purga-tre','e'+128 scnm5 defb 'A Mir formalit','y'+128 scnm6 defb 'Membrane theor','y'+128 scnm7 defb 'Heavy water plan','t'+128 scnm8 defb 'Hubble troubl','e'+128 ; Music routines. chan2c ld hl,ch2dat ; start of tune. jr chan2d ; process first note. chan2b ld a,(chrep2) ; number of repeats. dec a ; decrement counter. jr z,chan2d ; no more repeats, skip to next note. ld (chrep2),a ; store iterations remaining. ld hl,(c2loop) ; start again at beginning of loop. jr chan2d chan2a ld a,(hl) ; number of repeats. ld (chrep2),a ; store it for later. inc hl ; next byte. ld (c2loop),hl ; remember beginning of loop. chan2d ld (chptr2),hl ; store channel marker. chan2 ld hl,0 ; zero in hl. ld (snddat+8),hl ; default channels a and b to zero volume. ld hl,(chptr2) ; get pointer to tune data. ld a,(hl) ; what's the next note? inc hl ; next byte. ld (chptr2),hl ; store channel marker. cp 98 ; beginning of loop marker. jr z,chan2a ; store position. cp 99 ; end loop marker. jr z,chan2b ; restore position. cp 255 ; end of tune. jr z,chan2c ; restore position. call gfreq ; get frequency in de registers. ld (snddat+2),de ; put into channel 2. ld (snddat+9),a ; set data for amplitude register. chan1 ld hl,(chptr1) ; get pointer to tune data. chan1d ld a,(hl) ; what's the next note? inc hl ; next byte. ld (chptr1),hl ; store channel marker. cp 98 ; beginning of loop marker. jr z,chan1a ; store position. cp 99 ; end loop marker. jr z,chan1b ; restore position. cp 100 ; is it a rest? jr z,w8912 ; yes, ignore note then. cp 255 ; end of tune. jr z,chan1c ; restore position. call gfreq ; get frequency in de registers. ld (snddat),de ; put into channel 2. ld (snddat+8),a ; set data for amplitude register. ; Write the contents of our AY buffer to the AY registers. w8912 ld hl,snddat ; start of AY-3-8912 register data. ld e,0 ; register to start with. ld d,14 ; number of registers to write. w8912a ld a,e ld bc,65533 ; port 65533=select soundchip register. out (c),a ; tell chip which register we're writing. ld a,(hl) ; value to write. ld bc,49149 ; port 49149=write value to register. out (c),a ; this is what we're putting there. inc e ; next sound chip register. inc hl ; next byte to write. dec d ; decrement loop counter. jr nz,w8912a ; repeat until done. ret chan1c ld hl,ch1dat ; start of tune. jr chan1d ; process first note. chan1b ld a,(chrep1) ; number of repeats. dec a ; decrement counter. jr z,chan1d ; no more repeats, skip to next note. ld (chrep1),a ; store iterations remaining. ld hl,(c1loop) ; start again at beginning of loop. jr chan1d chan1a ld a,(hl) ; number of repeats. ld (chrep1),a ; store it for later. inc hl ; next byte. ld (c1loop),hl ; remember beginning of loop. jr chan1d snddat defw 0 ; tone registers, channel A. defw 0 ; channel B tone registers. defw 0 ; as above, channel C. defb 0 ; white noise period. defb 60 ; tone/noise mixer control. defb 16 ; channel A amplitude/envelope generator. defb 16 ; channel B amplitude/envelope. defb 0 ; channel C amplitude/envelope. defw 6000 ; duration of each note. defb 0 ; Get frequency of note a and return in de registers. gfreq rlca ; multiply note number by 2. ld e,a ; put into de. ld d,0 ; zeroise high byte of de. ld hl,freqs ; frequencies. add hl,de ; find address of frequency. ld e,(hl) ; low byte of note frequency. inc hl ; next byte. ld d,(hl) ; high byte of note frequency. ld a,16 ; use envelope generator for amplitude. ret ; This is our spooky music data. ; We shall have 4 special flag bytes: ; 98 = beginning of a loop, following byte gives iterations. ; 99 = end of loop. ; 100 = rest. ; 255 = end of tune. ; Channel 1 is the main tune. ch1dat defb 98,48,100,99 defb 7,98,5,100,99,7,100,100 defb 7,9,10,9,98,5,100,99 defb 8,100,100,7,10,11,12 defb 98,5,100,99,10,98,4,100,99 defb 9,8,98,8,100,99,8,9,10,7 defb 98,5,100,99,7,100,100,7,9 defb 10,9,98,5,100,99,8,100,100 defb 7,10,11,12,98,5,100,99,10 defb 98,4,100,99,9,8,98,5,100 defb 99,8,9,10,11,9,8 defb 98,2,11,100,100,100,100,100 defb 11,10,11,12,11,10,11,100 defb 100,100,100,100,11,10,11,12 defb 11,10,12,100,100,100,100 defb 100,10,11,12,13,12,10,11 defb 100,100,100,100,100,11,10 defb 9,11,10,9,99 defb 98,2,7,8,9,10,9,8,7,100 defb 100,100,100,100,7,8,9,10,9 defb 8,7,100,100,100,100,100,8 defb 9,10,10,9,8,8,100,100,100 defb 100,100,6,7,8,8,7,6 defb 7,100,100,100,100,100,99 defb 255 ; Channel 2 is the background melody. ch2dat defb 98,8,0,4,2,99 defb 98,4,1,5,3,99 defb 98,3,4,5,3,99 defb 4,2,1,255 ; Frequencies used for the in-game music. ; A mere 14 notes are used so those are all we need to store. freqs defw 847,755,712,635,565,533 defw 224,212,189,178,159,141 defw 133,119 scrol ld hl,20735 ; top right of window to scroll - line 23. push hl ld b,8 ; 8 pixel rows. scrl1 push bc push hl ld b,32 ; 32 chars wide. and a ; reset carry flag. scrl0 rl (hl) ; rotate left. dec l ; char left. djnz scrl0 ; repeat. pop hl inc h pop bc djnz scrl1 ld hl,(txtpos) ld a,(hl) pop hl rlca rlca rlca ; multiply by 8 to find char. ld b,a and 3 add a,60 ; ROM font starts here. ld d,a ld a,b and 248 ld e,a ld a,(txtbit) ld c,a ld b,8 scrl3 ld a,(de) ; get image of char line. and c ; test relevant bit of char. jr z,scrl2 ; not set - skip. inc (hl) ; set bit. scrl2 inc h ; next line of window. inc de ; next line of char. djnz scrl3 ld hl,txtbit rrc (hl) ; next bit of char to use. ret nc ld hl,(txtpos) ; text pointer. inc hl ; next character in message. ld a,(hl) ; what is it? inc a ; end of message? jr nz,scrl4 ; not yet - continue. ld hl,text ; start of scrolling message. scrl4 ld (txtpos),hl ; new text pointer position. ret txtbit defb 128 txtpos defw text text defb ' Area 51 ',127 defb ' 2005 Jonathan Cauldwell * ' defb 'Help Fizzog the alien find ' defb 'the components with which ' defb 'to repair his space scooter * ' defb 'Q=LEFT W=RIGHT B-SPACE=JUMP H-ENTER=PAUSE * ' defb 'Press ENTER to begin * ' defb 'For more games by the same ' defb 'author visit www.cronosoft.co.uk * ' defb 255 rmbuff defw 0,0,0,0,0,0,0,0; flags which rooms have been used. dbyte defb 0 scno defb 0 ; screen number. scdone defb 0 ; counts screens completed. albuff defw 0,0,0,0,0,0 ; alien buffer. defw 0,0,0,0,0,0 dflag defb 0 ; indicates player is dead when non-zero. lives defb 0 ; lives counter. numobj defb 0 ; number of objects on current screen. score defw 0 ; player's score. hisc defw 0 ; highest score. tdir defb 0 ; temporary direction. jdir defb 0 ; jump direction. dispx defb 0 ; general purpose coordinate. dispy defb 0 ; general purpose coordinate. fallf defb 0 ; falling flag, indicates player is in mid-air. chrep1 defb 0 ; channel 1 repeat. chrep2 defb 0 ; channel 2 repeat. chptr1 defw 0 ; channel pointer. chptr2 defw 0 ; channel pointer. c1loop defw 0 ; channel loop. c2loop defw 0 ; channel loop. tmp0 defw 0 ; temporary address. tmp1 defw 0 ; temporary store. toofar defb 0 ; fallen too far flag. direct defb 0 ; old direction player was facing, 0=left. ndirec defb 0 ; new direction player is facing, 8=right. framec defb 0 ; frame counter. scdata equ 32000 ; address to which screen data is expanded.