Hebrew in freeBASIC

[ron77]

1. hebrew in freebasic GFX screen you need to load a .CPI hebrew font like so...

file "LoadFont.bas"

type fbGfxFONT
  as long w,h
  as ubyte ptr pData
  bData(16*256-1) as ubyte
end type  
extern as any ptr __fb_gfx alias "__fb_gfx"
static shared as fbGfxFONT g_MyFont = type(8,16)
static shared as fbGfxFONT ptr g_pOrgFont
static shared as fbGfxFONT ptr ptr g_pptfbGfxFont

sub LoadFontEgaCPI( sFontFile as string )
  
  g_pptfbGfxFont = cptr(fbGfxFONT ptr ptr,__fb_gfx+52+9*sizeof(any ptr)-4)  
  if g_pOrgFont = 0 then g_pOrgFont = *g_pptfbGfxFont
  *g_pptfbGfxFont = @g_MyFont  
  
  var f = freefile()
  if open(sFontFile for binary access read as #f) then exit sub
  get #f,66,g_MyFont.bData(): close #f
  for N as long = 0 to 255*16
    g_MyFont.bData(N) = ((g_MyFont.bData(N) * &h80200802ULL) and &h0884422110ULL) * &h0101010101ULL shr 32
  next N
    
  g_MyFont.pData = @(g_MyFont.bData(0))  
  
end sub
#define EnableFont() *g_pptfbGfxFont = @g_MyFont  
#define RestoreFont() *g_pptfbGfxFont = g_pOrgFont

'~ screenres 640,480

'~ width 640\8,480\16 'must be 8x16
'~ LoadFontEgaCPI("hebega.cpi")

'~ for I as long = 0 to 1
  '~ for N as long = 0 to 255
    '~ locate 1+N\16, I*40+1+(N mod 16)*2
    '~ if (N >=7 and N<=10) or N=13 then print "?";: continue for
    '~ print chr(N);    
  '~ next N  
  '~ RestoreFont()
'~ next I

'~ sleep : end

You cannot view this attachment.

Plus you need to use IBM OEM 862 encoding instead UTF-8

Here is a function that converts UTF-8 to IBM OEM 862 encoding plus a "PrintRight" Function:

function Utf8ToOEM862( sInput as string ) as string
  dim as string sOutput = space(len(sInput))
  dim as long iOut
  for N as long = 0 to len(sInput)-1
    if sInput[N]=&hD7 then
      if sInput[N+1]>=&h90 andalso sInput[N+1]<=&hAA then
        sOutput[iOut] = sInput[N+1]-&h10         
        iOut += 1 : N += 1 :  :continue for
      end if
    end if
    #if __FB_DEBUG__    
      if sInput[N]>&h7F then puts("Warning: utf-8 char not converted!")
    #endif
    sOutput[iOut] = sInput[N] : iOut += 1
  next N
  return left(sOutput,iOut)
end function


sub PrintRight( sText as string )
  var sInvert = sText, iLen = len(sInvert)-1  
  for N as long = 0 to iLen\2
    swap SInvert[N],sInvert[iLen-N]
  next N
  var iLin = csrlin(), iCol = pos()
  if (iCol-(iLen+1)) < 1 then 
    print : iLin = csrlin() : iCol = loword(width())
  end if
  locate iLin,iCol-iLen
  print sInvert;
  locate iLin,iCol-(iLen+1)
end sub

and here is a function that converts UTF-8 to ANSI 1255 (good for GUI window9.bi)

function utf8toansi1255( sInput as string ) as string
  dim as string sOutput = space(len(sInput))
  dim as long iOut
  for N as long = 0 to len(sInput)-1
    if sInput[N]=&hD7 then
      if sInput[N+1]>=&h90 andalso sInput[N+1]<=&hAA then
        sOutput[iOut] = sInput[N+1]+(&hE0-&h90)
        iOut += 1 : N += 1 :  :continue for
      end if
    end if
    #if __FB_DEBUG__    
      if sInput[N]>&h7F then puts("Warning: utf-8 char not converted!")
    #endif
    sOutput[iOut] = sInput[N] : iOut += 1
  next N
  return left(sOutput,iOut)
end function