[1]


Task

Find the point of intersection of two lines in 2D.



The 1st line passes though    (4,0)    and    (6,10) .

The 2nd line passes though    (0,3)    and    (10,7) .




*        Intersection of two lines   01/03/2019
INTERSEC CSECT                     
         USING  INTERSEC,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LE     F0,XA              xa
       IF    CE,F0,EQ,XB THEN      if xa=xb then
         STE    F0,X1                x1=xa
         LE     F0,YA
       IF    CE,F0,EQ,YB THEN        if ya=yb then
         MVI    MSG,C'='               msg='='
       ENDIF    ,                    endif
       ELSE     ,                  else
         MVI    FK1,X'01'            fk1=true
         LE     F0,YB
         SE     F0,YA                yb-ya
         LE     F2,XB
         SE     F2,XA                xb-xa
         DER    F0,F2                /
         STE    F0,K1                k1=(yb-ya)/(xb-xa)
         ME     F0,XA                k1*xa
         LE     F2,YA                ya
         SER    F2,F0                -
         STE    F2,D1                d1=ya-k1*xa
       ENDIF    ,                  endif
         LE     F0,XC
       IF    CE,F0,EQ,XD THEN      if xc=xd then
         STE    F0,X2                x2=xc
         LE     F4,YC                yc
       IF    CE,F4,EQ,YD THEN        if yc=yd then
         MVI    MSG,C'='               msg='='
       ENDIF    ,                    endif
       ELSE     ,                  else
         MVI    FK2,X'01'            fk2=true
         LE     F0,YD
         SE     F0,YC                yd-yc
         LE     F2,XD
         SE     F2,XC                xd-xc
         DER    F0,F2                /
         STE    F0,K2                k2=(yd-yc)/(xd-xc)
         ME     F0,XC                k2*xc
         LE     F2,YC                yc
         SER    F2,F0                -
         STE    F2,D2                d2=yc-k2*xc
       ENDIF    ,                  endif
       IF   CLI,MSG,EQ,C' ' THEN   if msg=' ' then
       IF   CLI,FK1,EQ,X'00' THEN    if not fk1 then
       IF   CLI,FK2,EQ,X'00' THEN      if not fk2 then
         LE     F4,X1
       IF    CE,F4,EQ,X2                 if x1=x2 then
         MVI    MSG,C'='                   msg='='
       ELSE     ,                        else
         MVI    MSG,C'/'                   msg='/'
       ENDIF    ,                        endif
       ELSE     ,                      else
         LE     F0,X1
         STE    F0,X                     x=x1
         LE     F0,K2                    k2
         ME     F0,X                     *x
         AE     F0,D2                    +d2
         STE    F0,Y                     y=k2*x+d2
       ENDIF    ,                      endif
       ELSE     ,                    else
       IF    CLI,FK2,EQ,X'00' THEN     if not fk2 then
         LE     F0,X2
         STE    F0,X                     x=x2
         LE     F0,K1                    k1
         ME     F0,X                     *x
         AE     F0,D1                    +d1
         STE    F0,Y                     y=k1*x+d1
       ELSE     ,                      else
         LE     F4,K1
       IF    CE,F4,EQ,K2 THEN            if k1=k2 then
         LE     F4,D1
       IF    CE,F4,EQ,D2 THEN              if d1=d2 then
         MVI    MSG,C'='                     msg='=';
       ELSE     ,                          else
         MVI    MSG,C'/'                     msg='/';
       ENDIF    ,                          endif
       ELSE     ,                        else
         LE     F0,D2                      d2
         SE     F0,D1                      -d1
         LE     F2,K1                      k1
         SE     F2,K2                      -k2
         DER    F0,F2                      /
         STE    F0,X                       x=(d2-d1)/(k1-k2)
         LE     F0,K1                      k1
         ME     F0,X                       *x
         AE     F0,D1                      +d1
         STE    F0,Y                       y=k1*x+d1
       ENDIF    ,                        endif
       ENDIF    ,                      endif
       ENDIF    ,                    endif
       ENDIF    ,                  endif
       IF   CLI,MSG,EQ,C' ' THEN   if msg=' ' then
         LE     F0,X                 x
         LA     R0,3                 decimal=3
         BAL    R14,FORMATF          format x
         MVC    PG+0(13),0(R1)       output x
         LE     F0,Y                 y
         LA     R0,3                 decimal=3
         BAL    R14,FORMATF          format y
         MVC    PG+13(13),0(R1)      output y
       ENDIF    ,                  endif
         MVC    PG+28(1),MSG       output msg  
         XPRNT  PG,L'PG            print buffer
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling sav
         COPY   plig\$_FORMATF.MLC
XA       DC     E'4.0'             point A
YA       DC     E'0.0'
XB       DC     E'6.0'             point B
YB       DC     E'10.0'
XC       DC     E'0.0'             point C
YC       DC     E'3.0'
XD       DC     E'10.0'            point D
YD       DC     E'7.0'
X        DS     E
Y        DS     E
X1       DS     E
X2       DS     E
K1       DS     E
K2       DS     E
D1       DS     E
D2       DS     E
FK1      DC     X'00'
FK2      DC     X'00'
MSG      DC     C' '
PG       DC     CL80' '
         REGEQU
         END    INTERSEC