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$ = "": 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