Pi = 4 * ATN(1)
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 builds a chromatic circle in the CBB format."
PRINT
PRINT " Copyright Jean-Luc Ancey, May 17th, 1997.": PRINT
PRINT " Strike a key when ready."
GOSUB EsperaTecla
RETURN
CabezaTipo:
LineaEscrita$ = "<" + Tipo$ + ">": GOSUB GrabaUnaLinea
RETURN
CierraArchivo:
wByteEscrito = wByteEscrito + 1
LSET e$ = CHR$(26)
PUT #2, wByteEscrito
CLOSE
RETURN
ColaTipo:
LineaEscrita$ = "" + Tipo$ + ">": GOSUB GrabaUnaLinea
RETURN
EsperaTecla:
Tecla$ = ""
WHILE Tecla$ = ""
Tecla$ = INKEY$
WEND
RETURN
FinModifCoord:
LineaEscrita$ = "": GOSUB GrabaUnaLinea
LineaEscrita$ = "Fin": GOSUB GrabaUnaLinea
LineaEscrita$ = "": 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
Tipo$ = "modifcoord": GOSUB CabezaTipo
LineaEscrita$ = "Rotz 90": GOSUB GrabaUnaLinea
LineaEscrita$ = "Roty 90": GOSUB GrabaUnaLinea
GOSUB ColaTipo
NumRadios = 8
FOR RadioColores = 1 TO NumRadios
Perimetro = 2 * Pi * RadioColores
NumEsferas = INT(Perimetro)
FOR Esfera = 1 TO NumEsferas
AnguloDeg = (Esfera - 1) * (360 / NumEsferas)
AnguloRad = AnguloDeg * Pi / 180
LineaEscrita$ = "": GOSUB GrabaUnaLinea
LineaEscrita$ = "H"
Valor = INT(1000 + AnguloDeg + .5): GOSUB TradValorCadena
FOR Letra = 2 TO LEN(Cadena$)
Letra$ = MID$(Cadena$, Letra, 1)
Letra$ = CHR$(ASC(Letra$) - ASC("0") + ASC("a"))
LineaEscrita$ = LineaEscrita$ + Letra$
NEXT Letra
LineaEscrita$ = LineaEscrita$ + "B"
Valor = INT((1 - (RadioColores / (NumRadios + 1))) * 100 + 100.5)
GOSUB TradValorCadena
FOR Letra = 2 TO LEN(Cadena$)
Letra$ = MID$(Cadena$, Letra, 1)
Letra$ = CHR$(ASC(Letra$) - ASC("0") + ASC("a"))
LineaEscrita$ = LineaEscrita$ + Letra$
NEXT Letra
GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
Valor = AnguloDeg: GOSUB TradValorCadena
LineaEscrita$ = Cadena$ + ",1,"
Valor = 1 - (RadioColores / (NumRadios + 1))
GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
Valor = AnguloDeg + 90: GOSUB TradValorCadena
LineaEscrita$ = "Rotz " + Cadena$: GOSUB GrabaUnaLinea
Valor = COS(AnguloRad) * RadioColores
GOSUB TradValorCadena
LineaEscrita$ = "Posi " + Cadena$ + ","
Valor = SIN(AnguloRad) * RadioColores
GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ",0"
GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
LineaEscrita$ = "Posi 0,0,0 Tama 0.67,0.95,1 Excl n,s,e,o,sup"
GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
LineaEscrita$ = "Fin": GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
NEXT Esfera
NEXT RadioColores
GOSUB FinModifCoord
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