.TITLE	ZPIC
	.IDENT	/V1.0/
; ++
; This is the Z-machine handler for picture opcodes.
; (c) 2005 by Johnny Billquist
;
; History:
;
; V1.0	05-02-23 16:30	BQT	Initial coding started.
; --
	.INCLUDE	/ZMAC/

FAKE=0		; Fake Zork Zero pictures.

	.PSECT	DATA,D,RW
;
PICTAB:

	.IF NE FAKE
	.INCLUDE	/ZZPIC/
	.ENDC

EPTAB:	.WORD	-1
;
	.PSECT	CODE,I,RO
;
; EXT:5 5 6 draw_picture picture-number y x
;
; PUTLCHR - Latin-1 in R1
; NUMTXT - Number in R0
;
	.ENABL	LSB
DRWPIC::
	.INSTR	"draw_picture",#3

	.IF NE FAKE
	MOV	(R2)+,R3
	MOV	ACTSCR,R1
	MOV	W.CX(R1),-(SP)
	MOV	W.CY(R1),-(SP)
	MOV	(R2)+,R0
	BEQ	10$
	MOV	R0,W.CY(R1)
10$:	MOV	(R2),R0
	BEQ	20$
	MOV	R0,W.CX(R1)
20$:	CALL	SCRCUR
	MOV	#'A,R1
	CALL	PUTCHR
	MOV	ACTSCR,R1
	MOV	(SP)+,W.CY(R1)
	MOV	(SP)+,W.CX(R1)
	CALLR	SCRCUR

	.IFF

	RETURN

	.ENDC
;
; EXT:6 6 6 picture_data picture-number array ?(label)
;
	.ENABL	LSB
PICDAT::
	.INSTR	"picture_data",#2
	MOV	(R2)+,R3		; Get picture number.
	BNE	1$			; Non-zero?
	MOV	(R2),R0
	.PUTWB	R0,#EPTAB-PICTAB/6	; Number of pictures.
	ADD	#2,R0
	.PUTWB	R0,#0			; Version of picture data.
	CALLR	BTRUE			; Done.

1$:
	.IF NE FAKE

	MOV	(R2),-(SP)		; Get address.
	MOV	#PICTAB,R2		; Get address of table.
10$:	TST	(R2)			; End of table?
	BPL	20$			; No.
	TST	(SP)+			; Yes. Clean stack.

	.IFTF

	CALLR	BFALSE			; No picture.

	.IFT

20$:	CMP	(R2)+,R3		; Correct picture?
	BEQ	30$			; Yes.
	ADD	#4,R2			; No. Next entry.
	BR	10$			; Loop.
;
; Found correct picture.
;
30$:	MOV	(R2)+,R1		; Get width.
	CALL	GETSCL			; Get screen width.
	MUL	R1,R0
	DIV	#320.,R0		; Scale...
	TST	R1			; Remainder non-zero?
	BEQ	40$
	INC	R0			; Yes. Round up.
40$:	MOV	(SP)+,R3		; Get address to write to.
	ADD	#2,R3
	.PUTWB	R3,R0			; Save it.
	SUB	#2,R3
	MOV	(R2),R1			; Get height.
	CALL	GETSLN			; Get lines on screen.
	MUL	R1,R0
	DIV	#200.,R0		; Scale...
	TST	R1
	BEQ	50$
	INC	R0			; Round up.
50$:	.PUTWB	R3,R0			; Save it.
	CALLR	BTRUE			; Success.

	.ENDC

;
; EXT:28 1C 6 picture_table table
;
	.ENABL	LSB
PICTBL::
	.INSTR	"picture_table",#1
	RETURN
;
; EXT:7 7 6 erase_picture picture-number y x
;
	.ENABL	LSB
ERPIC::	.INSTR	"erase_picture",#3
	RETURN
;
	.END