Simplest language system

Share your advanced PureBasic knowledge/code with the community.
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Simplest language system

Post by jacdelad »

Hi #PB_All,
for an application I needed multiple translations. I searched the forum and found some suggestions and also clean and nice includes, but for me they were a bit too powerful (one even included grouping and such). Also I wanted to maintain the code better readable, aka leave the original texts in the code instead of a keyword or constant. This led me to this include, which I use in some programs. The advantage in my eyes is, that the code still contains the original text at its original place and that it doubles as a fallback, if the language file is incomplete or couldn't load at all. I don't know if this helps anyone or not, but maybe it does.

The include file:

Code: Select all

Global NewMap Language.s()
Procedure LoadLanguageFile(file$,Flags=#PB_UTF8)
  Protected file,input$,res,RegEx=CreateRegularExpression(#PB_Any,"^([^\|]+)\|(.*)$",#PB_RegularExpression_AnyNewLine|#PB_RegularExpression_MultiLine)
  file=ReadFile(#PB_Any,file$,Flags|#PB_File_SharedRead)
  If file
    input$=ReadString(file,#PB_File_IgnoreEOL)
    CloseFile(file)
    ClearMap(Language())
    If ExamineRegularExpression(RegEx,input$)
      While NextRegularExpressionMatch(RegEx)
        Language(RegularExpressionGroup(RegEx,1))=ReplaceString(RegularExpressionGroup(RegEx,2),"#CR",#CRLF$,#PB_String_NoCase)
      Wend
    EndIf
    res=1  
  EndIf
  FreeRegularExpression(RegEx)
  ProcedureReturn res
EndProcedure
Procedure LoadLanguageString(input$)
  Protected res,RegEx=CreateRegularExpression(#PB_Any,"^([^\|]+)\|(.*)$",#PB_RegularExpression_AnyNewLine|#PB_RegularExpression_MultiLine)
  ClearMap(Language())
  If ExamineRegularExpression(RegEx,input$)
    While NextRegularExpressionMatch(RegEx)
      Language(RegularExpressionGroup(RegEx,1))=ReplaceString(RegularExpressionGroup(RegEx,2),"#CR",#CRLF$,#PB_String_NoCase)
    Wend
  EndIf
  FreeRegularExpression(RegEx)
  ProcedureReturn #True
EndProcedure
Procedure LoadLanguageMem(*Mem,Flags=#PB_UTF8)
  Protected input$,res,RegEx=CreateRegularExpression(#PB_Any,"^([^\|]+)\|(.*)$",#PB_RegularExpression_AnyNewLine|#PB_RegularExpression_MultiLine)
  input$=PeekS(*Mem,-1,Flags)
  ClearMap(Language())
  If ExamineRegularExpression(RegEx,input$)
    While NextRegularExpressionMatch(RegEx)
      Language(RegularExpressionGroup(RegEx,1))=ReplaceString(RegularExpressionGroup(RegEx,2),"#CR",#CRLF$,#PB_String_NoCase)
    Wend
  EndIf
  FreeRegularExpression(RegEx)
  ProcedureReturn #True
EndProcedure

Procedure.s LangSEx(index$,standard$,Repl1$="",Repl2$="",Repl3$="",Repl4$="",Repl5$="")
  If FindMapElement(Language(),index$)
    standard$=Language(index$)
  EndIf
  If repl1$<>"":standard$=ReplaceString(standard$,"%s1",repl1$,#PB_String_NoCase):EndIf
  If repl2$<>"":standard$=ReplaceString(standard$,"%s2",repl2$,#PB_String_NoCase):EndIf
  If repl3$<>"":standard$=ReplaceString(standard$,"%s3",repl3$,#PB_String_NoCase):EndIf
  If repl4$<>"":standard$=ReplaceString(standard$,"%s4",repl4$,#PB_String_NoCase):EndIf
  If repl5$<>"":standard$=ReplaceString(standard$,"%s5",repl5$,#PB_String_NoCase):EndIf
  ProcedureReturn standard$
EndProcedure
Procedure.s LangEx(index,standard$,Repl1$="",Repl2$="",Repl3$="",Repl4$="",Repl5$="")
  Protected index$=Str(index)
  If FindMapElement(Language(),index$)
    standard$=Language(index$)
  EndIf
  If repl1$<>"":standard$=ReplaceString(standard$,"%s1",repl1$,#PB_String_NoCase):EndIf
  If repl2$<>"":standard$=ReplaceString(standard$,"%s2",repl2$,#PB_String_NoCase):EndIf
  If repl3$<>"":standard$=ReplaceString(standard$,"%s3",repl3$,#PB_String_NoCase):EndIf
  If repl4$<>"":standard$=ReplaceString(standard$,"%s4",repl4$,#PB_String_NoCase):EndIf
  If repl5$<>"":standard$=ReplaceString(standard$,"%s5",repl5$,#PB_String_NoCase):EndIf
  ProcedureReturn standard$
EndProcedure
Procedure.s LangS(index$,standard$)
  If FindMapElement(Language(),index$)
    standard$=Language(index$)
  EndIf
  ProcedureReturn standard$
EndProcedure
Procedure.s Lang(index,standard$)
  Protected index$=Str(index)
  If FindMapElement(Language(),index$)
    standard$=Language(index$)
  EndIf
  ProcedureReturn standard$
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  ;Uncomment for language change (maybe need to change path and file):
  ;LoadLanguageFile("Test.lang")
  OpenConsole(Lang(0,"Sprachtest"))
  PrintN(Lang(1,"Willkommen zu PureBasic!"))
  Print(Lang(2,"Was ist dein Name: "))
  name$=Input()
  PrintN(LangSEx("Name","Dein Name ist %s1",name$))
  PrintN(LangS("Bye","Auf wiedersehen!"))
  Input()
CompilerEndIf
The language file for the demo:

Code: Select all

*Language file
*Usage: index|text
*Multiline text is not allowed -> for multilines use #CR
*All missing indices will be replaced by German standard text
*Keep an eye on leading or trailing spaces, they are not cut and sometimes are needed.
*The index number may be led or trailed by spaces/tabs to make the document more readable: "  1   |..."="1|...", but "1|..."<>"01|..."
*%s1...%s5 are placeholders which will be replace while running
0|Language test
1|Welcome to PureBasic!
2|What's your name: 
Name|Your name is %s1
Bye|Good bye!
It should be pretty selfexplanatory, but in short:
  • Load the language file with LoadLanguageFile()
  • If you use numerical indexes you can use Lang()/LangEx() to retrieve the texts, otherwise use LangS()/LangSEx()
  • Indexes can contain almost anything but "|"
  • New lines are replaced by #CR
  • The Ex-versions of the Lang-functions allow replacements (see code)
Note: This include uses RegEx to retrieve the strings. If that is not wanted (too big exe, program too fast or a regex-phobia) it should be replaced by string functions.
Last edited by jacdelad on Sat Jun 10, 2023 3:38 am, edited 1 time in total.
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
HeX0R
Addict
Addict
Posts: 980
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: Simplest language system

Post by HeX0R »

How is that going to support e.g. chinese language, since you are working here with ASCII files?
Fred
Administrator
Administrator
Posts: 16618
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: Simplest language system

Post by Fred »

You can use this one which is very good: viewtopic.php?f=12&t=26729&hilit=language
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: Simplest language system

Post by jacdelad »

@Hex0r: I don't. My task was to provide English and Dutch. So I tried to put it into the simplest form possible.
@Fred: I know this thread, but it was to complex in my eyes. I wanted a simpler version.
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
NicTheQuick
Addict
Addict
Posts: 1224
Joined: Sun Jun 22, 2003 7:43 pm
Location: Germany, Saarbrücken
Contact:

Re: Simplest language system

Post by NicTheQuick »

You should use #PB_UTF8 and not #PB_Ascii for the files. At least I would not be able to use ä, ö, ü, ß and the upper case version for that. And french will also not be possible easily.
The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: Simplest language system

Post by jacdelad »

This should not be a problem. Everyone is free to adjust it or use the framework suggested by Fred.
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
AZJIO
Addict
Addict
Posts: 1312
Joined: Sun May 14, 2017 1:48 am

Re: Simplest language system

Post by AZJIO »

Languages ​​will not be supported: Russian, Hebrew, Greek, Slavic languages, Georgian, Ukrainian. Definitely use UTF8
Little John
Addict
Addict
Posts: 4519
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: Simplest language system

Post by Little John »

jacdelad wrote: Fri Jun 09, 2023 3:44 pm This should not be a problem. Everyone is free to adjust it [...]
:?:
We are currently writing the year 2023. There is no reason at all for using ASCII today, which is something from the the past millennium.
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: Simplest language system

Post by jacdelad »

Jesus...I got it. If that's really the only critique...
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
jamirokwai
Enthusiast
Enthusiast
Posts: 771
Joined: Tue May 20, 2008 2:12 am
Location: Cologne, Germany
Contact:

Re: Simplest language system

Post by jamirokwai »

Hi there,

here is my completely stripped down approach to embedded language-strings, just for educational reasons. I know, you like to load them from language-files. Basically, you just read all strings with the language you like to support in a global Map and call Strings() instead of writing the string itself.

Cheers
J.

Code: Select all

Enumeration 
  #Language_En ; English
  #Language_De ; German 
EndEnumeration

Global NewMap Strings.s()

Procedure Get_Language(language=#Language_En)
  Protected en$ = "", de$ = ""
    
  Restore LanguageStrings

  While en$ <> "-1"
    Read.s en$
    Read.s de$
    Strings(en$) = de$
  Wend
EndProcedure


Get_Language(#Language_De)
Debug Strings("Window")

DataSection
  LanguageStrings:
  Data.s "Window", "Fenster"
  Data.s "Close",  "Schließen"
  Data.s "-1", "-1"
EndDataSection
Regards,
JamiroKwai
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: Simplest language system

Post by jacdelad »

Yeah, I've seen the DataSection variant before, but I think it makes the code less readable.
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
benubi
Enthusiast
Enthusiast
Posts: 113
Joined: Tue Mar 29, 2005 4:01 pm

Re: Simplest language system

Post by benubi »

The simplest way would be like above with arrays. However if you want a key (name) based localization in a Map, I use this format which is also relatively common but IDK if it has a specific name. You can load from a text file or catch your language files from a Buffer (preferably store them with BOM); the code is not entire glitch free, when there's no BOM ascii is automatically assumed.

If you use XML dialogs for the GUI you could add an attribute to the gadget or window and other elements "lang-id" with the key as value. After loading the dialog XML file you go through all XML/GUI elements and when a "lang-id" appears you replace the default text with the localized text, before creating/opening the dialog windows.

Sorry if the code gets a little long, 90% is only about text file/buffer manipulation, the mini lib is at the bottom before the DataSection and the demo.

Code: Select all

; Text file helper procedures
; by benubi
; Public Domain / Free software

Prototype.i EnumBufferLinesCallback(*userdata, String$) ; Returns 0 to continue enumeration OR NON-ZERO (e.g. error number) 

Procedure$ BytesToHex(*B.ascii, count)
  Protected result$ = Space((count * 3) - 1)
  Protected i
  Protected *S = @result$
  While i < count
    PokeS(*S, RSet(Hex(*B\a), 2, "0"), 2, #PB_Unicode | #PB_String_NoZero)
    *S + 6
    *B + 1
    i + 1
  Wend
  ProcedureReturn result$
EndProcedure

Procedure$ GuessEOL(*Start.Byte, *Limit, Type = -1) ; *Start: memory pointer, *Limit = *Start + ByteSize, Type = #PB_Any, #PB_Unicode, #PB_UTF8 or #PB_Ascii
  ;
  ; Guess & return EOL sequence of a text file (CRLF, LFCR, LF or CR)
  ;     UTF8_BOM  =  $BFBBEF
  ;     UTF16_BOM =  $FEFF
  Protected *C.Character, *A.Ascii , cr , lf
  
  If type = -1 ; Default is PB internal format (unicode for all current PB versions, 2023)
    type = #PB_Unicode
  EndIf
  
  
  If type = #PB_Unicode
    *C = *start
    ;Debug "unicode"
    While *Limit > *C
      Select *C\C
        Case 13
          If cr
        ;    Debug "EOL=CR"
            ProcedureReturn #CR$
          ElseIf lf
         ;   Debug "EOL=LF"
            ProcedureReturn #LFCR$
          EndIf
          cr + 1
        Case 10
          If lf
         ;   Debug "EOL=LF"
            ProcedureReturn #LF$
          ElseIf cr
         ;   Debug "EOL=CR"
            ProcedureReturn #CRLF$
          EndIf
          lf + 1
        Default
          If lf
        ;    Debug "EOL=LF"
            ProcedureReturn #LF$
          ElseIf cr
         ;   Debug "EOL=CR"
            ProcedureReturn #CR$
          EndIf
      EndSelect
      *C + 2
    Wend
    
  Else
    *A = *Start
   ; Debug "ascii/utf8"
    While *Limit > *A
      Select *a\a
        Case #CR
          If cr
            
         ;   Debug "EOL=CR"
            ProcedureReturn #CR$
            
          ElseIf lf
            
         ;   Debug "EOL=LF"
            ProcedureReturn #LFCR$
          EndIf
          cr + 1
        Case #LF
          If lf
          ;  Debug "EOL=LF"
            ProcedureReturn #LF$
          ElseIf cr
          ;  Debug "EOL=CRLF"
            ProcedureReturn #CRLF$
          EndIf
          lf + 1
        Default
          If lf
            
          ;  Debug "EOL=LF"
            ProcedureReturn #LF$
          ElseIf cr
            
          ;  Debug "EOL=CR"
            ProcedureReturn #CR$
          EndIf
      EndSelect
      *A + 1
    Wend
  EndIf
  
;   If cr
;     ProcedureReturn #CR$
;   ElseIf lf
;     ProcedureReturn #LF$
;   Else
;     ProcedureReturn #LFCR$
;   EndIf
  
EndProcedure

Procedure.i CountBufferLines(*Buffer, BufferSize, Type = -1, Eol$ = #Null$)
  Protected BOM , BOMLEN
  Protected charsize
  If Type = -1 And BufferSize >= 3
    CopyMemory(*Buffer, @BOM, 3)
    If $BFBBEF = BOM ; UTF8 check
      Type   = #PB_UTF8
      BOMLEN = 3
    EndIf
  EndIf
  
  If BOM & $FFFF = $FEFF ; UTF16 check
    BOMLEN = 2
    type   = #PB_Unicode
  EndIf
  
  
  If type = -1 ; no BOM or defined character format => switch to ascii
    type = #PB_Ascii ; use ascii
  EndIf
  
  If type = #PB_UTF16
    charsize = 2
  Else
    charsize = 1
  EndIf
  
  If Eol$ = #Null$ ; = Empty$ or ""
    Eol$ = GuessEOL(*Buffer, BufferSize + *Buffer, type)
  EndIf
  
  Protected QEOL.q
  Protected eol_len = Len(Eol$)
  Protected eol_blen = StringByteLength(eol$, Type)
  Protected *Z1.Ascii, *Z2.Ascii, c
  Protected *Lim, *start, *limeol, *QEOL
  
;   Debug "EOL$="+BytesToHex(@EOL$, eol_blen)
;   Debug "EOLLEN="+eol_len+" / "+eol_blen
;   Debug "Type="+Str(type )
;   Debug "Ascii: "+#PB_Ascii
;   Debug "UTF8:" +#PB_UTF8
;   Debug "UTF16: "+#PB_UTF16
;   Debug "charsize="+charsize
  
  *start = *Buffer + *BOMLEN
  *Lim   = *Buffer + BufferSize
  *QEOL  = @QEOL
  PokeS(*QEOL, Eol$, eol_len, Type | #PB_String_NoZero)
  *limeol = *QEOL + eol_blen
  While *start < *Lim
    *z1 = *start
    *Z2 = *qeol
    While *Z1\a = *z2\a And *Z1 < *LIM And *Z2 < *limeol
      *Z1 + 1:*Z2 + 1
    Wend
    
    If *z2 = *limeol
      *start = *z1
      c      = c + 1
      If *start = *Lim
        ProcedureReturn c
      EndIf
      Continue
    EndIf
    *Start + charsize
  Wend
  
  ProcedureReturn c + 1 ; unterminated last/lone line /empty file
  
EndProcedure

Procedure.i BufferLines(*Buffer, BufferSize, List Result.s(), Type = -1, Eol$ = #Null$) ; *Buffer: memory pointer of text file, BufferSize: BYTE size of the file in memory, Result.s(): result list where to return the file's lines, Type: character type (force ascii, utf8, unicode, #PB_Any), EOL$: End Of Line sequence. Leave empty to guess or set to force CRLF$ etc.
  ; --------------------------------------------------------------------
  ; count = BufferLines(*Buffer, BufferSize, List Result.s(), Type, Eol$)
  ;
  ; The procedure adds text lines from a buffer to a PB String List.
  ;
  ; *Buffer    = *memory pointer of the text file (ascii, utf-8 or utf-16)
  ; BufferSize = Byte size of the buffer
  ; Result.s() = The results list where to add the text file's lines
  ; Type       = #PB_Any (default):guess/read BOM, #PB_Ascii, #PB_Unicode, #PB_UTF8
  ; Eol$       = #Empty$ or #Null$: Guess End Of Line sequence, other$: force use of EOL sequence e.g. Eol$=#CRLF$
  ; --------------------------------------------------------------------
  ;
  
  Protected eol.q, eolbytes, charsize, i, *EOL, chars
  Protected *C.Character, *A.ascii , *Z1.ascii, *Z2.ascii , *eolim
  Protected *START, *LIM
  Protected BOM.i, BOMLEN
  
  *START = *Buffer
  *LIM   = *Buffer + BufferSize
  
  If Type = -1 And BufferSize >= 3
    CopyMemory(*Buffer, @BOM, 3)
    If $BFBBEF = BOM
      BOMLEN = 3
      Type   = #PB_UTF8 | #PB_ByteLength
    EndIf
  EndIf
  
  If BOM & $FFFF = $FEFF
    BOMLEN + 2
    type = #PB_Unicode
  EndIf
  
  
  If type = -1
    type = #PB_Ascii
  ElseIf type = #PB_UTF8
    type = type | #PB_ByteLength
  EndIf
  
  If #Empty$ = Eol$ Or #Null$ = Eol$
    Eol$ = GuessEOL(*Buffer, *LIM, Type)
    If #Empty$ = Eol$
      Eol$ = #CRLF$
   ;   Debug "EMPTY EOL?!"
    EndIf
  EndIf
  
  
  If type = 2 : charsize = 2 : Else : charsize = 1 : EndIf
  
  PokeS(@eol, Eol$, Len(eol$), type | #PB_String_NoZero)
  
  eolbytes = Len(eol$) * charsize
  
  
  *EOL   = @eol
  *eolim = *EOL + eolbytes
  *A     = *Start + BOMLEN
  
  If type = #PB_UTF8
    type = type | #PB_ByteLength
  EndIf
  
  While *A < *LIM
    *z1 = *A
    *z2 = *EOL
    While *z1\a = *z2\a And *z1 < *lim And *z2 < *eolim
      *Z1 + 1
      *Z2 + 1
    Wend
    If *z2 = *eolim
      AddElement(Result())
      Result() = PeekS(*A, chars, Type)
      *Start   = *Start + (chars * charsize) + eolbytes
      i + 1
      chars = 0
      If *START >= *LIM
        ProcedureReturn i
      EndIf
      Continue
    EndIf
    chars + 1
    *A + charsize
  Wend
  If *START < *LIM
    AddElement(Result())
    Result() = PeekS(*START, chars, Type)
  EndIf
  Debug i
  ProcedureReturn i
EndProcedure

Procedure.i EnumBufferLines(*Buffer, BufferSize, EnumBufferLinesCallback.EnumBufferLinesCallback, *CallbackCookie = 0, Type = -1, Eol$ = #Null$) ; Enumerate text file lines in *buffer to a Callback procedure
 ;
 ; EnumBufferLines(*Buffer, BufferSize, EnumBufferLinesCallback, *CallbackCookie, Type, Eol$)
 ;
 ; Enumerate lines form a text file to a callback.
 ; *Buffer    = *memory pointer of the text file (ascii, utf-8 or utf-16)
 ; BufferSize = Byte size of the buffer
 ; EnumBufferLinesCallback: Pointer to @YourCallbackProcedure() where to enumerate the text file line string$'s. The Callback has the format: Callback(*Cookie, String$), where *cookie is an arbitrary (optional) value set by the user
 ; *CallbackCookie: *Userdata
 ; Type       = #PB_Any (default):guess text format (read bom/guess); other: force #PB_Ascii, #PB_Unicode, #PB_UTF8 "text file" format in *Buffer
 ; EOL$       = #Empty$ or force EOL sequence
 ;
  
  Protected eol.i, eolbytes, charsize, *EOL, chars
  Protected *C.Character, *A.ascii , *Z1.ascii, *Z2.ascii , *eolim
  Protected *START, *LIM
  Protected BOM.i, BOMLEN
  Protected result = #Null
  
  *START = *Buffer
  *LIM   = *Buffer + BufferSize
  
  If Type = -1 And BufferSize >= 3
    CopyMemory(*Buffer, @BOM, 3)
    If $BFBBEF = BOM
   ;   Debug ">>> found UTF8 BOM"
      Type   = #PB_UTF8
      BOMLEN = 3
    EndIf
  EndIf
  
  If BOM & $FFFF = $FEFF
   ; Debug ">>> Found Unicode UTF16 BOM"
    type   = #PB_UTF16
    BOMLEN = 2
  EndIf
  
  If type = -1
   ; Debug ">>> switch to default/ascii"
    type = #PB_Ascii
  EndIf
  
  If EOL$ = #Empty$
   ; Debug ">>>Guess EOL..."
    Eol$ = GuessEOL(*Buffer, *LIM, Type )
    If #Empty$ = Eol$
    ;  Debug ">>> Guess EOL: NO EOL found, set default CRLF"
      Eol$ = #CRLF$
    Else
    ;  Debug ">>> Guessed EOL:"+BytesToHex(@eol$,Len(eol$)*2)
    EndIf
  EndIf
  
  If type = #PB_UTF16 : charsize = 2 : Else : charsize = 1 : EndIf
  
  *EOL = @eol
  
  PokeS(*eol, Eol$, Len(Eol$), type | #PB_String_NoZero)
  
  eolbytes = Len(eol$) * charsize
  
  If type = #PB_UTF8
    type = type | #PB_ByteLength
  EndIf
  
  
  *eolim = *EOL + eolbytes
  *A     = *Buffer + BOMLEN
  *START = *A
  While *A < *LIM ; Go through buffer character by character
    *z1 = *A
    *z2 = *EOL
    
    While *z1\a = *z2\a And *z1 < *lim And *z2 < *eolim ; Check for EOL byte by byte
      *Z1 + 1
      *Z2 + 1
    Wend
    
    If *z2 = *eolim  ; Found EOL, calling callback procedure
      result = EnumBufferLinesCallback(*CallbackCookie, PeekS(*START, chars, Type))
      If result
        ProcedureReturn result
      EndIf
      
      
      *Start = *START + (chars * charsize) + eolbytes
      *A     = *START
      i + 1
      chars = 0
      If *A => *LIM
        ProcedureReturn result
      EndIf
      Continue
    EndIf
    chars + 1
    *A + charsize
  Wend
  
  If *Start < *LIM ; check for unterminated last line, call the callback procedure if it's the case
    result = EnumBufferLinesCallback(*CallbackCookie, PeekS(*Start, chars, Type))
  EndIf
  
  ProcedureReturn result
EndProcedure


Procedure.i BLOAD(File$, *FileSize.INTEGER) ; Loads a file to new buffer. Returns a *Memory pointer, and file size (write in *FileSize pointer parameter, optional).
  Protected fh, *Memory, LOF
  
  fh = ReadFile( - 1, file$) ; Open the file to load in read-mode
  
  If fh
    
    Lof = Lof(fh) ; Get file size for buffer allocation
    
    If *FileSize  ; Return file size
      *FileSize\i = LOF
    EndIf
    
    If LOF > 1
      ; Check for minimum memory allocation size (2 bytes on Windows, IDK for the other OS'es)
      ; Allocate memory without zero-ing it (will be completely overwritten after ReadData()).
      *Memory = AllocateMemory(Lof, #PB_Memory_NoClear)
      
    Else ; file size <= 1 bytes
      *Memory = AllocateMemory(2) ; Minimum malloc size (Windows or all OS?)
    EndIf
    
    If *Memory
      ReadData(fh, *Memory, LOF) ; Read complete file in one step
    EndIf
    CloseFile(fh) ; Close the file
    
    ProcedureReturn *Memory
  EndIf
  
  ProcedureReturn #False
EndProcedure

Structure _load_text_file_info
  *ArrayBase
  index.i
EndStructure

Procedure _load_text_file_callback(*Info._load_text_file_info, String$)
  Protected *S.STRING = *Info\ArrayBase + (SizeOf(STRING) * *Info\index)
  
  *info\index = *info\index + 1
  *S\s        = String$
  
  ;Debug "String = "+String$
  ProcedureReturn #Null
EndProcedure

Procedure.i Load_Text_File(File$, Array Result.s(1))
  Protected c, i
  Protected *Memory, fsize
  Protected info._load_text_file_info
  
  *Memory = BLOAD(file$, @fsize)
  If *Memory
    c = CountBufferLines(*Memory, fsize)
    ReDim Result(c + 1)
    info\ArrayBase = @result() ; + (2 * SizeOf(Integer))
    info\index     = 0
    EnumBufferLines(*Memory, fsize, @_load_text_file_callback(), @info)
    
    FreeMemory(*Memory)
  EndIf
  ProcedureReturn c
EndProcedure

; ---------- Lang files

Procedure Lang_From_Array(Array TXT.s(1), Map L.s())
  Protected line$

  Protected c, i , *C.character, klen, poffset, keys
  c = ArraySize(TXT())
  For i = 0 To c - 1 Step 1
    line$ = Txt(i)
    If  line$ = #Empty$
      ; empty line - ignore
    ElseIf Left(line$,1)="#"
      ; commentary line
    Else
      
      *C      = @line$
      klen    = 0
      poffset = 0
      
      While *C\c And *C\c <> 32 And *C\c <> 9
        klen + 1
        *C + SizeOf(Character)
      Wend
      
      If klen > 0
        ; key length must be above 0. 
        ; Lines starting with a tab Or space will be ignored.
        
        poffset = SizeOf(Character) * klen
        While *C\c And (*C\c = #TAB Or *C\c = 32)
          *C + SizeOf(Character)
          poffset + SizeOf(Character)
        Wend
        keys + 1
        AddMapElement(L(), Left(line$, klen), #PB_Map_NoElementCheck)
        L() = UnescapeString(PeekS(@line$ + poffset))
      
;         Debug "key:"+Chr(34)+Left(line$,klen)+Chr(34)
;         Debug Chr(34)+l()+Chr(34)
      Else 
   
      EndIf  
    EndIf
  Next
  ProcedureReturn keys 
EndProcedure

Procedure Catch_Lang(*Buffer, size, Map L.s(), type=-1) ; type = character format (Ascii, utf8, utf16)
  Protected c = CountBufferLines(*Buffer, size)
  Protected Dim TXT$(c)
  Protected _info._load_text_file_info
  _info\ArrayBase = TXT$()
  _info\index     = 0
  If EnumBufferLines(*Buffer, size, @_load_text_file_callback(), @_info, type) = 0
    ProcedureReturn Lang_From_Array(Txt$(), L())
  EndIf 
EndProcedure

Procedure Load_Lang(File$, Map L.s())
  Protected Dim TXT$(1)
  If Load_Text_File(File$, TXT$())
    ProcedureReturn Lang_From_Array(TXT$(), L())
  EndIf 
EndProcedure

; ---------- lang files end

CompilerIf #PB_Compiler_IsMainFile
DataSection
  mylangfile:
  Data.s Chr($FEFF)+"# (c) 2044 Snake Plissken Industries"+#CRLF$+
         "# ##################################"+#CRLF$+
         
         "LANGUAGE_NAME         Deutsch"+#CRLF$+
         "LANGUAGE_NAME_ENGLISH German"+#CRLF$+
         "# ##################################"+#CRLF$+
         
         "APPLICATION_NAME_ENGLISH  The ultimate guide for bug burger gourmets"+#CRLF$+
                                                                                "APPLICATION_NAME  Der ultimative Wegweiser für Bugburger Gourmets"+#CRLF$+
                                                                                "APPLICATION_NAME_SHORT Bugburger Gourmet App"+#CRLF$+
                                                                                "APPLICATION_COPYRIGHT    (c) 2044 Snake Plissken Industries"+#CRLF$+
                                                                                "APPLICATION_ABOUT_TEXT  Linie 1\nLinie 2\nLinie 3\nUsw..\n"+#CRLF$+
                                                                                "APPLICATION_ABOUT_TITLE Über Bugburger Gourmet..."+#CRLF$+
         "# ##################################"+#CRLF$+
                                                                                
         "MENUTITLE_FILE    Datei"+#CRLF$+
                                   "MENUITEM_OPEN     Öffnen"+#CRLF$+
                                   "MENUITEM_CLOSE    Schließen"+#CRLF$+
                                   "MENUITEM_QUIT     Verlassen"+#CRLF$+
                                   "MENUTITLE_EDIT    Bearbeiten"+#CRLF$+
                                   
         "# ##################################"+#CRLF$+
         "# Date format"+#CRLF$+
         "DATE_FORMAT_SHORT %dd.%mm.%yyyy"+#CRLF$+
         "TIME_FORMAT_SHORT %hh:%ii:%ss"+#CRLF$+
         ""+#CRLF$+
         "#### EOF"+#CRLF$
  end_mylangfile:         
  
EndDataSection
  
NewMap Lang.s()  

Catch_Lang(?mylangfile, ?end_mylangfile - ?mylangfile, Lang())

;file$ = OpenFileRequester("Select language file","de-de.lang","lang files|*.lang|All files|*.*",0)
;Load_Lang(file$, Lang())

Debug FormatDate(LANG("DATE_FORMAT_SHORT"),Date())

MessageRequester(Lang("APPLICATION_ABOUT_TITLE"), Lang("APPLICATION_NAME")+#CRLF$+Lang("APPLICATION_COPYRIGHT")+#CRLF$+#CRLF$+Lang("APPLICATION_ABOUT_TEXT"), #PB_MessageRequester_Info)

CompilerEndIf

Little John
Addict
Addict
Posts: 4519
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: Simplest language system

Post by Little John »

Fred wrote: Fri Jun 09, 2023 1:10 pm You can use this one which is very good: viewtopic.php?f=12&t=26729&hilit=language
I totally agree!
I use that (more precisely: GPI's version with Maps) for years now, and I'm very happy with it.
User avatar
HeX0R
Addict
Addict
Posts: 980
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: Simplest language system

Post by HeX0R »

benubi wrote: Fri Jun 09, 2023 4:39 pm If you use XML dialogs for the GUI you could add an attribute to the gadget or window and other elements "lang-id" with the key as value.
No extra attributes needed for dialogs, see here
deeproot
Enthusiast
Enthusiast
Posts: 269
Joined: Thu Dec 17, 2009 12:00 pm
Location: Llangadog, Wales, UK
Contact:

Re: Simplest language system

Post by deeproot »

Fred wrote: Fri Jun 09, 2023 1:10 pm You can use this one which is very good: viewtopic.php?f=12&t=26729&hilit=language
Works for me for years - excellent code from Freak :D
Post Reply