BaCon BBC - BACORN

[John]

       

BaCon BBC project thread

Code: [Select]

' UFO

PRAGMA INCLUDE SDL.h
PRAGMA OPTIONS -I/usr/include/SDL -D_GNU_SOURCE=1 -D_REENTRANT -DHAVE_OPENGL
PRAGMA LDFLAGS SDL bbc
PROTO init_screen, emulate_mode, emulate_origin, emulate_gcol, emulate_off, emulate_plot, end_screen
PROTO SDL_WM_SetCaption, emulate_vdustr

DECLARE p, i, r, q TYPE FLOATING

init_screen()
t1 = SDL_GetTicks()
SDL_WM_SetCaption("BaCon BBC UFO", 0)
emulate_mode(31)
emulate_origin(800, 600)
xs = 2
ys = 2
emulate_gcol(0, 14)
emulate_off()
a = 700
b = a * a
c = 600
FOR x = 0 TO a STEP xs
  s = x * x
  p = SQR(b - s)
  FOR i = -p TO p STEP 6 * ys
    r = SQR(s + i * i) / a
    q = (r - 1) * SIN(24 * r)
    y = INT(i / 3 + q * c)
    IF i = -p THEN
      m = y
      n = y
    ENDIF
    IF y > m THEN m = y
    IF y < n THEN n = y
    IF m = y OR n = y THEN
      emulate_plot(69, -x, y)
      emulate_plot(69, x, y)
    ENDIF
  NEXT
NEXT
t2 = SDL_GetTicks()
t3 = (t2-t1)/1000
emulate_off()
t$ = "Time: " & STR$(t3) & " seconds."
emulate_vdustr(t$, LEN(t$))
INPUT wait$
end_screen()


Code: [Select]

' Graph Demo

PRAGMA INCLUDE SDL.h
PRAGMA OPTIONS -I/usr/include/SDL -D_GNU_SOURCE=1 -D_REENTRANT -DHAVE_OPENGL
PRAGMA LDFLAGS SDL bbc
PROTO init_screen, emulate_mode, emulate_origin, emulate_move, emulate_draw, end_screen, SDL_WM_SetCaption

init_screen()
SDL_WM_SetCaption("BaCon BBC graphdemo", 0)
emulate_mode(31)
emulate_origin(800, 600)
xlow = -10
xhigh = 10
ylow = -10
yhigh = 10
depth = 10
xscale = 30
yscale = 12
c = -4000

FOR x = xlow TO xhigh
  emulate_move(xscale*(x+ylow), yscale*(ylow-x)+c/(x*x+ylow*ylow+depth))
  FOR y = ylow TO yhigh
    emulate_draw(xscale*(x+y), yscale*(y-x)+c/(x*x+y*y+depth))
  NEXT
NEXT
FOR y = ylow TO yhigh
  emulate_move(xscale*(xlow+y), yscale*(y-xlow)+c/(xlow*xlow+y*y+depth))
  FOR x = xlow TO xhigh
    emulate_draw(xscale*(x+y), yscale*(y-x)+c/(x*x+y*y+depth))
  NEXT
NEXT
INPUT wait$
end_screen()


Code: [Select]

' Fern
 
PRAGMA INCLUDE SDL.h
PRAGMA OPTIONS -I/usr/include/SDL -D_GNU_SOURCE=1 -D_REENTRANT -DHAVE_OPENGL
PRAGMA LDFLAGS m SDL bbc
PROTO init_screen, emulate_mode, emulate_origin, emulate_off, emulate_gcol, emulate_off, emulate_draw, emulate_move, end_screen, SDL_WM_SetCaption
DECLARE i TYPE long
DECLARE a,b,c,d,e,f,x,y,r,newx, newy TYPE float
SEED NOW
DEF FN QRND = (float)(RANDOM(1000) / 1000.0)
 
init_screen()
SDL_WM_SetCaption("BaCon BBC Fern", 0)
emulate_mode(31)
emulate_origin(200, 100)
emulate_off()
emulate_gcol(0, 10)
x = 0
y = 0
FOR i = 1 TO 80000
r = QRND
IF r <= 0.1 THEN
a = 0
b = 0
c = 0
d = 0.16
e = 0
f = 0
ELIF r > 0.1 AND r <= 0.86 THEN
a = .85
b = .04
c = -.04
d = .85
e = 0
f = 1.6
ELIF r > 0.86 AND r <= 0.93 THEN
a = .2
b = -.26
c = .23
d = .22
e = 0
f = 1.6
ELIF r > 0.93 THEN
a = -.15
b = .28
c = .26
d = .24
e = 0
f = .44
END IF
newx = a * x + b * y + e
newy = c * x + d * y + f
x = newx
y = newy
emulate_move((int)(600 + 96 * x), (int)(32 + 96 * y))
emulate_draw((int)(600 + 96 * x), (int)(32 + 96 * y))
NEXT i
INPUT wait$
end_screen()


Code: [Select]

' Polygon
 
PRAGMA INCLUDE SDL.h
PRAGMA OPTIONS -I/usr/include/SDL -D_GNU_SOURCE=1 -D_REENTRANT -DHAVE_OPENGL
PRAGMA LDFLAGS SDL bbc
PROTO init_screen, emulate_mode, emulate_origin, emulate_off, emulate_gcol, emulate_off, emulate_draw, emulate_move, end_screen
PROTO SDL_WM_SetCaption, emulate_newmode, emulate_vdu, emulate_plot
DECLARE angle, radius TYPE double
DECLARE xorigin, yorigin, i, l TYPE int
DECLARE c, t, d, side, sides TYPE int
DECLARE x[10] TYPE double
DECLARE y[10] TYPE double
SEED NOW
init_screen()
SDL_WM_SetCaption("BaCon BBC Polygon", 0)
emulate_newmode(800, 600, 256, -1)
emulate_vdu(26)
FOR i = 1 TO 1000
xorigin = RANDOM(1250)
yorigin = RANDOM(840)
radius = RANDOM(300) + 50
emulate_origin((int)xorigin, (int)yorigin)
sides = RANDOM(8) + 2
emulate_move((int)radius, 0)
emulate_move(10, 10)
c = RANDOM(64) + 1
t = (RANDOM(4) - 1) << 6
emulate_gcol(0, (int)c, (int)t)
FOR side = 1 TO sides
angle = (double)(((side - 1) * 2) * (PI / sides))
x[side] = (double)(radius * COS(angle))
y[side] = (double)(radius * SIN(angle))
emulate_move(0, 0)
emulate_plot(85, (int)x[side], (int)y[side])
NEXT side
emulate_move(0, 0)
emulate_plot(85, (int)radius, 0)
REPEAT
d = ABS(RANDOM(64) - 1)
UNTIL (d & 63) <> (c & 6)
emulate_gcol(0, (int)d, (int)t)
FOR side = 1 TO sides
FOR l = side TO sides
emulate_move((int)x[side], (int)y[side])
emulate_draw((int)x[l], (int)y[l])
NEXT l
NEXT side
NEXT i
INPUT wait$
end_screen()


Code: [Select]

'BBC COLOURS Demo - bits from Alex

' ***********************
' COMPILER DIRECTIVES
' ***********************

PRAGMA INCLUDE SDL.h
PRAGMA OPTIONS -I/usr/include/SDL -D_GNU_SOURCE=1 -D_REENTRANT -DHAVE_OPENGL
PRAGMA LDFLAGS m SDL bbc

' ***********************
' END COMPILER DIRECTIVES
' ***********************


' ***********************
' EXTERNAL FUNCTIONS
' ***********************

PROTO init_screen ALIAS SCREEN
PROTO emulate_modefn ALIAS GETMODE
PROTO emulate_vdufn ALIAS GETVDU
PROTO emulate_mode ALIAS MODE
PROTO emulate_origin ALIAS ORIGIN
PROTO emulate_off ALIAS OFF
PROTO emulate_gcol ALIAS GCOLOR
PROTO emulate_move ALIAS MOVE
PROTO emulate_vdustr ALIAS GPRINT
PROTO end_screen ALIAS ENDSCREEN
PROTO emulate_vdu ALIAS VDU
PROTO emulate_drawrect ALIAS RECTANGLE
PROTO SDL_WM_SetCaption ALIAS TITLE
PROTO SDL_PollEvent ALIAS BBC_GETKEY
PROTO SDL_GL_SetAttribute ALIAS SDL_ATTRIBUTE
PROTO printf ALIAS PRINTF
'emulate_drawrect(int32, int32, int32, int32, boolean) RECTANGLE

' ***********************
' END EXTERNAL FUNCTIONS
' ***********************


' ***********************
' SUBS & FUNCTIONS
' ***********************

' ------------------
SUB KEY_WAIT()
' ------------------
  LOCAL event TYPE SDL_Event
  WHILE TRUE DO
    WHILE BBC_GETKEY(&event) DO
      SELECT event.type
        CASE SDL_KEYUP
          ' If return is pressed, quit
          ' see http://www.libsdl.org/release/SDL-1.2.15/docs/html/sdlkey.html
          IF event.key.keysym.sym = SDLK_RETURN THEN
            OFF()
            ENDSCREEN()
            END 0
            END IF
          IF event.key.keysym.sym = SDLK_RIGHT THEN
            PRINT "RIGHT"
          END IF
          IF event.key.keysym.sym = SDLK_LEFT THEN
            PRINT "LEFT"
          END IF
          IF event.key.keysym.sym = SDLK_UP THEN
            PRINT "UP"
          END IF
          IF event.key.keysym.sym = SDLK_DOWN THEN
            PRINT "DOWN"
          END IF
        CASE  SDL_MOUSEMOTION
          PRINTF("Current mouse position is : %d,%d \n", event.motion.x,event.motion.y )
        CASE SDL_MOUSEBUTTONDOWN
          ' If left mouse button is clicked, quit
          IF  event.button.button == SDL_BUTTON_LEFT THEN
            PRINT "LEFT BUTTON"
            OFF()
            ENDSCREEN()
            END 0
          END IF
          IF  event.button.button == SDL_BUTTON_RIGHT THEN
             PRINT "RIGHT BUTTON"
          END IF
          IF  event.button.button == SDL_BUTTON_MIDDLE THEN
            PRINT "MIDDLE BUTTON"
          END IF
        CASE SDL_QUIT
        END 0
      END SELECT
    WEND
    SLEEP 200
  WEND
END SUB

' ------------------
SUB ANTIALIAS()
' ------------------
  SDL_ATTRIBUTE(SDL_GL_MULTISAMPLEBUFFERS, 1)
  SDL_ATTRIBUTE(SDL_GL_MULTISAMPLESAMPLES, 4)
END SUB

' ------------------
SUB MK_DRAWING()
' ------------------
  ' initializatopm
  LOCAL x, y TYPE int
  LOCAL T1$, T2$, T3$ TYPE STRING
  T1$ = "BaCon BBC COLOURS - MODE 32"
  T2$ = "BBC Colours - Mode 32"
  T3$ = "Left click to quit"
  LOCAL rotation TYPE double
  ' screen prep
  SCREEN()
  TITLE(T1$, 0)
  ANTIALIAS()
  MODE(32)
  VDU(5)
  OFF()
  ' terminal output
  PRINT "MODE: ", GETMODE()
  PRINT "DEPTH: ", GETVDU(3)
  PRINT "Width: ", GETVDU(11) + 1, " Height: ", GETVDU(12) + 1
  PRINT "OriginX: ", GETVDU(136), " OriginY: ", GETVDU(137)
  PRINT "FGcolor: ", GETVDU(153), " BGcolor: ", GETVDU(154)
  PRINT "OriginX: ", GETVDU(136), " OriginY: ", GETVDU(137)
  GCOLOR(0, 63, 192)
  MOVE(400, 1160)
  GPRINT("0", 0)
  MOVE(400 + 256 - 5, 1160)
  GPRINT("64", 0)
  MOVE(400 + (2 * 256) - 15, 1160)
  GPRINT("128", 0)
  MOVE(400 + (3 * 256) - 20, 1160)
  GPRINT("192", 0)
  ORIGIN(200, 100)
  FOR col = 0 TO 63
    MOVE(10, (col * 16) + 16)
    GPRINT(RIGHT$("  " & STR$(col), 2), 0)
  NEXT col
  ORIGIN(270, 100)
  FOR col = 0 TO 63
    FOR tint = 0 TO 192 STEP 64
      GCOLOR(0, col, tint)
      RECTANGLE(tint * 4, col * 16, 256, 16, 1)
      PRINT RIGHT$("   " & STR$(col), 3), ". GCOLOR(0,", col, ",", tint, ")"
    NEXT tint
  NEXT col
  PRINT "OriginX: ", GETVDU(136), " OriginY: ", GETVDU(137)
  PRINT "FGcolor: ", GETVDU(153), " BGcolor: ", GETVDU(154)
  ORIGIN(0, 0)
  MOVE(620, 80)
  GCOLOR(0, 2, 3)
  PRINT "OriginX: ", GETVDU(136), " OriginY: ", GETVDU(137)
  PRINT "FGcolor: ", GETVDU(153), " BGcolor: ", GETVDU(154)
  GPRINT(T2$, 0)
  GCOLOR(0, 63, 192)
  ' GCOLOR(0, 2, 4)
  MOVE(635, 40)
  GPRINT(T3$, 0)
END SUB

' ***********************
' END SUBS & FUNCTIONS
' ***********************


' ***********************
' MAIN
' ***********************

MK_DRAWING()
KEY_WAIT()

' ***********************
' END MAIN
' ***********************