06-18-2003, 09:23 PM
could anyone point out why this could be causing a 196kb file instead of a 12800kb file?
The problem area is called SaveMap:
The problem area is called SaveMap:
Code:
DECLARE FUNCTION askyesnoexit% (y%, x%, var.max%)
DECLARE SUB speedslower ()
DECLARE SUB header ()
DECLARE SUB setrandom ()
DECLARE SUB sleep2 ()
CLEAR
'$DYNAMIC
CLS : SCREEN 12
'Cellular Automata map creation utility release 3.01
'(c) Agamemnus (Michael Romanovsky) 2002-2003
'If you wish to use this for a freeware program please give due credit.
'Otherwise please give due compensation. :)
DIM randerosion%(1000)
DIM SHARED x.max AS INTEGER, y.max AS INTEGER: x.max = 40: y.max = 40
DIM temp1 AS LONG, temp2 AS LONG: temp1 = x.max: temp2 = y.max
DIM SHARED total AS LONG: total = temp1 * temp2
DIM SHARED cell%(x.max + 2, y.max + 2), cell2%(x.max + 2, y.max + 2)
DIM SHARED loadedstring$(20), option$(20)
header
askvars:
COLOR 15
LOCATE 7, 1: PRINT "Use preset conditions? (use arrow keys)"
COLOR 1
LOCATE 8, 1: PRINT "(otherwise load conditions)"
COLOR 4
option$(0) = "no": option$(1) = "yes": option$(2) = "exit"
choice% = askyesnoexit(7, 41, 3)
SELECT CASE choice%
CASE 0: GOSUB loadvars
CASE 1: GOSUB presetvars
CASE 2: SYSTEM
END SELECT
IF random1% = 1 THEN setrandom
IF randratio% = 0 THEN randratio% = INT(RND * 10) + 40
IF RandomC% = 0 THEN GOSUB randomoption0
CLS
'Main Loop
DO
swcolor% = 1 - swcolor%: GOSUB worldround
FOR x% = 1 TO x.max
FOR y% = 1 TO y.max
neighbors% = 0
IF cell%(x% - 1, y%) = 3 THEN neighbors% = neighbors% + 1
IF cell%(x% + 1, y%) = 3 THEN neighbors% = neighbors% + 1
IF cell%(x% - 1, y% - 1) = 3 THEN neighbors% = neighbors% + 1
IF cell%(x%, y% - 1) = 2 THEN neighbors% = neighbors% + 1
IF cell%(x% + 1, y% - 1) = 3 THEN neighbors% = neighbors% + 1
IF cell%(x% - 1, y% + 1) = 3 THEN neighbors% = neighbors% + 1
IF cell%(x% + 1, y% + 1) = 3 THEN neighbors% = neighbors% + 1
IF cell%(x%, y% + 1) = 3 THEN neighbors% = neighbors% + 1
IF Erosion% = 1 THEN LandWaterRatio% = randerosion%(TCycles%)
IF cell%(x%, y%) = 0 AND neighbors% < 4 THEN cell2%(x%, y%) = 3
IF cell%(x%, y%) = 3 AND neighbors% > LandMassSize% THEN cell2%(x%, y%) = 0
IF cell%(x%, y%) <> 0 AND neighbors% = LandWaterRatio% THEN cell2%(x%, y%) = 0
NEXT y%, x%
IF speed% <> 0 THEN speedslower
IF INKEY$ <> "" THEN EXIT DO 'This MUST be placed in this spot..
GOSUB pretty.colors: TCycles% = TCycles% + 1
LOOP
GOSUB read.pretty.colors
ratio1% = 100 * land& / total
ratio2% = 100 * water& / total
ratio3% = 100 * (total - land& - water&) / total
COLOR 15
LOCATE 19, 1: PRINT "Variations ended at:"; tvars&; " variations.";
PRINT TCycles%; "total cyles."
LOCATE 21, 1: PRINT "Percent Color" + STR$(ForestColor%) + ": "; ratio1%; "%"
LOCATE 22, 1: PRINT "Percent Color" + STR$(WaterColor%) + ": "; ratio2%; "%"
LOCATE 23, 1: PRINT "Percent Color" + STR$(LandColor%) + ": "; ratio3%; "%"
sleep2
DO
LOCATE 25, 1: PRINT STRING$(50, " ")
LOCATE 25, 1: INPUT "Save Map to file? ", I$: I$ = UCASE$(I$)
IF I$ = "Y" OR I$ = "YES" THEN GOSUB SaveMap: EXIT DO
IF I$ = "N" OR I$ = "NO" OR I$ = "EXIT" OR I$ = "QUIT" THEN EXIT DO
LOOP
END
worldround:
FOR y% = 1 TO y.max
cell%(0, y%) = cell%(x.max, y%)
cell%(x.max + 1, y%) = cell%(1, y%)
NEXT y%
FOR x% = 1 TO x.max
cell%(x%, 0) = cell%(x%, y.max)
cell%(x%, y.max + 1) = cell%(x%, 1)
NEXT x%
RETURN
WorldNotRound:
FOR y% = 1 TO y.max
cell%(0, y%) = 0
cell%(x.max + 1, y%) = 0
NEXT y%
FOR x% = 1 TO x.max
cell%(x%, 0) = 0
cell%(x%, y.max + 1) = 0
NEXT x%
RETURN
randomoption0:
FOR x% = OceanEdgeSizeX% TO x.max - OceanEdgeSizeX%
FOR y% = OceanEdgeSizeY% TO y.max - OceanEdgeSizeY%
cell%(x%, y%) = INT(RND * 2)
NEXT y%, x%
RETURN
randomoption1:
FOR x% = OceanEdgeSizeX% TO x.max - OceanEdgeSizeX%
FOR y% = OceanEdgeSizeY% TO y.max - OceanEdgeSizeY%
CellAB% = INT(RND * 100)
CellAB2% = INT(RND * 100)
IF CellAB% < CellAB2% - 1 THEN
cell%(x%, y%) = 0
ELSE
cell%(x%, y%) = 3
END IF
NEXT y%, x%
RETURN
randomoption2:
FOR x% = OceanEdgeSizeX% TO x.max - OceanEdgeSizeX%
FOR y% = OceanEdgeSizeY% TO y.max - OceanEdgeSizeY%
CellAB% = INT(RND * 100)
IF CellAB% > randratio% THEN
cell%(x%, y%) = 0
ELSE
cell%(x%, y%) = 3
END IF
NEXT y%, x%
RETURN
randerosionset:
RANDOMIZE erosionseed%
FOR I% = 1 TO 1000
randerosion%(I%) = INT(RND * randerosionvar1%) + randerosionvar2%
NEXT I%
RETURN
presetvars:
LandColor% = 6: ForestColor% = 1: WaterColor% = 2
OceanEdgeSizeX% = 0: OceanEdgeSizeY% = 0
WRound% = 1
LandWaterRatio% = 6: LandMassSize% = 4
BeachShow% = 2: Erosion% = 0
randerosionvar1% = 3: randerosionvar2% = 2: erosionseed% = 0
interval% = 1: random1% = 1
randratio% = 0: seed% = 0: speed% = 0
RETURN
loadvars:
COLOR 15
LOCATE 7, 1: PRINT STRING$(50, " "): LOCATE 8, 1: PRINT STRING$(33, " ")
LOCATE 7, 1: INPUT "File name? (full directory please) ", filename$
IF INSTR(filename$, ".ini") = 0 THEN filename$ = filename$ + ".ini"
OPEN filename$ FOR INPUT AS #1
FOR I% = 1 TO 20
INPUT #1, loadedstring$(I%)
startwrite% = INSTR(loadedstring$(I%), ")") + 1
endwrite% = INSTR(loadedstring$(I%), "/") - 4
loadedstring$(I%) = MID$(loadedstring$(I%), startwrite%, endwrite%)
NEXT I%
CLOSE #1
LandColor% = VAL(loadedstring$(1))
WaterColor% = VAL(loadedstring$(2))
x.max = VAL(loadedstring$(3))
y.max = VAL(loadedstring$(4))
REDIM cell%(x.max + 2, y.max + 2)
REDIM cell2%(x.max + 2, y.max + 2)
OceanEdgeSizeX% = VAL(loadedstring$(5))
OceanEdgeSizeY% = VAL(loadedstring$(6))
WRound% = VAL(loadedstring$(7))
LandWaterRatio% = VAL(loadedstring$(8))
LandMassSize% = VAL(loadedstring$(9))
BeachShow% = VAL(loadedstring$(10))
Erosion% = VAL(loadedstring$(11))
randerosionvar1% = VAL(loadedstring$(12))
randerosionvar2% = VAL(loadedstring$(13))
erosionseed% = VAL(loadedstring$(14))
interval% = VAL(loadedstring$(15))
random1% = VAL(loadedstring$(16))
randratio% = VAL(loadedstring$(17))
seed% = VAL(loadedstring$(18))
speed% = VAL(loadedstring$(19))
ForestColor% = VAL(loadedstring$(20))
PRINT "Settings loaded.": sleep2
RETURN
SaveMap:
COLOR 15
LOCATE 26, 1: INPUT "File name to save as? (full directory please) ", filename$
IF INSTR(filename$, ".map") = 0 THEN filename$ = filename$ + ".map"
mapstring$ = SPACE$(x.max)
DIM temp AS STRING * 1
OPEN filename$ FOR RANDOM AS #1
part1% = (x.max% - part2%) / 256
temp$ = CHR$(part1): PUT #1, 1, temp$
temp$ = CHR$(part2): PUT #1, 2, temp$
part2% = (y.max% MOD 256)
part1% = (y.max% - part2%) / 256
temp$ = CHR$(part1): PUT #1, 3, temp$
temp$ = CHR$(part2): PUT #1, 4, temp$
cur.loc% = 5
PRINT LEN(mapstring$) * x.max%
SLEEP
FOR y% = 1 TO y.max
FOR x% = 1 TO x.max
MID$(mapstring$, x%, 1) = CHR$(cell%(x%, y%))
NEXT x%
PRINT LEN(mapstring$), cur.loc%: SLEEP: I$ = INKEY$
PUT #1, cur.loc%, mapstring$
cur.loc% = cur.loc% + x.max
NEXT y%
CLOSE
RETURN
pretty.colors:
FOR x% = 1 TO x.max: FOR y% = 1 TO y.max
IF cell%(x%, y%) <> cell2%(x%, y%) THEN
cell%(x%, y%) = cell2%(x%, y%): cc% = cell2%(x%, y%)
IF swcolor% = 0 THEN IF cc% = 3 THEN cc% = 0 ELSE cc% = 3
IF cc% = 0 THEN cc% = ForestColor% ELSE cc% = WaterColor%
ELSE
cc% = LandColor%
END IF
PSET (x%, y%), cc%
NEXT y%, x%
RETURN
read.pretty.colors:
FOR x% = 1 TO x.max: FOR y% = 1 TO y.max
IF cell%(x%, y%) <> cell2%(x%, y%) THEN
cell%(x%, y%) = cell2%(x%, y%): cc% = cell2%(x%, y%)
IF swcolor% = 0 THEN IF cc% = 3 THEN cc% = 0 ELSE cc% = 3
IF cc% = 0 THEN cc% = ForestColor%: land& = land& + 1 ELSE cc% = WaterColor%: water& = water& + 1
ELSE
tvars& = tvars& + 1
cc% = LandColor%
END IF
cell%(x%, y%) = cc%
NEXT y%, x%
RETURN
REM $STATIC
FUNCTION askyesnoexit% (y%, x%, var.max%)
var.max% = var.max% - 1
var.choice% = 0
FOR I% = 0 TO var.max%
IF LEN(option$(I%)) > maxlength% THEN maxlength% = LEN(option$(I%))
NEXT I%
DO
redo1:
I$ = INKEY$
IF I$ = "" THEN GOTO redo1
IF I$ = CHR$(0) + "M" THEN var.choice% = var.choice% + 1
IF I$ = CHR$(0) + "K" THEN var.choice% = var.choice% - 1
IF I$ = CHR$(0) + "H" THEN var.choice% = var.choice% + 1
IF I$ = CHR$(0) + "P" THEN var.choice% = var.choice% - 1
IF I$ = CHR$(13) THEN EXIT DO
IF var.choice% < 0 THEN var.choice% = var.max%
IF var.choice% > var.max% THEN var.choice% = 0
LOCATE y%, x%: PRINT option$(var.choice%) + SPACE$(maxlength% - LEN(option$(var.choice%)))
LOOP
askyesnoexit% = var.choice%
END FUNCTION
SUB header
COLOR 4
PRINT " Cellular Automata Map Creation Utility release 3.01"
COLOR 1
PRINT
PRINT " (C) 2002 Agamemnus (Michael Romanovsky)"
PRINT " (Member of "; : COLOR 9: PRINT "Flyingsoft"; : COLOR 1: PRINT " Programming Group)"
END SUB
SUB setrandom
COLOR 15
redo2:
LOCATE 7, 1: PRINT STRING$(80, " ")
LOCATE 7, 1: INPUT "Give me a random number seed! (0 = random number)", rngseedS$
rngseedS$ = UCASE$(seedS$)
IF rngseedS$ = "NO" THEN LOCATE 8, 1: PRINT "Don't be a fool!": sleep2: GOTO redo2
rngseed% = VAL(seedS$)
IF rngseed% = 0 THEN RANDOMIZE TIMER
LOCATE 23, 1: PRINT "<press any key to continue>"
sleep2
END SUB
SUB sleep2
loop2:
IF INKEY$ <> "" THEN EXIT SUB
GOTO loop2
END SUB
SUB speedslower
FOR I% = 1 TO 1000
FOR I2% = 1 TO speed%
NEXT I2%
NEXT I%
END SUB
Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."
Visit www.neobasic.net to see rubbish in all its finest.
Visit www.neobasic.net to see rubbish in all its finest.