X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fsrc%2Fadventure%2FA5TOA1.RA;fp=sw%2Fsrc%2Fadventure%2FA5TOA1.RA;h=547a542cf82cb61f7aee801debbec445355fa7c3;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git

diff --git a/sw/src/adventure/A5TOA1.RA b/sw/src/adventure/A5TOA1.RA
new file mode 100644
index 0000000..547a542
--- /dev/null
+++ b/sw/src/adventure/A5TOA1.RA
@@ -0,0 +1,161 @@
+/	SUBROUTINE A5TOA1(A,B,D)
+/(pdp11:)SUBROUTINE A5TOA1(A,B,C,D)
+/
+/ THIS ROUTINE TAKES THE UP TO 6 CHARACTER "WORD" IN A:B:C
+/ AND TYPES IT OUT, FOLLOWED BY THE PUNCTUATION MARK IN D.
+/ IT ALSO APPENDS A CRLF TO GET TO A NEW LINE.
+/ For OS/8: the word is in A,B with nothing in C.
+/
+/	IMPLICIT INTEGER (A-Z)
+/	COMMON	/ALPHAS/ BLANK
+
+	EXTERN	SIXOUT
+	EXTERN	CGET
+	EXTERN	CPUT
+	SECT	A5TOA1
+	JA	#ST
+#XR,	ORG	.+10
+	TEXT	+A5TOA1+
+#RET,	SETX	#XR
+	SETB	#BASE
+	JA	.+3
+#BASE,	ORG	.+6
+A,	ORG	.+3
+B,	ORG	.+3
+D,	ORG	.+3
+BLANK,	TEXT +      +
+ZERO,	F 0
+THREE,	F 3
+	ORG	#BASE+30
+	FNOP
+	JA	#RET
+	FNOP
+#GOBAK,	0;0
+
+#RTN,	BASE	#BASE
+	JA	#GOBAK
+
+FIVE,	F 5
+SEVEN,	F 7
+
+#ST,	STARTD
+	0210
+	FSTA	#GOBAK,0
+	0200
+	SETX	#XR
+	SETB	#BASE
+	LDX	0,1
+	FSTA	#BASE
+	FLDA%	#BASE,1+
+	FSTA	A
+	FLDA%	#BASE,1+
+	FSTA	B
+	FLDA%	#BASE,1+
+	FSTA	D
+	STARTF
+	FLDA%	A
+	FSTA	A
+	FLDA%	B
+	FSTA	B
+	FLDA%	D
+	FSTA	D
+/	IF (A .NE. BLANK) TYPE 1,A
+	FLDA	A
+	FSUB	BLANK
+	JEQ	#G0001
+	JSR	TRIM
+	JA	.+4
+	JA	A
+	JSR	SIXOUT
+	JA	.+10
+	JA	A
+	JA	ZERO
+	JA	SEVEN
+/	IF (B .NE. BLANK) TYPE 1,B
+#G0001,	FLDA	B
+	FSUB	BLANK
+	JEQ	#G0002
+	JSR	TRIM
+	JA	.+4
+	JA	B
+	JSR	SIXOUT
+	JA	.+10
+	JA	B
+	JA	ZERO
+	JA	SEVEN
+/	IF (C .NE. BLANK) TYPE 1,C
+/	TYPE 2,D
+#G0002,	JSR	TRIM
+	JA	.+4
+	JA	D
+	JSR	SIXOUT
+	JA	#RTN
+	JA	D
+	JA	ZERO
+	JA	FIVE
+/	RETURN
+/	END
+
+/1	FORMAT('+',A2,$)
+/2	FORMAT('+',A2)
+
+	SECT	TRIM
+	JA	#TST
+#TXR,	ORG	.+10
+	TEXT	+TRIM  +
+#TRET,	SETX	#TXR
+	SETB	#TBASE
+	JA	.+3
+#TBASE,	ORG	.+6
+PSTR,	ORG	.+3
+I,	ORG	.+3
+CH,	ORG	.+3
+K1,	F 1
+K6,	F 6
+K32,	F 32
+	ORG	#TBASE+30
+	FNOP
+	JA	#TRET
+	FNOP
+#TGOBK,	0;0
+
+#TRTN,	BASE	#TBASE
+	JA	#TGOBK
+#TST,	STARTD
+	0210
+	FSTA	#TGOBK,0
+	0200
+	SETX	#TXR
+	SETB	#TBASE
+	LDX	0,1
+	FSTA	#TBASE
+	FLDA%	#TBASE,1+
+	FSTA	PSTR
+	STARTF
+
+	FLDA	K6
+	FSTA	I
+#T10,	FLDA	PSTR
+	STARTD
+	FSTA	#TG001
+	FSTA	#TG002
+	STARTF
+	JSR	CGET
+	JA	.+0010
+#TG001,	JA	.
+	JA	I
+	JA	CH
+	FLDA	CH
+	FSUB	K32
+	JNE	#TRTN
+	JSR	CPUT
+	JA	.+0010
+#TG002,	JA	.
+	JA	I
+	JA	ZERO
+	FLDA	I
+	FSUB	K1
+	FSTA	I
+	JGT	#T10
+
+	JA	#TRTN