Code: Select all
dim as string r
r = "àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß`abcdefghijklmnopqrstuvwxyz{|}~0@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_"
for i as long = 0 to 127
? r[i]; " ";
Next
Code: Select all
dim as string r
r = "àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß`abcdefghijklmnopqrstuvwxyz{|}~0@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_"
for i as long = 0 to 127
? r[i]; " ";
Next
Code: Select all
U+00E0 à 195 160
U+00E1 á 195 161
U+00E2 â 195 162
U+00E3 ã 195 163
U+00E4 ä 195 164
U+00E5 å 195 165
U+00E6 æ 195 166
U+00E7 ç 195 167
U+00E8 è 195 168
U+00E9 é 195 169
Code: Select all
dim as string * 256 a
Code: Select all
dim as string b = a
Code: Select all
dim as string a = space(256)
Code: Select all
dim as string * 256 a
for n as long=0 to 255
a[n]=n
next
print "a="
print a
print
dim as string b=a
print "b="
print b
print
b=mid(a,1)
print "b="
print b
sleep
Code: Select all
'#include "text128.bas"
/' -- text128.bas (incomplete - 2023 March 3 - by dafhi
'/
'' i kind of know what to expect, but others might want to leave this
'' commented out
'#define im_good
'#include "bitwalker32.bas"
/' --- bitwalker32 - 2023 Mar 1 - by dafhi
bound-safe bit-aligned read & write util
'/
'#include "boilerplate.bas"
/' ------ boilerplate.bas - 2023 Mar 1 '/
'
'' replaces int()
#define flo(x) (((x)*2.0-0.5)shr 1) '' http://www.freebasic.net/forum/viewtopic.php?p=118633
#define ceil(x) (-((-(x)*2.0-0.5)shr 1))
#undef int
#define int as Integer
#define min( a, b) iif( (a)<(b), (a), (b) )
#define max( a, b) iif( (a)>(b), (a), (b) )
const q34 = chr(34) '' double quote
const qqcr = chr(34) + chr(10) '' carriage return
union suspicion_suppressor ' suspicious ptr tango .. i forget who suggested this soludtion
as any ptr a
as ubyte ptr ub
as ushort ptr usho
as ulong ptr ul
as ulongint ptr uli
As Single Ptr s
as double ptr d
End Union
sub change_filename_if_exists( byref filename_out as string, filenum int )
if lof(filenum) > 0 then filename_out = "-" + filename_out
end sub
function ascii_pos( valu as ubyte, pos_curr int, pos0 as ubyte ptr, posE as ubyte ptr ) int
var p = pos0 + pos_curr
while p <= posE
if *p = valu then return p - pos0
p += 1
wend
return posE + 1 - pos0
end function
'
' ----- boilerplate.bas
' ---- bitwalker32.bas continued ..
'
namespace bitwalker32 '' 2023 Mar 1 - by dafhi
type base_literal as ulong
const as byte len_base_literal = len(base_literal) * 8 '' Feb 28
'' -- main type
'
type t
declare constructor( as long = 1, as byte = 8 )
as byte unit_len
as longint bit_pos
as any ptr p_data
declare property cbits as longint
declare sub calc_bytes_req( as long, as byte )
as longint _bit_ubound
as long _byte_ubound
end type
constructor t( c_elems as long, c_bits as byte )
if c_elems < 1 or c_bits < 1 then exit constructor
calc_bytes_req c_elems, c_bits
end constructor
sub t.calc_bytes_req( cElems as long, unit_len as byte)
var k = cElems * unit_len
if k < 1 orelse unit_len > len_base_literal orelse k > 1e9 then
? " bit_walker32.t.calc_bytes_req"
? "unit len: 1 to "; len_base_literal
? "elem count * unit len: 1 to 1e9 (1 Bil)"
sleep 250
exit sub
endif
_bit_ubound = k - 1
_byte_ubound = _bit_ubound \ 8
this.unit_len = unit_len
bit_pos = 0
end sub
property t.cbits as longint
return _bit_ubound + 1
end property
' --- internal read / write support - Feb 28
'
sub _wri( byref des as base_literal, shifted_val as base_literal, shifted_mask as base_literal )
des = (des and (-1 xor shifted_mask)) or (shifted_val and shifted_mask)
end sub
dim as byte _bit_offset
dim as long _byte_pos
dim as base_literal _mask
dim as suspicion_suppressor _sp
sub _bounds_check( byref v as t, bit_pos as longint, unit_len as byte )
var pos0 = max( bit_pos, 0)
var posE = min( bit_pos + unit_len - 1, v._bit_ubound)
_byte_pos = pos0 \ 8 '' integer divide
_bit_offset = pos0 - _byte_pos * 8
_mask = 2 ^ max(posE + 1 - pos0, 0) - 1
_sp.a = v.p_data + _byte_pos '' "any" ptr
end sub
' -------
'' read functions
function rea( byref v as t ) as base_literal '' Mar 1 - old name: r
_bounds_check v, v.bit_pos, v.unit_len
v.bit_pos += v.unit_len
return ((*_sp.ul shr _bit_offset) or _
(_sp.ul[1] shl (len_base_literal - _bit_offset))) and _mask
end function
function probe( byref v as t, bit_pos as longint, read_len as byte) as base_literal
swap bit_pos, v.bit_pos
swap read_len, v.unit_len
var ret_val = rea(v)
swap bit_pos, v.bit_pos
swap read_len, v.unit_len
return ret_val
end function
'' write subs
sub wri( byref v as t, valu as base_literal) '' Mar 1 - old name: w
_bounds_check v, v.bit_pos, v.unit_len
'' lo 4 bytes
_wri *_sp.ul, valu shl _bit_offset, _mask shl _bit_offset
'' hi 4 bytes
_wri _sp.ul[1], valu shr (len_base_literal - _bit_offset), _
_mask shr (len_base_literal - _bit_offset)
v.bit_pos += v.unit_len
end sub
sub doodle( byref v as t, valu as ulongint, bit_pos as longint, write_len as byte )
swap bit_pos, v.bit_pos
swap write_len, v.unit_len
wri v, valu
swap bit_pos, v.bit_pos
swap write_len, v.unit_len
end sub
end namespace ' --- bit_walker32
' -- text128.bas continued ..
'
namespace text128 ' -- bin / text converter March 3 - by dafhi
type encode_info
declare constructor( as string = "" )
as string original_name
as string encoded
as string formatted
as string err_msg
as ubyte file(any)
end type
constructor encode_info( original_filename as string )
original_name = original_filename
end constructor
dim as byte backref(255)
dim as string r '' forum-friendly ascii table attempt
dim as long init_index
sub _init_loop( lo as ubyte, hi int = -1 )
if init_index > 127 then exit sub
if len(r) = 0 then r = space(128)
var _step = 1
if hi < 0 then hi = lo
if hi < lo then _step = -1
for i as long = lo to hi step _step
if init_index < 128 then
r[ init_index ] = i
init_index += 1
endif
next
end sub
sub _fill_string_and_backref
if init_index > 127 then exit sub
_init_loop 35, 38 '' 39, freebasic comment symbol
' _init_loop 48, 255
_init_loop 48, 126
_init_loop 161, 255
' _init_loop 254
' _init_loop 174, 193
' _init_loop 255, 177
' _init_loop 195, 255
' ? init_index
for i int = 0 to 127
backref( r[i] ) = i
' ? r[i]; " "; i; " ";
Next: ?
End Sub
' ------- raw encode / decode subs
'
sub encode( p_src as any ptr, cbytes_in int, byref result as string )
_fill_string_and_backref
var c_expanded = (cbytes_in * 8 + 6) \ 7 '' integer divide
result = space( c_expanded )
dim as bitwalker32.t walk_src = type( c_expanded, 7 )
walk_src.p_data = p_src
for i int = 0 to c_expanded - 1
var k = bitwalker32.rea( walk_src )
result[i] = r[k]
next
end sub
sub decode( p_src as any ptr, cbytes_in int, des() as ubyte )
_fill_string_and_backref
dim as bitwalker32.t walker_dest = type( cbytes_in, 7 )
redim des( cbytes_in * 7 \ 8 - 1 )
walker_dest.p_data = @des(0)
dim as suspicion_suppressor src = type( p_src )
for i int = 0 to cbytes_in - 1
var k = backref( *src.ub )
bitwalker32.wri walker_dest, k
src.a += 1
next
end sub
'
' ---------- raw encode / decode
sub encode_str_from_file( filename_in as string, byref ret as encode_info )
ret.err_msg = ""
open filename_in for input as #1
'' this sub's pretty safe
'' simple size checks ..
var ilen = lof(1)
if ilen < 1 then
ret.err_msg = "encode_str_from_file, no data: " + filename_in
endif
if ilen > 50000 then
ret.err_msg = "encode_str_from_file: input file must be < 50K"
endif
'' close file and exit if error
if len(ret.err_msg) then
print ret.err_msg
close #1: sleep 250: exit sub
endif
'' no error .. toss entire file into array (current safety 50K bytes)
redim ret.file( ilen - 1 )
get #1,, ret.file()
close #1
'' my raw subs seem stable
encode @ret.file(0), ilen, ret.encoded
'' fill out remaining type data
ret.original_name = filename_in
ret.err_msg = ""
end sub
' ------------ support
'
function _build_from_data_statements( byref ret as encode_info ) as string
'' This sub was difficult to conceptualize.
'' safety checkpoint #1
dim as long len_formatted = len(ret.formatted)
if len_formatted > 1e6 orelse len_formatted < 1 then _
ret.err_msg = "_build_from_data_statements .. string size out of range: " + str(len_formatted): _
sleep 250: return ""
'' recognize boundary of formatted-data string
var ptrE = @ret.formatted[len_formatted - 1]
var ptr0 = @ret.formatted[0]
'' find first two double quotes
var i = ascii_pos( 34, 0, ptr0, ptrE )
var j = ascii_pos( 34, i+1, ptr0, ptrE )
'' first string: filename
var filename_out = mid( ret.formatted, i+2, j-i - 1 )
'' encode string is formatted-data string ..
'' .. minus data statements, quote marks, filename
ret.encoded = ""
var length_checkpoint = 0 '' added safety
do
'' tricky. if i was smarter i could maybe
'' do with less if statements
i = ascii_pos( 34, j+1, ptr0, ptrE )
j = ascii_pos( 34, i+1, ptr0, ptrE )
if i = j then exit do
var ilen = max(j-i - 1, 1)
length_checkpoint += ilen
'' 'unlikely' but i can't be too sure at this point
if length_checkpoint > len_formatted then
ret.err_msg = "_build_from_data_statements: build grew too large"
return ""
endif
'' build string
ret.encoded += mid( ret.formatted, i+2, ilen )
loop
'' laptop didn't explode?
ret.err_msg = ""
return filename_out
end function
'
' ------- support
sub data_statements_from_file( filename_in as string, byref ret as encode_info, string_width as ubyte = 65 )
'' sub was somewhat easy to conceptualize.
'' first i make raw encode from previously-examined sub
encode_str_from_file filename_in, ret
'' oddly enough, i can pass a string param 2 (above)
'' error check
if len(ret.err_msg) then _
print ret.err_msg: sleep 250: exit sub
'' FreeBASIC statement: Data ".."
const qData = "Data " + q34 '' double quote
'' first entry - filename
ret.formatted = qData + filename_in + qqcr
'' break up encode and slap on Data statements
var pos_read = 0
while pos_read < len(ret.encoded)
var pos_next = min(pos_read + string_width, len(ret.encoded))
dim as string q = space( 65 )
q = mid(ret.encoded, pos_read+1, pos_next - pos_read)
' ? len(q)
ret.formatted += qData + _
q + qqcr
pos_read = pos_next
wend
#ifdef im_good
#else
print ret.formatted
print "length: "; len(ret.encoded)
print
print q34 + "im_good" + q34 + " undefined, so i printed would-be contents here."
#endif
end sub
function reconstruct_from_encode( byref ret as encode_info ) as string
var filename_out = ret.original_name'_filename_from_string( name_plus_encode )
var f = freefile
open filename_out for input as f
change_filename_if_exists filename_out, f
close f
ret.err_msg = ""
if len(ret.encoded) > 50000 then _
ret.err_msg = "file_from_encode_str: input string > 50K"
if len(ret.err_msg) then _
print ret.err_msg:sleep 250: return ""
decode @ret.encoded[0], len(ret.encoded), ret.file()
' ? len(ret.encoded)
' ? ubound(ret.file)
if ubound(ret.file) > 50000 then _
ret.err_msg = "file_from_encode_str: output string > 50K"
if len(ret.err_msg) then _
print ret.err_msg:sleep 250: return ""
'open filename_out for output as #1
' put #1,, ret.file()
'close #1
ret.original_name = filename_out
print
print "suggested filename: "; filename_out; ". data restored to <UDT>encode_info.file()"
return filename_out
end function
end namespace ' --- text128
'' problematic zone .. some of the chars are read as unicode,
'' which messes up decode
sub read_fb_data( byref ret as text128.encode_info )
read ret.original_name
ret.encoded = ""
dim as string q
do
read q
ret.encoded += q
loop until q = ""
end sub
'const qEnd = "<EOF>" '' Prettification
'' visual inspection of byte vals
sub first_few_vals( p0 as any ptr, ilen int = 5, mesg as string)
? mesg
dim as ubyte ptr a = p0
for j as ubyte ptr = a to a + ilen - 1
? (*j); " ";
next: ?
' ? qEnd
end sub
' -- codez
'' all-ascii-vals string
dim as string source = space( 256*1 )
for i int = 0 to len(source) - 1
source[i] = i
next
var myfile = ""
'' i feed udt into my encoder
dim as text128.encode_info encode_info = type(myfile)
#if 0 '' visual source ascii inspection
first_few_vals @source[0], 50, "original"
#endif
text128.encode @source[0], len(source), encode_info.encoded
'' set to 0 to have it write "forum.txt"
#if 1 '' Data statement read into string
#if 1 '' visual encoded text inspection
first_few_vals @encode_info.encoded[0], 50, "encoded"
' first_few_vals @encode_info.encoded[0], len(encode_info.encoded), "encoded"
#endif
read_fb_data encode_info
#if 1
?
first_few_vals @encode_info.encoded[0], 50, "-- concat attempt from data statements --"
#endif
#else '' create freebasic data statements
open "forum.txt" for output as #1
put #1,, source
close #1
myfile = "forum.txt"
var string_width = 65
text128.data_statements_from_file myfile, encode_info
open "forum.txt" for output as #1
put #1,, encode_info.formatted
close #1
#endif
Data "forum.txt"
Data "#%4DlL$&3<P|\$o2:Jl4M°06AXªl=or9HfÆÆ$P4=Ot@]À0v@V¤\·°³7D]²xM¡ryGd"
Data "À¶§oS;Kk#1>`4}Nr:MvP·>RyHi%Av¢U¢V§f1WBY©dÃÀÃ7¦\°r=W´ºE`·¢Y±¤y©c¾°"
Data "uGsZIgž³¡c;jÌÌ$8T¾Ln19JpD}°q8GfÊ4^Pu?U¤`Ç>´xFcÀº·ÁS|Mq:Q¨¢·¡T¡V"
Data "«vaW¥[¯rAgB»¨b½°yWÅZ¬iËÌ1H¦¾¯p7Gj8e^³wEcÄÊE¶~S¡Z»Èaº§a½´«©Å½®o7K"
Data "zheÁµ}S¥jIÉļo;[ÌhÈûsKÌËÊÉÉÍ;"
Code: Select all
const q34 = chr(34)
const q10 = chr(10)
const qdata = "Data " + q34
dim as string build_string
for i as long = 0 to 255 step 16
dim as string * 16 a
for j as long = 0 to 15
a[j] = i + j
next
build_string += qData + a + q34 + " " + str(i+15) + q10
next
open "forum.txt" for output as #1
put #1,, build_string
close #1
/'
Data "" 15
Data "" 31
Data " !"#$%&'()*+,-./" 47
Data "0123456789:;<=>?" 63
Data "@ABCDEFGHIJKLMNO" 79
Data "PQRSTUVWXYZ[\]^_" 95
Data "`abcdefghijklmno" 111
Data "pqrstuvwxyz{|}~" 127
Data "€‚ƒ„…†‡ˆ‰Š‹ŒŽ" 143
Data "‘’“”•–—˜™š›œžŸ" 159
Data " ¡¢£¤¥¦§¨©ª«¬®¯" 175
Data "°±²³´µ¶·¸¹º»¼½¾¿" 191
Data "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏ" 207
Data "ÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß" 223
Data "àáâãäåæçèéêëìíîï" 239
Data "ðñòóôõö÷øùúûüýþÿ" 255
'/
Code: Select all
dim as string z0 = " !" ' 2 (Len)
dim as string z1 = "#$%&" ' 4
dim as string z2 = "()*+,-./" ' 8
dim as string z3 = "0123456789:;<=>?" ' 16
dim as string z4 = "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_" ' 32
dim as string z5 = "`abcdefghijklmno" ' 16
dim as string z6 = "pqrstuvwxyz{|}~" ' 15
dim as string z7 = "€‚ƒ„…†‡ˆ‰Š‹ŒŽ" ' 13
dim as string z8 = "‘’“”•–—˜™š›œžŸ" ' 14
dim as string z9 = " ¡¢£¤¥¦§¨©ª«¬®¯" ' 15
dim as string zA = "°±²³´µ¶·¸¹º»¼½¾¿"
dim as string zB = "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏ"
dim as string zC = "ÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß"
dim as string zD = "àáâãäåæçèéêëìíîï"
dim as string zE = "ðñòóôõö÷øùúûüýþÿ"