text128 beta - April 11

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

text128 beta - April 11

Post by dafhi »

Code: Select all

/' -- text128 beta - 2023 April 11 - by dafhi
  
  bin <-> base-128 text encoder
  
  this project lets you save a file as comments.
  
  for example, save the lightning.zip line (below) as "forum.txt" ..
  where fbc creates exes.  Demo will decode and save lightning.zip

lightning.zip"r8/Bb¦   2 r[»DMm~Zcc°#  ´Á  B$   Rmº.<\²t[]ªgzR·lª|»µHE2ijOKa)EPK$ÀR0´®kmVÀ¾?wxvwxD®Å¸$|(¯)6:r }C`¾Á=]_½\ºXG©&ª`n»?]ª°o}qsw7,7Tgl.uN¾StkI·1­,&^c]¸m©,½Á¬}±szzmFa¸eA¾CD}gNu(N¿©D/¬,]6PV®0|zOK6j¹¾#G¯Fª5D@#*bPXmg~nYtDh¦TF¸:CÀG)©z¬j~[QXfO3m&¦6¡Qx,itm:=¿bi½[¬reÀ!U½Jv®6.©t©YÅdf^nZuDdjªKxJ6k¯G]gl4M|¾BWIW@A]-®baA0m]­~F]{dwW5m&a9$P³l«¡Xy5r\=_º;|5®/{D/¬&G·/m/º3­VlQ¡_¿¸¸¨¡Mk¶xJIE²~°~&X0º³@H©uHsfS©F½·©/£ÅÄ·»²!«AÄo³`·¿a¾Og©£T8Å\&^s£Uxb9HX/¸ÄQ¬.^½g¹B´§GÁM­«C0<¦T>¬/\*af<Á@.µE{<nM«A<·®z¬U¶zs°I·84>V¯H«qV\«D8¥Ä|W¯ºB$Åc{º3>D¿,>1ªµ I])½J5O¨S±+¿G-flG¨Ckv4{/¶]RG@Y¿°~cy£l°>v¶|À:e­>$UM¼v¹¹iDg²Å¬)a-¢¦=«NnRY¯´I3±ª®az±WFh¿/[m#»P¦(G?¨$P#¯¯¨`?¹°¤$z\g(RJF«,½iºc/1¬h½Y¥$f0T½i°Q½Cgk.¡-z­/¶)²$94Z{¯·#¿®IA´¤u;{Lªp»Cª=9º©\KfF¾Zy/@7L³­_rF¢W¯<Á¦°x_zFNz]¹OhoWW2Zn<9<Äy­7GLH}T(B7}?ÅV??«¿h §4xelFgtN+oDg!fRM¯=|[b¹eOe2jIz¾Z¯®e¹:PhÁ<.¬¢a/0T8_ÅmyC9¦ShK¯³:H^HrU]¥8cO%*r3Z;\*¾*&Dxn*n0¿5FbCs==«28!o}©$]U$w*¸¿U$£yG >q,¤BÁ*°»o¤z:(4BxD8x>2xXh©Äfrb0o67pÀ>{yÀc9~¯Fc°¡,¶ÁKb³£,rY ¼,/G·Å{`V3»kA5QOp9q`³*²gU_U4®¿£|zª¡RUq¥TWd@O}§Vº(o³}/l/4;½µ¸`³¯rÄU¿R«4¶?)¥1}!h§¾uquÁ¯ªFº/¯NeÀ2<^tdJkDwcjV£O}fJ3)G!CT¢h±_zkv¨\dY `q«§2t]B¤eIcB{Dx8K¶t[ofn5{oXzGº+½<½)zrU0.M,± ¤7¶·¢%»Gn¢l%X6¯!R0nÀv»{mªTu¢(±JM)d~p·98l\u4·H¶§¡x°¥¨|j@+Q3Ä¿°5T4qsSz]°E.B9=72¸-NT@)4Uod²!KLdF¼N8!%*¨_[{±n*?<i¦¸HLR<ZyEn5sÅCo®Y*R;w\­°N¡p+aeI+x¨*¼HN¼l½´I¯·rx1¶}¶qq®¥vp@¹lZ¡{IbµB0Z<hVb¹[ºpc@°d8¼VTOr=^pw¹{sW¥S¾]Laj3N´<|&T ¾« ®ÁºgM»XhNj¾¬&oG;h2¶Z¢<Mb¥x/VqH¼d¹.¬0²ºd73Än§vy#7ÁG´LvªT-L3rR?4¤JqMYD+,¼Q«X~¹rZ)³xi=¢Á-§·MÀUW&c<f¬|\_MIÅb.e¿);6V¯¹DÁ¶rqdgºob}¹s/¡B%w>nhwSnX)i1I3¼;dV¢i´ª6dK9°_|Ae£=©R»£Tz=©R»£R:{A+r5T^c;Z«¿S^¿McX<|µ¶G6Aq/7UgHz§²k8E^w7dX´e8µ)y®µu;fG1e/AT&·ª~,$amSY_H2Eµsw¼z;{n<gsP&¡ªkpu±~ªiµ<­Z];²¢¥4RÅU º«¹½¸l7<U6>%u&¤Jxo¯\J{Q¦;Oz¥¦i>Ÿx¥f»V¯[µV^«dµµlZ<·d«$¹M`©M=gW@U+bj6m$±`>%2SyI½DW1o?l*i4T@­<+/¶`0Ty±0·<.I¯o´Pwz1h¼cK0z]$¯(µ9=M§Gd^>°>³3¿¨²NE@}gt8vH¯¥¶©NU»§¼;¤d¹DBX¾I,~¤7o<UXD¸x|u;d¸1>OW}Y/]QMvWu©I9wZY#TiCºP%+QWa|s4$j9¶ns@ZJR©-¹z1<µº]·²`Y®±»VYQ³>;Gh9?º¶Ä¯VºF0¾¶UN¿¡fJI¾)yÄ ~¥«c£qy¦­^;nGSW*\;pµI;p\¾_½7ÁJ-fQ1«,U­e¦)>3FS½Jd&¶mCv4A¡Lº$ÀC®55·±¿VeaO§ÀS§aÅ<.£®?#,/¹³+³°Á2sv`y gui­z>¤WF/·c0%Ka/jaT¯»?arS¢©AÁ¹1ľ½mÅ·£f^ÄV-wQL. růAx!xw\;O­»EÁ½ya«C^5]¤Ip¯FB½dji-¿-V=±rLsc¥h~ªACn(J¹RvZr>¤NµsG{C=¡w\#X$y[*_.y*²-¹»*2(R³Vo4Y7R¯©{HDV²½´=NBºe­BÁn´d¦@5©%8M4L½Od:I.y±#S}9.y»f#|%c}X­( ¶x*qw³ ½º¥º¨W$©LÄsg®t.)Q¨-o¡*4¦M¼hc ±À7¤)®N®UE¬1KyhzD%m¬j&®Tvc±®iº¸3m=f?«s­#qªÄÀX»zQu>`¡h:a£©^VRDuJ=_d>d[-­À±K¦XoIOKG2K¢@¡¯FÁ%x[Äe_¤Y=g~~Q¨£5]u>qR6.g4¹EMD«´®¾«3Å.²~TTIND¥¨EZj Zk0oµTH@dYH=bZw)W2P`Km¿uQ`+ZNªNV¯iG/oH°mqu=r)6@=6|Å$cUK5G°=¢Uc³¼C¸\${iDb5«G²U[o@X0¦2§2J#°¿²¢$4?i¨º^\T´Ao¸»ItI&³>3p6p¸T#j¦pNk[Á¬l[4Á¨kZXmG«X)al­H6µvfh!TZ¸#Kº¸sN&{)t5P³hLtnÅ``yr*Cn,tjC<?f+¶nDF¨Ni5I`/¢f^I?¡N8½Ty:bP(BI6o>tl;Hx.v$·«j!95´(BQ®D;2r?D fBGrÅxÁ).½VOR¯­{o~¹GiSµ1NW{Lf¨¼!),Tgjr~mqb{-G[Z;[&DE«+MY+_.½ZbÀ%4Z³·/1l¤r«S*¤olo\k$°>vG=3f*sm¤¦³&H+XÄ»/=J²:F£S¬QgL_JU]«=`mU¡3\z¦e©¦kP1¸¡uº7^iL©§m«Q¿:p¡.V8¨8%*R4OpÀOÅM©tF¦hp¤¾:ªuV^¾2|¢@)tv~m|G¯¨,XX|,Sr[=v%¹h¯*fX{Dy_uu=°AVt¿TW^VG8-wh3Sbc_o]_.D¸rL&M)½2§©Pªpº»¹n7L[6¤|zd>®³¯~\-~W©a8­uF<5«j¿¾zv7\«>B`Ui,R%`\±+Àv«cQ}$©»2§¢IttdE4¤un<©¸jIyc:¿<_ŧX¹f9KyYo9Q%:{=W1B¸VG=ÁLµ¹h0,#Bj©¾t&/Y^29A?Ev7}$&H¸!ª/Y/µbÁZ´DV¶8¡<²rN´>6ª#W:12ok®!6»_Gn2Gp±|6¤º@ĸpºAtX9~4¾b~ÄW¹@=$¤¼Å,«©«6¸53L&¾:®!À8·®»(V¯CY V_pO¼z­¡U7E¿V/~xw»BEK?E¨¦fÄyArg&GZ.Å:°ª¤i4TP&+ME­,~I@N]¨¬<¹mBz ½a£¸)XW+X]o¯°bs}Á;5}aO£2Á;@A°¸¥1XÁ§ª²n(SN|¶¶KaaxJ>9+:»b;ÄK\Ceu°$JU+.=^D¾Q?Lf¬¼]¬³« CQoVF;Nzyb$ad¹eÁ·guC1n:¥nLVR%h.#¥:)]%.wPd=d¬°(t*F>Wt/¼¯-³À½}Q3·d?,r}(o®S·znW%©JgE¨-ª$I°7¶sÀ8¶I8ey¥o`S¨¡¯K2k#pUKÄ>OfsPh E_µU§cpqs&u]!R)x+<F|iTN¶C³8wS;K8¹4_±·Å=vG!%À;b¦   2 r[»DMm~Zcc°#  ´Á  B$ F        b °@2    Rmº.<\²t[]ªgzR·6  #     %  $  ®¤SbrOº  ^v+!C}°! J$i!dX{$b|vb!    * B  £   ´µ#     

  - See line 215 to create your own encoding
    
    
    - other highlights -
  
  1. 186 semi-friendly characters for reference

  2. automatic "-" pre-pend if restore conflict
  
  3. some environments unicode strings during copy-paste,
   i created _partial_restore_asc() to restore
  
   update:
  newest lightning
  
'/


' ---- boilerplate
sub change_filename_if_exists( byref filename_out as string ) '' March 5
  var f = freefile
  open filename_out for input as f
  if lof(f) > 0 then filename_out = "-" + filename_out
  close f
end sub


  namespace text128 ''  A base-128 text encoder
  
''
dim as string err_msg
dim as string encoded
dim as string filename

function err0r as boolean
  if len(err_msg) then print err_msg: sleep 250: return true
  return false
end function

sub _partial_restore_asc( byref s as string )
  dim as long i_read, i_write
  var e = len(s) - 1 '' March 13
  e += (s[e] = 10) or (s[e] = 13)
  e += (s[e] = 10) or (s[e] = 13)
  while i_read < e + 1
    var ascii = s[i_read]
    var my_bool = ( ascii = 194 ) or ( ascii = 195 )
    i_read -= my_bool '' freebasic true = -1
    s[i_write] = s[i_read] - 64 * ( ascii = 195 )
    i_write += 1
    i_read += 1
  wend
  s = left( s, i_write )
end sub

'' Mar 12 - removed ascii chars 194 & 195 from q2
'' Mar 8 - removed comment symbol &'( from q0
const q0 = " !#$%&()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_"
const q1 = "`abcdefghijklmnopqrstuvwxyz{|}~¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿À"
const q2 = "ÁÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"

dim as ubyte    initialized', table(127) '' March 28
dim as ubyte    backref(255)

dim as string   r, bin_origin '' March 13

sub _initialize_table
  if initialized then exit sub '' March 16
  r = q0 + q1 + q2
  _partial_restore_asc r
  for i as long = 0 to 127 '' March 13
'    table(i) = r[i]       '' March 28
    backref( r[i] ) = i
  next
  initialized = true '' March 16
End Sub


const cbytes_origin_max = 90000

dim as ubyte decoded()


sub _read_file( byref _filename as string )
  
  err_msg += ", _read_file: "
  
  open _filename for input as #1
  var ilen = lof(1)
  var max_size = cbytes_origin_max
  if ilen < 1 or ilen > max_size then
    err_msg += _filename + " > " + str(max_size) + " bytes, or no file found"
    close '' March 18
    exit sub
  else
    bin_origin = space( ilen )
    get #1,, bin_origin
  endif
  close
  filename = _filename
  err_msg = ""
  
end sub


/' 
  encode creates the data
  save creates a file
'/
sub encode( filename as string )

  err_msg = ".encode"
  _read_file filename
  if err0r then exit sub
  
  print "encoding .."
  _initialize_table
  
  encoded = filename + chr(34) '' double quote

  dim as long ibit, ides = len(encoded)
  
  encoded += space( (8 * len(bin_origin) + 6 ) \ 7 )
  
  while ides < len(encoded)
    var ibyte_src = ibit \ 8 '' integer divide
    dim as ushort ptr usho = cast( any ptr, @bin_origin[ ibyte_src ] )
    var bit_offs = ibit - 8 * ibyte_src
    encoded[ides] = r[( *usho shr bit_offs) and 127] '' March 28
    ibit += 7
    ides += 1
  wend

end sub

sub save( text_filename as string )
  if len(err_msg) then exit sub
  
  open text_filename for output as #1
  put #1,, encoded
  close
  
  print "saved to "; text_filename
end sub

'' utility
sub _restore_7bits( des() as ubyte, ibit as long, src as ubyte )
  var ibyte = ibit \ 8
  var offs = ibit - ibyte * 8
  dim as ushort ptr usho = cast( any ptr, @des( ibyte ) )
  *usho or= 127 shl offs '' zero-out dest bits
  *usho xor= 127 shl offs
  *usho or= (backref(src)) shl offs
end sub


'' encoded file includes original filename

sub decode( file_in as string )

  err_msg = ".decode"
  
  _read_file file_in
  if err0r then exit sub
  
  dim as long j
  for i as long = 0 to len(bin_origin) - 1
    if bin_origin[i] = 34 then j = i: exit for
  next
  
  if j = 0 or j > 60 then err_msg = ".decode: original filename not detected"
  if err0r then exit sub
  
  print "decoding.." '' March 16.u2 - these 3 lines previously followed
  _initialize_table  '' .. the filename_out section below
  _partial_restore_asc bin_origin
  
  dim as string filename_out = space( j )
  for i as long = 0 to j - 1
    filename_out[i] = bin_origin[i]
  next
  
  var cbytes_in = len(bin_origin) - 1 - j
  redim decoded( cbytes_in * 7 \ 8 - 1 )
  
  var ibit_des = 0
  for i as long = j+1 to len(bin_origin) - 1
    _restore_7bits decoded(), ibit_des, bin_origin[i]
    ibit_des += 7
  next

  change_filename_if_exists filename_out
  open filename_out for output as #1
  put #1,, decoded()
  close
  
  print filename_out + " created."
  
end sub

end namespace


#if 1 '' 0 - encode, 1 - decode

  text128.decode "forum.txt"

#else
  
  var myfile = "lightning.zip"
  
  text128.encode myfile
  text128.save "forum.txt"

#endif
Post Reply