' "SHOWTREE.PRG": DISPLAYS INFORMATION FROM RESOURCE FILES
' Written by John Durst in HiSoft Basic, 1990

defint a-z
LIBRARY "xbios","gemdos","gemvdi","gemaes"	'HiSoft libraries
REM $INCLUDE gemaes.bh
REM $OPTION L20					' leave 20k for file loading
CONST	type_tree=0

DIM tree_array(11),type_array$(12),flags_array$(8),state_array$(5)
DIM SHARED	ok,junk,er$

DEF FNobject&(tree&,object)=tree&+object*24

' set up data in arrays
RESTORE type_data
	FOR j=0 TO 12
		READ type_array$(j)
	NEXT

	FOR j=0 TO 8
		READ flags_array$(j)
	NEXT

	FOR j=0 TO 5
		READ state_array$(j)
	NEXT

' first choose & load the resource file
start:
WINDOW FULLW
y$=FNfile_select$
IF ok=0 THEN SYSTEM				'CANCEL selected

IF FNrsrc_load(y$)=0 THEN
	junk=FNform_alert(1,"[3][Resource file "+y$+"|not found][ TRY AGAIN ]")
	CLS:GOTO start
END IF
CLS

'get base address for resource file
junk=FN rsrc_gaddr(type_tree,0,base_add&)

' find the number of trees in the resource file
' "GB", the Global Array holds much interesting information
' GB+44 holds the address of the end of a loaded resource file
end_ad&=PEEKL(GB+44):t&=base_add&:tr_num=0
WHILE t&<end_ad&
'look for the "LASTOB" flag in each tree, to count trees
	IF (PEEKW(t&+ob_flags) AND &h0020) THEN INCR tr_num
	t&=t&+24
WEND
tr$="Number of trees in file:"+STR$(tr_num)

' now start requesting information
' request tree number
inpt_tree:
LOCATE 1,1
PRINT er$;tr$:er$=""
INPUT "Number of Object Tree to look at? (ENTER to QUIT program):",y$
CLS
' check for input errors
	IF y$="" THEN SYSTEM	
	chk_num y$:IF er$<>"" THEN inpt_tree	
	IF VAL(y$)>=tr_num THEN er$="NUMBER OUT OF RANGE! ":GOTO inpt_tree
junk=FNrsrc_gaddr(type_tree,VAL(y$),edit&)

lstob=PEEKW(edit&+4)
IF lstob<0 THEN
	ob$="THIS TREE CONTAINS NO OBJECTS"
ELSE
	ob$="Tree No."+y$+": Root object of tree is 0, last object is"+STR$(lstob)
END IF

' request object number
inpt:
LOCATE 1,1
PRINT er$;ob$:er$=""
INPUT "object number:";y$:t$=y$
	IF y$="" THEN CLS:GOTO inpt_tree
	chk_num y$:IF er$<>"" THEN inpt
	IF VAL(y$)>lstob THEN er$=CHR$(7)+"NUMBER OUT OF RANGE! ":GOTO inpt
tree_addr&=FNobject&(edit&,VAL(y$))

' now display information
CLS
LOCATE 3,1
PRINT"Object No: ";y$

'get object info into temporary store
FOR j=0 TO 11
	tree_array(j)=PEEKW(tree_addr&+j*2)
NEXT

LOCATE 4,1
vswr_mode(2)	' transparent mode so that "TAB will not erase
' print out tree structure names
RESTORE struc_data		
FOR j=0 TO 10
	READ y$:PRINT y$
NEXT

' ob_next, ob_head, ob_tail
LOCATE 4,1
FOR j=0 TO 2
	PRINT TAB(20);
	PRINT tree_array(j)
NEXT

' ob_type
PRINT TAB(20);type_array$(tree_array(3)-20)

' ob_flags
temp=tree_array(4)
PRINT TAB(20);:IF temp=0 THEN PRINT"NORMAL"
FOR j=0 TO 8
	IF (temp\2)*2<>temp THEN PRINT flags_array$(j);" ";
	temp=temp\2
NEXT

' ob_state
temp=tree_array(5)
PRINT TAB(20);:IF temp=0 THEN PRINT"NORMAL"
FOR j=0 TO 5
	IF (temp\2)*2<>temp THEN PRINT state_array$(j);" ";
	temp=temp\2
NEXT 

' ob_spec - special cases below
PRINT TAB(20);HEX$(tree_array(6));HEX$(tree_array(7))

' ob_x, ob_y, ob_w, ob_h
FOR j=8 TO 11
	PRINT TAB(20);
	PRINT tree_array(j)
NEXT

'special cases for additional information	
	obtype=PEEKW(tree_addr&+6):ted&=PEEKL(tree_addr&+12)
' G_TEXT, G_BOXTEXT, G_FTEXT, G_FBOXTEXT
	IF obtype=21 OR obtype=22 OR obtype=29 OR obtype=30 THEN
		PRINT:PRINT"TEDINFO INFORMATION:"
		PRINT"Font:";PEEKW(ted&+12),"Colour:";HEX$(PEEKW(ted&+18))
		PRINT"Template: ";
			txt&=PEEKL(ted&+4)
			WHILE PEEKB(txt&)<>0:PRINT CHR$(PEEKB(txt&));:INCR txt&:WEND	
		PRINT" Text: ";
			txt&=PEEKL(ted&)
			WHILE PEEKB(txt&)<>0:PRINT CHR$(PEEKB(txt&));:INCR txt&:WEND			
	END IF

' G_IMAGE
	IF obtype=23 THEN
		img&=PEEKL(ted&)
		PRINT:PRINT"Bit image address:";img&;TAB(40)
		PRINT"Image offset from base:";base_add&-img&
		im_w=PEEKW(ted&+4)
		PRINT"Image width in BYTES:";im_w;TAB(40)
		im_h=PEEKW(ted&+6)
		PRINT"Image height in PIXELS:";im_h
		PRINT"Colour:";RIGHT$("0000"+HEX$(PEEKW(ted&+12)),4);
' show image
		scr&=FNphysbase&
		scr&=scr&+80*50+400+2
		DECR im_w:DECR im_h
		FOR j=0 TO im_h
			FOR i=0 TO im_w\2	'make it words
				POKEW scr&+160*j+i*4-2,PEEKW(img&)
				POKEW scr&+160*j+i*4,PEEKW(img&)
				img&=img&+2
			NEXT
		NEXT
	END IF

' G_BUTTON, G_STRING, G_TITLE		
	IF obtype=26 OR obtype=28 OR obtype=32 THEN
		PRINT:PRINT"Text: ";
		WHILE PEEKB(ted&)<>0:PRINT CHR$(PEEKB(ted&));:INCR ted&:WEND
	END IF

' G_BOXCHAR	
	IF obtype=27 THEN
		char=(ted& AND &hFF000000)/&h1000000
		PRINT"BOXCHAR=""";CHR$(char);""""
	END IF

'G_ICON
	IF obtype=31 THEN
		PRINT:PRINT"Base address:"base_add&
		mask&=PEEKL(ted&)
		PRINT:PRINT"Mask address:";mask&;TAB(40);
		ik_w=(PEEKW(ted&+22))\16
		PRINT"Icon width in WORDS:";ik_w
		Icon&=PEEKL(ted&+4)
		PRINT"Icon address:";Icon&;TAB(40);
		ik_h=PEEKW(ted&+24)
		PRINT"Icon height in PIXELS:";ik_h
		txt&=PEEKL(ted&+8)
		PRINT"Text: ";
			WHILE PEEKB(txt&)<>0:PRINT CHR$(PEEKB(txt&));:INCR txt&:WEND
		PRINT TAB(40);"Letter: ";CHR$(PEEKB(ted&+13));
' show image
		scr&=FNphysbase&
		scr&=scr&+80*50+400+2
		DECR ik_w:DECR ik_h
		FOR j=0 TO ik_h
			FOR i=0 TO ik_w
				POKEW scr&+160*j+i*4-2,PEEKW(Icon&)
				POKEW scr&+160*j+i*4,PEEKW(Icon&)
				Icon&=Icon&+2
			NEXT
		NEXT
	END IF
	
	PRINT:PRINT
	vswr_mode 1
GOTO inpt

' file selector
DEF FNfile_select$
	STATIC	filename$,path$,drv$,length
	SHARED	ok

' put together the pathname
' file & program must be in same directory if ROM selector used
filename$="":path$="                    "
IF drv$="" THEN drv$=CHR$(FNdgetdrv%+"A"%)
dgetpath VARPTR(path$),ASC(drv$)-"@"%
length=INSTR(path$,CHR$(0))-1
path$=drv$+":"+LEFT$(path$,length)+"\*.RSC"
fsel_input path$,filename$,ok
	IF ok=0 THEN EXIT SUB		'error
length=INSTR(path$,"*")-1
drv$=LEFT$(path$,1)
filename$=LEFT$(path$,length)+filename$
FNfile_select$=filename$
END DEF

' check for valid numeral input
SUB chk_num(y$)
STATIC	t$
	t$=y$
	WHILE LEN(t$)>0
		IF ASC(t$)<"0"% OR ASC(t$)>"9"% THEN er$=CHR$(7)+"NUMBER ERROR! ":EXIT SUB
		t$=RIGHT$(t$,LEN(t$)-1)
	WEND
END SUB

' data lists
struc_data:
DATA	ob_next,ob_head,ob_tail,ob_type,ob_flags,ob_state,ob_spec,ob_x,ob_y,ob_width,ob_height

type_data:
DATA	BOX, TEXT, BOXTEXT, IMAGE, PRGDEF, IBOX, BUTTON, BOXCHAR, STRING, FTEXT, FBOXTEXT, ICON, TITLE

flags_data:
DATA	SELECTABLE, DEFAULT, EXIT, EDITABLE, RBUTTON, LASTOB, TOUCHEXIT, HIDETREE, INDIRECT

state_data:
DATA	SELECTED, CROSSED, CHECKED, DISABLED, OUTLINED, SHADOWED