' **************************************************************************       
' * Programa de conversao entre varios sistemas de coordenadas             * 
' * Licenciatura de Fisica / Matematica Aplicada - Ramo Astronomia         * 
' * Realizado por:                                                         * 
' * Jose "Ant" Silva                                                       * 
' * e                                                                      * 
' * Ricardo "Spawn" Reis                                                   * 
' * Concede-se permissao para usar este programa para fins educativos      * 
' ************************************************************************** 
' Declaracao das contantes PI e Obliquidade da Ecliptica 
CONST PI = 3.141593 
CONST OE = .41 
' ************************************************************************** 
' Declaracao das subrotinas para as matrizes de rotacao 
DECLARE SUB MATRIx (A!, X!, Y!, Z!, XL!, YL!, ZL!) 
DECLARE SUB MATRIy (A!, X!, Y!, Z!, XL!, YL!, ZL!) 
DECLARE SUB MATRIz (A!, X!, Y!, Z!, XL!, YL!, ZL!) 
' ************************************************************************** 
' Declaracao das subrotinas para a conversao entre alguns sistemas 
DECLARE SUB CHGgr (A!, B!) 
DECLARE SUB CHGrg (A!, B!) 
DECLARE SUB CHGgh (G!, H!, M!, S!) 
DECLARE SUB CHGhg (H!, M!, S!, G!) 
DECLARE SUB CHGne (B!, A!, X!, Y!, Z!) 
DECLARE SUB CHGen (XL!, YL!, ZL!, A!, B!)
' **************************************************************************
' Declaracao da subrotina para pausa do programa
DECLARE SUB PAUSA ()
' **************************************************************************
' Apresentando o menu ...
MENU:
CLS
SCREEN 12
COLOR 11
LOCATE 5
PRINT "                    Programa de conversao de coordenadas"
COLOR 15
LOCATE 10
PRINT "        Escolha as coordenadas iniciais : "
PRINT
PRINT "                         1 - Horizontais "
PRINT "                         2 - Equatoriais locais"
PRINT "                         3 - Equatoriais celestes"
PRINT "                         4 - Eclipticas"
LOCATE 20
PRINT "                                       S - Sair"
LOCATE 23
COLOR 10
INPUT ; "                 Escolha uma das opcoes: ", OP1$
IF OP1$ = "S" OR OP1$ = "s" THEN GOTO SAIDA
IF OP1$ = "1" THEN GOTO HZ
IF OP1$ = "2" THEN GOTO EQLOC
IF OP1$ = "3" THEN GOTO EQCEL
IF OP1$ = "4" THEN GOTO ECL
GOTO MENU
' *************************************************************************
' Introducao de Coordenadas Horizontais
HZ:
CLS
LOCATE 3
COLOR 10
PRINT SPC(26); "Coordenadas Horizontais"
COLOR 15
PRINT
PRINT
PRINT " Introduzir coordenadas: "
LOCATE 10
INPUT "                   Azimute: ", AZI
IF AZI > 360 OR AZI < 0 THEN GOTO HZ
INPUT "                   Altura: ", ALT
IF ABS(ALT) > 90 THEN GOTO HZ
INPUT "                   Latitude: ", LAT
IF ABS(LAT) > 90 THEN GOTO HZ
LOCATE 16
PRINT " Introduzir o Tempo Sideral Local do instante da observacao: "
LOCATE 20
INPUT "                   Horas: ", H
IF H < 0 OR H > 24 THEN GOTO HZ
INPUT "                   Minutos: ", M
IF M < 0 OR M > 59 THEN GOTO HZ
IF H = 24 AND M <> 0 THEN GOTO HZ
INPUT "                   Segundos: ", S
IF S < 0 OR S > 59 THEN GOTO HZ
IF H = 24 AND S <> 0 THEN GOTO HZ
GOTO MENUFINAL
' *************************************************************************
' Introducao de Coordenadas Equatoriais Locais
EQLOC:
CLS
LOCATE 3
COLOR 10
PRINT SPC(23); "Coordenadas Equatoriais Locais"
COLOR 15
PRINT
PRINT
PRINT " Introduzir coordenadas: "
LOCATE 10
PRINT "                   Angulo Horario:"
INPUT "                                Horas: ", H
IF H < 0 OR H > 24 THEN GOTO EQLOC
INPUT "                                Minutos: ", M
IF M < 0 OR M > 59 THEN GOTO EQLOC
IF H = 24 AND M <> 0 THEN GOTO EQLOC
INPUT "                                Segundos: ", S
IF S < 0 OR S > 59 THEN GOTO EQLOC
IF H = 24 AND S <> 0 THEN GOTO EQLOC
PRINT
INPUT "                   Declinacao: ", DEC
IF ABS(DEC) > 90 THEN GOTO EQLOC
PRINT
INPUT "                     Latitude:", LAT
IF ABS(LAT) > 90 THEN GOTO EQLOC
LOCATE 20
PRINT " Introduzir o Tempo Sideral Local do instante da observacao: "
LOCATE 22
INPUT "                   Horas: ", H
IF H < 0 OR H > 24 THEN GOTO EQLOC
INPUT "                   Minutos: ", M
IF M < 0 OR M > 59 THEN GOTO EQLOC
IF H = 24 AND M <> 0 THEN GOTO EQLOC
INPUT "                   Segundos: ", S
IF S < 0 OR S > 59 THEN GOTO EQLOC
IF H = 24 AND S <> 0 THEN GOTO EQLOC
GOTO MENUFINAL
' *************************************************************************
' Introducao de Coordenadas Equatoriais Celestes
EQCEL:
CLS
LOCATE 3
COLOR 10
PRINT SPC(23); "Coordenadas Equatoriais Celestes"
COLOR 15
PRINT
PRINT
PRINT " Introduzir coordenadas:"
LOCATE 10
PRINT "                   Ascencao recta: "
INPUT "                                Horas: ", H
IF H < 0 OR H > 24 THEN GOTO EQCEL
INPUT "                                Minutos: ", M
IF M < 0 OR M > 59 THEN GOTO EQCEL
IF H = 24 AND M <> 0 THEN GOTO EQCEL
INPUT "                                Segundos: ", S
IF S < 0 OR S > 59 THEN GOTO EQCEL
IF H = 24 AND S <> 0 THEN GOTO EQCEL
PRINT
INPUT "                   Declinacao: ", DEC
IF ABS(DEC) > 90 THEN GOTO EQCEL
PRINT
INPUT "                   Latitude: ", LAT
IF ABS(LAT) > 90 THEN GOTO EQCEL
LOCATE 20
PRINT " Introduzir o Tempo Sideral Local do instante da observacao: "
LOCATE 23
INPUT "                   Horas: ", H
IF H < 0 OR H > 24 THEN GOTO EQCEL
INPUT "                   Minutos: ", M
IF M < 0 OR M > 59 THEN GOTO EQCEL
IF H = 24 AND M <> 0 THEN GOTO EQCEL
INPUT "                   Segundos: ", S
IF S < 0 OR S > 59 THEN GOTO EQCEL
IF H = 24 AND S <> 0 THEN GOTO EQCEL
GOTO MENUFINAL
' *************************************************************************
' Introducao de Coordenadas Eclipticas
ECL:
CLS
LOCATE 3
COLOR 10
PRINT SPC(23); "Coordenadas Eclipticas"
COLOR 15
PRINT
PRINT
PRINT " Introduzir coordenadas: "
LOCATE 10
INPUT "                   Longitude ecliptica: ", LOE
IF LOE < 0 OR LOE > 360 THEN GOTO ECL
PRINT
INPUT "                   Latitude ecliptica: ", LAE
IF ABS(LAE) > 90 THEN GOTO ECL
PRINT
INPUT "                   Latitude: ", LAT
IF ABS(LAT) > 90 THEN GOTO ECL
LOCATE 19
PRINT " Introduzir o Tempo Sideral Local do instante da observacao: "
LOCATE 21
INPUT "                   Horas: ", H
IF H < 0 OR H > 24 THEN GOTO ECL
INPUT "                   Minutos: ", M
IF M < 0 OR M > 59 THEN GOTO ECL
IF H = 24 AND M <> 0 THEN GOTO ECL
INPUT "                   Segundos: ", S
IF S < 0 OR S > 59 THEN GOTO ECL
IF H = 24 AND S <> 0 THEN GOTO HZ
GOTO MENUFINAL
GOTO MENU
' *************************************************************************
' Apresentando Menu Coordenadas finais ...
MENUFINAL:
CLS
LOCATE 10
PRINT "        Introduza as coordenadas finais: "
PRINT
PRINT
PRINT "                         1 - Horizontais "
PRINT "                         2 - Equatoriais locais"
PRINT "                         3 - Equatoriais celestes"
PRINT "                         4 - Eclipticas"
LOCATE 20
PRINT "                                    V - Voltar"
PRINT "                                    S - Sair"
LOCATE 25
COLOR 10
INPUT "                Escolha a opcao:", OP2$
COLOR 15
IF OP2$ = "s" OR OP2$ = "S" THEN GOTO SAIDA
IF OP2$ = "v" OR OP2$ = "V" THEN GOTO VOLTAR
IF OP2$ = OP1$ THEN GOTO MENUFINAL
IF OP1$ = "1" AND OP2$ = "2" THEN GOTO HEQLOCFNL
IF OP1$ = "1" AND OP2$ = "3" THEN GOTO HEQCELFNL
IF OP1$ = "1" AND OP2$ = "4" THEN GOTO HECLFNL
IF OP1$ = "2" AND OP2$ = "1" THEN GOTO ELHRZFNL
IF OP1$ = "2" AND OP2$ = "3" THEN GOTO ELEQCELFNL
IF OP1$ = "2" AND OP2$ = "4" THEN GOTO ELECLFNL
IF OP1$ = "3" AND OP2$ = "1" THEN GOTO ECHRZFNL
IF OP1$ = "3" AND OP2$ = "2" THEN GOTO ECEQLOCFNL
IF OP1$ = "3" AND OP2$ = "4" THEN GOTO ECECLFNL
IF OP1$ = "4" AND OP2$ = "1" THEN GOTO ECLHRZFNL
IF OP1$ = "4" AND OP2$ = "2" THEN GOTO ECLEQLOCFNL
IF OP1$ = "4" AND OP2$ = "3" THEN GOTO ECLEQCELFNL
' **************************************************************************
' Conversao de coordenadas horizontais para coordenadas equatoriais locais
HEQLOCFNL:
CLS
CALL CHGgr(AZI, AZIr)
CALL CHGgr(ALT, ALTr)
CALL CHGgr(LAT, LATr)
CALL CHGne(AZIr, ALTr, X, Y, Z)
CALL MATRIy((PI / 2 - LATr), X, Y, Z, XL, YL, ZL)
CALL CHGen(XL, YL, ZL, Tr, DECr)
CALL CHGrg(Tr, T)
CALL CHGrg(DECr, DEC)
CALL CHGgh(T, H, M, S)
LOCATE 5
PRINT " Coordenadas finais:"
LOCATE 10
PRINT "                   Angulo Horario:"
PRINT "                                Horas: "; H
PRINT "                                Minutos: "; M
PRINT "                                Segundos: "; S
PRINT
PRINT "                   Declinacao: "; USING "###.##"; DEC
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas horizontais para coordenadas equatoriais celestes
HEQCELFNL:
CLS
CALL CHGgr(AZI, AZIr)
CALL CHGgr(ALT, ALTr)
CALL CHGgr(LAT, LATr)
CALL CHGne(AZIr, ALTr, X, Y, Z)
CALL MATRIy((PI / 2 - LATr), X, Y, Z, XL, YL, ZL)
CALL CHGhg(H, M, SS, TS)
CALL CHGgr(TS, TSr)
CALL MATRIz(-TSr, XL, YL, ZL, X, Y, Z)
CALL CHGen(X, Y, Z, Tr, DECr)
CALL CHGrg(Tr, T)
CALL CHGrg(DECr, DEC)
CALL CHGgh(T, H, M, S)
LOCATE 5
PRINT " Coordenadas finais:"
LOCATE 10
PRINT "                   Ascencao recta: "
PRINT "                                Horas: "; H
PRINT "                                Minutos: "; M
PRINT "                                Segundos: "; S
PRINT
PRINT "                   Declinacao: "; USING "###.##"; DEC
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas horizontais para coordenadas eclipticas
HECLFNL:
CALL CHGgr(AZI, AZIr)
CALL CHGgr(ALT, ALTr)
CALL CHGgr(LAT, LATr)
CALL CHGne(AZIr, ALTr, X, Y, Z)
CALL MATRIy((PI / 2 - LATr), X, Y, Z, XL, YL, ZL)
CALL CHGhg(H, M, SS, TS)
CALL CHGgr(TS, TSr)
CALL MATRIz(-TSr, XL, YL, ZL, X, Y, Z)
CALL MATRIx(OE, X, Y, Z, XL, YL, ZL)
CALL CHGen(XL, YL, ZL, LOEr, LAEr)
CALL CHGrg(LOEr, LOE)
CALL CHGrg(LAEr, LAE)
CLS
LOCATE 5
PRINT "Coordenadas finais:"
LOCATE 10
PRINT "                   Longitude ecliptica: "; USING "###.##"; LOE
PRINT "                   Latitude ecliptica: "; USING "###.##"; LAE
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas equatoriais locais para coordenadas horizontais
ELHRZFNL:
CALL CHGhg(H, M, S, T)
CALL CHGgr(T, Tr)
CALL CHGgr(DEC, DECr)
CALL CHGgr(LAT, LATr)
CALL CHGne(Tr, DECr, X, Y, Z)
CALL MATRIy(LATr - PI / 2, X, Y, Z, XL, YL, ZL)
CALL CHGen(XL, YL, ZL, AZIr, ALTr)
CALL CHGrg(AZIr, AZI)
CALL CHGrg(ALTr, ALT)
CLS
LOCATE 5
PRINT "Coordenadas finais:"
LOCATE 8
PRINT "                   Azimute: "; USING "###.##"; AZI
PRINT "                   Altura: "; USING "###.##"; ALT
PRINT "                   Latitude: "; USING "###.##"; LAT
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas equatoriais locais para coordenadas equatoriais
' celestes
ELEQCELFNL:
CALL CHGhg(H, M, S, T)
CALL CHGgr(T, Tr)
CALL CHGgr(DEC, DECr)
CALL CHGgr(LAT, LATr)
CALL CHGne(Tr, DECr, X, Y, Z)
CALL MATRIz(-TSr, XL, YL, ZL, X, Y, Z)
CALL CHGen(X, Y, Z, Tr, DECr)
CALL CHGrg(Tr, T)
CALL CHGrg(DECr, DEC)
CALL CHGgh(T, H, M, S)
CLS
LOCATE 5
PRINT " Coordenadas finais:"
LOCATE 10
PRINT "                   Ascencao recta: "
PRINT "                                Horas: "; H
PRINT "                                Minutos: "; M
PRINT "                                Segundos: "; S
PRINT
PRINT "                   Declinacao: "; USING "###.##"; DEC
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas equatoriais locais para coordenadas eclipticas
ELECLFNL:
CALL CHGhg(H, M, S, T)
CALL CHGgr(T, Tr)
CALL CHGgr(DEC, DECr)
CALL CHGgr(LAT, LATr)
CALL CHGne(Tr, DECr, X, Y, Z)
CALL MATRIz(-TSr, XL, YL, ZL, X, Y, Z)
CALL MATRIx(OE, X, Y, Z, XL, YL, ZL)
CALL CHGen(XL, YL, ZL, LOEr, LAEr)
CALL CHGrg(LOEr, LOE)
CALL CHGrg(LAEr, LAE)
CLS
LOCATE 5
PRINT "Coordenadas finais:"
LOCATE 10
PRINT "                   Longitude ecliptica: "; USING "###.##"; LOE
PRINT "                   Latitude ecliptica: "; USING "###.##"; LAE
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas equatoriais celestes para coordenadas horizontais
ECHRZFNL:
CLS
CALL CHGhg(T, H, M, S)
CALL CHGgr(T, Tr)
CALL CHGgr(DEC, DECr)
CALL CHGne(Tr, DECr, X, Y, Z)
CALL CHGhg(H, M, SS, TS)
CALL CHGgr(TS, TSr)
CALL MATRIz(TSr, X, Y, Z, XL, YL, ZL)
CALL CHGgr(LAT, LATr)
CALL MATRIy((-(PI / 2) + LATr), XL, YL, ZL, X, Y, Z)
CALL CHGen(X, Y, Z, AZIr, ALTr)
CALL CHGrg(ALTr, ALT)
CALL CHGrg(AZIr, AZI)
LOCATE 5
PRINT "Coordenadas finais:"
LOCATE 8
PRINT "                   Azimute: "; USING "###.##"; AZI
PRINT "                   Altura: "; USING "###.##"; ALT
PRINT "                   Latitude: "; USING "###.##"; LAT
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas equatoriais celestes para coordenadas equatoriais
' celestes
ECEQLOCFNL:
CLS
CALL CHGhg(T, H, M, S)
CALL CHGgr(T, Tr)
CALL CHGgr(DEC, DECr)
CALL CHGne(Tr, DECr, X, Y, Z)
CALL CHGhg(H, M, SS, TS)
CALL CHGgr(TS, TSr)
CALL MATRIz(TSr, X, Y, Z, XL, YL, ZL)
CALL CHGen(XL, YL, ZL, Tr, DECr)
CALL CHGrg(Tr, T)
CALL CHGrg(DECr, DEC)
CALL CHGgh(T, H, M, S)
LOCATE 5
PRINT " Coordenadas finais:"
LOCATE 10
PRINT "                   Angulo Horario:"
PRINT "                                Horas: "; H
PRINT "                                Minutos: "; M
PRINT "                                Segundos: "; S
PRINT
PRINT "                   Declinacao: "; USING "###.##"; DEC
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas equatoriais celestes para coordenadas eclipticas
ECECLFNL:
CLS
CALL CHGhg(T, H, M, S)
CALL CHGgr(T, Tr)
CALL CHGgr(DEC, DECr)
CALL CHGne(Tr, DECr, X, Y, Z)
CALL MATRIx(OE, X, Y, Z, XL, YL, ZL)
CALL CHGen(XL, YL, ZL, LOEr, LAEr)
CALL CHGrg(LOEr, LOE)
CALL CHGrg(LAEr, LAE)
LOCATE 5
PRINT " Coordenadas finais:"
LOCATE 10
PRINT "                   Longitude ecliptica: "; USING "###.##"; LOE
PRINT "                   Latitude ecliptica: "; USING "###.##"; LAE
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas eclipticas para coordenadas horizontais
ECLHRZFNL:
CLS
CALL CHGgr(LOE, LOEr)
CALL CHGgr(LAE, LAEr)
CALL CHGne(LOEr, LAEr, XL, YL, ZL)
CALL MATRIx(-OE, XL, YL, ZL, X, Y, Z)
CALL CHGhg(H, M, SS, TS)
CALL CHGgr(TS, TSr)
CALL MATRIz(TSr, X, Y, Z, XL, YL, ZL)
CALL CHGgr(LAT, LATr)
CALL MATRIy((-(PI / 2) + LATr), XL, YL, ZL, X, Y, Z)
CALL CHGen(X, Y, Z, AZIr, ALTr)
CALL CHGrg(ALTr, ALT)
CALL CHGrg(AZIr, AZI)
LOCATE 5
PRINT "Coordenadas finais:"
LOCATE 8
PRINT "                   Azimute: "; USING "###.##"; AZI
PRINT "                   Altura: "; USING "###.##"; ALT
PRINT "                   Latitude: "; USING "###.##"; LAT
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas eclipticas para coordenadas equatoriais locais
ECLEQLOCFNL:
CLS
CALL CHGgr(LOE, LOEr)
CALL CHGgr(LAE, LAEr)
CALL CHGne(LOEr, LAEr, XL, YL, ZL)
CALL MATRIx(-OE, XL, YL, ZL, X, Y, Z)
CALL CHGhg(H, M, SS, TS)
CALL CHGgr(TS, TSr)
CALL MATRIz(TSr, X, Y, Z, XL, YL, ZL)
CALL CHGen(XL, YL, ZL, Tr, DECr)
CALL CHGrg(Tr, T)
CALL CHGrg(DECr, DEC)
CALL CHGgh(T, H, M, S)
LOCATE 5
PRINT " Coordenadas finais:"
LOCATE 10
PRINT "                   Angulo Horario:"
PRINT "                                Horas: "; H
PRINT "                                Minutos: "; M
PRINT "                                Segundos: "; S
PRINT
PRINT "                   Declinacao: "; USING "###.##"; DEC
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Conversao de coordenadas eclipticas para coordenadas equatoriais celestes
ECLEQCELFNL:
CLS
CALL CHGgr(LOE, LOEr)
CALL CHGgr(LAE, LAEr)
CALL CHGne(LOEr, LAEr, XL, YL, ZL)
CALL MATRIx(-OE, XL, YL, ZL, X, Y, Z)
CALL CHGen(X, Y, Z, Tr, DECr)
CALL CHGrg(Tr, T)
CALL CHGrg(DECr, DEC)
CALL CHGgh(T, H, M, S)
LOCATE 5
PRINT " Coordenadas finais:"
LOCATE 10
PRINT "                   Ascencao recta: "
PRINT "                                Horas: "; H
PRINT "                                Minutos: "; M
PRINT "                                Segundos: "; S
PRINT
PRINT "                   Declinacao: "; USING "###.##"; DEC
CALL PAUSA
GOTO SAIDA
' **************************************************************************
' Reinicia o programa voltando ao menu inicial
VOLTAR:
RUN
' **************************************************************************
' Saida do programa com apresentacao dos creditos
SAIDA:
CLS
LOCATE 6
COLOR 12
PRINT SPC(8); "Programa realizado por : "
LOCATE 9
COLOR 15
PRINT SPC(20); "Jose Antonio do Bem Ferreira da Silva"
PRINT
PRINT SPC(38); "e"
PRINT
PRINT SPC(20); "Ricardo Samuel dos Santos Cardoso Reis"
LOCATE 18
COLOR 14
PRINT SPC(10); "Curso : Fisica / Matematica Aplicada - Ramo Astronomia"
LOCATE 25
COLOR 9
PRINT SPC(18); "Faculdade de Ciencias da Universidade do Porto "
PRINT
PRINT
COLOR 15
PRINT " Prima Esc para sair ..."
DO
LOOP UNTIL INKEY$ = CHR$(27)
COLOR 0
END



' **************************************************************************
' Subrotina para mudar sistema de tres coordenadas para duas coordenadas
SUB CHGen (XL, YL, ZL, A, B) STATIC
A = ATN(YL / XL) + PI
B = ATN(ZL / ((XL ^ 2 + YL ^ 2) ^ (1 / 2)))
END SUB

' **************************************************************************
' Subrotina para converter graus em horas
SUB CHGgh (G, H, M, S) STATIC
H2 = (G * 24) / 360
H = INT(H2)
M = INT((H2 - H) * 60)
S = INT((((H2 - H) * 60) - M) * 60)
END SUB

' **************************************************************************
' Subrotina para mudar de graus para radianos
SUB CHGgr (A, B) STATIC
B = A * PI / 180
END SUB

' **************************************************************************
' Subrotina para mudar horas para graus
SUB CHGhg (H, M, S, G)
HT = H + (M / 60) + (S / 3600)
G = (HT * 360) / 24
END SUB

' **************************************************************************
' Subrotina para mudar sistema de duas coordenadas para tres coordenadas
SUB CHGne (A, B, X, Y, Z) STATIC
X = COS(B) * COS(A)
Y = COS(B) * SIN(A)
Z = SIN(B)
END SUB

' **************************************************************************
' Subrotina para mudar radianos para graus
SUB CHGrg (A, B) STATIC
B = (A * 180) / PI
END SUB

' **************************************************************************
' Subrotina para fazer a rotacao do sistema de eixos sobre o eixo dos xx
SUB MATRIx (A, X, Y, Z, XL, YL, ZL) STATIC
DIM Mx(3, 3), Me(3, 3)
Mx(1, 1) = 1
Mx(1, 2) = 0
Mx(1, 3) = 0
Mx(2, 1) = 0
Mx(2, 2) = COS(A)
Mx(2, 3) = SIN(A)
Mx(3, 1) = 0
Mx(3, 2) = -SIN(A)
Mx(3, 3) = COS(A)
Me(1, 1) = X
Me(2, 1) = Y
Me(3, 1) = Z
FOR C = 1 TO 3
XL = XL + Mx(1, C) * Me(C, 1)
YL = YL + Mx(2, C) * Me(C, 1)
ZL = ZL + Mx(3, C) * Me(C, 1)
NEXT C
END SUB

' **************************************************************************
' Subrotina para fazer a rotacao do sistema de eixos sobre o eixo dos yy
SUB MATRIy (A, X, Y, Z, XL, YL, ZL) STATIC
DIM Mx(3, 3), Me(3, 3)
Mx(1, 1) = COS(A)
Mx(1, 2) = 0
Mx(1, 3) = -SIN(A)
Mx(2, 1) = 0
Mx(2, 2) = 1
Mx(2, 3) = 0
Mx(3, 1) = SIN(A)
Mx(3, 2) = 0
Mx(3, 3) = COS(A)
Me(1, 1) = X
Me(2, 1) = Y
Me(3, 1) = Z
FOR C = 1 TO 3
XL = XL + Mx(1, C) * Me(C, 1)
YL = YL + Mx(2, C) * Me(C, 1)
ZL = ZL + Mx(3, C) * Me(C, 1)
NEXT C
END SUB

' **************************************************************************
' Subrotina para fazer a rotacao do sistema de eixos sobre o eixo dos zz
SUB MATRIz (A, X, Y, Z, XL, YL, ZL) STATIC
DIM Mx(3, 3), Me(3, 3)
Mx(1, 1) = COS(A)
Mx(1, 2) = SIN(A)
Mx(1, 3) = 0
Mx(2, 1) = -SIN(A)
Mx(2, 2) = COS(A)
Mx(2, 3) = 0
Mx(3, 1) = 0
Mx(3, 2) = 0
Mx(3, 3) = 1
Me(1, 1) = X
Me(2, 1) = Y
Me(3, 1) = Z
FOR C = 1 TO 3
XL = XL + Mx(1, C) * Me(C, 1)
YL = YL + Mx(2, C) * Me(C, 1)
ZL = ZL + Mx(3, C) * Me(C, 1)
NEXT C
' **************************************************************************
' Inverte-se a coordenada por causa de ser um sistema retrogrado
YL = -YL
END SUB

' **************************************************************************
' Subrotina para pausar o programa
SUB PAUSA STATIC
LOCATE 28
PRINT "Prima tecla para continuar..."
DO
LOOP WHILE INKEY$ = ""
END SUB
' **************************************************************************
'                                O FIM 
' **************************************************************************
' * Concede-se permissao para usar este programa para fins educativos      *
' **************************************************************************

line

Copyright © 1996-1999
Jose António Silva et al.
Todos os Direitos Reservados.

Por favor não utilize para outros fins que não educacionais.