title	'Neuer Zeichensatz'
	page	64

; Festlegen eines neuen Zeichensatzes von Datei, speichern
; eines alten Zeichensatzes in eine Datei mit Hilfe der
; RSX-Faehigkeit von CP/M Plus
; Das Programm setzt die RSX CHARSET.RSX voraus, die an SETMAT
; angehaengt werden muss mit dem Kommando :

;		GENCOM SETMAT CHARSET

; Das Dateiformat ist ASCII, so dass Datei auch von BASIC
; verarbeitet werden kann.

; Copyright (C)	Werner Cirsovius
;		Hohe Weide 44
;		D-2000 Hamburg 20
;		Tel.: 040/4223247

;		Version 1.0 Oktober 1986

; Aufruf des Programms :

;	SETMAT datei1 {datei2}

; Eine mit 'datei1' definierte Datei wird benutzt zum Speichern
; der vorhandenen Zeichenmatritzen. Wenn bei dieser Datei kein
; Dateityp angegeben ist, erhaelt sie den Typ '.ALT'
; Eine optionale mit 'datei2' definierte Datei wird benutzt zum
; Laden neuer Zeichenmatritzen. Wenn bei dieser Datei kein
; Dateityp angegeben ist, so wird der Typ '.NEU' erwartet
; Die alten Werte werden nur dann in der Datei gespeichert,
; wenn diese nicht vorhanden ist - andernfalls bricht das
; Programm sofort ab

; Die tatsaechliche Definition wird nur dann durchgefuehrt,
; wenn die alten Werte richtig gespeichert und die neue
; fehlerfrei gelesen wurde

; Bei Auftreten eines beliebigen Fehlers endet das Programm

; Das Dateiformat fuer die Definition wird im ASCII-Format
; erwartet. Nur Zeichen im Bereich 0..9 und A..F sind erlaubt.
; Bei anderen Zeichen bricht das Programm sofort ab

; ===== Konstanten =====

warm	equ	0000h	; CP/M Warm-Start
bdos	equ	0005h	; BDOS Einsprung

extnum	equ	12	; Zeiger auf Extentnummer
currec	equ	32	; Zeiger auf aktuellen Rekord
difpnt	equ	currec-extnum

strinf	equ	 9	; Funktion "Zeichenkette ausgeben"
openf	equ	15	; Funktion "Datei oeffnen"
closf	equ	16	; Funktion "Datei schliessen"
recrdf	equ	20	; Funktion "Aus Datei lesen"
recwrf	equ	21	; Funktion "In Datei schreiben"
creaf	equ	22	; Funktion "Datei anlegen"

getmat	equ	38	; RSX BDOS Funktionen
setmat	equ	39

fcb	equ	005ch	; Standard FCB
fcb2	equ	fcb+16	; Zweiter Dateiname
dma	equ	0080h	; Standard Rekord-Puffer

drv	equ	1	; Laenge der Laufwerksangabe
nam	equ	8	; Laenge des Dateinamens
ext	equ	3	; Laenge des Dateityps

cr	equ	0dh	; Zeilenanfang
lf	equ	0ah	; Neue Zeile
bel	equ	07h	; Klingel
eot	equ	'$'	; Standard CP/M Textende

reclng	equ	128	; Standard Pufferlaenge

matx	equ	8	; Laenge einer Matrix
matax	equ	2*matx	; Laenge einer ASCII Matrix

reclop	equ	reclng/matax
reccnt	equ	256*matax/reclng
recasc	equ	reclng/2

ldir	macro
	db	0edh,0b0h
	endm

cpir	macro
	db	0edh,0b1h
	endm

; ===== Start der TPA =====

	jmp	start	; Sprung zum Hauptteil

; ===== BDOS Interface =====

open:	; Gemeinsame Routine zum Oeffnen/Anlegen einer Datei

	mvi	a,openf
	jmp	comoc

create:	mvi	a,creaf

comoc:	push	b
	push	d
	push	h
	push	d
	xchg
	lxi	d,extnum
	dad	d	; Zeiger berechnen
	mvi	m,0	; Extent auf Null
	lxi	d,difpnt
	dad	d	; Zeiger berechnen
	mvi	m,0	; Rekord auf Null
	pop	d
	mov	c,a	; Funktion laden
	call	bdos	; Funktion ausfuehren
	pop	h
	pop	d
	pop	b
	ora	a
	rz		; Test ob Fehler
	stc
	ret

close:	; Datei schliessen

	push	b
	push	d
	push	h
	mvi	c,closf	; Funktion laden
	call	bdos	; Funktion ausfuehren
	pop	h
	pop	d
	pop	b
	ora	a
	rz		; Test ob Fehler
	stc
	ret

dskred:	; Gemeinsame Routine zum Lesen/Schreiben eines Rekords
	; von/in eine Datei

	mvi	a,recrdf
	jmp	comdsk

dskwrt:	mvi	a,recwrf

comdsk:	push	b
	push	d
	push	h
	mov	c,a	; Funktion laden
	call	bdos	; Funktion ausfuehren
	pop	h
	pop	d
	pop	b
	ora	a
	rz		; Test ob Fehler
	stc
	ret

string:	; Ausgabe einer Zeichenkette auf den Bildschirm

	push	b
	push	d
	push	h
	mvi	c,strinf; Funktion laden
	call	bdos	; Funktion ausfuehren
	pop	h
	pop	d
	pop	b
	ret

; ===== Hauptprogramm beginnt hier =====

start:	lxi	sp,loc	; Neuen Stack laden
	lda	dma	; Test, ob ein Parameter vorhanden ist
	ora	a
	jz	parerr
	lxi	h,fcb2
	lxi	d,fcbsav
	lxi	b,drv+nam+ext
	ldir		; Zweiten Dateinamen retten
	lda	fcb+drv+nam
	cpi	' '	; Test, ob Typ angegeben
	jnz	noext
	lxi	h,defold
	lxi	d,fcb+drv+nam
	lxi	b,ext
	ldir		; Setze Typ 'ALT'

; ===== TEIL 1 : Definition einlesen und in Datei schreiben =====

noext:	lxi	d,fcb
	call	open	; Test, ob Datei existiert
	jnc	errop	; Aha, sollte nicht vorhanden sein
	call	create	; Dann eine neue Datei anlegen
	jc	erropw	; Aha, geht nicht
	mvi	c,0	; Zeichenwert initialisieren

getnxt:	mvi	b,reclop; Zaehler fuer einen Pufferlauf
	lxi	d,dma	; Ziel laden

nxtchr:	lxi	h,mat
	mov	m,c	; Zeichen abspeichern
	push	b
	push	d
	mvi	c,getmat
	call	bdos	; Matrix holen
	pop	d
	lxi	h,mat+1
	mvi	b,matx

makasc:	mov	a,m	; Hexwert laden
	rrc	
	rrc
	rrc
	rrc
	call	gtnib	; Als ASCII ablegen
	mov	a,m
	call	gtnib
	inx	h
	dcr	b	; Test ob fertig
	jnz	makasc
	pop	b
	dcr	b	; Test ob Puffer voll
	jnz	tstdne
	lxi	d,fcb	; Puffer schreiben falls ja
	call	dskwrt
	jc	errwrt	; FEHLER

tstdne:	inr	c	; Test ob alle Zeichen fertig
	jz	prcend
	mov	a,b	; Puffer durch?
	ora	a
	jnz	nxtchr
	jmp	getnxt	; Ja, neuer Lauf

prcend:	lxi	d,fcb
	call	close	; Datei schliessen
	jc	errwrt

; ===== TEIL 2 : Neue Definition aus Datei lesen =====

	lda	fcbsav+drv
	cpi	' '	; Test ob zweite Datei angegeben
	jz	nonams
	lxi	h,defnew
	lxi	d,fcb+drv+nam
	lxi	b,ext	; Setze neuen Typ
	ldir
	lxi	b,drv+nam
	lda	fcbsav+drv+nam
	cpi	' '	; Teste Typ
	jz	skpmov
	lxi	b,drv+nam+ext

skpmov:	lxi	h,fcbsav
	lxi	d,fcb	; Zweiten Namen holen
	ldir
	lxi	d,fcb
	call	open	; Test ob Datei da ist
	jc	erropf
	mvi	c,reccnt
	lxi	d,matrix

getblk:	push	d
	lxi	d,fcb
	call	dskred	; Rekord lesen
	pop	d
	jc	rederr
	call	synchk	; Test gueltige Zeichen
	jnz	illchr
	push	b
	lxi	h,dma
	mvi	b,recasc

setasc:	call	gthex	; ASCII holen
	ral
	ral
	ral
	ral
	ani	11110000b
	push	psw	; Obere Bits retten
	call	gthex	; Zweiten Teil laden
	mov	c,a
	pop	psw
	ora	c	; Byte zusammenstellen
	stax	d
	inx	d
	dcr	b
	jnz	setasc
	pop	b
	dcr	c
	jnz	getblk

; ===== TEIL 3 : Jetzt neue Zeichen definieren =====

	lxi	h,matrix; Zeiger laden
	mvi	c,0	; Zaehler Null setzen

setnxt:	mov	a,c
	sta	mat	; Zeichen speichern
	push	b
	lxi	d,mat+1
	lxi	b,matx	; Neue Matrix kopieren
	ldir
	push	h
	lxi	h,mat
	mvi	c,setmat
	call	bdos	; Matrix definieren
	pop	h
	pop	b
	inr	c
	jnz	setnxt	; Test fertig
	lxi	d,succes
	jmp	comer	; Ok, das war alles

; ===== Fehler- und andere Meldungen ausgeben =====

illchr:	lxi	d,chrill
	jmp	comer
nonams:	lxi	d,namsno
	jmp	comer
parerr:	lxi	d,errpar
	jmp	comer
erropw:	lxi	d,opwerr
	jmp	comer
errop:	lxi	d,operr
	jmp	comer
errwrt:	lxi	d,wrterr
	jmp	comer
erropf:	lxi	d,opferr
	jmp	comer
rederr:	lxi	d,errred

comer:	call	string	; Meldung ausgeben
	jmp	warm	; Programm beenden

; ===== Unterprogramme =====

synchk:	; Tested ob die Zeichen im gelesenen Rekord gueltig sind
	; EIN	Rekord im DMA Puffer eingelesen
	; AUS	Z Flag gesetzt, wenn Zeichen gueltig sind
	;	Z Flag nicht gesetzt bei Fehler

	push	b
	push	h
	push	d
	lxi	d,dma	; Zeiger auf Puffer
	mvi	c,reclng

synlop:	push	b
	lxi	h,defhex; In Definition finden
	lxi	b,hexlng
	ldax	d
	cpir
	pop	b
	jnz	syndon
	inx	d
	dcr	c	; Test ob Ende
	jnz	synlop

syndon:	pop	d
	pop	h
	pop	b
	ret

gtnib:	; Holen und Speichern eines ASCII Nibbles von einem Binaerwert
	; EIN	Akku haelt Hex-Nibble
	;	DE zeigt auf Ziel
	; AUS	ASCII in aktuelles Ziel gespeichert
	;	Zielzeiger um eins erhoeht

	ani	00001111b
	ral
	rar
	daa		; Kleinen Trick anwenden
	adi	0f0h
	aci	040h
	stax	d	; Resultat abspeichern
	inx	d
	ret

gthex:	; Holen eines Binaerwertes von einem ASCII Nibble
	; EIN	HL zeigt auf ASCII Zeichenquelle
	; AUS	Akku haelt Hex-Nibble
	;	Quellzeiger um eins erhoeht

	mov	a,m	; ASCII holen
	inx	h
	sui	'0'	; In Binaerwert wandeln
	cpi	9+1	; Test ob A..F
	rc
	sui	'A'-'0'-10; Justieren falls ja
	ret

; ===== Meldungsdeld =====

succes	db	cr,lf,'Neue Matrizen definiert',cr,lf,eot
namsno	db	cr,lf,'Nur die Definition gespeichert',cr,lf,eot
opwerr	db	cr,lf,bel,'Kann Datei nicht anlegen',cr,lf,eot
operr	db	cr,lf,bel,'Ausgabedatei existiert bereits',cr,lf,eot
wrterr	db	cr,lf,bel,'Datei-Schreibfehler',cr,lf,eot
opferr	db	cr,lf,bel,'Kann Datei nicht |ffnen',cr,lf,eot
errred	db	cr,lf,bel,'Datei-Lesefehler',cr,lf,eot
errpar	db	cr,lf,bel,'Dateiname fehlt',cr,lf,eot
chrill	db	cr,lf,bel,'Ung}ltiges Zeichen in Datei gefunden',cr,lf,eot

; ===== Konstantenfeld =====

defold	db	'ALT'	; Dateitypen
defnew	db	'NEU'
defhex	db	'0123456789ABCDEF'
hexlng	equ	$-defhex

; ===== Variablenfeld =====

fcbsav	ds	drv+nam+ext	; FCB Speicherplatz
mat	ds	1+matx		; Platz fuer eine Matrix
matrix	ds	256*matx	; Feld fuer alle Matritzen
;
	ds	64		; Lokaler Stack
loc	end