Welcome to RetroCoders Community
sub Sound( fFreq as single , fDuration as single , bKeepOn as byte = 0 )
const PitFreq = 1193180
out &h43, &b10110110 'cnt 2 | LSB+MSB | squarewave | binary
dim as long iFreq = PitFreq/fFreq
if iFreq>65535 then iFreq=65536 else if iFreq<0 then iFreq=0
iFreq = (iFreq+1) and 65535
out &H42, (iFreq and 255)
out &H42, (iFreq shr 8)
out &H61, inp(&H61) or 3
dim as long iDuration = fDuration*(60/(PitFreq/65536))
if fDuration=0 then iDuration=0 else if iDuration < 1 then iDuration = 1
for iL as long = 0 to iDuration-1
wait &H3DA, 8: wait &H3DA, 8, 8
next iL
if bKeepOn=0 then out &H61, inp(&H61) and (not 1)
end sub
const LptPort = &h378
type WaveFile
iMagic as long
iChan as ushort
iBits as ushort
iFreq as long
iSize as ulong
end type
function LoadWav( sFile as string ) as WaveFile ptr
var f = freefile(), iOff=4
if open(sFile for binary access read as #f) then return 0
dim as ubyte uHeader(255)
get #f,,uheader()
#define u4(_off) *cptr( ulong ptr , @uHeader(_off))
#define u2(_off) *cptr( ushort ptr , @uHeader(_off))
#macro LocateChunk( _C4 )
for iOff = iOff to 255
if u4(iOff) = cvl(_C4) then exit for
next iOff
#endmacro
if u4(0) <> cvl("RIFF") then print "Not a .wav file": return 0
LocateChunk("WAVE")
if iOff >= 255 then print "Not a .wav file": return 0
LocateChunk("fmt ")
if iOff >= 255 orelse u2(iOff+8)<>1 then print "Not a PCM .wav file": return 0
var iChan = u2(iOff+10) , iFreq = u4(iOff+12) , iBits = u2(iOff+22)
if iChan<>1 and iChan<>2 then print "Unsupported channel amount": return 0
if iFreq<3500 or iFreq>48000 then print "Unsupported frequency": return 0
if iBits<>8 and iBits<>16 then print "Unsupported bits per sample": return 0
LocateChunk("data")
if iOff >= 255 then print "no playable data": return 0
var iSize = u4(iOff+4)
dim as WaveFile ptr pWave = allocate(iSize+sizeof(WaveFile)+16)
with *pWave
.iMagic = cvl("pWAV")
.iChan = iChan : .iBits = iBits
.iFreq = iFreq : .iSize = iSize
end with
get #f,iOff+9,*cptr(ubyte ptr,pWave+1),iSize
close #f
return pWave
end function
sub FreeWav( pWav as WaveFile ptr )
if pWav=0 then exit sub
if pWav->iMagic <> cvl("pWAV") then exit sub
deallocate(pWav)
end sub
sub DssPlayWav( pWav as WaveFile ptr )
if pWav=0 then exit sub
var pSample = cptr(ubyte ptr,pWav+1)
dim as integer iPos,iDelta,iNextChan,iNextSam=1,iAdd=0,iOutSam
with *pWav
if .iBits = 16 then iNextSam = 2 : iAdd = 128 : iPos += 1
iNextChan = iNextSam : iNextSam *= .iChan
'turn on
out LptPort+2,inp(LptPort+2) and (not 8)
'emit samples
do
iOutSam += 1
if iOutSam=700 then iOutSam=0:if multikey(1) then exit do
while (inp(LptPort+1) and &h40): wend
'wait LptPort+1,&h40,&h40 'wait for next sample
if .iChan>1 then
out LptPort, (cubyte((pSample[iPos]+iAdd))+cubyte((pSample[iPos+iNextChan]+iAdd))) shr 1
else
out LptPort, cubyte(pSample[iPos]+iAdd)
end if
out LptPort+2,inp(LptPort+2) or 8
out LptPort+2,inp(LptPort+2) and (not 8)
iDelta += .iFreq
while iDelta>7000 : iDelta -= 7000 : iPos += iNextSam : wend
loop until iPos >= .iSize
'turn off
out LptPort+2,inp(LptPort+2) or 8
end with
end sub
for N as long = 37 to 1023
print !"\r";N;: sound N,.03,1
next N
sound 0,0
var pWav = LoadWav("sample.wav")
DssPlayWav(pWav)
FreeWav(pWav)
sound 440,0,1
sleep
sound 440,0
Quote from: aurel on Jan 07, 2024, 07:30 AMso trick is in instr() reverse ?
#include "fbgfx.bi"
dim as long Wid,Hei
dim as short wHdr
var sFile = command$
if len(sFile)=0 then
print "BMP2TXT Input.bmp"
print "Will generate a Input.txt suitable for draw"
end 0
end if
if open(sFile for binary access read as #1) then
print "failed to open '"+sFile+"'"
end 2
end if
get #1,,wHdr
if wHdr<>cvshort("BM") then
print "input must be a paletted .bmp file"
end 1
end if
get #1,19,Wid : Get #1,,Hei : close #1
screenres 640,480,8,,fb.GFX_NULL
var pImg = ImageCreate(Wid,Hei)
bload sFile,pImg
var iPos = instrrev(sFile,".")
var sFileOut = left(sFile,iPos)+"txt"
open sFileOut for output as #2
var sRow = "",X=0
for Y as long = 0 to Hei-1
var iLastC=-1, iC=0, N=0
for X = 0 to Wid-1
iC = point(X,Y,pImg)
if X=(Wid-1) orelse iC <> iLastC then
dim as string sMore
if N then
sMore = "C" & iLastC & "R"
if N > 1 then sMore &= N
end if
if (len(sRow)+len(sMore)) >= 254 then print #2,sRow : sRow=sMore else sRow += sMore
if X=(Wid-1) andalso iC <> iLastC then
sMore = "C" & iC & "R0"
if (len(sRow)+len(sMore)) >= 254 then print #2,sRow : sRow=sMore else sRow += sMore
end if
iLastC = iC : N=1
else
N += 1
end if
next X
if Y <> Hei-1 then
var sMore = "BDBL" & Wid-1
if (len(sRow)+len(sMore)) >= 254 then print #2,sRow : sRow=sMore else sRow += sMore
end if
next Y
if len(sRow) then print #2,sRow : sRow = ""
10 SCREEN 8
15 DRAW "BM0,0"
20 OPEN "MyImage.txt" FOR INPUT AS #1
30 WHILE NOT EOF(1): INPUT #1, R$: DRAW R$: WEND
40 R$ = "": CLOSE #1