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