Sorry your browser is not supported!

mx=1
my=1
make object sphere 1,16
sync on
do

position camera 66,1,-200
position object 1,mx-16,my-16,0

if mouseclick()=0 then press=0
if mouseclick()=1 and press=0
press=1
 if mouseclick()=1
ball:
WHILE forever=0
position camera 66,1,-200 
  mx=mousex()
  my=mousey()
  mmx=mousemovex()
  mmy=mousemovey()
position object 1,mx-16,my-16,1
if mouseclick()=0 then exit
sync
ENDwhile

n=0
b=0
speed=mmx
WHILE forever=0
position camera 66,1,-200
position object 1,mx-16,my-16,1
mx=mx+mmx
my=my+mmy
if my<>450
if my>=450 then mmy=mmy*-1
endif
if mx>620 then mx=620:mmx=mmx*-1
if mx<20 then mx=20:mmx=mmx*-1
n=n+1
print mmx
print mmy
if n=9
  if mmx>1
   mmx=mmx-1
  endif
  if mmx<-1
   mmx=mmx+1
  endif
endif
if my<>450
if n=2
  if mmy>1
   mmy=mmy-1
  endif
  if mmy<-1
   mmy=mmy+1
  endif
endif
mmy=mmy+1

if mmx>=0 and mmy<>0 and mmx<3
 mmx=2
endif
if mmx<=0 and mmy<>0 and mmx>-3
 mmx=-2
endif

if mmx>2 or mmx<-2
 aa=1
endif

if aa=1 and mmy<2 and mmy>-2
 if mmy<0 then mmy=-1
 if mmy>0 then mmy=1
endif

endif
if my>450 then my=450

if mmx=-1 or mmx=1
 if b<abs(speed) then b=b+1
 if b=abs(speed) then mmx=0
endif

if n=9 then n=0
if mouseclick()=0 then press=0
 if mouseclick()=1 and press=0 and mousex()>mx-11 and mousex()<mx+11 and mousey()>my-11 and mousey()<my+11 then press=1:goto ball
sync
ENDwhile

 endif
endif

sync
loop

sync on : hide mouse

gosub init_images

gosub init_objects

angleup#=45

do

gosub check_input

`adjust limb rotation and position based on input
rotate limb 1,1,wrapvalue(angleup#),0,0
offset limb 1,1,0,cos(angleup#)*2,sin(angleup#)*2



`print angleup#

sync
`cls
loop



`------------------------------------------------------------
`SUBROUTINES
`------------------------------------------------------------

init_images:

ink rgb(0,255,0),0 : box 0,0,200,200
ink rgb(255,255,255),0

for x=0 to 5

line x,40,95+x,201
line 200-x,40,105-x,201

half_ellipse(100,40,90+x,30+x)

next x

get image 1,0,0,200,200

cls

return




init_objects:

make object plain 2,200,200 : texture object 2,1 : xrotate object 2,90

position camera 0,10,-110 : xrotate camera 10

make object cylinder 1,1 : scale object 1,100,500,100 :   make mesh from object 1,1 : delete object 1

make object box 1,3,1,2 : add limb 1,1,1 : rotate limb 1,1,45,0,0

color limb 1,0,rgb(0,0,0) : color limb 1,1,rgb(50,50,0)

position object 1,0,(object size y(1)/2),-100

return




check_input:

if rightkey()=1 then turn object right 1,2
if leftkey()=1 then turn object left 1,2
angle=object angle y(1)
if angle<330 and angle>320 then turn object right 1,2
if angle>30 and angle<40 then turn object left 1,2

if upkey()=1 then dec angleup#,1
if downkey()=1 then inc angleup#,1
if angleup#>90 then angleup#=90
if angleup#<0 then angleup#=0

if keystate(54)=0
   set camera to follow object position x(1),object position y(1),object position z(1),object angle y(1),30,10,10,0
else
   set camera to follow object position x(1),object position y(1),object position z(1),object angle y(1)+90,30,10,10,0
endif

return





`------------------------------------------------------------
`FUNCTIONS
`------------------------------------------------------------

function half_ellipse(cx,cy,xrad,yrad)

for angle=-180 to 0

x=cos(angle)*xrad+cx
y=sin(angle)*yrad+cy
dot x,y

next angle

endfunction

set display mode 800,600,32
sync on : sync rate 60

gosub menu

cls rgb(255,255,255)
ink rgb(175,175,175),0

box 0,0,799,400
ink 0,0
line 100,400,100,0:line 300,400,300,0:line 500,400,500,0:line 700,400,700,0
ink rgb(75,75,75),0
line 80,599,100,400:line 280,599,300,400:line 480,599,500,400:line 680,599,700,400
get image 2,0,0,799,599
cls rgb(255,255,255)
ink rgb(175,175,175),0
box 0,175,130,200
ink 0,0

circle 100,200,25 : line 100,225,100,325 : line 75,400,100,325 : line 125,400,100,325 : line 75,300,100,225
ink rgb(255,255,255),0:for cc=0 to 24:circle 100,200,cc:box 86,180,114,215:box 80,186,120,214:next cc:ink 0,0
get image 1,0,175,130,470

Game:

ppx=0:ppy=375:scx=0:scxx=799:pax=100:scxxx=799+799:aax=125:mouseclicked=9:xvel#=0:mx=0:my=0:xvel=0:yvel=0:cx=0:cy=0:ay=0:ax=0
Position mouse pax+30,pay+50:set text size 10

do

ax=mousex()
ay=mousey()
cx=mousex()
cy=mousey()

if mouseclicked=2
	paste image 2,scx,0:paste image 2,scxx,0:paste image 1,ppx,ppy
	scx = scx - xvel:scxx = scxx - xvel:ppx = ppx - xvel:pax = pax - xvel:aax = aax - xvel
	line aax,300,pax,425
	yvel = yvel + 5
	my = my + yvel
	if my >= screen height()-10
	   my = screen height()-10
	   yvel = 0 - yvel
	   xvel = xvel * 0.80
	   yvel = yvel * 0.80
	endif
	circle mx,my,10
	if xvel=0 and yvel<=1 and yvel>=-1 then gosub ends
else
	if mouseclicked=9
	else
		paste image 2,0,0:paste image 2,799,0:paste image 1,0,375
		line ax,ay,pax,425
		circle cx,cy,10
		if mouseclick() = 1
		   mx = mousex()
		   my = mousey()
		   xvel = mousemovex() * 2
		   yvel = mousemovey() * 2
			mouseclicked=1
		endif
	endif
endif
if mouseclick()=0 and mouseclicked=1 then mouseclicked=2

center text 400,10,"Click, Drag, and let go of the mouse to throw the ball."
xvel#=xvel#+xvel
center text 400,30,"Distance: "+str$(xvel#)
center text 400,50,"Highscore: "+str$(hs)

if scx<=-799 then scx=scxx+799
if scxx<=-799 then scxx=scx+799
if scx>=799 then scx=scxx-799
if scxx>=799 then scxx=scx-799

if mouseclicked=9 and mouseclick()=0 then mouseclicked=0

sync

cls rgb(255,255,255)
loop

ends:
if xvel#>hs then hs=xvel#
center text 400,10,"Click, Drag, and let go of the mouse to throw the ball."
center text 400,30,"Distance: "+str$(xvel#)
center text 400,50,"Highscore: "+str$(hs)
center text 400,300,"Press the spacekey to continue."
suspend for key
gosub game

Menu:
sxvel=0
syvel=0
msx=400
msy=screen height()-10
do
set text size 50
ink rgb(rnd(255),rnd(255),rnd(255)),0
center text 300,25,"F"
ink rgb(rnd(255),rnd(255),rnd(255)),0
center text 350,25,"L"
ink rgb(rnd(255),rnd(255),rnd(255)),0
center text 400,25,"I"
ink rgb(rnd(255),rnd(255),rnd(255)),0
center text 450,25,"N"
ink rgb(rnd(255),rnd(255),rnd(255)),0
center text 500,25,"G"
set text size 30
if mousex()>350 and mousex()<450 and mousey()>150 and mousey()<200
	ink rgb(255,255,0),0
	center text 400,150,"Easy"
	if mouseclick()=1
		friction=0.80
		return
	endif
else
	ink rgb(0,0,255),0
	center text 400,150,"Easy"
endif
if mousex()>320 and mousex()<480 and mousey()>300 and mousey()<350
	ink rgb(255,0,255),0
	center text 400,300,"Medium"
	if mouseclick()=1
		friction=0.50
		return
	endif
else
	ink rgb(0,255,0),0
	center text 400,300,"Medium"
endif
if mousex()>340 and mousex()<460 and mousey()>430 and mousey()<500
	ink rgb(0,255,255),0
	center text 400,450,"Hard"
	if mouseclick()=1
		friction=0.30
		return
	endif
else
	ink rgb(255,0,0),0
	center text 400,450,"Hard"
endif
ink 0,0
syvel=syvel+3
msx = msx + sxvel
msy = msy + syvel
if msy >= screen height()-10
   msy = screen height()-10
   syvel = 0 - syvel
   sxvel = sxvel * 0.90
   syvel = syvel * 0.90
endif
if msy <= 10
   msy = 10
   syvel = 0 - syvel
endif
if msx >= screen width()-10
   msx = screen width()-10
   sxvel = 0 - sxvel
endif
if msx <= 10
   msx = 10
   sxvel = 0 - sxvel
endif
if mouseclick()=1
	msx=mousex()
	msy=mousey()
	sxvel=mousemovex()*2
	syvel=mousemovey()*2
endif
circle msx,msy,10
sync
cls rgb(255,255,255)
loop

 for (count = 0; rsquared + isquared <= 4.0 && count < MaxIters; count++)

for count = 0 to MaxIters
  rem code here
  if (rsquared# + isquared#) > 4.0 then exit
next count

sync on:sync rate 0
REM Shadow Ninja
INK RGB(140,0,0),0
CIRCLE 4,4,4
INK RGB(10,10,10),0
BOX 0,2,8,4
INK RGB(140,0,0),0
LINE 4,8,4,20
LINE 4,20,2,30
LINE 4,20,6,30
LINE 4,18,2,9
LINE 4,18,8,8
GET IMAGE 4,0,0,9,32

DIM enground#(5)
DIM enemyjp#(5)
DIM enemywfr#(5)
DIM endescent#(5)
DIM enemyy#(5)
DIM enemyx#(5)
DIM minenemyy#(1)
minenemyy#(1)=screen height()
foe=1
enemyy#(foe)=402
wait key
do
 CLS RGB(0,100,0)
 IF enground#(foe)=0 AND enemyjp#(foe)=0 THEN endescent#(foe)=endescent#(foe)+.05
 IF enground#(foe)=0 AND enemyjp#(foe)=0 THEN enemyy#(foe)=enemyy#(foe)+endescent#(foe)
 IF enground#(foe)=1 THEN endescent#(foe)=0
 IF enemyy#(foe)>=SCREEN HEIGHT()-33 THEN enground#(foe)=1 ELSE enground#(foe)=0 
 IF enemywfr#(foe)=1 AND enemyjp#(foe)=0 THEN enemywfr#(foe)=0:enemyjp#(foe)=5
 IF enemyjp#(foe)>0 THEN enemyjp#(foe)=enemyjp#(foe)-.1
 IF enemyjp#(foe)<0 THEN enemyjp#(foe)=0
 IF enemyy#(foe)<minenemyy#(foe) THEN minenemyy#(foe)=enemyy#(foe)
 IF enemyy#(foe)>=SCREEN HEIGHT()-33 THEN enground#(foe)=1 ELSE enground#(foe)=0
 IF enground#(foe)=1 THEN inair=1
 enemyy#(foe)=enemyy#(foe)-enemyjp#(foe)
 if mousex()>enemyx#(foe) then enemyx#(foe)=enemyx#(foe)+.1
 if mousex()<enemyx#(foe) then enemyx#(foe)=enemyx#(foe)-.1
 if spacekey()=1 and enemyjp#(foe)=0 and enemywfr#(foe)=0 then enemywfr#(foe)=1:enemyjp#(foe)=5
 IF enemywfr#(foe)=1 and SPACEKEY()=0 AND enemyjp#(foe)=0 THEN enemywfr#(foe)=0:enemyjp#(foe)=5
 paste image 4,enemyx#(foe),enemyy#(foe),1 
 SYNC
loop



 IF r=0 THEN  CLS RGB(0,100,0)
 ink rgb(0,80,0),0
 center text x#+5,y#-18,"P1" 
 IF RIGHTKEY()=1
  INC x#,1:move=1
  IF ground=1 THEN INC x#,.6
   if shiftkey()=1 and ground=1 and run>4
   inc x#,2
   dec run#,4
   dec run,4
  endif
 ENDIF
 IF LEFTKEY()=1
 
 DEC x#,1:move=2
 IF ground=1 THEN DEC x#,.6
  if shiftkey()=1 and ground=1 and run>4
   dec x#,2
   dec run#,4
   dec run,4
  endif
 ENDIF
 if run<100 then inc run#,.1
 run=run#
 if shiftkey()=1 then ink rgb(255,0,0),0 else ink rgb(255,255,255),0
 print "Run Energy:",run
 ink rgb(150,150,150),0
 print "Shot";
 if loopwait=0 then print " is available." else print " not available."
 SPRITE 1,x#,y#,move
 INK RGB(50,50,50),0
 IF r=0 THEN TEXT x#-2,y#-15,name$:INK RGB(255,255,255),0
 IF ground=0 AND jp#=0 THEN INC descent#,.05
 IF ground=0 AND jp#=0 THEN INC y#,descent#+default#
 IF ground=1 THEN descent#=0
  
 IF ground=1 THEN jumps=0
 IF wfr=1 and SPACEKEY()=0 AND jp#=0 THEN wfr=0:jp#=5
 IF jp#>0 THEN DEC jp#,.1
 IF jp#<0 THEN jp#=0
 DEC y#,jp#
 IF y#<miny# THEN miny#=y#
 IF y#>=SCREEN HEIGHT()-33 THEN ground=1 ELSE ground=0 


 IF ground=1 THEN inair=1
 IF SPACEKEY()=1 AND ground=1 THEN maxheighty#=y#-234.25:wfr=1

repeat : sync : until scancode()<>0 or mouseclick()<>0

cls
sync on

rem Set up Fractal Variables
iterations=10
axiom$="8" : rem (X)
rules=1

movelen#=20
angchange#=15

rem Set upper limit of Code Lenth
arraynums=65536

rem Initialise arrays
dim set(arraynums)   : rem Final code
dim set1(arraynums)  : rem Code creation array 1
dim set2(arraynums)  : rem Code creation array 1

rem Array for rules, this time there's only 1
dim rule$(rules,1)
rem equivalent:
rem        (X)                 (F[+X][F-X])
rule$(1,0)="8"    : rule$(1,1)="1638761487"

rem Array to convert numbers of symbols
dim char$(9)
char$(1)="F"
char$(2)="f"
char$(3)="+"
char$(4)="-"
char$(5)="|"
char$(6)="["
char$(7)="]"
char$(8)="X"
char$(9)="Y"

gosub GenerateSet
gosub DrawFractal

rem Loop until any key is pressed
repeat : sync : until scancode()<>0 or mouseclick()<>0

end

GenerateSet:

   rem Set the first array to the original axiom
   for i=1 to len(axiom$)
      set1(i)=val(mid$(axiom$,i))
   next i

   rem Set the code lenths for each array
   set1size=len(axiom$)
   set2size=0

   rem Start on code generation array 1 (actually, this is array 2 but I'm going to switch it in a moment)
   setno=1

   rem Begin the FOR loop
   for i=1 to iterations

      rem Switch the array that we're using
      setno=1-setno

      rem If we're on the >first< array
      if setno=0

         rem Clear the >second< array (actually, it's not cleared, but becuase 'set2size' is 0 the data will be overwritten)
         set2size=0
         rem Go though the >first< array
         for j=1 to set1size
            rem Search though the rules to see if the current character should be changed
            rulefound=0
            for k=1 to rules
               rem If it matches a rule...
               if rule$(k,0)=str$(set1(j))
                  rem ...then copy the rule into array >2<
                  for l=1 to len(rule$(k,1))
                     set2size=set2size+1
                     set2(set2size)=val(mid$(rule$(k,1),l))
                  next l
                  rulefound=1
               endif
            next k
            rem If no rule matches...
            if rulefound=0
               rem ...then simply copy the symbol in array >1< to array >2<
               set2size=set2size+1
               set2(set2size)=set1(j)
            endif
         next j

      rem If we're on the >second< array
      else

         rem Clear the >first< array (actually, it's not cleared, but becuase 'set1size' is 0 the data will be overwritten)
         set1size=0
         rem Go though the >second< array
         for j=1 to set2size
            rulefound=0
            rem Search though the rules to see if the current character should be changed
            for k=1 to rules
               rem If it matches a rule...
               if rule$(k,0)=str$(set2(j))
                  rem ...then copy the rule into array >1<
                  for l=1 to len(rule$(k,1))
                     set1size=set1size+1
                     set1(set1size)=val(mid$(rule$(k,1),l))
                  next l
                  rulefound=1
               endif
            next k
            rem If no rule matches...
            if rulefound=0
               rem ...then simply copy the symbol in array >2< to array >1<
               set1size=set1size+1
               set1(set1size)=set2(j)
            endif
         next j

      endif

   next i

   rem Copy the current code from the current array into the final array
   if setno=0
      for i=1 to set2size
         set(i)=set2(i)
      next i
      setsize=set2size
   else
      for i=1 to set1size
         set(i)=set1(i)
      next i
      setsize=set1size
   endif

   rem Delete the unnecessary arrays
   undim set1(arraynums)
   undim set2(arraynums)

return

DrawFractal:

   rem Display the first few hundred symbols for decoration
   ink rgb(150,150,150),0
   forto=setsize
   if forto>4800 then forto=4800
   for i=1 to forto
      print char$(set(i)); : rem Accessing the 'char$()' array
   next i

   rem Set up initial state
   x#=320
   y#=470
   angle#=270

   rem Setup stack
   dim stackx#(1000)
   dim stacky#(1000)
   dim stackang#(1000)
   stackon=0

   ink rgb(255,255,0),0

   rem Cycle through the code
   for i=1 to setsize

      rem Move forward, drawing a line ("F","X" or "Y")
      if set(i)=1  or set(i)=8 or set(i)=9
         rem Draw the line
         line x#,y#,x#+cos(angle#)*movelen#,y#+sin(angle#)*movelen#
         rem Change the coordinates
         x#=x#+cos(angle#)*movelen#
         y#=y#+sin(angle#)*movelen#
      endif

      rem Move forward, without drawing ("f")
      if set(i)=2
         x#=x#+cos(angle#)*movelen#
         y#=y#+sin(angle#)*movelen#
      endif

      rem Turn left ("+")
      if set(i)=3
         angle#=wrapvalue(angle#-angchange#)
      endif

      rem Turn right ("-")
      if set(i)=4
         angle#=wrapvalue(angle#+angchange#)
      endif

      rem Rotate 180
      if set(i)=5
         angle#=wrapvalue(angle#+180)
      endif

      rem Store state to stack
      if set(i)=6
         stackon=stackon+1          : rem Increase stack size
         stackx#(stackon)=x#        : rem Save x
         stacky#(stackon)=y#        : rem Save y
         stackang#(stackon)=angle#  : rem Save angle
      endif

      rem Pop the state from the stack and set the drawer to it
      if set(i)=7
         x#=stackx#(stackon)        : rem Return to the x stacked at the top of the stack
         y#=stacky#(stackon)        : rem Return to the y stacked at the top of the stack
         angle#=stackang#(stackon)  : rem Return to the angle stacked at the top of the stack
         stackon=stackon-1          : rem Delete the top stackv (actually just decreasing the stack size, but it will eventually be overwritten)
      endif

   next i

return