.nolist
#include "include.inc"
.list
.org	ProgStart83p
	B_CALL(_runindicoff)
	call	clearscreen
	ld	hl,820
	B_CALL(_enoughmem)
	jr	nc,goodmem
memError:
	ld	hl,memtxt
	B_CALL(_puts)
	ret
goodmem:
	set	textinverse,(iy+textflags)
	ld	hl,title
	B_CALL(_puts)
	res	textinverse,(iy+textflags)
	ld	hl,20+(256*8)
	ld	(pencol),hl
	ld	hl,author
	B_CALL(_vputs)
	B_CALL(_newline)
	ld	hl,inputname
	B_CALL(_puts)
	ld	b,0
	ld	hl,name
	set	shiftAlpha,(iy+shiftflags)
getstring:
	push	hl
	push	bc
getkeyCur:
	B_CALL(_cursorOn)
getkey:
	B_CALL(_getcsc)
	or	a
	jr	z,getkey

	push	af
	B_CALL(_cursorOff)
	pop	af

	cp	skDel
	jr	z,Delete
	cp	skclear
	jr	z,clear

	cp	skEnter
	jp	z,Done
	cp	skalpha
	call	z,handle_alpha
	pop	bc
	push	bc
	ld	(patch+1),a
	ld	a,b
	cp	8
	jr	z,getkeyCur
	or	a
	jr	nz,patch
	bit	shiftalpha,(iy+shiftflags)
	jr	z,getkeyCur
patch:
	ld	a,0

	ld	e,a
	ld	d,0
	bit	shiftalpha,(iy+shiftflags)
	jr	nz,useletters
	ld	hl,numtable-1
	jr	goOn
useLetters:
	ld	hl,chartable-1
goOn:
	add	hl,de
	ld	a,(hl)
	or	a
	jr	z,getkeyCur

	B_CALL(_putc)
	pop	bc
	pop	hl
	inc	b
	ld	(hl),a
	inc	hl
	jr	getstring

delete:
	ld	a,' '
	B_CALL(_putmap)
	pop	bc
	pop	hl
	ld	a,b
	or	a
	jr	z,getstring

	ld	a,(curcol)
	dec	a
	ld	(curcol),a
	ld	a,' '
	B_CALL(_putmap)
	dec	b
	xor	a
	dec	hl
	ld	(hl),a
	jr	getstring
clear:
	ld	hl,(256*6)+2
	ld	(currow),hl
	B_CALL(_eraseEOL)
	ld	hl,name
	ld	de,name+1
	ld	bc,9
	ld	(hl),0
	ldir
	pop	bc
	pop	hl
	ld	b,0
	ld	hl,name
	jp	getstring
handle_alpha:
	bit	shiftAlpha,(iy+shiftflags)
	jr	z,setalpha
	res	shiftAlpha,(iy+shiftflags)
	ret
setalpha:
	set	shiftAlpha,(iy+shiftflags)
	ret



Done:
	res	shiftAlpha,(iy+shiftflags)
	call	clearscreen
	pop	bc
	pop	hl
	ld	a,(name)
	or	a
	ret	z

	ld	a,5
	ld	(name-1),a
	ld	hl,name-1
	B_CALL(_mov9toOp1)
	B_CALL(_chkfindsym)
	jr	nc,exist

	ld	a,6
	ld	(name-1),a
	ld	hl,name-1
	B_CALL(_mov9toOp1)
	B_CALL(_chkfindsym)
	jr	c,notfound
exist:
	ld	hl,progexists
	B_CALL(_puts)
deletekey:
	B_CALL(_getcsc)
	cp	skdel
	jr	z,deleteprog
	cp	skenter
	jr	nz,deletekey
	call	clearscreen
	ret
deleteprog:
	B_CALL(_chkfindsym)
	B_CALL(_delvararc)
notfound:
	ld	hl,768+(progdata_end-progdata)
	B_CALL(_createprotprog)
	inc	de
	inc	de
	ld	hl,progdata
	ld	bc,progdata_end-progdata
	ldir
	ld	hl,plotsscreen
	ld	bc,768
	ldir
	call	clearscreen
	ld	hl,success
	B_CALL(_puts)
	B_CALL(_newline)
	ret



inputName:
	.db "Name: "
charTable:
	.db 0,0,0,0				;arrows
	.db 0,0,0,0,0				;nothing
	.db 0,"WRMH",0 		;
	.db 0,0,Ltheta,"VQLG",0,0	;
	.db 0,"ZUPKFC",0,
	.db 0,"YTOJEB",0,0
	.db "XSNIDA"
	.db 0,0,0,0,0,0,0,0,0
title:
	.db " Screen to Prog "
numtable:
	.db 0,0,0,0				;arrows
	.db 0,0,0,0,0				;nothing
	.db 0,0,0,0,0,,0 		;
	.db 0,"369",0,0,0,0	;
	.db 0,"258",0,0,0,0,
	.db "0147",0,0,0,0,0
	.db 0,0,0,0,0,0
	.db 0,0,0,0,0,0,0,0,0
clearscreen:
	B_CALL(_clrscrnfull)
	B_CALL(_homeup)
	ret
memtxt:
	.db "Not enough RAM  "
	.db "to make a screen"
	.db "shot!",0
author:
	.db "By Joe Pemberton"
type:
	.db 0
name:
	.db 0,0,0,0,0,0,0,0,0
progexists:
	.db " Program exists!"
	.db "     Delete?    "
	.db "Del-yes ENTER-no",0
success:
	.db "Success!",0


progdata:
	.db	$BB,$6D
	ld	hl,$9d95+15
	ld	de,plotsscreen
	ld	bc,768
	ldir
	B_CALL(_grbufcpy)
	ret
pic:
progdata_end:



.end
END