TETRIS

Vragen en suggesties over het programmeren van spelletjes, sprites en dergelijke in Liberty BASIC

Moderator: anthonio

TETRIS

Berichtdoor bluatigro » do aug 07, 2014 9:59 am

dit is een proof of concept

eerst de sprites :
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global clr$
clr$ = "black red green yellow blue pink cyan white"
nomainwin
open "tetris sprites" for graphics as #m
  #m "trapclose [quit]"
  for i = 1 to 8
    #m "goto 0 0"
    #m "backcolor black"
    #m "down"
    #m "boxfilled 10 20"
    #m "up"
    #m "goto 0 11"
    #m "backcolor ";word$(clr$,i)
    #m "down"
    #m "boxfilled 10 20"
    #m "up"
    #m "getbmp bmp 0 0 10 20"
    bmpsave "bmp" , DefaultDir$ + "\BMP\tetris";i;".bmp"
  next i
wait
[quit]
  close #m
end

Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global sprx , spry
nomainwin
open "text sprite maker 1.0" for graphics as #m
  #m "trapclose [quit]"
  #m "font Courier_new 100 bold"
  for i = asc( "0" ) to asc( "9" )
    call clear 100 , 150
    call text 0 , 110 , chr$( i ) , "green"
    call savesprite "chr" + nr$( i , 3 )
  next i
  for i = asc( "a" ) to asc( "z" )
    call clear 100 , 150
    call text 0 , 110 , chr$( i ) , "green"
    call savesprite "chr" + nr$( i , 3 )
  next i
    i = asc( " " )
    call clear 100 , 150
    call text 0 , 110 , chr$( i ) , "green"
    call savesprite "chr" + nr$( i , 3 )

wait

sub savesprite spr$
  #m "getbmp sprite 0 0 " ; sprx ; " " ; spry * 2
  bmpsave "sprite" , DefaultDir$ _
  + "\BMP\" ; spr$ ; ".bmp"
end sub

function nr$( no , m )
  nr$ = right$( "00000000" ; no , m )
end function

sub clear x , y
  #m "cls"
  #m "color white"
  #m "backcolor white"
  #m "goto 0 0"
  #m "down"
  #m "boxfilled " ; x ; " " ; y
  #m "up"
  #m "goto 0 " ; y
  #m "down"
  #m "color black"
  #m "backcolor black"
  #m "boxfilled " ; x ; " " ; 2 * y
  #m "up"
  sprx = x
  spry = y
end sub

[quit]
  close #m
end

sub text x , y , txt$ , kl$
  #m "goto " ; x ; " " ; y
  #m "down"
  #m "color black"
  #m "backcolor white"
  #m "\" ; txt$
  #m "up"
  #m "goto " ; x ; " " ; y + spry
  #m "color " ; kl$
  #m "backcolor black"
  #m "\" ; txt$
  #m "up"
end sub

dan het spel :
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = Windowheight
for i = 1 to 8
  loadbmp "bmp";i , DefaultDir$ ; "\BMP\tetris";i;".bmp"
  anim$ = anim$ + "bmp" ; i ; " "
next i
for i = asc( "0" ) to asc( "9" )
  loadbmp "chr";i , DefaultDir$ ; "\BMP\chr";nr$( i );".bmp"
  number$ = number$ + "chr" ; i ; " "
next i
dim p( 10 , 30 ) , q( 7 , 7 )
global nowx , nowy , peace , pi , key$ , point
pi = atn( 1 ) * 4
call readpeaces
nomainwin
open "TETRIS 1.1" for graphics as #m
  #m "trapclose [quit]"
  #m "fill lightgray"
  #m "getbmp screen 0 0 10 10"
  #m "background screen"
  for x = 0 to 10
    for y = 0 to 30
      #m "addsprite " ; spr$(x,y) ; anim$
      #m "spritexy " ; spr$(x,y) ; x * 20 + 400 ; " " ; y * 20 + 50
      #m "spritescale " ; spr$(x,y) ; " 200"
    next y
  next x
  for x = 0 to 10
    #m "addsprite num" ; x ; " " ; number$
    #m "spritexy num" ; x ; " " ; x * 100 + 200 ; " " ; 700
  next x
  #m "when characterInput [key]"
  #m "setfocus"
  nowx = 6
  nowy = 3
  timer 250 , [tmr]
wait
function nr$( x )
  nr$ = right$( "000" ; x , 3 )
end function
[key]
  key$ = right$( Inkey$ , 1 )
wait
[tmr]
  for i = 0 to 3
    x = nowx + q( peace , i * 2 )
    y = nowy + q( peace , i * 2 + 1 )
    p( x , y ) = 0
    #m "spriteimage " ; spr$(x,y) ; "bmp" ; 1
  next
  nowy = nowy + 1
  select case key$
    case chr$( _VK_RIGHT )
      u = 0
      for i = 0 to 3
        x = nowx + q( peace , i * 2 )
        y = nowy + q( peace , i * 2 + 1 )
        if x >= 10 then u = 1
      next i
      if u = 0 then nowx = nowx + 1
    case chr$( _VK_LEFT )
      u = 0
      for i = 0 to 3
        x = nowx + q( peace , i * 2 )
        y = nowy + q( peace , i * 2 + 1 )
        if x <= 0 then u = 1
      next i
      if u = 0 then nowx = nowx - 1
    case chr$( _VK_UP )
      for i = 0 to 3
        dx = q( peace , i * 2 )
        dy = q( peace , i * 2 + 1 )
        call rotate dx , dy , 90
        q( peace , i * 2 ) = dx
        q( peace , i * 2 + 1 ) = dy
      next i
      u = 1
      while u
        u2 = 0
        for i = 0 to 3
          x = nowx + q( peace , i * 2 )
          y = nowy + q( peace , i * 2 + 1 )
          if x < 0 then u2 = 1
        next i
        if u2 = 0 then
          u = 0
        else
          nowx = nowx + 1
        end if
      wend
      u = 1
      while u
        u2 = 0
        for i = 0 to 3
          x = nowx + q( peace , i * 2 )
          y = nowy + q( peace , i * 2 + 1 )
          if x > 10 then u2 = 1
        next i
        if u2 = 0 then
          u = 0
        else
          nowx = nowx - 1
        end if
      wend
    case else
  end select
  key$ = ""
  u = 0
  for i = 0 to 3
    x = nowx + q( peace , i * 2 )
    y = nowy + q( peace , i * 2 + 1 )
    if p( x , y + 1) <> 0 then
      u = 1
    end if
    if y < 29 then
      p( x , y ) = peace
      #m "spriteimage " ; spr$(x,y) ; "bmp" ; peace + 2
    else
      u = 1
    end if
  next
  timer 0
  if u then
    if nowy = 3 then
      timer 0
      notice "GAME OVER !!" + chr$( 13 ) _
           + "You got " ; point ; " points ."
      for i = 1 to 8
        unloadbmp "bmp";i
      next i
      for i = asc( "0" ) to asc( "9" )
        unloadbmp "chr";i
      next i
      close #m
    end if
    nowx = 6
    nowy = 3
    peace = int( rnd(0) * 6 )
    y = 29
    while y > 1
      full = 1
      for x = 0 to 10
        if p(x,y) = 0 then full = 0
      next x
      if full then
        for iy = y to 1 step -1
          for x = 0 to 10
            p(x,iy)=p(x,iy-1)
            #m "spriteimage ";spr$(x,iy);" bmp";p(x,iy)+2
          next x
        next iy
        point = point + 10
        txt$ = right$( "0000000000" ; point , 10 )
        for i = 1 to len( txt$ )
          a = asc( mid$( txt$ , i , 1 ) )
          #m "spriteimage num" ; i ; " chr" ; a
        next i
      else
        y = y - 1
      end if
    wend
  end if
  timer 250 , [tmr]
  #m "drawsprites"
wait
sub rotate byref k , byref l , deg
  s = sin( rad( deg ) )
  c = cos( rad( deg ) )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub
function rad( deg )
  rad = deg * pi / 180
end function
function spr$( x , y )
  spr$ = "spr" ; int( x ) ; "_" ; int( y ) ; " "
end function
sub readpeaces
  for i = 0 to 5
    for j = 2 to 7
      read q
      q( i , j ) = q
    next j
  next i
  data -1,0 , 1,0 , 2,0 ''I
  data -1,0 , 0,1 , 0,2 ''J
  data  1,0 , 0,1 , 0,2 ''L
  data -1,0 , 1,0 , 1,1 ''S
  data -1,1 , 0,1 , 1,0 ''Z
  data  1,0 , 0,1 , 1,1 ''O
end sub
[quit]
  for i = 1 to 8
    unloadbmp "bmp";i
  next i
  for i = asc( "0" ) to asc( "9" )
    unloadbmp "chr";i
  next i
  close #m
end


ik ben niet goed in het spelen van spellen
dus gamers : test dit aub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: TETRIS

Berichtdoor bluatigro » do aug 07, 2014 10:11 am

update :
- ik was de T vergeten
- [esc] toegevoegt

Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = Windowheight
for i = 1 to 8
  loadbmp "bmp";i , DefaultDir$ ; "\BMP\tetris";i;".bmp"
  anim$ = anim$ + "bmp" ; i ; " "
next i
for i = asc( "0" ) to asc( "9" )
  loadbmp "chr";i , DefaultDir$ ; "\BMP\chr";nr$( i );".bmp"
  number$ = number$ + "chr" ; i ; " "
next i
dim p( 10 , 30 ) , q( 7 , 7 )
global nowx , nowy , peace , pi , key$ , point
pi = atn( 1 ) * 4
call readpeaces
nomainwin
open "TETRIS 1.2" for graphics as #m
  #m "trapclose [quit]"
  #m "fill lightgray"
  #m "getbmp screen 0 0 10 10"
  #m "background screen"
  for x = 0 to 10
    for y = 0 to 30
      #m "addsprite " ; spr$(x,y) ; anim$
      #m "spritexy " ; spr$(x,y) ; x * 20 + 400 ; " " ; y * 20 + 50
      #m "spritescale " ; spr$(x,y) ; " 200"
    next y
  next x
  for x = 0 to 10
    #m "addsprite num" ; x ; " " ; number$
    #m "spritexy num" ; x ; " " ; x * 100 + 200 ; " " ; 700
  next x
  #m "when characterInput [key]"
  #m "setfocus"
  nowx = 6
  nowy = 3
  timer 250 , [tmr]
wait
function nr$( x )
  nr$ = right$( "000" ; x , 3 )
end function
[key]
  key$ = right$( Inkey$ , 1 )
wait
[tmr]
  for i = 0 to 3
    x = nowx + q( peace , i * 2 )
    y = nowy + q( peace , i * 2 + 1 )
    p( x , y ) = 0
    #m "spriteimage " ; spr$(x,y) ; "bmp" ; 1
  next
  nowy = nowy + 1
  select case key$
    case chr$( _VK_ESCAPE )
      timer 0
      notice "GAME OVER !!" + chr$( 13 ) _
           + "You got " ; point ; " points ."
      for i = 1 to 8
        unloadbmp "bmp";i
      next i
      for i = asc( "0" ) to asc( "9" )
        unloadbmp "chr";i
      next i
      close #m
      end
    case chr$( _VK_RIGHT )
      u = 0
      for i = 0 to 3
        x = nowx + q( peace , i * 2 )
        y = nowy + q( peace , i * 2 + 1 )
        if x >= 10 then u = 1
      next i
      if u = 0 then nowx = nowx + 1
    case chr$( _VK_LEFT )
      u = 0
      for i = 0 to 3
        x = nowx + q( peace , i * 2 )
        y = nowy + q( peace , i * 2 + 1 )
        if x <= 0 then u = 1
      next i
      if u = 0 then nowx = nowx - 1
    case chr$( _VK_UP )
      for i = 0 to 3
        dx = q( peace , i * 2 )
        dy = q( peace , i * 2 + 1 )
        call rotate dx , dy , 90
        q( peace , i * 2 ) = dx
        q( peace , i * 2 + 1 ) = dy
      next i
      u = 1
      while u
        u2 = 0
        for i = 0 to 3
          x = nowx + q( peace , i * 2 )
          y = nowy + q( peace , i * 2 + 1 )
          if x < 0 then u2 = 1
        next i
        if u2 = 0 then
          u = 0
        else
          nowx = nowx + 1
        end if
      wend
      u = 1
      while u
        u2 = 0
        for i = 0 to 3
          x = nowx + q( peace , i * 2 )
          y = nowy + q( peace , i * 2 + 1 )
          if x > 10 then u2 = 1
        next i
        if u2 = 0 then
          u = 0
        else
          nowx = nowx - 1
        end if
      wend
    case else
  end select
  key$ = ""
  u = 0
  for i = 0 to 3
    x = nowx + q( peace , i * 2 )
    y = nowy + q( peace , i * 2 + 1 )
    if p( x , y + 1) <> 0 then
      u = 1
    end if
    if y < 29 then
      p( x , y ) = peace
      #m "spriteimage " ; spr$(x,y) ; "bmp" ; peace + 2
    else
      u = 1
    end if
  next
  timer 0
  if u then
    if nowy = 3 then
      timer 0
      notice "GAME OVER !!" + chr$( 13 ) _
           + "You got " ; point ; " points ."
      for i = 1 to 8
        unloadbmp "bmp";i
      next i
      for i = asc( "0" ) to asc( "9" )
        unloadbmp "chr";i
      next i
      close #m
    end if
    nowx = 6
    nowy = 3
    peace = int( rnd(0) * 7 )
    y = 29
    while y > 1
      full = 1
      for x = 0 to 10
        if p(x,y) = 0 then full = 0
      next x
      if full then
        for iy = y to 1 step -1
          for x = 0 to 10
            p(x,iy)=p(x,iy-1)
            #m "spriteimage ";spr$(x,iy);" bmp";p(x,iy)+2
          next x
        next iy
        point = point + 10
        txt$ = right$( "0000000000" ; point , 10 )
        for i = 1 to len( txt$ )
          a = asc( mid$( txt$ , i , 1 ) )
          #m "spriteimage num" ; i ; " chr" ; a
        next i
      else
        y = y - 1
      end if
    wend
  end if
  timer 250 , [tmr]
  #m "drawsprites"
wait
sub rotate byref k , byref l , deg
  s = sin( rad( deg ) )
  c = cos( rad( deg ) )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub
function rad( deg )
  rad = deg * pi / 180
end function
function spr$( x , y )
  spr$ = "spr" ; int( x ) ; "_" ; int( y ) ; " "
end function
sub readpeaces
  for i = 0 to 6
    for j = 2 to 7
      read q
      q( i , j ) = q
    next j
  next i
  data -1,0 , 1,0 , 2,0 ''I
  data -1,0 , 0,1 , 0,2 ''J
  data  1,0 , 0,1 , 0,2 ''L
  data -1,0 , 1,0 , 1,1 ''S
  data -1,1 , 0,1 , 1,0 ''Z
  data  1,0 , 0,1 , 1,1 ''O
  data -1,0 , 0,1 , 1,0 ''T
end sub
[quit]
  for i = 1 to 8
    unloadbmp "bmp";i
  next i
  for i = asc( "0" ) to asc( "9" )
    unloadbmp "chr";i
  next i
  close #m
end
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm


Keer terug naar Games

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron