Framogen FractalMapLand by MagicienBasic3rd Dec 2010 8:59
|
|---|
|
Summary to make heighmap, fractal land in colors or greys Description this program can make map saved in Bitmap format, To start you enter Code ` This code was downloaded from The Game Creators
` It is reproduced here with full permission
` http://www.thegamecreators.com
Rem Project: Dark Basic Pro Project
Rem Created: Tuesday, November 23, 2010
remstart
To the origin this source appeared in the
magazine ATARI ST (France) the code is of
François Schneider <Mega 1> coded in Gfa v3
I simplified it -not returned display 3D -
solely returned map in levels of colors
or grey.
This source is raw, you can easely modify it.
Excuse me for my bad translation in english
remend
Rem ***** Main Source File *****
set display mode 800,600,32
set window on
set window size 800,600
set window position 0,0
sync off
set text size 20
set text opaque
dimension= 2^12
DIM h(dimension,dimension)
DIM x3d(3)
dim y3d(3)
dim z3d(3)
dim xaff(3)
dim yaff(3)
dim encre(15)
CLS
create bitmap 1,800,600
set current bitmap 0
ink rgb(230,230,230),rgb(0,0,0)
gosub infoText
REPEAT
INPUT "Number of iterations (4-10) ?";niter
UNTIL niter => 4 AND niter <= 10
rem C'est ici que cela plantera si vous n'avez pas
rem un ordinateur avec une grosse carte graphique
if niter = 9 then create bitmap 1,1024,1024
if niter = 10 then create bitmap 1,2048,2048
gosub neufpremiers
depth = niter
gosub calcul
CLS
gosub initcoul1
depth = niter
gosub affcarte
set current bitmap 0
If niter = 9 then copy bitmap 1,0,0,1024,1024,0,0,0,512,512
if niter < 9 then copy bitmap 1,0,0,taille,taille,0,0,0,taille,taille
rem name of the bitmap in 15 colors
sav_img$ ="FRAMO-DB.BMP"
DO
ink rgb(230,230,0),rgb(0,0,0)
text 540,100,"Save BMP (Y/N) ?"
text 540,130,"nom: " + sav_img$
text 540,160," in 15 colors <Q> "
text 540,190," in 256 grey <G> "
if niter = 9
text 540,220,"Reduced picture for display"
endif
gris = 0
set cursor 540,250
text 540,250," "
text 540,500," "
input "?: ";choi$
choi$=upper$(choi$)
if choi$ = "Y"
sav_img$ = "FRAMO-DB.BMP"
save image sav_img$,1
ENDIF
if choi$ = "N"
delete bitmap 1
BREAK
END
ENDIF
if choi$ = "Q"
sav_img$ = "FRAMO-DB.BMP"
endif
if choi$ = "G"
text 540,500,"Wait please ..."
gris = 256
depth = niter
sav_img$ = "FRA-Grey.BMP"
gosub affcarte
set current bitmap 0
ENDIF
LOOP
rem choice of colors for style geographic map
initcoul1:
encre(1) = rgb(0,51,204)
encre(2) = rgb(51,102,0)
encre(3) = rgb(51,153,0)
encre(4) = rgb(0,204,0)
encre(5) = rgb(51,255,0)
encre(6) = rgb(102,255,0)
encre(7) = rgb(204,153,0)
encre(8) = rgb(255,153,0)
encre(9) = rgb(204,102,0)
encre(10) = rgb(204,51,0)
encre(11) = rgb(153,0,0)
encre(12) = rgb(102,0,0)
encre(13) = rgb(115,255,255)
encre(14) = rgb(204,255,255)
encre(15) = rgb(255,255,255)
RETURN
Rem j'ai changé les PROCEDURE Gfa en gosub en DBPro
neufpremiers:
LOCAL i,j
PRINT "Voici la disposition des 9 premiers"
PRINT " a(0,0) a(1,0) a(2,0)"
PRINT " a(0,1) a(1,1) a(2,1)"
PRINT " a(0,2) a(1,2) a(2,2)"
PRINT "Enter the altitudes of these points"
PRINT "(of préférence between -128 et 256)"
FOR j = 0 TO 2
FOR i = 0 TO 2
PRINT "altitude of a(";i;",";j;")>";
INPUT h(i,j)
NEXT i
NEXT j
RETURN
rem en principe en GFA calcul(niter%) = PROCEDURE
calcul:
LOCAL amp,n,i,j
amp = 256
n = 2
PRINT " Iterations;";
FOR iter=1 TO depth
PRINT iter;"..";
FOR j = n TO 0 step - 1
FOR i = n TO 0 step - 1
h(i *2,j *2)= h(i,j)
NEXT i
NEXT j
n = n *2
rem the dimension doubled
FOR j = 1 TO n -1 STEP 2
FOR i = 1 TO n -1 STEP 2
rem the points a(i,j) of index i even and j odd
rem has for altitude the averages of those of a(i,j-1) and a(i,j+1)
h(i-1,j)=(h(i-1,j-1)+h(i-1,j+1))/2
h(i -1,j)= h(i -1,j)+ INT( Rnd(amp)- amp / 2)
rem for i odd and j even, the altitude is the average
rem between those of a(i-1,j) et a(i+1,j)
h(i,j -1)=(h(i -1,j -1)+h(i + 1,j - 1)) / 2
h(i,j -1)= h(i,j -1) + INT( RND(amp)- amp / 2)
rem for i and j odds the altitude is the average
rem of the altitudes of the 4 points of coordinates even neighbors...
h(i,j)= h(i -1,j -1)+h(i -1,j +1)
h(i,j)= h(i,j) + h(i +1,j -1)+ h(i +1,j +1)
h(i,j)= h(i,j) / 4 + INT( RND(amp) - amp / 2)
rem this loop doesn't treat the new points
rem of the last column of the picture
NEXT i
NEXT j
FOR i = 1 TO n -1 STEP 2
rem We treat here the new points of the last
rem lign and of the last column
h(n,i)=(h(n,i-1)+h(n,i+1))/2+ INT( RND ( amp)- amp / 2)
h(i,n)=(h(i-1,n)+h(i+1,n))/2+ INT( RND ( amp)- amp / 2)
NEXT i
amp = amp / 2
rem We divide the amplitude by 2
NEXT iter
RETURN
affcarte:
LOCAL n,i,j
n= 2^(depth +1)
CLS
taille = n
TEXT 540,0,"FRActal MOuntain GENerator"
text 580,30,"taille: "+str$(taille)+"pixels "
set current bitmap 1
FOR j =0 TO n
FOR i =0 TO n
if gris =0 then ink coul1(h(i,j)),rgb(0,0,0)
if gris = 256
height=h(i,j)
if height> 255 then height = 255
rem Many values less than zero = many level <sea>
if height < 1 then height = 0
rem it's a grey color
ink rgb(height,height,height),rgb(0,0,0)
endif
dot i,j
NEXT i
NEXT j
get image 1,0,0,taille,taille
if taille > 512 then taille = 512
copy bitmap 1,0,0,taille,taille,0,0,0,taille,taille
rem wait key
RETURN
FUNCTION coul1(alt)
LOCAL coul
coul=alt / 19 + 2
IF coul > 15
coul = 15
ENDIF
IF coul < 1
coul = 1
ENDIF
coul = encre(coul)
ENDFUNCTION coul
infotext:
print
PRINT "*** FRAMOGEN *** par François Schneider <Mega 1> to the origin on ATARI ST (France)"
print " modification for Dark Basic by Arcadia "
Print
print "This program can make maps in <heightmap> type of fractals maps in levels"
print "of colors or greys, to start you must enter the number of iterations"
print "who give the size of the picture"
Print " ex: <4> =map of 32 pixels,... <8> = 512 pixels, <9> = 1024 pixels"
print
print " CAUTION ! "
Print "if our computer don't have performance in graphic card or memory"
print "avoid number great than <8> "
print
print "After:"
print "You must enter 9 values who display the germe of this <Heightmap> "
print
print
return
|