DEFLNG W GOSUB Bienvenida GOSUB ArchivoEscrito GOSUB Principal GOSUB CierraArchivo END ArchivoEscrito: CLS OKGrabacion$ = "no" WHILE OKGrabacion$ <> "s¡" INPUT "Complete DOS name of the file to store "; ArchivoEscrito$ OPEN "R", #2, ArchivoEscrito$, 1 FIELD #2, 1 AS e$ IF LOF(2) <> 0 THEN BEEP: PRINT : PRINT "A file with that name already exists. Erase (E), try again ?" GOSUB EsperaTecla IF Tecla$ = "e" OR Tecla$ = "E" THEN CLOSE #2 KILL ArchivoEscrito$ OPEN "R", #2, ArchivoEscrito$, 1 FIELD #2, 1 AS e$ OKGrabacion$ = "s¡" ELSE CLOSE #2 END IF ELSE OKGrabacion$ = "s¡" END IF WEND RETURN Bienvenida: CLS : COLOR 7, 0 PRINT " This program produces a series of truncated spheres in the CBB" PRINT "format." PRINT PRINT " Copyright Jean-Luc Ancey, February 10th, 1997.": PRINT PRINT " Strike a key when ready." GOSUB EsperaTecla RETURN CierraArchivo: wByteEscrito = wByteEscrito + 1 LSET e$ = CHR$(26) PUT #2, wByteEscrito CLOSE RETURN EsperaTecla: Tecla$ = "" WHILE Tecla$ = "" Tecla$ = INKEY$ WEND RETURN GrabaUnaEsfera: Valor = x: GOSUB TradValorCadena LineaEscrita$ = "Posi " + Cadena$ + "," Valor = y: GOSUB TradValorCadena LineaEscrita$ = LineaEscrita$ + Cadena$ + "," Valor = z: GOSUB TradValorCadena LineaEscrita$ = LineaEscrita$ + Cadena$ + " Tama 0.5,0.5,0.5 Punt 8,7" IF Exclusion$ <> "" THEN LineaEscrita$ = LineaEscrita$ + " Excl " + Exclusion$ END IF GOSUB GrabaUnaLinea RETURN GrabaUnaLinea: PRINT LineaEscrita$ 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 LeeUnaLinea: LineaLeida$ = "" FinDeLinea$ = "no" 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 Principal: CLS wByteEscrito = 0: wByteLeido = 0 LineaEscrita$ = "": GOSUB GrabaUnaLinea x = 0: y = 0: z = 0: Exclusion$ = "nesup": GOSUB GrabaUnaEsfera x = 1: y = 0: z = 0: Exclusion$ = "nsup": GOSUB GrabaUnaEsfera x = 2: y = 0: z = 0: Exclusion$ = "nosup": GOSUB GrabaUnaEsfera x = 0: y = 1: z = 0: Exclusion$ = "esup": GOSUB GrabaUnaEsfera x = 1: y = 1: z = 0: Exclusion$ = "sup": GOSUB GrabaUnaEsfera x = 2: y = 1: z = 0: Exclusion$ = "osup": GOSUB GrabaUnaEsfera x = 0: y = 2: z = 0: Exclusion$ = "sesup": GOSUB GrabaUnaEsfera x = 1: y = 2: z = 0: Exclusion$ = "ssup": GOSUB GrabaUnaEsfera x = 2: y = 2: z = 0: Exclusion$ = "sosup": GOSUB GrabaUnaEsfera LineaEscrita$ = "": GOSUB GrabaUnaLinea LineaEscrita$ = "": GOSUB GrabaUnaLinea x = 0: y = 0: z = 1: Exclusion$ = "ne": GOSUB GrabaUnaEsfera x = 1: y = 0: z = 1: Exclusion$ = "n": GOSUB GrabaUnaEsfera x = 2: y = 0: z = 1: Exclusion$ = "no": GOSUB GrabaUnaEsfera x = 0: y = 1: z = 1: Exclusion$ = "e": GOSUB GrabaUnaEsfera x = 1: y = 1: z = 1: Exclusion$ = "": GOSUB GrabaUnaEsfera x = 2: y = 1: z = 1: Exclusion$ = "o": GOSUB GrabaUnaEsfera x = 0: y = 2: z = 1: Exclusion$ = "se": GOSUB GrabaUnaEsfera x = 1: y = 2: z = 1: Exclusion$ = "s": GOSUB GrabaUnaEsfera x = 2: y = 2: z = 1: Exclusion$ = "so": GOSUB GrabaUnaEsfera LineaEscrita$ = "": GOSUB GrabaUnaLinea LineaEscrita$ = "": GOSUB GrabaUnaLinea x = 0: y = 0: z = 2: Exclusion$ = "neinf": GOSUB GrabaUnaEsfera x = 1: y = 0: z = 2: Exclusion$ = "ninf": GOSUB GrabaUnaEsfera x = 2: y = 0: z = 2: Exclusion$ = "noinf": GOSUB GrabaUnaEsfera x = 0: y = 1: z = 2: Exclusion$ = "einf": GOSUB GrabaUnaEsfera x = 1: y = 1: z = 2: Exclusion$ = "inf": GOSUB GrabaUnaEsfera x = 2: y = 1: z = 2: Exclusion$ = "oinf": GOSUB GrabaUnaEsfera x = 0: y = 2: z = 2: Exclusion$ = "seinf": GOSUB GrabaUnaEsfera x = 1: y = 2: z = 2: Exclusion$ = "sinf": GOSUB GrabaUnaEsfera x = 2: y = 2: z = 2: Exclusion$ = "soinf": GOSUB GrabaUnaEsfera LineaEscrita$ = "": GOSUB GrabaUnaLinea 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