DIBUJO ASISTIDO POR ORDENADOR LISTADO 4

    DECLARE FUNCTION MIN! (A!, B!)
    DECLARE FUNCTION MAX! (A!, B!)
    DECLARE SUB TRAS (XC!, YC!, ZC!)
    DECLARE SUB DIRP (XP!, YP!, ZP!)
    DECLARE SUB MMAT (A!(), B!())
    DECLARE SUB PROYECTA (P!(), Q!())
    DECLARE SUB ROTA (EJE$, A!)
    DIM SHARED MATP!(4, 4): DIM SHARED MATR!(4, 4): DIM SHARED MATT!(4, 4)
    DIM P1!(4), P2!(4), Q1!(4), Q2!(4)
    MATP(1, 1) = 1: MATP(1, 2) = 0: MATP(1, 3) = 0: MATP(1, 4) = 0
    MATP(2, 1) = 0: MATP(2, 2) = 1: MATP(2, 3) = 0: MATP(2, 4) = 0
    MATP(3, 1) = 0: MATP(3, 2) = 0: MATP(3, 3) = 1: MATP(3, 4) = 0
    MATP(4, 1) = 0: MATP(4, 2) = 0: MATP(4, 3) = 0: MATP(4, 4) = 1
    CLS: FILES "*.geo": PRINT
    INPUT "FICHERO: "; FICH$: OPEN FICH$ FOR INPUT AS #1
    INPUT #1, NP, NE, DUMMY: DIM XMAT!(NP), YMAT!(NP), ZMAT!(NP)
    XMIN = 999999!: YMIN = 999999!: ZMIN = 999999!
    XMAX = -XMIN: YMAX = -YMIN: ZMAX = -ZMIN
    FOR I = 1 TO NP
    INPUT #1, XMAT!(I), YMAT!(I), ZMAT!(I)
    XMIN = MIN(XMIN, XMAT(I))
    YMIN = MIN(YMIN, YMAT(I))
    ZMIN = MIN(ZMIN, ZMAT(I))
    XMAX = MAX(XMAX, XMAT(I))
    YMAX = MAX(YMAX, YMAT(I))
    ZMAX = MAX(ZMAX, ZMAT(I))
    NEXT I
    ROTA "Z", 30: MMAT MATR(), MATP()
    ROTA "X", 30: MMAT MATR(), MATP()
    DIRP 0, 0, 1: MMAT MATT(), MATP()
    P1(1) = XMIN: P1(2) = YMIN: P1(3) = ZMAX: P1(4) = 1
    PROYECTA P1(), Q1()
    P2(1) = XMAX: P2(2) = YMAX: P2(3) = ZMIN: P2(4) = 1
    PROYECTA P2(), Q2()
    SCREEN 12: BORDER = 2
    XS = ABS(Q2(1) - Q1(1)): YS = ABS(Q2(2) - Q1(2))
    XC = .5 * (Q1(1) + Q2(1)): YC = .5 * (Q1(2) + Q2(2))
    IF (XS / 4 > YS / 3) THEN
    SXMIN = Q1(1): SXMAX = Q2(1)
    SYMIN = YC - .5 * XS * 3 / 4
    SYMAX = YC + .5 * XS * 3 / 4
    ELSE
    SXMIN = XC - .5 * YS * 4 / 3
    SXMAX = XC + .5 * YS * 4 / 3
    SYMIN = Q1(2): SYMAX = Q2(2)
    END IF
    WINDOW (BORDER * SXMIN, BORDER * SYMAX)-(BORDER * SXMAX, BORDER * SYMIN)

    FOR I = 1 TO NE
    INPUT #1, NV, NI: NF = NI
    FOR K = 2 TO NV
    INPUT #1, NJ
    P1(1) = XMAT(NI): P1(2) = YMAT(NI): P1(3) = ZMAT(NI): P1(4) = 1
    P2(1) = XMAT(NJ): P2(2) = YMAT(NJ): P2(3) = ZMAT(NJ): P2(4) = 1
    PROYECTA P1(), Q1(): PROYECTA P2(), Q2()
    LINE (Q1(1) + XC, Q1(2) + YC)-(Q2(1) + XC, Q2(2) + YC)
    NI = NJ
    NEXT K
    P1(1) = XMAT(NI): P1(2) = YMAT(NI): P1(3) = ZMAT(NI): P1(4) = 1
    P2(1) = XMAT(NF): P2(2) = YMAT(NF): P2(3) = ZMAT(NF): P2(4) = 1
    PROYECTA P1(), Q1(): PROYECTA P2(), Q2()
    LINE (Q1(1) + XC, Q1(2) + YC)-(Q2(1) + XC, Q2(2) + YC)
    NEXT I
    SLEEP: CLOSE
    SUB DIRP (XP!, YP!, ZP!)
    MATT(1, 1) = 1: MATT(1, 2) = 0: MATT(1, 3) = 0: MATT(1, 4) = 0
    MATT(2, 1) = 0: MATT(2, 2) = 1: MATT(2, 3) = 0: MATT(2, 4) = 0
    MATT(3, 1) = -XP / ZP: MATT(3, 2) = -YP / ZP: MATT(3, 3) = 0: MATT(3, 4) = 0
    MATT(4, 1) = 0: MATT(4, 2) = 0: MATT(4, 3) = 0: MATT(4, 4) = 1
    END SUB

    FUNCTION MAX (A, B)
    IF (A > B) THEN
    MAX = A
    ELSE
    MAX = B
    END IF
    END FUNCTION

    FUNCTION MIN (A, B)
    IF (A < B) THEN
    MIN = A
    ELSE
    MIN = B
    END IF
    END FUNCTION

    SUB MMAT (A(), B())
    DIM C!(4, 4)
    FOR I = 1 TO 4
    FOR J = 1 TO 4
    C(I, J) = 0
    FOR K = 1 TO 4
    C(I, J) = C(I, J) + A(I, K) * B(K, J)
    NEXT K
    NEXT J
    NEXT I
    FOR I = 1 TO 4
    FOR J = 1 TO 4
    B(I, J) = C(I, J)
    NEXT J
    NEXT I
    END SUB

    SUB PROYECTA (P(), Q())
    FOR I = 1 TO 4
    Q(I) = 0
    FOR J = 1 TO 4
    Q(I) = Q(I) + P(J) * MATP(I, J)
    NEXT J
    NEXT I
    Q(1) = Q(1) / Q(4): Q(2) = Q(2) / Q(4): Q(3) = Q(3) / Q(4)
    END SUB

    SUB ROTA (EJE$, A!)
    CONST PI = 3.141592654#
    ANG = A * PI / 180!
    IF (EJE$ = "X") THEN
    MATR(1, 1) = 1: MATR(1, 2) = 0: MATR(1, 3) = 0: MATR(1, 4) = 0
    MATR(2, 1) = 0: MATR(2, 2) = COS(ANG): MATR(2, 3) = SIN(ANG): MATR(2, 4) = 0
    MATR(3, 1) = 0: MATR(3, 2) = -SIN(ANG): MATR(3, 3)= COS(ANG): MATR(3, 4) = 0
    MATR(4, 1) = 0: MATR(4, 2) = 0: MATR(4, 3) = 0: MATR(4, 4) = 1
    END IF
    IF (EJE$ = "Y") THEN
    MATR(1, 1)= COS(ANG): MATR(1, 2) = 0: MATR(1, 3) = -SIN(ANG): MATR(1, 4) = 0
    MATR(2, 1) = 0: MATR(2, 2) = 1: MATR(2, 3) = 0: MATR(2, 4) = 0
    MATR(3, 1) = SIN(ANG): MATR(3, 2) = 0: MATR(3, 3) = COS(ANG): MATR(3, 4) = 0
    MATR(4, 1) = 0: MATR(4, 2) = 0: MATR(4, 3) = 0: MATR(4, 4) = 1
    END IF
    IF (EJE$ = "Z") THEN
    MATR(1, 1) = COS(ANG): MATR(1, 2) = SIN(ANG): MATR(1, 3) = 0: MATR(1, 4) = 0
    MATR(2, 1)= -SIN(ANG): MATR(2, 2) = COS(ANG): MATR(2, 3) = 0: MATR(2, 4) = 0
    MATR(3, 1) = 0: MATR(3, 2) = 0: MATR(3, 3) = 1: MATR(3, 4) = 0
    MATR(4, 1) = 0: MATR(4, 2) = 0: MATR(4, 3) = 0: MATR(4, 4) = 1
    END IF
    END SUB

Índice