DRIEHOEK !!!

Geef hier je beste Liberty BASIC tips door. (Hier geen hulp vragen)

Moderators: anthonio, Abcott

DRIEHOEK !!!

Berichtdoor bluatigro » zo mei 09, 2010 9:15 am

ik heb n snelle en n trage [ update 10-mei-2010 ]
driehoek sub geschreven
werkt ook in justbasic
en dat zonder DLL's
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , pi
winx = WindowWidth
winy = WindowHeight
global black , red , green , yellow
global blue , magenta , cyan , white
global pink , purple , gray , orange
pi = atn( 1 ) * 4
black   = rgb(   0 ,   0 ,   0 )
red     = rgb( 255 ,   0 ,   0 )
green   = rgb(   0 , 255 ,   0 )
yellow  = rgb( 255 , 255 ,   0 )
blue    = rgb(   0 ,   0 , 255 )
magenta = rgb( 255 ,   0 , 255 )
cyan    = rgb(   0 , 255 , 255 )
white   = rgb( 255 , 255 , 255 )
pink    = rgb( 255 , 127 , 127 )
orange  = rgb( 255 , 127 ,   0 )
gray    = rgb( 127 , 127 , 127 )
purple  = rgb( 127 ,   0 , 127 )
nomainwin
open "triangle" for graphics as #m
  #m "trapclose [quit]"
  call tri 100,100 , 50,150 , 150,250 , 255
  call tri2 300 , 200 , red _
          , 100 , 400 , green _
          , 500 , 600 , blue
wait
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
  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 ; " " ; i _
    ; " " ; b ; " " ; i
    #m "up"
  next i
  #m "flush"
end sub
sub tri2 x1,y1,kl1,x2,y2,kl2,x3,y3,kl3
  if kl1=kl2 and kl2=kl3 then
    call tri x1,y1,x2,y2,x3,y3,kl1
  end if
  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
    call swap kl1 , kl3
  end if
  if y1 > y2 then
    call swap y1 , y2
    call swap x1 , x2
    call swap kl1 , kl2
  end if
  if y2 > y3 then
    call swap y2 , y3
    call swap x2 , y3
    call swap kl2 , kl3
  end if
  for y = y1 to y3
    a = x1 + ( x3 - x1 ) * (y-y1) / ( y3 - y1 )
    kla = mix( kl1 , (y-y1) / (y3-y1) , kl3 )
    if y < y2 then
      b = x1 + ( x2 - x1 ) * (y-y1) / ( y2 - y1 )
      klb = mix( kl1 , (y-y1) / (y2-y1) , kl2 )
    else
      b = x2 + ( x3 - x2 ) * (y-y2) / ( y3 - y2 )
      klb = mix( kl2 , (y-y2) / (y3-y2) , kl3 )
    end if
    t = 0
    if a > b then
      call swap a , b
      call swap kla , klb
    end if
    if a = b then b = b + 1
    for x = a to b
      kl = mix( kla , ( x - a ) / ( b - a ) , klb )
      call setcolor kl
      #m "down"
      #m "set " ; x ; " " ; y
      #m "up"
    next x
  next y
  #m "flush"
end sub
sub setcolor clr
  r = clr and 255
  g = int( clr / 256 ) and 255
  b = int( clr / 256 ^ 2 ) and 255
  #m "color " ; r ; " " ; g ; " " ; b
  #m "backcolor " ; r ; " " ; g ; " " ; b
end sub
sub swap byref a , byref b
  h = a : a = b : b = h
end sub
[quit]
  close #m
end
function rad( deg )
  rad = deg * pi / 180
end function
function rainbow( deg )
  rainbow = rgb( sin( rad( deg ) ) * 127 + 128 _
               , sin( rad( deg - 120 ) ) * 127 + 128 _
               , sin( rad( deg + 120 ) ) * 127 + 128 )
end function
function rgb( r , g , b )
  rgb = ( r and 255 ) _
  + ( g and 255 ) * 256 _
  + ( b and 255 ) * 256 * 256
end function
function mix( kl1 , f , kl2 )
  r1 = int( kl1 and 255 )
  g1 = int( kl1 / 256 ) and 255
  b1 = int( kl1 / 256 / 256 ) and 255
  r2 = int( kl2 and 255 )
  g2 = int( kl2 / 256 ) and 255
  b2 = int( kl2 / 256 / 256 ) and 255
  dr = r2 - r1
  dg = g2 - g1
  db = b2 - b1
  dr = dr * f
  dg = dg * f
  db = db * f
  r = r1 + dr
  g = g1 + dg
  b = b1 + db
  mix = rgb( r and 255 , g and 255 , b and 255 )
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Keer terug naar Tips en informatie

Wie is er online

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

cron