TANGRAM

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

Moderator: anthonio

TANGRAM

Berichtdoor bluatigro » do nov 13, 2014 10:57 am

ik probeer n tangram puzzel te maken

error :
- mijn vierhoeken zijn vreemd
- niet alle polygons worden getekend
- het roteren gaat niet goed
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
dim p( 6 , 10 )
global tx1 , tx2 , tx3 , tx4 , tkl , tfl , true , false
global ty1 , ty2 , ty3 , ty4 , tx , ty , tangle , pi
pi = atn( 1 ) * 4
false = 0
true = not( false )
tx1 = 0
ty1 = 1
tx2 = 2
ty2 = 3
tx3 = 4
ty3 = 5
tx4 = 6
ty4 = 7
tkl = 8
tfl = 9
tx = 0
ty = 1
tangle = 2
nomainwin
call poly 0, 128,0  ,-128,0 ,0,128 ,0,0  ,rgb(255,  0,  0),false
call poly 1, 128,0  ,-128,0 ,0,128 ,0,0  ,rgb(  0,255,  0),false
call poly 2, 128,0  ,0,128  ,0,0   ,0,0  ,rgb(  0,  0,255),false
call poly 3, 64,0   ,-64,0  ,0,64  ,0,0  ,rgb(255,  0,255),false
call poly 4, 64,0   ,-64,0  ,0,64  ,0,0  ,rgb(  0,255,255),false
call poly 5, 0,-64  ,64,0   ,-64,0 ,0,64 ,rgb(255,255,255),true
call poly 6, 64,-64 , 64,64 ,0,0   ,0,128,rgb(255,255,  0),true
open "Tangram" for graphics as #m
  #m "trapclose [quit]"
  #m "fill black"
  call drawpoly 0 , 128 , 0 , 0
  call drawpoly 1 , 0 , 128 , 0
  call drawpoly 2 , 256 , 256 , 0
  call drawpoly 3 , 64 , 256 , 2
  call drawpoly 4 , 128+64 , 128 , 3
  call drawpoly 5 , 128 , 128+64 , 0
  call drawpoly 6 , 256 , 128 , 2
wait
[quit]
  close #m
end






end
sub drawpoly no , x , y , angle
  x1 = p(no,tx1)
  y1 = p(no,ty1)
  x2 = p(no,tx2)
  y2 = p(no,ty2)
  x3 = p(no,tx3)
  y3 = p(no,ty3)
  x4 = p(no,tx4)
  y4 = p(no,ty4)
  call rotate x1 , y1 , angle
  call rotate x2 , y2 , angle
  call rotate x3 , y3 , angle
  call rotate x4 , y4 , angle
  call tri x1+x,y1+y,x2+x,y2+y,x3+x,y3+y,p(no,tkl)
  if p(no,tfl) then
    call tri x4+x,y4+y,x2+x,y2+y,x3+x,y3+y,p(no,tkl)
  end if
end sub
sub poly no , x1,y1 , x2,y2 , x3,y3 , x4,y4 , kl , f
  p(no,tx1) = x1
  p(no,ty1) = y1
  p(no,tx2) = x2
  p(no,ty2) = y2
  p(no,tx3) = x3
  p(no,ty3) = y3
  p(no,tx4) = x4
  p(no,ty4) = y4
  p(no,tkl) = kl
  p(no,tfl) = f
end sub
sub rotate byref k , byref l , angle
  s = sin( angle * pi / 2 )
  c = cos( angle * pi / 2 )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub
sub swap byref a , byref b
  h = a
  a = b
  b = h
end sub
sub tri x1 , y1 , x2 , y2 , x3 , y3 , clr
  call setcolor clr
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    call swap y1 , y3
    call swap x1 , x3
  end if
  if y1 > y2 then
    call swap y1 , y2
    call swap x1 , x3
  end if
  if y2 > y3 then
    call swap y2 , y3
    call swap x2 , y3
  end if
  if y1 = y3 then y1 = y1 + 1e-5
  if y1 = y2 then y1 = y1 + 1e-5
  if y2 = y3 then y2 = y2 + 1e-5
  for i = y1 to y3
    a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
    if i < y2 then
      b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
    else
      b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
    end if
    #m "down"
    #m "line " ; a + 128 ; " " ; i + 128 _
    ; " " ; b + 128 ; " " ; i + 128
    #m "up"
  next i
  #m "flush"
end sub
function rgb( r,g,b )
  rgb = r + g * 256 + b * 256 ^ 2
end function
sub setcolor kl
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256 ^ 2 ) and 255
  #m "color " ; r ; " " ; g ; " " ; b
  #m "backcolor " ; r ; " " ; g ; " " ; b
end sub
function pixel( x , y )
  pixel = 0
end function
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