Posts: 3,368
Threads: 195
Joined: Jan 2003
..
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.
Posts: 1,774
Threads: 62
Joined: Aug 2003
Sorry... I spaced out. :lol: It's very interesting behavior, but the code seems a bit obfuscated to my eyes... it's probably because I've started using longer names for variables and I'm hooked on FBIDE's auto indenter. It's really nice though, and a hell of alot faster than what I posted. 
EDIT:
I changed this to use integers only, and it does a fade thing. It's kinda like a screen-saver now. 
Code: #Include "Fbgfx.bi"
Option Explicit
Randomize Timer
Const False As Integer = 0
Const True As Integer = Not False
Const Cir_Cnt As Integer = 150
Const SCR_WIDTH As Integer = 320
Const SCR_HEIGHT As Integer = 240
Const BPP As Integer = 16
Screenres SCR_WIDTH, SCR_HEIGHT, BPP,2, 1
ScreenSet 0,1
Setmouse 0,0,0
Type Point2D
X As Integer
Y As Integer
End Type
Type Circles
P As Point2d
Rad As Integer
Hill_Hole As Byte
End Type
Type Colors
As Integer R, G, B
End Type
Declare Function Vec_2D_Dist(vA As Point2D, vB As Point2D) As Integer
Declare Sub Blur_Buffer( Byval Buffer As Colors Ptr Ptr, tBuffer As Colors Ptr Ptr, Strength As Integer )
Dim As Circles Cir(CIR_CNT)
Dim As Integer i, X, Y, R, G, B, All_Colors_Match, Dist
Dim As Colors Ptr Ptr Buffer, tBuffer, Scr_Buffer
Dim As Point2D tVec
Buffer = CAllocate(SCR_WIDTH * Sizeof(Colors) )
tBuffer = CAllocate(SCR_WIDTH * Sizeof(Colors) )
Scr_Buffer = CAllocate(SCR_WIDTH * Sizeof(Colors) )
For X = 0 To SCR_WIDTH-1
Buffer[X] = CAllocate(SCR_Height * Sizeof(Colors) )
tBuffer[X] = CAllocate(SCR_Height * Sizeof(Colors) )
Scr_Buffer[X] = CAllocate(SCR_Height * Sizeof(Colors) )
Next
Do
For i= 0 To Ubound(Cir)
Cir(i).P.X = Rnd*SCR_WIDTH
Cir(i).P.Y = Rnd*SCR_HEIGHT
Cir(i).Rad = 25+(Rnd*100)
Select Case Int(Rnd*2)
Case 0
Cir(i).Hill_Hole = 1
Case 1
Cir(i).Hill_Hole = -1
End Select
Next
For Y = 0 To SCR_HEIGHT-1
For X = 0 To SCR_WIDTH-1
tVec.Y = Y
tVec.X = X
R = 0
G = 128
B = 0
For i = 0 To Ubound(Cir)
Dist = Vec_2D_Dist( Cir(i).P, tVec )
If Dist<=Cir(i).Rad Then
G += (((Cir(i).Rad-Dist))*Cir(i).Hill_Hole)
End If
Next
If G<0 Then G=0
If G>255 Then G=255
If G<=68 And G>=64 Then
R = 128
G = 128
B = 255
End If
If G<64 Then
B = G+Int(Rnd*64)
R = 0
G = 0
End If
If Int(Rnd*2)=0 Then
If B<G Then
G/=1.75
R=G/2.042553191489362
B=G/5.05263157894737
End If
End If
Scr_Buffer[X][Y].R = R
Scr_Buffer[X][Y].G = G
Scr_Buffer[X][Y].B = B
If Multikey(Sc_Escape) Then End
Next
Next
Blur_Buffer Scr_Buffer, tBuffer, 1
Do
All_Colors_Match = True
For Y = 0 To SCR_HEIGHT-1
For X = 0 To SCR_WIDTH-1
Buffer[X][Y].R+=SGN(tBuffer[X][Y].R-Buffer[X][Y].R)
Buffer[X][Y].G+=SGN(tBuffer[X][Y].G-Buffer[X][Y].G)
Buffer[X][Y].B+=SGN(tBuffer[X][Y].B-Buffer[X][Y].B)
If tBuffer[X][Y].R<>Buffer[X][Y].R OR tBuffer[X][Y].G<>Buffer[X][Y].G OR tBuffer[X][Y].B<>Buffer[X][Y].B Then
All_Colors_Match = False
End If
Pset(X,Y), RGB(Buffer[X][Y].R, Buffer[X][Y].G, Buffer[X][Y].B)
If Multikey(Sc_Escape) Then End
Next
Next
Flip
Loop Until All_Colors_Match
Loop Until Multikey(Sc_Escape)
For X = 0 To SCR_WIDTH-1
Deallocate Buffer[X]
Deallocate tBuffer[X]
Deallocate Scr_Buffer[X]
Next
Deallocate Buffer
Deallocate tBuffer
Deallocate Scr_Buffer
End
Sub Blur_Buffer( Byval Buffer As Colors Ptr Ptr, tBuffer As Colors Ptr Ptr, Strength As Integer )
Dim As Integer X, Y, X1, Y1, XBeg, XFin, YBeg, YFin, Hits, R, G, B
For Y = 0 To SCR_HEIGHT-1
For X = 0 To SCR_WIDTH-1
R=0
G=0
B=0
Hits = 0
XBeg = X-Strength
If XBeg<0 Then XBeg=0
YBeg = Y-Strength
If YBeg<0 Then YBeg=0
XFin = X+Strength
If XFin>SCR_WIDTH-1 Then XFin=SCR_WIDTH-1
YFin = Y+Strength
If YFin>SCR_HEIGHT-1 Then YFin=SCR_HEIGHT-1
For Y1 = YBeg To YFin
For X1 = XBeg To XFin
R+= Buffer[X1][Y1].R
G+= Buffer[X1][Y1].G
B+= Buffer[X1][Y1].B
Hits+=1
Next
Next
If Hits=0 Then Hits=1
R/=Hits
G/=Hits
B/=Hits
tBuffer[X][Y].R = R
tBuffer[X][Y].G = G
tBuffer[X][Y].B = B
Next
Next
End Sub
Function Vec_2D_Dist(vA As Point2D, vB As Point2D) As Integer
Dim DX As Integer, _
DY As Integer ,_
Dist As Integer
DX = Va.X - Vb.X
DY = Va.Y - Vb.Y
Dist = Sqr(DX^2 + DY^2)
Function = Dist
End Function
Posts: 2,771
Threads: 96
Joined: Oct 2003
*looks at agas code*
MY EYES!!
you still dont indent your code!?
It really helps with following program flow.
I would comment on the result.. but It wouldnt work on my laptop (which is totally not your fault.. just my crappy laptop >:X)
Dr_D: nice map generator! very sweet. It reminded me of a map generator I made many moons ago. I will dig it out of the archives :)
Posts: 1,774
Threads: 62
Joined: Aug 2003
Cool! I can't wait to see it. I really liked that tree-maker-algo thing you made back at qbtk. :wtnod: Does anyone else remeber that?
Posts: 2,771
Threads: 96
Joined: Oct 2003
Quote:Cool! I can't wait to see it. I really liked that tree-maker-algo thing you made back at qbtk. :wtnod: Does anyone else remeber that?
hehe that was fun. For a mod competition. QBTK, ahh, those were the funny days ^^
Anyway, I would get the thingy out of my archive CD right now, but my laptop refuses to read certain brands of CD -__-;
Posts: 3,368
Threads: 195
Joined: Jan 2003
Dr_Davenstein, that looks very nice. If you change the colors you can rename it "Fingernail Cell Cultures" or something... :lol:
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.
Posts: 2,771
Threads: 96
Joined: Oct 2003
I finally found my long lost terrain generator.
Originally QB code, I hacked it up quickly to work with FB, and changed some of the settings around to take advantage of FB's high speed. Please excuse any poor coding techniques, yucky structure and old methods.
It generates fairly tropical hilly terrain with random lakes and stuff. The only problem is the overall island shape is completely rectangular.
It works by making many, many small patches of random height terrain, then averaging it out.
Back in the day, I had a little voxel engine that you could walk around the island in, which was quite nice. It really reminded me of a tropical island. Ahh. Relaxing :)
Code: defsng a-z
DECLARE SUB writepal (red, grn, blu, palp)
RANDOMIZE TIMER
type rgbtype
r as integer
g as integer
b as integer
end type
dim shared ci(255) as rgbtype
SCREEN 14, 24
sizex = 320
sizey = 200
b = 60
FOR i = 1 TO 8
writepal 0, 0, 60, i
NEXT
FOR i = 9 TO 12
r = r + 60 / 4
g = g + 50 / 4
B = B - 60 / 4
writepal r, g, B, i
NEXT
FOR i = 13 TO 30
writepal 60, 50, 0, i
NEXT
r = 60
g = 50
FOR i = 31 TO 64
r = r - 40 / 33
g = g - 40 / 33
writepal r, g, 0, i
NEXT
r = 20
g = 10
FOR i = 65 TO 192
r = r - 20 / 128
g = g + 50 / 128
writepal r, g, 0, i
NEXT
r = 0
g = 60
B = 0
FOR i = 193 TO 255
r = r + 45 / 63
g = g - 15 / 63
B = B + 45 / 63
writepal r, g, B, i
NEXT
DIM buffer(sizex, sizey)
FOR x = 1 TO sizex
FOR y = 1 TO sizey
buffer(x, y) = 1
NEXT
NEXT
FOR i = 1 TO 800
posx = INT(RND * (sizex - 40)) + 20
posy = INT(RND * (sizey - 40)) + 20
height = INT(RND * 350) + 1
FOR j = 1 TO 50
posx2 = (INT(RND * 16) - 8) + posx
posy2 = (INT(RND * 16) - 8) + posy
IF posx2 > 1 AND posx2 < sizex AND posy2 > 1 AND posy2 < sizey THEN buffer(posx2, posy2) = height
NEXT
NEXT
LOCATE 1, 24: PRINT "]"
FOR smth = 1 TO 4
FOR x = 1 TO sizex - 1
FOR y = 1 TO sizey - 1
av = 0
av = av + buffer(x - 1, y - 1)
av = av + buffer(x + 1, y - 1)
av = av + buffer(x - 1, y + 1)
av = av + buffer(x + 1, y + 1)
av = av + buffer(x, y + 1)
av = av + buffer(x, y - 1)
av = av + buffer(x + 1, y)
av = av + buffer(x - 1, y)
av = av + buffer(x, y)
av = av / 9
IF av > 255 THEN av = 255
IF av < 1 THEN av = 1
buffer(x, y) = av
NEXT
LOCATE 1, 1
a = a + 1
'PRINT "Generating: [" + STRING$((a / ((sizex - 1) * 4)) * 10, "þ")
NEXT
NEXT
for x = 1 to sizex
for y = 1 to sizey
h = buffer(x, y)
if h > 255 then h = 255
PSET (x, y), rgb(ci(h).r, ci(h).g, ci(h).b)
next
next
sleep
END
'CLS
'FOR x = sizex - 1 TO 1 STEP -1
' FOR y = 10 TO sizey + 9
' 'PSET (x, y), buffer(x, y - 10)
' LINE (x * 2 - 2 + y, y * 2 - 2)-(x * 2 + y, y * 2 - buffer(x, y - 10) / 8), buffer(x, y - 10), BF
' NEXT
'NEXT
'END
'FOR x = sizex - 1 TO 2 STEP -2
' FOR y = 12 TO sizey + 9 STEP 2
' LINE (x * 2 + y, y * 2 - buffer(x, y - 10) / 8)-((x - 2) * 2 + y, y * 2 - buffer(x - 2, y - 10) / 8), buffer(x, y - 10)
' LINE (x * 2 + y, y * 2 - buffer(x, y - 10) / 8)-(x * 2 + (y - 2), (y - 2) * 2 - buffer(x, y - 12) / 8), buffer(x, y - 10)
' NEXT
'NEXT
SUB writepal (red, grn, blu, palp)
ci(palp).r = (red / 60) * 255
ci(palp).g = (grn / 60) * 255
ci(palp).b = (blu / 60) * 255
END SUB
Posts: 1,774
Threads: 62
Joined: Aug 2003
Cool. It does remind me of tropical islands. I can taste the pina-coladas already. :lol:
Posts: 3,368
Threads: 195
Joined: Jan 2003
Nice. It's cool.
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.
|
