Dancer Demo

[mysoft]

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

[ZXDunny]

You do have a lot of issues with software Aurel. I pasted it into WinFBE Suite and it started just fine.

[Tomaaz]

i 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.

[mysoft]

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

[__blackjack__]

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.

[mysoft]

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.

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