DEFLNG W
	RANDOMIZE TIMER
	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 clearing of simple trees in the CBB format."
	PRINT
	PRINT "   Copyright Jean-Luc Ancey, February 12th, 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

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

GrabaUnArbol:
	TamanoArbol = TamArbMini + (TamArbMaxi - TamArbMini) * RND
	Alfa = ParamAlfa * TamanoArbol / TamArbMaxi
	Bravo = ParamBravo * TamanoArbol / TamArbMaxi
	Charlie = ParamCharlie * TamanoArbol / TamArbMaxi
	Delta = ParamDelta * TamanoArbol / TamArbMaxi
	Echo = ParamEcho * TamanoArbol / TamArbMaxi
	Foxtrot = ParamFoxtrot * TamanoArbol / TamArbMaxi
	Golf = ParamGolf * TamanoArbol / TamArbMaxi
	     
	Tipo$ = "cilindros": GOSUB CabezaTipo
	z = zArbol
	TamaX = Foxtrot: TamaY = Foxtrot: TamaZ = Alfa - Charlie
	Exclusion$ = "sup,inf"
	GOSUB GrabaVolumen
	GOSUB ColaTipo
    
	Tipo$ = "esferas": GOSUB CabezaTipo
	z = zArbol + Bravo
	TamaX = Golf: TamaY = Golf: TamaZ = Golf
	Exclusion$ = "sup"
	GOSUB GrabaVolumen
	GOSUB ColaTipo
     
	Tipo$ = "conos": GOSUB CabezaTipo
	z = zArbol + Bravo + Delta
	TamaX = Golf: TamaY = Golf: TamaZ = Echo
	Exclusion$ = "inf"
	GOSUB GrabaVolumen
	GOSUB ColaTipo
	RETURN

GrabaVolumen:
	LineaEscrita$ = "Posi "
	Valor = x: GOSUB TradValorCadena
	LineaEscrita$ = LineaEscrita$ + Cadena$
	Valor = y: GOSUB TradValorCadena
	LineaEscrita$ = LineaEscrita$ + "," + Cadena$
	Valor = z: GOSUB TradValorCadena
	LineaEscrita$ = LineaEscrita$ + "," + Cadena$
	IF Posicion$ <> "" THEN
		LineaEscrita$ = LineaEscrita$ + "," + Posicion$
	END IF
	LineaEscrita$ = LineaEscrita$ + " 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
	IF Tipo$ <> "cubos" THEN
		Valor = NumPuntosXY: GOSUB TradValorCadena
		LineaEscrita$ = LineaEscrita$ + " Punt " + Cadena$
		IF Tipo$ = "esferas" THEN
			Valor = NumPuntosZ: GOSUB TradValorCadena
			LineaEscrita$ = LineaEscrita$ + "," + Cadena$
		END IF
	END IF
	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:
	CLS
	wByteEscrito = 0: wByteLeido = 0
	GOSUB Variables
	GOSUB Suelo
	Arbol = 0
	WHILE Arbol < numArboles
		x = (RND * 2 - 1) * TamanoArea / 2
		y = (RND * 2 - 1) * TamanoArea / 2
		zArbol = 0
		Radio = SQR(x * x + y * y)
		IF Radio <= TamanoArea / 2 AND Radio >= TamanoArea2 / 2 THEN
			Arbol = Arbol + 1
			GOSUB GrabaUnArbol
		END IF
	WEND
	RETURN

Suelo:
	Tipo$ = "cubos": GOSUB CabezaTipo
	x = 0: y = 0: z = 0: Posicion$ = "c"
	TamaX = TamanoArea * 1.2: TamaY = TamaX: TamaZ = 1
	Exclusion$ = "sup,n,s,e,o"
	GOSUB GrabaVolumen
	GOSUB ColaTipo
	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:
	numArboles = 70
	TamanoArea = 50
	TamanoArea2 = 30
	TamArbMini = 3: TamArbMaxi = 7
	ParamAlfa = 6
	ParamBravo = 3
	ParamCharlie = 2.5
	ParamGolf = 6
	ParamDelta = ParamGolf / 2
	ParamEcho = 9
	ParamFoxtrot = 4 / 3
	NumPuntosXY = 5
	NumPuntosZ = 5
	RETURN

    Source: geocities.com/siliconvalley/way/4179

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