Qbasicnews.com

Qbasicnews.com > QBasic > QB Discussion & Programming Help > no sense
Full Version: no sense
You're currently viewing a stripped down version of our content. View the full version with proper formatting.

Agamemnus

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:

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

Glenn

06-18-2003, 10:11 PM
a fixed record length? It seems that for what you're doing, "FOR BINARY" might be what you want. Either way, as you use "PUT#1", sum the number of bytes you're writing and print out that sum at the end and compare it to your file size. Also make sure your file pointer (the parameter after the first comma in "PUT#1") is what it's supposed to be and that you're not just overwriting data that you've already written.

Agamemnus

06-18-2003, 11:28 PM
Oh, I get it.

Whoops.

So I was skipping 40 lines, then 80, all the way up to 1600 blanks. Makes sense..
Qbasicnews.com > QBasic > QB Discussion & Programming Help > no sense