	.TITLE	DEVICE
 	.DSABL	GBL
	.GLOBL	DISP	ENTRY
 	.GLOBL	WINPKE	HLINE	INVIEW
 	.GLOBL	P0	P1

	.INCLU	"SCRMAC"
	.INCLU	"DIAMAC"

BY	=	6.

.MACRO	.LABEL	ADDR,CODE
	.WORD	ADDR-.,CODE
.ENDM

A.F7::
	.PUSH	<TB.PAL,TB.PAL+2>

	MOV	#2*2,INVIEW
	CALL	HLINE
	CLR	INVIEW

	.DIALOG	#D.PAL
	.WHCUR

	MOV	DIA.BX,R1
	MOV	R1,R0
	DEC	R0
	.WPUT	#T.SEMI,R0,#BY+4,#28.+2

	CLR	R3
	MOV	#4,R0
1$:	.WATTR	R3
	ADD	#^B0100,R3

	MOV	#BY,R2
	MOV	#4,R4
2$:	.WCCLR	R1,R2,#7
	INC	R2
	SOB	R4,2$

	ADD	#7,R1
	SOB	R0,1$

	.WATTR	#^B1000
	MOV	DIA.BX,R1
	ADD	#3,R1
	MOV	#T.DIG,R2
	MOV	#TB.PAL,R3

	MOV	#4,R0
3$:	MOVB	(R3)+,R4
	ADD	#'0,R4
	MOVB	R4,@R2
	.WPUT	R2,R1,#BY+5,#1
	ADD	#7,R1
	SOB	R0,3$

	.WATTR	#^B0111

	MOV	X.PAL,R1

CURON:	CALL	CURSOR
KEYIN:	CALL	WINPKEY
	JSR	R0,DISP
	.LABEL	DOWN	,215
	.LABEL	DOWN	,221  
	.LABEL	UP	,214
	.LABEL	UP	,220
	.LABEL	LEFT	,216
	.LABEL	RIGHT	,217
	.LABEL	RIGHT	, 11
	.LABEL	RIGHT	, 40
	.LABEL	DONE	,212
	.LABEL	DONE	, 33
	.LABEL	ENTER	,200
	.LABEL	F2	,202
	.LABEL	F3	,203
	.WORD
	SUB	#'0,R0
	BLT	KEYIN
	CMP	R0,#7.
	BGT	KEYIN
	MOVB	R0,TB.PAL(R1)
	CALL	SET
	BR	RIGHT

UP:	INCB	TB.PAL(R1)
	BR	BIC7

DOWN:	DECB	TB.PAL(R1)
BIC7:	BICB	#^C7,TB.PAL(R1)
.SET:	CALL	SET
	BR	KEYIN

LEFT:	CALL	CURSOR
	DEC	R1
	BR	BIC3

RIGHT:	CALL	CURSOR
	INC	R1
BIC3:	BIC	#^C3,R1
	BR	CURON

F2:;	0357
	MOV	#3*400+0,TB.PAL
	MOV	#7*400+5,TB.PAL+2
	BR	ENTER
F3:;	0176
	MOV	#1*400+0,TB.PAL
	MOV	#6*400+7,TB.PAL+2
ENTER:
	CMP	(SP)+,(SP)+
	BR	.SETPAL
DONE:
	.POP	<TB.PAL+2,TB.PAL>

.SETPAL:
	CALL	SETPAL

	MOV	R1,X.PAL

	.WATTR	#^B1011 
 	.WRES
	CALL	HLINE
	.WSCUR
	JMP	ENTRY

CURSOR:	MOV	R1,R3
	MUL	#7,R3
	ADD	DIA.BX,R3
	ADD	#2,R3
	.WINV	R3,#BY+5,#3
	RETURN

SET:	MOV	R1,R3
	MUL	#7,R3
	ADD	DIA.BX,R3
	ADD	#3,R3
	MOVB	TB.PAL(R1),R4
	ADD	#'0,R4
	MOV	#T.DIG,R2
	MOVB	R4,@R2
	.WPUT	R2,R3,#BY+5,#1
SETPAL::
	MOV	#TB.PAL,R2
	MOV	#P0,R3
	MOV	#4,R4
1$:	MOVB	(R2)+,R0
	BIS	#^B1000,R0
	MOVB	R0,@R3
	ASL	R0
	ASL	R0
	ASL	R0
	ASL	R0
	BISB	R0,(R3)+
	SOB	R4,1$
	.WPAL
	RETURN

D.PAL:
	.WORD	^B1000
	.WORD	28.,8.-2
	.WORD	BY-2.
	.WORD	TL.PAL
	.WORD
	.WORD

X.PAL::	.WORD	0
TB.PAL::.BYTE	0,3,5,7

TL.PAL:	.ASCIZ	" Palette "
T.SEMI:
	.BYTE	242
.REPT	28.
	.BYTE	265
.ENDM
	.BYTE	240
T.DIG:	.BYTE	'0
	.EVEN

	.END
                                                                                                                                                                                                                    