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

    Source: geocities.com/siliconvalley/way/4179

               ( geocities.com/siliconvalley/way)                   ( geocities.com/siliconvalley)