;FallDown Forever by Aaron Curtis in 2001 ;Best in 1024x768 or higher ;Thought you were going to do some easy reading, eh? ;Not likely! ;You thought wrong! ;I have made this source disturbingly complicated... ;Hahahahahahahahahah... ;Known problems: ;-link routines are not very stable... ;-game is kind of flickery... ; (don't think there's much way around this) ;-possibly a crash bug? ;-game always defaults back to 1-player mode... (is this bad?) ;-rle routine could be smaller... ;Basics of how this works: ; 3 video layers are set up, each one with a light ;and dark plane. One layer is marked as the "display" ;layer, and the interrupt code outputs it to the screen. ;Being grayscale, this takes several interrupts to do. So ;another layer is marked as the "ready" layer, and contains ;a ready-to-display screen, so that once the interrupts ;are done showing the display layer, they can switch over ;to the ready layer at any time. Then there's the "work" ;layer, which is where all the graphics are drawn. Once ;everything is fully drawn, the work layer becomes the ready ;layer. Scrolling is accomplished by copying the ready layer ;into the work layer, offset by 16 bytes. To keep things ;running smoothly, each series of tiles is pre-drawn in a buffer, ;one tile at a time each time the screen is scrolled. I bet ;that made no sense at all :) #include ti86asm.inc #include ti86und.inc #include ti86abs.inc #include asm86.h x equ $b800 backsave equ x ;32 bytes to save background ycoord equ x+32 ;2 bytes for coordinates xcoord equ x+33 backcount equ x+34 ;1 byte counter for the background tile backtile equ x+35 ;2 bytes pointer to background tile losses equ x+37 ;1 byte, number of link failures in a row animcount equ x+40 ;1 byte counter, tell what animation frame is in use ready equ $e580 ;pointers to 3 video buffers, 2k each. Display -- currently being display equ $e581 ;put on screen by interrupts. Ready -- will become display after work equ $e582 ;current disply is done. Work -- where graphics are being drawn. vidcount equ $e583 ;1 byte, counter for the interrupt routine score equ x+45 ;3 bytes, score (stored low-middle-high) temp equ x+48 ;7 bytes, string used to display score (last must=0) passedlines equ x+56 ;1 byte counter of number of platforms gone by speedcount equ x+57 ;1 byte, tells when the game should speed up players equ x+58 ;1 byte, number of players (1=1, 0=2) linkstat equ x+59 ;1 byte, tells whether this calc is sending or receiving oppycoord equ x+60 ;2 bytes for opponent's coordinates oppxcoord equ x+61 oppback equ x+62 ;32 bytes to save background under opponent spritedata equ $9000 ;table of pre-shifted gfx (4k) newstack equ $e600 ;$200 bytes need the old stack space for video layers (must not be on page 1) ltiles equ $a000 dtiles equ $b000 ;64 bytes each, areas for the next row of tiles to be drawn (off screen) unrolledldir equ $8010 ;2048-16 ldi's .org _asm_exec_ram nop jp start .dw $0001 .dw title .dw icon title: .db "Fall Down Forever 2.11",0 icon: .db 16,1 .db %11100110 .db %10000101 .db %11000101 .db %10000110 .db %00000000 .db %01111100 .db %11111110 .db %11111111 .db %11100111 .db %11100111 .db %00001111 .db %00011110 .db %00111100 .db %01111111 .db %11111111 .db %11111111 start: ;**** set up rom patch **** ld hl,($4065) ;this is $01a1 in all current rom versions ld (rompatch+1),hl ;**** unroll an ldir **** ld hl,unrolledldir ld bc,2048-16 unrollloop: ld (hl),$ed inc hl ld (hl),$a0 cpi jp pe,unrollloop ld (hl),$c9 ;ret ;**** move the stack **** ld hl,$fa00 ld de,newstack ld bc,512 ldir ;copy the stack to it's new home ld h,(newstack-$fa00)/256 ;l=0 add hl,sp ;put sp-$1400 in hl ld sp,hl call _flushallmenus call _runindicoff start2: call copytext call duplicate startgame: ld a,%11000000 ;put link in normal state out (7),a ;**** set up grayscale handler **** di ;if calc was already in im 2, it could crash w/out the di ld hl,$e300 ;vector table starts here ld a,h ld i,a ;put table address in i ld b,1 ;ld bc,256 ld d,h ;put $e301 in de ld e,b ld (hl),$e4 ;table points to $e4e4 ldir ;table is 257 bytes ld d,(hl) ld e,(hl) ;ld de,$e4e4 ld hl,intcode ld c,endintcode-intcode ;intcode < 256 bytes ldir ;copy the interupt code to $e4e4 im 2 ;tell calc to use im 2 ei call _clrLCD call copytext ld hl,$a000 ld de,$a001 ld b,$b9-$a0 ;c doesn't matter ld (hl),l ;l=0 ldir ;clear stuff on ram page 1, all variables set to 0 ld (linkend+1),sp ;save the stack pointer call setupscreen ;set up variables, has nothing to do with the screen call titlescreen ;display the title screen call _clrLCD ld a,(players) or a push af ld hl,waittext call z,disptext call copytext call transition ld a,%00110110 ld ($e4e4+reloadc+1-intcode),a ;switch to 1:2 mixing in game (title uses 2:3) ld hl,$c008 ;increase contrast a bit (see interrupt routine) inc (hl) pop af jr nz,singleplay call receive jr nc,speedreceived keepsending: call getkeyz cp K_EXIT jp z,killlink2 ;start2 ld bc,(numhalts+1) call send jr c,keepsending jr singleplay speedreceived: ld a,62 ld (xcoord),a ld a,50 ld (oppxcoord),a ld a,c ld (numhalts+1),a singleplay: ;**** the main program loop **** mainloop: call drawball ;draw the ball to the invisible layer ld a,(players) or a call z,drawoppball ;draw opponent's ball if in 2 player mode ;**change video layers** ld hl,work ;work layer is finished drawing ld b,(hl) ld a,(hl) dec hl add a,(hl) ;now look at the display layer dec hl ld (hl),b ;mark the work layer as ready to go neg add a,$d0 ;$e8+$f0+$f8 = $d0 ld (work),a ;take the remaining layer as the new workspace numhalts: ld a,0 ;get number of halts (self-modifying) or a jr z,superfast haltloop: dec a ;cp 0, also decrement counter halt ;delay program a bit jr nz,haltloop ;do it again superfast: ld d,a ;ld de,0 (coordinates for the top-left corner) ld e,a ld a,(players) ;no score in multiplayer or a push af call nz,dispscore ;display score call scroll ;scroll up, also draw a tile in the tile buffer ;scrolling actually copies the visible layer to the invisible one pop af call z,eraseoppball ;erase opponent's ball in 2 player mode call eraseball ;remove the ball from the invisible layer ld a,(ycoord) ;update y coordinate (gravity) cp 55 ;55 is the bottom adc a,0 ;increment if less than 55 ld (ycoord),a ;save position call fallcheck ;see if the ball will be pushed up call z,addpoints ;if the ball falls, you get some points ld a,%10111111 ;begin key checking out (1),a ;I have elected not to use any nop's in a,(1) rla ;check for more key call nc,pause rla ;check for exit key jr c,exitnotpressed ld a,(players) ;exit does different things for different player modes... or a jp z,exitpressed ;if 2-player, exit=game over jp nz,exitgame ;if 1-player, it assumes you want to leave quickly :) exitnotpressed: ld bc,(ycoord) ;get coordinates before changing them ld de,7*16 ;pre-load value used in both routines ld a,%11111110 ;\ out (1),a ; \ in a,(1) ; | rra ; | rra ; - check for arrow keys push af ; / call nc,moveleft ; \ pop af ; | rra ; / call nc,moveright ;/ ld a,(players) or a jr nz,nolink ;see if we need to update the opponent's position call receivestuff ;this times out very fast if the other ; calc isn't sending call c,sendstuff ;so then the first calc to get here is the sender ;this means that when the second calc starts receiving, ; the first will already be sending nolink: ld a,(backcount) ;\ inc a ; | and 7 ; -- go to next line in background ld (backcount),a ;/ jr nz,jpmain ;and do it all over again ld a,(animcount) ;do this 1 in 8 times add a,16 ;16 bytes per frame... and %00110000 ld (animcount),a jpmain: jp mainloop receivestuff: call receivedata ret c jr senddata sendstuff: call senddata ret c receivedata: call receive ;receive low byte ret c ld l,c call receive ;receive high byte ret c ld h,c notreceived: ld (oppycoord),hl ret senddata: ld hl,(ycoord) ld c,l call send ret c ld c,h jp send dump_cache: ;a=0-3, the line we're on in the tile buffer add a,a ;multiply by 16 add a,a add a,a add a,a ld l,a ld h,$b0 ;now hl points to somewhere in dtiles .db $dd,$6f ;ld ixl,a (undocumented op-codes) .db $dd,$26,$a0 ;ld ixh,$a0 ix points to an equivalent place in ltiles ld a,(work) ;high byte of current work layer add a,3 ;\ ld d,a ; \ ld e,$f0 ;--- put the last line (light layer) in de, ie/ $03f0 from the start of the page ld c,e ;\ add a,4 ; \ ld b,a ;--- dark invisible layer in bc, same offset as the light layer ld a,16 drawline: push af ;arr!!! I need more registers! ld a,(hl) ;swipe a byte from the dark tile buffer or a ;cp 0 jr z,notile ;if 0, there's a hole there ld (bc),a ;otherwise stick it on the screen ld a,(ix+0) ;then get on from the light layer ld (de),a ;and stick that on the screen notile: inc l ;increment everything (only lower bytes necessary) inc e inc c .db $dd,$2c ;inc ixl pop af dec a jr nz,drawline ;do 16 times ld a,(passedlines) ;count up how many times this routine has been called inc a and %00111111 ld (passedlines),a ret nz ld a,(numlines+1) ;after 64, make the platforms get closer together cp 26 ;but not if they're already really close jr z,tooclose dec a dec a ld (numlines+1),a tooclose: ld a,(speedcount) ;count up how many times the above has happened inc a and %00000011 ld (speedcount),a ret nz ld a,(numhalts+1) ;after 4, speed the game up sub 1 ;cp 1 / dec a ret c ;can't remove a halt if there are none ld (numhalts+1),a ld hl,ldpoints+1 ;only fair to give you more points inc (hl) ld hl,(backtile) ;go to next background as well ld bc,8 add hl,bc ld (backtile),hl ret pause: ;actually turn off the calc ld a,(players) or a ;no pausing in 2 player games ld a,%10000000 ;for keypresses ret z rlca ;ld a,%00000001 mask timer interupts, turn lcd off out (3),a halt ;wait till you press on (puts thing back to normal too) ld bc,$f000 ;give the calc a LONG time to think about it ; (the hardware must return to normal before another halt ; is reached, not sure on the specifics of this) rrca ;ld a,%10000000 (for keypresses) pauseloop: cpi ;dec bc ret po ;ret if bc=0 jr pauseloop ;otherwise keep looping addpoints: ld a,(players) or a ret z ld hl,(score) ldpoints: ;self-modifying code here ld bc,1 ;points added depends on game speed add hl,bc ld (score),hl ret nc ld hl,score+2 ;if score goes over 64k, make a note of it inc (hl) ret dispscore: ;the routine that uses _dispAHL is too slow ld hl,(score) ld a,(score+2) dispahl: ld (_penCol),de ld iy,$c3e5 ld de,temp+5 scoreloop: call _divAHLby10 ;this call is very weird, it divides ahl by 10, but add a,$30 ; puts the remainder in a, thus screwing up the answer... dec de ld (de),a ld a,h or l ;only check for hl=0 ld a,0 ;if the score is <19 bits, a would be 0 anyway (need flags) jr nz,scoreloop ex de,hl jp _vputs copytext: ;text is all in dark gray, this makes it black ld hl,$fc00 ld de,$f800 ld bc,1024 ldir ret moveleft: ld a,b or a ret z ;return if x coord is 0 call findpixel ;returns z if no shift jr nz,nolcheck ;only have to check if there's no shift ld bc,4*256-1 add hl,bc ld a,(hl) or a ret nz ;return if there's a dark byte to the left, ie/ a wall add hl,de cp (hl) ;a=0 ret nz ;have to do the same for the bottom of the ball too nolcheck: ld hl,xcoord dec (hl) dec (hl) ret moveright: ld a,b cp 120 ret z call findpixel ld bc,4*256+1 add hl,bc ld a,(hl) or a ret nz add hl,de cp (hl) ;a=0 ret nz ld hl,xcoord inc (hl) inc (hl) ret gameover: pop af ;was in a call... exitpressed: ld de,$0600 ld hl,govertext ld a,(players) or a jr nz,normaldeath ld a,%11111100 ;lower both wires out (7),a ;signal for "I'm dead" ld hl,losertext linkdeath: ld de,$0800 normaldeath: ld (_curRow),de push hl call duplicate call _clrLCD pop hl call _puts ;print Game Over or whatever call getkeyz ;flush keypress buffer ld de,(score) ld a,(score+2) ;your score in ade ld hl,lastscore+2 ;pointer to lowest high score (high byte) ld b,5 ;counter for this loop... checkscore: push bc push hl ld b,(hl) dec hl ld c,(hl) dec hl ld l,(hl) ld h,c ;high score in bhl ex de,hl ;ahl and bde, respectively call _cp_ahl_bde ;c if your score is lower ex de,hl ;your score back to ade pop hl pop bc jr c,scorechecked push bc ld bc,-14 ;go to the next highest score add hl,bc pop bc djnz checkscore scorechecked: ld c,a ;score in cde ld a,b cp 5 jp z,exitwait ;leave if score",0 behold: .db "Behold! The All Time Champions!",0 highnames: .db "----------",0 .dw 1000 .db 0 .db "----------",0 .dw 900 .db 0 .db "----------",0 .dw 800 .db 0 .db "----------",0 .dw 700 .db 0 .db "----------",0 lastscore: .dw 600 .db 0 backflag: .db 0 halloffame: pop af call _clrLCD ld hl,author ld de,$3400 call disptext ;preserves e ld d,$3a call disptext ld d,$00 call disptext ld b,5 ld de,$0c12 namesloop: push bc call disptext push de ld c,(hl) inc hl ld b,(hl) inc hl push hl ld a,(hl) ld h,b ld l,c ld e,$58 call dispahl pop hl pop de ld a,d add a,7 ld d,a inc hl pop bc djnz namesloop call copytext call transition hallwait: call getkeyz or a jr z,hallwait call duplicate jp startgame scroll: ;**** main scrolling part **** ld hl,(ready-1) ld l,16 ;offset hl down 1 line, so when copied the 2nd line becomes the first ;so hl is a pointer to the visible layer ld a,(work) ld d,a ;now de is a pointer to the invisible one ld e,0 push de ;hang on to this for later ; ld bc,2048-16 ;2 video pages = 2048 bytes (one for light, one for dark) ; ldir ;now the screen is scrolled *and* copied to the invisible layer call unrolledldir ;**** redrawing the bottom line **** (a pain with the double buffering) pop hl ;get invisible layer back in hl ld de,2048-16 add hl,de ;go to the last line of the dark tiles ld d,h ld e,l inc e ;put a pointer to the next byte over in de ld bc,15 ld (hl),b ldir ;zero-out the whole bottom line push hl ld hl,(backtile) ;get pointer to the background tile ld a,(backcount) ld c,a add hl,bc ;then move to the correct line ld a,(backflag) or a ;if this is 0 there is no background ld c,a jr z,nobg ld c,(hl) ;now get one line of the background tile in a nobg: pop hl ld a,-4 add a,h ld h,a ld d,h ld e,l dec e ;put one less than hl in de ld (hl),c ld c,15 ;same as before, ld bc,15 lddr ;same as before, but going backwards and copying the background ;**** pre-caching platform tiles **** linecount: ;label for self-modifying code ld a,4 ;starts at 4 so the platforms don't come right away inc a numlines: cp 40 ;more self-modifying code here jr c,stillgood xor a ;reset after it hits a certain number stillgood: ld (linecount+1),a ;save a back to the "ld a,4" line above cp 4 ;if under 4, draw the cache to the screen jp c,dump_cache ; instead of updating it platformcount: ld a,0 ;which tile we're drawing (self-modifying) ld c,a ;put in bc inc a and 15 ld (platformcount+1),a ;update counter while we're here ld hl,dtiles ;put the dark tile buffer in hl add hl,bc ;now point to the right one ld d,$a0 ;slick way of putting ltiles in de with the right offset ld e,l push de ;link routines will destroy de ld a,(players) or a jr nz,oneplayer ;if 1 player, just go to the random generator call receive ;try and receive a number from the other calc jr nc,tilereceived ;if receive succeeded, we're done call random ;if it failed, we're sending, so get a random number ld c,a ;put it in c... push bc ;save that so we have it later call send ;send it... pop bc tilereceived: ld a,c ;both calcs end with a number in a jr gotrand oneplayer: call random gotrand: pop de ld b,4 ;4 lines per tile cp 45 ;45/255 chance of getting a hole jr c,putahole tilecount: ld a,0 ;see how many tiles in a row there are (self-modifying) inc a ;add another one... ld (tilecount+1),a cp 13 ;if too many, put a hole jr nc,putahole ld ix,platformdark ;gfx in ix platdraw: push bc ;save counter ld a,(ix+0) ;get line from dark gfx ld (hl),a ;put in the buffer ld a,(ix+4) ;get line from light gfx ld (de),a ;put in the light buffer inc ix ;go to next line in gfx ld bc,16 ;\ add hl,bc ; \ ld e,l ; |- move to next line in both buffers pop bc ;get counter back djnz platdraw ;do the whole thing ret putahole: xor a ld (tilecount+1),a ;reset consecutive tiles to 0 ld de,16 holeloop: ld (hl),a add hl,de djnz holeloop ret random: ;This routine uses rom data to simulate random numbers... ;It does a rather poor job of it, but it's good enough for ;this game push hl ld a,r ;a=random-ish number <128 srl a ;a<64 ld h,a ;use that as the upper byte of an address (always rom page 0) lrand: ld l,0 ;use some value as the lower byte... (self-modifying) add a,(hl) ;get a number from there ld (lrand+1),a ;and use that as the next lower byte pop hl ret eraseoppball: ld bc,(oppycoord) ld de,oppback jr anti_mad eraseball: ld bc,(ycoord) ld de,backsave anti_mad: ;routine to erase mad sprites ;inputs: de=where you stored the background b=x coord c=y coord ;destroys: hl, de, bc, af dec c ;due to the screen being scrolled up... call findpixel ;get the invisible light layer in hl ld a,8 ;8 lines per sprite restoreloop: ex de,hl ;now the saved stuff is in hl, video mem in de ldi ldi ;load and increment a couple times ex de,hl ;put video mem back in hl ld bc,1022 ;move back 2 bytes and go to the dark layer add hl,bc ex de,hl ;put video mem back in de (destination) ldi ldi ex de,hl sbc hl,bc ;go back to light layer (6 bytes ahead of where we should be) ld bc,10 add hl,bc ;move to next line in video mem dec a ;decrement counter jr nz,restoreloop ;and do it again if needed ret ;wasn't that easy? drawoppball: ld bc,(oppycoord) ld iy,oppback jr drawball2 drawball: ld bc,(ycoord) ld iy,backsave drawball2: ld ix,bgfx11 ld hl,spritemask ld de,(animcount) add ix,de mad_sprite: ;about this wonderful routine: ;-sprites are in grayscale, and the routine will compensate for double buffering ;-sprite masking is also used on the light layer ;-the background behind the sprite is saved in 16-bit format for fast erasure (anti_mad) ;All this is accomplished by pre-calculating all possible sprite shifts and storing them in 256*2*8 table ;Yeah... it needs 4k free :( ;This thing can probably be optimized... ;inputs: ix=bitmap data iy=background storage space b=x coord c=y coord hl=pointer to mask ;destroys: hl, bc, de, af, ix, iy, (spritemaskld+1) (hey, at least no shadow registers :) ;note: the sprites must be done like the stack; i.e. firt drawn=last erased ld (spritemaskld+1),hl call findpixel add a,$90 ;the sprite table starts at $9000 ;**** sprite drawing part **** ld d,a ld b,8 spriteloop: ld c,(hl) ld (iy+0),c spritemaskld: ld a,(spritemask) ;self-modifying code here ld e,a push de ld a,(de) cpl and c ld c,a ld e,(ix+8) ld a,(de) or c ld (hl),a pop de inc d inc hl ld c,(hl) ld (iy+1),c ld a,(de) cpl and c ld c,a ld e,(ix+8) ld a,(de) or c ld (hl),a inc h inc h inc h inc h ld e,(ix+0) ;\ ld a,(hl) ; \ ld (iy+3),a ; \ ld a,(de) ; \ or (hl) ; \ ld (hl),a ; \ dec d ;------ this is your basic non-aligned sprite, note how much crap the masking dec hl ; / adds in the previous section ld a,(hl) ; / ld (iy+2),a ; / ld a,(de) ; / or (hl) ; / ld (hl),a ;/ inc ix push bc ld bc,16-1024 add hl,bc pop bc .db $fd,$2c ;inc iyl, faster than inc iy .db $fd,$2c .db $fd,$2c .db $fd,$2c ld a,(spritemaskld+1) inc a ld (spritemaskld+1),a djnz spriteloop ret findpixel: ld a,(work) ;doing our drawing on the work layer or a rra ;\ rra ;-- divide by 4, a little faster that srl a / srl a ld h,a ;this will get multiplied by 4 later ld a,c ;put y coord in a add a,a ;--multiply by 4 add a,a ;/ ld l,a ;now put that in l ld a,b ;put x coord in a rra ;\ add hl,hl ; \ rra ;--- divide a by 8, multiply hl by 4 (must be in this order) add hl,hl ; / rra ;/ ;so now hl is the y coord * 16, added to the appropriate offset add a,l ld l,a ;put the x coord together with hl, to get the offset in video mem (dark layer) ld a,b ;put the x coord in a and %00000111 ;this is the amount the pic must be shifted to the right add a,a ret ;outputs: hl=postion in invisible light layer a=upper byte of table address ;z=no shift setupscreen: ld hl,(50*256)+1 ld (ycoord),hl ld h,62 ld (oppycoord),hl ld a,4 ld (linecount+1),a ld a,40 ld (numlines+1),a ;**** generate table of gfx **** ld hl,spritedata ld d,l gentable: ld c,0 ld b,c gfxloop: push bc ld b,d ld a,d or a jr z,notshifted xor a shiftloop: srl c rra djnz shiftloop notshifted: ld (hl),c inc h ld (hl),a dec h inc hl pop bc inc c djnz gfxloop inc h inc d ld a,d cp 8 jr nz,gentable ret duplicate: ld hl,$f800 ld de,$f000 duplication: ld a,d ld (ready),a ld (display),a ld a,h ld (work),a ld bc,2048 ldir ret transition: ld b,8 transouter: ld de,$f000 ld hl,$f800 transloop: srl (hl) ld a,(de) rra ld (de),a inc de inc hl ld a,h or a jr nz,transloop halt djnz transouter ld h,$f0 ;l=0 ld d,$f8 ;e=0 jr duplication ;**** link routines **** ;these are identical in concept to the routines used in ZTetris, ZPong, and probably ;every other link game out there. However, these are commented :) send: ;inputs: c=byte to send, both wires must be high by default ;outputs: b=8-number of bits sent, both wires high, goes to game over on certain conditions ;destroys: af,bc,de in a,(7) and %00000011 jr z,killlink ;if both lines low, get out of here (game over signal) ld b,8 ;sending 8 bits sendloop: ld de,$0000 ;error timer rl c ;force high bit into carry ld a,%11010100 ;lower the red wire by default (sending 0) ($d4) jr nc,selected ;if high bit was 0, use above value ld a,%11101000 ;if 1, lower the white wire instead ($e8) selected: out (7),a ;put it out the link port waitconfirm: call linktimer in a,(7) ;see what the wires are doing and %00000011 ;check lower 2 bits jr nz,waitconfirm ;if both bits 0, data was received ok (both wires low) ld a,%11000000 out (7),a ;give the ok to raise both wires (one will be done automatically) ($c0) waitconfirm2: call linktimer in a,(7) and %00000011 cp 3 jr nz,waitconfirm2 ;wait for other calc to raise the other wire djnz sendloop ;continue sending xor a ;reset c; ld a,0 ld (losses),a ;reset number of losses ret receive: ;inputs: both wires must be high by default ;outputs: c=byte received, b=8-number of bits received, both wires high ; goes to game over on certain conditions ;destroys: af,bc,de in a,(7) and %00000011 jr z,killlink ;game over signal applies to receiving too ld b,8 ;receiving 8 bits receiveloop: ld de,200 ;error timer waitreceive: call linktimer in a,(7) and %00000011 cp 3 ;if bits 0 and 1 set, both wires are high jr z,waitreceive ;wait for one of the wires to go low rra ;check red wire status rl c ;if set, red is high (thus white is low), so put the correct bit into c rra ;now check white wire (since the flags are destroyed) ld a,%11010100 ;$d4 jr nc,selected2 ;if white is low, lower red and vice versa ld a,%11101000 ;$e8 selected2: out (7),a ;so now both wires are low waitreceive2: call linktimer in a,(7) and %00000011 jr z,waitreceive2 ;wait for the wire we didn't lower to go high again (the other will remain low) ld a,%11000000 ;$c0 out (7),a ;raise both wires since the other calc will have given the ok sign djnz receiveloop ;if not done, wait for next bit xor a ;reset c ld (losses),a ;reset number of losses ret ;what was received: ;x-coordinate: 0-127 -> reset bit 7, reset bit 1 ;y-coordinate: 0-63 -> set bit 7 ;tile number: 0-255 -> reset bit 7, set bit 1 linktimer: ;leave if we have to wait too long (and return an error) dec de ld a,d or e ;see if de is 0 ret nz ;if not, keep going as usual ;otherwise we have to deal with a link failure ld a,%11000000 ;$c0 out (7),a ;reset link status (both high) ld a,(losses) ;see how many consecutive losses we have inc a ld (losses),a ;add this loss to it pop de ;fix the stack to leave the linktimer routine (de is ok to destroy) cp 20 ;see if this is the 20th consecutive failure ret c ;if not, keep playing ;otherwise, all is probably lost... killlink2: ld hl,errortext ;will be used with _puts later jr linkend killlink: ld hl,winnertext linkend: ld sp,0 ;undo all the calls that were made (self-modifying) jp linkdeath ;**** interupt routine **** intcode: ;start of interupt, both iff's reset ex af,af' ;flip to shadow registers exx in a,(3) bit 1,a jr z,notatimerint ld a,($c008) ;save a few bytes by putting this here out (2),a ;use whatever contrast is stored in memory ld a,(display) ;display is $e8, $f0, or $f8 srl c jr nz,cnotzero reloadc: ;this actually goes l-d-d-l-d-repeat when you see it on the screen ld c,%00011100 ;if the counter hit 0, reset it push af ld a,(ready) ;so now that it's displayed fully, we can display the next one ld (display),a pop af cnotzero: jr nc,nopageflip ;if the bit was set, we're on the dark layer add a,$04 ;$f0->$f4 and $f8->$fc, put on dark layer if the bit was 1 nopageflip: out (0),a ;make it so notatimerint: ld a,%00001000 ;rather than check port 3, just reset both interupt types (bits 1 and 0) out (3),a ;now tell the hardware to turn them off ld a,%00001011 ;turn both types of interupts back on (bit 3 is set, so the lcd is on) out (3),a ;and tell the hardware to do it... (note bit 2 is reset) ex af,af' exx ei ;ei must be here or calc dies (in the power down routine) ret ;return from interupt (reti not needed) endintcode: texttable: .dw $1b02 .dw $2102 .dw $2702 .dw $2d67 .dw $3367 .dw $3a67 .dw $3402 .dw $3a02 platformdark: .db %11111111 .db %11111111 .db %11110000 .db %11110000 platformlight: .db %11111111 .db %11000000 .db %11001111 .db %11001111 backtile1: .db %10000011 .db %10000100 .db %01001000 .db %00111000 .db %00011100 .db %00010010 .db %00100001 .db %11000001 backtile2: .db %00100010 .db %01010101 .db %10001000 .db %10001000 .db %10001000 .db %01010101 .db %00100010 .db %00100010 backtile3: .db %10000001 .db %01000010 .db %00111100 .db %00100100 .db %00100100 .db %00111100 .db %01000010 .db %10000001 backtile4: .db %00010000 .db %00010000 .db %00101000 .db %01000100 .db %10000011 .db %01000100 .db %00101000 .db %00010000 backtile5: .db %00010000 .db %00100000 .db %00100000 .db %01100000 .db %11010111 .db %00001100 .db %00001000 .db %00001000 spritemask: ;a pretty wasteful mask :( .db %00111100 .db %01111110 .db %11111111 .db %11111111 .db %11111111 .db %11111111 .db %01111110 .db %00111100 bgfx11: .db %00111100 .db %01000010 .db %10000001 .db %10000011 .db %10000011 .db %10000111 .db %01011110 .db %00111100 bgfx12: .db %00111100 .db %01001110 .db %10001111 .db %10011101 .db %11111101 .db %11111001 .db %01100010 .db %00111100 bgfx21: .db %00111100 .db %01111110 .db %11111111 .db %11000011 .db %10000011 .db %10000111 .db %01011110 .db %00111100 bgfx22: .db %00111100 .db %01111110 .db %11000111 .db %10011111 .db %11111101 .db %11111001 .db %01100010 .db %00111100 bgfx31: .db %00111100 .db %01000010 .db %10011001 .db %11111111 .db %11111111 .db %10011111 .db %01011110 .db %00111100 bgfx32: .db %00111100 .db %01001110 .db %10101111 .db %11111111 .db %11111111 .db %11111101 .db %01100010 .db %00111100 bgfx41: .db %00111100 .db %01000010 .db %10000001 .db %10000011 .db %11000011 .db %11111111 .db %01111110 .db %00111100 bgfx42: .db %00111100 .db %01001110 .db %10001111 .db %10011101 .db %11111111 .db %11111111 .db %01111110 .db %00111100 #include rle.asm .end