Kyruss II

[kevin]

 

    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 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 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 :) )
 

Code Select Expand



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

  Download Kyruss II (V0.56)

[Vee]

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)

[kevin]

perhaps you should read this thread a little more closely :)

[Vee]

 :-X oops it's an independent compiler, forget what I've said ^^

[kevin]

     Kyruss II  V0.56

      This demo is a quick port of my Kyruss II project into the PlayBASIC  language.  While the entire port only took a couple of hours, there's still some quirks with in this edition. I'm not sure if those are due to the port, or the condition of the original code.  Probably both :)..   Which was newer than last tech demo release.   But upon further inspection, it also has some odd issues..   The main drama as a result is that TYPED ARRAYS  don't seem to be working in correctly in this edition...  But ya get that..


 Controls Keys:
 
       F1   = Open File dialog.  This lets you load a new program and run it

       ESC   = Quit Kyruss II

       SPACE = Recompile current program


 Download:

   Download Kyruss II V0.56