Source code
Here I'll present short code snippets or longer examples. Happy copy pasting ;-)
High score tables (PlayBasic)
This code should help you to load, save and sort your high scores.
RemStart
Highscores contains the top MAX_SCORES high scores. The best high score is at index 1,
the "worst" high score is at index MAX_SCORES
RemEnd
Constant MAX_SCORES = 10
Dim Highscores(MAX_SCORES+1)
Dim HighscoreNames$(MAX_SCORES+1)
Psub GetNumberOfHighscores()
EndPsub MAX_SCORES
Function IsHighscore(newscore)
Local i
For i = 1 To MAX_SCORES
If Highscores(i) < newscore
Exitfunction True
EndIf
Next
EndFunction False
Psub InsertHighscore(newscore, newname$)
Local i, newpos = -1
i = 1
While newpos = -1
If Highscores(i) < newscore
newpos = i
Else
Inc i
EndIf
EndWhile
If newpos <> -1
; insert the new score and move down the others
For i = MAX_SCORES To newpos Step -1
Highscores(i) = Highscores(i-1)
HighscoreNames$(i) = HighscoreNames$(i-1)
Next
Highscores(newpos) = newscore
HighscoreNames$(newpos) = newname$
EndIf
EndPsub
Psub GetHighscoreAndNameAt(index)
Local score, name$
If index > 0 And index <= MAX_SCORES
score = Highscores(index)
name$ = HighscoreNames$(index)
Else
score = 0
name$ = "Unknown"
EndIf
EndPsub score, name$
Psub LoadHighscores(file$)
Local fn, i
If FileExist(file$) = 1
fn = GetFreeFile()
ReadFile file$, fn
For i = 1 To MAX_SCORES
Highscores(i) = ReadInt(fn)
HighscoreNames$(i) = ReadString$(fn)
Next
CloseFile fn
Else
; file does not exist, so generate and save default high scores
GenerateDefaultHighscores()
SaveHighscores(file$)
EndIf
EndPsub
Psub SaveHighscores(file$)
Local fn, i
fn = GetFreeFile()
WriteFile file$, fn
For i = 1 To MAX_SCORES
WriteInt fn, Highscores(i)
WriteString fn, HighscoreNames$(i)
Next
CloseFile fn
EndPsub
Psub GenerateDefaultHighscores()
Local i
For i = 1 To MAX_SCORES
Highscores(i) = 1000
HighscoreNames$(i) = "Tommy"
Next
EndPsub
The code
<nowiki>
; PROJECT : Plasma
; AUTHOR : Tommy Haaks
; CREATED : 16.05.2006
; EDITED : 18.05.2006
; ---------------------------------------------------------------------
Explicit True
Constant SCREEN_WIDTH = 800
Constant SCREEN_HEIGHT = 600
Global PlasmaWidth = 0
Global PlasmaHeight = 0
OpenScreen SCREEN_WIDTH, SCREEN_HEIGHT, 16, 1
Cls 0
DrawPlasma(400,400)
Sync
WaitKey
the real worker psubs start here
Psub Displace(num#)
Local max#, rand#
max# = num# / (PlasmaWidth + PlasmaHeight) * 3.0
rand# = (Rnd#(1.0) - 0.5) * max#
EndPsub rand#
c# is a value between 0.0 and 1.0 and is mapped to some color
this PSub can influence the generated pictures very much
Psub ComputeColor(c#)
Local r#, g#, b#, red, green, blue, col
r# = 0.0
g# = 0.0
b# = 0.0
If c# < 0.5
r# = c# * 2
Else
r# = (1.0 - c#) * 2
EndIf
If c# >= 0.3 And c# < 0.8
g# = (c# -0.3) * 2
ElseIf c# < 0.3
g# = (0.3 - c#) * 2
Else
g# = (1.3 - c#) * 2
EndIf
If c# >= 0.5
b# = (c# -0.5) * 2
Else
b# = (0.5 - c#) * 2
EndIf
r#, g# And b# are now values between 0 And 1. We need To map those To values between 0 And 255 For RGB()
red = Int(r# * 255)
green = Int(g# * 255)
blue = Int(b# * 255)
col = RGB(red, green, blue)
EndPsub col
Psub DrawPixel(x,y,col#)
Local pixcol
pixcol = ComputeColor(col#)
Ink pixcol
Dot x, y
EndPsub
Psub DrawPlasma(width, height)
Local c1#, c2#, c3#, c4#
PlasmaWidth = width
PlasmaHeight = height
Assign the four corners of the initial grid random color values
these will end up being the colors of the four corners of the image
c1# = Rnd#(1.0)
c2# = Rnd#(1.0)
c3# = Rnd#(1.0)
c4# = Rnd#(1.0)
DivideGrid(0, 0, width, height, c1#, c2#, c3#, c4#)
EndPsub
this is the recursive function that implements the random midpoint
displacement algorithm. It will call itself until the grid pieces
become smaller than one pixel.
Function DivideGrid(x, y, w, h, c1#, c2#, c3#, c4#)
Local e1#, e2#, e3#, e4#, m#
Local neww, newh, col#
neww = w / 2
newh = h / 2
DrawPixel(x, y, c1#) ; top left
DrawPixel(x+w-1, y, c2#) ; top right
DrawPixel(x+w-1, y+h-1, c3#) ; bottom right
DrawPixel(x, y+h-1, c4#) ; bottom left
m# = (c1# + c2# + c3# +c4#) / 4.0 + Displace(neww + newh) randomly displace the midpoint
make sure that the midpoint doesn't accidentally "randomly displaced" past the boundaries!
If m# < 0.0
m# = 0.0
ElseIf m# > 1.0
m# = 1.0
EndIf
DrawPixel(x+neww, y+newh, m#) ; center
If w <= 2 Or h <= 2
Exitfunction
EndIf
e1# = (c1# + c2#) / 2.0 calculate the edges by averaging the two corners of each edge
e2# = (c2# + c3#) / 2.0
e3# = (c3# + c4#) / 2.0
e4# = (c4# + c1#) / 2.0
// do the operation again for each of the four new grids
DivideGrid(x, y, neww, newh, c1#, e1#, m#, e4#) ; top left grid
DivideGrid(x+neww, y, w-neww, newh, e1#, c2#, e2#, m#) ; top right grid
DivideGrid(x+neww, y+newh, w-neww, h-newh, m#, e2#, c3#, e3#); bottom right grid
DivideGrid(x, y+newh, neww, h-newh, e4#, m#, e3#, c4#); bottom left grid
EndFunction
The code
<nowiki>
; PROJECT : Plasma
; AUTHOR : Tommy Haaks
; CREATED : 16.05.2006
; EDITED : 22.05.2006
; ---------------------------------------------------------------------
Explicit True
Constant SCREEN_WIDTH = 800
Constant SCREEN_HEIGHT = 600
Constant WhiteColor = RGB(255,255,255)
Constant BORDER# = 0.3
Dim Color1(3)
Dim Color2(3)
Color1(1) = 0x07
Color1(2) = 0x5a
Color1(3) = 0x9a
Color2(1) = 0x8f
Color2(2) = 0x28
Color2(3) = 0xd7
Global PlasmaWidth = 0
Global PlasmaHeight = 0
OpenScreen SCREEN_WIDTH, SCREEN_HEIGHT, 16, 1
Do
Cls 0
LockBuffer
DrawPlasma(512,512)
DrawStars(100)
UnLockBuffer
Sync
WaitKey
WaitNoKey
Loop
End
the real worker psubs start here
Psub Displace(num#)
Local max#, rand#
max# = num# / (PlasmaWidth + PlasmaHeight) * 3.0
rand# = (Rnd#(1.0) - 0.5) * max#
EndPsub rand#
c# is a value between 0.0 and 1.0 and is mapped to some color
this PSub can influence the generated pictures very much
RemStart
;Psub ComputeColor(c#)
Local r#, g#, b#, red, green, blue, col
r# = 0.0
g# = 0.0
b# = 0.0
If c# < 0.5
r# = c# * 2
Else
r# = (1.0 - c#) * 2
EndIf
If c# >= 0.3 And c# < 0.8
g# = (c# -0.3) * 2
ElseIf c# < 0.3
g# = (0.3 - c#) * 2
Else
g# = (1.3 - c#) * 2
EndIf
If c# >= 0.5
b# = (c# -0.5) * 2
Else
b# = (0.5 - c#) * 2
EndIf
r#, g# And b# are now values between 0 And 1. We need To map those To values between 0 And 255 For RGB()
red = Int(r# * 255)
green = Int(g# * 255)
blue = Int(b# * 255)
col = RGB(red, green, blue)
;EndPsub col
RemEnd
Psub ComputeColor(x, y, c#)
Local b#, red, green, blue, col
b# = 1.0 - (Float(y) / Float(PlasmaHeight))
red = Int((Color2(1) * (1.0 - b#) + Color1(1) * b#) * c#)
green = Int((Color2(2) * (1.0 - b#) + Color1(2) * b#) * c#)
blue = Int((Color2(3) * (1.0 - b#) + Color1(3) * b#) * c#)
col = RGB(red, green, blue)
EndPsub col
Psub DrawPixel(x,y,col#)
Local pixcol
pixcol = ComputeColor(x, y, col#)
Ink pixcol
Dot x, y
#Print "x = " + Str$(x) + ", y = " + Str$(y)
EndPsub
Psub DrawPlasma(width, height)
Local c1#, c2#, c3#, c4#
PlasmaWidth = width
PlasmaHeight = height
Assign the four corners of the initial grid random color values
these will end up being the colors of the four corners of the image
c1# = Rnd#(BORDER#) ; 1.0
c2# = Rnd#(BORDER#) ; 1.0
c3# = Rnd#(BORDER#) ; 1.0
c4# = Rnd#(BORDER#) ; 1.0
DivideGrid(0, 0, width, height, c1#, c2#, c3#, c4#)
EndPsub
this is the recursive function that implements the random midpoint
displacement algorithm. It will call itself until the grid pieces
become smaller than one pixel.
Function DivideGrid(x, y, w, h, c1#, c2#, c3#, c4#)
Local e1#, e2#, e3#, e4#, m#
Local neww, newh, col#
#Print "DivideGrid(" + Str$(x) + ", " + Str$(y) + ", " + Str$(w) + ", " + Str$(h) + ")"
neww = w / 2
newh = h / 2
DrawPixel(x, y, c1#) ; top left
DrawPixel(x+w-1, y, c2#) ; top right
DrawPixel(x+w-1, y+h-1, c3#) ; bottom right
DrawPixel(x, y+h-1, c4#) ; bottom left
m# = (c1# + c2# + c3# +c4#) / 4.0 + Displace(neww + newh) randomly displace the midpoint
make sure that the midpoint doesn't accidentally "randomly displaced" past the boundaries!
If m# < 0.0
m# = 0.0
ElseIf m# > BORDER# ; 1.0
m# = BORDER# ; 1.0
EndIf
DrawPixel(x+neww, y+newh, m#) ; center
If w <= 2 Or h <= 2
Exitfunction
EndIf
e1# = (c1# + c2#) / 2.0 calculate the edges by averaging the two corners of each edge
e2# = (c2# + c3#) / 2.0
e3# = (c3# + c4#) / 2.0
e4# = (c4# + c1#) / 2.0
// do the operation again for each of the four new grids
DivideGrid(x, y, neww, newh, c1#, e1#, m#, e4#) ; top left grid
DivideGrid(x+neww, y, w-neww, newh, e1#, c2#, e2#, m#) ; top right grid
DivideGrid(x+neww, y+newh, w-neww, h-newh, m#, e2#, c3#, e3#); bottom right grid
DivideGrid(x, y+newh, neww, h-newh, e4#, m#, e3#, c4#); bottom left grid
EndFunction
Psub DrawStars(amount)
Local i, x, y, s
For i = 1 To amount
x = Rnd(PlasmaWidth)
y = Rnd(PlasmaHeight)
If RgbB(Point(x,y)) > 15
s = Rnd(1) + 1
BoxC x, y, x+s, y+s, 1, WhiteColor
EndIf
Next
EndPsub