News:

Welcome to RetroCoders Community

Main Menu

Recent posts

#72
GWBasic / Re: bmp2draw
Last post by CharlieJV - Jan 09, 2024, 01:36 PM
That's very cool.
#73
FreeBasic / dos Sound/PlayWav
Last post by mysoft - Jan 08, 2024, 07:31 PM
this is a freebasic for dos quick and dirty implementation of qbasic SOUND command (PC speaker)
and LoadWav/FreeWav/DssPlayWav functions to play .wav files over the DSS (mainly dosbox)
i may add another SpkPlayWav to play the .wav over PC speaker... DSS was just simpler to implement without using any interrupt... (i can read the timer registers to get SB/PC Speaker, but it's less stable, since it's not buffered)

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 have an optional 3rd parameter that can be used for background play... where it sets the frequency and start play... but does not stop, (useful for bg music handled every game frame))
so
sound 440,0,1
sleep
sound 440,0
will keep playing the 440hz until a key is pressed...
but it's also useful to prevent unecessary stops after sounds get played as the sample on the implementation code shows, (this is also because QBASIC implemented a sound stack... so it playted in background using interrupts, and queded 1 sound statement at least, similar as PLAY in background mode), but this implementation delay is basically synchronous so the only way to have it async is to keep it playing and change the frequency/pauses in your game (even at 30hz is good enough for background play)
#74
GWBasic / Re: bmp2draw
Last post by mysoft - Jan 08, 2024, 07:07 PM
Quote from: aurel on Jan 07, 2024, 07:30 AMso trick is in instr() reverse ?

not the instrrev is just to locate the last . (dot) so that when you pass file.bmp it emits file.txt
the trick is to use the draw statement and i check for pixels that have the same color so i can emit a single "R###" command instead of multiple "C#R" (so for some simple .bmp files without much detail it actually compresses a bit)
#75
GWBasic / Re: bmp2draw
Last post by aurel - Jan 07, 2024, 07:30 AM
so trick is in instr() reverse ?
#76
GWBasic / bmp2draw
Last post by mysoft - Jan 06, 2024, 04:18 PM
this is a program written in freebasic that converts a .bmp file into a .txt file that can be used along the gwbasic/qbasic/freebasic draw command.

#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 = ""

usage can be something like this:
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
the sample code works in gwbasic/qbasic and freebasic (with -lang qb)

if there's a need to have the tool to be compiled with qbasic itself, let me know...
#78
General Discussion / Re: what kind of music do you ...
Last post by johnno56 - Jan 04, 2024, 11:53 PM
Agreed...

.. and yet another pair of cool groups... ;)
#79
General Discussion / Re: what kind of music do you ...
Last post by aurel - Jan 03, 2024, 04:55 PM
maybe not but they are world the well known band of all times  ;)

INEXES ?
man at work
all from Australia... ;)
#80
General Discussion / Re: what kind of music do you ...
Last post by johnno56 - Jan 03, 2024, 12:13 PM
AC/DC? A fine group... Not quite my "cup of tea" but some of their music is ok.