TrueBASIC

Es cierto que el código recuerda mucho al lenguaje BASIC original. Es una lastima que los programas de ejemplo que vienen con la Demo sean tan sumamente malos y pobres. A la vista de los mismos no dan ganas de pagar por una licencia. Existen diversos tipos de licencia (Bronce, Plata y Oro que van desde los 39$, 199$ y 499$). Esta disponible para Windows, Mac y Linux. 

Tiene unos foros y mucha documentación adicional. Así mismo, dispone de multitud de herramientas adicionales, pero todas son previo pago. Me parece bueno, pero me hubiera gustado ver alguna demostración de su potencia y no la he visto.

Esta empresa la fundaron: John G. Kemeny y Thomas E. Kurtz, los inventores del BASIC inicial en el Dartmouth College Computation Center en Mayo-Octubre 1964.

! Lissa Box.
!
! copyright (c) 1988 by True BASIC, Inc.
! time delay added 22 APR 2004

RANDOMIZE

ASK MAX COLOR colormax
LET colormax = Min(colormax,31)
LET cycleflag = 0

DIM r(31),g(31),b(31)
CALL Init(r,g,b,colormax)

SET WINDOW -1.3,1.55,-1.3,1.55
CALL BackCycle(r,g,b,bc,back)
IF colormax=1 then
   SET BACK "red"
   LET boxcolor = 5               !b/w -- white box
ELSE
   LET boxcolor = 1               !color -- use various colors for boxes
END IF

DO
   IF mod(clock,300)=0 then CALL Reset
   LET x = sin(nx * i)
   LET y = cos(ny * i)
   LET i = i+.01
   LET clock = clock+1
   IF colormax>1 then
      LET boxcolor = boxcolor+1
      IF boxcolor=colormax then LET boxcolor=1
      IF cycleflag<>0 then CALL Cycle(r,g,b,xxx,colormax)
   END IF
   SET COLOR boxcolor
   BOX AREA x,x+.22,y,y+.22
   SET COLOR colormax
   BOX LINES x,x+.22,y,y+.22
   CALL BackCycle(r,g,b,bc,back)
   IF key input then
      EXIT DO
   END IF
   PAUSE 0.05

LOOP

SUB Reset                         !choose another x,y for lissajous
    CLEAR
    LET nx = Round(7*rnd+1)
    LET ny = Round(9*rnd+1)
    IF nx=1 then LET nx = 3
    IF ny=1 then LET ny = 3
    IF nx=ny then LET nx = nx + 1
    IF rnd<.3 then LET cycleflag=0 else LET cycleflag=0
END SUB
END

SUB Init(r(),g(),b(),colormax)    !set 31 colors to rainbow

    MAT READ r, g, b
    DATA 1,1,1,1,1, .9,.8,.6,.4,.2, 0,0,0,0,0, 0,0,0,0,0, .2,.4,.6,.8,.9, 1,1,1,1,1, 0
    DATA .2,.4,.6,.8,.9, 1,1,1,1,1, 1,1,1,1,1, .9,.8,.6,.4,.2, 0,0,0,0,0, 0,0,0,0,0, 0
    DATA 0,0,0,0,0, 0,0,0,0,0, .2,.4,.6,.8,.9, 1,1,1,1,1, 1,1,1,1,1, .9,.8,.6,.4,.2, 0

    LET j = 1
    FOR i = 1 to colormax
        SET COLOR MIX(i) r(j), g(j), b(j)
        LET j = j + 1
    NEXT i




END SUB

SUB Cycle(r(),g(),b(),c,colormax)      !cycle colors
    LET c1 = mod(c,30)+1
    LET j = c
    FOR i = colormax-1 to 1 step -1
        LET j = j-1
        IF j<1 then LET j=colormax-1
        SET COLOR MIX (i) r(j),g(j),b(j)
    NEXT i
    LET c = c1
END SUB

SUB BackCycle(r(),g(),b(),bc,back)     !cycle background colors
    LET bc = bc-.125              !bc is intensity
    IF bc<0 then
       LET back = mod(back,30)+1
       LET bc = 1
    END IF
    LET back1 = mod(back,30)+1
    LET r1 = (bc*r(back)+(1-bc)*r(back1)) * .9
    LET g1 = (bc*g(back)+(1-bc)*g(back1)) * .6
    LET b1 = (bc*b(back)+(1-bc)*b(back1)) * .7
    SET COLOR MIX(0) r1, g1, b1
END SUB

http://www.truebasic.com/