TheGameCreators - CodeBase - Framogen FractalMapLand

Return to the CodeBase listing

Category: Graphics

Version: 1.0

Information

Uploaded: 3rd Dec 2010 08:59

Modified: 1st Jan 1970 01:00

Author: MagicienBasic

Summary

to make heighmap, fractal land in colors or greys

Full Description

this program can make map saved in Bitmap format, To start you enter<br /> number of iter (length of fractal ex: 8 = 512x512 pixels), follow by<br /> 9 values who make the germ of landscape. Finally you can save in BMP <br /> (15 colors or 256 greys)

DarkBASIC Professional Source 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"

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 "*** FRAMOGEN *** par FranÃ§ois Schneider <Mega 1> to the origin on ATARI ST (France)"

print "               modification for Dark Basic by Arcadia            "

print "This program can make maps in <heightmap> type of fractals maps in levels"

CodeBase - Framogen FractalMapLand

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	MagicienBasic
CodeBase Entries:	1