; This source file is part of the LynxLib miscellaneous library by
; Robert Fischer, and is Copyright 1990 by Robert Fischer.  It costs no
; money, and you may not make money off of it, but you may redistribute
; it.  It comes with ABSOLUTELY NO WARRANTY.  See the file LYNXLIB.DOC
; for more details.
; To contact the author:
; 	Robert Fischer \\80 Killdeer Rd \\Hamden, CT   06517   USA
; 	(203) 288-9599     fischer-robert@cs.yale.edu

; Routines for loading spectrum pictures.  Handles SPC and SPU formats.
; Also converts from SPU to PI1 format.
; Made May 16, 1988

;.include "atari.s"

; Constants

scolr_len = 19104	; length of Spectrum colors
spec_len = 51104	; length of a Spectrum file
scr_len = 32000		; length of screen memory in bytes

degas_plen = 32		; length of degas palette
degas_len = degas_plen + scr_len + 2	; length of degas file
full_len = 63680	; 320*199 number of pixels in full color picture

; Imports
	.globl	_malloc
	.globl	_free
	.globl	_lmalloc
	.globl	_read_bytes

		.text
; ---------------------------------------------
;_main::
;	move.l	#scolr_len, -(sp)	; Allocate spec_colr
;	jsr		_lmalloc
;	move.l	d0, spec_colr
;	addq.l	#4, sp
;
;	move.l	spec_colr, -(sp)
;	Physbase
;	move.l	d0, -(sp)
;	move.l	#jan, -(sp)
;	jsr		_load_spc
;	lea		12(sp), sp
;
;	move.l	#pal, -(sp)
;	Physbase
;	move.l	d0, -(sp)
;	move.l	spec_colr, -(sp)
;	move.l	d0, -(sp)
;	jsr		_spu_to_degas
;	lea		16(sp), sp
;
;	move.l	spec_colr, -(sp)
;	jsr		_free
;	addq.l	#4, sp
;	Pterm0
;	.bss
;pal:	ds.w	16
;	.text

; ---------------------------------------------
; Call: spu_to_degas(spec_pic, spec_colr, pic_pt, pal_pt)
_spu_to_degas::
	move.l	4(sp), spec_pic
	move.l	8(sp), spec_colr
	move.l	12(sp), pic_pt
	move.l	16(sp), pal_pt

	move.l	#full_len*2, -(sp)	; Allocate full_color
	jsr		_lmalloc
	tst.l	d0				; Test for error
	beq		ret_nofree1

	addq.l	#4, sp
	move.l	d0, full_color

	movem.l	d3-d7/a3-a6,-(sp)	; save registers

; Set up sum square table for use in determining similarity
; of color vectors
h0:
		lea		color_dist,a0		; a0 points to this 1911-byte buffer
		move	#$f889,d6
		move	#3822,d7
he:
		move	d6,d0		; unpack 3 nybbles to d2, d1, d0
		move	d6,d1
		move	d6,d2
		andi	#$f,d0
		andi	#$f0,d1
		andi	#$f00,d2
		lsr		#4,d1
		lsr		#8,d2

		cmp		#8,d2	; if d2 >= 8
		bcs.s	h2e		; then
		subi	#16,d2	;   d2 := -(16-d2)
h2e:
		cmp		#8,d1	; if d1 >= 8
		bcs.s	h3a		; then
		subi	#16,d1	;   d1 := -(16-d1)
		addq	#1,d2	;   d2 := d2 + 1
h3a:
		cmp		#8,d0	; if d0 >= 8
		bcs.s	h46		; then
		subi	#16,d0	;   d0 := -(16-d0)
		addq	#1,d1	;   d1 := d1 + 1
h46:
		muls	d2,d2	; d0 := d0^2 + d1^2 + d2^2
		muls	d1,d1
		muls	d0,d0
		add		d2,d0
		add		d1,d0
		move.b	d0,(a0)+
		addq	#1,d6
		dbf		d7,he

; Call subroutine "find_color" once for each pixel in scan lines 1..199
; Args:  d1 = scan line
;        d0 = pixel on line
; Put word result into table "full_color"

		move.l	full_color,a5
		move	#$1,d7	; Scan line 1
hd4:
		clr		d6		; Pixel 0
hd6:
		move	d6,d0
		move	d7,d1
		bsr		find_color
		move	d0,(a5)+
		addq	#1,d6
		cmp		#320,d6
		bcs.s	hd6
		addq	#1,d7
		cmp		#200,d7
		bcs.s	hd4


; Clear frequency table
		lea		frequency,a0
		move	#$ff,d7
hfa:
		clr.l	(a0)+
		dbf		d7,hfa

; Count how many times each of the 512 colors occurs
		lea		frequency,a0
		move.l	full_color,a5
		move	#full_len-1,d7
h110:
		move	(a5)+,d0	; get color word from next pixel
		move	d0,d1		; pack together 3 bits for each of 3 nybbles
		andi	#$7,d1
		add		d1,d0
		move	d0,d1
		andi	#$7e,d1
		add		d1,d0
		lsr		#1,d0
		addq	#1,(a0,d0.w)	; tally color
		dbf		d7,h110

; Choose 16 most frequently used colors for Degas palette
		move.l	pal_pt, a6
		move	#15,d7
		move	#$400,d5		; dummy index past end of frequency table
h13c:
		lea		frequency,a0
		clr		(a0,d5.w)	; remove last chosen color

		move	#511,d6		; Scan for most frequent color
		clr		d0			; d0 = frequency
		move	#-1,d5		; d5 = color number of most frequent color 
h150:	cmp		(a0)+,d0
		bcc.s	h15a
		move	d6,d5
		move	-2(a0),d0
h15a:	dbf		d6,h150

		tst		d5			; if no remaining color used
		bpl.s	h168		; then begin
		move	#-1,(a6)	;	put end flag in Degas palette
		bra.s	h176		;   done coalescing colors
h168:						; end
		neg		d5			; put complement of color word in Degas palette
		addi	#511,d5		
		move	d5,(a6)+
		add		d5,d5		; d5 = byte index of color in frequency table
		dbf		d7,h13c
h176:

; Change Degas palette from 9 bit to 12 bit format
		move.l	pal_pt,a0
		move	#15,d7
h180:
		move	(a0),d0
		bmi.s	h19a		; branch if at end of palette
		move	d0,d1
		andi	#$1f8,d1
		add		d1,d0
		move	d0,d1
		andi	#$380,d1
		add		d1,d0
		move	d0,(a0)+
		dbf		d7,h180
h19a:

; Map all other colors into one of the chosen ones
		lea		distance_base,a4
		move.l	full_color,a5
		move.l	pal_pt,a6
		move	#full_len-1,d7
h1b0:
		move	#15,d6
		move	(a5),d0		; get color of next pixel

; Find closest Degas color index in d4
		lea		(a6),a0		; address of next Degas color
		move.b	#255,d2		; d2 = maximum possible distance
h1bc:
		move	(a0)+,d1	; get Degas color
		bmi.s	h1d2		; branch if at end of Degas palette
		sub		d0,d1
		move.b	$0(a4,d1.w),d3	; d3 = distance squared between colors
		cmp.b	d2,d3		; if current palette color is closer
		bcc.s	h1ce		; then
		move.b	d3,d2		;    d2 = minimum distance so far
		move	d6,d4		;    d4 = corresponding palette position
h1ce:
		dbf		d6,h1bc
h1d2:

; put new color index into full color array
		neg		d4			; d4 = 15-d4
		addi	#15,d4
		move	d4,(a5)+
		dbf		d7,h1b0

;-----------------------------------------------
; Construct Degas file image

; Set any unused Degas palette entries to zero
		move.l	pal_pt,a0
		move	#15,d7
h1e8:
		tst		(a0)+		; locate end of Degas palette
		dbmi	d7,h1e8
		tst		d7			; if there are unused colors
		bmi.s	h1fa		; then 
		subq.l	#2,a0		;    set them all to zeros
h1f4:
		clr		(a0)+
		dbf		d7,h1f4
h1fa:

; Clear scan line 0 of Degas file image
		move	#39,d7		; #words-1 in one scan line of one bit plane
		move.l	pic_pt, a0	; Get ready to mess up picture image
h1fe:
		clr.l	(a0)+
		dbf		d7,h1fe

; Convert scan lines 1..199 of full color raster image to Degas format
		move.l	full_color,a5
		move	#full_len/16-1,d7	; number of words in each bit plane
h20e:								; pack 16 pixels into 4 bit plane words
		move	#15,d6
h212:
		move	(a5)+,d5
		lsr		#1,d5
		roxl	#1,d0
		lsr		#1,d5
		roxl	#1,d1
		lsr		#1,d5
		roxl	#1,d2
		lsr		#1,d5
		roxl	#1,d3
		dbf		d6,h212

		move	d0,(a0)+		; put 4 bit plane words in screen memory
		move	d1,(a0)+
		move	d2,(a0)+
		move	d3,(a0)+
		dbf		d7,h20e

		move.l	full_color, -(sp)
		jsr		_free
		addq.l	#4, sp
		move.l	#-1, d0
ret_nofree1:
		movem.l	(sp)+,d3-d7/a3-a6	; restore registers
		rts
; ---------------------------------------------
.macro read_bytes handle, count, buf		; calles _read_bytes
	move.l	\buf,-(sp)
	move.l	\count,-(sp)
	move.l	\handle,-(sp)
	jsr		_read_bytes
	lea		12(sp), sp
.endm
; ---------------------------------------------
; Call: load_spu(in, spec_pic, spec_colr)
;	VFILE *in;
; loads an SPU file into memory
_load_spu::
	move.l	d7, -(sp)

; Read input file
	move.l	8(sp), d7	; d7 is file handle of input file


	move.l	12(sp), d0	; 12(sp) == spec_pic
	read_bytes	d7, #scr_len, d0
	tst.w	d0
	beq		.quit		; Branch on error

	move.l	16(sp), d0
	read_bytes	d7, #scolr_len, d0	; 16(sp) == spec_colr
	tst.w	d0
	beq		.quit		; Branch on error

	move.l	(sp)+, d7	; No error, return normally
	move.l	#-1, d0
	rts

.quit:	; Return a FALSE
	move.l	(sp)+, d7
	move.l	#0, d0
	rts

; ------------------------------------------
; Subroutine to return color of specified pixel at row d1, column d0
find_color:
		move.l	spec_pic,a0
		move.l	spec_colr,a1
		move	d1,d4		; d1 := d1*160 (offset into bitmap for row start)
		add		d1,d1
		add		d1,d1
		add		d4,d1
		lsl		#5,d1
		move	d0,d2
		move	d0,d3
		andi	#$f,d2		; d2 = bit position within bit plane word
		andi	#$fff0,d3	; d3 = byte offset for current column
		lsr		#1,d3
		add		d3,d1		; a0 = address of 4 bitplane words
		adda	d1,a0
		neg		d2			; d1 = mask with 1 at "position" d2
		addi	#15,d2
		clr		d1
		bset	d2,d1
		move	(a0)+,d3	; extract bit from plane 0
		and		d1,d3
		sne		d2			; pack it into d2
		ror		#1,d2
		move	(a0)+,d3	; extract bit from plane 1
		and		d1,d3
		sne		d2			; pack it into d2
		ror		#1,d2
		move	(a0)+,d3	; extract bit from plane 2
		and		d1,d3
		sne		d2			; pack it into d2
		ror		#1,d2
		move	(a0)+,d3	; extract bit from plane 3
		and		d1,d3
		sne		d2			; pack it into d2
		rol		#3,d2
		andi	#$f,d2		; mask out unwanted bits
		move	d2,d3		; d2 = d3 = color index
		add		d2,d2		; d2 = 10*d2 + 1
		add		d2,d2
		add		d3,d2
		add		d2,d2
		addq	#1,d2
		btst	#0,d3		; if odd(d3)
		beq.s	h2f0		; then
		subq	#6,d2		;   d2 := d2 - 6
; Find the word in the color table corresponding to color index in d2
h2f0:
		add		d3,d3		; initial color index
		cmp		d2,d0		; when does color change?
		bcs.s	h306		; branch if pixel is before first color change
		addi	#32,d3		; adjust color index
		addi	#160,d2		; move to right half of screen
		cmp		d2,d0
		bcs.s	h306		; branch if pixel is before second color change
		addi	#32,d3		; adjust color index
h306:
		move	d4,d0		; d4 = row number
		move	d0,d2		; d3 = 96*d4 (row offset into color table)
		add		d0,d0
		add		d2,d0
		lsl		#5,d0
		add		d0,d3
		move	-96(a1,d3.w),d0	; return color word
		rts
;-----------------------------------------
; Calling sequence: load_spc(in, spec_pic, spec_colr)
;	VFILE *in
_load_spc::
	move.l	4(sp), name
	move.l	8(sp), spec_pic
	move.l	12(sp), spec_colr
	movem.l	d3-d7/a3-a6,-(sp)	; save registers

	; Read 12 bytes from a file
	move.l	name, d5	; d5 is the file handle

	read_bytes	d5, #$c, #first_twelve
	cmp.w  	#$5350, first_twelve		; Check for valid header (only this for SPC files)
	bne		.ret_nofree		; 6600 013e

	; Allocate proper memory
	move.l	pic_len, -(sp)	; Allocate picbuf
	jsr		_lmalloc
	move.l	d0, picbuf
	move.l	color_len, (sp)	; Allocate colorbuf
	jsr		_lmalloc
	move.l	d0, colorbuf
	addq.l	#4, sp

	; Read the SPC file
	read_bytes	d5, pic_len, picbuf		; read picture info
	tst.w		d0
	beq			.ret_free

	read_bytes	d5, color_len, colorbuf		; read color info
	tst.w		d0
	beq			.ret_free

	move.l	picbuf,a0		; address of read data
	move.l	spec_pic,a1
	move	#$1,d1
	move	#$7,d7
	lea	$7d00(a1),a2		; end of 32000 bytes of picture
	lea	8(a2),a3
.hb7a:
	lea	-31840(a2),a1	; = 160 - 32000

.hb7e:	; get repetition count
	    ; positive:  copy count bytes
	    ; negative:  repeat next byte count times
	move.b	(a0)+,d6
	ext  	d6
	bmi.s	.hb90

.hb84:	; "positive" branch -- copy count bytes into current bitplane
	move.b	(a0)+,(a1)		; Stick in the next byte
	adda  	d1,a1		; increment output (a1) by 1 half the time, 7 half
	exg		d1,d7
	dbf		d6,.hb84; go around the # of times found out in the previous byte
	bra.s	.hba0		; skip past "negative" branch

.hb90:	; "negative" branch -- repeat next byte count times into bitplane
	neg  	d6
	addq  	#1,d6
	move.b	(a0)+,d0
.hb96:
	move.b	d0,(a1)		; 1280
	adda  	d1,a1		; d2c1
	exg	d1,d7		; c347
	dbf	d6,.hb96		; 51ce fff8

.hba0:
	cmpa.l	a2,a1		; have we filled the current bitplane?
	bcs.s	.hb7e		; no, so continue with next chunk of input file
	bne	.ret_free			; branch if we've overflowed bitplane
	addq.l	#2,a2		; set up for next bitplane
	cmpa.l	a3,a2		; a2=a3 when last bitplane is finished
	bcs.s	.hb7a		; branch if another bitplane needs doing

	move.l	a0,d0		; check that all of input was used
	addq.l	#1,d0
	bclr	#$0,d0
	sub.l	picbuf,d0
	cmp.l	pic_len,d0
	bne	.ret_free			; branch if error

; Decode color information
	move.l	colorbuf,a0		; 41f9 0000 a6f4
	move.l	spec_colr,a1		; 43f9 0000 ecea
	move.w	#$254,d7		; 3e3c 0254
	clr  	d0		; 4240
.hbd8:
	move.w	#13,d6		; set up loop to move 14 words to colortab
	move.w	(a0)+,d1	; first word is bitmap
	lsr  	#1,d1		; discard rightmost bit
	move.w	d0,(a1)+	; put 0 into colortab

.hbe2:
	lsr.w  	#1,d1		; get next bit of bitmap
	bcc.s	.hbee		; branch if it is a 0

	move.w	(a0)+,(a1)+	; bit is 1 -- copy next word
	dbf		d6,.hbe2
	bra.s	.hbf4
.hbee:
	move.w	d0,(a1)+	; bit is 0 -- copy in a zero
	dbf		d6,.hbe2

.hbf4:
	move.w	d0,(a1)+	; put 0 in colortab
	dbf		d7,.hbd8			; go around again

	sub.l	colorbuf,a0	; check that all data was used
	cmp.l	color_len,a0

	move.l	colorbuf, -(sp)	; Finished sucessfully, return TRUE
	jsr		_free
	move.l	picbuf, (sp)
	jsr		_free
	addq.l	#4, sp
	movem.l	(sp)+,d3-d7/a3-a6	; restore registers
	move.l	#-1, d0
	rts

.ret_free:		; Error-returning stuff
	move.l	colorbuf, -(sp)
	jsr		_free
	move.l	picbuf, (sp)
	jsr		_free
	addq.l	#4, sp
.ret_nofree:
	movem.l	(sp)+,d3-d7/a3-a6	; restore registers
	move.l	#0, d0
	rts
;-----------------------------------------
;-----------------------------------------

		.bss
name:	ds.l	1
;-----------------------------------------
; Spectrum file image
;spec_pic:	ds.b	scr_len				; Screen image
;spec_colr:	ds.b	spec_len - scr_len	; Color words
spec_pic: ds.l	1	; spec_pic and spec_colr are set up so their memory
spec_colr: ds.l	1	; is contiguous
;-----------------------------------------
; Full color bitmap with one color word per pixel
;full_color:			ds.w	full_len
full_color:	ds.l 1
;-----------------------------------------
; Degas file image
pal_pt:		ds.l	1	; Pointer to standard format palette
pic_pt:		ds.l	1	; Pointer to standard format picture image

; Degas file format
;			ds.b    2				; resolution
;			ds.b	degas_plen		; palette
;			ds.b	scr_len			; screen

;-----------------------------------------
; Frequency of occurrence of colors
frequency:	ds.w	513

; Table of color measures: a**2 + b**2 + c**2
color_dist:	ds.b	1911
distance_base:
		ds.b	1
		ds.b	1911

; Stuff for loading SPC files
first_twelve:	ds.w	2	; First 12 bytes of a file
pic_len:		ds.l	1
color_len:		ds.l	1

picbuf:			ds.b	4
colorbuf:		ds.b	4

	.data
healthy:	dc.b	"HEALTHY.SPU"
jan:		dc.b	"JAN.SPC"
