.enabl	lc
	.title	usrnam
	.rem	$

Create a new username.

John Wilson, 08-Dec-85.

Must be linked with HEADER.MAC

$
	.mcall	exit$s
;
firqb=	402	;file request queue block
xrb=	442	;transfer request block
calfip=	emt	;call file processor
opnfq=	2	;CALFIP subfunc to open a file
crefq=	4	;subfunc to create and open a file
rstfq=	20	;subfunc to reset channel(s)
.read=	emt+2	;read a record
.write=	emt+4	;write a record
.ttech=	emt+20	;enable echo
.ttnch=	emt+22	;disable echo
.postn=	emt+32	;get carriage column
.date=	emt+34	;get current time
;
cr=	15	;carriage return
lf=	12	;line feed
;
usrnam:	movb	#rstfq,firqb+3	;close all files
	clrb	firqb+4
	calfip
	jsr	r5,type		;print header
	.word	l.head,header
10$:	; get the username they want
	jsr	r5,type		;prompt for username
	.word	l.user,user
	jsr	pc,getlin	;get the username
	mov	r0,r2		;copy ptr
	mov	r1,r3		;and length
	beq	50$		;length=0, invalid name
	mov	#name,r4	;point at buffer
20$:	movb	(r2)+,(r4)+	;copy a byte
	sob	r3,20$		;loop
	mov	#12.,r3		;length of field
	sub	r1,r3		;find amount left
	blos	40$		;name fills entire field
30$:	movb	#' ,(r4)+	;pad with blanks
	sob	r3,30$		;loop
40$:	mov	#usernm,r5	;point at buffer
	mov	#4,r4		;4 words (12 chars)
	jsr	pc,rad50	;convert to radix-50
	bcc	60$		;skip if ok
50$:	jsr	r5,type		;print message
	.word	l.inva,inval
	br	10$		;loop
60$:	; try to look up the username in BBUSER.DAT
	jsr	pc,clrfrq	;clear the firqb
	movb	#opnfq,firqb+3	;func=open file
	movb	#2,firqb+4	;on channel 1
	mov	#firqb+6,r0	;point at filename
	mov	#bbsppn,(r0)+	;filename='devn:[p,pn]BBUSER.DAT'
	mov	#^RBBU,(r0)+
	mov	#^RSER,(r0)+
	mov	#^RDAT,(r0)
.iif ne <bbsdev>, mov #bbsdev,firqb+30
.iif ne <bbsunt>, mov #bbsunt,firqb+32
	calfip			;open the file
	movb	firqb+2,r1	;and job # (*2)
	asr	r1		;/2=job
	clr	r0		;sxt
	div	#10.,r0		;separate digits of job #
	mov	r0,r3		;copy high digit
	mul	#50,r3		;shift left (rad50)
	add	r3,r1		;add together
	add	#^R 00,r1	;convert to rad50
	mov	r1,-(sp)	;save
	mov	firqb+16,r5	;get file size
70$:	mov	#8.,r4		;# of records per block
	mov	#buf,r3		;point at buffer
	mov	#xrb,r0		;point at xrb
	mov	#512.,(r0)+	;read one block
	clr	(r0)+		;nothing read yet
	mov	r3,(r0)+	;into @#buf
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next block
	clr	(r0)+		;(KB wait time)
	clr	(r0)		;(modifier bits)
	.read			;read the block
80$:	mov	#4,r2		;name is 4 words long
	mov	r3,r1		;copy ptr
	mov	#usernm,r0	;point at name
90$:	cmp	(r0)+,(r1)+	;do they match?
	bne	100$		;no, skip
	sob	r2,90$		;loop
	jsr	r5,type		;yes, the name is already taken
	.word	l.take,taken
	clrb	firqb+3		;(=CLSFQ) func=close file
	movb	#2,firqb+4	;channel 1
	calfip
	br	10$		;reprompt
100$:	add	#100,r3		;point at next entry in block
	sob	r4,80$		;check the whole block
	sob	r5,70$		;for all blocks
	; not found - find a free spot in the last block
	mov	xrb+10,r5	;save block #
	mov	#8.,r4		;8 records/block
	mov	#buf,r3		;point at begn of buffer
110$:	tst	(r3)		;in use?
	beq	130$		;no, use it
	add	#100,r3		;yes, skip to next record
	sob	r4,110$		;loop
	inc	r5		;block is full, start a new one
	mov	#400,r4		;blk is 400 words
	mov	#buf,r3		;point at buffer
	mov	r3,r2		;copy
120$:	clr	(r2)+		;clear out the block
	sob	r4,120$		;loop
130$:	mov	r5,-(sp)	;save block #
	mov	r3,-(sp)	;and buf addr
	jsr	r5,type		;print password header
	.word	l.pswr,pswrd
140$:	jsr	r5,type		;prompt for password
	.word	l.pw,pw
	.ttnch			;echo off
	jsr	pc,getlin	;get password
	.ttech			;echo on
	mov	#psword,r5	;point at buffer
	mov	#2,r4		;2 words (6 chars)
	jsr	pc,rad50	;convert to radix-50
	bcc	150$		;legal password, continue
	; non-rad50 password
	jsr	r5,type		;print message
	.word	l.inva,inval
	br	140$		;try again
150$:	; get real name, or whatever
	jsr	r5,type		;prompt
	.word	l.real,real
	mov	#xrb,r0		;point at xrb
	mov	#82.,(r0)+	;length of buffer
	clr	(r0)+		;nothing read yet
	mov	#kbbuf,r1	;point at kb buffer
	mov	r1,(r0)+	;save
	clr	(r0)+		;channel 0
	clr	(r0)+		;next blk
	clr	(r0)+		;unlimited wait
	clr	(r0)		;no modifiers
	.read			;read
	tstb	firqb		;error?
	bne	exit		;yes, die
	mov	r1,r2		;copy ptr
	mov	xrb+2,r3	;get length
	mov	#44.,r4		;length of field
160$:	movb	(r1)+,r0	;get a char
	cmp	r0,#37		;ctrl char?
	blos	170$		;yes, ignore
	movb	r0,(r2)+	;no, save
	dec	r4		;dec count
	beq	190$		;field is full, skip
170$:	sob	r3,160$		;loop
180$:	clrb	(r2)+		;clear rest of buffer
	sob	r4,180$		;loop
190$:	mov	#usernm,r0	;point at username
	mov	(sp)+,r1	;pop pointer
	mov	#6,r2		;length of username+password=6 words
200$:	mov	(r0)+,(r1)+	;put in buffer
	sob	r2,200$		;loop
	.date			;get time, date
	mov	xrb+2,(r1)+	;put time in buffer
	mov	xrb,(r1)+	;... date
	clr	(r1)+		;no mail yet
	clr	(r1)+		;PPN for mail (0=BBS mail file)
	mov	#kbbuf,r0	;point at real name
	mov	#22.,r2		;length in words
210$:	mov	(r0)+,(r1)+	;copy
	sob	r2,210$		;loop
	mov	#xrb,r0		;point at xrb
	mov	#512.,(r0)+	;write one block
	mov	#512.,(r0)+	;...
	mov	#buf,(r0)+	;from @#buf
	mov	#2,(r0)+	;to channel 1
	mov	(sp)+,(r0)+	;(block)
	clr	(r0)+		;(KB wait time)
	clr	(r0)		;no modifiers
	.write			;write the block
; write username and date/time to NAMEjj.TMP
	jsr	pc,clrfrq	;clear the firqb
	movb	#crefq,firqb+3	;func=open file for input
	movb	#4,firqb+4	;on channel 2
	mov	(sp)+,r0	;get job # (rad50)
	add	#^RE  ,r0	;name='NAMEjj.TMP'
	mov	#firqb+10,r5	;point at filename
	mov	#^RNAM,(r5)+
	mov	r0,(r5)+
	mov	#^RTMP,(r5)+
	movb	#1,(r5)		;file size=1 block
	calfip			;create the file
	mov	#xrb,r0		;point at xrb
	mov	#512.,(r0)+	;write 1 block
	mov	#512.,(r0)+	;...
	mov	#name,(r0)+	;from NAME
	mov	#4,(r0)+	;to channel 2
	clr	(r0)+		;next (first) block
	clr	(r0)+		;(not applicable)
	clr	(r0)		;no modifiers
	.write			;do it
	clrb	firqb+3		;(=CLSFQ) func=close file
	movb	#4,firqb+4	;channel 2
	calfip			;do it
	jsr	r5,type		;'Name added: '
	.word	l.adde,added
	jsr	r5,type		;(losername)
	.word	12.,name
	jsr	r5,type		;crlf
	.word	2,crlf
;
exit:	clrb	firqb+3		;(=CLSFQ) func=close file
	movb	#2,firqb+4	;channel 1
	calfip			;do it
	.ttech			;echo back on in case ^Z
	jsr	r5,type		;extra crlf
	.word	2,crlf
	exit$s			;die
;+
;
; RAD50
;
; Convert a string to radix-50.
; On entry, r0 points to a string, r1 contains the length,
; r5 points to the area in which to store the result,
; and r4 contains the length (words) of the area.
;
; On return, everything is peachy unless C=1,
; in which case the string contained one or more
; non-radix-50 characters.
;
;-
rad50:	clr	r3		;init
	jsr	pc,20$		;do 3 chars
	jsr	pc,10$
	jsr	pc,10$
	mov	r3,(r5)+	;save
	sob	r4,rad50	;loop
;
10$:	;do a single char
	mul	#50,r3		;make space for the char
20$:	tst	r1		;anything left?
	beq	80$		;no, return
	dec	r1		;yes, dec count
	movb	(r0)+,r2	;and get the char
	cmp	#'$,r2		;dollar sign?
	bne	30$		;no
	add	#33,r3		;yes
	rts	pc
30$:	cmp	#'_,r2		;underline?
	bne	40$		;no
	add	#35,r3		;yes, use undefined code
	rts	pc
40$:	cmp	#'.,r2		;decimal point?
	beq	50$		;yes
	cmp	r2,#'0		;digit?
	blo	60$		;no
	cmp	r2,#'9		;hm?
	bhi	60$		;no
50$:	add	#36-'0,r2	;yes, convert to rad50
	br	70$		;skip
60$:	sub	#'A,r2		;letter?
	blo	90$		;no
	cmp	r2,#25.		;hm?
	bhi	90$		;no
	inc	r2		;yes, convert to rad50
70$:	add	r2,r3		;add in
80$:	rts	pc
90$:	tst	(sp)+		;purge stack
	sec			;error
	rts	pc		;fall through to original caller
;+
;
; GETLIN
;
; Read a line from the KB (channel 1);
; hang up and kill job on ^C or HB.
; Return ptr to line in r0, length in r1,
; Z=1 if length is zero.
;
;-
getlin:	mov	#xrb,r1		;point at xrb
	mov	#82.,(r1)+	;length of buffer
	clr	(r1)+		;nothing in it yet
	mov	#kbbuf,r0	;point at buffer
	mov	r0,(r1)+	;save
	clr	(r1)+		;channel 0
	clr	(r1)+		;read next block
	clr	(r1)+		;unlimited wait
	clr	(r1)		;no modifiers
	.read			;read a line
	movb	firqb,r4	;any errors?
	bne	exit		;yes, exit
	mov	r0,r1		;no, copy ptr
	mov	xrb+2,r3	;get length of line read
10$:	movb	(r0)+,r4	;get a char
	cmp	r4,#40		;space or ctrl char?
	blos	30$		;yes, ignore
	cmp	r4,#'A+40	;lower case?
	blo	20$		;no
	cmp	r4,#'Z+40	;eh?
	bhi	20$		;no
	sub	#40,r4		;yes, convert
20$:	movb	r4,(r1)+	;no, copy
30$:	sob	r3,10$		;loop
	clrb	xrb+6		;see if at begn of line
	.postn			;return column
	tstb	xrb+2		;at begn of line?
	beq	40$		;yes
	jsr	r5,type		;print crlf
	.word	2,crlf
40$:	mov	#kbbuf,r0	;point at string
	sub	r0,r1		;find length
	rts	pc
;+
;
; TYPE
;
; Print string with inline length and addr.
; Must be called through r5.
;
;-
type:	mov	(r5),xrb	;get length
	mov	(r5)+,xrb+2	;twice
	mov	(r5)+,xrb+4	;get ptr
	clr	xrb+6		;channel 0
	clr	xrb+10		;next block
	clr	xrb+14		;RECORD 0%
	.write			;write
	rts	r5		;no, return
;
; Clear out the FIRQB.
;
clrfrq:	mov	#firqb,r5	;point at firqb
	mov	#20,r4		;length=20 words
10$:	clr	(r5)+		;clear out the firqb
	sob	r4,10$		;loop
	rts	pc
;
header:	.byte	lf
	.ascii	/A username may consist of 1 to 12 characters,/<cr><lf>
	.ascii	/each of which may be A-Z, 0-9, $, ., or _./<cr><lf>
	.ascii	/Embedded blanks are not significant./
crlf:	.byte	cr,lf
l.head=	.-header
;
user:	.ascii	<lf>/What would you like your username to be? /
l.user=	.-user
;
inval:	.ascii	<lf>/%Invalid character(s)/<cr><lf>
l.inva=	.-inval
;
taken:	.ascii	<lf>/That username is already taken./<cr><lf>
	.ascii	/Please choose another./<cr><lf>
l.take=	.-taken
;
pswrd:	.ascii	<lf>/A password may consist of 0 to 6 characters,/<cr><lf>
	.ascii	/each of which may be A-Z, 0-9, $, ., or _./<cr><lf>
	.ascii	/Embedded blanks are not significant./<cr><lf>
l.pswr=	.-pswrd
;
pw:	.ascii	<lf>/What do you want your password to be? /
l.pw=	.-pw
;
real:	.ascii	<lf>/What is your real name (optional) ? /
l.real=	.-real
;
added:	.ascii	<lf>/Name added: /
l.adde=	.-added
;
	.even
name:	.blkb	12.		;buffer for username (ASCII)
	.word	1440.,16001.	;date=12:00 midnight, 01-Jan-86
usernm:	.blkw	4		;username, rad50
psword:	.blkw	2		;password, rad50
; PSWORD must immediately follow USERNM!
kbbuf:	.blkb	82.		;keyboard buffer,
buf:	.blkb	512.		;and block buffer for BBUSER.DAT
;
;
	.end	usrnam