### Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.

### Topics - B+

Pages: [1] 2
1
##### Code snippets / Aquarium with swaying kelp
« on: October 14, 2016 »
Well I got the kelp to sway but the movie is a little blinky...

Code: [Select]
`'aquarium with kelp.txt for NaaLaa 6 [B+=MGA] 2016-10-14'tranlated from previous coderandomize(time())radiansvisible:xmax = 600ymax = 300pi# = 3.1415kelp[xmax + 1][ymax + 1]set window 180, 40, xmax, ymaxset redraw falsehidden:'setup n fish x, y, length, dx (x speed), plasma colors r,b,gn = 26r# = 0.0 ; g# = 0.0 ; b# = 0.0x[n]; y[n]; l[n]; dx[n]; rr#[n]; gg#[n]; bb#[n]for i = 0 to n-1 x[i] = rnd(xmax) y[i] = rnd(ymax) l[i] = int(float(rnd(xmax)) * 0.0625 + 18.0) dx[i] = rnd(4) + 2 d = rnd(2) if d <> 0 then dx[i] = dx[i] * -1 r# = r# + 0.2     ; if r# > 0.5 then r# = 0.02   ; rr#[i] = r# g# = g# + 0.005   ; if g# > 0.5 then g# = 0.005  ; gg#[i] = g# b# = b# + 0.01    ; if b# > 0.5 then b# = 0.01   ; bb#[i] = b#next'setup kelpset color 0, 128, 0set caret 100, 130wln "Please wait, growing the kelp..."redraw_growKelpz = 0while 1 'clr screen with water grad for i = 0 to ymax-1 set color 0, 0, 255 - int( float#(i) / float#(ymax)  * 255.0 ) draw line 0, i, xmax, i next z = z + 1 z = z % 20 _showKelp z 'draw fish for i = 0 to n-1 x[i] = x[i] + dx[i] + rnd(3) if float#(x[i]) + 1.25 * float#(l[i]) < 0.0 then dx[i] = -1 * dx[i] if float#(x[i]) - 1.25 * float#(l[i]) > float#(xmax) then dx[i] = -1 * dx[i] y[i] = y[i] + rnd(3) - 1 for ra = 1 to l[i] rd = int(127.0 + 127.0 * sin(rr#[i] * 3.0 * float#(ra))) gn = int(127.0 + 127.0 * sin(gg#[i] * 3.0 * float#(ra))) bl = int(127.0 + 127.0 * sin(bb#[i] * 3.0 * float#(ra))) set color rd, gn, bl if dx[i] < 0 then draw line x[i] + ra, y[i] - ra, x[i] + ra, y[i] + ra else draw line x[i] - ra, y[i] - ra, x[i] - ra, y[i] + ra endif next for ra = 5 to int(0.3 * float#(l[i])) rd = int(127.0 + 127.0 * sin(rr#[i] * float#(ra))) gn = int(127.0 + 127.0 * sin(gg#[i] * float#(ra))) bl = int(127.0 + 127.0 * sin(bb#[i] * float#(ra))) set color rd, gn, bl if dx[i] < 0 then draw line x[i] + l[i] + ra, y[i] - ra, x[i] + l[i] + ra, y[i] + ra else draw line x[i] - l[i] - ra, y[i] - ra, x[i] - l[i] - ra, y[i] + ra endif next if dx[i] < 0 then set colori 0      _rmDisk x[i] + int( 0.25 * float#(l[i]) ), y[i], int( 0.1 * float#(l[i]) ) set colori 0xFFFF00      _circByLine x[i] + int(0.25 * float#(l[i]) ), y[i], int( 0.06 * float#(l[i]) ) else set colori 0x000000      _rmDisk x[i] - int(0.25 * float#(l[i]) ), y[i], int( 0.1 * float#(l[i]) ) set colori 0xFFFF00      _circByLine x[i] - int(0.25 * float#(l[i])), y[i], int( 0.06 * float#(l[i]) ) endif next redraw wait 25wendprocedure circByLine(x, y, r) 'may 25, 2015 rsq = r * r; ly = 0 for cx = r downto 0 cy = int(sqr#(float(rsq - cx * cx))) x1 = x + cx; x2 = x - cx; y1 = y + ly; y2 = y+cy; y3 = y - ly; y4 = y - cy draw line x1, y1, x1, y2 draw line x1, y3, x1, y4 draw line x2, y1, x2, y2 draw line x2, y3, x2, y4 ly = cy nextendprocprocedure rmDisk(x, y, r) rsq = r * r for a = 0 to r b = int(sqr(float(rsq - a * a))) x1 = x + a; x2 = x - a; y1 = y - b; y2 = y + b draw line x1, y1, x1, y2 draw line x2, y1, x2, y2 nextendprocprocedure growKelp() d = 1 while d <= ymax x = rnd(xmax) y = d c = 0 while y <> 0 and c = 0 if y - 1 >= 0 and x + 1 <= xmax + 1 and x - 1 >= 0 c = kelp[x][ y - 1]      if rnd(2) = 1 and kelp[x - 1][ y - 1] <> 0 then c = kelp[x - 1][y - 1]      if c = 0       c = kelp[x - 1][y - 1]        c = kelp[x + 1][y - 1]        y = y - 1 endif else c = (x % 23) + 1 endif wend if c = 0 then c = (x % 23) + 1 kelp[x][y] = c    if y = d - 1 then d = d + 1 wendendprocprocedure showKelp(z)    for y = 0 to ymax dy# = (float(y) * pi# / 180.0 + float(z)) * (float(y) / float(ymax)) xoff = int(5.0 * sin(float(dy#)))        for x = 0 to xmax            if kelp[x][y] > 0 and kelp[x][y] < 16 then                set color 0, kelp[x][y] * 16, 0                set pixel x + xoff, ymax - y            endif        next    nextendproc`

2
##### Code snippets / Another banana Mandelbrot
« on: September 21, 2016 »
Sorry, I had a few extra bananas hanging around after shooting down some gorillas:

Code: [Select]
`'another banana mandelbrot.txt for Naalaa [B+=MGA] 2016-09-021t = time()XMAX = 700YMAX = 600set window 200, 40, XMAX, YMAXset redraw offload image 1, "assets/banana.png"set color 255, 255, 255draw rect 0, 0, XMAX, YMAX, truefor y = -30 to 30  for x = -5 to 64    m# = 0.0 ; r# = 0.0    for k = 0 to 15      j# = r# * r# - m# * m# - 2.0 + float(x) / 25.0      m# = 2.0 * r# * m# + float(y) / 25.0      r# = j#      l = k % 16      if j# * j# + m# * m# > 11.0 then k = 112    next    if l = 15 clear transformation translate (float(x) + 5.0) * 10.0, (float(y) + 30.0) * 10.0 scale 1.0, 1.0 bananaRot# = float(rnd(360)) rotate bananaRot# draw image 1 'set colori 0 'draw rect (x+5)*10, (y+30)*10, 10,  10, true endif  nextnextset caret 10, 10set colori 0wln "time ", (time() - t), " ms"redrawwait keydown`

3
##### Code snippets / Connett Circles
« on: September 17, 2016 »
http://shawweb.myzen.co.uk/stephen/sdlbasic.htm

Code: [Select]
`'patterns.txt Naalaa [B+=MGA] from 'pattern.bas for SmallBASIC 0.12.0 2015-11-27 Peter W & MGA/B+'pixel colorized versionconstant:xmax = 800ymax = 600hidden:set window 100, 40, xmax, ymax set redraw false  s# = 500.0while 1 set colori 0xffffff cls set colori 0 for y = 0 to ymax for x = 0 to xmax a# = float(x) * s / 600.0 b# = float(y) * s / 600.0 c# = a# * a# + b# * b# d# = c# / 2.0 d# = d# - float(int(d#)) if d# < 0.25 r = int(d# * 4.0 * 255.0) set color r, 0, 0 elseif d# < 0.5 g = int(d# * 2.0 * 255.0) set color 0, g, 0 elseif d# < 0.75 bl = int(d# * 4.0 / 3.0 * 255.0) set color 0, 0, bl else set color 0, 0, 0 endif draw pixel x, y next next redraw wait 200 if keydown(27, true) then end s# = s# + 5.0 if s# > 1000.0 then s# = 5.0wend`

4
##### Code snippets / Analog (and digital) Clock
« on: September 13, 2016 »
Testing KSINK import. Works for me!

Code: [Select]
`' clock.txt [B+=MGA] 2016-09-12' test using this ksink library and dllimport "ksink.lib"'needs ksink.dll too in same folderconstant:XMAX = 400YMAX = 400XC = 200YC = 200HR# = 4.0HL1# = 175.0HL2# = 10.0HhandR# = 15.0MhandR# = 8.0ShandR# = 5.0HhandL# = 105.0MhandL# = 150.0ShandL# = 160.0visible:hidden:set window 100, 40, XMAX, YMAXset redraw falsePstart = xy2P(XC, YC)do set colori 0 cls 'digital time set colori 0xffffff set caret 5, 5 h\$ = str(GetHour() + 0) if len(h\$) = 1 then h\$ = "0" + h\$ m\$ = str(GetMinute() + 0)  if len(m\$) = 1 then m\$ = "0" + m\$ s\$ = str(GetSecond() + 0) if len(s\$) = 1 then s\$ = "0" + s\$ wln h\$, ":", m\$, ":", s\$ 'allow esc set caret 360, 380 wln "esc" 'analog time 'draw hour markers for i = 0 to 11 'this draws an invisble arm out to hour markers aHR# = float(i * 30) - 90.0 set colori 0 Pnext = quad(Pstart, 1.0, aHR#, HL1# - 10.0, 1.0) 'use Pnext to locate hour marker starts set colori 0xffffff Pnext = quad(Pnext, HR#, aHR#, HL2#, HR#) next 'draw the clock hands 'account for partial hour and minute passed with fractions minFrac# = float(GetMinute() % 60) / 60.0 secFrac# = float(GetSecond() % 60) / 60.0 'arm angles 0 degrees is due east, so minus 90 is north = 0 for our clock aHour# = (float(GetHour() % 12) + minFrac#)  / 12.0  * 360.0 - 90.0 aMin# =  (minFrac# + secFrac# / 60.0) * 360.0 - 90.0 aSec# =  secFrac# * 360.0 - 90.0 'draw arms with slightly different shades of gray set colori 0xf0f0f0 Pnext = quad(Pstart, HhandR#, aHour#, HhandL#, HhandR# - 6.0) set colori 0xa0a0a0 Pnext = quad(Pstart, MhandR#, aMin#, MhandL#, MhandR# - 3.5) set colori 0x707070 Pnext = quad(Pstart, ShandR#, aSec#, ShandL#, ShandR# - 3.0) 'draw a center pin set colori 0 _fcirc XC, YC, 2 redraw wait 1until keydown(27, true)function quad(pStart, r1#, ang#, lng#, r2#)'solid fill circles at both ends, use polygon 4 points to fill middle area'draws from pStart at radius r1 down angle ang for length of leg'with r2 being the radius at end point 'returns the x, y end point in P form for further pendage drawing'constants XMAX, YMAX'needs fcirc(x, y, r)'needs xy2P(x, y) 'extract x, y start line of circles  fx# = float(pStart % (XMAX + 1)) fy# = float(pStart) / float(XMAX) x1# = fx# + r1# * cos(ang# + 90.0) y1# = fy# + r1# * sin(ang# + 90.0) x2# = fx# + r1# * cos(ang# - 90.0) y2# = fy# + r1# * sin(ang# - 90.0) xe# = fx# + lng# * cos(ang#) ye# = fy# + lng# * sin(ang#) x3# = xe# + r2# * cos(ang# + 90.0) y3# = ye# + r2# * sin(ang# + 90.0) x4# = xe# + r2# * cos(ang# - 90.0) y4# = ye# + r2# * sin(ang# - 90.0) _fcirc int(fx#), int(fy#), int(r1#) _fcirc int(xe#), int(ye#), int(r2#) 'draw quad fill draw poly[int(x1#), int(y1#), int(x2#), int(y2#), int(x4#), int(y4#), int(x3#), int(y3#)], true return xy2P(int(xe#), int(ye#))endfuncprocedure fcirc(x, y, r) rsq = r * r for a = 0 to r b = int(sqr(float(rsq - a * a))) x1 = x + a; x2 = x - a; y1 = y - b; y2 = y + b draw line x1, y1, x1, y2 draw line x2, y1, x2, y2 nextendprocfunction xy2P(x, y) 'note uses constants XMAX screen width return y * (XMAX + 1) + xendfunc`

5
##### Code snippets / Quad test
« on: September 06, 2016 »
Code: [Select]
`'quad test.txt for Naalaa [B+=MGA] 2016-09-05' try appendage with polygon fill methodconstant:XMAX = 800YMAX = 600hidden:set window 100, 40, 800, 600set redraw offfor a = 0 to 360 set colori 0 cls set color 255, 0, 0 cp = xy2P(400, 300) nextP = quad(cp, 1.0, float(a), 150.0, 50.0) set color 0, 128, 0 nextP = quad(nextP, 1.0, float(a) * 4.0, 75.0, 25.0) set color 0, 0, 255 nextP = quad(nextP, 1.0, float(a) * 16.0, 50.0, 13.0) set color 255, 255, 0 nextP = quad(nextP, 1.0, float(a) * 64.0, 25.0, 7.0) redraw wait 100nextwait keydownfunction quad(pStart, r1#, ang#, lng#, r2#)'solid fill circles at both ends, use polygon 4 points to fill middle area'draws from pStart at radius r1 down angle ang for length of lng'with r2 being the radius at end point 'returns the x, y end point in P form for further pendage drawing'constants XMAX, YMAX'needs fcirc(x, y, r)'needs xy2P(x, y) 'extract x, y start line of circles  fx# = float(pStart % (XMAX + 1)) fy# = float(pStart) / float(XMAX) x1# = fx# + r1# * cos(ang# + 90.0) y1# = fy# + r1# * sin(ang# + 90.0) x2# = fx# + r1# * cos(ang# - 90.0) y2# = fy# + r1# * sin(ang# - 90.0)  xe# = fx# + lng# * cos(ang#)  ye# = fy# + lng# * sin(ang#) x3# = xe# + r2# * cos(ang# + 90.0) y3# = ye# + r2# * sin(ang# + 90.0) x4# = xe# + r2# * cos(ang# - 90.0) y4# = ye# + r2# * sin(ang# - 90.0) _fcirc int(fx#), int(fy#), int(r1#)  _fcirc int(xe#), int(ye#), int(r2#) 'draw quad fill draw poly[int(x1#), int(y1#), int(x2#), int(y2#), int(x4#), int(y4#), int(x3#), int(y3#)], true return xy2P(int(xe#), int(ye#))endfuncprocedure fcirc(x, y, r) rsq = r * r for a = 0 to r b = int(sqr(float(rsq - a * a))) x1 = x + a; x2 = x - a; y1 = y - b; y2 = y + b draw line x1, y1, x1, y2 draw line x2, y1, x2, y2 nextendprocfunction xy2P(x, y) 'note uses constants XMAX screen width return y * (XMAX + 1) + xendfunc`

6
##### General discussion / Convert 3 r,g,b to one?
« on: September 02, 2016 »
There must be a way to convert 3 RGB integers to one for set colori to use instead of set color?

I am looking for RGB2I(r, g, b) function.

7
##### Code snippets / Illustrated Human Sort
« on: August 31, 2016 »
Code: [Select]
`' Illustrated Human Sort.txt for Naalaa 2016-08-30 translated from' Illustrated Human Sort.txt for JB v1.01 2016-08-30 translated from' Illustrated Human Sort.bas SmallBASIC 0.12.6 [B+=MGA] 2016-08-29' well this is a disaster (a quick translation is not possible) !!!' #1 < <= > >= operators do not work on strings' #2 printing over text on screen eg spaces does not erase' need rebuild screen at each update ' Using Binary Search Algorithm to sort some alpha numeric stringsset window 200, 40, 400, 440set redraw falserandomize time()constant:SP8\$ = "        "N = 15visible:fi\$ = ""high = 0low = 0check = 0filed\$[N + 1]fileThis\$[N + 1]hidden:'set up work pilefor y = 1 to N  c\$ = mid\$("ABCDEFGHIJKLMNOPQRSTUVWXYZ", rnd(26), 1)  r = rnd(8)   for i = 0 to r    c\$ = c\$ + mid\$("abcdefghijklmnopqrstuvwxyz", rnd(26), 1)  next  if len(c\$) < 5 then c\$ = mid\$("0123456789", rnd(10), 1) + mid\$("0123456789", rnd(10), 1) + " " + c\$  fileThis\$[y] = left\$(c\$ + SP8\$, 8)nextproc us 0'do some filingfor i = 1 to N 'move file to working place and remove from work array fi\$ = fileThis\$[i] fileThis\$[i] = "" proc us i  if i = 1 then    filed\$[1] = fi\$ fi\$ = "" proc us i  else 'this is main event    iPoint = findIndex(fi\$, i - 1 )    for j = i downto iPoint + 1        filed\$[j] = filed\$[j - 1]    next filed\$[iPoint] = "" proc us i    filed\$[iPoint] = fi\$ fi\$ = "" proc us i endifnextset colori 0x00ffffproc pa 0, N + 2, "  I am done sorting things out!"redrawwait keydownfunction findIndex(find\$, ub) 'proc pa 60, ub +1, find\$ +", "+filed\$[ub] 'OK so far i = ub + 1  lb = 1 check = ub proc us i  if GTE(find\$, filed\$[ub]) then    check = 0    return ub + 1  else    high = ub check = 0 proc us i  endif check = lb  proc us i  if LTE(find\$, filed\$[lb]) then high = 0 check = 0 proc us i    return lb  else    low = lb check = 0    proc us i  endif   midi = int(float(high - low) / 2.0) + low  check = midi  proc us i  while midi <> low    if find\$ = filed\$[midi] then      low = 0      high = 0       check = 0    proc us i      return midi     endif     if LT(find\$, filed\$[midi]) then high = midi check = 0      proc us i    else    low = midi check = 0      proc us i  endif  midi = int(float(high - low ) / 2.0) + low check = midi  proc us i  wend  check = 0  high = 0  sv = low low = 0  proc us i   return sv + 1endfunc' redraw whole screen then pauseprocedure us(i) set colori 0x0 draw rect 0, 0, 800, 600, true set colori 0x0000ff proc pa 0, -1, "File These:" proc pa 15, -1, "File:" proc pa 30, -1, "Filed:" set colori 0xff8800 for j = 1 to N proc pa 0, j, fileThis\$[j] next set colori 0x00b830 proc pa 15, i, fi\$ set colori 0xffffff if low and low = high then proc pa 28, low, "?" if high and high <> low then proc pa 28, high, "<" if low and low <> high then proc pa 28, low, ">" if check then if check <> low and check <> high then proc pa 28, check, "?" endif set colori 0xffff00 for j = 1 to N proc pa 30 + 0, j + 0, filed\$[j +0] next redraw proc d1endprocprocedure pa(xCol, yRow, text\$)  set caret (xCol + 2) * 8, (yRow + 2) * 20 wln text\$endprocprocedure d1()    wait 1000endproc'note mid\$ does not error if position is less than 0 or greater than len(string) -1'compare s1\$ <= s2\$ return true if so else false unless one string = "" then error, return -1function LTE(s1\$, s2\$) if s1\$ = "" or s2\$ = "" then return -1 if s1\$ = s2\$ then return true elseif len(s1\$) <= len(s2\$) then lm1 = len(s1\$) - 1 ; shorter\$ = s1\$ else lm1 = len(s2\$) ; shorter\$ = s2\$ endif for i = 0 to lm1 if asc(mid(s1\$, i, 1)) < asc(mid(s2\$, i, 1)) then return true elseif asc(mid(s1\$, i, 1)) > asc(mid(s2\$, i, 1)) then return false endif next 'still here? if shorter\$ = s1\$ then return true else return false endifendfunc'if s1\$ or s2\$ = "" return -1, error compare s1\$ < s2\$function LT(s1\$, s2\$) if s1\$ = "" or s2\$ = "" then return -1 if s1\$ = s2\$ then return false elseif len(s1\$) <= len(s2\$) then lm1 = len(s1\$) - 1 ; shorter\$ = s1\$ else lm1 = len(s2\$) ; shorter\$ = s2\$ endif for i = 0 to lm1 if asc(mid(s1\$, i, 1)) < asc(mid(s2\$, i, 1)) then return true elseif asc(mid(s1\$, i, 1)) > asc(mid(s2\$, i, 1)) then return false endif next 'still here? if shorter\$ = s1\$ then return true else return false endifendfuncfunction GTE(s1\$, s2\$) if s1\$ = "" or s2\$ = "" then return -1 if s1\$ = s2\$ then return true elseif len(s1\$) <= len(s2\$) then lm1 = len(s1\$) - 1 ; shorter\$ = s1\$ else lm1 = len(s2\$) ; shorter\$ = s2\$ endif for i = 0 to lm1 if asc(mid(s1\$, i, 1)) > asc(mid(s2\$, i, 1)) then return true elseif asc(mid(s1\$, i, 1)) < asc(mid(s2\$, i, 1)) then return false endif next 'still here? if shorter\$ = s1\$ then return false else return true endifendfunc`

8
##### Code snippets / Henon translation
« on: August 29, 2016 »
Code: [Select]
`'Henon translation [B+=MGA] 2016-08-28xmax = 800ymax = 600set window 100, 40, xmax, ymaxradiansset redraw offa# = -10.1 ; sc# = 175.0 ; ox# = 400.0 ; oy# = 300.0while a# < 100.0 set colori 0 draw rect 0, 0, 800, 600, true x# = -0.1 while x# < 0.8 x# = x# + 0.05 y# = -0.1 while y# < 0.8 y# = y# + 0.05 lx# = x# ; ly# = y# for n =1 to 40 xx# = lx# * cos(a) - (ly# - lx# * lx#) * sin(a#) ly# = lx# * sin(a) + (ly# - lx# * lx#) * cos(a#) lx# = xx# if abs(int(lx#) + int(ly#)) > 3000 then n = 41 set color n * 5, 255 - n * 5, 128 + n * 2 set pixel int(ly# * sc# + ox#), int(lx# * sc# + oy#) next wend wend redraw   a# = a# + 0.001 sc# = sc# + 0.01wend`

9
##### Code snippets / Aquarium
« on: August 28, 2016 »
Code: [Select]
`'aquarium.txt for NaaLaa 6 [B+=MGA] 2016-08-27'tranlated from previous codexmax = 1200ymax = 700set window 80, 40, xmax, ymaxset redraw falseradiansn = 30r# = 0.0 ; g# = 0.0 ; b# = 0.0x[n]; y[n]; l[n]; dx[n]; rr#[n]; gg#[n]; bb#[n]for i = 0 to n-1 x[i] = rnd(xmax) y[i] = rnd(ymax) l[i] = int(float(rnd(xmax)) * 0.0625 + 18.0) dx[i] = rnd(2) + 1 d = rnd(2) if d <> 0 then dx[i] = dx[i] * -1 r# = r# + 0.2     ; if r# > 0.5 then r# = 0.02   ; rr#[i] = r# g# = g# + 0.005   ; if g# > 0.5 then g# = 0.005  ; gg#[i] = g# b# = b# + 0.01    ; if b# > 0.5 then b# = 0.01   ; bb#[i] = b#nextwhile 1 for i = 0 to ymax-1 set color 0, 0, 255 - int( float#(i) / float#(ymax)  * 255.0 ) draw line 0, i, xmax, i next for i = 0 to n-1 x[i] = x[i] + dx[i] if float#(x[i]) + 1.25 * float#(l[i]) < 0.0 then dx[i] = -1 * dx[i] if float#(x[i]) - 1.25 * float#(l[i]) > float#(xmax) then dx[i] = -1 * dx[i] y[i] = y[i] + rnd(3) - 1 for ra = 1 to l[i] rd = int(127.0 + 127.0 * sin(rr#[i] * float#(ra))) gn = int(127.0 + 127.0 * sin(gg#[i] * float#(ra))) bl = int(127.0 + 127.0 * sin(bb#[i] * float#(ra))) set color rd, gn, bl if dx[i] < 0 then draw line x[i] + ra, y[i] - ra, x[i] + ra, y[i] + ra else draw line x[i] - ra, y[i] - ra, x[i] - ra, y[i] + ra endif next for ra = 5 to int(0.3 * float#(l[i])) rd = int(127.0 + 127.0 * sin(rr#[i] * float#(ra))) gn = int(127.0 + 127.0 * sin(gg#[i] * float#(ra))) bl = int(127.0 + 127.0 * sin(bb#[i] * float#(ra))) set color rd, gn, bl if dx[i] < 0 then draw line x[i] + l[i] + ra, y[i] - ra, x[i] + l[i] + ra, y[i] + ra else draw line x[i] - l[i] - ra, y[i] - ra, x[i] - l[i] - ra, y[i] + ra endif next if dx[i] < 0 then set colori 0      _DrawFilledCircle x[i] + int( 0.25 * float#(l[i]) ), y[i], int( 0.1 * float#(l[i]) ) set colori 0xFFFF00      _DrawCircle x[i] + int(0.25 * float#(l[i]) ), y[i], int( 0.06 * float#(l[i]) ) else set colori 0x000000      _DrawFilledCircle x[i] - int(0.25 * float#(l[i]) ), y[i], int( 0.1 * float#(l[i]) ) set colori 0xFFFF00      _DrawCircle x[i] - int(0.25 * float#(l[i])), y[i], int( 0.06 * float#(l[i]) ) endif next redrawwendprocedure DrawCircle(x0, y0, radius) x = radius y = 0 err = 0 while x >= y draw pixel x0 + x, y0 + y draw pixel x0 - x, y0 + y draw pixel x0 + y, y0 + x draw pixel x0 - y, y0 + x draw pixel x0 - x, y0 - y draw pixel x0 + x, y0 - y draw pixel x0 - y, y0 - x draw pixel x0 + y, y0 - x y = y + 1 err = err + 1 + 2*y if 2*(err - x) + 1 > 0 x = x - 1 err = err + 1 - 2*x endif wendendprocprocedure DrawFilledCircle(x0, y0, radius) x = radius y = 0 err = 0 while x >= y x2 = x*2; y2 = y*2 draw rect x0 - x, y0 + y, x2, 1, true draw rect x0 - y, y0 + x, y2, 1, true draw rect x0 - x, y0 - y, x2, 1, true draw rect x0 - y, y0 - x, y2, 1, true y = y + 1 err = err + 1 + 2*y if 2*(err - x) + 1 > 0 x = x - 1 err = err + 1 - 2*x endif wendendproc`

10
##### Suggestions, requests and demands / Cut, copy, paste
« on: August 27, 2016 »
Request cut, copy and paste from right mouse click in editor.

I noticed as soon as I started up again with Naalaa.

I also miss running from a right click but, well, that might be asking too much...

11
##### Code snippets / Voronoi Spiral Gem
« on: August 27, 2016 »
Code: [Select]
`rem http://retrogamecoding.org/board/index.php?topic=486.0rem Re: Voronoi Spiral gemrem « Reply #9 on: 25. August 2016, 13:11:47 » Mopzrem 2016-08-27 mod B+=MGA, rem I'd rather see screen update and loose a second or 2rem than stare at black black screen and wonder ifrem new version download was working ;))rem I get 163 - 167 secs on 1.3GHz gem = 700gems = gem - 1set window 16, 16, gem, gemset redraw offpoints = 36*13cy = gem/2ga# = 10.0x[points]y[points]kl[points]s# = 0.7wln "Working, please wait ..."redrawt = time()ps = points - 1for n = 0 to ps   x[n] = cy + int(s*float(n)*cos(float(n)*ga))   y[n] = cy + int(s*float(n)*sin(float(n)*ga))   if x[n] < gem and x[n] > 0 and y[n] < gem and y[n] > 0     g = 127 - abs(cy - x[n])*127 / cy + 127 - abs(cy - y[n]) * 127 / cy   else     g = 0   endif   if x[n] < gem and x[n] > 0; r = 255 - x[n]*255/gem; else; r = 0; endif   if y[n] < gem and y[n] > 0; b = y[n]*255 / gem; else; b = 0; endif   kl[n] = (r SHL 16) + (g SHL 8) + b   set colori kl[n]   _DrawFilledCircle int(x[n]), int(y[n]), 2nextfor xx = 0 to gem for yy = 0 to gem d = gem*gem + 1 for i = 0 to points - 1 a = x[i] - xx; b = y[i] - yy q = a*a + b*b if q < d; d = q; kkl = i; endif next set colori kl[kkl] set pixel xx, yy next redrawnextset color 255, 255, 255set caret 0, 0wln "Time: ", (time() - t)/1000redrawwait keydownprocedure DrawCircle(x0, y0, radius) x = radius y = 0 err = 0 while x >= y draw pixel x0 + x, y0 + y draw pixel x0 - x, y0 + y draw pixel x0 + y, y0 + x draw pixel x0 - y, y0 + x draw pixel x0 - x, y0 - y draw pixel x0 + x, y0 - y draw pixel x0 - y, y0 - x draw pixel x0 + y, y0 - x y = y + 1 err = err + 1 + 2*y if 2*(err - x) + 1 > 0 x = x - 1 err = err + 1 - 2*x endif wendendprocprocedure DrawFilledCircle(x0, y0, radius) x = radius y = 0 err = 0 while x >= y x2 = x*2; y2 = y*2 draw rect x0 - x, y0 + y, x2, 1, true draw rect x0 - y, y0 + x, y2, 1, true draw rect x0 - x, y0 - y, x2, 1, true draw rect x0 - y, y0 - x, y2, 1, true y = y + 1 err = err + 1 + 2*y if 2*(err - x) + 1 > 0 x = x - 1 err = err + 1 - 2*x endif wendendproc`
PS I think this circle fill might be better than what Rick and I came up with!

12
##### Code snippets / Rainbow beat
« on: October 11, 2015 »
Here is something I could not figure out in another BASIC:

Code: [Select]
`rem rainbow beat.txt in NaaLaa 2015-10-10 MGA/B+rem modified from PeterMaria BP.org 2015-10-05 "Heartbeat"xmax=760ymax=760set window 400,1,xmax,ymaxset redraw offradiansw = xmax/2h = ymax/2a#=0.0while keydown(27)=0 set color 0,0,0  cls  for i=165 to 315      set color 255-i%165, 255-i%200, 255-i%255, 255      for j=1 to 10         _circ w+int(sin(float(i))*a#),h+int(cos(float(i))*a#),388-i+j      next      a#=a#+0.01      if a#>=180.0 then break  next if a#>=180.0 then break redraw wait 10wendrem for snapshotwait 15000 procedure circ(x,y,r) rsq=r*r;ly=0 for cx=r downto 0 cy=int(sqr#(float(rsq-cx*cx))) x1=x+cx;x2=x-cx;y1=y+ly;y2=y+cy;y3=y-ly;y4=y-cy draw line x1,y1,x1,y2 draw line x1,y3,x1,y4    draw line x2,y1,x2,y2    draw line x2,y3,x2,y4 ly=cy nextendproc`
How interesting that the colors are in correct order for rainbow!

13
##### Code snippets / Boing!
« on: July 26, 2015 »
Another fun mouse effect:
Code: [Select]
`rem boing.txt for Naalaa 2015-07-25 MGA/B+ left mouse down, optional drag mouse, release, see spring action say, "boing"xmax=1200 ; ymax=700set window 0,0,xmax,ymaxset redraw offradianscx[]=[0,0,xmax+30,xmax+30]cy[]=[50,ymax-50,50,ymax-50]da#=0.03;a#=0.0boingx#=0.0;boingy#=0.0oldtx=0;oldty=0while keydown(27)=0 if mousebutton(0) then tx=mousex()+20 ty=mousey() else tx=xmax/2 ty=ymax/2 if tx<>oldtx or ty<>oldty then boingx#=3.0*float(tx-oldtx)/4.0 boingy#=3.0*float(ty-oldty)/4.0 else boingx#=-3.0*boingx#/4.0 boingy#=-3.0*boingy#/4.0 endif tx=tx+int(boingx#) ty=ty+int(boingy#) endif a#=0.01 oldtx=tx ; oldty=ty set color 0,255,255 draw rect 0,0,xmax,ymax,1 for corner = 0 to 3 s1x=cx[corner] ; s1y=cy[corner] dx#=float(tx-s1x)/2000.0 ; dy#=float(ty-s1y)/2000.0 x#=float(tx-20) ;  y#=float(ty) for i=1 to 2000 sx#=20.0*cos(a#)+x# sy#=20.0*sin(a#)+y# set color 0,0,255 draw rect int(sx#),int(sy#),2,2,1 set color 0,0,0 draw pixel int(sx#),int(sy#) set color 255,255,255 draw pixel int(sx#),int(sy#)+2 x#=x#-dx#;y#=y#-dy# a#=a#+da# next next for j=23 downto 1 set color 0,0,255-8*j proc disk tx-20,ty,j next redraw wait 10wendendprocedure disk(x,y,r) rsq=r*r for a = r downto 0 b = int(sqr(float(rsq-a*a))) x1=x+a;x2=x-a;y1=y-b;y2=y+b draw line x1,y1,x1,y2 draw line x2,y1,x2,y2 nextendproc`

14
##### Code snippets / Poly and poly again...
« on: July 10, 2015 »
Some polygon recursion:
Code: [Select]
`rem Poly and poly again.txt for naalaa 2015-07-09rem translated from SmallBASIC 2015-06-28 MGA/B+ws=760set window 0,0,ws,wsset redraw offradiansvisible:d=2pi#=3.1415hidden:set color 0,0,0clscx=ws/2;cy=ws/2while keydown(27)=0 do set color 0,0,0 cls d=d+1 side=cy-10 proc dopoly cx,cy,side,1 set color 255,128,0 set caret 0,0 wln str\$(d)," poly and poly again..." redraw wait 2000 until d=15 d=2wendprocedure dopoly(&xc,&yc,&level,call)sq=level/2if sq<1+d  returnelseif call>4 and d>6 returnelseif call>3 and d>10 returnelse x[d]        y[d]        dm=d-1        for i=0 to dm      t#=cos(float(i)*2.0*pi#/float(d))          x[i]=int(float(xc)+t#*float(sq))          t#=sin(float(i)*2.0*pi#/float(d))          y[i]=int(float(yc)+t#*float(sq))        next        for a=0 to dm      b=a+1          if b>dm then b=0          if sq>100             set color 255,255,255          elseif sq>60            set color 220,220,0      elseif sq>30            set color 0,128,128          elseif sq>20            set color 255,0,0          elseif sq>10            set color 0,0,200   else     set color 0,10*sq,10*sq          endif          draw line x[a],y[a],x[b],y[b]          proc dopoly x[a],y[a],sq,call+1 nextendifendproc`

15
##### Showcase / Flappy 3
« on: July 06, 2015 »
Finally collision detection is by location not color:
`remrem Flappy 3  2015-07-06 More code overhaulrem          collision detection by pipe(x,y) and flappy(x,y) LOCATION!!!!    rem          faster goundspeeds + more variance to pipe heightsrem          = more challengingimport "Speed.lib"set window 200,0,432,768set color 188, 255, 251set redraw offload image 1, "assets\clouds.png"load image 2, "assets\city.png"load image 3, "assets\trees.png"load image 5, "assets\ground.png"load image 7, "assets\intro.png"load image 16, "assets\bird1.png"load image 17, "assets\bird2.png"load image 18, "assets\bird3.png"load image 19, "assets\pipe200.png"load image 20, "assets\pipe180.png"load image 21, "assets\pipe150.png"load sound 1, "assets\pop.wav"load sound 2, "assets\bling.wav"load sound 3, "assets\dead.wav"load sound 4, "assets\flap.wav"create font 0, "arial" , 42set font 0visible:groundspeed# = 1.0highscore=0score = 0scored = 0bling = 2dead = 3flap = 4flappyx = 75flappyy = 300pipey = -478pipex# = 432.0groundx# = 0.0treesx# = 0.0cityx# = 0.0cloudsx# = 0.0rem ======================== Mainproc introwhile keydown(27)=0 cls proc movestuff proc moveflappy proc collision proc updatescore redraw proc SPD_HoldFrame(140)wendendremrem PROCEDURESremprocedure intro() do draw image 7, 0, 0 set color 0,0,0 set caret 217,650 center "High score today is "+str(highscore) redraw set color 188,255,251 if mousebutton(0) then if mousex() > 166 and mousex() < 264 and mousey() > 366 and mousey() < 401 then wait 1500 cls break elseif mousex() > 166 and mousex() < 264 and mousey() > 412 and mousey() < 446 then cls wait 500 end endif endif if keydown(27) then end loop clsendprocprocedure movestuff() draw image 1, int(cloudsx#), 462 cloudsx#=cloudsx# -0.125*groundspeed# if cloudsx# <= -432.0 then cloudsx# = 0.0 draw image 2, int(cityx#), 507 cityx# = cityx# -0.25*groundspeed if cityx# <= -432.0 then cityx# = 0.0 draw image 3, int(treesx#), 552 treesx# = treesx# - 0.5*groundspeed# if treesx# <= -432.0 then treesx# = 0.0 if groundspeed# <1.5 then draw image 19, int(pipex#), pipey elseif groundspeed# <2.0 draw image 20, int(pipex#), pipey else draw image 21, int(pipex#), pipey endif pipex# = pipex# - groundspeed# if pipex# < -52.0 then pipex# = 432.0 pipey=-600+rnd(250) scored=0 endif draw image 16, flappyx, flappyy draw image 5, int(groundx#), 600 set color 0,0,0 set caret 217,650 center score set color 188,255,251 groundx# = groundx# - groundspeed# if groundx# <= -432.0 then groundx# = 0.0endprocprocedure moveflappy() if keydown(32) or mousebutton(0) then flappyy = int(float(flappyy) -1.5) play sound flap else flappyy = int(float(flappyy) +1.5) endifendprocprocedure collision() rem hit top or ground? if flappyy <-1 or flappyy >570 then play sound(dead) wait 1500 proc settlescore endif if flappyx-49<=int(pipex#) and flappyx+39>=int(pipex#) then if groundspeed#<1.5 then if flappyy <627 + pipey or flappyy > 630+pipey+170 then play sound(dead) wait 1500 proc settlescore endif elseif groundspeed# <2.0 if flappyy <637 + pipey or flappyy > 640+pipey+150 then play sound(dead) wait 1500 proc settlescore endif else if flappyy <652 + pipey or flappyy > 655+pipey+120 then play sound(dead) wait 1500 proc settlescore endif endif endifendprocprocedure updatescore() if flappyx >= int(pipex#)+52 and scored = 0 then scored = 1 play sound(bling) score = score + 1 if score <5 then groundspeed# =1.4 elseif score <11 groundspeed#=1.9 else groundspeed#=2.2 endif endifendprocprocedure settlescore() if score>highscore then highscore=score score = 0 scored = 0 flappyx = 75 flappyy = 300 pipey = -478 pipex# = 432.0 groundx# = 0.0 treesx# = 0.0 cityx# = 0.0 cloudsx# = 0.0 groundspeed#=1.0 proc introendproc`