; puzzle 1k - drop things down
; Dominic Morris 2002


; Some handy ROM routines/system variables
	defc	stakbc = $2d2b
	defc	printfp = $2de3
	defc	int_seed = 23670

	
	MODULE	pobble

	org	23775

	defc	arena   = 35000
	defc	sprites = 40960

	defc	playdepth	= 9
	defc	playwidth	= 7

	defc	arena_width	= 16
	defc	arena_depth	= playdepth * 2 

	defc	player_sprite = 8
	defc	water_sprite  = 9
	defc	wall_sprite   = 10

; entry point
	ld	hl,16384
	ld	bc,6911
	call	clear		;clear screen
	ld	hl,sprites	;set up a blank sprite
	ld	bc,32
	call	clear		;leaves a = 0	
	out	(254),a		

	; de holds sprites+33
	; Copy the ball sprite with ink colours 1-7
	ld	b,7
.loop	push	bc
	ld	hl,ball
	ld	bc,32
	ldir
	pop	bc
	ld	a,8	;get the attribute colour for the balls
	sub	b
	ld	(de),a
	inc	de
	djnz	loop
; hl now points to the other sprites
	ld	bc,33 *	3	;number of sprites
	ldir
	ld	hl,$0300	;level = 0, lives = 3
	ld	(level),hl	;initialises lives as well
	ld	(ballcol),hl	;rows_reqd is initialised elsewere
	ld	h,l
	ld	(score),hl	;hl = 0
.levloop
	call	init_level	;draw the first level
.ploop	ld	hl,1024		;counter for shifting up
	ld	(mloop1+1),hl
.mloop	xor	a
	ld	(23560),a
	ld	a,(pposn)
	ld	b,a
	ld	a,(ballcol)
	and	a
	jr	nz,mloop1	;no ball? then get one
	call	random		;saves bc
	ld	(ballcol),a
	jr	player_print	;print the character & ball
.mloop1	ld	hl,0		;water up count
	dec	hl
	ld	(mloop1+1),hl
	ld	a,h
	or	l
	jr	z,scroll_up	;jps back to levloop
	halt
	ld	a,(23560)	;get key press
	and	223
	jr	z,mloop1
	cp	'Q'
	jr	nz,not_left
	ld	a,b
	and	a
	jr	z,mloop
	dec	a	
; Entry a = new posn b = old posn
.pmove	push	af
	ld	c,b
	ld	b,arena_depth - playdepth -2
	xor	a
	push	bc
	call	arena_print
	pop	bc		;now blank out the ball
	inc	b
	ld	a,wall_sprite
	call	arena_print
	pop	af
	ld	(pposn),a
	ld	b,a
.player_print
	ld	c,b
	ld	b,arena_depth-playdepth - 2
	ld	a,player_sprite
	push	bc
	call	arena_print
	pop	bc
	inc	b
	ld	a,(ballcol)
	call	arena_print
	jr	mloop
.not_left
	cp	'P'
	jr	nz,not_right
	ld	a,b
	cp	7
	jr	z,mloop
	inc	a
	jr	pmove
.not_right
	cp	'M'
	jr	nz,mloop
; drop the stone here
	call	drop
	jr	nc,lifeover
	ld	hl,ballcol
	ld	(hl),0
	inc	hl	;rows_reqd
	ld	a,(hl)
	and	a
	jr	nz,mloop
	inc	hl	;level
	inc	(hl)
	jp	levloop

; Scroll the arena up
.scroll_up
	ld	hl,arena + arena_width
	ld	de,arena
	ld	bc,#(arena_depth - 1 ) * arena_width
	ldir
	ld	hl,arena + (arena_depth-1 ) * arena_width
	ld	a,water_sprite
	ld	bc,arena_width - 1
	call	clear1
	call	drawboard
	ld	c,arena_width
.sloop1
	ld	b,arena_depth - playdepth -1
.sloop	call	getcontent
	and	a
	jr	nz,lifeover
	djnz	sloop
	dec	c
	jr	nz,sloop1
	jp	ploop
; lose a life, on no lives left exit back to basic
.lifeover
	ld	a,(lives)
	dec	a
	ret	z
	ld	(lives),a
	jp	levloop

; Draw the game screen
.init_level
	ld	b,18	;draw the line at top
.draw1	push	bc
	ld	a,18
	sub	b
	ld	e,a
	ld	d,2
	ld	a,wall_sprite
	call	sprite
	pop	bc
	dec	b
	djnz	draw1
	ld	b,22	;now draw the sides
.draw2	push	bc
	ld	e,0
	ld	d,b
	ld	a,wall_sprite
	call	sprite
	pop	bc
	push	bc
	ld	d,b
	ld	e,18
	ld	a,wall_sprite
	call	sprite
	pop	bc
	dec	b
	djnz	draw2
	ld	hl,arena	;calculate how much water is needed and also
				;number of rows required to finish level
	ld	bc,arena_depth * arena_width 
	call	clear
	ld	a,(level)
	inc	a
	ld	l,a
	ld	h,0
	add	hl,hl
	add	hl,hl
	add	hl,hl
	ld	a,l
	ld	(rows_reqd),a	;rows = levels * 8
	add	hl,hl
	push	hl	;size
	ex	de,hl	;de = size
	ld	hl,arena + ( (arena_depth+1) * arena_width) 
	and	a
	sbc	hl,de
	pop	bc	;get length back
	dec	bc	;correct length (cut?)
	ld	a,water_sprite
	call	clear1
; now draw the playing field 
.drawboard
	ld	b,arena_depth   ;rows
.dplay1	ld	c,playwidth+1	;cols
.dplay2	push	bc
	dec	c
	call	getcontent
	call	arena_print
	pop	bc
	dec	c
	jr	nz,dplay2
	dec	b
	ld	a,b
	cp	arena_depth - playdepth  	;top row
	jr	nc,dplay1
; Now print the text
.txtprt
	ld	hl,leveltxt
	call	pstr
	ld	bc,(level)
	call	pnum1	
	call	pstr		;scoretxt follows
	ld	bc,(score)
	call	pnum
	call	pstr		;rowstxt follows on
	ld	bc,(rows_reqd)
	call	pnum1
	call	pstr		;lives txt follows
	ld	bc,(lives)
	jp	pnum1
	


.arena_print
	ex	af,af
	ld	a,b
	add	a,a	;*10	;18 -? 22, 15->20
	sub	14
	ld	d,a
	ld	a,c
	add	a,a
	add	2	;gets xpos
	ld	e,a
	ex	af,af

.sprite	inc	a	;print a sprite
	ld	bc,33
	ld	hl,sprites-33
.sprit1 add	hl,bc  
	dec	a  
	jr	nz,sprit1  
.spriti ld	a,d  
	and	248  
	add	64
	ld	c,a  
	ld	a,d  
	and	7  
	rrca  
	rrca  
	rrca  
	add	e  
	ld	e,a  
	ld	d,c  
	push	de
	ld	b,16        ; 16 lines in a sprite
.sprit2	ld	a,(hl)  
	ld	(de),a  
	inc	hl  
	inc	e  
	ld	a,(hl)  
	ld	(de),a  
	inc	hl  
	dec	e  
	inc	d  
	ld	a,7  
	and	d  
	jr	nz,outlo  
	ld	a,e  
	add	32  
	ld	e,a  
	jr	c,outlo  
	ld	a,d  
	sub	8  
	ld	d,a  
.outlo	djnz	sprit2  
	pop	de
	ld	a,d  
	rrca  
	rrca  
	rrca  
	and	3  
	or	88
	ld	d,a  
	ex	de,hl  
	ld	bc,31  
	ld	a,(de)  
	ld	(hl),a  
	inc	l  
	ld	(hl),a  
	add	hl,bc  
	ld	(hl),a  
	inc	l  
	ld	(hl),a  
	ret   

; Drop the ball here
.drop	ld	b,arena_depth - playdepth 
	ld	a,(pposn)
	ld	c,a
	call	getcontent	;check the first position
	and	a
	ret	nz
	dec	b		;now back to wall level
	
; b = row c = column
.drop1	inc	b		;go to next row
	call	getcontent
	and	a
	jr	nz,check_row	;reached the position below is not suitable
	push	bc
	ld	a,(ballcol)
	ld	(hl),a		;place it in the arena
	call	arena_print
; now blank out the position above
	pop	bc
	push	bc
	dec	b
	call	getcontent
	xor	a
	ld	(hl),a
	call	arena_print
	halt			;wait a bit so player can see ball drop
	halt
	halt
	halt
	pop	bc
	jr	drop1

; Check for completed rows
.check_row	
	dec	b
	call	getcontent
	ld	a,(ballcol)
	ld	(hl),a
.check_row_lp
	ld	b,arena_depth ;bottom row
.check_row_0
	ld	c,playwidth+1 	;far right column +1
.check_row_1
	dec	c
	call	getcontent
	ld	de,1		;horiz right
	call	check_row_offs
	jr	c,check_row_lp
	ld	de,-arena_width - 1	;diag left
	call	check_row_offs
	jr	c,check_row_lp
	inc	de		;vertical up
	call	check_row_offs
	jr	c,check_row_lp
	inc	de		;diag right
	call	check_row_offs
	jr	c,check_row_lp
	inc	c
	dec	c
	jr	nz,check_row_1
	dec	b
	ld	a,b
	cp	arena_depth - playdepth
	jr	nz,check_row_0
	scf			;we dropped successfully
	ret

; Check a row
; Entry: 	hl = current check position
;		 a = colour to check
;		de = offset to get to next
; Exit:		 c = got row, have crunched, nc = carry on checking
.check_row_offs
	and	a	;sets nc
	ret	z
	cp	water_sprite	;water
	ret	nc	;i.e. is water
	push	hl
	add	hl,de
	cp	(hl)
	jr	z,check_row_offs2
.check_row_offs1
	pop	hl
	and	a
	ret
.check_row_offs2
	add	hl,de
	cp	(hl)
	jr	nz,check_row_offs1
; Success
	xor	a
	ld	(hl),a	;final posn
	pop	hl	;get start back
	ld	(hl),a	;first posn
	add	hl,de
	ld	(hl),a	;second posn
	call	crunch	;move everything down
	ld	hl,rows_reqd
	ld	a,(hl)
	and	a
	jr	z,check_rows_offs3
	dec	(hl)
.check_rows_offs3
	ld	hl,(score)	;add score
	ld	de,(level)
	ld	d,0
	inc	de
	add	hl,de
	ld	(score),hl
	call	drawboard
	jp	line_sfx

.crunch
	ld	b,arena_depth	;bottom row
.crunch_0
	ld	c,playwidth	;far right column
.crunch_1
; check horizontal holes
	call	getcontent
	and	a
	jr	z,crunch_3
.crunch_2
	dec	c
	jr	nz,crunch_1
	dec	b
	ld	a,b
	cp	arena_depth - playdepth
	jr	nz,crunch_0
	ret
; Do the crunch
.crunch_3
	push	bc
; Move down
; Entry hl = hole
	ld	a,playdepth
	ld	bc,-arena_width
.movedown1
	ld	d,h
	ld	e,l	;de = dest
	add	hl,bc
	ex	af,af
	ld	a,(hl)
	ld	(de),a
	ex	af,af
	dec	a
	jr	nz,movedown1
	pop	bc	
	jr	crunch_2


; Get the content at a certain point in the arena
; Entry:	b = row c = column
; Exit:		hl = point a = content
.getcontent
	ld	l,b
	dec	l
	ld	h,0
	add	hl,hl
	add	hl,hl
	add	hl,hl	; *8
	add	hl,hl	; *16
	ld	e,c
	ld	d,0
	add	hl,de
	ld	de,arena
	add	hl,de
	ld	a,(hl)
	ret

; Clear some space
.clear	xor	a
.clear1	ld	d,h
	ld	e,l
	inc	de
	ld	(hl),a
	ldir
	ret

; Print a 255 terminated string using ROM routines
.pstr	ld	a,(hl)
	inc	hl
	inc	a
	ret	z
	dec	a
	rst	16
	jr	pstr

; Print (b)c using ROM routines preserving hl
.pnum1	ld	b,0
.pnum	push	hl
	call	stakbc
	call	printfp
	pop	hl
	ret

; Random routine - needs to preserve bc
.random	ld	hl,(int_seed)
	ld	a,h
	add	a
	rl	l
	rl	h
	add	a
	rl	l
	rl	h
	add	a
	rl	l
	rl	h
	ld	de,$7415
	add	hl,de
	ld	(int_seed),hl
	ld	a,l
	and	7		;don't want colour 0
	jr	z,random
	ret

; Sound effect reused from Twintris to indicate completed row
.line_sfx
	xor	a
	ld	b,128  
	di    
.linbp1	push	bc  
	xor	16  
	out	(254),a  
.linbp2	nop   
	nop   
	djnz	linbp2  
	pop	bc  
	djnz	linbp1  
	scf			;ensure that we recheck the board
	ei    
	ret   

; Some ingame text
.leveltxt
	defb	22,7,24
	defb	17,0,16,7
	defm	"Level: "
	defb	22,8,24,255
.scoretxt
	defb	22,4,24
	defm	"Score: "
	defb	22,5,24,255
.rowstxt
	defb	22,11,24
	defm	"Reqd: "
	defb	22,12,24,255
.livestxt
	defb	22,14,24
	defm	"Lives: "
	defb	22,15,24,255

; Variables used in the game
.ballcol	defb	0
.rows_reqd	defb	0
.level		defb	0
.lives		defb	0

.score		defw	0

.pposn		defb	0	; players x posn

; Now the sprites
.ball	defb    @00000000,@00000000
        defb    @00000011,@11000000
        defb    @00001101,@01110000
        defb    @00010001,@11111000
        defb    @00111011,@01111100
        defb    @00010001,@10111100
        defb    @01010101,@11111110
        defb    @00100101,@11111110
        defb    @01001101,@01111110
        defb    @00010011,@11001110
        defb    @00100101,@11010100
        defb    @00010011,@10111100
        defb    @00000101,@11111000
        defb    @00001100,@11110000
        defb    @00000011,@11000000
        defb    @00000000,@00000000

.hero	defb    @00000000,@00000000
        defb    @00000001,@11000000
        defb    @00000111,@11110000
        defb    @00001111,@11111000
        defb    @00011111,@11111100
        defb    @00011000,@00001100
        defb    @00110001,@00010110
        defb    @00110000,@00000110
        defb    @00111000,@10001110
        defb    @00111111,@11111110
        defb    @00011101,@11011100
        defb    @00011110,@00111100
        defb    @00001111,@11111000
        defb    @00000111,@11110000
        defb    @00000001,@11000000
        defb    @00000000,@00000000
        defb    4

.water	defb    @00000000,@00000000
        defb    @00000001,@10000000
        defb    @00000011,@11000000
        defb    @00000111,@11100000
        defb    @00001111,@11110000
        defb    @00011111,@11111000
        defb    @00111111,@11111100
        defb    @01111111,@11111110
        defb    @01111111,@11111110
        defb    @00001111,@11110000
        defb    @00001111,@11110000
        defb    @00001111,@11110000
        defb    @00001111,@11110000
        defb    @00001111,@11110000
        defb    @00001111,@11110000
        defb    @00000000,@00000000
        defb    78

.wall	defb    @01111111,@01111111
        defb    @01010101,@01010101
        defb    @00101011,@00101011
        defb    @00000000,@00000000
        defb    @11110111,@11110111
        defb    @01010101,@01010101
        defb    @10110010,@10110010
        defb    @00000000,@00000000
        defb    @01111111,@01111111
        defb    @01010101,@01010101
        defb    @00101011,@00101011
        defb    @00000000,@00000000
        defb    @11110111,@11110111
        defb    @01010101,@01010101
        defb    @10110010,@10110010
        defb    @00000000,@00000000
	defb	5