perm filename ARROW.FAI[GEM,BGB] blob
sn#046303 filedate 1973-06-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 NSUBR DPYARW,NODE
C00005 00003 ----- DPYARW continued.
C00008 00004 END
C00009 ENDMK
C⊗;
NSUBR DPYARW,NODE
ACCUMULATORS{FLG,N,V1,V2,DX1,DY1,DX2,DY2,X1,Y1}
LAC N,NODE ;FETCH NODE IN QUESTION
TESTZ N,NSEW↔POP1J ;MAKE SURE IT'S NOT OFF SCREEN
PARROW V2,N ;AND THE OTHER END
TEST V1,TBIT1 ;HAVE WE BEEN HERE YET?
GO [ MARK N,TBIT1↔POP1J];NO, MARK OUR PLACE AND RETURN
TESTZ V2,NSEW↔POP1J ;CHECK FOR OFF SCREEN
PVT V2,V2 ;NOW GET SECOND VERTEX
TESTZ V2,NSEW↔POP1J ;CHECK FOR OFF SCREEN
PVT V1,N ;AND LASTLY THE FIRST VERTEX
TESTZ V1,NSEW↔POP1J ;CHECK FOR OFF SCREEN
XDC DX1,N ;Fetch coordinates of V1'
YDC DY1,N
XDC DX2,V2 ;Fetch coordinates of V2
YDC DY2,V2
XDC 0,V1 ;Fetch coordinates of V1
YDC DY2,V1 ; -→
FSBR DX1,0 ;Calculate E1
FSBR DY1,1 ; -→
FSBR DX2,0 ;Calculate E2
FSBR DY2,1 ; -→
FSC DX1,-1 ;Divide E1 by 2.0
FSC DY1,-1
FADR 0,DX1 ;This is the bisector of V1' and V2'
FADR 1,DY1
FADR 0,DX2
FADR 1,DY2
DAC 0,XCEN ;Save somewhere
DAC 1,YCEN
LAC 0,DX1 ;Normalize
LAC 1,DY1
CALL DIST
FDVR DX1,1
FDVR DY1,1
LAC 0,DX2 ;Normalize
LAC 1,DY2
CALL DIST
FDVR DX2,1
FDVR DY2,1
MOVN 0,DX2
MOVN 1,DY2
FMPR 0,K4
FMPR 1,K4
FADRM 0,XCEN
FADRM 1,YCEN
CALL HALF ;Do first half of arrow
MOVN DX1,DX1 ; -→
MOVN DX2,DX2 ;Change sign of E1
EXCH V1,V2 ;Switch vertices
PARROW N,N ;And Ynodes
CALL HALF
POP1J
;----- DPYARW continued.
DIST: FMPR 0,0 ;Calculate length of vector
FMPR 1,1
FADR 1,0
CALL SQRT↑,1
POP0J
HALF: LAC X1,V1 ;Draw extension
LACI Y1,DX2
LAC 0,K5
CALL OFFAI
LAC X1,N
SETZ 0,
CALL OFFAV
LAC X1,N ;Upper wing of arrow
LACI Y1,DX2
LAC 0,K4
CALL OFFAI
PUSHP X1 ;Save start of arrow
PUSHP Y1
LAC 0,DX1
LAC 1,DY1
FMPR 0,K1
FMPR 1,K1
LAC X1,DX2
LAC Y1,DY2
FMPR X1,K2
FMPR Y1,K2
FADR 0,X1
FADR 1,Y1
FIX 0,233000
FIX 1,233000
CALL RVECT,0,1
MOVN 0,X1 ;Now the lower wing
MOVN 0,Y1
FIX 0,232000 ;(Doubles)
FIX 1,232000
CALL RIVECT,0,1
CALL AVECT ;(With arguments saved above)
MOVN X1,DX1 ;The main line of arrow
MOVN Y1,DY1
FMPR X1,K3
FMPR Y1,K3
FADR X1,YCEN
FADR Y1,YCEN
SETO FLG
GO FAV
OFFAI: TDZA FLG,FLG
OFFAV: SETO FLG,
LAC 1,0
JUMPE 0,.+4
FMPR 0,(Y1)
FMPR 0,1(Y1)
YDC Y1,X1
XDC X1,X1
FADR X1,0
FADR Y1,1
FAV: FIX X1,233000
FIX Y1,233000
JUMPE FLG,[CALL AIVECT,X1,Y1
POP0J]
CALL AVECT↑,X1,Y1
POP0J
K1: 12.0
K2: 5.0
K3: 3.0
K4: 10.0
K5: 2.0
DECLARE{XCEN,YCEN}
SUBREND DPYARW
END