RSC File Reader

GFA BASIC-related articles in here please

Moderators: exxos, simonsunnyboy, Mug UK, Zorro 2, Moderator Team

User avatar
charles
10 GOTO 10
10 GOTO 10
Posts: 2057
Joined: Tue Aug 17, 2004 12:11 am
Location: ont. Canada
Contact:

RSC File Reader

Postby charles » Thu Oct 19, 2017 2:07 pm

I think this is kinda cool .
over the past years ive made many .rsc files.
when going back to projects its difficult to remember the
flags state spec
of these object ,
so I wrote this small listing to decipher the data for myself ....

plan is eventually further develop this listing to save the data as a .ascii /.lst file
therefore I can embed rsc data into gfa programs ...

Code: Select all

' sof
'
SAVE "a:\rscsift.gfa"
LIST "d:\rscsift.lst"
KILL "A:\*.BAK"
' DUMP "" TO "d:\vars.lst"
'
RESERVE ((FRE(0) DIV 2) DIV 256)*256
'
DEFFILL 1,2,4
PBOX 0,0,WORK_OUT(0),WORK_OUT(1)
'
' ==variables
'
path$=""
item$=""
file$=""
exten$=""
title$=""
default$=""
'
a%=0
o.next%=0
o.head%=0
o.tail%=0
o.type%=0
o.flags%=0
o.state%=0
o.x%=0
o.y%=0
o.w%=0
o.h%=0
o.spec%=0
b%=0
flen%=0
'
x&=0
type&=0
spec&=0
a&=0
x.&=0
fram_spec&=0
xx&=0
pos&=0
'
drive|=0
'
' ==allocation
default$=STRING$(&H20,0)
path$=STRING$(&H40,0)
file$=STRING$(&H80,0)
'
DIM ted&(13)
DIM bit&(6)
DIM user%(1)
DIM icon&(17)
'
' ===================================================
make_path
main
' ===================================================
'
~RSRC_FREE()
'
ERASE ted&(),bit&(),user%(),icon&()
'
CLEAR
'
RESERVE
'
END
'
' ====PROCEDURES====
'
> PROCEDURE main
  '
  MID$(path$,1)=LEFT$(path$,RINSTR(path$,"\"))+"*.RSC"
  '
  FILESELECT path$,default$,file$
  '
  IF file$<>"" AND MID$(file$,RINSTR(file$,"."))=".RSC"
    '
    MID$(path$,1)=LEFT$(file$,RINSTR(file$,"\"))+"*.RSC"
    '
    ~RSRC_LOAD(file$)
    ~RSRC_GADDR(0,0,a%)
    '
    treehop
    '
  ENDIF !{rsc disk load}
  '
RETURN
'
> PROCEDURE treehop
  '
  xx&=0
  WHILE a%>0
    '
    ~OBJC_DRAW(a%,0,99,0,0,0,0)
    ~INP(2)
    '
    objecthop
    '
    INC xx&
    ~RSRC_GADDR(0,xx&,a%)
    '
  WEND
  '
RETURN
'
> PROCEDURE objecthop
  '
  x&=0
  '
  REPEAT
    '
    CLS
    ' ========
    o.next%=OB_NEXT(a%,x&)
    next
    o.head%=OB_HEAD(a%,x&)
    head
    o.tail%=OB_TAIL(a%,x&)
    tail
    '
    ' =========
    o.type%=OB_TYPE(a%,x&)
    type
    o.spec%=OB_SPEC(a%,x&)
    spec
    o.flags%=OB_FLAGS(a%,x&)
    flags
    o.state%=OB_STATE(a%,x&)
    state
    '
    ON spec& GOSUB boxinfo,tedinfo,address,bitblk,userblk,iconblk
    '
    ' =========
    o.x%=OB_X(a%,x&)
    x_axis
    o.y%=OB_Y(a%,x&)
    y_axis
    o.w%=OB_W(a%,x&)
    width
    o.h%=OB_H(a%,x&)
    height
    '
    ~INP(2)
    '
    ADD x&,1
    '
  UNTIL o.next%=0
  '
RETURN
'
> PROCEDURE make_path
  drive|=GEMDOS(&H19)
  MID$(path$,1)=CHR$((ASC("A")+drive|))+":"+DIR$(drive|+1)+"\"
RETURN
'
'
> PROCEDURE next
  PRINT o.next%;" ";
RETURN
'
> PROCEDURE head
  PRINT o.head%;" ";
RETURN
'
> PROCEDURE tail
  PRINT o.tail%;" "
RETURN
'
> PROCEDURE type
  '
  '  PRINT o.type%;" ";
  '
  SELECT o.type%
    '
  CASE 20                 !g_box       boxinfo
    spec&=1
    PRINT "g_box> ";
  CASE 25                 !g_ibox      boxinfo
    spec&=1
    PRINT "g_ibox> ";
  CASE 27                 !g_boxchar   boxinfo
    spec&=1
    PRINT "g_boxchar> ";
    '
  CASE 21                 !g_text      tedinfo
    spec&=2
    PRINT "g_text> ";
  CASE 22                 !g_boxtext   tedinfo
    spec&=2
    PRINT "g_boxtext> ";
  CASE 29                 !g_ftext     tedinfo
    spec&=2
    PRINT "g_ftext> ";
  CASE 30                 !g_fboxtext  tedinfo
    spec&=2
    PRINT "g_fboxtext> ";
    '
  CASE 26                 !g_button    address of the string
    spec&=3
    PRINT "g_button> ";
  CASE 28                 !g_string    address of the string
    spec&=3
    PRINT "g_string> ";
  CASE 32                 !g_title     address of the string
    spec&=3
    PRINT "g_title> ";
    '
  CASE 23                 !g_image     bitblk
    spec&=4
    PRINT "g_image> ";
    '
  CASE 24                 !g_userdef   userblk
    spec&=5
    PRINT "g_userdef> ";
    '
  CASE 31                 !g_icon      iconblk
    spec&=6
    PRINT "g_icon> ";
    '
  ENDSELECT
  '
RETURN
'
> PROCEDURE spec
  '
  SELECT spec&
    '
  CASE 1           !g_box g_ibox g_boxchar               boxinfo
    PRINT "boxinfo ";
    '
  CASE 2           !g_text g_boxtext g_ftext g_fboxtext  tedinfo
    PRINT "tedinfo ";
    '
  CASE 3           !g_button g_string g_title            address of the string
    PRINT "address ";
    '
  CASE 4           !g_image                              bitblk
    PRINT "bitblk ";
    '
  CASE 5           !g_userdef                            userblk
    PRINT "userblk ";
    '
  CASE 6           !g_icon                               iconblk
    PRINT "iconblk ";
    '
  ENDSELECT
  '
  PRINT
  '
RETURN
'
> PROCEDURE flags
  '
  '  PRINT o.flags%;" ";
  '
  IF BTST(o.flags%,0)
    PRINT "selectable ";
  ENDIF
  IF BTST(o.flags%,1)
    PRINT "default ";
  ENDIF
  IF BTST(o.flags%,2)
    PRINT "exit ";
  ENDIF
  IF BTST(o.flags%,3)
    PRINT "editable ";
  ENDIF
  IF BTST(o.flags%,4)
    PRINT "radiobutton ";
  ENDIF
  IF BTST(o.flags%,5)
    PRINT "lastobj ";
  ENDIF
  IF BTST(o.flags%,6)
    PRINT "touchexit ";
  ENDIF
  IF BTST(o.flags%,7)
    PRINT "hidetree ";
  ENDIF
  IF BTST(o.flags%,8)
    PRINT "indirect ";
  ENDIF
  IF o.flags%=0
    PRINT "!!no FLAGS!! ";
  ENDIF
  '
  PRINT
  '
RETURN
'
> PROCEDURE state
  '
  '  PRINT o.state%;" "
  '
  IF BTST(o.state%,0)
    PRINT "selected ";
  ENDIF
  IF BTST(o.state%,1)
    PRINT "crossed ";
  ENDIF
  IF BTST(o.state%,2)
    PRINT "checked ";
  ENDIF
  IF BTST(o.state%,3)
    PRINT "disabled ";
  ENDIF
  IF BTST(o.state%,4)
    PRINT "outlined ";
  ENDIF
  IF BTST(o.state%,5)
    PRINT "shadowed ";
  ENDIF
  IF o.state%=0
    PRINT "!!no STATE!! ";
  ENDIF
  '
  PRINT
  '
RETURN
'
> PROCEDURE x_axis
  PRINT "X= ";o.x%;" ";
RETURN
'
> PROCEDURE y_axis
  PRINT "Y= ";o.y%;" ";
RETURN
'
> PROCEDURE width
  PRINT "W= ";o.w%;" ";
RETURN
'
> PROCEDURE height
  PRINT "H= ";o.h%;" "
RETURN
'
'
> PROCEDURE boxinfo
  '
  PRINT "B O X I N F O ";BIN$(o.spec%)
  '
  ' frame spec:
  ' 1-128 inside obj  1=1 in 2=2 in etc
  ' 129-255 outside  255=1 out 254=2 etc
  ' 0 no frame
  PRINT "fram_spec ";SHR(o.spec%,16) AND &X11111111
  '
  ' frame:0-15
  PRINT "frame colour ";SHR(o.spec%,12) AND &X1111
  '
  ' text colour:0-15
  PRINT "text ";SHR(o.spec%,8) AND &X1111
  '
  ' text mode:0-1
  PRINT "textmode ";SHR(o.spec%,7) AND &X1
  '
  ' fill pat:0-7
  PRINT "fill pat ";SHR(o.spec%,4) AND &X111
  '
  ' colour of insides of box:0-15
  PRINT "color inside box ";o.spec% AND &X1111
  '
  PRINT "B O X I N F O  E N D "
  '
RETURN
'
> PROCEDURE tedinfo
  '
  BMOVE o.spec%,V:ted&(0),30
  '
  PRINT "text ";CHAR{{V:ted&(0)}}
  PRINT "mask ";CHAR{{V:ted&(2)}}
  PRINT "vald ";CHAR{{V:ted&(4)}}
  PRINT "char set ";ted&(6)
  PRINT "reserve1 ";ted&(7)
  PRINT "text align ";ted&(8)
  '
  PRINT " ted box info"
  o.spec%=ted&(9)
  boxinfo
  '
  PRINT "reserve2 ";ted&(10)
  PRINT "frame thick ";ted&(11)
  PRINT "text length ";ted&(12)
  PRINT "mask length ";ted&(13)
  '
RETURN
'
> PROCEDURE address
  PRINT "add:";o.spec%
RETURN
'
> PROCEDURE bitblk
  PRINT "bit: ";o.spec%
RETURN
'
> PROCEDURE userblk
  PRINT "user: ";o.spec%
RETURN
'
> PROCEDURE iconblk
  PRINT "icon: ";o.spec%
RETURN
'
' eof
atari is my lifestyle,not a hobby.
HOLD ON ! ! !,
Im printing unreadable characters ...!

ThorstenOtto
Captain Atari
Captain Atari
Posts: 163
Joined: Sun Aug 03, 2014 5:54 pm

Re: RSC File Reader

Postby ThorstenOtto » Thu Oct 19, 2017 3:03 pm

Been quite some time since i worked with GFA, but AFAIK it's not possible to embed initialized structures in the listing. If you get this working, let me know, maybe i can integrate it in ORCS

User avatar
charles
10 GOTO 10
10 GOTO 10
Posts: 2057
Joined: Tue Aug 17, 2004 12:11 am
Location: ont. Canada
Contact:

Re: RSC File Reader

Postby charles » Thu Oct 19, 2017 3:11 pm

well the initial ideal is to list the data structures to a formatted file,
in the same sequence a rsc...
which language do u program with otto?
atari is my lifestyle,not a hobby.
HOLD ON ! ! !,
Im printing unreadable characters ...!

User avatar
lp
Fuji Shaped Bastard
Fuji Shaped Bastard
Posts: 2257
Joined: Wed Nov 12, 2003 11:09 pm
Location: GFA Headquarters
Contact:

Re: RSC File Reader

Postby lp » Thu Oct 19, 2017 3:33 pm

ThorstenOtto wrote:Been quite some time since i worked with GFA, but AFAIK it's not possible to embed initialized structures in the listing. If you get this working, let me know, maybe i can integrate it in ORCS


You are correct. The best way to embed a RSC file is the INLINE command, then fix it up yourself, but it limits the file size to 32kb. It's far easier and more efficient to use rsrc_load() as it was intended. My 2 cents. ;)

User avatar
charles
10 GOTO 10
10 GOTO 10
Posts: 2057
Joined: Tue Aug 17, 2004 12:11 am
Location: ont. Canada
Contact:

Re: RSC File Reader

Postby charles » Thu Oct 19, 2017 4:23 pm

lonny ->just malloc a space to load it into,no inline
I think if you use a larger reserve it will inline larger then 32kb ????
but
with this making it into data lines .....its not looking good : (
with all the "DATA" and "," it takes to format/segment the RSC into data lines , the
.lst file is doubling original .RSC size......lol!!

im really doing this so I can use parts of exisiting RSC and to study the structure
atari is my lifestyle,not a hobby.
HOLD ON ! ! !,
Im printing unreadable characters ...!

User avatar
lp
Fuji Shaped Bastard
Fuji Shaped Bastard
Posts: 2257
Joined: Wed Nov 12, 2003 11:09 pm
Location: GFA Headquarters
Contact:

Re: RSC File Reader

Postby lp » Thu Oct 19, 2017 4:47 pm

If you malloc() some ram, load file, fix all pointers yourself, that is not embedded. That's duplicating exactly what rsrc_load() does. ;)

Every comma (,) in a data statement is converted to a null byte when compiled. I could of told you it would increase in size if stored as bytes in data statements. Plus you have to copy the data somewhere, so then you have the bloated rsc file in data statements, plus it's normal size when copied with READ command. ;)

Actually it's far more than double its size in data statements. Since the values in the data statements are stored in ASCII. For example:
DATA 255,255 (2 bytes)-> compiled bytes: 50 53 53 0 50 53 53 0 (8 bytes!)
DATA FF,FF (2 bytes) -> compiled bytes: 70 70 0 70 70 0 (6 bytes!)

INLINE is always limited to 32kb. Even with this limit it wins for efficiency. It's possible to split a RSC file into two files, use two INLINEs if needed.
Last edited by lp on Thu Oct 19, 2017 5:27 pm, edited 4 times in total.

User avatar
charles
10 GOTO 10
10 GOTO 10
Posts: 2057
Joined: Tue Aug 17, 2004 12:11 am
Location: ont. Canada
Contact:

Re: RSC File Reader

Postby charles » Thu Oct 19, 2017 5:00 pm

ive managed to get the rsc in lst file down to about 12 extra bytes per obj,ted........

just noticed you didn't mention in addition to those other factors I will require a algo written in the program ram to reread the rsc data lines back into the storage space .....
some whopper this is .....!
advantage I can see are

no rsc needed ,
no folder/hierarchy corruption .(cant find rsc file)???


might save some headaches...
atari is my lifestyle,not a hobby.
HOLD ON ! ! !,
Im printing unreadable characters ...!

User avatar
charles
10 GOTO 10
10 GOTO 10
Posts: 2057
Joined: Tue Aug 17, 2004 12:11 am
Location: ont. Canada
Contact:

Re: RSC File Reader

Postby charles » Thu Oct 19, 2017 5:13 pm

really ??
thanks lonny
did not relieze the data lines had extra bytes once stored

interesting
atari is my lifestyle,not a hobby.
HOLD ON ! ! !,
Im printing unreadable characters ...!

User avatar
charles
10 GOTO 10
10 GOTO 10
Posts: 2057
Joined: Tue Aug 17, 2004 12:11 am
Location: ont. Canada
Contact:

Re: RSC File Reader

Postby charles » Thu Oct 19, 2017 5:29 pm

here is the listing with file writer ...
not complete
missing:
bitblk,icon,user string procedures ,

but if you want them gonna have to write yourself

can see the corse to follow ....
good luck

Code: Select all

' sof
'
SAVE "b:\rscsift.gfa"
LIST "d:\rscsift.lst"
KILL "b:\*.BAK"
' DUMP "" TO "d:\vars.lst"
'
RESERVE ((FRE(0) DIV 2) DIV 256)*256
'
DEFFILL 1,2,4
PBOX 0,0,WORK_OUT(0),WORK_OUT(1)
'
' ==variables
'
path$=""
item$=""
file$=""
exten$=""
title$=""
default$=""
'
a%=0
o.next%=0
o.head%=0
o.tail%=0
o.type%=0
o.flags%=0
o.state%=0
o.x%=0
o.y%=0
o.w%=0
o.h%=0
o.spec%=0
b%=0
flen%=0
'
x&=0
type&=0
spec&=0
a&=0
x.&=0
fram_spec&=0
xx&=0
pos&=0
'
drive|=0
'
' ==allocation
default$=STRING$(&H20,0)
path$=STRING$(&H40,0)
file$=STRING$(&H80,0)
'
DIM ted&(13)
DIM bit&(6)
DIM user%(1)
DIM icon&(17)
'
' ===================================================
make_path
OPEN "o",#1,"d:\test.lst"
main
CLOSE #1
' ===================================================
y:
'
~RSRC_FREE()
'
ERASE ted&(),bit&(),user%(),icon&()
'
CLEAR
'
RESERVE
'
EDIT
'
' ====PROCEDURES====
'
> PROCEDURE main
  '
  MID$(path$,1)=LEFT$(path$,RINSTR(path$,"\"))+"*.RSC"
  '
  FILESELECT path$,default$,file$
  '
  IF file$<>"" AND MID$(file$,RINSTR(file$,"."))=".RSC"
    '
    MID$(path$,1)=LEFT$(file$,RINSTR(file$,"\"))+"*.RSC"
    '
    ~RSRC_LOAD(file$)
    ~RSRC_GADDR(0,0,a%)
    '
    treehop
    '
  ENDIF !{rsc disk load}
  '
RETURN
> PROCEDURE treehop
  '
  xx&=0
  WHILE a%>0
    '
    ~OBJC_DRAW(a%,0,99,0,0,0,0)
    ~INP(2)
    '
    objecthop
    '
    INC xx&
    ~RSRC_GADDR(0,xx&,a%)
    '
  WEND
  '
RETURN
PROCEDURE objecthop
  '
  x&=0
  '
  REPEAT
    '
    CLS
    ' ========
    o.next%=OB_NEXT(a%,x&)
    next
    o.head%=OB_HEAD(a%,x&)
    head
    o.tail%=OB_TAIL(a%,x&)
    tail
    '
    ' =========
    o.type%=OB_TYPE(a%,x&)
    type
    o.spec%=OB_SPEC(a%,x&)
    spec
    o.flags%=OB_FLAGS(a%,x&)
    flags
    o.state%=OB_STATE(a%,x&)
    state
    '
    ON spec& GOSUB boxinfo,tedinfo,address,bitblk,userblk,iconblk
    '
    ' =========
    o.x%=OB_X(a%,x&)
    x_axis
    o.y%=OB_Y(a%,x&)
    y_axis
    o.w%=OB_W(a%,x&)
    width
    o.h%=OB_H(a%,x&)
    height
    '
    ' =========
    PRINT #1,"'Obj"
    PRINT #1,"DATA ";
    PRINT #1,o.next%;",";o.head%;",";o.tail%;",";
    PRINT #1,o.type%;",";o.flags%;",";o.state%;",";o.spec%;",";
    PRINT #1,o.x%;",";o.y%;",";o.w%;",";o.h%
    '
    SELECT o.type%
    CASE 21,22,29,30
      PRINT #1,"'Ted"
      PRINT #1,"DATA ";
      PRINT #1,t.text$;",";
      PRINT #1,t.mask$;",";
      PRINT #1,t.vald$;",";
      PRINT #1,t.char_set&;",";
      PRINT #1,t.reserve1&;",";
      PRINT #1,t.text_align&;",";
      PRINT #1,t.o.spec%;",";
      PRINT #1,t.reserve2&;",";
      PRINT #1,t.frame_thick&;",";
      PRINT #1,t.text_length&;",";
      PRINT #1,t.mask_length&
      '
    ENDSELECT
    ' =========
    ~INP(2)
    '
    ADD x&,1
    '
  UNTIL o.next%=0
  '
RETURN
> PROCEDURE make_path
  drive|=GEMDOS(&H19)
  MID$(path$,1)=CHR$((ASC("A")+drive|))+":"+DIR$(drive|+1)+"\"
RETURN
'
'
> PROCEDURE next
  PRINT o.next%;" ";
RETURN
> PROCEDURE head
  PRINT o.head%;" ";
RETURN
> PROCEDURE tail
  PRINT o.tail%;" "
RETURN
> PROCEDURE type
  '
  '  PRINT o.type%;" ";
  '
  SELECT o.type%
    '
  CASE 20                 !g_box       boxinfo
    spec&=1
    PRINT "g_box> ";
  CASE 25                 !g_ibox      boxinfo
    spec&=1
    PRINT "g_ibox> ";
  CASE 27                 !g_boxchar   boxinfo
    spec&=1
    PRINT "g_boxchar> ";
    '
  CASE 21                 !g_text      tedinfo
    spec&=2
    PRINT "g_text> ";
  CASE 22                 !g_boxtext   tedinfo
    spec&=2
    PRINT "g_boxtext> ";
  CASE 29                 !g_ftext     tedinfo
    spec&=2
    PRINT "g_ftext> ";
  CASE 30                 !g_fboxtext  tedinfo
    spec&=2
    PRINT "g_fboxtext> ";
    '
  CASE 26                 !g_button    address of the string
    spec&=3
    PRINT "g_button> ";
  CASE 28                 !g_string    address of the string
    spec&=3
    PRINT "g_string> ";
  CASE 32                 !g_title     address of the string
    spec&=3
    PRINT "g_title> ";
    '
  CASE 23                 !g_image     bitblk
    spec&=4
    PRINT "g_image> ";
    '
  CASE 24                 !g_userdef   userblk
    spec&=5
    PRINT "g_userdef> ";
    '
  CASE 31                 !g_icon      iconblk
    spec&=6
    PRINT "g_icon> ";
    '
  ENDSELECT
  '
RETURN
> PROCEDURE spec
  '
  SELECT spec&
    '
  CASE 1           !g_box g_ibox g_boxchar               boxinfo
    PRINT "boxinfo ";
    '
  CASE 2           !g_text g_boxtext g_ftext g_fboxtext  tedinfo
    PRINT "tedinfo ";
    '
  CASE 3           !g_button g_string g_title            address of the string
    PRINT "address ";
    '
  CASE 4           !g_image                              bitblk
    PRINT "bitblk ";
    '
  CASE 5           !g_userdef                            userblk
    PRINT "userblk ";
    '
  CASE 6           !g_icon                               iconblk
    PRINT "iconblk ";
    '
  ENDSELECT
  '
  PRINT
  '
RETURN
> PROCEDURE flags
  '
  '  PRINT o.flags%;" ";
  '
  IF BTST(o.flags%,0)
    PRINT "selectable ";
  ENDIF
  IF BTST(o.flags%,1)
    PRINT "default ";
  ENDIF
  IF BTST(o.flags%,2)
    PRINT "exit ";
  ENDIF
  IF BTST(o.flags%,3)
    PRINT "editable ";
  ENDIF
  IF BTST(o.flags%,4)
    PRINT "radiobutton ";
  ENDIF
  IF BTST(o.flags%,5)
    PRINT "lastobj ";
  ENDIF
  IF BTST(o.flags%,6)
    PRINT "touchexit ";
  ENDIF
  IF BTST(o.flags%,7)
    PRINT "hidetree ";
  ENDIF
  IF BTST(o.flags%,8)
    PRINT "indirect ";
  ENDIF
  IF o.flags%=0
    PRINT "!!no FLAGS!! ";
  ENDIF
  '
  PRINT
  '
RETURN
> PROCEDURE state
  '
  '  PRINT o.state%;" "
  '
  IF BTST(o.state%,0)
    PRINT "selected ";
  ENDIF
  IF BTST(o.state%,1)
    PRINT "crossed ";
  ENDIF
  IF BTST(o.state%,2)
    PRINT "checked ";
  ENDIF
  IF BTST(o.state%,3)
    PRINT "disabled ";
  ENDIF
  IF BTST(o.state%,4)
    PRINT "outlined ";
  ENDIF
  IF BTST(o.state%,5)
    PRINT "shadowed ";
  ENDIF
  IF o.state%=0
    PRINT "!!no STATE!! ";
  ENDIF
  '
  PRINT
  '
RETURN
> PROCEDURE x_axis
  PRINT "X= ";o.x%;" ";
RETURN
> PROCEDURE y_axis
  PRINT "Y= ";o.y%;" ";
RETURN
> PROCEDURE width
  PRINT "W= ";o.w%;" ";
RETURN
> PROCEDURE height
  PRINT "H= ";o.h%;" "
RETURN
'
'
> PROCEDURE boxinfo
  '
  PRINT "B O X I N F O ";BIN$(o.spec%)
  '
  ' frame spec:
  ' 1-128 inside obj  1=1 in 2=2 in etc
  ' 129-255 outside  255=1 out 254=2 etc
  ' 0 no frame
  PRINT "fram_spec ";SHR(o.spec%,16) AND &X11111111
  '
  ' frame:0-15
  PRINT "frame colour ";SHR(o.spec%,12) AND &X1111
  '
  ' text colour:0-15
  PRINT "text ";SHR(o.spec%,8) AND &X1111
  '
  ' text mode:0-1
  PRINT "textmode ";SHR(o.spec%,7) AND &X1
  '
  ' fill pat:0-7
  PRINT "fill pat ";SHR(o.spec%,4) AND &X111
  '
  ' colour of insides of box:0-15
  PRINT "color inside box ";o.spec% AND &X1111
  '
  PRINT "B O X I N F O  E N D "
  '
RETURN
PROCEDURE tedinfo
  '
  BMOVE o.spec%,V:ted&(0),30
  '
  t.text$=CHAR{{V:ted&(0)}}
  PRINT "text ";t.text$
  t.mask$=CHAR{{V:ted&(2)}}
  PRINT "mask ";t.mask$
  t.vald$=CHAR{{V:ted&(4)}}
  PRINT "vald ";t.vald$
  '
  t.char_set&=ted&(6)
  PRINT "char set ";t.char_set&
  '
  t.reserve1&=ted&(7)
  PRINT "reserve1 ";t.reserve1&
  '
  t.text_align&=ted&(8)
  PRINT "text align ";t.text_align&
  '
  t.o.spec%=ted&(9)
  o.spec%=t.o.spec%
  PRINT " ted box info"
  boxinfo
  '
  t.reserve2&=ted&(10)
  PRINT "reserve2 ";t.reserve2&
  '
  t.frame_thick&=ted&(11)
  PRINT "frame thick ";t.frame_thick&
  '
  t.text_length&=ted&(12)
  PRINT "text length ";t.text_length&
  '
  t.mask_length&=ted&(13)
  PRINT "mask length ";t.mask_length&
  '
RETURN
'
> PROCEDURE address
  PRINT "add:";o.spec%
RETURN
> PROCEDURE bitblk
  PRINT "bit: ";o.spec%
RETURN
> PROCEDURE userblk
  PRINT "user: ";o.spec%
RETURN
> PROCEDURE iconblk
  PRINT "icon: ";o.spec%
RETURN
'
' eof
'
'
'
' O_next,O_head,O_tail
DATA 34,0,12345678
' O_type,O_flags,O_state,O_spec
DATA 34,0,12345678,12345678900
atari is my lifestyle,not a hobby.
HOLD ON ! ! !,
Im printing unreadable characters ...!

User avatar
charles
10 GOTO 10
10 GOTO 10
Posts: 2057
Joined: Tue Aug 17, 2004 12:11 am
Location: ont. Canada
Contact:

Re: RSC File Reader

Postby charles » Fri Oct 20, 2017 2:11 pm

heres some additional code
the part to read the data saved into array and use like rsc file under(objc draw,form do etc) ,
its buggy and I don't know why ....
think it might be I need null strings or gfa garbage collection???

Code: Select all

' sof
'
SAVE "b:\embed1.gfa"
LIST "b:\embed1.lst"
LIST "d:\embed1.lst"
KILL "b:\*.bak"
'
RESERVE (8000 DIV 256)*256
'
trees&=SUB(2,1)
DIM object&(11,trees&)         !declare memory for  OBJECTS
DIM tedinfo&(13,trees&)        !declare memory for  TEDINFO
DIM malrsc%(trees&*3)          !declare memory for  STRINGS
'
DEFFILL 1,2,4
PBOX 0,0,639,399
'
' -rsrc load
RESTORE 1
FOR o.ind&=0 TO trees&
  '
  FOR o.obj&=0 TO 11
    IF o.obj&=6
      READ a%
      {V:object&(o.obj&,o.ind&)}=a%
      INC o.obj&
    ELSE
      READ a&
      object&(o.obj&,o.ind&)=a&
    ENDIF
  NEXT o.obj&
  '
  SELECT object&(3,o.ind&)
    '
  CASE 21,22,29,30
    '
    FOR t.obj&=0 TO 13
      '
      SELECT t.obj&          !!ted first three entries are string
      CASE 0,2,4
        READ a$
        a$=a$+CHR$(0)
        a%=MALLOC(LEN(a$))
        {V:tedinfo&(t.obj&,t.ind&)}=a%
        malrsc%(m.rsc&)=a%
        BMOVE V:a$,malrsc%(m.rsc&),LEN(a$)
        INC m.rsc&
        INC t.obj&
      DEFAULT
        READ a&
        '        PRINT USING "### #######",t.obj&,a&
        tedinfo&(t.obj&,t.ind&)=a&
      ENDSELECT
    NEXT t.obj&
    '
    LONG{V:object&(6,o.ind&)}=V:tedinfo&(0,t.ind&)
    INC t.ind&
    '
  ENDSELECT
  '
NEXT o.ind&
'
object%=V:object&(0,0)         !address of object
'
'
'
' -------------------
~OBJC_DRAW(object%,0,1,0,0,0,0)
'
PRINT AT(24,6);"111 = exit"
'
REPEAT
  ~FORM_DO(object%,0)
  text$=CHAR{{OB_SPEC(object%,1)}}
UNTIL text$="111"
'
' -------------------------------------------------------------------
'
' -rsc free
DEC m.rsc&
FOR x&=0 TO m.rsc&
  ~MFREE(malrsc%(x&))
NEXT x&
ERASE malrsc%(),object&(),tedinfo&()
'
RESERVE
'
END
'
' ==========Data for resource
1:
' Obj
DATA -1,1,1,20,1024,32,16716032,212,103,42,20
' Obj                   bug   change to 1 =relocatable curs???
DATA 0,-1,-1,29,1130,0,4480,1,2,42,16
' Ted
DATA 999,___,NNN,3,6,2,4480,0,-1,4,4,""
'
' eof
atari is my lifestyle,not a hobby.
HOLD ON ! ! !,
Im printing unreadable characters ...!

User avatar
charles
10 GOTO 10
10 GOTO 10
Posts: 2057
Joined: Tue Aug 17, 2004 12:11 am
Location: ont. Canada
Contact:

Re: RSC File Reader

Postby charles » Fri Oct 20, 2017 2:12 pm

do I need to use rsrc_saddr?
atari is my lifestyle,not a hobby.
HOLD ON ! ! !,
Im printing unreadable characters ...!

User avatar
charles
10 GOTO 10
10 GOTO 10
Posts: 2057
Joined: Tue Aug 17, 2004 12:11 am
Location: ont. Canada
Contact:

Re: RSC File Reader

Postby charles » Sat Oct 21, 2017 1:05 pm

this verision is stable , just don't know about rsc files in large lengths,,,,

don't want 80+ editable fields in my resource so I made this to popup for a data entry box ...

Code: Select all

' sof
'
ON ERROR GOSUB err
'
RESERVE (8000 DIV 256)*256
'
trees&=2
tree%=MALLOC(24*trees&)
DIM tedtext$(2)
DIM tedinfo&(13)
'
DEFFILL 1,2,4
PBOX 0,0,639,399
'
o.ind&=0
FOR o.ind&=0 TO trees&-1
  '
  FOR x&=0 TO 22 STEP 2
    IF x&=12
      READ a%
      LONG{(tree%+x&)+(24*o.ind&)}=a%
      x&=14
    ELSE
      READ a&
      WORD{(tree%+x&)+(24*o.ind&)}=a&
    ENDIF
  NEXT x&
  '
  SELECT OB_TYPE(tree%,o.ind&)
  CASE 21,22,29,30
    OB_SPEC(tree%,o.ind&)=V:tedinfo&(0)
    FOR x&=0 TO 13
      IF x&=0 OR x&=2 OR x&=4
        READ a$
        tedtext$(x& DIV 2)=a$+CHR$(0)
        {V:tedinfo&(x&)}=V:tedtext$(x& DIV 2)
        INC x&
      ELSE IF x&=12 OR x&=13
        a&=LEN(tedtext$(x&-12))
        tedinfo&(x&)=a&
      ELSE
        READ a&
        tedinfo&(x&)=a&
      ENDIF
    NEXT x&
    '
  ENDSELECT
  '
NEXT o.ind&
'
' -------------------
PRINT AT(24,6);"99 = Exit"
'
~FORM_CENTER(tree%,x%,y%,w%,h%)
'
'
~FORM_DIAL(0,0,0,0,0,x%-1,y%-1,x%+w%,y%+h%)
~OBJC_DRAW(tree%,0,2,x%-1,y%-1,x%+w%,y%+h%)
'
REPEAT
  '
  obj%=FORM_DO(tree%,0)
  PRINT AT(24,7);USING "obj ###",obj%
  '
  IF obj%=1
    IF CHAR{{OB_SPEC(tree%,1)}}="99"
      end!=TRUE
    ENDIF
  ENDIF
  '
  IF BTST(OB_STATE(tree%,1),0)
    PAUSE 4
    ~OBJC_CHANGE(tree%,1,0,x%-1,y%-1,x%+w%,y%+h%,0,1)
  ENDIF
  '
UNTIL end!
'
~FORM_DIAL(3,0,0,0,0,x%-1,y%-1,x%+w%,y%+h%)
'
' -------------------------------------------------------------------
'
' -rsc free
ERASE tedinfo&(),tedtext$()
~MFREE(tree%)
'
RESERVE
'
END
'
PROCEDURE err
  PRINT ERR
  RESUME
RETURN
'
' ==========Data for resource
' Obj
DATA -1,1,1,20,1024,32,16716032,12,10,42,20
' Obj
DATA 0,-1,-1,29,1130,0,4480,1,2,42,16
' Ted
DATA 99,__,NN,3,6,2,4480,0,-1
'
' eof
atari is my lifestyle,not a hobby.
HOLD ON ! ! !,
Im printing unreadable characters ...!


Social Media

     

Return to “GFA BASIC”

Who is online

Users browsing this forum: No registered users and 1 guest