disk8: Initial commit
[pdp8.git] / sw / adventure / MOVE.RA
1 SECT MOVE
2 / SUBROUTINE MOVE(OBJECT,WHERE)
3 / C
4 / C PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT. MAY ALREADY BE
5 / C TOTING, IN WHICH CASE THE CARRY IS A NO-OP. MUSTN'T PICK UP OBJECTS WHICH
6 / C ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS.
7 / C
8 / IMPLICIT INTEGER (A-Z)
9 / COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
10 / DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)
11 / C
12 EXTERN CARRY
13 EXTERN DROP
14 JA #ST
15 #XR, ORG .+10
16 TEXT +MOVE +
17 #RET, SETX #XR
18 SETB #BASE
19 JA .+3
20 #BASE, ORG .+6
21 OBJECT, ORG .+3
22 WHERE, ORG .+3
23 HUND, F 100.0
24 THREHN, F 300.0
25 FROM, ORG .+3
26 ORG #BASE+30
27 FNOP
28 JA #RET
29 FNOP
30 #GOBAK, 0;0
31 #LBL=.
32 COMMON PLACOM
33 ATLOC, ORG .+0702
34 LINK, ORG .+1130
35 PLACE, ORG .+0454
36 FIXED, ORG .+0454
37 HOLDNG, ORG .+3
38 ORG #LBL
39 #RTN, BASE #BASE
40 JA #GOBAK
41 #ST, STARTD
42 0210
43 FSTA #GOBAK,0
44 0200
45 SETX #XR
46 SETB #BASE
47 LDX 0,1
48 FSTA #BASE
49 FLDA% #BASE,1+
50 FSTA OBJECT
51 FSTA #G3
52 FSTA #G2
53 FLDA% #BASE,1+
54 FSTA WHERE
55 FSTA #G4
56 STARTF
57 FLDA% OBJECT
58 ATX 7
59 / IF(OBJECT.GT.100)GOTO 1
60 FSUB HUND
61 ATX 5
62 JGT #1
63 / FROM=PLACE(OBJECT)
64 FLDA PLACE-3,7
65 FSTA FROM
66 / GOTO 2
67 JA #2
68
69 / 1 FROM=FIXED(OBJECT-100)
70 #1, FLDA FIXED-3,5
71 FSTA FROM
72
73 / 2 IF(FROM.GT.0.AND.FROM.LE.300)CALL CARRY(OBJECT,FROM)
74 #2, JLE #G1
75 FSUB THREHN
76 JGT #G1
77 JSR CARRY
78 JA .+6
79 #G2, JA .
80 JA FROM
81 / CALL DROP(OBJECT,WHERE)
82 #G1, JSR DROP
83 / RETURN
84 / END
85 JA #RTN
86 #G3, JA .
87 #G4, JA .
88 END