|
|
|
Source codeHere 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 |
; 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 |
; 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
|
|
|
| Copyright (C) 2006-2008. All rights reserved. Last update: Tuesday, November 04, 2008 |  | |
|
|
|
; popup.document.open();popup.document.write( '<html><head><link rel=\'stylesheet\' href=\'../_frame/site.css\' type=\'text/css\'></head><body style=\'background-color:#FFFFFF;background-image:url();\' bgcolor=#FFFFFF><center><img src=\'bv000001.jpg\' alt=\'\'><br><br><table class=\'wg-paragraph\' style=\'border:none\'><tr><td><a href=\'javascript:close();\'>close window</a></td></tr></table></center></body></html>' );popup.document.close(); "Click to zoom the image")
; popup.document.open();popup.document.write( '<html><head><link rel=\'stylesheet\' href=\'../_frame/site.css\' type=\'text/css\'></head><body style=\'background-color:#FFFFFF;background-image:url();\' bgcolor=#FFFFFF><center><img src=\'bv000003.jpg\' alt=\'\'><br><br><table class=\'wg-paragraph\' style=\'border:none\'><tr><td><a href=\'javascript:close();\'>close window</a></td></tr></table></center></body></html>' );popup.document.close(); "Click to zoom the image")