plasma landshap

Algemene discussies en vragen omtrent Liberty BASIC programma's. Stuur zoveel mogelijk delen van listings (snippets) in als je hulp wilt.

Moderators: anthonio, Abcott

plasma landshap

Berichtdoor bluatigro » vr feb 20, 2015 11:25 am

dit is mijn freebasic code omgeschreven naar LB

error :
- hill$() geeft een zwart - wit landschap
- vandaar dat ik Rainbow$() gebruik

WAARSCHUWING :
- rekenen en tekenen duren n paar minuten

Code: Selecteer alles
global pi , black$ , white$ , gray$ , green$ , blue$
pi = atn( 1 ) * 4
black$ = rgb$( 0 , 0 , 0 )
white$ = rgb$( 255 , 255 , 255 )
gray$  = rgb$( 127 , 127 , 127 )
green$ = rgb$( 0 , 255 , 0 )
blue$  = rgb$( 0 , 0 , 255 )
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight
dim h( winx , winx )
h( 0 , 0 ) = dice( 2 * pi )
h( winx , 0 ) = dice( 2 * pi )
h( 0 , winy ) = dice( 2 * pi )
h( winx , winy ) = dice( 2 * pi )
call lino 0 , 0 ,  winx , winy , 2 * pi
nomainwin
open "terain" for graphics as #m
  #m "fill black"
  for x = 1 to  winx
    for y = 0 to  winy
      #m "color " ; rainbow$( h( x , y ) )
      #m "down"
      #m "line " ; x ; " " ; y - h( x , y ) * 50  _
           ; " " ; x ; " " ; y - h( x , y ) * 50 - 10 
      #m "up"
    next y
  next x
wait

function dice( x )
 dice = rnd( 0 ) * x - x / 2
end function

sub lino x1 , y1 , x2 , y2 , q
  if abs( x1 - x2 ) < 1 then exit sub

  mx = ( x1 + x2 ) / 2
  my = ( y1 + y2 ) / 2

  h1 = ( h( x1 , y1 ) + h( x2 , y1 ) ) / 2 + dice( q )
  h2 = ( h( x1 , y2 ) + h( x2 , y2 ) ) / 2 + dice( q )
  h3 = ( h( x1 , y1 ) + h( x1 , y2 ) ) / 2 + dice( q )
  h4 = ( h( x2 , y1 ) + h( x2 , y2 ) ) / 2 + dice( q )
  h5 = ( h( x1 , y1 ) + h( x2 , y1 ) _
  + h( x1 , y2 ) + h( x2 , y2 ) ) / 4 + dice( q )

  if h( mx , y1 )= 0 then h( mx , y1 ) = h1
  if h( mx , y2 )= 0 then h( mx , y2 ) = h2
  if h( x1 , my )= 0 then h( x1 , my ) = h3
  if h( x2 , my )= 0 then h( x2 , my ) = h4
  if h( mx , my )= 0 then h( mx , my ) = h5

  call lino x1 , y1 , mx , my , q / 2
  call lino x1 , my , mx , y2 , q / 2
  call lino mx , y1 , x2 , my , q / 2
  call lino mx , my , x2 , y2 , q / 2
end sub

function rainbow$( x )
  r = sin( x ) * 127 + 128
  g = sin( x + pi * 2 / 3 ) * 127 + 128
  b = sin( x - pi * 2 / 3 ) * 127 + 128
  rainbow$ = rgb$( r , g , b )
end function
function hill$( x )
  x = x + 2
  uit$ = white$
  if x < 0 then uit$ = black$
  if x < 1 then uit$ = mix$( black$ , x , blue$ )
  if x < 2 then uit$ = mix$( blue$ , x - 1 , green$ )
  if x < 3 then uit$ = mix$( green$ , x - 2 , gray$ )
  if x < 4 then uit$ = mix$( gray$ , x - 3 , white$ )
  hill$ = uit$
end function
function mix$( kla$ , f , klb$ )
  ra = val( word$( kla$ , 1 ) )
  ga = val( word$( kla$ , 2 ) )
  ba = val( word$( kla$ , 3 ) )
  rb = val( word$( klb$ , 1 ) )
  gb = val( word$( klb$ , 2 ) )
  bb = val( word$( klb$ , 3 ) )
  r = ra + ( rb - ra ) * f
  g = ga + ( gb - ga ) * f
  b = ba + ( bb - ba ) * f
  mix$ = rgb$( r , g , b )
end function
function shade$( kl$ , f )
  r = val( word$( kl$ , 1 ) )
  g = val( word$( kl$ , 2 ) )
  b = val( word$( kl$ , 3 ) )
  r = r * f
  g = g * f
  b = b * f
  shade$ = rgb$( r , g , b )
end function
function rgb$( r , g , b )
  r = r and 255
  g = g and 255
  b = b and 255
  rgb$ = str$( r ) ; " " ; g ; " " ; b
end function
 
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Keer terug naar Liberty BASIC Code

Wie is er online

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

cron