.TITLE	SNOOPY
;
;+
;
; THIS PROGRAM INQUIRES ABOUT THE TEACHERS NAME, AND WHICH PICTURE
; THE CLASS WOULD LIKE TO SEE
;
;   PICTURES AVAILABLE ARE:
;     1 - SNOOPY
;     2 - TWEETY BIRD
;     3 - A PICTURE OF A PUSSY CAT
;     4 - A PICTURE OF JFK
;     5 - A PHANTOM F-4
;
;-
;
;  SNOOPY SOURCE PROGRAM STARTS HERE
;
	.MCALL	ALUN$C,QIO$C,QIOW$C,QIOW$,QIO$,DIR$
	.MCALL	FSRSZ$,FDBDF$,FDOP$R,OPEN$R,GET$
	.MCALL	CLOSE$
	.MCALL	EXIT$S
;
	.ENABL	LC
	.NLIST	BEX
;
	.SBTTL	ASSIGN
;
	FSRSZ$	1		;OPEN ONLY ONE FILE, AT RUN TIME
INFILE:	FDBDF$			;ONLY ONE FILE NOW
;
;
;
SCHOOL:	NOP
;
	TERM=1
	ALUN$C	TERM,TI,0
	QIO$C	IO.ATT,TERM,,,TISTAT
;
;
	.SBTTL	SOURCE
;
;  WRITE OUT MESSAGE ASKING NAME
;
FIRST:	NOP
	QIOW$C	IO.RPR,TERM,1,,TISTAT,,<NAME,52.,,BEGMSG,BEGLEN,'0>
;
;  GET NUMBER OF CHARACTERS READ IN AND CENTER MESSAGE
;
	MOV	TISTAT+2,R0	;MOVE NUMBER OF CHARACTERS INTO R0
	BLE	FIRST		;MUST HAVE A NAME FIRST
	DEC	R0		;Check to see if last char. of name  *3/82
	CMPB	NAME(R0),#'s	;is an s.  If it is                  *3/82
				;We must make adjustments            *3/82
	BEQ	5$		;It is, just add an apostrophe, still*3/82
	INC	R0		;want to center the name             *3/82
;
5$:	MOV	#61.,R1
	SUB	R0,R1		;NUMBER OF CHARACTERS LEFT IN LINE
	ASR	R1
	MOV	#NAMLIN,R2	;GET ADDRESS OF NAMLIN
	ADD	R1,R2		;PUT IN OFFSET (BLANKS)
	MOV	#PART1,R1
	MOV	#9.,R3		;NUMBER OF CHARS IN PART 1
10$:	MOVB	(R1)+,(R2)+
	SOB	R3,10$
	MOV	TISTAT+2,R0	;MOVE NUMBER OF CHARACTERS INTO R0
	MOV	#NAME,R1	;MOV ADDRESS OF NAME INTO REGISTER
20$:	MOVB	(R1)+,(R2)+
	SOB	R0,20$
	MOVB	#'',(R2)+	;Put in an apostrophe            *3/82
	MOV	TISTAT+2,R0	;                                *3/82
	DEC	R0		;                                *3/82
	CMPB	NAME(R0),#'s	;Is the last character an s?     *3/82
	BEQ	25$		;Yes it is, don't put on an s    *3/82
	MOVB	#'s,(R2)+	;                                *3/82
25$:	MOV	#PART2,R1	;MOVE ADDRESS OF PART 2 INTO REGISTER
	MOV	#6.,R3		;NUMBER OF CHARACTERS
30$:	MOVB	(R1)+,(R2)+
	SOB	R3,30$
	MOV	#79.,R1
40$:	DEC	R1
	CMPB	#' ,NAMLIN(R1)		;A BLANK
	BEQ	40$
	ADD	#3,R1
	MOV	R1,OUTP+14.
;
;  GREETING MESSAGE IS NOW READY FOR PRINTING
;
;  ENTER PICTURE SELECTION
;
	QIO$C	IO.WLB,TERM,,,,,<SELECT,SELENT,'0>
;
AGAIN:	NOP
	QIOW$C	IO.RPR,TERM,1,,TISTAT,,<RESPN,1,,MSG2,LEN2,'$>
;
	MOV	RESPN,R0
	SUB	#'1,R0		;SUBTRACT OFF ASCII CODE
	BGE	OKAY		;IF NEGATIVE YOU GOOFED
OOPS:	NOP
	QIO$C	IO.WLB,TERM,,,,,<INERR,ERR1,'0>
	BR	AGAIN
OKAY:	NOP
	CMP	NUMPIC,R0	;If the number in NUMPIC is less than or
	BLE	OOPS		;equal to the number in R0, again you goofed
	ASL	R0		;multiply by two to get location of file
				;FDB in NAMTAB
;
	QIO$C	IO.WLB,TERM,,,,,<BLANKS,1,'1>	;SPACE BEFORE GREETINGS
	DIR$	#OUTP		;PRINT GREETINGS
	QIO$C	IO.WLB,TERM,,,,,<BLANKS,1,'1>	;SPACE AFTER GREETINGS
;
;
	MOV	NAMLEN(R0),INLEN		;GET LENGTH OF FILE NAME
	MOV	NAMTAB(R0),INAME	;POINT THE FILE BUFFER TO CORRECT NAME
	FDOP$R	#INFILE,#2,#SNOOPY	;RUN TIME FDOP
	OPEN$R	#INFILE,,,,#INBUF,#80.,ERROR		;OPEN THE FILE
PRINT:	NOP
	MOV	#"  ,R0
	MOV	#41.,R1			;CLEAR OUT
	MOV	#INBUF,R2		;THE FILE
10$:	MOV	R0,(R2)+		;BUFFER
	SOB	R1,10$
;
	GET$	#INFILE,#INBUF,#80.,ERROR	;GET RECORDS
	MOV	#80.,R1		;DELETE TRAINLING BLANKS AND NULLS
20$:	DEC	R1
	BLT	BLNKPR		;LINE IS NOTHING BUT BLANKS AND NULLS
	CMPB	#000,INBUF(R1)
	BEQ	20$
	CMPB	#' ,INBUF(R1)	;CHECK FOR SPACES
	BEQ	20$
	INC	R1		;NUMBER OF BYTES, DON'T FORGET
				;ABOUT LOCATION ZERO IN THE BUFFER
	MOV	R1,OUT+14.
	DIR$	#OUT
	BR	PRINT
BLNKPR:	NOP
	QIO$C	IO.WLB,TERM,,,,,<BLANKS,1,040>	;NOTHING BUT BLANKS
	BR	PRINT
;
;  ERROR SECTION
;
	.SBTTL	ERROR
ERROR:	NOP
	CMPB	F.ERR(R0),#366	;HIT THE END-OF-FILE, EXIT
	BEQ	NOPROB
	MOV	R0,R3
	MOV	#TIPRNT,R0
	MOV	#"  ,(R0)+	;TWO BLANKS PLEASE
	MOVB	F.ERR(R3),R1	;ERROR NUMBER, PART 1
	CLR	R2
	CALL	$CBDSG		;CONVERT TO SOMETHING WE CAN READ
	MOVB	#' ,(R0)+	;A SIGLE BLANK PLEASE
	MOVB	#' ,(R0)+	;ONE MORE
	MOVB	F.ERR+1(R3),R1	;ERROR NUMBER, PART 2 (HI-BYTE)
	CLR	R2
	CALL	$CBDSG
	QIO$C	IO.WLB,TERM,,,,,<TIPRNT,TILEN,'0>	;PRINT OUT GOOF
;
NOPROB:	NOP
	QIO$C	IO.WLB,TERM,,,,,<BLANKS,1,'1>
	QIOW$C	IO.DET,TERM,1	;DETACH THE TERMINAL
	CLOSE$	#INFILE		;CLOSE THE FILE
	EXIT$S			;LETS GET OUT OF HERE
;
;
;
	.SBTTL	DATA
;
;  DATA AREA
OUT:	QIOW$	IO.WLB,TERM,1,,,,<INBUF,80.,040>	;VARIABLE PRINT-WAIT
OUTP:	QIO$	IO.WLB,TERM,,,,,<NAMMSG,80.,'1>	;VARIABLE PRINT-NO WAIT
TISTAT:	.BLKW	2
	START=.
BEGMSG:	.ASCII	/  Please enter the teacher's name on the next line:/
	BEGLEN=.-START
	.EVEN
NAME:	.BLKB	52.
	.EVEN
PART1:	.ASCII	/Hello to /
	.EVEN
PART2:	.ASCII	/ class/
	.EVEN
NAMMSG:	.BYTE	015,040
;		/123456789012345678901234567890123456789/
NAMLIN:	.ASCII	/                                        /
	.ASCII	/                                        /
	.EVEN
	START=.
SELECT:	.ASCII	/  Possible pictures :/<15><12><12>
	.ASCII	<11>/1 - Curses/<15><12>
	.ASCII	<11>/2 - A Feathered Friend/<15><12>
	.ASCII	<11>/3 - A Feline/<15><12>
	.ASCII	<11>/4 - Number 35/<15><12>
	.ASCII	<11>/5 - Go Fast/<15><12><12>
	SELENT=.-START
	.EVEN
	START=.
MSG2:	.ASCII	/  Please enter your selection: /
	LEN2=.-START
	.EVEN
	START=.
INERR:	.ASCII	<07><15>/  Your response does not compute.  Your/
	.ASCII	/ selection is/<15><07><12>/  limited to one of the/
	.ASCII	/ the following:  1, 2, 3, 4 or 5/ <07><12><12>
	ERR1=.-START
	.EVEN
RESPN:	.BLKW	1
INBUF:	.ASCII	/  /
	.BLKB	78.
	.EVEN
BLANKS:	.BYTE	15,14
	.EVEN
	START=.
TIPRNT:	.ASCII	/               /
	TILEN=.-START
	.EVEN
;
SNOOPY:	.WORD	0,0,0,0		;TAKE THE DEFAULTS ON DEVICE AND UIC
INLEN:	.BLKW	1		;FILE NAME LENGTH
INAME:	.BLKW	1		;FILE NAME ADDRESS
;
;
NUMPIC:	.WORD	5		;Number of pictures available for printing
;
NAMLEN:	.WORD	10.,10.,10.,7.,9.	;TABLE OF FILE NAME LENGTHS
NAMTAB:	.WORD	NAME1,NAME2,NAME3,NAME4	;FILE NAME ADDRESS TABLE
	.WORD	NAME5
;
NAME1:	.ASCII	/SNOOPY.PIC/		;FIRST PICRTURE
	.EVEN
NAME2:	.ASCII	/TWEETY.PIC/		;SECOND PICTURE
	.EVEN
NAME3:	.ASCII	/PUSCAT.PIC/		;FIFTH PICTURE
	.EVEN
NAME4:	.ASCII	/JFK.PIC/		;FOURTH PICTURE
	.EVEN
NAME5:	.ASCII	/PLANE.PIC/		;Fifth picture
;
	.END	SCHOOL