Compilateur FBPano

function strcmp% (a$, b$)
  if a = b then
    strcmp = 0
  elseif a > b then
    strcmp = 1
  else
    strcmp = -1
  end_if
end_function

dll_on "strcmp.dll"

dim a$, b$, result%

a$ = "abcd"
b$ = "dcba"

result% = dll_call2("strcmp", adr(a$), adr(b$))

print result%

dll_on "strcmp.dll"

dim n%, i%

n% = 5

dim a$(n%)

a$(1) = "un"
a$(2) = "deux"
a$(3) = "trois"
a$(4) = "quatre"
a$(5) = "cinq"

tri()

for i% = 1 to n%
  print a$(i%)
next i%

end

sub tri()
' Tri par insertion

  dim_local i%, j%, k%, a1$, a2$, tmp$

  for i% = 1 to n% - 1
    k% = i%
    a1$ = a$(i%)
    for j% = i% + 1 to n%
      a2$ = a$(j%)
      ' Tester si a2$ < a1$
      if dll_call2("strcmp", adr(a2$), adr(a1$))= -1
        k% = j%
        a1$ = a$(j%)
      end_if
    next j%

    ' Echanger a$(i%) et a$(k%)
    tmp$ = a$(i%)
    a$(i%) = a$(k%)
    a$(k%) = tmp$
  next i%
end_sub

dll_on "strcmp.dll"

dim nlig%, ncol%

nlig% = 5
ncol% = 2

dim a$(nlig%, ncol%)

data "un", "one"
data "deux", "two"
data "trois", "three"
data "quatre", "four"
data "cinq", "five"

read_data()

tri(1)
print_tab(1)

tri(2)
print_tab(2)

end

sub read_data()
  dim_local i%, j%
  for i% = 1 to nlig%
    for j% = 1 to ncol%
      read a$(i%, j%)
    next j%
  next i%
end_sub

sub print_tab(cle%)
  dim_local i%, j%, tmp$
  print
  print "Tri sur la colonne ", cle%, " :"
  print
  for i% = 1 to nlig%
    tmp$ = ""
    for j% = 1 to ncol%
      tmp$ = tmp$ + a$(i%, j%) + "     "
    next j%
    print tmp$
  next i%
end_sub

sub swap_lines(i%, k%)
  dim_local j%, tmp$
  for j% = 1 to ncol%
    tmp$ = a$(i%, j%)
    a$(i%, j%) = a$(k%, j%)
    a$(k%, j%) = tmp$
  next j%
end_sub

sub tri(cle%)
' Tri par insertion

  dim_local i%, j%, k%, a1$, a2$

  for i% = 1 to nlig% - 1
    k% = i%
    a1$ = a$(i%, cle%)
    for j% = i% + 1 to nlig%
      a2$ = a$(j%, cle%)
      ' Tester si a2$ < a1$
      if dll_call2("strcmp", adr(a2$), adr(a1$))= -1
        k% = j%
        a1$ = a$(j%, cle%)
      end_if
    next j%
    ' Echanger les lignes i% et k%
    swap_lines(i%, k%)
  next i%
end_sub

' *****************************************************************
' An ascii chart for low and high ascii chars
' Richard D. Clark
' Freeware
' -----------------------------------------------------------------
' Adaptation pour FBPano par J. Debord
' *****************************************************************

const fbWhite = RGB (255, 255, 255)
const fbYellow = RGB (255, 255, 000)
const fbGrey = RGB (192, 192, 192)
const fbGreen = RGB (000, 255, 000)
const fbEmeraldGreen = RGB (000, 201, 087)
const fbGreenPale = RGB (152, 251, 152)
const fbYellowGreen = RGB (154, 205, 050)
const fbOrange = RGB (255, 128, 000)
const fbSalmon = RGB (250, 128, 114)
const fbCarrot = RGB (237, 145, 033)
const fbMarsYellow = RGB (227, 112, 026)
const fbGold = RGB (255, 215, 000)
const fbMelon = RGB (227, 168, 105)

dim keycode%

fb_form 700, 500, "Table des codes ASCII"

PrintAscii

repeat
  keycode = fb_event_key
  select keycode
    case 65, 97 : PrintAscii  ' A, a
    case 66, 98 : DrawBox     ' B, b
  end_select
until keycode = 27            ' Esc

end

sub display(txt$, row%, col%, colour%)
  fb_pen_color colour
  fb_print txt, col * 10, row * 16
end_sub

sub PrintAscii
    dim i%, ccol%, col%, row%, colour%, cout$

    fb_cls
    col = 1
    row = 1

    display "Codes ASCII 0-127", row, col, fbOrange

    for i = 0 to 127
        row = row + 1
        ccol = col
        cout = trim(str(i))
        if len(cout) < 3 then
            cout = string(3 - len(cout), "0") + cout
        end_if
        display cout, row, ccol, fbWhite
        ccol = ccol + 3
        display ":", row, ccol, fbGrey
        ccol = ccol + 1
        select i
          case  3 to   6 : colour = fbYellowGreen
          case 48 to  57 : colour = fbGreenPale
          case 65 to  90 : colour = fbGreen
          case 97 to 122 : colour = fbEmeraldGreen
          case else      : colour = fbYellow
        end_select
        if i <> 7 then
            display chr(i), row, ccol, colour
        end_if
        ccol = ccol + 1
        display " ", row, ccol, colour
        if row = 14 then
            row = 1
            col = ccol + 2
        end_if
    next i
    row = 15
    col = 1
    display "Codes ASCII 128-255", row, col, fbOrange
    for i = 128 to 255
        row = row + 1
        ccol = col
        cout = trim(str(i))
        if len(cout) < 3 then
            cout = string(3 - len(cout), "0") + cout
        end_if
        display cout, row, ccol, fbWhite
        ccol = ccol + 3
        display ":", row, ccol, fbGrey
        ccol = ccol + 1
        select i
          case 176 to 178                                  : colour = fbGold
          case 185 to 188, 200 to 206                      : colour = fbCarrot
          case 219 to 223                                  : colour = fbSalmon
          case 179, 180, 191 to 197, 217, 218              : colour = fbMarsYellow
          case 181, 184, 190, 198, 207, 209, 212, 213, 216 : colour = fbMelon
          case else                                        : colour = fbYellow
        end_select
        display chr(i), row, ccol, colour
        ccol = ccol + 1
        display " ", row, ccol, colour
        if row = 28 then
            row = 15
            col = ccol + 2
        end_if
    next i
    display "Pressez B pour les dessins de boites, ESC pour quitter.", 30, 1, fbWhite
end_sub

sub DrawBox
    fb_cls

    display "Lignes doubles :", 1, 1, fbOrange

    display chr(201, 205, 205, 203, 205, 205, 187), 2, 1, fbYellow
    display chr(186,  32,  32, 186,  32,  32, 186), 3, 1, fbYellow
    display chr(204, 205, 205, 206, 205, 205, 185), 4, 1, fbYellow
    display chr(186,  32,  32, 186,  32,  32, 186), 5, 1, fbYellow
    display chr(200, 205, 205, 202, 205, 205, 188), 6, 1, fbYellow

    display "201 205 205 203 205 205 187", 2, 10, fbWhite
    display "186         186         186", 3, 10, fbWhite
    display "204 205 205 206 205 205 185", 4, 10, fbWhite
    display "186         186         186", 5, 10, fbWhite
    display "200 205 205 202 205 205 188", 6, 10, fbWhite

    display "Lignes simples :", 8, 1, fbOrange

    display chr(218, 196, 196, 194, 196, 196, 191),  9, 1, fbYellow
    display chr(179,  32,  32, 179,  32,  32, 179), 10, 1, fbYellow
    display chr(195, 196, 196, 197, 196, 196, 180), 11, 1, fbYellow
    display chr(179,  32,  32, 179,  32,  32, 179), 12, 1, fbYellow
    display chr(192, 196, 196, 193, 196, 196, 217), 13, 1, fbYellow

    display "218 196 196 194 196 196 191",  9, 10, fbWhite
    display "179         179         179", 10, 10, fbWhite
    display "195 196 196 197 196 196 180", 11, 10, fbWhite
    display "179         179         179", 12, 10, fbWhite
    display "192 196 196 193 196 196 217", 13, 10, fbWhite

    display "Lignes doubles/simples :", 15, 1, fbOrange

    display chr(213, 205, 205, 209, 205, 205, 184), 16, 1, fbYellow
    display chr(179,  32,  32, 179,  32,  32, 179), 17, 1, fbYellow
    display chr(198, 205, 205, 216, 205, 205, 181), 18, 1, fbYellow
    display chr(179,  32,  32, 179,  32,  32, 179), 19, 1, fbYellow
    display chr(212, 205, 205, 207, 205, 205, 190), 20, 1, fbYellow

    display "213 205 205 209 205 205 184", 16, 10, fbWhite
    display "179         179         179", 17, 10, fbWhite
    display "198 205 205 216 205 205 181", 18, 10, fbWhite
    display "179         179         179", 19, 10, fbWhite
    display "212 205 205 207 205 205 190", 20, 10, fbWhite

    display "Lignes simples/doubles :", 22, 1, fbOrange

    display chr(214, 196, 196, 210, 196, 196, 183), 23, 1, fbYellow
    display chr(186,  32,  32, 186,  32,  32, 186), 24, 1, fbYellow
    display chr(199, 196, 196, 215, 196, 196, 182), 25, 1, fbYellow
    display chr(186,  32,  32, 186,  32,  32, 186), 26, 1, fbYellow
    display chr(211, 196, 196, 208, 196, 196, 189), 27, 1, fbYellow

    display "214 196 196 210 196 196 183", 23, 10, fbWhite
    display "186         186         186", 24, 10, fbWhite
    display "199 196 196 215 196 196 182", 25, 10, fbWhite
    display "186         186         186", 26, 10, fbWhite
    display "211 196 196 208 196 196 189", 27, 10, fbWhite

    display "Pressez A pour la table ASCII, Esc pour quitter", 30, 1, fbWhite
end_sub

' *****************************************************************
' Ondulations
' D'apres Lothar Schirm sur le forum FreeBASIC
' -----------------------------------------------------------------
' Chaque particule (bleu clair) tourne sur un cercle (bleu foncé)
' Le décalage des cercles crée l'illusion d'une onde qui se déplace
' *****************************************************************

dim y0 = 50
dim r = 30, r1 = 3
dim t = 0, dt = 0.03

fb_form 1000, 100, "Ondulations"

fb_animate adr(draw_frame), adr(event_keyboard)

sub draw_frame(done%)

  dim k%, x0, phi, t1, x, y
  
  t = t + dt
  
  fb_cls
  
  for k = 0 to 40
    x0 = 25 * k
    fb_pen_color &hAAAAFF
    fb_arc x0, y0, r
    phi = 0.5 * k
    t1 = t - phi
    x = x0 + r * sin(t1)
    y = y0 - r * cos(t1)
    fb_pen_color &h00FFFF
    fb_pie x, y, r1
  next k
end_sub

sub event_keyboard(event_type%, keycode%, done%)
  done = (keycode = 27)
end_sub

' ********************************************************************
' Fourmi de Langton
' ********************************************************************
' Ce programme travaille sur des grilles de grande taille dont on
' n'affiche qu'une partie, avec possibilite de zoom et de defilement.
'
' Le programme demarre en mode "Creation". Les commandes suivantes
' sont actives :
'
'   Clic gauche : colore une case en blanc ou bleu
'   Clic droit  : positionne la fourmi
'   A, a        : colore en bleu une partie des cases, de maniere aleatoire
'   E, e        : efface (met en blanc) toutes les cases
'   +, -        : augmente ou diminue le zoom (taille en pixels
'                 des cases affichees : 0, 4, 8, 12, 16, 20, 24 ;
'                 0 = 1 pixel par case)
'   Fleches     : font defiler la zone d'affichage
'   *, /        : multiplie ou divise par 2 le pas de defilement
'                 (1 a 1024)
'   G, g        : affiche une grille (si zoom > 4)
'   S, s        : active ou desactive la sauvegarde automatique
'                 des images en mode "Generation"
'   Espace      : Passe en mode "Generation"
'
' En mode "Generation" les commandes suivantes sont actives :
'
'   G, g, S, s          : comme en mode "Creation"
'   Fleches, +, -, *, / : comme en mode "Creation"
'   Espace              : repasse en mode "Creation" et remet le
'                         compteur d'iterations a zero
'
' Les parametres sont ecrits de part et d'autre de la grille :
'   - coordonnees des cases affichees (X,Y)
'   - zoom, pas de deplacement, compteur d'iterations
'
' La touche Echap quitte le programme
' ********************************************************************

dim n% = 1000    ' Taille du "terrain de jeu"

dim z% = 12      ' Zoom (0, 4, 8, 12, 16, 20, 24)

dim fg% = 2      ' Taille de la fenetre graphique en multiple de 240
                 ' (240 = PPCM des valeurs de zoom)

dim creat% = TRUE      ' Mode "creation"
dim grid% = TRUE       ' Afficher la grille (si z > 4)
dim savepics% = FALSE  ' Sauvegarder les images
dim pas% = 1           ' Deplacement par les fleches (nb de cases)
dim iter% = 0          ' Iteration
dim pr = 0.5           ' Probabilite d'avoir une case blanche
                       '   lors d'un remplissage aleatoire
dim a%*1(n, n)         ' Grille (0=Blanc, 1=Bleu)
dim fi%, fj%           ' Position de la fourmi
dim r% = 2             ' Orientation (0=Nord, 1=Est, 2=Sud, 3=Ouest)

dim x0%, y0%           ' Coin sup. gauche de la grille affichee
dim w%                 ' Largeur de la grille en pixels
dim fps%               ' Nombre d'images par seconde
dim m%                 ' Nombre de cases affichees dans chaque direction
dim k1x%, kmx%         ' Coord. de la case affichee en haut a gauche
dim k1y%, kmy%         ' Coord. de la case affichee en bas a droite

fi = n \ 2
fj = fi

' --------------------------------------------------------------------
' Programme principal
' --------------------------------------------------------------------

init()

fb_form w + 2 * x0, w + 2 * y0, "Fourmi de Langton (" & n & " x " & n & ")"

fb_animate adr(draw_frame), adr(event_keyboard), adr(event_mouse), fps

' --------------------------------------------------------------------
' Sous-Programmes
' --------------------------------------------------------------------

sub init()
' Initialisation des parametres graphiques

  x0 = 20
  y0 = 30
  w = 240 * fg
  fps = n \ 20
  if z = 0 then m = w else m = w \ z
  k1x = (n - m) \ 2 + 1
  kmx = k1x + m - 1
  k1y = k1x
  kmy = kmx
end_sub

sub efface ()
' Efface toutes les cases

  dim i%, j%

  for i = 1 to n
    for j = 1 to n
      if a(i,j) = 1 then a(i,j) = 0
    next j
  next i
end_sub

sub aleat ()
' Coloriage aleatoire des cases

  dim i%, j%
  randomize timer

  for i = 1 to n
    for j = 1 to n
      if rnd > pr then a(i, j) = 1 else a(i, j) = 0
    next j
  next i
end_sub

sub deplace()
' Deplacement de la fourmi

  a(fi, fj) = a(fi, fj) xor 1        ' Changement de couleur
  r = (r + 2 * a(fi, fj) + 1) mod 4  ' Nouvelle orientation

  select r
    case 0 : fi = fi - 1             ' Deplacement
    case 1 : fj = fj + 1
    case 2 : fi = fi + 1
    case 3 : fj = fj - 1
  end_select

  iter = iter + 1
end_sub

function filename$()
' Genere le nom de fichier PNG pour 1 generation (Ex. 00000123.png)

  dim f$, L%

  f = str(iter)
  L = len(f)
  filename = string(8 - L, "0") + f + ".png"
end_function

sub printparam()
' Affichage des parametres

  dim a1x$, amx$, a1y$, amy$, Lx%, Ly%, y1%, y2%

  a1x = str(k1x)
  amx = str(kmx)
  a1y = str(k1y)
  amy = str(kmy)

  Lx = 10 * len(a1x)
  Ly = 10 * len(a1y)

  y1 = 8
  y2 = 40 + w

  fb_view
  fb_window

  fb_pen_color &h00FFFF

  fb_print "X:", 20, y1
  fb_print "-", 40 + Lx, y1
  fb_print "Y:", 160, y1
  fb_print "-", 180 + Ly, y1

  fb_print "Zoom:", 20, y2
  fb_print "Pas:", 100, y2
  fb_print "Iter:", 180, y2

  fb_pen_color &h00FF00

  fb_print a1x, 40, y1
  fb_print amx, 50 + Lx, y1
  fb_print a1y, 180, y1
  fb_print amy, 190 + Ly, y1

  fb_print str(z), 65, y2
  fb_print str(pas), 135, y2
  fb_print str(iter), 225, y2
end_sub

sub plotgrid ()
' Affichage de la grille

  if z < 8 then
    exit_sub
  end_if

  dim x%, y%

  fb_pen_color &h666666

  for x = 0 to w step z
    fb_line x, 0, x, w
  next x

  for y = 0 to w step z
    fb_line 0, y, w, y
  next y
end_sub

sub plotcell(i%, j%, x%, y%, xr%, yr%, z%)
' Coloration d'une case

  dim fourmi%, col%

  fourmi = (i = fi and j = fj)
  
  if a(i, j) = 0 and (not fourmi) then
    exit_sub
  end_if
    
  if fourmi then col = &hFF0000 else col = &h000099

  fb_pen_color col

  if z = 0 then fb_point x, y else fb_rectangle_fill xr, yr, z, z
end_sub
          
sub display()
' Affichage et sauvegarde de l'image

  dim i%, j%, i1%, j1%, x%, y%, xr%, yr%, z2%, h%

  z2 = z \ 2

  if z = 0 then h = 1 else h = z

  fb_cls

  fb_view x0, y0, w + x0, w + y0, , &hFFFFFF
  fb_window 0, 0, w + 1, w + 1

  fb_pen_color &hFFFFFF
  fb_rectangle_fill 0, 0, w, w

  if grid then plotgrid()

  x = z2
  xr = 0
  for j = 0 to m - 1
    y = z2
    yr = 0
    j1 = j + k1x
    for i = 0 to m - 1
      i1 = i + k1y
      plotcell i1, j1, x, y, xr, yr, z
      y = y + h
      yr = yr + h
    next i
    x = x + h
    xr = xr + h
  next j

  printparam()

  if not creat then
    if savepics then fb_save filename(), false
  end_if
end_sub

sub draw_frame(done%)
' Affichage du graphique et deplacement de la fourmi

  display()
  if not creat then deplace()
end_sub

sub event_keyboard(event_type%, keycode%, done%)
' Traitement des touches du clavier

  select keycode
    case 27                      ' Echap
      done = TRUE

    case 32                      ' Barre d'espace
      creat = not creat
      if creat then iter = 0

    case 42                      ' *
      if pas < 1024 then
        pas = 2 * pas
      end_if

    case 43                      ' Plus
      if z < 24 then
        z = z + 4
        init()
      end_if

    case 45                      ' Moins
      if z > 0 then
        z = z - 4
        init()
      end_if

    case 47                      ' /
      if pas > 1 then
        pas = pas \ 2
      end_if

    case 65, 97                  ' A, a
      if creat then
        aleat()
        display()
      end_if

    case 69, 101                 ' E, e
      if creat then
        efface()
        display()
      end_if

    case 71, 103                 ' G, g
      grid = not grid

    case 83, 115                 ' S, s
      savepics = not savepics

    case 328                     ' Fleche haute
      k1y = max(1, k1y - pas)
      kmy = k1y + m - 1

    case 331                     ' Fleche gauche
      k1x = max(1, k1x - pas)
      kmx = k1x + m - 1

    case 333                     ' Fleche droite
      kmx = min(n, kmx + pas)
      k1x = kmx - m + 1

    case 336                     ' Fleche basse
      kmy = min(n, kmy + pas)
      k1y = kmy - m + 1
  end_select
end_sub

sub event_mouse(event_type%, mouse_check%, x%, y%, btn%, wheel%, done%)
' Traitement du clic de souris

  if not (creat and z > 0 and event_type = EVENT_MOUSE_BUTTON_PRESS) then
    exit_sub
  end_if

  dim i%, j%

  i = (w - y + y0) \ z + k1y
  j = (x - x0) \ z + k1x

  select btn
    case BUTTON_LEFT
      a(i, j) = a(i, j) xor 1
    case BUTTON_RIGHT
      fi = i
      fj = j
  end_select
end_sub