i ported a dancer demo from the TRS-COLOR (8bit computer) manual to freebasic (lang fb) trying to keep the code as close to the original as possible...
changes where that i removed some useless gosub+return (since it was used only once anyway) and the GOTO to restart i turned into a DO:LOOP (i could had kept goto with a label, but meh...)
i removed all the $ suffixes and changed them to s prefixes for strings
i emulated the CLS and PRINT@ that were specific to that basic under _Cls and _PrintAt functions
i emulated the fact that characters above 127 were colored semi-graphic , and so the _Print and _Cls functions
reflect that accepting the original color values instead of freebasic ones... and checking character number to prints the colors (semi-graphic were not required just full colors, so it should works fine in any codepage)
i changed the console size to be 32x16 (size of text mode on TRS-COLOR), as this is required due the way this demo use strings to quickly draw over multiple lines by making all strings multiple of 32 characters...
freebasic does not have built-in sound, but if you include the fbsound headers or equivalent sound implementation it will work otherwise it will just delay the amount the sound would
const ConWid=32 , ConHei=16
width ConWid,ConHei : locate ,,0
color ,10 : cls
'DC = 2584 , DD=258C , DE=2590 , DF = 2580 , DB=2588
dim shared as integer CP_Padrao(15) = {32,1,1,&hDC,0,&hDD,1,1,1,1,&hDE,1,&hDF,1,1,&hDB}
dim shared as integer CP_Cores(8) = {0,10,14,9,12,15,11,5,6}
#define _Print PrintAt -1,
sub PrintAt( iPos as integer = -1 , sText as string )
dim as integer N , C , Cor = -1 , NewCor
dim as string sTrecho
if iPos>=0 then locate 1+(iPos\ConWid),1+(iPos mod ConWid)
for N = 1 to len(sText)
C = asc(sText,N)
if C >= asc("a") and C <= asc("z") then
NewCor = 1 : C -= 32
elseif C >= 128 then
if (C and 15)=0 then NewCor = Cor and 15 else NewCor = (C\16)-7
C = CP_Padrao(C and 15)
else
NewCor = 1*16
end if
if NewCor <> Cor then
if len(sTrecho) then
color CP_Cores(Cor and 15),CP_Cores(Cor\16)
print sTrecho; : sTrecho = ""
end if
Cor = NewCor
end if
sTrecho += chr(C)
next N
if len(sTrecho) then
color CP_Cores(Cor and 15),CP_Cores(Cor\16)
print sTrecho;
end if
end sub
sub _cls( iCor as integer = 1 )
if iCor < 0 or iCor > 8 then exit sub
color , CP_Cores(iCor) : cls
end sub
dim as integer T,X,L,P,V,D
dim as string sD,sG,sB,sFU,sC,sF,sA,sE,sHD
dim as string sJ,sBD,sB1,sB2,sB3,sL1
dim as string sH,sI,sL2,sL3,sLG
sD = chr(128,128) '10
sG = sD+chr(128) '20
sB = sG+sD '30
sFU = sB+sB+sB+sD+sD '40
sC = chr(143+64) '50
sF = sC+sC '60
sA = sF+sC '70
for T = 1 to 7 '80
sE = sE+chr(143+48) '90
next T '100
sHD = sB+sA+sB+sFU+sB+sA+sB+sFU '110
sJ = chr(128) '115
for X=1 to 4 '120
sBD = sBD+sD+sC+sE+sC+sD+sFU '130
next X '140
sB1=sD+sC+sE+sC+sC+sJ+sFU+ _
sD+sC+sE+sJ+sC+sJ+sFU+ _
sD+sC+sE+sJ+sC+sJ+sFU+ _
sD+sC+sE+sG '145
sB2=sJ+sC+sC+sE+sC+sD+sFU+ _
sJ+sC+sJ+sE+sC+sD+sFU+ _
sJ+sC+sJ+sE+sC+sD+sFU+ _
sG+sE+sC+sD '147
sL1=sG+sE+sG+sFU+sG+sF+ _
sG+sF+sG+sFU+sG+sF+ _
sG+sF+sG '150
sH=sG+sG '160
sI=sH+sD '170
sL2=sG+sE+sA+sFU+sG+sF+sH+sF+sFU+sG+sF '180
sL3=sA+sE+sG+sFU+sF+sH+sF+sG+sFU+sI+sF '190
color 0,10
input "Velocidade (1-10)";V
V = 11-((V-1) mod 10)
do
for X=1 to 17
if X=1 or X=5 then restore
read L,P,T,D
if P=1 then sLG = sL1 : sB = sBD
if P=2 then sLG = sL2 : sB = sB1
if P=3 then sLG = sL3 : sB = sB2
_cls(0)
PrintAt L,sHD
PrintAt L+32*2, sB
PrintAt L+32*6, sLG
#ifdef sound
sound 32+T,V*D
#else
sleep V*D*50
#endif
next X
loop
data 137,2,89,1,240,1,33,2
data 137,3,159,1,229,1,133,2
data 5,1,89,1,229,1,133,2
data 5,1,147,1,229,1,159,1
data 229,1,147,1,5,1,133,1
data 229,1,125,2,5,1,133,1
data 229,1,147,2
You do have a lot of issues with software Aurel. I pasted it into WinFBE Suite and it started just fine.
Quote from: aurel on Jul 08, 2023, 10:02 PMi use PoseidonFB and so far programs work but this one compile and then nothing
then i look in TManager ..program simply stuck in memory
Just from looking at the code and your post - it's a console program and you compile it with
-s gui option which stops the console from showing.
yeah.... it's a console program so compile without -s gui :)
adding this as the 2nd line would also work (but in gfx screen mode)
screenres ConWid*8,ConHei*14
There is an array out of bounds error with `Cor`. Initialising this with -1 leads to `Cor` being 15 and then this value being used as index into the just 9 element long `CP_Cores` array.
Quote from: __blackjack__ on Jul 23, 2025, 08:47 PMThere is an array out of bounds error with `Cor`. Initialising this with -1 leads to `Cor` being 15 and then this value being used as index into the just 9 element long `CP_Cores` array.
ah yeah `Cor` is to be intiialized with 1 not -1, i was puzzled since i couldnt see it here, but turns out i guess i copy pasted the code before fixing that xD