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

Plasma (PlayBasic)

Some plasma generation, based on code from Justin Seyster (see here) and Phil Hassey (see here)...

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

Space nebulae (PlayBasic)

I worked on the plasma code to create space nebulae dynamically. Here is the result.
It works best if the width and height are equal and multiples of 2.

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