DEFLNG W
DIM Punto(3000, 3): 'El m ximo es 4095
DIM PuntoTextura(400, 2)
DIM PuntoEnLado(100)
DIM Lado$(2000): 'Puede ser m s en la versi¢n profesional de Quick Basic
DIM LineaLimpia$(500, 2): 'La segunda cadena contiene las exclusiones
DIM PuntoEnObjeto(8, 3): DIM PunCubo$(8): DIM PunLadoCubo$(4)
DIM Mencion$(100)
DIM ModifCoord$(200): DIM NivelModif(200)
DIM NombreArchivo$(100): DIM wByteLeido(100)
NumInstrucciones = 4: 'Las 4 Instrucciones son Posi, Tama, Excl, Punt
DIM Instruccion(NumInstrucciones): DIM Instruccion$(NumInstrucciones)
Comilla$ = CHR$(34): Pi = 4 * ATN(1)
maxTono = 360: maxSaturacion = 1: maxBrillo = 1
Tono = 240: Saturacion = 0: Brillo = .5: GOSUB HsbRgb
NombreBasico$ = "Objeto": Textura$ = ""
GOSUB Bienvenida
GOSUB ArchivoLeido
GOSUB TipoExportacion
GOSUB ArchivoEscrito
GOSUB Principal
GOSUB CierraArchivo
END
ArchivoEscrito:
CLS
OKGrabacion$ = "no"
WHILE OKGrabacion$ <> "s¡"
INPUT "Complete DOS name of the translated file "; ArchivoEscrito$
GOSUB InicioNormal
IF LOF(2) <> 0 THEN
BEEP: PRINT : PRINT "A file with that name already exists. Erase (E), Try again (T) ?"
GOSUB EsperaTecla
IF Tecla$ = "e" OR Tecla$ = "E" THEN
CLOSE #2
KILL ArchivoEscrito$
IF LEFT$(TipoExportacion$, 4) <> "VRML" AND TipoExportacion$ <> "Caligari" THEN
GOSUB InicioNormal
ELSE
IF LEFT$(TipoExportacion$, 4) = "VRML" THEN
GOSUB InicioVRML
ELSE
GOSUB InicioCaligari
END IF
END IF
OKGrabacion$ = "s¡"
ELSE
CLOSE #2
END IF
ELSE
IF LEFT$(TipoExportacion$, 4) = "VRML" OR TipoExportacion$ = "Caligari" THEN
CLOSE #2
IF LEFT$(TipoExportacion$, 4) = "VRML" THEN
GOSUB InicioVRML
ELSE
GOSUB InicioCaligari
END IF
END IF
OKGrabacion$ = "s¡"
END IF
WEND
CLS
RETURN
ArchivoLeido:
OKLectura$ = "no"
WHILE OKLectura$ <> "s¡"
IF ArchivoLeido$ = "" THEN
CLS
LOCATE 1, 1: INPUT "Complete DOS name of the CBB file to read "; ArchivoLeido$
ELSE
IF NivelJerarqu < 20 THEN
LOCATE NivelJerarqu + 3, 1: PRINT ArchivoLeido$;
END IF
FOR Espacio = LEN(ArchivoLeido$) + 1 TO 80
PRINT " ";
NEXT Espacio
END IF
OPEN "R", #1, ArchivoLeido$, 1
FIELD #1, 1 AS l$
TamanoArchivo = LOF(1)
IF TamanoArchivo = 0 THEN
LineaDOS$ = "del " + ArchivoLeido$
SHELL LineaDOS$: CLOSE #1
BEEP: PRINT : PRINT "The file does not exist, please try again."
GOSUB EsperaTecla
ArchivoLeido$ = ""
ELSE
OKLectura$ = "s¡"
END IF
WEND
RETURN
Bienvenida:
CLS : COLOR 7, 0
PRINT " This program translates CBB tridimensional files to other formats,"
PRINT "such as WRL (VRML 1 and 2), ASC (3D Studio), and COB (Caligari)."
PRINT " This version manages parallelepipeds, cylinders, cones,"
PRINT "spheres, and any shape defined with vertices and faces. It allows"
PRINT "to define colors according to a hue-saturation-grayscale model."
PRINT " It also allows to modify coordinates (moving, scaling and"
PRINT "rotating shapes), to use textures and, most important of all,"
PRINT "it allows to use the files in a hierarchical structure."
PRINT
PRINT " Copyright Jean-Luc Ancey, November 21st, 1998."
PRINT " Email: jlancey@rocketmail.com"
PRINT " URL: http://www.geocities.com/SiliconValley/Way/4179/VrCocha.htm"
PRINT
PRINT " Non-profit use of this program authorized under the condition"
PRINT "that the name of the author, his email and URL should appear clearly"
PRINT "in the Basic listing and the exported VRML instructions. Commercial use"
PRINT "of this program unauthorized without permission of the author.": PRINT
PRINT " Strike a key when ready."
GOSUB EsperaTecla
CLS
RETURN
BorraEspacios:
Letra = 0
WHILE Letra < LEN(LineaATratar$)
Letra = Letra + 1
Letra$ = MID$(LineaATratar$, Letra, 1)
IF Letra$ = " " THEN
LineaATratar$ = LEFT$(LineaATratar$, Letra - 1) + RIGHT$(LineaATratar$, LEN(LineaATratar$) - Letra)
END IF
WEND
RETURN
BuscaPoTaExPu:
'Se trata de permitir que las ordenes Posicion, Tama¤o,
'Exclusiones y Puntos puedan venir en cualquier orden
LetraPosi = 0: LetraTama = 0: LetraExcl = 0: LetraPunt = 0
FOR Letra = 1 TO LEN(LineaATratar$) - 3
IF MID$(LineaATratar$, Letra, 4) = "posi" THEN
LetraPosi = Letra
END IF
IF MID$(LineaATratar$, Letra, 4) = "tama" THEN
LetraTama = Letra
END IF
IF MID$(LineaATratar$, Letra, 4) = "excl" THEN
LetraExcl = Letra
END IF
IF MID$(LineaATratar$, Letra, 4) = "punt" THEN
LetraPunt = Letra
END IF
NEXT Letra
Instruccion(1) = LetraPosi: Instruccion$(1) = "posi"
Instruccion(2) = LetraTama: Instruccion$(2) = "tama"
Instruccion(3) = LetraExcl: Instruccion$(3) = "excl"
Instruccion(4) = LetraPunt: Instruccion$(4) = "punt"
FOR Instruccion1 = 1 TO NumInstrucciones - 1
FOR Instruccion2 = Instruccion1 + 1 TO NumInstrucciones
IF Instruccion(Instruccion2) < Instruccion(Instruccion1) THEN
SWAP Instruccion(Instruccion1), Instruccion(Instruccion2)
SWAP Instruccion$(Instruccion1), Instruccion$(Instruccion2)
END IF
NEXT Instruccion2
NEXT Instruccion1
FOR Instruccion = 1 TO NumInstrucciones
InicioInstruccion = Instruccion(Instruccion)
IF Instruccion <> NumInstrucciones THEN
FinInstruccion = Instruccion(Instruccion + 1) - 1
ELSE
FinInstruccion = LEN(LineaATratar$)
END IF
IF InicioInstruccion <> 0 THEN
IF Instruccion$(Instruccion) = "posi" THEN
Posicion$ = MID$(LineaATratar$, InicioInstruccion, FinInstruccion - InicioInstruccion + 1)
END IF
IF Instruccion$(Instruccion) = "tama" THEN
Tamano$ = MID$(LineaATratar$, InicioInstruccion, FinInstruccion - InicioInstruccion + 1)
END IF
IF Instruccion$(Instruccion) = "excl" THEN
Exclusion$ = MID$(LineaATratar$, InicioInstruccion, FinInstruccion - InicioInstruccion + 1)
END IF
IF Instruccion$(Instruccion) = "punt" THEN
NumPuntos$ = MID$(LineaATratar$, InicioInstruccion, FinInstruccion - InicioInstruccion + 1)
END IF
ELSE
IF Instruccion$(Instruccion) = "posi" THEN
Posicion$ = "posi, no hay"
END IF
IF Instruccion$(Instruccion) = "tama" THEN
Tamano$ = "tama, no hay"
END IF
IF Instruccion$(Instruccion) = "excl" THEN
Exclusion$ = "excl, no hay"
END IF
IF Instruccion$(Instruccion) = "punt" THEN
NumPuntos$ = "punt, no hay"
END IF
END IF
NEXT Instruccion
RETURN
CalculaLatitud:
Latitud = Pi * Nivel / (NumPuntosZ - 1) - Pi / 2
RETURN
CierraArchivo:
IF LEFT$(TipoExportacion$, 4) = "VRML" THEN
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = "}"
ELSE
LineaEscrita$ = "] }"
END IF
GOSUB GrabaUnaLinea
END IF
IF TipoExportacion$ <> "VRML2" THEN
'El chr$(26) molesta a Internet Explorer
wByteEscrito = wByteEscrito + 1
LSET e$ = CHR$(26)
PUT #2, wByteEscrito
END IF
CLOSE
RETURN
ComparaExclHemi:
Cadena$ = ExclusionEsferaSup$
FOR Letra = 1 TO LEN(Cadena$)
Letra$ = MID$(Cadena$, Letra, 1)
IF ASC(Letra$) >= ASC("5") AND ASC(Letra$) <= ASC("8") THEN
Letra$ = CHR$(ASC(Letra$) - ASC("5") + ASC("1"))
MID$(Cadena$, Letra, 1) = Letra$
END IF
NEXT Letra
IF ExclusionEsferaInf$ = Cadena$ THEN
'Los puntos de los dos hemisferios estando en las mismas direcciones,
'no hay problema
CoherenHemisf$ = "iguales"
ELSE
IF ExclusionEsferaInf$ = "----" OR ExclusionEsferaSup$ = "----" THEN
'Ya que todos los puntos estar n el el mismo hemisferio,
'no hay problema
IF ExclusionEsferaInf$ = "----" THEN
CoherenHemisf$ = "superior no m s"
ELSE
CoherenHemisf$ = "inferior no m s"
END IF
ELSE
'Entonces un hemisferio por lo menos tiene que ser completo
IF ExclusionEsferaInf$ = "1234" THEN
CoherenHemisf$ = "inferior completo"
NumPuntosXYExclInf = NumPuntosXY
ELSE
CoherenHemisf$ = "superior completo"
END IF
END IF
END IF
RETURN
ContaTrian:
NumLetra = 0: TrianEnLado = -1
'El n£mero de triangulos es igual al n£mero de puntos menos 1
WHILE NumLetra < LEN(Lado$(NumLado))
NumLetra = NumLetra + 1
Letra$ = MID$(Lado$(NumLado), NumLetra, 1)
IF Letra$ = "," THEN
TrianEnLado = TrianEnLado + 1
END IF
WEND
RETURN
CoordCentroCirculo:
'El primer punto es el centro del area inferior
'0 = n£mero punto; 1 = x; 2 = y; 3 = z
SELECT CASE RefCoord$
CASE "e"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto
PuntoEnObjeto(1, 3) = ZObjeto
CASE "ne"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto
CASE "n"
PuntoEnObjeto(1, 1) = XObjeto
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto
CASE "no"
PuntoEnObjeto(1, 1) = XObjeto + TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto
CASE "o"
PuntoEnObjeto(1, 1) = XObjeto + TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto
PuntoEnObjeto(1, 3) = ZObjeto
CASE "so"
PuntoEnObjeto(1, 1) = XObjeto + TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto + TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto
CASE "s"
PuntoEnObjeto(1, 1) = XObjeto
PuntoEnObjeto(1, 2) = YObjeto + TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto
CASE "se"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto + TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto
CASE "egrav"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto
PuntoEnObjeto(1, 3) = ZObjeto - TamObjetoZ / 2
CASE "negrav"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto - TamObjetoZ / 2
CASE "ngrav"
PuntoEnObjeto(1, 1) = XObjeto
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto - TamObjetoZ / 2
CASE "nograv"
PuntoEnObjeto(1, 1) = XObjeto + TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto - TamObjetoZ / 2
CASE "ograv"
PuntoEnObjeto(1, 1) = XObjeto + TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto
PuntoEnObjeto(1, 3) = ZObjeto - TamObjetoZ / 2
CASE "sograv"
PuntoEnObjeto(1, 1) = XObjeto + TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto + TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto - TamObjetoZ / 2
CASE "sgrav"
PuntoEnObjeto(1, 1) = XObjeto
PuntoEnObjeto(1, 2) = YObjeto + TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto - TamObjetoZ / 2
CASE "segrav"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto + TamObjetoY / 2
PuntoEnObjeto(1, 3) = ZObjeto - TamObjetoZ / 2
CASE "cgrav"
PuntoEnObjeto(1, 1) = XObjeto
PuntoEnObjeto(1, 2) = YObjeto
PuntoEnObjeto(1, 3) = ZObjeto - TamObjetoZ / 2
CASE ELSE: 'Entonces se considera el centro del area inferior
PuntoEnObjeto(1, 1) = XObjeto
PuntoEnObjeto(1, 2) = YObjeto
PuntoEnObjeto(1, 3) = ZObjeto
END SELECT
RETURN
CoordCubo:
'El primer punto est en el ngulo SO del area inferior
'0 = n£mero punto; 1 = x; 2 = y; 3 = z
SELECT CASE RefCoord$
CASE "e"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY / 2
CASE "ne"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY
CASE "n"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY
CASE "no"
PuntoEnObjeto(1, 1) = XObjeto
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY
CASE "o"
PuntoEnObjeto(1, 1) = XObjeto
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY / 2
CASE "so"
PuntoEnObjeto(1, 1) = XObjeto
PuntoEnObjeto(1, 2) = YObjeto
CASE "s"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto
CASE "se"
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX
PuntoEnObjeto(1, 2) = YObjeto
CASE ELSE: 'Entonces se considera el centro del area inferior
PuntoEnObjeto(1, 1) = XObjeto - TamObjetoX / 2
PuntoEnObjeto(1, 2) = YObjeto - TamObjetoY / 2
END SELECT
PuntoEnObjeto(2, 1) = PuntoEnObjeto(1, 1) + TamObjetoX
PuntoEnObjeto(3, 1) = PuntoEnObjeto(1, 1) + TamObjetoX
PuntoEnObjeto(4, 1) = PuntoEnObjeto(1, 1)
PuntoEnObjeto(5, 1) = PuntoEnObjeto(1, 1)
PuntoEnObjeto(6, 1) = PuntoEnObjeto(2, 1)
PuntoEnObjeto(7, 1) = PuntoEnObjeto(3, 1)
PuntoEnObjeto(8, 1) = PuntoEnObjeto(4, 1)
PuntoEnObjeto(2, 2) = PuntoEnObjeto(1, 2)
PuntoEnObjeto(3, 2) = PuntoEnObjeto(1, 2) + TamObjetoY
PuntoEnObjeto(4, 2) = PuntoEnObjeto(1, 2) + TamObjetoY
PuntoEnObjeto(5, 2) = PuntoEnObjeto(1, 2)
PuntoEnObjeto(6, 2) = PuntoEnObjeto(2, 2)
PuntoEnObjeto(7, 2) = PuntoEnObjeto(3, 2)
PuntoEnObjeto(8, 2) = PuntoEnObjeto(4, 2)
FOR PuntoCubo = 1 TO 4
PuntoEnObjeto(PuntoCubo, 3) = ZObjeto
NEXT PuntoCubo
FOR PuntoCubo = 5 TO 8
PuntoEnObjeto(PuntoCubo, 3) = ZObjeto + TamObjetoZ
NEXT PuntoCubo
RETURN
CorreccionGrises:
Rojo2 = Rojo: Verde2 = Verde: Azul2 = Azul
Gris = (76 / 255) * Rojo2 + (150 / 255) * Verde2 + (29 / 255) * Azul2
IF Gris > Brillo / maxBrillo THEN
Rojo2 = Rojo2 * ((Brillo / maxBrillo) / Gris)
Verde2 = Verde2 * ((Brillo / maxBrillo) / Gris)
Azul2 = Azul2 * ((Brillo / maxBrillo) / Gris)
ELSE
Rojo2 = 1 - ((1 - Rojo2) * ((1 - (Brillo / maxBrillo)) / (1 - Gris)))
Verde2 = 1 - ((1 - Verde2) * ((1 - (Brillo / maxBrillo)) / (1 - Gris)))
Azul2 = 1 - ((1 - Azul2) * ((1 - (Brillo / maxBrillo)) / (1 - Gris)))
END IF
Rojo = Rojo2: Verde = Verde2: Azul = Azul2
RETURN
CortaMenciones:
NumMenciones = 1: Letra = 0
Mencion$(1) = ""
WHILE Letra < LEN(LineaATratar$)
Letra = Letra + 1: Letra$ = MID$(LineaATratar$, Letra, 1)
IF Letra$ = "," THEN
NumMenciones = NumMenciones + 1
Mencion$(NumMenciones) = ""
ELSE
Mencion$(NumMenciones) = Mencion$(NumMenciones) + Letra$
END IF
WEND
IF Mencion$(NumMenciones) = "" THEN
NumMenciones = NumMenciones - 1
END IF
RETURN
DePolarARect:
CoordDerecha2 = COS(AngDespRota) * DistParaRota
CoordDelante2 = SIN(AngDespRota) * DistParaRota
RETURN
DeRectAPolar:
IF CoordDerecha = 0 AND CoordDelante = 0 THEN
AngAntRota = 0
ELSE
IF ABS(CoordDerecha) >= ABS(CoordDelante) THEN
AngAntRota = ATN(CoordDelante / CoordDerecha)
IF CoordDerecha < 0 THEN AngAntRota = AngAntRota + Pi
ELSE
AngAntRota = ATN(CoordDerecha / CoordDelante)
IF CoordDelante < 0 THEN AngAntRota = AngAntRota + Pi
AngAntRota = Pi / 2 - AngAntRota
END IF
END IF
DistParaRota = SQR(CoordDerecha * CoordDerecha + CoordDelante * CoordDelante)
WHILE AngAntRota > Pi
AngAntRota = AngAntRota - 2 * Pi
WEND
RETURN
EsperaTecla:
Tecla$ = ""
WHILE Tecla$ = ""
Tecla$ = INKEY$
WEND
RETURN
ExclusionCirculo:
ExclusionCirculo$ = MID$(Exclusion$, 2, 4)
SELECT CASE ExclusionCirculo$
CASE "1---"
AnguloInicioRed = 0
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExcl = NumPuntosXY / 4 + 1
CirculoCompleto$ = "no"
CASE "-2--"
AnguloInicioRed = 90
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExcl = NumPuntosXY / 4 + 1
CirculoCompleto$ = "no"
CASE "--3-"
AnguloInicioRed = 180
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExcl = NumPuntosXY / 4 + 1
CirculoCompleto$ = "no"
CASE "---4"
AnguloInicioRed = 270
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExcl = NumPuntosXY / 4 + 1
CirculoCompleto$ = "no"
CASE "12--"
AnguloInicioRed = 0
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExcl = NumPuntosXY / 2 + 1
CirculoCompleto$ = "no"
CASE "-23-"
AnguloInicioRed = 90
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExcl = NumPuntosXY / 2 + 1
CirculoCompleto$ = "no"
CASE "--34"
AnguloInicioRed = 180
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExcl = NumPuntosXY / 2 + 1
CirculoCompleto$ = "no"
CASE "1--4"
AnguloInicioRed = 270
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExcl = NumPuntosXY / 2 + 1
CirculoCompleto$ = "no"
CASE "123-"
AnguloInicioRed = 0
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExcl = 3 * NumPuntosXY / 4 + 1
CirculoCompleto$ = "no"
CASE "-234"
AnguloInicioRed = 90
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExcl = 3 * NumPuntosXY / 4 + 1
CirculoCompleto$ = "no"
CASE "1-34"
AnguloInicioRed = 180
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExcl = 3 * NumPuntosXY / 4 + 1
CirculoCompleto$ = "no"
CASE "12-4"
AnguloInicioRed = 270
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExcl = 3 * NumPuntosXY / 4 + 1
CirculoCompleto$ = "no"
CASE ELSE: 'Entonces se hace un tronco completo
AnguloInicioRed = 0
NumPuntosXYExcl = NumPuntosXY
CirculoCompleto$ = "s¡"
END SELECT
RETURN
ExclusionEsfera:
ExclusionEsferaInf$ = MID$(Exclusion$, 2, 4)
EsferaInf$ = "s¡"
SELECT CASE ExclusionEsferaInf$
CASE "----"
EsferaInf$ = "no"
CASE "1---"
AnguloInicioRedInf = 0
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclInf = NumPuntosXY / 4 + 1
CirculoInfCompleto$ = "no"
CASE "-2--"
AnguloInicioRedInf = 90
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclInf = NumPuntosXY / 4 + 1
CirculoInfCompleto$ = "no"
CASE "--3-"
AnguloInicioRedInf = 180
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclInf = NumPuntosXY / 4 + 1
CirculoInfCompleto$ = "no"
CASE "---4"
AnguloInicioRedInf = 270
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclInf = NumPuntosXY / 4 + 1
CirculoInfCompleto$ = "no"
CASE "12--"
AnguloInicioRedInf = 0
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExclInf = NumPuntosXY / 2 + 1
CirculoInfCompleto$ = "no"
CASE "-23-"
AnguloInicioRedInf = 90
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExclInf = NumPuntosXY / 2 + 1
CirculoInfCompleto$ = "no"
CASE "--34"
AnguloInicioRedInf = 180
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExclInf = NumPuntosXY / 2 + 1
CirculoInfCompleto$ = "no"
CASE "1--4"
AnguloInicioRedInf = 270
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExclInf = NumPuntosXY / 2 + 1
CirculoInfCompleto$ = "no"
CASE "123-"
AnguloInicioRedInf = 0
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclInf = 3 * NumPuntosXY / 4 + 1
CirculoInfCompleto$ = "no"
CASE "-234"
AnguloInicioRedInf = 90
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclInf = 3 * NumPuntosXY / 4 + 1
CirculoInfCompleto$ = "no"
CASE "1-34"
AnguloInicioRedInf = 180
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclInf = 3 * NumPuntosXY / 4 + 1
CirculoInfCompleto$ = "no"
CASE "12-4"
AnguloInicioRedInf = 270
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclInf = 3 * NumPuntosXY / 4 + 1
CirculoInfCompleto$ = "no"
CASE ELSE: 'Entonces se hace un hemisferio completo
ExclusionEsferaInf$ = "1234"
AnguloInicioRedInf = 0
NumPuntosXYExclInf = NumPuntosXY
CirculoInfCompleto$ = "s¡"
END SELECT
ExclusionEsferaSup$ = MID$(Exclusion$, 6, 4)
EsferaSup$ = "s¡"
SELECT CASE ExclusionEsferaSup$
CASE "----"
EsferaSup$ = "no"
CASE "5---"
AnguloInicioRedSup = 0
AnguloInicioRedInf2 = 90
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclSup = NumPuntosXY / 4 + 1
CirculoSupCompleto$ = "no"
CASE "-6--"
AnguloInicioRedSup = 90
AnguloInicioRedInf2 = 180
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclSup = NumPuntosXY / 4 + 1
CirculoSupCompleto$ = "no"
CASE "--7-"
AnguloInicioRedSup = 180
AnguloInicioRedInf2 = 270
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclSup = NumPuntosXY / 4 + 1
CirculoSupCompleto$ = "no"
CASE "---8"
AnguloInicioRedSup = 270
AnguloInicioRedInf2 = 0
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclSup = NumPuntosXY / 4 + 1
CirculoSupCompleto$ = "no"
CASE "56--"
AnguloInicioRedSup = 0
AnguloInicioRedInf2 = -180
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExclSup = NumPuntosXY / 2 + 1
CirculoSupCompleto$ = "no"
CASE "-67-"
AnguloInicioRedSup = 90
AnguloInicioRedInf2 = -90
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExclSup = NumPuntosXY / 2 + 1
CirculoSupCompleto$ = "no"
CASE "--78"
AnguloInicioRedSup = 180
AnguloInicioRedInf2 = 0
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExclSup = NumPuntosXY / 2 + 1
CirculoSupCompleto$ = "no"
CASE "5--8"
AnguloInicioRedSup = 270
AnguloInicioRedInf2 = 90
Valor = NumPuntosXY: GOSUB MultipleDe2
NumPuntosXY = Valor
NumPuntosXYExclSup = NumPuntosXY / 2 + 1
CirculoSupCompleto$ = "no"
CASE "567-"
AnguloInicioRedSup = 0
AnguloInicioRedInf2 = -90
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclSup = 3 * NumPuntosXY / 4 + 1
CirculoSupCompleto$ = "no"
CASE "-678"
AnguloInicioRedSup = 90
AnguloInicioRedInf2 = 0
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclSup = 3 * NumPuntosXY / 4 + 1
CirculoSupCompleto$ = "no"
CASE "5-78"
AnguloInicioRedSup = 180
AnguloInicioRedInf2 = 90
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclSup = 3 * NumPuntosXY / 4 + 1
CirculoSupCompleto$ = "no"
CASE "56-8"
AnguloInicioRedSup = 270
AnguloInicioRedInf2 = 180
Valor = NumPuntosXY: GOSUB MultipleDe4
NumPuntosXY = Valor
NumPuntosXYExclSup = 3 * NumPuntosXY / 4 + 1
CirculoSupCompleto$ = "no"
CASE ELSE: 'Entonces se hace un hemisferio completo
ExclusionEsferaSup$ = "5678"
AnguloInicioRedSup = 0
NumPuntosXYExclSup = NumPuntosXY
CirculoSupCompleto$ = "s¡"
END SELECT
RETURN
ExcluyeSector:
SectoresEsfera$ = LEFT$(SectoresEsfera$, SectorAExcluir) + "-" + RIGHT$(SectoresEsfera$, 10 - SectorAExcluir - 1)
RETURN
GrabaCilindros:
FOR Redondo = 1 TO TotalObjRedondos
LineaATratar$ = LineaLimpia$(Redondo, 1)
GOSUB LimpiaYCortaLinea
Exclusion$ = LineaLimpia$(Redondo, 2)
GOSUB ExclusionCirculo
GOSUB PuntosCilindro
IF LEFT$(Exclusion$, 1) = "0" THEN
GOSUB LadoInferiorRedondo
END IF
GOSUB TroncoCilindro
IF RIGHT$(Exclusion$, 1) = "9" THEN
GOSUB LadoSuperiorRedondo
END IF
NEXT Redondo
GOSUB GrabaTodo
RETURN
GrabaColorCBD:
LineaEscrita$ = "": GOSUB GrabaUnaLinea
Valor = Tono: GOSUB TradValorCadena
LineaEscrita$ = Cadena$ + ","
Valor = Saturacion: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = Brillo: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
RETURN
GrabaColorTextVRML:
IF TipoExportacion$ = "VRML1" THEN
Tono2 = Tono: Saturacion2 = Saturacion: Brillo2 = Brillo
Tono = Tono2: Saturacion = Saturacion2
Brillo = Brillo2 * 2 - 1
Brillo = SGN(Brillo) * ABS(Brillo) ^ 4
Brillo = (Brillo + 1) / 2
'Todo eso para que ambientColor este m s cerca de un gr¡s 50%
GOSUB HsbRgb
LineaEscrita$ = " Material {"
GOSUB GrabaUnaLinea
LineaEscrita$ = " ambientColor [ "
Valor = Rojo: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = Verde: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = Azul: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ", ]"
GOSUB GrabaUnaLinea
Tono = Tono2: Saturacion = Saturacion2: Brillo = Brillo2
GOSUB HsbRgb
LineaEscrita$ = " diffuseColor [ "
Valor = Rojo: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = Verde: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = Azul: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ", ]"
GOSUB GrabaUnaLinea
LineaEscrita$ = " specularColor [ "
Valor = 0: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = 0: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = 0: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ", ]"
GOSUB GrabaUnaLinea
LineaEscrita$ = " shininess [ 0.0, ]"
GOSUB GrabaUnaLinea
LineaEscrita$ = " }"
GOSUB GrabaUnaLinea
Tono = Tono2: Saturacion = Saturacion2: Brillo = Brillo2
GOSUB HsbRgb
IF LEN(Textura$) > 0 THEN
LineaEscrita$ = " Texture2 { filename " + Comilla$ + Textura2$ + Extension$ + Comilla$ + " }"
GOSUB GrabaUnaLinea
END IF
ELSE
Tono2 = Tono: Saturacion2 = Saturacion: Brillo2 = Brillo
LineaEscrita$ = " appearance Appearance {": GOSUB GrabaUnaLinea
LineaEscrita$ = " material Material {"
IF LEN(Textura$) > 0 THEN
LineaEscrita$ = " texture ImageTexture { url " + Comilla$ + Textura2$ + Extension$ + Comilla$ + " }"
GOSUB GrabaUnaLinea
ELSE
Tono = Tono2: Saturacion = Saturacion2: Brillo = Brillo2
GOSUB HsbRgb
LineaEscrita$ = LineaEscrita$ + " diffuseColor "
Valor = Rojo: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = Verde: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = Azul: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " }"
GOSUB GrabaUnaLinea
END IF
LineaEscrita$ = " }": GOSUB GrabaUnaLinea
Tono = Tono2: Saturacion = Saturacion2: Brillo = Brillo2
GOSUB HsbRgb
END IF
RETURN
GrabaConos:
FOR Redondo = 1 TO TotalObjRedondos
LineaATratar$ = LineaLimpia$(Redondo, 1)
GOSUB LimpiaYCortaLinea
Exclusion$ = LineaLimpia$(Redondo, 2)
GOSUB ExclusionCirculo
GOSUB PuntosCono
IF LEFT$(Exclusion$, 1) = "0" THEN
GOSUB LadoInferiorRedondo
END IF
GOSUB LadoSuperiorRedondo
NEXT Redondo
GOSUB GrabaTodo
RETURN
GrabaCubos:
FOR Cubo = 1 TO TotalCubos
FOR a = 1 TO 8
PunCubo$(a) = ""
NEXT a
NumLetra = 0: NumComas = 0
WHILE NumLetra < LEN(LineaLimpia$(Cubo, 1))
NumLetra = NumLetra + 1
Letra$ = MID$(LineaLimpia$(Cubo, 1), NumLetra, 1)
IF Letra$ = "," THEN
NumComas = NumComas + 1
ELSE
PunCubo$(NumComas + 1) = PunCubo$(NumComas + 1) + Letra$
END IF
WEND
NumCuboExcl = Cubo: GOSUB IntrprtExclCubo
IF LadoInf$ <> "no" THEN
LadoRectangular$ = "1,4,3,2": GOSUB GrabaLadoCubo
END IF
IF LadoSur$ <> "no" THEN
LadoRectangular$ = "1,2,6,5": GOSUB GrabaLadoCubo
END IF
IF LadoEste$ <> "no" THEN
LadoRectangular$ = "2,3,7,6": GOSUB GrabaLadoCubo
END IF
IF LadoNorte$ <> "no" THEN
LadoRectangular$ = "3,4,8,7": GOSUB GrabaLadoCubo
END IF
IF LadoOeste$ <> "no" THEN
LadoRectangular$ = "4,1,5,8": GOSUB GrabaLadoCubo
END IF
IF LadoSup$ <> "no" THEN
LadoRectangular$ = "5,6,7,8": GOSUB GrabaLadoCubo
END IF
NEXT Cubo
GOSUB GrabaTodo
RETURN
GrabaEsferas:
FOR Redondo = 1 TO TotalObjRedondos
LineaATratar$ = LineaLimpia$(Redondo, 1)
GOSUB LimpiaYCortaLinea
Exclusion$ = LineaLimpia$(Redondo, 2)
GOSUB ExclusionEsfera
GOSUB ComparaExclHemi
GOSUB GrabaSectoresEsfera
NEXT Redondo
GOSUB GrabaTodo
RETURN
GrabaLadoCubo:
FOR a = 1 TO 4
PunLadoCubo$(a) = ""
NEXT a
NumLetra = 0: NumComas = 0
WHILE NumLetra < LEN(LadoRectangular$)
NumLetra = NumLetra + 1
Letra$ = MID$(LadoRectangular$, NumLetra, 1)
IF Letra$ = "," THEN
NumComas = NumComas + 1
ELSE
PunLadoCubo$(NumComas + 1) = PunLadoCubo$(NumComas + 1) + Letra$
END IF
WEND
TotalLados = TotalLados + 1: Lado$(TotalLados) = ""
FOR a = 1 TO 3
Lado$(TotalLados) = Lado$(TotalLados) + PunCubo$(VAL(PunLadoCubo$(a))) + ","
NEXT a
Lado$(TotalLados) = Lado$(TotalLados) + PunCubo$(VAL(PunLadoCubo$(a)))
NumLado = TotalLados: GOSUB ContaTrian
TotalLadosTrian = TotalLadosTrian + TrianEnLado
RETURN
GrabaLadoRectangular:
TotalLados = TotalLados + 1
TotalLadosTrian = TotalLadosTrian + 2
Valor = Punto1: GOSUB TradValorCadena: Punto1$ = Cadena$
Valor = Punto2: GOSUB TradValorCadena: Punto2$ = Cadena$
Valor = Punto3: GOSUB TradValorCadena: Punto3$ = Cadena$
Valor = Punto4: GOSUB TradValorCadena: Punto4$ = Cadena$
Lado$(TotalLados) = Punto1$ + "," + Punto2$ + "," + Punto3$ + "," + Punto4$
RETURN
GrabaLadoTriangular:
TotalLados = TotalLados + 1
TotalLadosTrian = TotalLadosTrian + 1
Valor = Punto1: GOSUB TradValorCadena: Punto1$ = Cadena$
Valor = Punto2: GOSUB TradValorCadena: Punto2$ = Cadena$
Valor = Punto3: GOSUB TradValorCadena: Punto3$ = Cadena$
Lado$(TotalLados) = Punto1$ + "," + Punto2$ + "," + Punto3$
RETURN
GrabaLados:
SELECT CASE TipoExportacion$
CASE "3D Studio"
LineaEscrita$ = "Face list:"
GOSUB GrabaUnaLinea
NumLadoTrian = -1: '3D Studio empieza a contar por 0
FOR NumLado = 1 TO TotalLados
GOSUB InterpretaLado
GOSUB ProdLado3DStudio
NEXT NumLado
CASE "VRML1"
GOSUB LadosVRML1y2
CASE "VRML2"
GOSUB LadosVRML1y2
CASE "Caligari"
Valor = TotalLadosTrian: GOSUB TradValorCadena
LineaEscrita$ = "Faces " + Cadena$
GOSUB GrabaUnaLinea
FOR NumLado = 1 TO TotalLados
GOSUB InterpretaLado
GOSUB ProduceLadoCaligari
NEXT NumLado
Valor = IdCaligari + 1: GOSUB TradValorCadena
LineaEscrita$ = "Unit V0.01 Id " + Cadena$ + " Parent "
Valor = IdCaligari: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " Size 00000009": GOSUB GrabaUnaLinea
LineaEscrita$ = "Units 2": GOSUB GrabaUnaLinea
Valor = IdCaligari: GOSUB TradValorCadena
LineaEscrita$ = "Mat1 V0.05 Id 2156012 Parent " + Cadena$ + " Size 00000109": GOSUB GrabaUnaLinea
LineaEscrita$ = "mat# 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "shader: phong facet: auto32": GOSUB GrabaUnaLinea
LineaEscrita$ = "rgb "
Valor = Rojo: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = Verde: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = Azul: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
GOSUB GrabaUnaLinea
LineaEscrita$ = "alpha 1 ka 0.1 ks 0.1 exp 0 ior 1": GOSUB GrabaUnaLinea
IF LEN(Textura$) = 0 THEN
LineaEscrita$ = "texture: "
ELSE
LineaEscrita$ = "texture: " + Camino$ + Textura2$ + Extension$ + " "
END IF
GOSUB GrabaUnaLinea
LineaEscrita$ = "offset 0,0 repeats 1,1 flags 2"
GOSUB GrabaUnaLinea
CASE "S3D"
LineaEscrita$ = " ®MOIN¯" + Nombre$ + "®MONM¯"
GOSUB GrabaUnaLinea
FOR NumLado = 1 TO TotalLados
GOSUB InterpretaLado
GOSUB ProduceLadoS3D
NEXT NumLado
CASE "CBD"
LineaEscrita$ = ""
GOSUB GrabaUnaLinea
FOR NumLado = 1 TO TotalLados
GOSUB InterpretaLado
GOSUB ProduceLadoCBD
NEXT NumLado
LineaEscrita$ = ""
GOSUB GrabaUnaLinea
CASE ELSE
END SELECT
RETURN
GrabaParalelo:
FOR PuntoCirculo = 1 TO NumPuntosXYExcl - 1
NumPunto = NumPunto + 1
Punto1 = NumPunto
Punto2 = NumPunto + 1
Punto3 = Punto2 + NumPuntosXYExcl
Punto4 = Punto1 + NumPuntosXYExcl
GOSUB GrabaLadoRectangular
NEXT PuntoCirculo
IF CirculoCompleto$ = "s¡" THEN
NumPunto = NumPunto + 1
Punto1 = NumPunto
Punto2 = Punto1ParaleloAnt
Punto3 = Punto2 + NumPuntosXYExcl
Punto4 = Punto1 + NumPuntosXYExcl
GOSUB GrabaLadoRectangular
END IF
RETURN
GrabaPuntos:
SELECT CASE TipoExportacion$
CASE "3D Studio"
LineaEscrita$ = "Named object: " + Comilla$ + Nombre$ + Comilla$
GOSUB GrabaUnaLinea
LineaEscrita$ = "Tri-mesh, Vertices: "
Valor = TotalPuntos: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " Faces: "
Valor = TotalLadosTrian: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
GOSUB GrabaUnaLinea
LineaEscrita$ = "Vertex list:"
GOSUB GrabaUnaLinea
FOR NumPuntExp = 1 TO TotalPuntos
LineaEscrita$ = "Vertex "
Valor = NumPuntExp - 1: '3D Studio empieza por 0 y no por 1
GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ": X: "
Valor = Punto(NumPuntExp, 1): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " Y: "
Valor = Punto(NumPuntExp, 2): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " Z: "
Valor = Punto(NumPuntExp, 3): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
GOSUB GrabaUnaLinea
NEXT NumPuntExp
CASE "VRML1"
GOSUB PuntosVRML1y2
CASE "VRML2"
GOSUB PuntosVRML1y2
CASE "Caligari"
IdCaligari = 2160000 + TotalObjetos * 2
Valor = IdCaligari: GOSUB TradValorCadena
LineaEscrita$ = "PolH V0.02 Id " + Cadena$ + " Parent 2156520 Size 00000500": GOSUB GrabaUnaLinea
LineaEscrita$ = "Name " + Nombre$: GOSUB GrabaUnaLinea
LineaEscrita$ = "center 0 0 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "x axis 1 0 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "y axis 0 1 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "z axis 0 0 1": GOSUB GrabaUnaLinea
LineaEscrita$ = "Transform": GOSUB GrabaUnaLinea
LineaEscrita$ = "1 0 0 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "0 1 0 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "0 0 1 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "0 0 0 1": GOSUB GrabaUnaLinea
Valor = TotalPuntos: GOSUB TradValorCadena
LineaEscrita$ = "World Vertices " + Cadena$: GOSUB GrabaUnaLinea
FOR NumPuntExp = 1 TO TotalPuntos
Valor = Punto(NumPuntExp, 1): GOSUB TradValorCadena
LineaEscrita$ = Cadena$ + " "
Valor = Punto(NumPuntExp, 2): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = Punto(NumPuntExp, 3): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
GOSUB GrabaUnaLinea
NEXT NumPuntExp
IF LEN(Textura$) = 0 THEN
LineaEscrita$ = "Texture Vertices 1": GOSUB GrabaUnaLinea
LineaEscrita$ = "0 0": GOSUB GrabaUnaLinea
ELSE
Valor = TotalPuntosText: GOSUB TradValorCadena
LineaEscrita$ = "Texture Vertices " + Cadena$: GOSUB GrabaUnaLinea
FOR NumPuntExp = 1 TO TotalPuntosText
Valor = PuntoTextura(NumPuntExp, 1): GOSUB TradValorCadena
LineaEscrita$ = Cadena$ + " "
Valor = PuntoTextura(NumPuntExp, 2): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
GOSUB GrabaUnaLinea
NEXT NumPuntExp
END IF
CASE "CBD"
LineaEscrita$ = ""
GOSUB GrabaUnaLinea
LineaEscrita$ = Nombre$
GOSUB GrabaUnaLinea
LineaEscrita$ = ""
GOSUB GrabaUnaLinea
LineaEscrita$ = ""
GOSUB GrabaUnaLinea
FOR NumPuntExp = 1 TO TotalPuntos
Valor = NumPuntExp: GOSUB TradValorCadena
LineaEscrita$ = Cadena$ + ","
Valor = Punto(NumPuntExp, 1): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = Punto(NumPuntExp, 2): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = Punto(NumPuntExp, 3): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
GOSUB GrabaUnaLinea
NEXT NumPuntExp
LineaEscrita$ = ""
GOSUB GrabaUnaLinea
CASE ELSE
END SELECT
RETURN
GrabaPuntosText:
IF TipoExportacion$ = "CBD" THEN
LineaEscrita$ = "": GOSUB GrabaUnaLinea
FOR NumPuntExp = 1 TO TotalPuntosText
Valor = NumPuntExp: GOSUB TradValorCadena
LineaEscrita$ = Cadena$ + ","
Valor = PuntoTextura(NumPuntExp, 1): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = PuntoTextura(NumPuntExp, 2): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
GOSUB GrabaUnaLinea
NEXT NumPuntExp
LineaEscrita$ = "": GOSUB GrabaUnaLinea
END IF
RETURN
GrabaSectoresEsfera:
SELECT CASE CoherenHemisf$
CASE "inferior no m s"
Valor = NumPuntosZ
GOSUB NumImparParalelos
AnguloInicioRed = AnguloInicioRedInf
NumPuntosXYExcl = NumPuntosXYExclInf
CirculoCompleto$ = CirculoInfCompleto$
GOSUB PuntoBaseEsfera
Punto1InfRed = TotalPuntos + 1
PrimerParalelo = 1
UltimoParalelo = (NumPuntosZ - 1) / 2
GOSUB PuntosTroncoEsfera
PuntoUltSupRed = TotalPuntos
GOSUB LadoInferiorRedondo
PrimerParalelo = 1
UltimoParalelo = (NumPuntosZ - 1) / 2 - 1
GOSUB TroncoEsfera
CASE "superior no m s"
Valor = NumPuntosZ
GOSUB NumImparParalelos
AnguloInicioRed = AnguloInicioRedSup
NumPuntosXYExcl = NumPuntosXYExclSup
CirculoCompleto$ = CirculoSupCompleto$
Punto1InfRed = TotalPuntos + 1
PrimerParalelo = (NumPuntosZ - 1) / 2
UltimoParalelo = NumPuntosZ - 2
GOSUB PuntosTroncoEsfera
PuntoUltSupRed = TotalPuntos
GOSUB PuntoCumbreEsfera
PrimerParalelo = (NumPuntosZ - 1) / 2
UltimoParalelo = NumPuntosZ - 3
GOSUB TroncoEsfera
GOSUB LadoSuperiorRedondo
CASE "inferior completo"
Valor = NumPuntosZ
GOSUB NumImparParalelos
AnguloInicioRed = AnguloInicioRedInf2 + 360 / NumPuntosXY
NumPuntosXYExcl = NumPuntosXYExclInf
CirculoCompleto$ = CirculoInfCompleto$
GOSUB PuntoBaseEsfera
Punto1InfRed = TotalPuntos + 1
PrimerParalelo = 1
UltimoParalelo = (NumPuntosZ - 1) / 2
GOSUB PuntosTroncoEsfera
AnguloInicioRed = AnguloInicioRedSup
NumPuntosXYExcl = NumPuntosXYExclSup
CirculoCompleto$ = CirculoSupCompleto$
PrimerParalelo = (NumPuntosZ - 1) / 2
UltimoParalelo = NumPuntosZ - 2
TotalPuntos = TotalPuntos - NumPuntosXYExclSup
Punto1InfRed2 = TotalPuntos + 1
GOSUB PuntosTroncoEsfera
PuntoUltSupRed = TotalPuntos
GOSUB PuntoCumbreEsfera
NumPuntosXYExcl = NumPuntosXYExclInf
CirculoCompleto$ = CirculoInfCompleto$
GOSUB LadoInferiorRedondo
PrimerParalelo = 1
UltimoParalelo = (NumPuntosZ - 1) / 2 - 1
GOSUB TroncoEsfera
NumPuntosXYExcl = NumPuntosXYExclSup
CirculoCompleto$ = CirculoSupCompleto$
PrimerParalelo = (NumPuntosZ - 1) / 2
UltimoParalelo = NumPuntosZ - 3
Punto1InfRed = Punto1InfRed2
GOSUB TroncoEsfera
GOSUB LadoSuperiorRedondo
CASE "superior completo"
Valor = NumPuntosZ
GOSUB NumImparParalelos
AnguloInicioRed = AnguloInicioRedInf
NumPuntosXYExcl = NumPuntosXYExclInf
CirculoCompleto$ = CirculoInfCompleto$
GOSUB PuntoBaseEsfera
Punto1InfRed = TotalPuntos + 1
PrimerParalelo = 1
UltimoParalelo = (NumPuntosZ - 1) / 2
GOSUB PuntosTroncoEsfera
Punto1InfRed2 = TotalPuntos - NumPuntosXYExclInf + 1
NumPuntosXYExcl = NumPuntosXYExclSup
CirculoCompleto$ = CirculoSupCompleto$
PrimerParalelo = (NumPuntosZ - 1) / 2
UltimoParalelo = NumPuntosZ - 2
TotalPuntos = TotalPuntos - NumPuntosXYExclInf
GOSUB PuntosTroncoEsfera
PuntoUltSupRed = TotalPuntos
GOSUB PuntoCumbreEsfera
NumPuntosXYExcl = NumPuntosXYExclInf
CirculoCompleto$ = CirculoInfCompleto$
GOSUB LadoInferiorRedondo
PrimerParalelo = 1
UltimoParalelo = (NumPuntosZ - 1) / 2 - 1
GOSUB TroncoEsfera
NumPuntosXYExcl = NumPuntosXYExclSup
CirculoCompleto$ = CirculoSupCompleto$
PrimerParalelo = (NumPuntosZ - 1) / 2
UltimoParalelo = NumPuntosZ - 3
Punto1InfRed = Punto1InfRed2
GOSUB TroncoEsfera
GOSUB LadoSuperiorRedondo
CASE ELSE
'Por defecto, los dos hemisferios se consideran iguales
AnguloInicioRed = AnguloInicioRedInf
NumPuntosXYExcl = NumPuntosXYExclInf
CirculoCompleto$ = CirculoInfCompleto$
GOSUB PuntosEsfera
GOSUB LadoInferiorRedondo
PrimerParalelo = 1
UltimoParalelo = NumPuntosZ - 3
GOSUB TroncoEsfera
GOSUB LadoSuperiorRedondo
END SELECT
RETURN
GrabaTextura:
IF TipoExportacion$ = "CBD" THEN
LineaEscrita$ = "": GOSUB GrabaUnaLinea
LineaEscrita$ = Camino$ + Archivo2$ + Extension$: GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
END IF
RETURN
GrabaTodo:
IF NombreBasico$ = "" THEN NombreBasico$ = "Objeto"
IF Nombre$ = NombreAnt$ THEN
Valor = TotalObjetos2: GOSUB TradValorCadena
Nombre$ = NombreBasico$ + Cadena$
END IF
NombreAnt$ = Nombre$
GOSUB IntegraModifCoord
IF TipoExportacion$ <> "S3D" THEN
IF TotalPuntos > 0 THEN
GOSUB GrabaPuntos
END IF
END IF
IF TotalPuntos > 0 THEN
GOSUB GrabaLados
END IF
RETURN
GrabaUnaLinea:
wLineasEscritas = wLineasEscritas + 1
LOCATE 1, 41: PRINT "Written lines ="; wLineasEscritas;
LineaEscrita$ = LineaEscrita$ + CHR$(13) + CHR$(10)
FOR a = 1 TO LEN(LineaEscrita$)
wByteEscrito = wByteEscrito + 1
LSET e$ = MID$(LineaEscrita$, a, 1)
PUT #2, wByteEscrito
NEXT a
LineaEscrita$ = ""
RETURN
HsbRgb:
'Conversi¢n de HSB (Hue, Saturation, Brightness o Tono, Saturaci¢n, Brillo)
'a RGB (Red, Green, Blue o Rojo, Verde, Azul)
IF Brillo <= 0 THEN Brillo = .0001
IF Brillo >= maxBrillo THEN Brillo = maxBrillo * .9999
IF Saturacion <= 0 THEN Saturacion = .0001
IF Saturacion >= maxSaturacion THEN Saturacion = maxSaturacion * .9999
SectorTono = INT(Tono / (maxTono / 6))
IF SectorTono = 6 THEN SectorTono = 5
AngColorRad = Tono * 2 * Pi / maxTono
SELECT CASE SectorTono
CASE 0
Rojo = 1
Azul = 0
Verde = (1 - COS(AngColorRad * 3)) / 2
CASE 1
Verde = 1
Azul = 0
Rojo = (1 - COS(AngColorRad * 3)) / 2
CASE 2
Verde = 1
Rojo = 0
Azul = (1 - COS(AngColorRad * 3)) / 2
CASE 3
Azul = 1
Rojo = 0
Verde = (1 - COS(AngColorRad * 3)) / 2
CASE 4
Azul = 1
Verde = 0
Rojo = (1 - COS(AngColorRad * 3)) / 2
CASE 5
Rojo = 1
Verde = 0
Azul = (1 - COS(AngColorRad * 3)) / 2
CASE ELSE
END SELECT
Rojo = Rojo * Saturacion / maxSaturacion + .5 * (1 - (Saturacion / maxSaturacion))
Verde = Verde * Saturacion / maxSaturacion + .5 * (1 - (Saturacion / maxSaturacion))
Azul = Azul * Saturacion / maxSaturacion + .5 * (1 - (Saturacion / maxSaturacion))
GOSUB CorreccionGrises
IF Rojo > 1 THEN Rojo = 1
IF Verde > 1 THEN Verde = 1
IF Azul > 1 THEN Azul = 1
Valor = INT((1 - Brillo) * 100 + .5): GOSUB TradValorCadena
Gris$ = Cadena$
IF LEN(Gris$) > 2 THEN Gris$ = "99"
IF LEN(Gris$) = 1 THEN Gris$ = "0" + Gris$
RETURN
InicioCaligari:
GOSUB InicioNormal
LineaEscrita$ = "Caligari V00.01ALH ": GOSUB GrabaUnaLinea
LineaEscrita$ = "Grou V0.01 Id 2156520 Parent 0 Size 00000109": GOSUB GrabaUnaLinea
LineaEscrita$ = "Name NoName,1": GOSUB GrabaUnaLinea
LineaEscrita$ = "center 0 0 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "x axis 1 0 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "y axis 0 1 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "z axis 0 0 1": GOSUB GrabaUnaLinea
LineaEscrita$ = "Transform": GOSUB GrabaUnaLinea
LineaEscrita$ = "1 0 0 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "0 1 0 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "0 0 1 0": GOSUB GrabaUnaLinea
LineaEscrita$ = "0 0 0 1": GOSUB GrabaUnaLinea
LineaEscrita$ = "Unit V0.01 Id 2156521 Parent 2156520 Size 00000009": GOSUB GrabaUnaLinea
LineaEscrita$ = "Units 2": GOSUB GrabaUnaLinea
CLS
RETURN
InicioNormal:
OPEN "R", #2, ArchivoEscrito$, 1
FIELD #2, 1 AS e$
wByteEscrito = 0
CLS
RETURN
InicioVRML:
GOSUB InicioNormal
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = "#VRML V1.0 ascii": GOSUB GrabaUnaLinea
ELSE
LineaEscrita$ = "#VRML V2.0 utf8": GOSUB GrabaUnaLinea
END IF
LineaEscrita$ = "#produced according to Jean-Luc Ancey's method": GOSUB GrabaUnaLinea
LineaEscrita$ = "#find information on": GOSUB GrabaUnaLinea
LineaEscrita$ = "#http://www.geocities.com/SiliconValley/Way/4179/VrCocha.htm": GOSUB GrabaUnaLinea
LineaEscrita$ = "#email jlancey@rocketmail.com": GOSUB GrabaUnaLinea
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = "DEF BackgroundColor Info {": GOSUB GrabaUnaLinea
LineaEscrita$ = " string " + Comilla$ + ".4 .66 1" + Comilla$: GOSUB GrabaUnaLinea
LineaEscrita$ = "}": GOSUB GrabaUnaLinea
LineaEscrita$ = "DEF Viewer Info {": GOSUB GrabaUnaLinea
LineaEscrita$ = " string " + Comilla$ + "walk" + Comilla$: GOSUB GrabaUnaLinea
LineaEscrita$ = "}": GOSUB GrabaUnaLinea
LineaEscrita$ = "MaterialBinding {": GOSUB GrabaUnaLinea
LineaEscrita$ = " value PER_FACE_INDEXED": GOSUB GrabaUnaLinea
LineaEscrita$ = "}": GOSUB GrabaUnaLinea
ELSE
LineaEscrita$ = "Background { skyColor 0.79 0.94 0.98 }": GOSUB GrabaUnaLinea
END IF
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = "Separator {": GOSUB GrabaUnaLinea
ELSE
LineaEscrita$ = "Group { children [": GOSUB GrabaUnaLinea
END IF
CLS
RETURN
IntegraModifCoord:
IF NivelModif > NivelModifRec THEN
NivelModifRec = NivelModif
LOCATE 2, 63: PRINT "Record ="; NivelModifRec
END IF
FOR NivelModif2 = NivelModif TO 1 STEP -1
FOR ModifCoord = 1 TO NumModifCoord
IF NivelModif(ModifCoord) = NivelModif2 THEN
ModifCoord$ = ModifCoord$(ModifCoord)
IF LEN(ModifCoord$) > 4 THEN
'Este por si acaso hubiera una linea vac¡a
GOSUB IntegraModifParticular
END IF
END IF
NEXT ModifCoord
NEXT NivelModif2
RETURN
IntegraModifParticular:
IF LEFT$(ModifCoord$, 4) = "posi" THEN
LineaATratar$ = ModifCoord$
GOSUB LimpiaComas: GOSUB CortaMenciones
DeltaX = VAL(Mencion$(1))
DeltaY = VAL(Mencion$(2))
DeltaZ = VAL(Mencion$(3))
FOR NumPuntExp = 1 TO TotalPuntos
Punto(NumPuntExp, 1) = Punto(NumPuntExp, 1) + DeltaX
Punto(NumPuntExp, 2) = Punto(NumPuntExp, 2) + DeltaY
Punto(NumPuntExp, 3) = Punto(NumPuntExp, 3) + DeltaZ
NEXT NumPuntExp
END IF
IF LEFT$(ModifCoord$, 4) = "tama" THEN
LineaATratar$ = ModifCoord$
GOSUB LimpiaComas: GOSUB CortaMenciones
FactorX = VAL(Mencion$(1))
FactorY = VAL(Mencion$(2))
FactorZ = VAL(Mencion$(3))
FOR NumPuntExp = 1 TO TotalPuntos
Punto(NumPuntExp, 1) = Punto(NumPuntExp, 1) * FactorX
Punto(NumPuntExp, 2) = Punto(NumPuntExp, 2) * FactorY
Punto(NumPuntExp, 3) = Punto(NumPuntExp, 3) * FactorZ
NEXT NumPuntExp
END IF
IF LEFT$(ModifCoord$, 4) = "rotx" THEN
NumCoordDerecha = 2: NumCoordDelante = 3
GOSUB Rotacion
END IF
IF LEFT$(ModifCoord$, 4) = "roty" THEN
NumCoordDerecha = 3: NumCoordDelante = 1
GOSUB Rotacion
END IF
IF LEFT$(ModifCoord$, 4) = "rotz" THEN
NumCoordDerecha = 1: NumCoordDelante = 2
GOSUB Rotacion
END IF
RETURN
InterpretaCubo:
LineaATratar$ = LineaLeida$
GOSUB LimpiaYCortaLinea
GOSUB CoordCubo
TotalCubos = TotalCubos + 1
Cubo$ = ""
LineaLimpia$(TotalCubos, 2) = Exclusion$
NumCuboExcl = TotalCubos: GOSUB IntrprtExclCubo
FOR PuntoCubo = 1 TO 8
SELECT CASE PuntoCubo
CASE 1
ExclCubo1$ = LadoInf$: ExclCubo2$ = LadoSur$: ExclCubo3$ = LadoOeste$
CASE 2
ExclCubo1$ = LadoInf$: ExclCubo2$ = LadoSur$: ExclCubo3$ = LadoEste$
CASE 3
ExclCubo1$ = LadoInf$: ExclCubo2$ = LadoNorte$: ExclCubo3$ = LadoEste$
CASE 4
ExclCubo1$ = LadoInf$: ExclCubo2$ = LadoNorte$: ExclCubo3$ = LadoOeste$
CASE 5
ExclCubo1$ = LadoSup$: ExclCubo2$ = LadoSur$: ExclCubo3$ = LadoOeste$
CASE 6
ExclCubo1$ = LadoSup$: ExclCubo2$ = LadoSur$: ExclCubo3$ = LadoEste$
CASE 7
ExclCubo1$ = LadoSup$: ExclCubo2$ = LadoNorte$: ExclCubo3$ = LadoEste$
CASE 8
ExclCubo1$ = LadoSup$: ExclCubo2$ = LadoNorte$: ExclCubo3$ = LadoOeste$
CASE ELSE
CLS : PRINT "Algo no funcion¢ con las exclusiones de un cubo.": END
END SELECT
IF ExclCubo1$ = "s¡" OR ExclCubo2$ = "s¡" OR ExclCubo3$ = "s¡" THEN
'Cuidado, "s¡" quiere decir que el lado existe, no que est excluido
TotalPuntos = TotalPuntos + 1
Valor = TotalPuntos: GOSUB TradValorCadena
Cubo$ = Cubo$ + Cadena$
Punto(TotalPuntos, 1) = PuntoEnObjeto(PuntoCubo, 1)
Punto(TotalPuntos, 2) = PuntoEnObjeto(PuntoCubo, 2)
Punto(TotalPuntos, 3) = PuntoEnObjeto(PuntoCubo, 3)
ELSE
Cubo$ = Cubo$ + "0"
END IF
IF PuntoCubo <> 8 THEN
Cubo$ = Cubo$ + ","
END IF
NEXT PuntoCubo
LineaLimpia$(TotalCubos, 1) = Cubo$
RETURN
InterpretaLado:
'Interpreta una l¡nea de descripci¢n de lado
NumLetra = 0: TotalPuntEnLado = 0
NumeroPunto$ = ""
WHILE NumLetra < LEN(Lado$(NumLado))
NumLetra = NumLetra + 1
Letra$ = MID$(Lado$(NumLado), NumLetra, 1)
IF Letra$ = "," THEN
TotalPuntEnLado = TotalPuntEnLado + 1
PuntoEnLado(TotalPuntEnLado) = VAL(NumeroPunto$)
NumeroPunto$ = ""
ELSE
NumeroPunto$ = NumeroPunto$ + Letra$
END IF
WEND
'Hay que pensar en el £ltimo punto, que no es seguido por una coma
TotalPuntEnLado = TotalPuntEnLado + 1
PuntoEnLado(TotalPuntEnLado) = VAL(NumeroPunto$)
RETURN
InterpretaNombreArchivo:
Camino$ = "": Extension$ = "": Archivo2$ = "": TipoTexto$ = "Extensi¢n"
NumLetra = LEN(Archivo$)
WHILE NumLetra > 0
Letra$ = MID$(Archivo$, NumLetra, 1)
IF TipoTexto$ = "Extensi¢n" THEN Extension$ = Letra$ + Extension$
IF Letra$ = "." THEN
TipoTexto$ = "Archivo"
ELSE
IF Letra$ = "\" THEN TipoTexto$ = "Camino"
IF TipoTexto$ = "Archivo" THEN Archivo2$ = Letra$ + Archivo2$
IF TipoTexto$ = "Camino" THEN Camino$ = Letra$ + Camino$
END IF
NumLetra = NumLetra - 1
WEND
RETURN
InterpretaRedondo:
LineaATratar$ = LineaLeida$
GOSUB LimpiaYCortaLinea
GOSUB CoordCentroCirculo
GOSUB LeeExclEsfera
TotalObjRedondos = TotalObjRedondos + 1
LineaLimpia$ = "posi "
Valor = PuntoEnObjeto(1, 1): GOSUB TradValorCadena: LineaLimpia$ = LineaLimpia$ + Cadena$ + ","
Valor = PuntoEnObjeto(1, 2): GOSUB TradValorCadena: LineaLimpia$ = LineaLimpia$ + Cadena$ + ","
Valor = PuntoEnObjeto(1, 3): GOSUB TradValorCadena: LineaLimpia$ = LineaLimpia$ + Cadena$
LineaLimpia$ = LineaLimpia$ + " tama "
Valor = TamObjetoX: GOSUB TradValorCadena: LineaLimpia$ = LineaLimpia$ + Cadena$ + ","
Valor = TamObjetoY: GOSUB TradValorCadena: LineaLimpia$ = LineaLimpia$ + Cadena$ + ","
Valor = TamObjetoZ: GOSUB TradValorCadena: LineaLimpia$ = LineaLimpia$ + Cadena$
LineaLimpia$ = LineaLimpia$ + " punt "
Valor = NumPuntosXY: GOSUB TradValorCadena: LineaLimpia$ = LineaLimpia$ + Cadena$ + ","
Valor = NumPuntosZ: GOSUB TradValorCadena: LineaLimpia$ = LineaLimpia$ + Cadena$
LineaLimpia$(TotalObjRedondos, 1) = LineaLimpia$
LineaLimpia$(TotalObjRedondos, 2) = SectoresEsfera$
RETURN
IntrprtExclCubo:
LineaATratar$ = LineaLimpia$(NumCuboExcl, 2): GOSUB CortaMenciones
LadoInf$ = "s¡": LadoNorte$ = "s¡": LadoSur$ = "s¡"
LadoEste$ = "s¡": LadoOeste$ = "s¡": LadoSup$ = "s¡"
FOR Mencion = 1 TO NumMenciones
IF Mencion$(Mencion) = "inf" THEN LadoInf$ = "no"
IF Mencion$(Mencion) = "n" THEN LadoNorte$ = "no"
IF Mencion$(Mencion) = "s" THEN LadoSur$ = "no"
IF Mencion$(Mencion) = "e" THEN LadoEste$ = "no"
IF Mencion$(Mencion) = "o" THEN LadoOeste$ = "no"
IF Mencion$(Mencion) = "sup" THEN LadoSup$ = "no"
NEXT Mencion
RETURN
LadoInferiorRedondo:
NumPunto = CentroInfRed
Punto1 = CentroInfRed
FOR PuntoCirculo = 1 TO NumPuntosXYExcl - 1
NumPunto = NumPunto + 1
Punto2 = NumPunto + 1
Punto3 = NumPunto
GOSUB GrabaLadoTriangular
NEXT PuntoCirculo
IF CirculoCompleto$ = "s¡" THEN
NumPunto = NumPunto + 1
Punto2 = Punto1InfRed
Punto3 = NumPunto
GOSUB GrabaLadoTriangular
END IF
RETURN
LadoSuperiorRedondo:
NumPunto = Punto1SupRed - 1
Punto1 = CentroSupRed
FOR PuntoCirculo = 1 TO NumPuntosXYExcl - 1
NumPunto = NumPunto + 1
Punto2 = NumPunto
Punto3 = NumPunto + 1
GOSUB GrabaLadoTriangular
NEXT PuntoCirculo
IF CirculoCompleto$ = "s¡" THEN
NumPunto = NumPunto + 1
Punto2 = NumPunto
Punto3 = Punto1SupRed
GOSUB GrabaLadoTriangular
END IF
RETURN
LadosVRML1y2:
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = " IndexedFaceSet {"
GOSUB GrabaUnaLinea
END IF
FOR NumLado = 1 TO TotalLados
GOSUB InterpretaLado
GOSUB ProduceLadoVRML
NEXT NumLado
IF LEN(Textura$) > 0 THEN
FOR NumLado = 1 TO TotalLados
GOSUB InterpretaLado
GOSUB ProduceLadoTextVRML
NEXT NumLado
END IF
LineaEscrita$ = " }": GOSUB GrabaUnaLinea
LineaEscrita$ = " }": GOSUB GrabaUnaLinea
RETURN
LeeExclEsfera:
SectoresEsfera$ = "0123456789"
LineaATratar$ = Exclusion$: GOSUB CortaMenciones
FOR Mencion = 1 TO NumMenciones
IF Mencion$(Mencion) = "inf" THEN
IF TipoDeAccion$ = "esferas" THEN
SectorAExcluir = 1: GOSUB ExcluyeSector
SectorAExcluir = 2: GOSUB ExcluyeSector
SectorAExcluir = 3: GOSUB ExcluyeSector
SectorAExcluir = 4: GOSUB ExcluyeSector
ELSE
SectorAExcluir = 0: GOSUB ExcluyeSector
END IF
END IF
IF Mencion$(Mencion) = "ninf" THEN
SectorAExcluir = 1: GOSUB ExcluyeSector
SectorAExcluir = 2: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "sinf" THEN
SectorAExcluir = 3: GOSUB ExcluyeSector
SectorAExcluir = 4: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "einf" THEN
SectorAExcluir = 1: GOSUB ExcluyeSector
SectorAExcluir = 4: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "oinf" THEN
SectorAExcluir = 2: GOSUB ExcluyeSector
SectorAExcluir = 3: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "neinf" THEN
SectorAExcluir = 1: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "noinf" THEN
SectorAExcluir = 2: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "soinf" THEN
SectorAExcluir = 3: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "seinf" THEN
SectorAExcluir = 4: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "n" THEN
SectorAExcluir = 1: GOSUB ExcluyeSector
SectorAExcluir = 2: GOSUB ExcluyeSector
SectorAExcluir = 5: GOSUB ExcluyeSector
SectorAExcluir = 6: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "s" THEN
SectorAExcluir = 3: GOSUB ExcluyeSector
SectorAExcluir = 4: GOSUB ExcluyeSector
SectorAExcluir = 7: GOSUB ExcluyeSector
SectorAExcluir = 8: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "e" THEN
SectorAExcluir = 1: GOSUB ExcluyeSector
SectorAExcluir = 4: GOSUB ExcluyeSector
SectorAExcluir = 5: GOSUB ExcluyeSector
SectorAExcluir = 8: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "o" THEN
SectorAExcluir = 2: GOSUB ExcluyeSector
SectorAExcluir = 3: GOSUB ExcluyeSector
SectorAExcluir = 6: GOSUB ExcluyeSector
SectorAExcluir = 7: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "ne" THEN
SectorAExcluir = 1: GOSUB ExcluyeSector
SectorAExcluir = 5: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "no" THEN
SectorAExcluir = 2: GOSUB ExcluyeSector
SectorAExcluir = 6: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "so" THEN
SectorAExcluir = 3: GOSUB ExcluyeSector
SectorAExcluir = 7: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "se" THEN
SectorAExcluir = 4: GOSUB ExcluyeSector
SectorAExcluir = 8: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "nsup" THEN
SectorAExcluir = 5: GOSUB ExcluyeSector
SectorAExcluir = 6: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "ssup" THEN
SectorAExcluir = 7: GOSUB ExcluyeSector
SectorAExcluir = 8: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "esup" THEN
SectorAExcluir = 5: GOSUB ExcluyeSector
SectorAExcluir = 8: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "osup" THEN
SectorAExcluir = 6: GOSUB ExcluyeSector
SectorAExcluir = 7: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "nesup" THEN
SectorAExcluir = 5: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "nosup" THEN
SectorAExcluir = 6: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "sosup" THEN
SectorAExcluir = 7: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "sesup" THEN
SectorAExcluir = 8: GOSUB ExcluyeSector
END IF
IF Mencion$(Mencion) = "sup" THEN
IF TipoDeAccion$ = "esferas" THEN
SectorAExcluir = 5: GOSUB ExcluyeSector
SectorAExcluir = 6: GOSUB ExcluyeSector
SectorAExcluir = 7: GOSUB ExcluyeSector
SectorAExcluir = 8: GOSUB ExcluyeSector
ELSE
SectorAExcluir = 9: GOSUB ExcluyeSector
END IF
END IF
NEXT Mencion
RETURN
LimpiaComas:
LineaATratar$ = RIGHT$(LineaATratar$, LEN(LineaATratar$) - 4)
GOSUB BorraEspacios
WHILE LEFT$(LineaATratar$, 1) = ","
LineaATratar$ = RIGHT$(LineaATratar$, LEN(LineaATratar$) - 1)
WEND
WHILE RIGHT$(LineaATratar$, 1) = ","
LineaATratar$ = LEFT$(LineaATratar$, LEN(LineaATratar$) - 1)
WEND
RETURN
LimpiaYCortaLinea:
GOSUB PoneEnMinusc
GOSUB BuscaPoTaExPu
LineaATratar$ = Posicion$: GOSUB LimpiaComas: Posicion$ = LineaATratar$
LineaATratar$ = Tamano$: GOSUB LimpiaComas: Tamano$ = LineaATratar$
LineaATratar$ = Exclusion$: GOSUB LimpiaComas: Exclusion$ = LineaATratar$
LineaATratar$ = NumPuntos$: GOSUB LimpiaComas: NumPuntos$ = LineaATratar$
LineaATratar$ = Posicion$: GOSUB CortaMenciones: GOSUB OrdAlfaMenciones
XObjeto = VAL(Mencion$(1)): YObjeto = VAL(Mencion$(2)): ZObjeto = VAL(Mencion$(3))
IF NumMenciones > 3 THEN
RefCoord$ = Mencion$(4)
ELSE
RefCoord$ = "c"
END IF
LineaATratar$ = Tamano$: GOSUB CortaMenciones
TamObjetoX = VAL(Mencion$(1)): TamObjetoY = VAL(Mencion$(2)): TamObjetoZ = VAL(Mencion$(3))
IF Exclusion$ <> "nohay" THEN
LineaATratar$ = Exclusion$: GOSUB CortaMenciones: GOSUB OrdAlfaMenciones
Exclusion$ = ""
FOR Mencion = 1 TO NumMenciones
Exclusion$ = Exclusion$ + Mencion$(Mencion)
IF Mencion < NumMenciones THEN
Exclusion$ = Exclusion$ + ","
END IF
NEXT Mencion
NumExclusiones = NumMenciones
ELSE
NumExclusiones = 0
Exclusion$ = ""
END IF
LineaATratar$ = NumPuntos$: GOSUB CortaMenciones
IF Mencion$(1) <> "nohay" THEN
NumPuntosXY = VAL(Mencion$(1))
IF NumPuntosXY < 3 THEN NumPuntosXY = 3
ELSE
NumPuntosXY = 6
END IF
IF NumMenciones >= 2 THEN
NumPuntosZ = VAL(Mencion$(2))
IF NumPuntosZ < 3 THEN NumPuntosZ = 3
ELSE
NumPuntosZ = 5
END IF
RETURN
LeePunto:
'Lee una l¡nea de descripci¢n de punto
NumPunto$ = "": XPunto$ = "": YPunto$ = "": ZPunto$ = ""
NumLetra = 0: NumComas = 0
WHILE NumLetra < LEN(LineaLeida$)
NumLetra = NumLetra + 1
Letra$ = MID$(LineaLeida$, NumLetra, 1)
IF Letra$ = "," THEN NumComas = NumComas + 1
IF NumComas = 0 AND Letra$ <> "," THEN
NumPunto$ = NumPunto$ + Letra$
END IF
IF NumComas = 1 AND Letra$ <> "," THEN
XPunto$ = XPunto$ + Letra$
END IF
IF NumComas = 2 AND Letra$ <> "," THEN
YPunto$ = YPunto$ + Letra$
END IF
IF NumComas = 3 AND Letra$ <> "," THEN
ZPunto$ = ZPunto$ + Letra$
END IF
WEND
NumPunto = VAL(NumPunto$)
XPunto = VAL(XPunto$)
YPunto = VAL(YPunto$)
ZPunto = VAL(ZPunto$)
Punto(NumPunto, 1) = XPunto
Punto(NumPunto, 2) = YPunto
Punto(NumPunto, 3) = ZPunto
TotalPuntos = TotalPuntos + 1
RETURN
LeePuntoText:
NumPuntoText$ = "": UPuntoText$ = "": VPuntoText$ = ""
NumLetra = 0: NumComas = 0
WHILE NumLetra < LEN(LineaLeida$)
NumLetra = NumLetra + 1
Letra$ = MID$(LineaLeida$, NumLetra, 1)
IF Letra$ = "," THEN NumComas = NumComas + 1
IF NumComas = 0 AND Letra$ <> "," THEN
NumPuntoText$ = NumPuntoText$ + Letra$
END IF
IF NumComas = 1 AND Letra$ <> "," THEN
UPuntoText$ = UPuntoText$ + Letra$
END IF
IF NumComas = 2 AND Letra$ <> "," THEN
VPuntoText$ = VPuntoText$ + Letra$
END IF
WEND
NumPuntoText = VAL(NumPuntoText$)
UPuntoText = VAL(UPuntoText$)
VPuntoText = VAL(VPuntoText$)
PuntoTextura(NumPuntoText, 1) = UPuntoText
PuntoTextura(NumPuntoText, 2) = VPuntoText
TotalPuntosText = TotalPuntosText + 1
RETURN
LeeUnaLinea:
LineaLeida$ = ""
FinDeLinea$ = "no"
wLineasLeidas = wLineasLeidas + 1
LOCATE 1, 1: PRINT "Read lines ="; wLineasLeidas;
WHILE FinDeLinea$ = "no" AND wByteLeido < LOF(1)
wByteLeido = wByteLeido + 1
GET #1, wByteLeido
IF l$ <> CHR$(13) THEN
IF l$ <> CHR$(10) THEN LineaLeida$ = LineaLeida$ + l$
ELSE
FinDeLinea$ = "s¡"
END IF
WEND
RETURN
LineaDeInstrucciones:
IF TipoDeAccion$ = "cilindros" THEN
GOSUB InterpretaRedondo
END IF
IF TipoDeAccion$ = "color" THEN
LineaATratar$ = LineaLeida$
GOSUB CortaMenciones
Tono = VAL(Mencion$(1))
Saturacion = VAL(Mencion$(2))
Brillo = VAL(Mencion$(3))
GOSUB HsbRgb
END IF
IF TipoDeAccion$ = "conos" THEN
GOSUB InterpretaRedondo
END IF
IF TipoDeAccion$ = "cubos" THEN
GOSUB InterpretaCubo
END IF
IF TipoDeAccion$ = "esferas" THEN
GOSUB InterpretaRedondo
END IF
IF TipoDeAccion$ = "inclusion" THEN
NombreArchivo$(NivelJerarqu) = ArchivoLeido$
wByteLeido(NivelJerarqu) = wByteLeido
CLOSE #1
NivelJerarqu = NivelJerarqu + 1
NombreArchivo$(NivelJerarqu) = LineaLeida$
ArchivoLeido$ = LineaLeida$
wByteLeido = 0
GOSUB ArchivoLeido
END IF
IF TipoDeAccion$ = "lados" THEN
TotalLados = TotalLados + 1
Lado$(TotalLados) = LineaLeida$
NumLado = TotalLados: GOSUB ContaTrian
TotalLadosTrian = TotalLadosTrian + TrianEnLado
END IF
IF TipoDeAccion$ = "modifcoord" THEN
LineaATratar$ = LineaLeida$
GOSUB PoneEnMinusc
IF LineaATratar$ = "fin" THEN
NivelModif = NivelModif - 1
'Una primera vez porque la linea de tipo incrementa
WHILE NivelModif(NumModifCoord) = NivelModif AND NumModifCoord > 0
NumModifCoord = NumModifCoord - 1
WEND
NivelModif = NivelModif - 1
LOCATE 2, 41: PRINT "Level of modif. ="; NivelModif; " "
'Una segunda vez para tomar en cuenta la cancelaci¢n anterior
ELSE
NumModifCoord = NumModifCoord + 1
ModifCoord$(NumModifCoord) = LineaATratar$
NivelModif(NumModifCoord) = NivelModif
END IF
END IF
IF TipoDeAccion$ = "nombre" THEN
NombreBasico$ = LineaLeida$
LineaATratar$ = NombreBasico$: GOSUB BorraEspacios
NombreBasico$ = LineaATratar$
END IF
IF TipoDeAccion$ = "puntos" THEN
GOSUB LeePunto
END IF
IF TipoDeAccion$ = "puntosText" THEN
GOSUB LeePuntoText
END IF
IF TipoDeAccion$ = "textura" THEN
Textura$ = LineaLeida$
Archivo$ = Textura$
GOSUB InterpretaNombreArchivo
Textura2$ = Archivo2$
END IF
RETURN
LineaDeTipo:
IF TipoDeAccion$ = "cilindros" THEN
TotalPuntos = 0: TotalLados = 0: TotalObjRedondos = 0
TotalLadosTrian = 0
END IF
IF TipoDeAccion$ = "color" THEN
Textura$ = ""
END IF
IF TipoDeAccion$ = "conos" THEN
TotalPuntos = 0: TotalLados = 0: TotalObjRedondos = 0
TotalLadosTrian = 0
END IF
IF TipoDeAccion$ = "cubos" THEN
TotalPuntos = 0: TotalLados = 0: TotalCubos = 0
TotalLadosTrian = 0
END IF
IF TipoDeAccion$ = "esferas" THEN
TotalPuntos = 0: TotalLados = 0: TotalObjRedondos = 0
TotalLadosTrian = 0
END IF
IF TipoDeAccion$ = "modifcoord" THEN
NivelModif = NivelModif + 1
LOCATE 2, 41: PRINT "Level of modif. ="; NivelModif; " "
END IF
IF TipoDeAccion$ = "nombre" THEN
TotalObjetos2 = 0
END IF
IF TipoDeAccion$ = "puntos" THEN
TotalPuntos = 0: TotalLados = 0
TotalLadosTrian = 0
END IF
IF TipoDeAccion$ = "puntosText" THEN
TotalPuntosText = 0
END IF
IF TipoDeAccion$ = "/cilindros" THEN
TotalObjetos = TotalObjetos + 1
TotalObjetos2 = TotalObjetos2 + 1
GOSUB GrabaCilindros
END IF
IF TipoDeAccion$ = "/color" AND TipoExportacion$ = "CBD" THEN
GOSUB GrabaColorCBD
END IF
IF TipoDeAccion$ = "/conos" THEN
TotalObjetos = TotalObjetos + 1
TotalObjetos2 = TotalObjetos2 + 1
GOSUB GrabaConos
END IF
IF TipoDeAccion$ = "/cubos" THEN
TotalObjetos = TotalObjetos + 1
TotalObjetos2 = TotalObjetos2 + 1
GOSUB GrabaCubos
END IF
IF TipoDeAccion$ = "/esferas" THEN
TotalObjetos = TotalObjetos + 1
TotalObjetos2 = TotalObjetos2 + 1
GOSUB GrabaEsferas
END IF
IF TipoDeAccion$ = "/lados" THEN
TotalObjetos = TotalObjetos + 1
TotalObjetos2 = TotalObjetos2 + 1
GOSUB GrabaTodo
END IF
IF TipoDeAccion$ = "/puntosText" THEN
GOSUB GrabaPuntosText
END IF
IF TipoDeAccion$ = "/textura" THEN
GOSUB GrabaTextura
END IF
RETURN
MultipleDe2:
IF Valor MOD 2 THEN
Valor = (INT(Valor / 2) + 1) * 2
END IF
RETURN
MultipleDe4:
IF Valor MOD 4 THEN
Valor = (INT(Valor / 4) + 1) * 4
END IF
RETURN
NumImparParalelos:
Valor = NumPuntosZ - 1: GOSUB MultipleDe2: NumPuntosZ = Valor + 1
IF NumPuntosZ < 3 THEN NumPuntosZ = 3
RETURN
OrdAlfaMenciones:
FOR Mencion1 = 1 TO NumMenciones - 1
FOR Mencion2 = Mencion1 + 1 TO NumMenciones
NumLetra = 0: ResultadoComp$ = "no se sabe"
WHILE ResultadoComp$ = "no se sabe"
NumLetra = NumLetra + 1
Letra1$ = LEFT$(Mencion$(Mencion1), 1)
IF Letra1$ = "." OR Letra1$ = "-" OR (ASC(Letra1$) > ASC("0") AND ASC(Letra1$) <= ASC("9")) THEN
'Si se trata de valores num‚ricos (coordenadas), no hay que mezclarlos
Ascii1 = ASC("0"): LenCadena1 = 1
ELSE
IF NumLetra > LEN(Mencion$(Mencion1)) THEN
Ascii1 = 0: LenCadena1 = 0
ELSE
Ascii1 = ASC(MID$(Mencion$(Mencion1), NumLetra, 1))
LenCadena1 = LEN(Mencion$(Mencion1))
END IF
END IF
Letra2$ = LEFT$(Mencion$(Mencion2), 1)
IF Letra2$ = "." OR Letra2$ = "-" OR (ASC(Letra2$) > ASC("0") AND ASC(Letra2$) <= ASC("9")) THEN
'Si se trata de valores num‚ricos (coordenadas), no hay que mezclarlos
Ascii2 = ASC("0"): LenCadena2 = 1
ELSE
IF NumLetra > LEN(Mencion$(Mencion2)) THEN
Ascii2 = 0: LenCadena2 = 0
ELSE
Ascii2 = ASC(MID$(Mencion$(Mencion2), NumLetra, 1))
LenCadena2 = LEN(Mencion$(Mencion2))
END IF
END IF
IF Ascii1 < Ascii2 THEN ResultadoComp$ = "est bien"
IF Ascii1 > Ascii2 THEN ResultadoComp$ = "hay que invertir"
IF Ascii1 = Ascii2 THEN
IF (LenCadena1 = 0 AND LenCadena2 = 0) OR (Ascii1 = ASC("0") AND Ascii2 = ASC("0")) THEN
ResultadoComp$ = "est bien"
ELSE
ResultadoComp$ = "no se sabe"
END IF
END IF
WEND
IF ResultadoComp$ = "hay que invertir" THEN
SWAP Mencion$(Mencion1), Mencion$(Mencion2)
END IF
NEXT Mencion2
NEXT Mencion1
RETURN
PoneEnMinusc:
FOR Letra = 1 TO LEN(LineaATratar$)
Letra$ = MID$(LineaATratar$, Letra, 1)
IF ASC(Letra$) >= ASC("A") AND ASC(Letra$) <= ASC("Z") THEN
MID$(LineaATratar$, Letra, 1) = CHR$(ASC(Letra$) - ASC("A") + ASC("a"))
END IF
NEXT Letra
RETURN
Principal:
CLS
TipoDeAccion$ = "nada"
TotalObjetos = 0: TotalObjetos2 = 0: NombreAnt$ = ""
NumModifCoord = 0: NivelModif = 0: NivelModifRec = 0
wLineasLeidas = 0: wLineasEscritas = 0
wByteLeido = 0
NivelJerarqu = 1
LOCATE 4, 1: PRINT ArchivoLeido$;
WHILE NivelJerarqu >= 1
WHILE wByteLeido < LOF(1)
GOSUB LeeUnaLinea
GOSUB QueTipoDeLinea
IF LineaDeTipo$ = "s¡" THEN
LOCATE 2, 1: PRINT LineaLeida$;
FOR Espacio = LEN(LineaLeida$) + 1 TO 40
PRINT " ";
NEXT Espacio
GOSUB LineaDeTipo
ELSE
GOSUB LineaDeInstrucciones
END IF
WEND
CLOSE #1
LOCATE NivelJerarqu + 3, 1
FOR Espacio = 1 TO 80
PRINT " ";
NEXT Espacio
NivelJerarqu = NivelJerarqu - 1
IF NivelJerarqu > 0 THEN
ArchivoLeido$ = NombreArchivo$(NivelJerarqu)
wByteLeido = wByteLeido(NivelJerarqu)
GOSUB ArchivoLeido
END IF
WEND
IF TipoExportacion$ = "Caligari" THEN
LineaEscrita$ = "END V1.00 Id 0 Parent 0 Size 0"
GOSUB GrabaUnaLinea
END IF
RETURN
ProdLado3DStudio:
GOSUB ContaTrian
FOR NumTrian = 1 TO TrianEnLado
NumLadoTrian = NumLadoTrian + 1
Valor = NumLadoTrian: GOSUB TradValorCadena
LineaEscrita$ = "Face " + Cadena$ + ": A:"
Valor = PuntoEnLado(1) - 1: GOSUB TradValorCadena
'-1 porque 3D Studio empieza la numeraci¢n por 0
LineaEscrita$ = LineaEscrita$ + Cadena$ + " B:"
Valor = PuntoEnLado(NumTrian + 1) - 1: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " C:"
Valor = PuntoEnLado(NumTrian + 2) - 1: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " AB:1 BC:1 CA:1"
GOSUB GrabaUnaLinea
NEXT NumTrian
RETURN
ProduceLadoCaligari:
GOSUB ContaTrian
FOR NumTrian = 1 TO TrianEnLado
LineaEscrita$ = "Face verts 3 flags 0 mat 0"
GOSUB GrabaUnaLinea
IF LEN(Textura$) = 0 THEN
Valor = PuntoEnLado(NumTrian + 2) - 1: GOSUB TradValorCadena
'-1 porque Caligari empieza la numeraci¢n por 0
LineaEscrita$ = "<" + Cadena$ + ",0> <"
Valor = PuntoEnLado(NumTrian + 1) - 1: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ",0> <"
Valor = PuntoEnLado(1) - 1: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ",0> "
GOSUB GrabaUnaLinea
ELSE
Valor = PuntoEnLado(NumTrian + 2) - 1: GOSUB TradValorCadena
LineaEscrita$ = "<" + Cadena$ + "," + Cadena$ + "> <"
Valor = PuntoEnLado(NumTrian + 1) - 1: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + "," + Cadena$ + "> <"
Valor = PuntoEnLado(1) - 1: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + "," + Cadena$ + "> "
GOSUB GrabaUnaLinea
END IF
NEXT NumTrian
RETURN
ProduceLadoCBD:
LineaEscrita$ = ""
FOR NumPuntEnLado = 1 TO TotalPuntEnLado
Valor = PuntoEnLado(NumPuntEnLado): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
IF NumPuntEnLado <> TotalPuntEnLado THEN
LineaEscrita$ = LineaEscrita$ + ","
END IF
NEXT NumPuntEnLado
GOSUB GrabaUnaLinea
RETURN
ProduceLadoS3D:
LineaEscrita$ = "F00," + Gris$ + ";"
FOR NumPuntEnLado = 1 TO TotalPuntEnLado
Valor = Punto(PuntoEnLado(NumPuntEnLado), 1): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = Punto(PuntoEnLado(NumPuntEnLado), 2): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = Punto(PuntoEnLado(NumPuntEnLado), 3): GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ";"
NEXT NumPuntEnLado
GOSUB GrabaUnaLinea
RETURN
ProduceLadoTextVRML:
GOSUB ContaTrian
FOR NumTrian = 1 TO TrianEnLado
IF NumLado = 1 AND NumTrian = 1 THEN
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = " textureCoordIndex [ "
ELSE
LineaEscrita$ = " texCoordIndex [ "
END IF
ELSE
LineaEscrita$ = " "
END IF
GOSUB ProduceLadoVRML2
NEXT NumTrian
RETURN
ProduceLadoVRML:
GOSUB ContaTrian
FOR NumTrian = 1 TO TrianEnLado
IF NumLado = 1 AND NumTrian = 1 THEN
LineaEscrita$ = " coordIndex [ "
ELSE
LineaEscrita$ = " "
END IF
GOSUB ProduceLadoVRML2
NEXT NumTrian
RETURN
ProduceLadoVRML2:
Valor = PuntoEnLado(1) - 1: GOSUB TradValorCadena
'-1 porque VRML empieza la numeraci¢n por 0
LineaEscrita$ = LineaEscrita$ + Cadena$ + ", "
Valor = PuntoEnLado(NumTrian + 1) - 1: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ", "
Valor = PuntoEnLado(NumTrian + 2) - 1: GOSUB TradValorCadena
IF NumLado = TotalLados AND NumTrian = TrianEnLado THEN
LineaEscrita$ = LineaEscrita$ + Cadena$ + ", -1 ]"
GOSUB GrabaUnaLinea
ELSE
LineaEscrita$ = LineaEscrita$ + Cadena$ + ", -1,"
GOSUB GrabaUnaLinea
END IF
RETURN
PuntoBaseEsfera:
TotalPuntos = TotalPuntos + 1
CentroInfRed = TotalPuntos
Punto(TotalPuntos, 1) = XObjeto
Punto(TotalPuntos, 2) = YObjeto
Punto(TotalPuntos, 3) = ZObjeto
RETURN
PuntoCumbreEsfera:
TotalPuntos = TotalPuntos + 1
CentroSupRed = TotalPuntos
Punto(TotalPuntos, 1) = XObjeto
Punto(TotalPuntos, 2) = YObjeto
Punto(TotalPuntos, 3) = ZObjeto + TamObjetoZ
RETURN
PuntosCilindro:
IF LEFT$(Exclusion$, 1) = "0" THEN
TotalPuntos = TotalPuntos + 1
CentroInfRed = TotalPuntos
Punto(TotalPuntos, 1) = XObjeto
Punto(TotalPuntos, 2) = YObjeto
Punto(TotalPuntos, 3) = ZObjeto
END IF
Punto1InfRed = TotalPuntos + 1
FOR PuntoCirculo = 1 TO NumPuntosXYExcl
Angulo = AnguloInicioRed + (PuntoCirculo - 1) * 360 / NumPuntosXY
TotalPuntos = TotalPuntos + 1
AnguloRad = Angulo * Pi / 180
Punto(TotalPuntos, 1) = XObjeto + COS(AnguloRad) * TamObjetoX / 2
'El tama¤o es el diametro, y se necesita el radio
Punto(TotalPuntos, 2) = YObjeto + SIN(AnguloRad) * TamObjetoY / 2
Punto(TotalPuntos, 3) = ZObjeto
NEXT PuntoCirculo
PuntoUltInfRed = TotalPuntos
Punto1SupRed = TotalPuntos + 1
FOR PuntoCirculo = 1 TO NumPuntosXYExcl
Angulo = AnguloInicioRed + (PuntoCirculo - 1) * 360 / NumPuntosXY
TotalPuntos = TotalPuntos + 1
AnguloRad = Angulo * Pi / 180
Punto(TotalPuntos, 1) = XObjeto + COS(AnguloRad) * TamObjetoX / 2
Punto(TotalPuntos, 2) = YObjeto + SIN(AnguloRad) * TamObjetoY / 2
Punto(TotalPuntos, 3) = ZObjeto + TamObjetoZ
NEXT PuntoCirculo
PuntoUltSupRed = TotalPuntos
IF RIGHT$(Exclusion$, 1) = "9" THEN
TotalPuntos = TotalPuntos + 1
CentroSupRed = TotalPuntos
Punto(TotalPuntos, 1) = XObjeto
Punto(TotalPuntos, 2) = YObjeto
Punto(TotalPuntos, 3) = ZObjeto + TamObjetoZ
END IF
RETURN
PuntosCono:
IF LEFT$(Exclusion$, 1) = "0" THEN
TotalPuntos = TotalPuntos + 1
CentroInfRed = TotalPuntos
Punto(TotalPuntos, 1) = XObjeto
Punto(TotalPuntos, 2) = YObjeto
Punto(TotalPuntos, 3) = ZObjeto
END IF
Punto1InfRed = TotalPuntos + 1
FOR PuntoCirculo = 1 TO NumPuntosXYExcl
Angulo = AnguloInicioRed + (PuntoCirculo - 1) * 360 / NumPuntosXY
TotalPuntos = TotalPuntos + 1
AnguloRad = Angulo * Pi / 180
Punto(TotalPuntos, 1) = XObjeto + COS(AnguloRad) * TamObjetoX / 2
'El tama¤o es el diametro, y se necesita el radio
Punto(TotalPuntos, 2) = YObjeto + SIN(AnguloRad) * TamObjetoY / 2
Punto(TotalPuntos, 3) = ZObjeto
NEXT PuntoCirculo
PuntoUltInfRed = TotalPuntos
Punto1SupRed = Punto1InfRed
PuntoUltSupRed = TotalPuntos
TotalPuntos = TotalPuntos + 1
CentroSupRed = TotalPuntos
Punto(TotalPuntos, 1) = XObjeto
Punto(TotalPuntos, 2) = YObjeto
Punto(TotalPuntos, 3) = ZObjeto + TamObjetoZ
RETURN
PuntosEsfera:
GOSUB PuntoBaseEsfera
Punto1InfRed = TotalPuntos + 1
PrimerParalelo = 1
UltimoParalelo = NumPuntosZ - 2
GOSUB PuntosTroncoEsfera
PuntoUltSupRed = TotalPuntos
GOSUB PuntoCumbreEsfera
RETURN
PuntosTroncoEsfera:
FOR Paralelo = PrimerParalelo TO UltimoParalelo
Nivel = Paralelo: GOSUB CalculaLatitud
IF Paralelo = NumPuntosZ - 2 THEN Punto1SupRed = TotalPuntos + 1
FOR PuntoCirculo = 1 TO NumPuntosXYExcl
Angulo = AnguloInicioRed + (PuntoCirculo - 1) * 360 / NumPuntosXY
TotalPuntos = TotalPuntos + 1
AnguloRad = Angulo * Pi / 180
Punto(TotalPuntos, 1) = XObjeto + COS(AnguloRad) * TamObjetoX * COS(Latitud) / 2
Punto(TotalPuntos, 2) = YObjeto + SIN(AnguloRad) * TamObjetoY * COS(Latitud) / 2
Punto(TotalPuntos, 3) = ZObjeto + TamObjetoZ / 2 + TamObjetoZ * SIN(Latitud) / 2
NEXT PuntoCirculo
IF Paralelo = 1 THEN PuntoUltInfRed = TotalPuntos
NEXT Paralelo
RETURN
PuntosVRML1y2:
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = " DEF " + Nombre$ + " Separator {"
ELSE
LineaEscrita$ = " DEF " + Nombre$ + " Shape {"
END IF
GOSUB GrabaUnaLinea
GOSUB GrabaColorTextVRML
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = " Coordinate3 {": GOSUB GrabaUnaLinea
LineaEscrita$ = " point [ ": GOSUB GrabaUnaLinea
ELSE
LineaEscrita$ = " geometry IndexedFaceSet {": GOSUB GrabaUnaLinea
LineaEscrita$ = " solid FALSE": GOSUB GrabaUnaLinea
LineaEscrita$ = " coord Coordinate {": GOSUB GrabaUnaLinea
LineaEscrita$ = " point [ ": GOSUB GrabaUnaLinea
END IF
FOR NumPuntExp = 1 TO TotalPuntos
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = " "
ELSE
LineaEscrita$ = " "
END IF
'Para VRML, X y Y definen un plano vertical
Valor = INT(Punto(NumPuntExp, 2) * 1000 + .5) / 1000
GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = INT(Punto(NumPuntExp, 3) * 1000 + .5) / 1000
GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = INT(Punto(NumPuntExp, 1) * 1000 + .5) / 1000
GOSUB TradValorCadena
IF NumPuntExp <> TotalPuntos THEN
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
ELSE
LineaEscrita$ = LineaEscrita$ + Cadena$
END IF
GOSUB GrabaUnaLinea
NEXT NumPuntExp
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = " ]": GOSUB GrabaUnaLinea
LineaEscrita$ = " }": GOSUB GrabaUnaLinea
ELSE
LineaEscrita$ = " ]": GOSUB GrabaUnaLinea
LineaEscrita$ = " }": GOSUB GrabaUnaLinea
END IF
IF LEN(Textura$) > 0 THEN
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = " TextureCoordinate2 {": GOSUB GrabaUnaLinea
LineaEscrita$ = " point [ ": GOSUB GrabaUnaLinea
ELSE
LineaEscrita$ = " texCoord TextureCoordinate {": GOSUB GrabaUnaLinea
LineaEscrita$ = " point [ ": GOSUB GrabaUnaLinea
END IF
FOR NumPuntExp = 1 TO TotalPuntosText
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = " "
ELSE
LineaEscrita$ = " "
END IF
Valor = INT(PuntoTextura(NumPuntExp, 1) * 100 + .5) / 100
GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + " "
Valor = INT(PuntoTextura(NumPuntExp, 2) * 100 + .5) / 100
GOSUB TradValorCadena
IF NumPuntExp <> TotalPuntos THEN
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
ELSE
LineaEscrita$ = LineaEscrita$ + Cadena$
END IF
GOSUB GrabaUnaLinea
NEXT NumPuntExp
IF TipoExportacion$ = "VRML1" THEN
LineaEscrita$ = " ]": GOSUB GrabaUnaLinea
LineaEscrita$ = " }": GOSUB GrabaUnaLinea
ELSE
LineaEscrita$ = " ]": GOSUB GrabaUnaLinea
LineaEscrita$ = " }": GOSUB GrabaUnaLinea
END IF
END IF
RETURN
QueTipoDeLinea:
IF RIGHT$(LineaLeida$, 1) = ">" THEN
LineaDeTipo$ = "s¡"
LineaATratar$ = LineaLeida$: GOSUB PoneEnMinusc
TipoDeAccion$ = MID$(LineaLeida$, 2, LEN(LineaLeida$) - 2)
ELSE
LineaDeTipo$ = "no"
END IF
RETURN
Rotacion:
Rotacion = VAL(RIGHT$(ModifCoord$, LEN(ModifCoord$) - 4))
Rotacion = Rotacion * Pi / 180
FOR NumPuntExp = 1 TO TotalPuntos
CoordDerecha = Punto(NumPuntExp, NumCoordDerecha)
CoordDelante = Punto(NumPuntExp, NumCoordDelante)
GOSUB DeRectAPolar
AngDespRota = AngAntRota + Rotacion
GOSUB DePolarARect
Punto(NumPuntExp, NumCoordDerecha) = CoordDerecha2
Punto(NumPuntExp, NumCoordDelante) = CoordDelante2
NEXT NumPuntExp
RETURN
TipoExportacion:
CLS
PRINT "In what format do you wish to export the CBB file :": PRINT
PRINT " 1 - S3D (wireframe format special to the VR Cocha Club);"
PRINT " 2 - WRL (VRML1 format, read by the Live 3D plug-in);"
PRINT " 3 - WRL (VRML2 format, read by the Cosmo Player plug-in);"
PRINT " 4 - ASC (3D Studio format);"
PRINT " 5 - COB (for Caligari TrueSpace);"
PRINT " 6 - CBD (variant of the CBB format, with basic shapes converted"
PRINT " to vertices and faces) ?"
Tecla$ = " "
WHILE NOT (ASC(Tecla$) >= ASC("1") AND ASC(Tecla$) <= ASC("6"))
GOSUB EsperaTecla
IF ASC(Tecla$) < ASC("1") OR ASC(Tecla$) > ASC("5") THEN BEEP
WEND
SELECT CASE Tecla$
CASE "1"
TipoExportacion$ = "S3D"
CASE "2"
TipoExportacion$ = "VRML1"
CASE "3"
TipoExportacion$ = "VRML2"
CASE "4"
TipoExportacion$ = "3D Studio"
CASE "5"
TipoExportacion$ = "Caligari"
CASE "6"
TipoExportacion$ = "CBD"
CASE ELSE
STOP: 'Hubiera obviamente un error
END SELECT
RETURN
TradValorCadena:
Cadena$ = STR$(Valor)
IF LEFT$(Cadena$, 1) = " " THEN
Cadena$ = MID$(Cadena$, 2, LEN(Cadena$) - 1)
END IF
IF LEFT$(Cadena$, 2) = "-." THEN
Cadena$ = "-0" + RIGHT$(Cadena$, LEN(Cadena$) - 1)
END IF
IF LEFT$(Cadena$, 1) = "." THEN
Cadena$ = "0" + Cadena$
END IF
RETURN
TroncoCilindro:
NumPunto = Punto1InfRed - 1
Punto1ParaleloAnt = Punto1InfRed
GOSUB GrabaParalelo
RETURN
TroncoEsfera:
FOR Paralelo = PrimerParalelo TO UltimoParalelo
NumPunto = Punto1InfRed - 1 + (Paralelo - PrimerParalelo) * NumPuntosXYExcl
Punto1ParaleloAnt = Punto1InfRed + (Paralelo - PrimerParalelo) * NumPuntosXYExcl
GOSUB GrabaParalelo
NEXT Paralelo
RETURN