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

diff --git a/sw/adventure/src/MOVE.RA b/sw/adventure/src/MOVE.RA
new file mode 100644
index 0000000..4a5ce68
--- /dev/null
+++ b/sw/adventure/src/MOVE.RA
@@ -0,0 +1,88 @@
+	SECT	MOVE
+/	 SUBROUTINE MOVE(OBJECT,WHERE)
+/	 C
+/	 C PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT. MAY ALREADY BE
+/	 C TOTING, IN WHICH CASE THE CARRY IS A NO-OP. MUSTN'T PICK UP OBJECTS WHICH
+/	 C ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS.
+/	 C
+/	 IMPLICIT INTEGER (A-Z)
+/	 COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
+/	 DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)
+/	 C
+	EXTERN	CARRY
+	EXTERN	DROP
+	JA	#ST
+#XR,	ORG	.+10
+	TEXT	+MOVE  +
+#RET,	SETX	#XR
+	SETB	#BASE
+	JA	.+3
+#BASE,	ORG	.+6
+OBJECT,	ORG	.+3
+WHERE,	ORG	.+3
+HUND,	F 100.0
+THREHN,	F 300.0
+FROM,	ORG	.+3
+	ORG	#BASE+30
+	FNOP
+	JA	#RET
+	FNOP
+#GOBAK,	0;0
+	#LBL=.
+	COMMON	PLACOM
+ATLOC,	ORG	.+0702
+LINK,	ORG	.+1130
+PLACE,	ORG	.+0454
+FIXED,	ORG	.+0454
+HOLDNG,	ORG	.+3
+	ORG	#LBL
+#RTN,	BASE	#BASE
+	JA	#GOBAK
+#ST,	STARTD
+	0210
+	FSTA	#GOBAK,0
+	0200
+	SETX	#XR
+	SETB	#BASE
+	LDX	0,1
+	FSTA	#BASE
+	FLDA%	#BASE,1+
+	FSTA	OBJECT
+	FSTA	#G3
+	FSTA	#G2
+	FLDA%	#BASE,1+
+	FSTA	WHERE
+	FSTA	#G4
+	STARTF
+	FLDA%	OBJECT
+	ATX	7
+/	 IF(OBJECT.GT.100)GOTO 1
+	FSUB	HUND
+	ATX	5
+	JGT	#1
+/	 FROM=PLACE(OBJECT)
+	FLDA	PLACE-3,7
+	FSTA	FROM
+/	 GOTO 2
+	JA	#2
+
+/	 1	FROM=FIXED(OBJECT-100)
+#1,	FLDA	FIXED-3,5
+	FSTA	FROM
+
+/	 2	IF(FROM.GT.0.AND.FROM.LE.300)CALL CARRY(OBJECT,FROM)
+#2, 	JLE	#G1
+	FSUB	THREHN
+	JGT	#G1
+	JSR	CARRY
+	JA	.+6
+#G2,	JA	.
+	JA	FROM
+/	 CALL DROP(OBJECT,WHERE)
+#G1,	JSR	DROP
+/	 RETURN
+/	 END
+	JA	#RTN
+#G3,	JA	.
+#G4,	JA	.
+	END