Parented_objects are the basic building block used by the I/O system. The aim of this object is to put in place the structure used across all I/O objects. It is a linked object with the name string added.
object class
\ number of characters in string
cell% instance_variable %%length
\ free buffer containing string
cell% instance_variable %%data_area
m: ( add n -- )
\ just in case getting the data area aborts
0 %%data_area !
DUP %%length !
DUP get_free_buffer
DUP %%data_area !
SWAP MOVE
; overrides :construct
m: ( --)
\ pointer will only be zero if failed ot allocate on a create
%%data_area @ ?DUP IF
0 %%data_area !
kill_free_buffer
THEN
this [parent] :destruct
; overrides :destruct
m: ( addr n --)
DUP %%length !
%%data_area @ OVER resize_free_buffer %%data_area !
%%data_area @ SWAP MOVE
; method :string!
m: ( -- addr n )
%%data_area @ %%length @
; method :string@
\ delete the first n bytes from the start of a buffer
: delete { ( buffer size u --) }{
variable %delete_n }
\ limit to string length things go better
OVER MIN \ buffer length u (--
\ nope we are not going to allow the deletion of charaters
\ from another dimension
zero MAX
%delete_n ! \ addr n(--
OVER \ addr n addr (--
%delete_n @ + \ addr n addr_from
jump
jump %delete_n @ - \ addr n addr_from addr_to n_after
MOVE \ addr n
2DROP
\ if you want to fill end with blanks
\ addr n (--
\ + %delete_n @ - \ addr
\ %delete_n @ \ addr count
\ BLANK
;
\ insert a string at the start of a buffer
: insert { ( iaddr n buffer size --) }{
variable %insert_n }
\ limit the string to the buffer size
ROT \ iaddr buffer size n
OVER \ iaddr buffer size n size
MIN \ iaddr buffer size min
%insert_n ! \ iaddr buffer size
%insert_n @ - \ iaddr buffer cnt_left
OVER \ iaddr buffer cnt_left buffer
DUP %insert_n @ + \ iaddr buffer cnt_left buffer beffer_to
ROT MOVE \ iaddr buffer
%insert_n @ MOVE
;
\ delete u bytes at offset
m: { variable %offset variable %u ( --) }
this :string@ %offset @
/STRING \ add n (--
%u @ delete \ (--
%u @ NEGATE \ string new_len(--
%%length +!
%%data_area @ %%length @ resize_free_buffer %%data_area !
; method :string_delete
\ insert S at offset
m: { ( addr1 u ) variable %offset ( --) }
DUP %%length +!
%%data_area @ %%length @ resize_free_buffer %%data_area !
this :string@ \ addr n buffer n1
%offset @ /STRING
insert
; method :string_insert
\ add S to end
m: ( addr u --)
%%length @ this :string_insert
; method :string+
m: ( indent --)
CR DUP SPACES ." string | " ." Object: " this .h
CR DUP SPACES ." buffer: " %%data_area @ .h
SPACE ." buffer_length: " %%data_area @ buffer_size .h
SPACE ." string length: " %%length @ .h
CR DUP SPACES ." string: " %%data_area @ %%length @ TYPE
DROP send
; overrides :print
end_class string_class