DEFLNG W
Pi = 4 * ATN(1): Phi = (1 + SQR(5)) / 2
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 some sort of a Mormon temple in the CBB format."
PRINT
PRINT " Copyright Jean-Luc Ancey, February 18th, 1997.": PRINT
PRINT " Strike a key when ready."
GOSUB EsperaTecla
RETURN
CierraArchivo:
wByteEscrito = wByteEscrito + 1
LSET e$ = CHR$(26)
PUT #2, wByteEscrito
CLOSE
RETURN
ColumnasEsquinas:
Nombre$ = "ColuEsq": GOSUB GrabaNombre
Tono = 200: Saturacion = .3: Brillo = .8: GOSUB GrabaColor
LineaEscrita$ = "": GOSUB GrabaUnaLinea
x = TamaCuerpoXY / 2: y = TamaCuerpoXY / 2: z = 0: Posicion$ = "c"
TamaX = DiamColumAngulos: TamaY = DiamColumAngulos: TamaZ = AltoCuerpo
Exclusion$ = "sup,so"
GOSUB GrabaUnaColumna
x = 0 - TamaCuerpoXY / 2: y = TamaCuerpoXY / 2: z = 0: Posicion$ = "c"
TamaX = DiamColumAngulos: TamaY = DiamColumAngulos: TamaZ = AltoCuerpo
Exclusion$ = "sup,se"
GOSUB GrabaUnaColumna
x = 0 - TamaCuerpoXY / 2: y = 0 - TamaCuerpoXY / 2: z = 0: Posicion$ = "c"
TamaX = DiamColumAngulos: TamaY = DiamColumAngulos: TamaZ = AltoCuerpo
Exclusion$ = "sup,ne"
GOSUB GrabaUnaColumna
x = TamaCuerpoXY / 2: y = 0 - TamaCuerpoXY / 2: z = 0: Posicion$ = "c"
TamaX = DiamColumAngulos: TamaY = DiamColumAngulos: TamaZ = AltoCuerpo
Exclusion$ = "sup,no"
GOSUB GrabaUnaColumna
LineaEscrita$ = "": GOSUB GrabaUnaLinea
GOSUB TechoCharlie
RETURN
ColumnasLados:
Nombre$ = "ColuLados": GOSUB GrabaNombre
Tono = 60: Saturacion = .8: Brillo = .8: GOSUB GrabaColor
LineaEscrita$ = "": GOSUB GrabaUnaLinea
FOR Columna = 2 TO ColumnasPorLado - 1
x = 0 - TamaCuerpoXY / 2 + (TamaCuerpoXY / (ColumnasPorLado - 1)) * (Columna - 1)
y = 0 - TamaCuerpoXY / 2
z = AltoEscalones: Posicion$ = "c"
TamaX = DiamConosLados: TamaY = DiamConosLados: TamaZ = AltoCuerpo - AltoEscalones
Exclusion$ = "inf,n"
GOSUB GrabaUnaColumna
NEXT Columna
FOR Columna = 2 TO ColumnasPorLado - 1
x = TamaCuerpoXY / 2
y = 0 - TamaCuerpoXY / 2 + (TamaCuerpoXY / (ColumnasPorLado - 1)) * (Columna - 1)
z = AltoEscalones: Posicion$ = "c"
TamaX = DiamConosLados: TamaY = DiamConosLados: TamaZ = AltoCuerpo - AltoEscalones
Exclusion$ = "inf,o"
GOSUB GrabaUnaColumna
NEXT Columna
FOR Columna = 2 TO ColumnasPorLado - 1
x = 0 - TamaCuerpoXY / 2 + (TamaCuerpoXY / (ColumnasPorLado - 1)) * (Columna - 1)
y = TamaCuerpoXY / 2
z = AltoEscalones: Posicion$ = "c"
TamaX = DiamConosLados: TamaY = DiamConosLados: TamaZ = AltoCuerpo - AltoEscalones
Exclusion$ = "inf,s"
GOSUB GrabaUnaColumna
NEXT Columna
FOR Columna = 2 TO ColumnasPorLado - 1
x = 0 - TamaCuerpoXY / 2
y = 0 - TamaCuerpoXY / 2 + (TamaCuerpoXY / (ColumnasPorLado - 1)) * (Columna - 1)
z = AltoEscalones: Posicion$ = "c"
TamaX = DiamConosLados: TamaY = DiamConosLados: TamaZ = AltoCuerpo - AltoEscalones
Exclusion$ = "inf,e"
GOSUB GrabaUnaColumna
NEXT Columna
LineaEscrita$ = "": GOSUB GrabaUnaLinea
RETURN
Cuerpo:
Nombre$ = "Cuerpo": GOSUB GrabaNombre
Tono = 180: Saturacion = .8: Brillo = .5: GOSUB GrabaColor
LineaEscrita$ = "": GOSUB GrabaUnaLinea
x = 0: y = 0: z = 0: Posicion$ = "c"
TamaX = TamaCuerpoXY: TamaY = TamaCuerpoXY: TamaZ = AltoCuerpo
Exclusion$ = ""
GOSUB GrabaUnCubo
LineaEscrita$ = "": GOSUB GrabaUnaLinea
RETURN
Escalones:
Nombre$ = "Escalones": GOSUB GrabaNombre
Tono = 120: Saturacion = .6: Brillo = .5: GOSUB GrabaColor
LineaEscrita$ = "": GOSUB GrabaUnaLinea
x = 0: y = 0 - TamaCuerpoXY / 2: z = 0: Posicion$ = "n"
TamaX = AnchoEscalones: TamaY = ProfundoEscalones: TamaZ = AltoEscalones
Exclusion$ = "n"
GOSUB GrabaUnCubo
x = TamaCuerpoXY / 2: y = 0: z = 0: Posicion$ = "o"
TamaX = ProfundoEscalones: TamaY = AnchoEscalones: TamaZ = AltoEscalones
Exclusion$ = "o"
GOSUB GrabaUnCubo
x = 0: y = TamaCuerpoXY / 2: z = 0: Posicion$ = "s"
TamaX = AnchoEscalones: TamaY = ProfundoEscalones: TamaZ = AltoEscalones
Exclusion$ = "s"
GOSUB GrabaUnCubo
x = 0 - TamaCuerpoXY / 2: y = 0: z = 0: Posicion$ = "e"
TamaX = ProfundoEscalones: TamaY = AnchoEscalones: TamaZ = AltoEscalones
Exclusion$ = "e"
GOSUB GrabaUnCubo
LineaEscrita$ = "": GOSUB GrabaUnaLinea
RETURN
EsperaTecla:
Tecla$ = ""
WHILE Tecla$ = ""
Tecla$ = INKEY$
WEND
RETURN
GrabaColor:
LineaEscrita$ = "": GOSUB GrabaUnaLinea
Valor = Tono: GOSUB TradValorCadena
LineaEscrita$ = Cadena$ + ","
Valor = Saturacion: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = Brillo: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
RETURN
GrabaNombre:
LineaEscrita$ = "": GOSUB GrabaUnaLinea
LineaEscrita$ = Nombre$: GOSUB GrabaUnaLinea
LineaEscrita$ = "": GOSUB GrabaUnaLinea
RETURN
GrabaUnaColumna:
LineaEscrita$ = "Posi "
Valor = x: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = y: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = z: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + "," + Posicion$ + " Tama "
Valor = TamaX: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = TamaY: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = TamaZ: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
IF Exclusion$ <> "" THEN
LineaEscrita$ = LineaEscrita$ + " Excl " + Exclusion$
END IF
Exclusion$ = ""
LineaEscrita$ = LineaEscrita$ + " Punt 12"
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
GrabaUnaEsferaTecho:
LineaEscrita$ = "Posi "
Valor = x: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = y: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = z: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + "," + Posicion$ + " Tama "
Valor = TamaX: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = TamaY: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = TamaZ: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
IF Exclusion$ <> "" THEN
LineaEscrita$ = LineaEscrita$ + " Excl " + Exclusion$
END IF
LineaEscrita$ = LineaEscrita$ + " Punt 18,11"
Exclusion$ = ""
GOSUB GrabaUnaLinea
RETURN
GrabaUnConoTecho:
LineaEscrita$ = "Posi "
Valor = x: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = y: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = z: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + "," + Posicion$ + " Tama "
Valor = TamaX: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = TamaY: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = TamaZ: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
IF Exclusion$ <> "" THEN
LineaEscrita$ = LineaEscrita$ + " Excl " + Exclusion$
END IF
LineaEscrita$ = LineaEscrita$ + " Punt 18"
Exclusion$ = ""
GOSUB GrabaUnaLinea
RETURN
GrabaUnCubo:
LineaEscrita$ = "Posi "
Valor = x: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = y: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = z: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + "," + Posicion$ + " Tama "
Valor = TamaX: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = TamaY: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$ + ","
Valor = TamaZ: GOSUB TradValorCadena
LineaEscrita$ = LineaEscrita$ + Cadena$
IF Exclusion$ <> "" THEN
LineaEscrita$ = LineaEscrita$ + " Excl " + Exclusion$
END IF
Exclusion$ = ""
GOSUB GrabaUnaLinea
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:
GOSUB Variables
GOSUB Cuerpo
GOSUB Escalones
GOSUB ColumnasEsquinas
GOSUB ColumnasLados
GOSUB Techo
RETURN
Techo:
Nombre$ = "Techo": GOSUB GrabaNombre
Tono = 12: Saturacion = .33: Brillo = .4: GOSUB GrabaColor
GOSUB TechoAlfa
GOSUB TechoBravo
RETURN
TechoAlfa:
LineaEscrita$ = "": GOSUB GrabaUnaLinea
x = 0: y = 0: z = AltoCuerpo: Posicion$ = "cgrav"
TamaX = Alfa / SIN(Pi / 4): TamaY = TamaX: TamaZ = TamaX
Exclusion$ = "inf"
GOSUB GrabaUnaEsferaTecho
LineaEscrita$ = "": GOSUB GrabaUnaLinea
RETURN
TechoBravo:
LineaEscrita$ = "": GOSUB GrabaUnaLinea
x = Alfa / 2 + Bravo / 2: y = Alfa / 2 + Bravo / 2: z = AltoCuerpo: Posicion$ = "c"
TamaX = Bravo / SIN(Pi / 4): TamaY = Bravo / SIN(Pi / 4): TamaZ = AltoBravo
Exclusion$ = "inf"
GOSUB GrabaUnConoTecho
x = 0 - Alfa / 2 - Bravo / 2: y = Alfa / 2 + Bravo / 2: z = AltoCuerpo: Posicion$ = "c"
Exclusion$ = "inf"
GOSUB GrabaUnConoTecho
x = 0 - Alfa / 2 - Bravo / 2: y = 0 - Alfa / 2 - Bravo / 2: z = AltoCuerpo: Posicion$ = "c"
Exclusion$ = "inf"
GOSUB GrabaUnConoTecho
x = Alfa / 2 + Bravo / 2: y = 0 - Alfa / 2 - Bravo / 2: z = AltoCuerpo: Posicion$ = "c"
Exclusion$ = "inf"
GOSUB GrabaUnConoTecho
LineaEscrita$ = "": GOSUB GrabaUnaLinea
RETURN
TechoCharlie:
LineaEscrita$ = "": GOSUB GrabaUnaLinea
x = TamaCuerpoXY / 2: y = TamaCuerpoXY / 2: z = AltoCuerpo: Posicion$ = "c"
TamaX = Charlie: TamaY = Charlie: TamaZ = AltoCharlie
Exclusion$ = "inf"
GOSUB GrabaUnConoTecho
x = 0 - TamaCuerpoXY / 2: y = TamaCuerpoXY / 2: z = AltoCuerpo: Posicion$ = "c"
GOSUB GrabaUnConoTecho
x = 0 - TamaCuerpoXY / 2: y = 0 - TamaCuerpoXY / 2: z = AltoCuerpo: Posicion$ = "c"
GOSUB GrabaUnConoTecho
x = TamaCuerpoXY / 2: y = 0 - TamaCuerpoXY / 2: z = AltoCuerpo: Posicion$ = "c"
GOSUB GrabaUnConoTecho
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
Variables:
TamaCuerpoXY = 6
AltoCuerpo = TamaCuerpoXY / Phi
ProfundoEscalones = TamaCuerpoXY / 8
AltoEscalones = AltoCuerpo / 24
DiamColumAngulos = 2 / 3
DiamConosLados = DiamColumAngulos / Phi
ColumnasPorLado = 8
AnchoEscalones = TamaCuerpoXY * ((ColumnasPorLado - 2) / (ColumnasPorLado - 1))
Alfa = (TamaCuerpoXY / Phi) * SIN(Pi / 4)
Charlie = DiamColumAngulos
Bravo = TamaCuerpoXY / 2 - Alfa / 2 - Charlie / 2
AltoCharlie = AltoCuerpo
AltoBravo = Alfa / 2
RETURN