title	Neuer Zeichensatz
	name	('SETMAT')

; 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 =====

OS	equ	0000h		; CP/M Warm-Start
BDOS	equ	0005h		; BDOS Einsprung
FCB	equ	005ch		; Standard FCB
FCB2	equ	FCB+_DIR	; Zweiter Dateiname
DMA	equ	0080h		; Standard Rekord-Puffer

.string	equ	9		; Funktion "Zeichenkette ausgeben"
.open	equ	15		; Funktion "Datei oeffnen"
.close	equ	16		; Funktion "Datei schliessen"
.rdseq	equ	20		; Funktion "Aus Datei lesen"
.wrseq	equ	21		; Funktion "In Datei schreiben"
.make	equ	22		; Funktion "Datei anlegen"

.ldmtx	equ	38		; RSX BDOS Funktionen
.stmtx	equ	39

.drv	equ	1		; Laenge der Laufwerksangabe
.nam	equ	8		; Laenge des Dateinamens
.ext	equ	3		; Laenge des Dateityps
_EX	equ	12		; Zeiger auf Extentnummer
_CR	equ	32		; Zeiger auf aktuellen Rekord
_DIR	equ	16		; Zeiger auf zweiten FCB

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


; ===== Start der TPA =====
;
; ===== BDOS Interface =====
;
; Gemeinsame Routine zum Oeffnen/Anlegen einer Datei
;
open:
	ld	a,.open
	jr	comoc
create:
	ld	a,.make
comoc:
	push	bc
	push	de
	push	hl
	push	de
	ex	de,hl
	ld	de,_EX
	add	hl,de		; Zeiger berechnen
	ld	(hl),0		; Extent auf Null
	ld	de,_CR-_EX
	add	hl,de		; Zeiger berechnen
	ld	(hl),0		; Rekord auf Null
	pop	de
	ld	c,a		; Funktion laden
	call	BDOS		; Funktion ausfuehren
	pop	hl
	pop	de
	pop	bc
	or	a
	ret	z		; Test ob Fehler
	scf
	ret
;
; Datei schliessen
;
close:

	push	bc
	push	de
	push	hl
	ld	c,.close	; Funktion laden
	call	BDOS		; Funktion ausfuehren
	pop	hl
	pop	de
	pop	bc
	or	a
	ret	z		; Test ob Fehler
	scf
	ret
;
; Gemeinsame Routine zum Lesen/Schreiben eines Rekords
; von/in eine Datei
;
dskred:
	ld	a,.rdseq
	jr	comdsk
dskwrt:
	ld	a,.wrseq
comdsk:
	push	bc
	push	de
	push	hl
	ld	c,a		; Funktion laden
	call	BDOS		; Funktion ausfuehren
	pop	hl
	pop	de
	pop	bc
	or	a
	ret	z		; Test ob Fehler
	scf
	ret
;
; Ausgabe einer Zeichenkette auf den Bildschirm
;
string:
	push	bc
	push	de
	push	hl
	ld	c,.string	; Funktion laden
	call	BDOS		; Funktion ausfuehren
	pop	hl
	pop	de
	pop	bc
	ret
;
; ===== Hauptprogramm beginnt hier =====
;
start:
	ld	sp,LocStk	; Neuen Stack laden
	ld	a,(DMA)		; Test, ob ein Parameter vorhanden ist
	or	a
	jp	z,parerr
	ld	hl,FCB2
	ld	de,FCBsav
	ld	bc,.drv+.nam+.ext
	ldir			; Zweiten Dateinamen retten
	ld	a,(FCB+.drv+.nam)
	cp	' '		; Test, ob Typ angegeben
	jr	nz,noext
	ld	hl,DEF$OLD
	ld	de,FCB+.drv+.nam
	ld	bc,.ext
	ldir			; Setze Typ 'ALT'
;
; ===== TEIL 1 : Definition einlesen und in Datei schreiben =====
;
noext:
	ld	de,FCB
	call	open		; Test, ob Datei existiert
	jp	nc,errop	; Aha, sollte nicht vorhanden sein
	call	create		; Dann eine neue Datei anlegen
	jp	c,erropw	; Aha, geht nicht
	ld	c,0		; Zeichenwert initialisieren
getnxt:
	ld	b,reclop	; Zaehler fuer einen Pufferlauf
	ld	de,DMA		; Ziel laden
nxtchr:
	ld	hl,mat
	ld	(hl),c		; Zeichen abspeichern
	push	bc
	push	de
	ld	c,.ldmtx
	call	BDOS		; Matrix holen
	pop	de
	ld	hl,mat+1
	ld	b,matx
makasc:
	ld	a,(hl)		; Hexwert laden
	rrca
	rrca
	rrca
	rrca
	call	gtnib		; Als ASCII ablegen
	ld	a,(hl)
	call	gtnib
	inc	hl
	djnz	makasc		; Test ob fertig
	pop	bc
	djnz	tstdne		; Test ob Puffer voll
	ld	de,FCB		; Puffer schreiben falls ja
	call	dskwrt
	jp	c,errwrt	; FEHLER
tstdne:
	inc	c		; Test ob alle Zeichen fertig
	jr	z,prcend
	ld	a,b		; Puffer durch?
	or	a
	jr	nz,nxtchr
	jr	getnxt		; Ja, neuer Lauf
prcend:
	ld	de,FCB
	call	close		; Datei schliessen
	jp	c,errwrt
;
; ===== TEIL 2 : Neue Definition aus Datei lesen =====
;
	ld	a,(FCBsav+.drv)
	cp	' '		; Test ob zweite Datei angegeben
	jp	z,nonams
	ld	hl,DEF$NEW
	ld	de,FCB+.drv+.nam
	ld	bc,.ext		; Setze neuen Typ
	ldir
	ld	bc,.drv+.nam
	ld	a,(FCBsav+.drv+.nam)
	cp	' '		; Teste Typ
	jr	z,skpmov
	ld	bc,.drv+.nam+.ext
skpmov:
	ld	hl,FCBsav
	ld	de,FCB		; Zweiten Namen holen
	ldir
	ld	de,FCB
	call	open		; Test ob Datei da ist
	jp	c,erropf
	ld	c,reccnt
	ld	de,matrix
getblk:
	push	de
	ld	de,FCB
	call	dskred		; Rekord lesen
	pop	de
	jp	c,rederr
	call	synchk		; Test gueltige Zeichen
	jp	nz,illchr
	push	bc
	ld	hl,DMA
	ld	b,recasc
setasc:
	call	gthex		; ASCII holen
	rla
	rla
	rla
	rla
	and	11110000b
	push	af		; Obere Bits retten
	call	gthex		; Zweiten Teil laden
	ld	c,a
	pop	af
	or	c		; Byte zusammenstellen
	ld	(de),a
	inc	de
	djnz	setasc
	pop	bc
	dec	c
	jr	nz,getblk
;
; ===== TEIL 3 : Jetzt neue Zeichen definieren =====
;
	ld	hl,matrix	; Zeiger laden
	ld	c,0		; Zaehler Null setzen
setnxt:
	ld	a,c
	ld	(mat),a		; Zeichen speichern
	push	bc
	ld	de,mat+1
	ld	bc,matx		; Neue Matrix kopieren
	ldir
	push	hl
	ld	hl,mat
	ld	c,.stmtx
	call	BDOS		; Matrix definieren
	pop	hl
	pop	bc
	inc	c
	jr	nz,setnxt	; Test fertig
	ld	de,$SUCCESS
	jp	comer		; Ok, das war alles
;
; ===== Fehler- und andere Meldungen ausgeben =====
;
illchr:
	ld	de,$ILLASC
	jp	comer
nonams:
	ld	de,$DEFONLY
	jp	comer
parerr:
	ld	de,$NONAME
	jp	comer
erropw:
	ld	de,$CRECERR
	jp	comer
errop:
	ld	de,$EXIST
	jp	comer
errwrt:
	ld	de,$WRTERR
	jp	comer
erropf:
	ld	de,$OPENERR
	jp	comer
rederr:
	ld	de,$REDERR
comer:
	call	string		; Meldung ausgeben
	jp	OS		; Programm beenden
;
; ===== Unterprogramme =====
;
; 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
;
synchk:
	push	bc
	push	hl
	push	de
	ld	de,DMA		; Zeiger auf Puffer
	ld	b,reclng
synlop:
	push	bc
	ld	hl,DEF$HEX	; In Definition finden
	ld	bc,HEXLEN
	ld	a,(de)
	cpir
	pop	bc
	jr	nz,syndon
	inc	de
	djnz	synlop		; Test ob Ende
syndon:
	pop	de
	pop	hl
	pop	bc
	ret
;
; 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
;
gtnib:
	and	00001111b
	rla
	rra
	daa			; Kleinen Trick anwenden
	add	a,0f0h
	adc	a,040h
	ld	(de),a		; Resultat abspeichern
	inc	de
	ret
;
; Holen eines Binaerwertes von einem ASCII Nibble
; EIN	HL zeigt auf ASCII Zeichenquelle
; AUS	Akku haelt Hex-Nibble
; 	Quellzeiger um eins erhoeht
;
gthex:
	ld	a,(hl)		; ASCII holen
	inc	hl
	sub	'0'		; In Binaerwert wandeln
	cp	9+1		; Test ob A..F
	ret	c
	sub	'A'-'0'-10	; Justieren falls ja
	ret
;
; ===== Meldungsdeld =====
;
$SUCCESS:
	db	cr,lf,'Neue Matrizen definiert',cr,lf,eot
$DEFONLY:
	db	cr,lf,'Nur die Definition gespeichert',cr,lf,eot
$CRECERR:
	db	cr,lf,bel,'Kann Datei nicht anlegen',cr,lf,eot
$EXIST:
	db	cr,lf,bel,'Ausgabedatei existiert bereits',cr,lf,eot
$WRTERR:
	db	cr,lf,bel,'Datei-Schreibfehler',cr,lf,eot
$OPENERR:
	db	cr,lf,bel,'Kann Datei nicht |ffnen',cr,lf,eot
$REDERR:
	db	cr,lf,bel,'Datei-Lesefehler',cr,lf,eot
$NONAME:
	db	cr,lf,bel,'Dateiname fehlt',cr,lf,eot
$ILLASC:
	db	cr,lf,bel,'Ung}ltiges Zeichen in Datei gefunden',cr,lf,eot
;
; ===== Konstantenfeld =====
;
DEF$OLD:
	db	'ALT'		; Dateitypen
DEF$NEW:
	db	'NEU'
DEF$HEX:
	db	'0123456789ABCDEF'
HEXLEN	equ	$-DEF$HEX
;
; ===== 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	2*32		; Lokaler Stack
LocStk:
	end	start