"Fossies" - the Fresh Open Source Software Archive

Member "FreeBASIC-1.05.0-linux-x86_64/examples/console/caca/cacaball.bas" (31 Jan 2016, 5222 Bytes) of package /linux/privat/FreeBASIC-1.05.0-linux-x86_64.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Visual Basic source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "cacaball.bas": 1.03.0-source_vs_1.04.0-source.

    1 /'
    2  *  cacaball      metaballs effect for libcaca
    3  *  Copyright (c) 2003-2004 Jean-Yves Lamoureux <jylam@lnxscene.org>
    4  *                All Rights Reserved
    5  *
    6  *  Id: cacaball.bas,v 1.2 2005/07/23 17:39:53 v1ctor Exp 
    7  *
    8  *  This program is free software; you can redistribute it and/or
    9  *  modify it under the terms of the GNU Lesser General Public
   10  *  License as published by the Free Software Foundation; either
   11  *  version 2 of the License, or (at your option) any later version.
   12  *
   13  *  This program is distributed in the hope that it will be useful,
   14  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
   15  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   16  *  Lesser General Public License for more details.
   17  *
   18  *  You should have received a copy of the GNU Lesser General Public
   19  *  License along with this program; if not, write to the Free Software
   20  *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
   21  *  02111-1301  USA
   22  '/
   23 
   24 #ifndef M_PI
   25 #define M_PI 3.14159265358979323846
   26 #endif
   27 
   28 #include "caca0.bi"
   29 
   30 /' Virtual buffer size '/
   31 #define XSIZ 256
   32 #define YSIZ 256
   33 
   34 #define METASIZE 100
   35 #define METABALLS 16
   36 
   37 /' Colour index where to crop balls '/
   38 #define CROPBALL 160
   39 
   40 declare sub create_ball()
   41 declare sub draw_ball(byval as uinteger, byval as uinteger)
   42 
   43 dim shared pixels(0 to XSIZ * YSIZ - 1) as ubyte
   44 dim shared metaball(0 to METASIZE * METASIZE - 1) as ubyte
   45 
   46 dim as integer r(0 to 255), g(0 to 255), b(0 to 255), a(0 to 255)
   47 dim as single d(0 to METABALLS - 1), di(0 to METABALLS - 1), dj(0 to METABALLS - 1), dk(0 to METABALLS - 1)
   48 dim as uinteger x(0 to METABALLS - 1), y(0 to METABALLS - 1)
   49 dim as single i = 10.0, j = 17.0, k = 11.0
   50 dim as integer frame
   51 
   52     if (caca_init()) then
   53         end 1
   54     end if
   55 
   56     caca_set_delay(20000)
   57 
   58     /' Make the palette eatable by libcaca '/
   59     for p as integer = 0 to 255
   60         r(p) = 0
   61         g(p) = 0
   62         b(p) = 0
   63         a(p) = 0
   64     next
   65 
   66     r(255) = &HFFF
   67     g(255) = &HFFF
   68     b(255) = &HFFF
   69 
   70     /' Create a libcaca bitmap smaller than our pixel buffer, so that we
   71      * display only the interesting part of it '/
   72     dim bitmap as caca_bitmap ptr = _
   73         caca_create_bitmap(8, XSIZ - METASIZE, YSIZ - METASIZE, XSIZ, _
   74                         0, 0, 0, 0)
   75 
   76     /' Generate ball sprite '/
   77     create_ball()
   78 
   79     for p as integer = 0 to METABALLS - 1
   80         d(p) = caca_rand(0, 100)
   81         di(p) = csng(caca_rand(500, 4000)) / 6000.0
   82         dj(p) = csng(caca_rand(500, 4000)) / 6000.0
   83         dk(p) = csng(caca_rand(500, 4000)) / 6000.0
   84     next
   85 
   86     '' Go !
   87     do until caca_get_event(CACA_EVENT_KEY_PRESS)
   88         frame += 1
   89 
   90         /' Crop the palette '/
   91         for p as integer = CROPBALL to 254
   92             dim as integer t1, t2, t3
   93             t1 = iif(p < &H40 , 0 , iif(p < &Hc0 , (p - &H40) * &H20 , &Hfff))
   94             t2 = iif(p < &He0 , 0 , (p - &He0) * &H80)
   95             t3 = iif(p < &H40 , p * &H40 , &Hfff)
   96 
   97             r(p) = (1.0 + sin(cdbl(frame) * M_PI / 60)) * t1 \ 4 _
   98                  + (1.0 + sin(cdbl(frame + 40) * M_PI / 60)) * t2 \ 4 _
   99                  + (1.0 + sin(cdbl(frame + 80) * M_PI / 60)) * t3 \ 4
  100             g(p) = (1.0 + sin(cdbl(frame) * M_PI / 60)) * t2 \ 4 _
  101                  + (1.0 + sin(cdbl(frame + 40) * M_PI / 60)) * t3 \ 4 _
  102                  + (1.0 + sin(cdbl(frame + 80) * M_PI / 60)) * t1 \ 4
  103             b(p) = (1.0 + sin(cdbl(frame) * M_PI / 60)) * t3 \ 4 _
  104                  + (1.0 + sin(cdbl(frame + 40) * M_PI / 60)) * t1 \ 4 _
  105                  + (1.0 + sin(cdbl(frame + 80) * M_PI / 60)) * t2 \ 4
  106         next
  107 
  108         /' Set the palette '/
  109         caca_set_bitmap_palette(bitmap, @r(0), @g(0), @b(0), @a(0))
  110 
  111         /' Silly paths for our balls '/
  112         for p as integer = 0 to METABALLS - 1
  113             dim as single u, v
  114             u = di(p) * i + dj(p) * j + dk(p) * sin(di(p) * k)
  115             v = d(p) + di(p) * j + dj(p) * k + dk(p) * sin(dk(p) * i)
  116             u = sin(i + u * 2.1) * (1.0 + sin(u))
  117             v = sin(j + v * 1.9) * (1.0 + sin(v))
  118             x(p) = (XSIZ - METASIZE) \ 2 + u * (XSIZ - METASIZE) \ 4
  119             y(p) = (YSIZ - METASIZE) \ 2 + v * (YSIZ - METASIZE) \ 4
  120         next
  121 
  122         i += 0.011
  123         j += 0.017
  124         k += 0.019
  125 
  126         clear pixels(0), 0, XSIZ * YSIZ
  127 
  128         /' Here is all the trick. Maybe if you're that
  129          * clever you'll understand. '/
  130         for p as integer = 0 to METABALLS - 1
  131             draw_ball(x(p), y(p))
  132         next
  133 
  134         /' Draw our virtual buffer to screen, letting libcaca resize it '/
  135         caca_draw_bitmap(0, 0, caca_get_width() - 1, caca_get_height() - 1, _
  136                          bitmap, @pixels(0) + (METASIZE \ 2) * (1 + XSIZ))
  137         caca_refresh()
  138     loop
  139 
  140     /' End, bye folks '/
  141     caca_end()
  142 
  143     end 0
  144 
  145 
  146 /' Generate ball sprite
  147  * You should read the comments, I already wrote that before ... '/
  148 sub create_ball()
  149     for y as integer = 0 to METASIZE - 1
  150         for x as integer = 0 to METASIZE - 1
  151             dim distance as single
  152             distance = ((METASIZE\2) - x) * ((METASIZE\2) - x) _
  153                      + ((METASIZE\2) - y) * ((METASIZE\2) - y)
  154             distance = sqr(distance) * 64 / METASIZE
  155             metaball(x + y * METASIZE) = iif(distance > 15 , 0 , cint(((255.0 - distance) * 15)))
  156         next
  157     next
  158 end sub
  159 
  160 /' You missed the trick? '/
  161 sub draw_ball(byval bx as uinteger, byval by as uinteger)
  162     dim b as uinteger = (by * XSIZ) + bx
  163     dim e as uinteger
  164 
  165     for i as integer = 0 to METASIZE * METASIZE - 1
  166         dim colr as uinteger = pixels(b) + metaball(i)
  167         if (colr > 255) then
  168             colr = 255
  169         end if
  170 
  171         pixels(b) = colr
  172         if (e = METASIZE) then
  173             e = 0
  174             b += XSIZ - METASIZE
  175         end if
  176         b += 1
  177         e += 1
  178     next
  179 end sub