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