title	PALETTE utility
	name	('PALETTE')

; The AMSTRAD PALETTE utility for PCW machines

; Disassembled by W.Cirsovius

; Call: PALETTE option1 option2

OS	equ	0000h
BDOS	equ	0005h
CCPcmd	equ	0080h

_Conout	equ	 2
_Condir	equ	 6
_String	equ	 9
_vers	equ	12

CPM31	equ	31h
CPM22	equ	22h

SET.INK	equ	00cbh
SET.BOR	equ	00ceh
CD.VERS	equ	00e3h

_Userf	equ	30

LoMask	equ	00001111b
Mask	equ	00111111b

lf	equ	0ah
cr	equ	0dh
eot	equ	'$'
esc	equ	1bh
eof	equ	'Z'-'@'

_IG	equ	0
_HX	equ	2
_NM	equ	3
_EX	equ	4
_EO	equ	5

MSB	equ	7

	jr	PALETTE

	db	'PALETTE #115',cr,lf
	db	'Developed by Locomotive Software Ltd.',cr,lf
	db	'Copyright (C) 1985 '
	db	'Amstrad Consumer Electronics PLC',cr,lf
;
; %%%%%%%%%%%%%%%%%%%%%
; %%% START PALETTE %%%
; %%%%%%%%%%%%%%%%%%%%%
;
PALETTE:
	ld	(UsrStk),sp	; Save callers stack
	ld	sp,LocStk	; Get local stack
	call	GetVersion	; Get machine version
	call	PrepCCPLine	; Prepare command line
	call	c,ProcPAL	; Process palette set up
	ld	sp,(UsrStk)	; Get back stack
	ret
;
; Process palette set up
; ENTRY	Reg C holds macine type
;
ProcPAL:
	ld	a,c		; Test correct machine
	cp	3
	jp	z,InvalEnv	; .. nope
	call	GetNum		; Get 1st number
	jr	z,TstSet	; .. none
	call	SetBackGround	; Set background color
	call	GetNum		; Get 2nd number
	jr	z,TstEnd	; .. nope
	call	SetForeGround	; Define colour
	ld	b,2		; Init ink number
	jr	GetColour	; .. set colours
DefColour:
	call	SetColours	; Define ink and border
	inc	b		; .. bump ink number
	ld	a,b
	cp	16		; Test max
	ret	nc
GetColour:
	call	GetNum		; Get number
	jr	nz,DefColour	; .. it's more
	jr	TstEnd
TstSet:
	call	FixNL		; Test end of line
	jr	z,TstEnd	; .. nope
	ld	de,$NO.COLOR
	ld	c,_String
	jp	BDOS
$NO.COLOR:
	db	'No colour',cr,lf,eot
TstEnd:
	call	FixNL		; Test end of line
	ret	nz		; .. yeap
	ld	de,$BAD.COLOR
	jp	ProcErr
$BAD.COLOR:
	db	'Bad colour',cr,lf,eot
;
; Set backgound colour
; ENTRY	Reg L holds 0 or 1
;
SetBackGround:
	push	de
	ld	e,'c'
	call	SetESCAPE	; .. set it
	pop	de
	ret
;
; Set foreground colour
; ENTRY	Reg L holds 0 or 1
;
SetForeGround:
	push	de
	ld	e,'b'
	call	SetESCAPE	; .. set it
	pop	de
	ret
;
; Set ESCape sequence
; ENTRY	Reg E holds ESCape character
;	Reg L holds color
;
SetESCAPE:
	push	af
	ld	a,esc
	call	Condir		; Give ESCape
	ld	a,e
	call	Condir		; .. set character
	ld	a,l
	and	Mask		; Mask color
	add	a,' '
	call	Condir		; .. set it
	pop	af
	ret
;
; Print character on console via BDOS
; ENTRY	Accu holds character
;
Condir:
	push	hl
	push	de
	push	bc
	push	af
	ld	e,a
	ld	c,_Condir
	call	BDOS		; .. print
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret
;
; Set colours of ink and border
; ENTRY	Reg B holds ink number
;	Reg L holds colour
;
SetColours:
	push	bc
	push	af
	ld	a,b		; Get number
	ld	b,l		; Set colour
	ld	c,l
	push	bc
	push	af
	call	SetInk		; Define ink
	pop	af
	pop	bc		; Get back colours
	or	a
	call	z,SetBorder	; Set border on request
	pop	af
	pop	bc
	ret
;
; Process error
; ENTRY	Reg DE points to error message
;
ProcErr:
	push	bc
	push	af
	call	String		; Print error
	call	GetAttr		; Test EOL or EOF
	jr	nz,PE.ex	; .. yeap
	ld	de,$IGNORE
	call	String		; Tell ignoring
	jr	PE.go
PE.loop:
	ld	a,c
	call	Conout		; Print character
PE.go:
	call	GetChr		; Get character and attribute
	call	GetAttr		; Test EOL or EOF
	call	Get		; Get character
	jr	z,PE.loop	; .. there is more to print
	ld	de,$CRLF
	call	String		; .. close line
PE.ex:
	pop	af
	pop	bc
	ret
$IGNORE:
	db	'Ignoring rest of line: ',eot
$CRLF:
	db	cr,lf,eot
;
; Tell invalid environment
;
InvalEnv:
	push	de
	ld	de,$INVENV
	call	String		; Print error
	pop	de
	ret
$INVENV:
	db	'This program will not run in this environment'
	db	cr,lf,eot
;
; Print string on console
; ENTRY	Reg DE points to string closed by '$'
;
String:
	push	hl
	push	de
	push	bc
	push	af
	ld	c,_String
	call	BDOS		; .. print
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret
;
; Print character on console
; ENTRY	Accu holds character
;
Conout:
	push	hl
	push	de
	push	bc
	push	af
	ld	e,a
	ld	c,_Conout
	call	BDOS		; .. print
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret
;
; Get number from input
; EXIT	Zero set if no number
;	Reg HL holds number
;
GetNum:
	push	bc
	call	ChrGet		; Get valid character
	bit	_NM,b		; Test number
	jr	z,GN.hex	; .. nope
	call	GetDec
	jr	GN.ex
GN.hex:
	bit	_EX,b		; Test hex prefix
	jr	z,GN.ex		; .. nope
	call	GetHex		; .. get it
GN.ex:
	pop	bc
	ret
;
; Get decimal number
; EXIT	Reg HL holds number
;
GetDec:
	push	de
	push	bc
	call	ChrGet		; Get valid character
	bit	_NM,b		; Test number
	jr	z,GD.ex		; .. no
	ld	hl,0		; Init result
	jr	GD.go
GD.loop:
	ld	e,l		; Copy number
	ld	d,h
	add	hl,hl		; *  2
	add	hl,hl		; *  4
	add	hl,de		; *  5
	add	hl,hl		; * 10
GD.go:
	ld	a,c
	sub	'0'		; Strip off offset
	add	a,l
	ld	l,a		; .. add to old number
	adc	a,h
	sub	l
	ld	h,a
	call	Get		; Get character from file
	call	GetChr		; .. and attribute
	bit	_NM,b		; Test still number
	jr	nz,GD.loop	; .. yeap
	or	1		; .. set success
GD.ex:
	pop	bc
	pop	de
	ret
;
; Get hex number
; EXIT	Reg HL holds number
;
GetHex:
	push	bc
	call	ChrGet		; Get valid character
	bit	_EX,b		; Test expansion prefix
	jr	z,GH.ex		; .. nope
	call	Get		; Get character from file
	call	GetChr		; .. and attribute
	bit	_HX,b		; Test hex
	call	z,UnGet		; Unget character if not
	jr	z,GH.ex		; .. and exit
	ld	hl,0		; Init result
	jr	GH.go
GH.loop:
	add	hl,hl		; *  2
	add	hl,hl		; *  4
	add	hl,hl		; *  8
	add	hl,hl		; * 16
GH.go:
	ld	a,c		; Get character
	and	LoMask		; Mask lower part
	bit	_NM,b		; Test 0..9
	jr	nz,GH.dec	; .. yeap
	add	a,9		; Fix for hex
GH.dec:
	or	l
	ld	l,a		; Put into result
	call	Get		; Get character from file
	call	GetChr		; .. and attribute
	bit	_HX,b		; Test still hex
	jr	nz,GH.loop	; .. yeap
	or	1		; Set success
GH.ex:
	pop	bc
	ret
;
; Fix for end of line
;
FixNL:
	call	GetAttr		; Get attributes
	call	nz,Get		; .. read next if EOL or EOF
	ret
;
; Get valid definition character from file
;
ChrGet:
	jr	.ChrGet		; .. skip reading from file
CG.loop:
	call	Get		; Get character from file
.ChrGet:
	call	GetChr		; Get character and attribute
	bit	_EO,b		; Test end of file or line
	ret	nz		; .. exit
	bit	_IG,b		; Test valid character
	jr	nz,CG.loop	; .. nope
	ret
;
; Prepare CCP command line
; EXIT	Carry set if line OK
;
PrepCCPLine:
	push	hl
	push	de
	push	bc
	ld	hl,CCPcmd
	ld	a,(hl)		; Fetch length of input
	inc	a
	ld	(RecPtr),a	; .. save it
	inc	hl
	ld	(BufPtr),hl	; Init buffer
	dec	a
	add	a,l		; Point to end of line
	ld	l,a
	adc	a,h
	sub	l
	ld	h,a
	ld	(hl),eof	; Close line
	scf
	pop	bc
	pop	de
	pop	hl
	ret	nc
;
; Get character from command line
; Store character and attribute
;
Get:
	push	hl
	push	de
	push	bc
	push	af
	ld	hl,(BufPtr)	; Get current pointer
	ld	c,(hl)		; .. get character
	ex	de,hl
	call	PutChr		; .. save it
	ld	a,c
	cp	eof		; Test end of line
	jr	z,Get.eof
	ld	a,(RecPtr)
	dec	a		; Fix pointers
	ld	(RecPtr),a
	ex	de,hl
	inc	hl
	ld	(BufPtr),hl
Get.eof:
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret
;
; Unget current character
;
UnGet:
	push	hl
	push	de
	push	bc
	push	af
	ld	a,(Char)	; Get character
	cp	eof		; Test end of line
	ld	hl,(BufPtr)
	jr	z,UG.dummy	; .. yeap, skip
	ld	hl,RecPtr
	inc	(hl)		; Fix pointers if not
	ld	hl,(BufPtr)
	dec	hl
	ld	(BufPtr),hl
UG.dummy:
	dec	hl
	ld	c,(hl)
	call	PutChr		; Save character and attribute
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret
;
; Put character and attribute into memory
; ENTRY	Reg C holds character
;
PutChr:
	bit	MSB,c		; Test 80..FF
	ld	b,01h
	jr	nz,.PutChr	; .. yeap, set standard
	ld	b,0
	ld	hl,AttrTable
	add	hl,bc
	ld	b,(hl)		; Fetch attribute
.PutChr:
	ld	(Char),bc	; Save character and attribute
	ret
;
; Get current character and attribute
; EXIT	Reg C holds character
;	Reg B holds attribute
;
GetChr:
	ld	bc,(Char)	; Get character and attribute
	ret
;
; Get EOL or EOF state of current character
; EXIT	Zero set if not EOL or EOF
;
GetAttr:
	ld	a,(Attr)	; Get attribute
	and	1 SHL _EO	; .. test bit
	ret
;
; Get version of machine
; EXIT	Reg C holds type of machine
;	0 : CPC6128
;	1 : PCW8256
;	3 : CP/M 2.2 version
;	4 : Other machine
;
GetVersion:
	ld	c,_vers
	call	BDOS		; Get OS version
	cp	CPM31		; Test CP/M+
	jr	z,Vers31
	cp	CPM22		; Test CP/M 2.2
	ld	c,4
	ret	nz
	ld	c,3
	ret
Vers31:
	ld	hl,(OS+1)
	ld	de,3*(_Userf-1)
	add	hl,de
	ld	(Userf+1),hl	; Set USERF vector
	call	GetType		; Get machine type
	ld	c,a		; .. set result
	ret
;
; Execute BIOS function 30 : USERF
;
Userf:
	jp	$-$
;
; Get type of machine
; EXIT	Accu holds type of machine
;
GetType:
	call	Userf		; .. get type
	dw	CD.VERS
	ret
;
; Set colour of ink
; ENTRY	Accu holds ink number
;	Reg B holds 1st colour
;	Reg C holds 2nd colour
;
SetInk:
	call	Userf		; .. set it
	dw	SET.INK
	ret
;
; Set colour of border
; ENTRY	Reg B holds 1st colour
;	Reg C holds 2nd colour
;
SetBorder:
	call	Userf		; .. set it
	dw	SET.BOR
	ret
;
; Attribute table of all ASCII characters
; Bit definitions:
;
;    7    6    5    4    3    2    1    0
; +----+----+----+----+----+----+----+----+
; | xx | xx | EO | EX | NM | HX | AN | IG |
; +----+----+----+----+----+----+----+----+
;
; xx	N.C.
; EO	EOL or EOF
; EX	Extension string
; NM	Numeric 0..9
; HX	Hex range A..F
; AN	Alphanumeric prefix
; IG	Ignore for definition
;
AttrTable:
;
; Control characters
;
	db	01h,01h,01h,01h,01h,01h,01h	; 00..06
	db	01h,01h,01h,01h,01h,01h,21h	; 07..0D
	db	01h,01h,01h,01h,01h,01h,01h	; 0E..14
	db	01h,01h,01h,01h,01h,21h,01h	; 15..1B
	db	01h,01h,01h,01h			; 1C..1F
;
; ASCII characters
;
	db	01h,01h,00h,10h,01h,01h,10h	;  !"#$%&
	db	01h,01h,01h,01h,01h,01h,01h	; '()*+,\
	db	00h,01h,0ch,0ch,0ch,0ch,0ch	; ./01234
	db	0ch,0ch,0ch,0ch,0ch,01h,01h	; 56789:;
	db	01h,01h,01h,01h,01h,06h,06h	; <=>?@AB
	db	06h,06h,06h,06h,02h,02h,02h	; CDEFGHI
	db	02h,02h,02h,02h,02h,02h,02h	; JKLMNOP
	db	02h,02h,02h,02h,02h,02h,02h	; QRSTUVW
	db	02h,02h,02h,01h,01h,01h,01h	; XYZ[\]^
	db	01h,01h,06h,06h,06h,06h,06h	; _`abcde
	db	06h,02h,02h,02h,02h,02h,02h	; fghijkl
	db	02h,02h,02h,02h,02h,02h,02h	; mnopqrs
	db	02h,02h,02h,02h,02h,02h,02h	; tuvwxyz
	db	01h,01h,01h,01h,01h		; {|}~DEL

	db	eof

	ds	129,0

DATA	equ	1000h

UsrStk	equ	DATA+256
LocStk	equ	UsrStk+258
BufPtr	equ	UsrStk+258
RecPtr	equ	BufPtr+2
Char	equ	RecPtr+1
Attr	equ	Char+1

	end