Posts: 285
Threads: 70
Joined: Feb 2005
Just to get me going on the right track could someone please show me how to include all the GFX stuff ready to compile with FB. Gordon
Code: REM SPIROS
SCREEN 9
ever = 0
WHILE ever = 0
B = INT(RND * 50) + 1: M = (INT(RND * 10) + 1) / 10
IF INT(RND * 4) = 1 THEN CLS
COLOR INT(RND * 15) + 1
A = 30: C = A + B: Q = 0
FOR n = 1 TO 3000
IF INKEY$ <> "" THEN END
x = C * COS(Q) - M * B * COS(C * Q / B)
x = x + 300
y = C * SIN(Q) - M * B * SIN(C * Q / B)
y = y + 150
IF Q = 0 THEN
PSET (x, y)
ELSE
LINE -(x, y)
END IF
Q = Q + B / 800
NEXT n
SLEEP 2000
WEND
Posts: 268
Threads: 9
Joined: Dec 2004
FBC will include support for QB-like gfx functions automatically if your program uses them. So to compile your program, just run
and that's it. BTW, since FB assumes all variables to be INTEGER unless specified, whereas QB assumed them to be SINGLE, the program you posted here will not work as it should. To make it work properly, just add a
as the first line. Now recompile and it'll work as in QB.
Posts: 285
Threads: 70
Joined: Feb 2005
Thanks for your help.
I have a number of these patterns converted from BBC BASIC. If I manage to convert more for FB, where can I upload them in this forum for others.
The QB versions etc can be found from the Programs page of below. Gordon
http://sionet.mysite.wanadoo-members.co.uk
Posts: 285
Threads: 70
Joined: Feb 2005
HERE IS ANOTHER ANCIENT PATTERN THAT COMPILES OK WITH FB GORDON
Code: DEFSNG A-Z
REM KALIEDSCOPE originaly Written for the UK BBC Electron
DIM X(3, 3), Y(3, 3), XC%(7), YC%(7)
SCREEN 12: LOCATE 10, 15
PRINT "Press Enter to start then Spacebar anytime to Quit"
INPUT T: RANDOMIZE TIMER: RESTORE 500
FOR I% = 1 TO 7
READ XC%(I%), YC%(I%)
NEXT
SCALE1 = 250: SCALE2 = 400: WINDOW
FIN = 0: C = 1: C% = 0
WHILE FIN = 0: CLS
S$ = "A"
FOR P = 1 TO 2: CLS
IF P = 2 THEN S$ = "B"
C = C + 1: IF C = 4 THEN C = 1
FOR L% = 1 TO 6
GOSUB 300: REM CALCS
PC% = INT(RND * 15) + 1: COLOR PC%
IF S$ = "A" THEN K% = 1: GOTO 140
FOR K% = 1 TO 7
140 WINDOW (0 - XC%(K%), 0 - YC%(K%))-(1279 - XC%(K%), 1023 - YC%(K%))
GOSUB 410: REM TRIANGLES
IF S$ = "A" THEN GOTO 180
NEXT K%
180 NEXT L%
REM Attempts to avoid full screen color flood
ST = -600: EN = 600: IF S$ = "B" THEN ST = -50: EN = 1150
CX% = 0: SX% = 0
FOR TX% = ST TO EN STEP 20
SX% = SX% + POINT(TX%, 0)
CX% = CX% + 1
NEXT TX%: TX% = TX% - 20
IF SX% MOD CX% = 0 THEN GOTO 190
REM Delay
T = TIMER: WHILE TIMER < T + 2: WEND: IF INKEY$ = " " THEN END
190 NEXT P
WEND
300 REM CALCS
IF S$ = "A" THEN SCALE = SCALE2 ELSE SCALE = SCALE1
FOR J% = 1 TO 3
R = SCALE * RND: TH = 1.047 * (RND + .5)
X(1, J%) = R * COS(TH): Y(1, J%) = R * SIN(TH)
XH = X(1, J%) / 2: XV = X(1, J%) * .866
YH = Y(1, J%) * .866: YV = Y(1, J%) / 2
X(2, J%) = YH + XH: Y(2, J%) = -YV + XV
X(3, J%) = YH - XH: Y(3, J%) = -YV - XV
NEXT J%: RETURN
410 REM TRIANGLES
FOR I% = 1 TO 3
PSET (X(I%, 1), Y(I%, 1))
LINE -(X(I%, 2), Y(I%, 2))
LINE -(X(I%, 3), Y(I%, 3)): LINE -(X(I%, 1), Y(I%, 1))
PX% = (X(I%, 1) + X(I%, 2) + X(I%, 3)) / 3
PY% = (Y(I%, 1) + Y(I%, 2) + Y(I%, 3)) / 3
PAINT (PX%, PY%)
PSET (-X(I%, 1), Y(I%, 1))
LINE -(-X(I%, 2), Y(I%, 2))
LINE -(-X(I%, 3), Y(I%, 3)): LINE -(-X(I%, 1), Y(I%, 1))
PX = (-X(I%, 1) + -X(I%, 2) + -X(I%, 3)) / 3
PY = (Y(I%, 1) + Y(I%, 2) + Y(I%, 3)) / 3: PAINT (PX, PY)
NEXT I%: RETURN
500 DATA 640,514,370,994,910,994,1180,514,910,34,370,34,100,514
Posts: 285
Threads: 70
Joined: Feb 2005
Can anyone see why INKEY$ allows the first program to abort but not the second program, although both stop OK with QB ? Gordon
Code: DEFSNG A-Z
REM Cross Patterns from BBC BASIC
SCREEN 9: PRINT TAB(26);"PRESS SPACEBAR TO ABORT"
SLEEP 2000 : COLOR 14: CM = 130: DL = .05
RANDOMIZE TIMER: WINDOW (0, 320)-(620, 0)
WHILE FIN = 0
REM BG = INT(RND * CM) + 1: CLS : PAINT (100, 100), BG
COL% = INT(RND * CM) + 1: T = TIMER: Z = TIMER
MAX% = 800: STP% = 4: RES% = 4: XP% = 200: YP% = 100
X% = (INT(RND * (400 / RES%)) + 1) * RES%
Y% = (INT(RND * (400 / RES%)) + 1) * RES%
XST% = (INT(RND * STP%) + 1) * RES%
YST% = (INT(RND * STP%) + 1) * RES%
COUNT = 1: CH = 0: WHILE CH = 0
IF COUNT MOD 12 = 0 THEN COL% = INT(RND * 16)
H% = (X% + XP%) / 2: V% = (Y% + YP%) / 2.926
PSET (H%, V%), COL%
H% = (X% + XP%) / 2: V% = (MAX% - Y% + YP%) / 2.926
LINE -(H%, V%), COL%
GOSUB DELAY
H% = (MAX% - X% + XP%) / 2
V% = (MAX% - Y% + YP%) / 2.926
LINE -(H%, V%), COL%
GOSUB DELAY
H% = (MAX% - X% + XP%) / 2: V% = (Y% + YP%) / 2.926
LINE -(H%, V%), COL%
GOSUB DELAY
H% = (X% + XP%) / 2: V% = (Y% + YP%) / 2.926
LINE -(H%, V%), COL%
H% = (Y% + XP%) / 2: V% = (X% + YP%) / 2.926
PSET (H%, V%), COL%
GOSUB DELAY
H% = (Y% + XP%) / 2: V% = (MAX% - X% + YP%) / 2.926
LINE -(H%, V%), COL%
GOSUB DELAY
H% = (MAX% - Y% + XP%) / 2: V% = (MAX% - X% + YP%) / 2.926
LINE -(H%, V%), COL%
GOSUB DELAY
H% = (MAX% - Y% + XP%) / 2: V% = (X% + YP%) / 2.926
LINE -(H%, V%), COL%
GOSUB DELAY
H% = (Y% + XP%) / 2: V% = (X% + YP%) / 2.926
LINE -(H%, V%), COL%
GOSUB DELAY
X% = X% + XST%: IF X% > MAX% OR X% < 0 THEN XST% = -XST%
Y% = Y% + YST%: IF Y% > MAX% OR Y% < 0 THEN YST% = -YST%
COUNT = COUNT + 1: IF COUNT > 40 THEN COUNT = 1: CH = 1
IF INKEY$ = " " THEN STOP
WEND: BG% = INT(RND * 174): COLOR COL%:
SLEEP 2000 : CLS
WEND: STOP
DELAY: SLEEP 1: RETURN
Code: DEFSNG A-Z
REM KOCH patterns from an IBM original
SCREEN 12: LOCATE 10, 20
PRINT "Press Spacebar anytime to Abort": SLEEP 2000
DIM SR(20), SX1(20), SX2(20), SY1(20), SY2(20)
DIM SX(20), SY(20), SY3(20), SY4(20), SCOL(20)
WINDOW (0, 0)-(1279, 799)
PI = 3.141593
COS30 = COS(30 * PI / 180): WHILE 1
SP = 0: RESTORE 2089
FOR Z = 1 TO 6: READ FA, FB
RES = 8: RDFC = 1 / FA: X = 640: Y = 400: R = 256
CLS : BG = INT(RND * CM) + 1: PAINT (100, 100), BG
C = INT(RND * CM) + 1: PX = INT(RND * 20) + 1
GOSUB 2044: SLEEP 1000 :CLS
NEXT: WEND
2044 REM Koch Flake
I$ = INKEY$ : IF I$ <> "" THEN STOP
IF R < RES THEN RETURN
SX1(SP) = X1: SX2(SP) = X2
SY1(SP) = Y1: SY2(SP) = Y2
SY3(SP) = Y3: SY4(SP) = Y4
SP = SP + 1
X1 = X - R * COS30: X2 = X + R * COS30: XINC = R * COS30
Y1 = Y - R: Y2 = Y - R / 2: Y3 = Y + R / 2: Y4 = Y + R
P = C + PX
LINE (X1, Y2)-(X, Y4), P
LINE -(X2, Y2), P
LINE -(X1, Y2), P
LINE (X, Y1)-(X1, Y3), P
LINE -(X2, Y3), P
LINE -(X, Y1), P
PAINT (X, Y), P, P
PAINT (X, Y3 + R / 4), P, P
PAINT (X2 - XINC, Y3 - R / 4), P, P
PAINT (X2 - XINC, Y2 + R / 4), P, P
PAINT (X, Y2 - R / 4), P, P
PAINT (X1 + XINC, Y2 + R / 4), P, P
PAINT (X1 + XINC, Y3 - R / 4), P, P
SR(SP) = R: SCOL(SP) = C
SX(SP) = X: SY(SP) = Y
RDFC = 1 / FB
R = R * RDFC
C = C + PX
X = X1: Y = Y2
GOSUB 2044
X = SX(SP): Y = Y4
GOSUB 2044
SLEEP 1
X = X2: Y = Y2
GOSUB 2044
X = SX(SP): Y = Y1
GOSUB 2044
X = X1: Y = Y3
GOSUB 2044
X = X2: Y = Y3
GOSUB 2044
X = SX(SP): Y = SY(SP)
GOSUB 2044
R = SR(SP): X = SX(SP): Y = SY(SP)
C = SCOL(SP)
SP = SP - 1
X1 = SX1(SP): X2 = SX2(SP)
Y1 = SY1(SP): Y2 = SY2(SP)
Y3 = SY3(SP): Y4 = SY4(SP)
RETURN
2089 DATA 3,3,2.6,4,2.5,2.4,3.2,3,2.5,4,3.5,2.7
Posts: 285
Threads: 70
Joined: Feb 2005
Here is my offering for today to provide quite a nice background for PLAYMP3.BAS Gordon
Code: ''
'' play all mp3 files at the path given in command-line (current dir if none)
''
'' uses the fmod library to do the hard work
''
option explicit
option escape
'$include: 'fmod.bi'
screen 12
WINDOW (0 - 638, 0 - 478)-(638, 478)
print tab (10);"Press P for previous, N for next or any other key to exit."
declare function listmp3 ( path as string, mp3table() as string ) as integer
declare function getmp3name ( byval stream as integer ) as string
declare function getmp3artist ( byval stream as integer ) as string
declare function getmp3album ( byval stream as integer ) as string
declare sub printmp3tags ( byval stream as integer )
dim stream as integer
dim mp3table() as string
dim songs as integer, currsong as integer
dim I as single, K as single
dim doexit as integer, C as integer
dim shared streamended as integer
''
songs = listmp3( command$, mp3table() )
if( songs = 0 ) then
print "No mp3 files found, usage: playmp3.exe path"
sleep
end 1
end if
''
if( FSOUND_GetVersion <= FMOD_VERSION ) then
print "FMOD version " + str$(FMOD_VERSION) + " or greater required"
end 1
end If
''
if( FSOUND_Init( 44100, 4, 0 ) = 0 ) then
print "Can't initialize FMOD"
end 1
end if
''
FSOUND_Stream_SetBufferSize( 50 )
''
currsong = 0
doexit = 0
do
''
stream = FSOUND_Stream_Open( mp3table(currsong), FSOUND_MPEGACCURATE, 0, 0 )
if( stream = 0 ) then
print "Can't load music file \"" + mp3table(currsong) + "\""
exit do
end if
''
print "Title:", getmp3name( stream )
print "Album:", getmp3album( stream )
print "Artist:", getmp3artist( stream )
'printmp3tags stream
''
streamended = 0
FSOUND_Stream_Play( FSOUND_FREE, stream )
''
dim key as string
do
key = inkey$
if( len( key ) > 0 ) then
select case ucase$( key )
case "P"
currsong = currsong - 1
if( currsong < 0 ) then currsong = songs - 1
case "N"
currsong = currsong + 1
if( currsong >= songs ) then currsong = 0
case else
doexit = -1
end select
exit do
else
if( FSOUND_Stream_GetPosition( stream ) >= FSOUND_Stream_GetLength( stream ) ) then
currsong = currsong + 1
if( currsong >= songs ) then currsong = 0
exit do
end if
end if
FOR K = 396 TO 240 STEP -40
C = INT(RND * 15) + 1
FOR I = -K TO K STEP 4
PSET (K, I), C
LINE -(-K, -I), C
PSET (I, -K), C
LINE -(-I, K), C
NEXT I
SLEEP 1000
NEXT K
sleep 1000
loop
FSOUND_Stream_Stop stream
FSOUND_Stream_Close stream
loop until( doexit )
FSOUND_Close
end
''::::
function byteptr2string( byval pbyte as byte ptr, byval lgt as integer ) as string
dim text as string, ptext as byte ptr
dim i as integer
text = ""
if( lgt > 0 ) then
text = space$( lgt )
ptext = strptr( text )
for i = 1 to lgt
*ptext = *pbyte
ptext = ptext + 1
pbyte = pbyte + 1
next i
end if
byteptr2string = trim$( text )
end function
'':::::
sub printmp3tags( byval stream as integer )
dim numtags as integer
dim tagtype as integer, tagname as byte ptr, tagvalue as byte ptr, taglen as integer
dim tag as integer
FSOUND_Stream_GetNumTagFields( stream, @numtags )
for tag = 0 to numtags-1
FSOUND_Stream_GetTagField( stream, tag, @tagtype, @tagname, @tagvalue, @taglen )
print byteptr2string( tagname, taglen )
next tag
end sub
'':::::
function getmp3name( byval stream as integer ) as string
dim tagname as byte ptr, taglen as integer
FSOUND_Stream_FindTagField( stream, FSOUND_TAGFIELD_ID3V1, "TITLE", @tagname, @taglen )
if( taglen = 0 ) then
FSOUND_Stream_FindTagField( stream, FSOUND_TAGFIELD_ID3V2, "TIT2", @tagname, @taglen )
end if
getmp3name = byteptr2string( tagname, taglen )
end function
'':::::
function getmp3artist( byval stream as integer ) as string
dim tagname as byte ptr, taglen as integer
FSOUND_Stream_FindTagField( stream, FSOUND_TAGFIELD_ID3V1, "ARTIST", @tagname, @taglen )
if( taglen = 0 ) then
FSOUND_Stream_FindTagField( stream, FSOUND_TAGFIELD_ID3V2, "TPE1", @tagname, @taglen )
end if
getmp3artist = byteptr2string( tagname, taglen )
end function
'':::::
function getmp3album( byval stream as integer ) as string
dim tagname as byte ptr, taglen as integer
FSOUND_Stream_FindTagField( stream, FSOUND_TAGFIELD_ID3V1, "ALBUM", @tagname, @taglen )
if( taglen = 0 ) then
FSOUND_Stream_FindTagField( stream, FSOUND_TAGFIELD_ID3V2, "TALB", @tagname, @taglen )
end if
getmp3album = byteptr2string( tagname, taglen )
end function
'':::::
function listmp3( path as string, mp3table() as string ) as integer
dim fname as string
dim maxsongs as integer, song as integer
''
maxsongs = 20
redim mp3table(0 to maxsongs-1) as string
''
#ifdef FB__WIN32
const pathdiv = "\\"
#else
const pathdiv = "/"
#endif
if( len( path ) > 0 ) then
if( left$( path, 1 ) = "\"" ) then
path = mid$( path, 2 )
end if
if( right$( path, 1 ) = "\"" ) then
path = left$( path, len( path ) - 1 )
end if
if( right$( path, 1 ) <> pathdiv ) then
path = path + pathdiv
end if
end if
''
song = 0
fname = dir$( path + "*.mp3" )
do while( len( fname ) > 0 )
if( song >= maxsongs ) then
maxsongs = maxsongs + (maxsongs \ 2)
redim mp3table(0 to maxsongs-1) as string
end if
mp3table(song) = path + fname
song = song + 1
fname = dir$( "" )
loop
listmp3 = song
end function
|
