Recent Posts

Pages: 1 2 [3] 4 5 ... 10
21
Community news and announcements / Re: QB64 world
« Last post by B+ on 16. February 2018, 17:44:52 »
New wiki for QB64 since .net is down:
https://www.qb64.org/wiki/Main_Page

I am opening a discussion at org about BOTifying your code.

I don't know dukey aBOuT  it but am fascinated by subject of accessing and interacting with Internet stuff through code.

IRC #QB64 have bots going in chatroom, I think they might be improved, more conversational, more sensational...
22
Community news and announcements / QB64 world
« Last post by B+ on 15. February 2018, 16:50:56 »
I don't know if we ever talked about QB64 here?

For me it is like SmallBASIC's big brother but Compiled and with typed variables (many!) and many new features that are incompatible with old QBasic or QB45 or ... these keywords are all marked with a beginning underline _newKeyword  so old QB usually mostly works.

There is the official QB64.net
http://www.qb64.net/forum/
currently (2018-02-15) down

There is a newer OB64.org that takes over when .net is down (down allot) and as of today will stay up and co-exist with the official .net site.
http://qb64.org (important downloads and sources)
http://qb64.org/forum/

Walter Whitman's site: The Joyful Programmer (where I hang out too much and might find a couple golden oldies from BP.org)
http://qb64.thejoyfulprogrammer.com/?rndtime=1514578291164454855

There are many enthusiast sites, I will share one, Steve McNeil's because he has the Basic spirit of being teacher to beginners:
http://qb64.freeforums.net
(though ProBoards is NOT my favorite forum host environment) Steve has this forum as backup to his code but it is regular forum where the code could be discussed in advertised space.

So JJ, you don't have to just hang out at FB  8)
And Galileo, there are guys at .net that speak your language, I think.

Oh very important! Don't forget about the Wiki:
http://www.qb64.net/wiki/index.php/Main_Page
(but today is experiencing technical difficulties because QB64.net is down and Wiki is tied in with it. We gotta fix that because using help from IDE is as primitive as using the IDE's file LOAD Dialog.)
23
Code and examples / Import/Export BMP files
« Last post by Galileo on 09. February 2018, 21:07:35 »
Hello again.

This is a small fragment of code that allows you to import and view a file in BMP format 24 bits per pixel, and save in this format an image generated in the Yabasic graphic mode.
24
Code and examples / Simulate the use of complex types and type functions
« Last post by Galileo on 05. February 2018, 20:18:34 »
Yabasic does not allow the creation of user-defined types, but can be emulated. Even the use of type functions.

This is the import file with new type definition.

Code: [Select]
// Save with the name "c2d.yab"
// Type Cheb2d

sub create() // new object of type Cheb2d
items = items + 1
type() // redim attributes
return items // index of new object
end sub

sub init(p, order, precision, iterations)
   precision(p) = precision
   iterations(p) = iterations
   if order < 2 then
      print "Order must be >= 2"
      end
   end if
   redim xt(p, order - 1), yt(p, order - 1), coeffP(p, order * order - 1), coeffC(p, order * order - 1)
end sub

sub fit(p, xyz())
local i, j, m, tc, e, childcost

   parentcost(p) = 1 / 0
   tc = arraysize(coeffP(), 2)
   for i = 0 to tc
      coeffP(p, i) = 1 - 2 * ran()
   next
   for i = 0 to iterations - 1
      childcost = 0
      for j = 0 to tc
          m = exp(-precision * ran())
          if ran() < .5 then m = -m end if
          m = m + coeffP(p, j)
          if m > 1 or m < -1 then
            coeffC(p, j) = coeffP(p, j)
         else
            coeffC(p, j) = m
         end if
      next
      for j = 0 to arraysize(xyz(), 1) step 3
         e = evaluateX(p, xyz(j), xyz(j + 1), coeffC()) - xyz(j + 2)
         childcost = childcost + e * e
      next
      if childcost < parentcost(p) then
         parentcost(p) = childcost
         for j = 0 to tc
            coeffP(p, j) = coeffC(p, j)
         next
      end if
   next
end sub

sub evaluate(p, x, y)
   return evaluateX(p, x, y, coeffP())
end sub

sub type() // Attributes
dim xt(items, 1)
    dim yt(items, 1)
    dim coeffP(items, 1)
    dim coeffC(items, 1)
    dim precision(items)
    dim iterations(items)
    dim parentcost(items)
end sub

sub evaluateX(p, x, y, c())
local k, r, i, j, t

   xt(p, 0) = 1
   yt(p, 0) = 1
   xt(p, 1) = x
   yt(p, 1) = y
   t = arraysize(xt(), 2)
   for i = 2 to t
      xt(p, i) = 2 * x * xt(p, i - 1) - xt(p, i - 2)
      yt(p, i) = 2 * y * yt(p, i - 1) - yt(p, i - 2)
   next
   for i = 0 to t
      for j = 0 to arraysize(yt(), 2)
         r = r + c(p, k) * xt(p, i) * yt(p, j)
         k = k + 1
      next
   next
   return r
end sub

And this is the main code:

Code: [Select]
// 2D Chebyshev approximation
// Adapted from FreeBASIC to Yabasic by Galileo, 02/2018
// Original code: https://www.freebasic.net/forum/viewtopic.php?f=7&t=25969&p=236937&hilit=chebyshev#p236937
//
// An example of how to simulate the use of complex types and type functions.

import c2d // File where the type and its associated methods are implemented. c2d is the name of type.

if not peek("isbound") bind "TestChebyshev.exe" // If the code is modified, the executable file is generated again.

sub testfn(x, y)
   return sin(sin(7 * x) + cos(3 * y))
end sub
   
open window 400,400
n = 2000
dim xyz(n * 3 - 1)
x = 0 : y = 0 : z = 0

for x = -1 to 1 step .0025
   for y = -1 to 1 step .0025
      c = int(127.9999 * (1 + testfn(x, y)))
      color c, c, c
      dot 200 + 200 * x, 200 + 200 * y
   next
next

for i = 0 to n - 1 step 3
   x = 1 - 2 * ran()
   y = 1 - 2 * ran()
   z = testfn(x, y)
   xyz(i) = x
   xyz(i + 1) = y
   xyz(i + 2) = z
next

c1 = c2d.create() // Create a new object of type c2d
c2d.init(c1, 9, 60, 200000)
c2d.fit(c1, xyz())

for x = -1 to 1 step .0025
   for y = -1 to 1 step .0025
      e = c2d.evaluate(c1, x, y)
      if e > 1 then e = 1 end if
      if e < -1 then e = -1 end if
      c = int(127.9999 * (1 + e))
      color 0, c, c
      dot 200 + 200 * x, 200 + 200 * y
   next y
next x

Source code and executable is included.
25
Code and examples / Re: Barcode 39 generator
« Last post by B+ on 04. February 2018, 21:29:15 »
Well looks like an SB translation works:
26
Code and examples / Re: Barcode 39 generator
« Last post by Galileo on 04. February 2018, 19:49:28 »
Well, I finally got it to work with the technique used by ZXDunny.

Code: [Select]
REM Code 39 Barcode generator, by ZXDunny
// Adapted to Yabasic by Galileo, 02/2018, v2

open window 500, 100

data 265,73,328,25,280,88,13,268,76,28,259,67,322,19,274,82,7,262,70,22,385,193,448,145,400,208,52,289,97,352,49,304,112,37,292,100,196,133,168,42,388,162,138,148
a$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 -$%./+*"
n = len(a$)
dim a(n)

black$ = "0,0,0"
white$ = "255,255,255"

for i = 1 to n
read a(i)
next i
x = 10
INPUT "Phrase: " p$ // test "ABC123"
p$ = "*" + upper$(p$) + "*"
l = LEN(p$)
FOR f = 1 TO l
c$ = mid$(p$, f, 1)
c = instr(a$, c$ )
IF c = 0 PRINT "Error in input" : end
d = a(c)
FOR g = 8 to 0 step -1
if and(d, (shl(1, g))) then
b = 3
else
b = 1
end if
if mod(g, 2) then
color white$
else
color black$
end if
                fill RECTANGLE x, 10 TO x + b, 50
                x = x + b + 1
NEXT g
x = x + 2
NEXT f

color black$ : text 10, 70, p$

sub shl(lhs, rhs)
return Int(lhs * 2 ^ rhs)
end sub
28
Code and examples / Text Rotation Fun
« Last post by B+ on 03. February 2018, 05:45:32 »
Code: [Select]
'text rotation fun.bas for SmallBASIC 0.12.11 (B+=MGA) 2017-02-02

'global variables
message = "abcdefghijklmnopqrstuvwxyz""
secWide = txtw(message) + 2
secHigh = txth(message) + 2
dim sect(secWide, secHigh) 'array to store message points
color rgb(200, 200, 200),0 : cls
rect 0, 0, secWide, secHigh, 9

? message
loadSect 0, 0 'load array
'debug checks
'for y = 0 to secHigh
'  for x = 0 to secWide
'    if sect(x, y) then pset x + 200, y + 200
'  next
'next
'input "OK ";ok

dim plasma(5, 3)
for i = 0 to 5
  plasma(i, 0) = rnd * rnd
  plasma(i, 1) = rnd * rnd
  plasma(i, 2) = rnd * rnd
next

cls
cx = xmax/2 : cy = ymax/2
while 1
  cls
  dp 0
  yaxis cx, cy/4, a, 2
  dp 1
  xaxis cx, 3*cy/4, a, 5
  dp 2
  rotate cx/2, cy, a, 1
  dp 3
  rotate 3*cx/2, cy, a -90, 2.5
  dp 4
  rotate cx, cy/2, -4*a + 90, 2
  dp 5
  rotate cx, 3*cy/2, 2*a + 180, 4.5
  showpage
  delay 10
  a = a + 1
  if a = 360 then a = 0
wend
pause

sub dp(i)
  color rgb(128 + 127*sin(plasma(i,0)*a), 128 + 127*sin(plasma(i, 1)*a), 128 + 127*sin(plasma(i, 2)*a))
end

sub loadSect(xstart, ystart)
  local x, y, p, black
  'these are all global
  black = rgb(100 ,100, 100)
  for y = 0 to secHigh
    for x = 0 to secWide
      p = POINT(xstart + x, ystart + y)
      if p < black then sect(x, y) = 1 '<== data from screen points
    next
  next
end

sub rotate(cx, cy, angle, scale) 'and scale
  local cax, cay, ra, cc, d, anew, ax,ay

  cax = secWide/2 : cay = secHigh/2  'array center
  for y = 0 to secHigh
    for x = 0 to secWide
      cc = sect(x,y)
      if (x-cax) <> 0  and cc <> 0 then
        d = ((x-cax)^2+(y-cay)^2)^.5
        anew = atan((y-cay)/(x-cax))
        if x-cax <  0 and y-cay  < 0 then anew = anew + pi+rad(angle)  '-x,-y
        if x-cax <  0 and y-cay >= 0 then anew = anew + pi+rad(angle) '-x,+y
        if x-cax >= 0 and y-cay  < 0 then anew = anew + rad(angle)    '+x,-y
        if x-cax >= 0 and y-cay >= 0 then anew = anew + rad(angle)   '+x,+y
        ax = d*cos(anew):ay=d*sin(anew)
        rect int(cx+ax*scale),int(cy+ay*scale) step scale+1, scale+1 filled
      end if
    next
  next
end

sub yaxis(cx, cy, angle, scale)
   local cax, cay, cc, ax,ay

  cax = secWide/2 : cay = secHigh/2  'array center
  for y = 0 to secHigh
    for x = 0 to secWide
      cc = sect(x,y)
      if cc <> 0 then
        ax = (x - cax)*cos(rad(angle)):ay= (y - cay)
        rect int(cx+ax*scale),int(cy+ay*scale) step scale+1, scale+1 filled
      end if
    next
  next
end

sub xaxis(cx, cy, angle, scale)
   local cax, cay, cc, ax,ay

  cax = secWide/2 : cay = secHigh/2  'array center
  for y = 0 to secHigh
    for x = 0 to secWide
      cc = sect(x,y)
      if cc <> 0 then
        ax = (x - cax) :ay = (y - cay) * sin( rad(angle))
        rect int(cx+ax*scale),int(cy+ay*scale) step scale+1, scale+1 filled
      end if
    next
  next
end 

29
Code and examples / Re: Barcode 39 generator
« Last post by Galileo on 01. February 2018, 19:04:53 »
Well! A small modification and works perfectly.

Code: [Select]
REM Code 39 Barcode generator, by ZXDunny
// Adapted to Yabasic gy Galileo, 02/2018

open window 500, 100

data 265,73,328,25,280,88,13,268,76,28,259,67,322,19,274,82,7,262,70,22,385,193,448,145,400,208
data 52,289,97,352,49,304,112,37,292,100,196,133,168,42,388,162,138,148
a$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 -$%./+*"
n = len(a$)
dim a(n)

black$ = "0,0,0"
white$ = "255,255,255"

for i = 1 to n
read a(i)
next i

x = 10

INPUT "Phrase: " p$ // test "*ABC123*"

l = LEN(p$)
p$ = upper$(p$)
FOR f = 1 TO l
c$ = mid$(p$, f, 1)
c = instr(a$, c$ )
IF c = 0 PRINT "Error in input" : end
d = a(c)
b$ = right$("00000000" + bin$(d), 9)
FOR g = 1 to 9
if val(mid$(b$, g, 1)) then
b = 3
else
b = 1
end if
if mod(g, 2) then
color black$
else
color white$
end if
                fill RECTANGLE x, 10 TO x + b, 50
                x = x + b + 1
NEXT g
x = x + 2
NEXT f

color black$ : text 10, 70, p$
30
Offtopic / Re: (and Hello! again) Goodbye SdlBasic
« Last post by B+ on 30. January 2018, 21:07:30 »
While looking for "the real" SdlBasic forum, I stumbled upon this:
https://www.tapatalk.com/groups/sldbasic/index.php

Apparently new owners of a temporary SdlBasic forum from past that has screwed up my avatar and dates.

Tap-a-wallet?
Pages: 1 2 [3] 4 5 ... 10