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