(http://underwaredesign.com/PlayBasicSig.png)
Kyruss II (PlayBASIC edition)
Long before PlayBASIC ever existed, I was messing around with a couple of ideas for building
programming games, rather than languages. The original version of Kyruss (http://www.underwaredesign.com/forums/index.php?topic=529.0) was based on the idea of the Virus War simulation based on a custom assembly (similar to 68000 assembly) . The original concept was that the Kyruss environment would compile the various code fragments, then run them within a custom machine simulation. Coming from an assembly background myself, I found this rather fun (still do), but you know.. Some people wanted something simpler.
Anyway, long story short, later on the idea came about for another programming game, but this time based on something closer to BASIC. The overall concept was that authors would write AI controller scripts for a 3D BOT. Each AI controls a robot around a simple Wolf 3D styled maze. The last robot standing wins. While the project was never really got off the ground, it did spawn the development of various UnderwareDesign.com (http://underwaredesign.com) applications. From the
Visible Worlds through to of what we now know as
PlayBASIC some years later.
So what's this ? - Well this is a version of the Kyruss II Compiler + VM, ported to PlayBASIC V1.64k (beta19). Porting it was pretty straight forward really, since the original code was written in DB classic. You know, some good old 'search and replace' fixes most of the major stuff. There was a few tidbits that need changing due to functionality differences. But all in all, it only took a couple of hours. The original was written between 18,Mar,2002 and 31,may,2002.
The objective of the port is not to pick up development of the project, but rather to help with testing PlayBasic V1.64K's real world functionality, in particular when under stress. The whole KyrussII package weighs in at over 21,000 lines of code, which compiles in seconds and easily executes
2->3 faster than the original DB version, without any significant changes. Unfortunately DB's limitations mean there's a lot of workarounds in the code. So It's tempting to tweak up it somewhat and make it more PB specific. I'm fairly confident that it could be made two or three times faster again.
KyrussII Sample Code (Familiar huh :) )
rem Example Kyruss program
rem By Kevin Picone
define constant Width=320
define constant Height=200
define constant Width2=width/2
define constant Height2=height/2
define constant Stars_Xpos=0
define constant Stars_Ypos=1
define constant Stars_Xspeed=2
define constant Stars_StructSize=3
Type Aliens
Xpos as integer
Ypos as integer
Endtype
Dim Badguys(100) as aliens
TotalNumbOfStars=10
Dim Stars(TotalNumbOfStars,Stars_StructSize)
For lp=0 to TotalNumbOfStars
Stars(lp,Stars_Xpos)=rnd(width)
Stars(lp,Stars_Ypos)=rnd(height)
Stars(lp,Stars_Xspeed)=rndrange(1,3)
next lp
Function Random_Text(t$)
text rnd(width),rnd(height),t$
Endfunction
` die=wrapangle(50,1)
effectCounter=0
do
if effect=0 then gosub Intro_effect4
if effect=1 then gosub Intro_effect6
if effect=2 then gosub Intro_effect7
if effect=3 then gosub Intro_effect5
if effect=4 then gosub Intro_effect_Sinewaves
if effect=5 then gosub Intro_effect2
if effect=6 then gosub Intro_effect3
if effect=7 then gosub Intro_effect
Sync
loop
BumP_EffectCounter:
inc effectcounter
if effectcounter>60
effectcounter=0
inc effect
if effect>7 then effect=0
endif
return
Bump_Effect:
effectcounter=0
inc effect
if effect>7 then effect=0
return
Intro_effect:
cls $0
ink $ff
print 100
print 123.456
print "Box and Line Demo"
For lp=0 to 50
dot rnd(320),rnd(200)
next lp
ink $ff0000
For lp=0 to 40
` ink (rnd(255)*(2^16))+(rnd(255)*(2^8))+rnd(255)
` ink rndrgb()
linec rnd(width/2),rnd(height/2),rnd(width/2),rnd(height/2),rndrgb()
next lp
For lp=0 to 40
boxc
rndrange(width2,width),rndrange(height2,height),rndrange(width2,width),rndrange(height2,height),rndrgb()
next lp
Gosub BumP_EffectCounter
return
Intro_effect2:
` cls $0
` ink $ff0000
` print "Strips Demo"
` ink $ff
For xlp=0 to width2
boxc xlp,0,320-xlp,199,rndrgb()
next xlp
`
` xlp=width/2
` decloop
`ink rndrgb()
` boxc xlp,0,320-xlp,199,rndrgb()
` decbranch xlp
Gosub BumP_EffectCounter
return
Intro_effect3:
cls $0
ink $ff00
print "Strips Demo"
For ylp=0 to height-1
`ink (rnd(255)*(2^16))
boxc rnd(160),ylp,rndrange(160,320),ylp+1,(rnd(255)*(2^16))
next ylp
Gosub BumP_EffectCounter
return
Intro_effect4:
a=666
b=101010
col=$ff00ff
fadedir=1
circle_col=$ff8040
r=5
For R=0 to 200
cls 0
swap a,b
Random_Text("TESTING FUNCTION")
ink circle_col
circle 160,100,r,1
` ink rgbfade(circle_col,50)
Dotc rnd(320),rnd(200),Rgb(rnd(255),rnd(255),rnd(255))
ink rgbfade(col,fadestep)
fadestep=fadestep+fadedir
if fadestep=>100 then fadedir=-1
if fadestep<0 then fadedir=1
setcursor 150,100
print upper$("Fade")+" Colour "
text 40,100,autocaps$("pretty colours")
ink 255
framestart=timer()
Stuff =0
lp=1000
decloop
inc Stuff
decbranch lp
print "# oF loops:"+str$(Stuff)
gosub show_frame_time
sync
next r
Gosub BumP_Effect
return
show_frame_time:
frameend=timer()
frame=(frameend-framestart)
Totalframetimer=Totalframetimer+frame
inc Totalframes#
AverageFrame#=totalframetimer/totalframes#
print " frame:"+str$(frame)
print "frame average:"+str$(averageframe#)
return
Intro_effect5:
Frames=50
Slidestep#=180.0/frames
Slideangle#=90
col=rgb(rnd(255),rnd(255),rnd(255))
scroll=0
repeat
`framestart=timer()
Xslide#=sin(Slideangle#)*170
Slideangle#=slideangle#-Slidestep#
cls 0
ink $ff0000
xbase=(xbase+1)&31
Gosub Box_playfield2
ink col
text 130+Xslide#,90,autocaps$("scrolling boxes")
` gosub show_frame_time
sync
inc scroll
until scroll>frames
Gosub BumP_Effect
return
Box_playfield2:
ypos=0
ylp=9
decloop
xpos=-32+xbase
ypos2=ypos+28
xlp=12
decloop
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
decbranch xlp
ypos=ypos+32
decbranch ylp
return
Box_playfield:
ypos=0
` For ylp=0 to 9
ylp=9
decloop
xpos=-32+xbase
ypos2=ypos+28
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
box xpos,ypos,xpos+28,ypos2
xpos=xpos+32
box xpos,ypos,xpos+28,ypos2
ypos=ypos+32
decbranch ylp
return
Intro_effect6:
gosub setup
Frames=250
scroll=0
repeat
` cls 0
` circlec x1,y1,rndrange(5,10),1,rndrgb()
` circlec x2,y2,rndrange(5,10),1,rndrgb()
linec x1,y1,x2,y2,rndrgb()
if x1<0 or x1>width then x1d=neg(x1d)
if x2<0 or x2>width then x2d=neg(x2d)
if y1<0 or y1>height then y1d=neg(y1d)
if y2<0 or y2>height then y2d=neg(y2d)
x1=x1+x1d
y1=y1+y1d
x2=x2+x2d
y2=y2+y2d
sync
inc scroll
until scroll>frames
Gosub BumP_Effect
return
GetSpeed:
repeat
speed=rndrange(-5,5)
until speed<>0
return
setup:
x1=rnd(width)
y1=rnd(height)
x2=rnd(width)
y2=rnd(height)
Gosub GetSpeed
x1d=Speed
Gosub GetSpeed
y1d=Speed
Gosub GetSpeed
x2d=Speed
Gosub GetSpeed
y2d=Speed
return
Intro_effect7:
Frames=250
scroll=0
repeat
cls 0
ink $ff0000
xbase=(xbase+1)&31
` Gosub Box_playfield
ink $ff00
print "2D array Test"
lp=TotalNumbOfStars-1
decloop
x=(Stars(lp,Stars_Xpos)-Stars(lp,Stars_Xspeed))
if x<0 then x=x+width
circlec x,Stars(lp,Stars_Ypos),rndrange(5,10),1,rndrgb()
` dotc x,Stars(lp,Stars_Ypos),rndrgb()
Stars(lp,Stars_Xpos)=x
decbranch lp
sync
inc scroll
until scroll>frames
Gosub BumP_Effect
return
Intro_effect_Sinewaves:
Frames=120
repeat
sinebaseangle=wrapvalue(sinebaseangle,2)
cls 0
lp=width
angle=sinebaseangle
radius=5
ink $f0ff0f
decloop
box lp,sinnewvalue(100,angle,50),lp,200
dec angle
decbranch lp
circlec radius,sinnewvalue(99-radius,angle+radius,50),radius,1,rndrgb()
ink $00ff00
print "Sine It Up"
sync
inc scroll
until scroll>frames
Gosub BumP_Effect
return
Download Kyruss II (V0.56) (http://www.underwaredesign.com/?page=programs.Kyruss-II)
i have v1.64K beta19 and there are countless compilererrors here.
Most of them are missing parameters of box or boxc and many are because of the missing do for decloop. there is also something with decbranch (a command which i never heard of :D)