#comment
     This file is part of Z80 Scheme Interpreter     

     Z80 Scheme Interpreter is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
     the Free Software Foundation; either version 2 of the License, or
     (at your option) any later version.
 
     This program is distributed in the hope that it will be useful,
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     GNU General Public License for more details.
 
     You should have received a copy of the GNU General Public License
     along with this program; if not, write to the Free Software
     Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 
     Copyright 2007, Spencer Putt
#endcomment


; input
;	hl - object
; output
;	none
pretty_print:
	ld a,l
	and tag_mask
	jr nz,++_
	
#ifdef USE_HEAP_FIXNUMS
	call deref_fixnum
#else
	sra h\ rr l
	sra h\ rr l
#endif

	bit 7,h
	jr z,_
	ld a,$2D
	push hl
	bcall(_vputmap)
	pop hl
	call neg_hl
_
	jp dispHL
	
_	
	cp tag_pair
	jr nz,_
	jp print_list


_
	cp tag_closure
	jr nz,_
	
	ld hl,szProcedure
	jp vputs	
	
_
	cp tag_escape
	ret nz
	
	ld a,l
	cp true
	jr nz,_
	
	ld hl,kwt
	call workfetch
	jp print_work
	
	
_
	cp false
	jr nz,_
	
	ld hl,kwf
	call workfetch
	jp print_work
	
_
	cp tag_symbol
	jr nz,_
	
	ld l,h
	ld h,0
	mul_hl,bc(symbol_size)
	ld bc,symbols
	add hl,bc
	
	call work_fetch
	jp print_work
	
_
	cp void
	jr nz,_
	
	ret	
	
_
	cp tag_char
	jr nz,_
	
	ld a,h
	or a
	jr nz,not_nul
	
	ld hl,szNul
	jp vputs
	
not_nul:
	push hl
	ld a,'#'
	bcall(_vputmap)
	ld a,'\\'
	bcall(_vputmap)
	pop hl
	ld a,h
	bcall(_vputmap)
	ret
szNul:
.db "#\\nul",0
		
_
	cp null
	jr nz,_
	ld a,$28
	bcall(_vputmap)
	ld a,$29
	bcall(_vputmap)	
	
_
	ret
	
szProcedure:
.db "#<proc>",0
	
print_work:
	ld hl,work
	jp vputs
	
	
string_buffer = OP1
	
DispHL: 
	ld	e,'0'
Num2Dec	ld	bc,-10000
	call	Num1
	ld	bc,-1000
	call	Num1
	ld	bc,-100
	call	Num1
	ld	c,-10
	call	Num1
	ld	c,-1
	call	num1
	ld	a,e
	or	a
	ret 	z
	bcall(_vputmap)
	ret

Num1	ld	a,'0'-1
Num2	inc	a
	add	hl,bc
	jr	c,Num2
	sbc	hl,bc

	cp	e
	ret	z
	bcall(_vputmap)
	ld	e,0
	ret
 
     
; input
;	hl - list to print
; output
;	none
print_list:
	ld a,$28
	push hl
	bcall(_vputmap)
	pop hl
	call list_null_nz
	jp z,print_list_done
	jp _
	
print_list_loop:
	call list_null_nz
	jp z,print_list_done
	
	ld a,$20
	push hl
	bcall(_vputmap)
	pop hl
	
_
	push hl
	call list_cdr
	ld a,l
	pop hl
	cp null
	jr z,print_formal_list
	and tag_mask
	cp tag_pair
	jr z,print_formal_list
	
	
	push hl
	call list_car
	ex (sp),hl
	call list_cdr
	ex (sp),hl
	call pretty_print

	ld a,$20
	bcall(_vputmap)
	ld a,'.'
	bcall(_vputmap)
	ld a,$20
	bcall(_vputmap)
	
	pop hl
	call pretty_print
	jp print_list_done
	
print_formal_list:
	push hl
	call list_car
	ex (sp),hl
	call list_cdr
	ex (sp),hl
	call pretty_print
	pop hl
	jp print_list_loop
	
print_list_done:
	ld a,$29
	bcall(_vputmap)
	ret
	
	
repl_print:
	ld a,l
	cp void
	ret z
	ld a,(penrow)
	cp 64-6
	jr c,_
	xor a
	push hl
	bcall(_grBufClr)
	bcall(_clrLCDFull)
	pop hl
	xor a
	ld (penrow),a
_
	call pretty_print
	ld a,(penrow)
	add a,6
	ld (penrow),a
	xor a
	ld (pencol),a
	ret