function draw

General FreeBASIC programming questions.
bluatigro
Posts: 651
Joined: Apr 25, 2012 10:35
Location: netherlands

function draw

Postby bluatigro » Apr 02, 2020 11:58

error :
my Rainbow is not good

if you like this i wil extend the operator's
whitch operators wood you like ?

Code: Select all


''instructions :
''a function exist of list's and atom's
''eatch list exstist of a operator and 3 atom's
''a list begins whit a '[' and ends whhit a ']'
''a atom can be a number a var or a list
''betweenn '[' and operator and atom and ']' is 1 space
''a var can only be 'x' or 'y'

''the kleur$() gives 'gray' if a iligal calculation has been tryed

''see code for posible operator's
dim shared as ulong wordtel
dim shared as string word( 10 )
dim shared as double in( 3 )
sub split( a as string )
  wordtel = 0
  while instr( a , " " ) <> 0
    word( wordtel ) = left( a , instr( a , " " ) - 1 )
    a = right( a , len( a ) - instr( a , " " ) )
    wordtel += 1
  wend
  if a <> "" then
    word( wordtel ) = a
    wordtel += 1
  end if
end sub

const as string letters = "xy"
const as double pi = atn( 1 ) * 4

function isNumber( x as string ) as integer
  return ( val( x ) <> 0 ) or ( x = "0" )
end function
function isInput( x as string ) as integer
  return ( len( x ) = 1 ) and ( instr( letters , x ) <> 0 )
end function
function run_prog( prog as string ) as string
'' run the formula
'' return a double in a string
'' or "error" if formula has error
  if prog = "" then return "error"
  while instr( prog , "]" )
    dim as integer einde = instr( prog , "]" )
    dim as integer begin = einde
    while mid( prog , begin , 1 ) <> "[" _
    and begin > 0
      begin -= 1
    wend
    if begin <= 0 and not isNumber( prog ) then return "error"
    dim as string part = mid( prog , begin , einde - begin + 1 )
    dim as double a , b , c , abc
    split part
    if word( 2 ) = "[" or word( 2 ) = "]" then return "error"
    if word( 3 ) = "[" or word( 3 ) = "]" then return "error"
    if word( 4 ) = "[" or word( 4 ) = "]" then return "error"
    if isInput( word( 2 ) ) then
      a = in( instr( letters , word( 2 ) ) )
    else
      if isNumber( word( 2 ) ) then
        a = val( word( 2 ) )
      else
        return "error"
      end if
    end if
    if isInput( word( 3 ) ) then
      b = in( instr( letters , word( 3 ) ) )
    else
      if isNumber( word( 3 ) ) then
        b = val( word( 3 ) )
      else
        return "error"
      end if
    end if
    if isInput( word( 4 ) ) then
      c = in( instr( letters , word( 4 ) ) )
    else
      if isNumber( word( 4 ) ) then
        c = val( word( 4 ) )
      else
        return "error"
      end if
    end if
    dim as string func = word( 1 )
    select case func
      case "+"
        abc = a + b
      case "-"
        abc = a - b
      case "*"
        abc = a * b
      case "/"
        if b = 0 then return "error"
        abc = a / b
      case "sqr"
        if a < 0 then return "error"
        abc = sqr( a )
      case else
        return "error"
    end select
    dim as string l , r
    l = left( prog , begin - 1 )
    r = right( prog , len( prog ) - einde )
    prog = l + str( abc ) + r
  wend
  return prog
end function
function rad( x as double ) as double
  return x * pi / 180
end function
function rainbow( x as double ) as ulong
  dim as byte r , g , b
  r = sin( rad( x ) ) * 127 + 128
  g = sin( rad( x - 120 ) ) * 127 + 128
  b = sin( rad( x + 120 ) ) * 127 + 128
  return rgb( r , g , b )
end function
function kleur( x as double , y as double _
              , p as string ) as ulong
  in( 1 ) = x
  in( 2 ) = y
  dim as string uit = run_prog( p )
  if uit = "error" then
    return rgb( 127 , 127 , 127 )
  end if
  return rainbow( val( uit ) )
end function
screen 18 , 32
dim as integer w , h
screeninfo w , h
dim as double x , y
'' only change the string in kleur()
'' see above instructions
for x = 0 to w
  for y = 0 to h
    pset( x , y ) , kleur( x , y , "[ + x y 0 ]" )
  next y
next x
sleep
 
   

bluatigro
Posts: 651
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: function draw

Postby bluatigro » Apr 02, 2020 12:50

update :
longer prog string in kleur()

Code: Select all


''instructions :
''a function exist of list's and atom's
''eatch list exstist of a operator and 3 atom's
''a list begins whit a '[' and ends whhit a ']'
''a atom can be a number a var or a list
''betweenn '[' and operator and atom and ']' is 1 space
''a var can only be 'x' or 'y'

''the kleur$() gives 'gray' if a iligal calculation has been tryed

''see code for posible operator's
dim shared as ulong wordtel
dim shared as string word( 10 )
dim shared as double in( 3 )
sub split( a as string )
  wordtel = 0
  while instr( a , " " ) <> 0
    word( wordtel ) = left( a , instr( a , " " ) - 1 )
    a = right( a , len( a ) - instr( a , " " ) )
    wordtel += 1
  wend
  if a <> "" then
    word( wordtel ) = a
    wordtel += 1
  end if
end sub

const as string letters = "xy"
const as double pi = atn( 1 ) * 4

function isNumber( x as string ) as integer
  return ( val( x ) <> 0 ) or ( x = "0" )
end function
function isInput( x as string ) as integer
  return ( len( x ) = 1 ) and ( instr( letters , x ) <> 0 )
end function
function run_prog( prog as string ) as string
'' run the formula
'' return a double in a string
'' or "error" if formula has error
  if prog = "" then return "error"
  while instr( prog , "]" )
    dim as integer einde = instr( prog , "]" )
    dim as integer begin = einde
    while mid( prog , begin , 1 ) <> "[" _
    and begin > 0
      begin -= 1
    wend
    if begin <= 0 and not isNumber( prog ) then return "error"
    dim as string part = mid( prog , begin , einde - begin + 1 )
    dim as double a , b , c , abc
    split part
    if word( 2 ) = "[" or word( 2 ) = "]" then return "error"
    if word( 3 ) = "[" or word( 3 ) = "]" then return "error"
    if word( 4 ) = "[" or word( 4 ) = "]" then return "error"
    if isInput( word( 2 ) ) then
      a = in( instr( letters , word( 2 ) ) )
    else
      if isNumber( word( 2 ) ) then
        a = val( word( 2 ) )
      else
        return "error"
      end if
    end if
    if isInput( word( 3 ) ) then
      b = in( instr( letters , word( 3 ) ) )
    else
      if isNumber( word( 3 ) ) then
        b = val( word( 3 ) )
      else
        return "error"
      end if
    end if
    if isInput( word( 4 ) ) then
      c = in( instr( letters , word( 4 ) ) )
    else
      if isNumber( word( 4 ) ) then
        c = val( word( 4 ) )
      else
        return "error"
      end if
    end if
    dim as string func = word( 1 )
    select case func
      case "+"
        abc = a + b
      case "-"
        abc = a - b
      case "*"
        abc = a * b
      case "/"
        if b = 0 then return "error"
        abc = a / b
      case "sqr"
        if a < 0 then return "error"
        abc = sqr( a )
      case else
        return "error"
    end select
    dim as string l , r
    l = left( prog , begin - 1 )
    r = right( prog , len( prog ) - einde )
    prog = l + str( abc ) + r
  wend
  return prog
end function
function rad( x as double ) as double
  return x * pi / 180
end function
function rainbow( x as double ) as ulong
  dim as byte r , g , b
  r = sin( rad( x ) ) * 127 + 128
  g = sin( rad( x - 120 ) ) * 127 + 128
  b = sin( rad( x + 120 ) ) * 127 + 128
  return rgb( r , g , b )
end function
function kleur( x as double , y as double _
              , p as string ) as ulong
  in( 1 ) = x
  in( 2 ) = y
  dim as string uit = run_prog( p )
  if uit = "error" then
    return rgb( 127 , 0 , 0 )
  end if
  return rainbow( val( uit ) )
end function
screen 18 , 32
dim as integer w , h
screeninfo w , h
dim as double x , y
'' only change the string in kleur()
'' see above instructions
for x = 0 to w
  for y = 0 to h
    pset( x , y ) , kleur( x , y , _
"[ sqr [ + [ * x x 0 ] [ * y y 0 ] 0 ] 0 0 ]" )
  next y
next x
sleep
 
   

UEZ
Posts: 520
Joined: May 05, 2017 19:59
Location: Germany

Re: function draw

Postby UEZ » Apr 02, 2020 14:37

Here my rainbow version:

Code: Select all

'Coded by UEZ build 2020-04-20

Type tagHSL
    As Single h, s, l
End Type

Const pi = Acos(-1), rad = pi / 180

Function HUE2RGB(p As Single, q As Single, t As Single) As Single
   If t < 0 Then t += 1
   If t > 1 Then t -= 1
   If t < 1 / 6 Then Return p + (q - p) * 6 * t
   If t < 0.5 Then Return q
   If t < 2 / 3 Then Return p + (q - p) * (2 / 3 - t) * 6
   Return p
End Function

Function HSL2RGB(H As Single, S As Single, L As Single) As Ulong
   Dim As Single r, g, b
   If s = 0 Then
      r = l : g = l : b = l
   Else
      Dim As Single p, q
      q = Iif(l < 0.5, l * (1 + s), l + s - l * s)
      p = 2 * l - q
      r = hue2rgb(p, q, h + 1 / 3)
      g = hue2rgb(p, q, h)
      b = hue2rgb(p, q, h - 1 / 3)
   End If
   Return (r * 255) Shl 16 Or (g * 255) Shl 8 Or (b * 255) Shl 0
End Function

Sub CreateRainbow(cx As single, cy As single, r As Single, img As Any ptr = 0)
   Dim As Ulong col
   For i As Single = 0 To 320
      col = 255 Shl 24 Or HSL2RGB(i / 360, 1, 0.5)
      For j As Single = 0 To 180 Step 0.075
         Pset img, (cx + Cos(-j * rad) * r, cy + Sin(-j * rad) * r), col
      Next
      r -= 0.5
   Next
End Sub

Const w = 1200, h = 600, cx = w \ 2
ScreenRes w, h, 32, , 100

Color 0, &hFF404040
Cls

Screenlock
CreateRainbow(cx, h, h * 0.995)
Draw String (4, 4), "Coded by UEZ", &hFFFFFFFF
Screenunlock

Do
    Sleep 10, 1
Loop Until Len(InKey())


It seems that the HSL2RGB function doesn't work properly yet... -> fixed.

Return to “General”

Who is online

Users browsing this forum: bubacxo and 2 guests