Recent Posts

Pages: 1 ... 8 9 [10]
91
Code and examples / Re: Spirograph
« Last post by jbk on 05. July 2017, 13:31:51 »
hello B+
here's one in FreeBasic by dafhi http://www.freebasic.net/forum/viewtopic.php?p=205476#p205476
I modified the background, commenting-out the checker board background and changing the color.
the picture shown is one of an infinite of random variations
92
Code and examples / Re: XML Parser
« Last post by John on 04. July 2017, 19:28:01 »
Something LIKE this?

Code: [Select]
dict{"A"} = 1
dict{"B"} = "bee"
dict{"C"} = "sea"
dict{"D"} = "peebee"

FOR x = 0 TO UBOUND(dict) STEP 2
  IF dict[x+1] = "bee" OR dict[x+1] LIKE "*bee" THEN PRINT "Found: Key = ",dict[x],"  ",dict[x+1],"\n"
NEXT


jrs@jrs-laptop:~/sb/examples/test$ time scriba findval.sb
Found: Key = B  bee
Found: Key = D  peebee

real   0m0.005s
user   0m0.004s
sys   0m0.000s
jrs@jrs-laptop:~/sb/examples/test$


I had added Array Sort to the T(ools) extension module but it can only sort one index at a time and removes duplicate values.



93
Code and examples / Re: XML Parser
« Last post by B+ on 04. July 2017, 16:54:22 »
:) Yes, that's the idea!

Can you reverse the process eg list all the keys that have the value "bee" or LIKE "bee" in different ways?

BTW, nice Help Link "HASH", I should read it before asking questions ;-))
94
Code and examples / DJPeter Math Solver in o2
« Last post by Aurel on 04. July 2017, 09:03:39 »
HI
here is version of DJPeter math solver - expression evaluator
in Oxygen Basic - using string pointers to compare strings( math functions)

Code: [Select]
' simple expression solver FB DJPeters
'Oxygen basic version by Aurel
declare sub Unary        (byref Result as float)
declare sub Parenthesized(byref Result as float)
declare sub Exponent     (byref Result as float)
declare sub MulDiv       (byref Result as float)
declare sub AddSub       (byref result as float)
'declare sub DoUnary      (Op as string,byref Result as double)
declare sub GetToken()
declare function IsDigit() as int
declare function IsAlpha() as int
declare function IsWhite() as int
declare function IsDelimiter() as int
declare function isFunction() as int

'enum TokenTypes / integer constant
 % EOL = 1
 % DELIMETER = 2
 % NUMBER = 3
 % IDENT = 4
'end enum

string  Expression,Token,ch
int TokenType,cPos,TRUE=1,FALSE=0

sub sError(sErr as string)
  print "Error: " & sErr
  'beep:sleep:end
end sub
'---------------------------------
function IsDigit() as int
  int c: c=asc(ch)
  if c>47  and c<58 or c=46
return TRUE
  end if
return FALSE
end function
'--------------------------------
function IsAlpha() as int
  int c: c=asc(ucase(ch))
  if c>64 and c<91
  return TRUE
  end if
  return FALSE
end function
'---------------------------------
function IsWhite() as int
  int c : c=asc(ch)
  return ((c=32) or (c=9))
end function
'---------------------------------
function IsDelimeter() as int
  int c: c=asc(ch)
  if c=9 then return TRUE
  c=instr("+-*/^()",ch)
  if c>0 then return TRUE
  return FALSE
end function
'---------------------------------------
function IsFunction() as int
int *f = strptr token
Select f
 case "SIN"   
       return TRUE
 case "COS"
       return TRUE
 case "TAN"
       return TRUE
 case "SQR"
       return TRUE
 end select
 
  return FALSE
end function
'----------------------------------------
sub GetChar
  cPos=cPos+1
  if cPos>len(Expression) then
    ch="":return
  end if
  ch = mid(Expression,cPos,1)
end sub
'---------------------------------------
sub GetToken()
  GetChar()
  if Ch="" then
    Token     = ""
    TokenType = EOL
    return
  end if

  if IsDelimeter()= TRUE then
    Token     = Ch
    TokenType = DELIMETER
    return
  end if

  if IsDigit()= TRUE then
    Token = ""
    while IsDelimeter()=FALSE and Ch<>""
      Token=Token+Ch
      GetChar()
    wend
    TokenType = NUMBER
    cPos=cPos-1
    return
  end if

  if IsAlpha() = TRUE then
    Token = ""
    while IsAlpha()=TRUE and Ch<>""
      Token = Token + Ch
      GetChar()
    wend
 'print "TOKEN:" & token
    Token= UCASE(Token)
    TokenType = IDENT
    cPos=cPos-1
    return
  end if
end sub
'---------------------------------------------

sub AddSub(byref Result as float)
  string Op
  float Temp
  Unary(result)
  Op=Token
  while Op = "+" or Op = "-"
    GetToken()
  Unary(Temp)
    if Op="+" then
      Result=Result+Temp
    end if
    if Op="-"
      Result=Result-Temp
    end if
    Op = Token
  wend
end sub

sub Unary(byref Result as float)
  string Op
  if TokenType=DELIMETER and (Token="+" or Token="-")
    Op = Token
    GetToken()
  end if
  MulDiv(Result)
  if Op="-" then Result = -Result
end sub

sub MulDiv(byref Result as float)
  string Op
  float Temp
  Exponent(Result)
  Op=Token
  while Op = "*" or Op = "/"
    GetToken()
    Exponent(Temp)
    if op="*" then
      Result *= Temp
    else
      if (Temp=0) then
        sError("division by zero")
      else
        Result = Result / Temp
      end if
    end if
    Op = Token
  wend
end sub

sub Exponent(byref Result as float)
  float Temp
  Parenthesized(Result)
  if (Token="^") then
    GetToken()
    Parenthesized(Temp)
    Result ^= Temp
  end if
end sub

sub Parenthesized(byref Result as float)
  if token = "-" or token = "+" then Unary(Result)
  if (Token ="(") and (TokenType = DELIMETER) then
    GetToken()
    AddSub(Result)
    if (Token <> ")") then serror("unbalanced round brackets")
    GetToken()
  else
    select TokenType
      case NUMBER
        Result = val(Token)
        GetToken()
      case IDENT
        if IsFunction()= TRUE then
          string Func : Func = Token
          int *p = strPtr Func
          float res : res = result
          GetToken()
          Parenthesized(res)

      select p
         ' case "ABS": result = abs(res)
         ' case "ATN": result = atn(res)
          case "COS": result = cos(res)
          'case "EXP": result = exp(res)
          'case "FIX": result = fix(res)
          'case "INT": result = int(res)
          'case "LOG": result = log(res)
          'case "SGN": result = sgn(res)
          case "SIN": result = sin(res)
          case "SQR": result = sqr(res)
          case "TAN": result = tan(res)
      end select
      else
        serror("unknow ident / function " & Token)
      end if
    end select
  end if
end sub

function Eval(byval s as string) as float
  float result
  Expression=s
  cPos=0
  GetToken()
  AddSub(result)
  return result
end function

string e
e = "sin(2+3)"
print e & " = " & Eval(e)

95
Code and examples / Re: XML Parser
« Last post by John on 04. July 2017, 08:41:17 »
That sounds like the Script BASIC HASH extension module functionality.

Or you could use an associative array as a hash.

Code: [Select]
dict{"A"} = 1
dict{"B"} = "bee"
dict{"C"} = "sea"

FOR x = 0 TO UBOUND(dict) STEP 2
  PRINT "Key = ",dict[x],"  Value = ",dict[x+1],"\n"
NEXT

b = "B"
PRINT dict{b},"\n"


jrs@jrs-laptop:~/sb/examples/test$ scriba assray.sb
Key = A  Value = 1
Key = B  Value = bee
Key = C  Value = sea
bee
jrs@jrs-laptop:~/sb/examples/test$
96
Code and examples / Re: It's the 4th, have a blast!
« Last post by B+ on 04. July 2017, 06:35:08 »
Code: [Select]
'fireworks 3.bas SmallBASIC 0.12.2 [B+=MGA] 2015-05-09
'fireworks 2.bas 2016-05-05 now with Gravity, Newtonian bounce, smoke debris
'fireworks 3.bas try with map variables make bursts around a central point


flare_max = 300 : debris_max = 5000 : debris_stack = 0
dim flare(flare_max)
dim debris(debris_max)

sub NewDebris(i)
  local c
  debris(i).x = rnd * xmax
  debris(i).y = rnd * ymax
  c = rnd * 255
  debris(i).c = rgb(c, c, c)
end

while 1
   rnd_cycle = rnd * 30
   loop_count = 0
   burst.x = .75 * xmax * rnd + .125 * xmax
   burst.y = .5 * ymax * rnd +.125 * ymax
   repeat
      cls
      'color 14 : locate 0,0: ? debris_stack; " Debris" 'debug line
      for i=1 to 20   'new burst using random old flames to sim burnout
         nxt = rnd * flare_max + 1
         angle = rnd * 2 * pi
         flare(nxt).x = burst.x + rnd * 5 * cos(angle)
         flare(nxt).y = burst.y + rnd * 5 * sin(angle)
         angle = rnd * 2 * pi
         flare(nxt).dx = rnd * 15 * cos(angle)
         flare(nxt).dy = rnd * 15 * sin(angle)
         rc = int(rnd * 3)
         if rc = 0 then
            'flare(nxt).c = 12 'patriotic theme
            flare(nxt).c = rgb(255, rnd * 255, 0)
         elseif rc = 1
            'flare(nxt).c = 9 'patriotic theme
            flare(nxt).c = rgb(100 + rnd * 155, 100 + rnd * 155, 220)
         else
            flare(nxt).c = 15
         endif
      next
      for i = 0 to flare_max
         if flare(i).dy then 'while still moving vertically
            line flare(i).x, flare(i).y step flare(i).dx, flare(i).dy, rgb(98, 98, 98)
            circle step flare(i).dx, flare(i).dy, 1, 1, flare(i).c filled
            flare(i).x += flare(i).dx
            flare(i).y += flare(i).dy
            flare(i).dy += .4  'add  gravity
            flare(i).dx *= .99 'add some air resistance
            if flare(i).x < 0 or flare(i).x > xmax then flare(i).dy = 0  'outside of screen
            'add some spark bouncing here
            if flare(i).y > ymax then
              if abs(flare(i).dy) > .5 then
                flare(i).y = ymax : flare(i).dy *= -.25
              else
                flare(i).dy = 0
              fi
            fi
          fi
      next
      for i = 0 to debris_stack
        pset debris(i).x, debris(i).y, debris(i).c
        debris(i).x += rnd * 3 - 1.5
        debris(i).y += rnd * 3.5 - 1.5
        if debris(i).x < 0 or debris(i).y < 0 or debris(i).x > xmax or debris(i).y > ymax then NewDebris(i)
      next
      showpage
      delay 2
      loop_count += 1
    until loop_count > rnd_cycle
    if debris_stack < debris_max then
      for i = 1 to 20
        NewDebris i + debris_stack
      next
      debris_stack += 20
    fi
wend

97
Code and examples / It's the 4th, have a blast!
« Last post by B+ on 04. July 2017, 06:33:15 »
Code: [Select]
' more particles.bas  SmallBASIC 0.12.8 [B+=MGA] 2016-11-18
' from: more particles.sdlbas [B+=MGA] 2016-11-18
' attempt to simulate alpha effect

func rand(n1, n2)
  if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
  rand = (rnd * (hi - lo + 1)) \ 1 + lo
end

def rdir = iff(rnd < .5, -1, 1)

numPoints = 100

dim  vx(numPoints), vy(numPoints), clr(numPoints), life(numPoints), lifeTime(numPoints)

wantColor = 1  'colorize on/off, 1 or 0

for i = 0 to numPoints
  initPoint(i)
next
while 1
  cls
  for p = 0 to numPoints
    life(p) += 1
    if life(p) = lifeTime(p) then
      initPoint(p)
    else
      'redraw the whole arc of particle path
      x0 = xmax/2 : y0 = .35 *  ymax : drop = vy(p)
      for i = 0 to life(p)
        if wantColor then
          select case clr(p)
          case 0
            r = 1: g = 0 : b = 0
          case 1
            r =1 : g = 1 : b = 1
          case 2
            r =0 : g = 0 : b = 1
          case 3
            r = 0 : g = .7 : b = 0
          case 4
            r= 1: g = 1 : b = 0
          case 5
            r = 1 : g = 0 : b = 1
          case 6
            r = 1 : g = .6 : b = 0
          end select
          if r = 0 then
            r = 3 * (life(p) - i)
          else
            r = i/life(p) * 255 * r
          end if
          if g = 0 then
            g = 3 * (life(p) - i)
          else
            g = i/life(p) * 255 * g
          end if
          if b = 0 then
            b = 3 * (life(p) -1)
          else
            b = i/life(p) * 255 * b
          end if
          color rgb(r, g, b)
        else
          m = i/life(p) * 255
          color rgb(m, m, m)
        end if
        xnext = x0 + vx(p)
        drop += .1
        ynext = y0 + drop
        radius = i/life(p) * 8
        circle xnext, ynext, radius filled
        x0 = xnext
        y0 = ynext
      next
    end if
  next
  showpage
wend

sub initPoint(p)
  vx(p) = rnd * 7  * rdir
  vy(p) = rnd * 7  * rdir
  clr(p) = rand(0, 6)
  life(p) = 0
  lifeTime(p) = rand(30, 70)
end
98
Code and examples / Re: XML Parser
« Last post by B+ on 03. July 2017, 15:59:45 »
Python dictionary structure is a variable/value pairing like what might be used for properties. As a common acquaintance of ours once explained it, instead of having an array with numeric indexes, you have an array of string indexes.

For BASIC sim of the dictionary structure, I would use strings and I would use one delimiter for the var/value pair, probably = sign, and another delimiter for the pairings probably a space.
99
Code and examples / Re: XML Parser
« Last post by B+ on 03. July 2017, 15:34:37 »
Code: [Select]
' like test.bas SmallBASIC 0.12.9 (B+=MGA) 2017-07-03
dim hello(), world()
open "Word List.txt" for input as #1
while eof(1)=0
  lineinput #1, fline
  two = left(fline,2)
  if two <> lasttwo then
    locate 1, 1 : ? space(20) : locate 1, 1 : ? two : lasttwo = two
  fi
  if fline like "h*" then
    if fline like "h?ll?" then hello << fline : ? fline
  elif fline like "w*" then
    if fline like "w?r?d" then world << fline : ? fline
  fi
wend
close #1
cls

for h in hello
  for w in world
    ? h;" ";w,
    c++ : if c mod 6 = 0 then ?
  next
next
?
pause
100
Code and examples / Re: XML Parser
« Last post by John on 03. July 2017, 08:45:12 »
Maybe we should change direction with this thread and make the challenge writing a LIKE function in BASIC.  :D

Hopefully someone will come up with a better name than JOKER.

BTW The Script BASIC LIKE can be either case sensitive (default) or case insensitive.
Pages: 1 ... 8 9 [10]