Board Logo
« Looking for examples to include with Just BASIC v2 »

Welcome Guest. Please Login or Register.
Jan 18th, 2018, 3:50pm


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ


« Previous Topic | Next Topic »
Pages: 1 2  Notify Send Topic Print
 sticky  Author  Topic: Looking for examples to include with Just BASIC v2  (Read 855 times)
bluatigro
Full Member
ImageImageImageImage


member is offline

Avatar

cxio difersas el tio respondas cxio samvaloras [ thats esperanto for : everybody is different therefore everybody is equal ]


PM

Gender: Male
Posts: 229
xx Re: Looking for examples to include with Just BASI
« Reply #15 on: Aug 16th, 2017, 04:58am »

i created a view examples for beginnens
and not beginners
this was for a book [ in dutch ]
the book wil not be there
so if you want them ask

here some examples :
Code:
'' bluatigro 16 aug 2017
'' les 1b strings

a$ = "abcdefghijklmnopqrstuvwxyz"
b$ = "this is a test ."
c$ = "+"
print "a$ = " ; a$
print "b$ = " ; b$
print "a$ + b$ = " ; a$ + b$
print "left$( a$ , 5 ) = " ; left$( a$ , 5 )
print "right$( a$ , 5 ) = " ; right$( a$ , 5 )
print "mid$( a$ , 7 , 5 ) = " ; mid$( a$ , 7 , 5 )
print "instr( a$ , 'j' ) = " ; instr( a$ , "j" )
print "len( a$ ) = " ; len( a$ )
print "c$ = " ; c$
print "asc( c$ ) = " ; asc( c$ )
print "chr$( 43 ) = " ; chr$( 43 )
for i = 0 to 6
  print "word$( b$ , " ; i ; " ) = " ; word$( b$ , i )
next i
 

Code:
'' bluatigro 16 aug 2017
'' les 07f triangle


WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
nomainwin
open "triangle" for graphics as #m
  #m "trapclose [quit]"
  #m "fill black"
  call triangle 50,50, 150,30 , 70,150 , "red"
wait
[quit]
  close #m
end
sub triangle x1 , y1 , x2 , y2 , x3 , y3 , kl$
  #m "color "; kl$
  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 , x2
  end if
  if y2 > y3 then
    call swap y2 , y3
    call swap x2 , x3
  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
end sub
sub swap byref a , byref b
  h = a
  a = b
  b = h
end sub
 

Code:
'' bluatigro 16 aug 2017
''les 99a oop complex
''oop example




end
function complex$( r , i )
''constructor
  complex$ = str$( r ) + " " ; i
end function
function complex.r( c$ )
''property
  complex.r = val( word$( c$ , 1 ) )
end function
function complex.i( c$ )
''property
  complex.i = val( word$( c$ , 2 ) )
end function
function complex.add$( a$ , b$ )
''  add = a + b
  ar = complex.r( a$ )
  ai = complex.i( a$ )
  br = complex.r( b$ )
  bi = complex.i( b$ )
  complex.add$ = complex$( ar + br , ai + bi )
end function
function complex.sub$( a$ , b$ )
''  sub = a - b
  ar = complex.r( a$ )
  ai = complex.i( a$ )
  br = complex.r( b$ )
  bi = complex.i( b$ )
  complex.sub$ = complex$( ar - br , ai - bi )
end function
function complex.multy$( a$ , b$ )
''  multy = a * b
  ar = complex.r( a$ )
  ai = complex.i( a$ )
  br = complex.r( b$ )
  bi = complex.i( b$ )
  a = ar * br - ai * bi
  b = ar * bi + ai * br
  complex.multy$ = complex$( a , b )
end function
function complex.div$( a$ , b$ )
''  div = a / b
  r1 = complex.r( a$ )
  i1 = complex.i( a$ )
  r2 = complex.r( b$ )
  i2 = complex.i( b$ )
  a = ( r1 * r2 + i1 * i2 ) /(r2*r2+i2*i2)
  b = ( r2 * i2 - r1 * i1 ) /(r2*r2+i2*i2)
  complex.div$ = complex$( a , b )
end function
function complex.abs( a$ )
''  abs( a )
  r1 = complex.r( a$ )
  i1 = complex.i( a$ )
  complex.abs = sqr( r1*r1 + i1*i1 )
end function
function complex.sqr$( a$ )
''  sqr( a )
  r1 = complex.r( a$ )
  i1 = complex.i( a$ )
  a = sqr((r1+sqr(r1*r1+i1*1))/2)
  b = 2*sqr((r1+sqr(r1*r1+i1*i1))/2)
  b = i1 / b
  complex.sqr$ = complex$( a , b )
end function
function complex.log$( a$ )
''  log( a )
  r1 = complex.r( a$ )
  i1 = complex.i( a$ )
  a = log(sqr(r1*r1+i1*i1))
  b = atn(i1/r1)
  complex.log$ = complex$( a , b )
end function
function complex.exp$( a$ )
''  exp( a )
  r1 = complex.r( a$ )
  i1 = complex.i( a$ )
  a = exp(r1)*cos(i1)
  b = exp(r1)*sin(i1)
  complex.exp$ = complex$( a , b )
end function
 

Code:
'' bluatigro 16 aug 2017
'' les 99i polar bears
'' genetic algoritm example
global dnamax
dnamax = 29
dim dna( dnamax )
global generation
WindowWidth = 800
WindowHeight = 600
'nomainwin
open "Polar bears ." for graphics as #m
  #m "trapclose [quit]"
  #m "font Corier_new 30 bold"
  ''first we fill the dna whit random chromoson
  for i = 0 to dnamax
    dna( i ) = int( rnd(0) * 2 ^ 24 )
  next
  timer 2000 , [timer]
wait
[timer]
  #m "fill 127 127 127"
  #m "goto 0 30"
  #m "down"
  #m "\Generation : " ; generation
  #m "up"
  scan
  ''draw bears
  for x = 0 to 2
    for y = 0 to dnamax / 3
      call draw.bear x * 250 _
      , y * 50 + 90 , dna( x + y * 3 )
    next y
  next x
  ''next gereration
  generation = generation + 1
  ''sort bears on fitness
  for h = 1 to dnamax
    for l = 0 to h - 1
      if fout( dna( l ) ) > fout( dna( h ) ) then
        help = dna( l )
        dna( l ) = dna( h )
        dna( h ) = help
      end if
    next l
  next h
  ''create childern and mutate some of them
  for i = 6 to dnamax
    a = int( rnd(0) * 6 )
    b = int( rnd(0) * 6 )
    dna( i ) = child( dna( a ), dna( b ) )
    if rnd(0) > 0.5 then
      dna( i ) = mutate( dna( i ))
    end if
  next i
wait
[quit]
  close #m
end
function fout( kl )
  r = int( kl) and 255
  g = int( (kl / 256)) and 255
  b = int( kl / ( 256 ^ 2 ) ) and 255
  fout = sqr((255-r)^2+(255-g)^2+(255-b)^2)
end function
sub draw.bear x , y , kl
  r = int( kl and 255 )
  g = int( (kl / 256)) and 255
  b = int( kl / ( 256 ^ 2 )) and 255
  if r + g + b > 127 * 3 then
    #m "color black"
  else
    #m "color white"
  end if
  #m "backcolor " ; r ; " " ; g ; " " ; b
  #m "goto " ; x ; " " ; y
  #m "down"
  #m "\" + nr$( r ) + " " + nr$( g ) + " " + nr$( b )
  #m "up"
end sub
function nr$( x )
  nr$ = right$( "000" ; x , 3 )
end function
function child( a , b )
  uit = 0
  for i = 0 to 23
    if rnd(0) < 0.5 then
      uit = uit + ( a and ( 2 ^ i ) )
    else
      uit = uit + ( b and ( 2 ^ i ) )
    end if
  next i
  child = uit
end function
function mutate( a )
  mutate = a xor ( 2 ^ int( rnd(0) * 23 ) )
end function
 

i have +- 30 lessons . interested ?
« Last Edit: Aug 16th, 2017, 04:59am by bluatigro » User IP Logged

bluatigro
Full Member
ImageImageImageImage


member is offline

Avatar

cxio difersas el tio respondas cxio samvaloras [ thats esperanto for : everybody is different therefore everybody is equal ]


PM

Gender: Male
Posts: 229
xx Re: Looking for examples to include with Just BASI
« Reply #16 on: Aug 16th, 2017, 05:05am »

a simple game :
Code:
'' blua tigro 16 aug 2017
'' not 3
'' event driven game exsample
WindowWidth = 600
WindowHeight = 650
global who.play , who1 , who2 , human , rando , r1000
global game , hr , rh , hr1 , r1h
human = 1
rando = 2
r1000 = 3
hr = 1
rh = 2
hr1 = 3
r1h = 4
dim bord( 9 )
nomainwin
button #m.1 , "1" , btn.click , UL , 0 , 400 , 200 , 200
button #m.2 , "2" , btn.click , UL , 200 , 400 , 200 , 200
button #m.3 , "3" , btn.click , UL , 400 , 400 , 200 , 200
button #m.4 , "4" , btn.click , UL , 0 , 200 , 200 , 200
button #m.5 , "5" , btn.click , UL , 200 , 200 , 200 , 200
button #m.6 , "6" , btn.click , UL , 400 , 200 , 200 , 200
button #m.7 , "7" , btn.click , UL , 0 , 0 , 200 , 200
button #m.8 , "8" , btn.click , UL , 200 , 0 , 200 , 200
button #m.9 , "9" , btn.click , UL , 400 , 0 , 200 , 200
menu #m , "Game" _
        , "You vs rando" , humanrando _
        , "Rando vs you" , randohuman _
        , "You vs r1000" , humanr1000 _
        , "r1000 vs you" , r1000human _
        , | , "Quit" , quit

open "NOT 3" for window as #m
  #m "trapclose [quit]"
  #m "font 100 bold"
wait
sub quit
  close #m
end sub
[quit]
  close #m
end
sub humanrando
  who1 = human
  who2 = rando
  game = hr
  call new.game
end sub
sub randohuman
  who1 = rando
  who2 = human
  game = rh
  call new.game
end sub
sub humanr1000
  who1 = human
  who2 = r1000
  game = hr1
  call new.game
end sub
sub r1000human
  who1 = r1000
  who2 = human
  game = r1h
  call new.game
end sub
sub new.game
  for i = 1 to 9
    bord( i ) = 0
  next i
  bord( 0 ) = 1
  #m.1 , "1"
  #m.2 , "2"
  #m.3 , "3"
  #m.4 , "4"
  #m.5 , "5"
  #m.6 , "6"
  #m.7 , "7"
  #m.8 , "8"
  #m.9 , "9"
  who.play = who1
  bordstate = 0
  if who.play = rando then
    call rando.zet
  end if
  if who.play = r1000 then
    call r1000.zet
  end if
end sub
sub btn.click h$
  if who.play = human then
    z = val( right$( h$ , 1 ) )
    if bord( z ) then
      notice "ON A EMPTY PLASE PLEASE !!"
      exit sub
    end if
    call any.zet z
  end if
  if game = hr or game = rh then
    call rando.zet
  end if
  if game = hr1 or game = r1h then
    call r1000.zet
  end if
end sub
sub any.zet z
  bord( z ) = 1
  select case z
    case 1
      #m.1 , "X"
    case 2
      #m.2 , "X"
    case 3
      #m.3 , "X"
    case 4
      #m.4 , "X"
    case 5
      #m.5 , "X"
    case 6
      #m.6 , "X"
    case 7
      #m.7 , "X"
    case 8
      #m.8 , "X"
    case 9
      #m.9 , "X"
    case else
  end select
  if who.play = who1 then
    who.play = who2
  else
    who.play = who1
  end if
  if row() then
    select case who.play
      case human
        notice "You won !!"
      case r1000
        notice "r1000 won ."
      case else ''rando
        notice "rando won ."
    end select
  end if
end sub
function ry( a , b , c )
  ry = bord(a) and bord(b) and bord(c)
end function
function row()
  row = ry( 1 , 2 , 3 ) _
     or ry( 4 , 5 , 6 ) _
     or ry( 7 , 8 , 9 ) _
     or ry( 1 , 4 , 7 ) _
     or ry( 2 , 5 , 8 ) _
     or ry( 3 , 6 , 9 )
end function
sub rando.zet
  dice = int( rnd(0) * 9 )
  while bord( dice )
    dice = int( rnd(0) * 9 )
  wend
  notice "Rando moves on : " ; dice
  call any.zet dice
end sub
sub r1000.zet
  i = 0
  done = 0
  do
    i = i + 1
    dice = int( rnd(0) * 9 )
    while bord( dice )
      dice = int( rnd(0) * 9 )
    wend
    bord( dice ) = 1
    if not( row() ) then done = 1
    bord( dice ) = 0
  loop while not( done ) and i < 1000
  notice "R1000 moves on " ; dice
  call any.zet dice
end sub
 
User IP Logged

bluatigro
Full Member
ImageImageImageImage


member is offline

Avatar

cxio difersas el tio respondas cxio samvaloras [ thats esperanto for : everybody is different therefore everybody is equal ]


PM

Gender: Male
Posts: 229
xx Re: Looking for examples to include with Just BASI
« Reply #17 on: Aug 16th, 2017, 05:25am »

this can be useful too
Code:
'' bluatigro 16 aug 2017
'' sprite draw it
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
nomainwin
global mode , pixel , lijn , ellipse , box , remove
global ellipsefill , boxfill , ox , oy , nx , ny
global file$ , size , winx , winy , color$ , backolor$
global sprx , spry
winx = WindowWidth
winy = WindowHeight
sprx = 64
spry = 64
menu #m , "file" _
        , "new" , [new] _
        , "open" , [open] _
        , "save" , [save] _
        , "save as" , [saveAs] _
        ,|, "exit" , [quit]
menu #m , "tools" _
        , "pixel" , [pixel] _
        , "line" , [line] _
        , "ellipse" , [ellipse] _
        , "ellipse fill" , [ellipsefill] _
        , "box" , [box] _
        , "box fill" , [boxfill] _
        , "remove" , [remove] _
        ,|, "size" , [size] _
        ,|, "color" , [color] _
        , "backcolor" , [backcolor]
size = 1
pixel = 1
lijn = 2
ellipse = 3
ellipsefill = 4
box = 5
boxfill = 6
remove = 7
color$ = "black"
backcolor$ = "yellow"
mode = pixel
open "draw it sprite" for graphics as #m
  #m "trapclose [quit]"
  #m "when mouseMove [move]"
  #m "when leftButtonDown [leftdown]"
  #m "when leftButtonMove [leftmove]"
  #m "when leftButtonUp [leftup]"
  #m "setfocus"
wait
[move]
  nx = MouseX
  ny = MouseY
wait
[leftmove]
  nx = MouseX
  ny = MouseY
  #m "rule " ; _R2_NOTXORPEN
  #m "color white"
  #m "size 1"
  select case mode
    case lijn
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
    case ellipse
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case ellipsefill
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case box
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case boxfill
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case pixel
      #m "rule " ; _R2_COPYPEN
      #m "color black"
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny - spry
      #m "down"
      #m "set " ; nx ; " " ; ny - spry
      #m "up"
      #m "color " ; color$ 
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny
      #m "down"
      #m "set " ; nx ; " " ; ny
      #m "up"
     case else ''remove
      #m "rule " ; _R2_COPYPEN
      #m "color white"
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny - spry
      #m "down"
      #m "set " ; nx ; " " ; ny - spry
      #m "up"
      #m "color black"
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny
      #m "down"
      #m "set " ; nx ; " " ; ny
      #m "up"
  end select
wait
sub Pause ms
  t = time$( "milliseconds" )
  while time$( "milliseconds" ) < t + ms
  wend
end sub
[leftdown]
  ox = MouseX
  oy = MouseY
wait
[leftup]
  #m "rule " ; _R2_COPYPEN
  #m "size " ; size
  select case mode
    case lijn
      #m "color black"
      #m "down"
      #m "line " ; ox ; " " ; oy - spry _
      ; " " ; nx ; " " ; ny - spry
      #m "up"
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
    case ellipse
      #m "color black"
      #m "goto " ; ( ox + nx ) / 2 _
      ; " " ; ( oy + ny ) / 2 - spry
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case ellipsefill
      #m "color black"
      #m "backcolor black"
      #m "goto " ; ( ox + nx ) / 2 _
      ; " " ; ( oy + ny ) / 2 - spry
      #m "down"
      #m "ellipsefilled " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipsefilled " ; nx - ox ; " " ; ny - oy
      #m "up"
    case box
      #m "color black"
      #m "goto " ; ox ; " " ; oy - spry
      #m "down"
      #m "box " ; nx ; " " ; ny - spry
      #m "up"
      #m "color " ; color$
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case boxfill
      #m "color black"
      #m "backcolor black"
      #m "goto " ; ox ; " " ; oy - spry
      #m "down"
      #m "boxfilled " ; nx ; " " ; ny - spry
      #m "up"
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "boxfilled " ; nx ; " " ; ny
      #m "up"
    case else
  end select
wait
[pixel]
  mode = pixel
wait
[line]
  mode = lijn
wait
[ellipse]
  mode = ellipse
wait
[ellipsefill]
  mode = ellipsefill
wait
[box]
  mode = box
wait
[boxfill]
  mode = boxfill
wait
[remove]
  mode = remove
wait
[size]
  s$ = str$( size )
  prompt "size = " ; s$
  size = val( s$ )
wait
[color]
  prompt "Color = " ; color$
wait
[backcolor]
  prompt "Backcolor = " ; backcolor$
wait
[new]
  file$ = DefaultDir$ + "\unnamed.bmp"
  #m "fill white"
[x]
  x$ = str$( sprx )
  prompt "X size ?" ; x$
  sprx = val( x$ )
  if sprx > winx then goto [x]
[y]
  y$ = str$( spry )
  prompt "Y size ?" ; y$
  spry = val( y$ )
  if spry > winy / 2 then goto [y]
  #m "goto " ; 0 ; " " ; spry - 1
  #m "color black"
  #m "backcolor black"
  #m "down"
  #m "boxfilled " ; sprx ; " " ; spry * 2
  #m "up"
wait
[open]
  filedialog "open bmp" , "*.bmp" , file$
  loadbmp "bmp" , file$
  #m "drawbmp bmp"
  #m "drawsprites"
wait
[saveAs]
  filedialog "save bmp" , "*.bmp" , file$
[save]
  #m "getbmp bmp 0 0 " ; sprx ; " " ; spry * 2
  bmpsave "bmp" , file$ + ".bmp"
wait
[quit]
  close #m
end

 
User IP Logged

Pages: 1 2  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls