alias OLPLO 'sw f00020'
alias OLPHI 'sw f00022'

alias VMODE 'sw f00028'

alias HP 'sw f0002e'
alias HBE 'sw f00032'
alias HDB1 'sw f00038'
alias HDB2 'sw f0003a'
alias HBB 'sw f00030'
alias HDE 'sw f0003c'
alias HS 'sw f00034'
alias HVS 'sw f00036'
alias HEQ 'sw f00054'

alias VP 'sw f0003c'
alias VBE 'sw f00042'
alias VDB 'sw f00046'
alias VBB 'sw f00040'
alias VDE 'sw f00048'
alias VS 'sw f00044'
alias VEB 'sw f0004a'
alias VEE 'sw f0004c'

alias VI 'sw f0004e'
alias INT1 'sw f000e0'
alias INT2 'sw f000e2'

alias BORD1 'sl f0002a'
alias BG 'sw f00058'

load od.db

load gpu.db

alias lo 'aread car2'
alias go 'g 802000'
alias gs 'getsym car2.abs'
alias sc 'sl screen (lpeek(screen)^8)'
alias xc 'sc;g;sc'

procedure to addr
	if (argc==1) goto ok
	print -i " Where to?"
	goto exit
#:ok
	g ,addr
#:exit
.

procedure oof addr
	local dest
	if (argc==1) goto ik
	print -i " Give object address ?"
	goto exit
#:ik
	set dest (lpeek(addr+4))^$2000
	sl addr+4 dest
#:exit
.

procedure tran addr
	local dest
	if (argc==1) goto ik
	print -i " Give object address ?"
	goto exit
#:ik
	set dest (lpeek(addr+8))^$8000
	sl addr+8 dest
#:exit
.

procedure wipe value
	if (argc==1) goto ok
	print -i " Clear memory to what value ?"
	goto exit
#:ok
	sl 4000[7c000] value
#:exit
.

procedure rmw addr
	local dest
	if (argc==1) goto ik
	print -i " Give object address ?"
	goto exit
#:ik
	set dest (lpeek(addr+8))^$4000
	sl addr+8 dest
#:exit
.

procedure die addr
	sl addr+4 4
.

procedure dwidth addr wid
	local dest
	if (argc==2) goto ik
	print -i " Give object address ?"
	goto exit
#:ik

	set dest (wpeek(addr+c)&$F003)
	set dest (dest|(wid<<2))
	sw addr+c dest
#:exit
.

procedure iwidth addr wid
	local dest
	if (argc==2) goto ik
	print -i " Give object address ?"
	goto exit
#:ik

	set dest (lpeek(addr+a)&$FFE007FF)
	set dest (dest|(wid<<@12))
	sl addr+a dest
#:exit
.

procedure height addr high
	local dest
	if (argc==2) goto ik
	print -i " Give object address ?"
	goto exit
#:ik

	set dest (lpeek(addr+4)&$FF003FFF)
	set dest (dest|(high<<@14))
	sl addr+4 dest
#:exit
.

procedure pitch addr pit
	local dest
	if (argc==2) goto ik
	print -i " Give object address ?"
	goto exit
#:ik

	set dest (lpeek(addr+c)&$FFFC7FFF)
	set dest (dest|(pit<<@15))
	sl addr+c dest
#:exit
.

procedure depth addr dep
	local dest
	if (argc==2) goto ik
	print -i " Give object address ?"
	goto exit
#:ik

	set dest (wpeek(addr+e)&$8FFF)
	set dest (dest|(dep<<@12))
	sw addr+e dest
#:exit
.

procedure ypos addr pos
	local dest
	if (argc==2) goto ik
	print -i " Give object address ?"
	goto exit
#:ik
	set dest (wpeek(addr+6)&$C007)
	set dest (dest|(pos<<4))
	sw addr+6 dest
#:exit
.

procedure xpos addr pos
	local dest
	if (argc==2) goto ik
	print -i " Give object address ?"
	goto exit
#:ik
	set dest (wpeek(addr+@14)&$F000)
	set dest (dest|pos)
	sw addr+@14 dest
#:exit
.


alias disint 'VI 1D1;VBB 221;sw 4306 8e03'
alias ret 'g ,lpeek(a7)'

procedure adjust
	local addr qty xs zs xf zf dx dz
	set addr lpeek(5802c)
	set qty lpeek(addr)
	set addr addr+4
	set xs lpeek(addr+@12)
	set zs lpeek(addr+@20)
	set addr addr+(20*qty)-20
	set xf lpeek(addr+@12)
	set zf lpeek(addr+@20)
	set dx xf-xs
	set dz zf-zs
	print "           X       Z"
	print "Start:" -d6 xs -d6 zs
	print "End:  " -d6 xf -d6 zf
	print "diff: " -d6 dx -d6 dz
.

procedure wh3d addr dset
	set addr addr-End_of_data-8

	if (argc==1) goto type1
	if (dset==1)  goto type1

	set addr addr+OBJECTS2
	goto output

#:type1
	set addr addr+OBJECTS1
#:output
	where addr
.

procedure voice val
	local addr
	set addr 93000+(50*val)
	sl addr (18-lpeek(addr))
.

alias slow 'x pprot -1'
alias fast 'x pprot 3'
alias labs 'x dislab 1'
alias nolabs 'x dislab 0'
alias nosrc 'x srclevel 0'
alias srcon 'x srclevel 1'

procedure why addr
	set addr addr+802000-d5000
	where addr
.

procedure rom
	local addr
	set addr pc
	if addr<=802000 goto fail
	x pc pc+802000-d5000
	goto exit
#:fail
	print "pc already in ROM"
#:exit
.

procedure brom addr
	local addr
	b addr+802000-d5000
.

procedure lsrom addr
	local addr
	ls addr+802000-d5000
.

procedure lrom addr
	local addr
	l addr+802000-d5000
.

procedure cond addr code
	local byte
	if argc==2 goto doit
	print "Codes available are :"
	print "0 (true)"
	print "1 (false or bsr for a branch)"
	print "2/3  HI/LS - the unsigned compares"
	print "4/5  CC/CS"
	print "6/7  NE/EQ"
	print "8/9  VC/VS"
	print "A/B  PL/MI"
	print "C/D  GE/LT"
	print "E/F  GT/LE"
	print "codes can be used on Scc Bcc and DBcc commands only."
	goto exit

#:fail
	print "cond can only be used on Scc Bcc and DBcc commands."
	goto exit

#:wrong
	print "codition codes are limited to 0-F. use cond with no arguments for info"
	goto exit

#:doit
	set byte (peek(addr)&F0)
	if byte==60 goto f1
	if byte!=50 goto fail

	set byte (peek(addr+1)&C0)
	if byte!=C0 goto fail
#:f1
	if code>=10 goto wrong
	set byte (peek(addr)&F0)
	set byte byte|code
	s addr byte
	print "condition code accepted"
	if peek(addr)!=byte print "check write protect - write has failed"

#:exit
.

