LaceGeoPic
PRG formatted GEOS file V1.0
Paint PAGES
'	LaceGeoPic.rel
BLASTER'S CONVERTER V2.1
Write Image V2.1
geoWrite    V2.1
.noeqin
.noglbl
.if	Pass1		;Only need to include these files
	.include	LaceSym		;get GEOS definitions
	.include	LaceMac		;get GEOS macro definitions
.endif
.glbl
.eqin
.ramsect
Input:	.block	640*2+8+80*2	;input buffer for 1 compacted record
OutPut1:	.block	640*2+8+80*2	;output buffer for 2 card rows with color
.psect		
	;on entry GeoPiant pic file name is in "Name"
	;and disk is opened and ready to use
GetPic:	LoadW	r0,Name
	jsr	OpenRecordFile
	bne	999$	;On Error abort
	LoadW	a5,0+80	;VDC address for foreground screen
	LoadW	a4,$5000-3*80	;VDC address for background screen
	LoadW	a6,$c4a0	;VDC address for forecolor memory
	LoadW	a7,$d800+80	;VDC address for backcolor memory
	LoadB	a9L,25	;number of records to display (50 card rows)
	lda	StartRec
	jsr	PointRecord
	bne	99$
10$	LoadW	r2,640*2+8+80*2	;Maximum number of bytes that can be read
	LoadW	r7,Input
	jsr	ReadRecord
	tay		;save rec status flag
	txa		;Check for disk error
	bne	99$	;if x<>0 then disk error, abort
	tya		;Check rec status flag
	beq	20$	;if status=0 then record is empty, Do empty rec
	;Unpack record and display
	jsr	UnPack
	jsr	PutVdc
	bra	30$
	;fill output buffer with Empty data, (Blank screen, with default geos colors)
20$	sei
	jsr	EmptyRec
	jsr	PutVdc
30$	dec	a9L	;Exit if no more 
	beq	99$	;       records to display
	jsr	NextRecord
	beq	10$	;if no error do again
99$	rts		;exit Display
999$	pla		;If there is an error while trying to 
	pla		;open a file then abort back to 
	jmp	Click	;the file box
ProcTable:	.word	KeyProc
	.word	1
KeyProc:	jsr	TempHideMouse
	lda	keyData
	ldx	#0
	stx	keyData
	cmp	#KEY_F1
	beq	10$
	cmp	#KEY_F3
	beq	20$
	cmp	#KEY_F5
	beq	30$
00$	rts
10$	lda	#0
ProcTable:	.word	KeyProc
	.word	1
KeyProc:	jsr	TempHideMouse
	lda	keyData
	ldx	#0
	stx	keyData
	cmp	#KEY_F1
	beq	10$
	cmp	#KEY_F3
	beq	20$
	cmp	#KEY_F5
	beq	30$
00$	rts
10$	lda	#0
	cmp	StartRec
	beq	00$
	sta	StartRec	;F1=Top of page
	jsr	ClearVDC
	jmp	GetPic
20$	lda	#10
	cmp	StartRec
	beq	00$
	sta	StartRec	;F3=Middle of page
	jsr	ClearVDC
	jmp	GetPic
30$	lda	#20
	cmp	StartRec
	beq	00$
	sta	StartRec	;F4=Bottom of page
	jsr	ClearVDC
	jmp	GetPic
UnPack:	LoadW	a0,Input
	LoadW	a1,OutPut1
UnL:	ldy	#0
	lda	(a0),y
	beq	UExit	;Zero = end of record
	cmp	#$40
	bcs	10$
	jsr	UP1	;Compaction command 1
	bra	UnL	
10$	beq	UExit	;invalid command, abort record
	cmp	#$80
	bcs	20$
	jsr	UP2	;Compaction command 2
	bra	UnL
20$	beq	UExit	;invalid command, abort record
	jsr	UP3	;Compaction command 3
	bra	UnL
UExit:	rts
EmptyRec:	;fill output buffer
	jsr	i_FillRam
	.word	640*2
	.word	OutPut1
	.byte	0
	jsr	i_FillRam
	.word	80*2
	.word	OutPut1+640*2+8
	.byte	$0f
UP1:	pha
	AddVW	1,a0
10$	lda	(a0),y
	sta	(a1),y
	bpl	10$
	adc	a0L
	sta	a0L
	lda	#0
	adc	a0H
	sta	a0H
	adc	a1L
	sta	a1L
	lda	#0
	adc	a1H	
	sta	a1H
UP1:	pha
	AddVW	1,a0
10$	lda	(a0),y
	sta	(a1),y
	bpl	10$
	adc	a0L
	sta	a0L
	lda	#0
	adc	a0H
	sta	a0H
	adc	a1L
	sta	a1L
	lda	#0
	adc	a1H	
	sta	a1H
UP2:	sec
	sbc	#$40
	AddVW	1,a0
5$	ldy	#7	
10$	lda	(a0),y
	sta	(a1),y
	bpl	10$
	lda	#8
	adc	a1L
	sta	a1L
	lda	#0
	adc	a1H
	sta	a1H
	bne	5$
30$	AddVW	8,a0
99$	rts
UP3:	s
UP3:	sec
	sbc	#$80
	sta	a3L
	ldy	#1
	lda	(a0),y
	ldy	a3L
10$	sta	(a1),y
	bpl	10$
	lda	a3L
	adc	a1L
	sta	a1L
	lda	#0
	adc	a1H
	sta	a1H
	AddVW	2,a0
PutVdc:	jsr	ConvCol	;
PutVdc:	jsr	ConvCol	;40 col colors must be converted to VDC colors
	jsr	PutEvCo	;Put even scan lines to forescreen
	jsr	PutOdCo	;put odd scan lines to backscreen
	jsr	PutEvSc	;put colors to front color ram
	jsr	PutOdSc	;put colors to back color ram
ConvCol:	LoadW	a0,OutPut1+640*2+8
	ldy	#0
10$	lda	(a0),y
	jsr	Cvt
	sta	(a0),y
	cpy	#160
	bne	10$
Cvt:	pha
	and	#%00001111
	lda	ColTable,x
	rol	a
	rol	a
	rol	a
	rol	a
	sta	Temp
	and	#%11110000
	lsr	a
	lsr	a
	lsr	a
	lsr	a
	lda	ColTable,x
	ora	Temp
ColTable:	.byte	0,15,8,6,11,4,2,13,12,10,9,0,1,5,3,14
Temp:	.byte	0
;40 col color	80col conversion
;0=Black	0=black
;1=White	15=white
;2=Red	8=dark red
;3=Cyan	6=dark cyan
;4=Purple	11=light purple
;5=Green	4=dark green
;6=blue	2=dark blue
;7=yellow	13=light yellow
;8=orange	12=dark yellow
;9=brown	10=Dark purple
;10=light red	9=light red
;11=dark grey	0=black
;12=medium grey	1=dark grey
;13=light green	5=light green
;14=light blue	3=light blue
;15=light grey	14=light grey
PutEvSc:	LoadW	a0,OutPut1
	LoadW	a1,OutPut1
	ldx	#18
	lda	a4H
	jsr	WrVDC
	lda	a4L
	jsr	WrVDC
	ldx	#31
	ldy	#0
3$	LoadB	a3L,2	;2 card rows
4$	Load
PutEvSc:	LoadW	a0,OutPut1
	LoadW	a1,OutPut1
	ldx	#18
	lda	a4H
	jsr	WrVDC
	lda	a4L
	jsr	WrVDC
	ldx	#31
	ldy	#0
3$	LoadB	a3L,2	;2 card rows
4$	LoadB	a2H,4	;4 times per card row (Every other row)
5$	LoadB	a2L,80	;Do 80 bytes accross
10$	lda	(a1),y
	jsr	WrVDC
	AddVW	8,a1
	AddVW	1,a4
	dec	a2L
	bne	10$
	dec	a2H
	beq	20$
	AddVW	2,a0
	MoveW	a0,a1
	bra	5$
20$	dec	a3L
	beq	30$
	LoadW	a0,OutPut1
	AddVW	640,a0
	MoveW	a0,a1
	bra	4$
30$	rts
PutOd
PutOdSc:	LoadW	a0,OutPut1+1
	LoadW	a1,OutPut1+1
	ldx	#18
	lda	a5H
	jsr	WrVDC
	lda	a5L
	jsr	WrVDC
	ldx	#31
	ldy	#0
3$	LoadB	a3L,2	;2 card rows
4$	LoadB	a2H,4	;4 times per card row (Every other row)
5$	LoadB	a2L,80	;Do 80 bytes accross
10$	lda	(a1),y
	jsr	WrVDC
	AddVW	8,a1
	AddVW	1,a5
	dec	a2L
	bne	10$
	dec	a2H
	beq	20$
	AddVW	2,a0
	MoveW	a0,a1
	bra	5$
20$	dec	a3L
	beq	30$
	LoadW	a0,OutPut1+1
	AddVW	640,a0
	MoveW	a0,a1
	bra	4$
30$	rts
PutEvCo:	LoadW	a0,OutPut1+640*2+8
	ldx	#18
	lda	a6H
	jsr	WrVDC
	lda	a6L
	jsr	WrVDC
	ldy	#0
	ldx	#31
10$	lda	(a0),y
	jsr	WrVDC
	AddVW	1,a6
	cpy	#160
	bne	10$
PutOdCo:	LoadW	
PutOdCo:	LoadW	a0,OutPut1+640*2+8
	ldx	#18
	lda	a7H
	jsr	WrVDC
	lda	a7L
	jsr	WrVDC
	ldy	#0
	ldx	#31
10$	lda	(a0),y
	jsr	WrVDC
	AddVW	1,a7
	cpy	#160
	bne	10$