' TRANSFER IMAGE DATA FROM SCREEN TO RESOURCE FILE IMAGE
'3/11/89

defint a-z
library "xbios","gemdos","gemvdi","gemaes"

'use only 40k for program
rem $option k40
REM	$INCLUDE GEMAES.BH
DIM type_array$(12)
DIM SHARED pts(15)

RESTORE type_data
	FOR j=0 TO 12
		READ type_array$(j)
	NEXT

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

'*** PROGRAM STARTS HERE ***
'first, discard lo-res screen
medium=PEEKW(SYSTAB)-1		'medium=1 for MEDIUM RES, =0 for HI RES
IF medium=3 THEN
	junk=FNform_alert(1,"[3][This does not work|in LOW RESOLUTION][ SORRY! ]")
	SYSTEM
END IF

WINDOW FULLW 2:CLS

' ** choose & load the resource file
LOCATE 2,22
PRINT "CHOOSE RESOURCE FILE FOR ALTERATION"

start:
file_select "RSC",ok

IF ok=0 THEN SYSTEM		'quit

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

	rscstart&=PEEKL(GB+48)			'start of RSC file in memory
	lasttree=PEEKW(rscstart&+22)-1	'number of last tree
	
'also copy the RSC file into an accessible string
'which can later be SAVED again

	OPEN filename$ FOR INPUT AS #1
	rsc_len=LOF(1)		'get length of RSC file
		im$=INPUT$(rsc_len,#1)
	CLOSE

CLS

'** now search the resource file for the image
inpt_tree:
LOCATE 3,6
PRINT "RESOURCE FILE: ";filename$
PRINT:INPUT "Enter number of Object Tree holding image (key ""RETURN"" to QUIT program):",y$:t$=y$
	IF y$="" THEN BEEP:SYSTEM
'weed out bad input
	WHILE LEN(t$)>0
		IF ASC(t$)<"0"% OR ASC(t$)>"9"% THEN BEEP:PRINT "NUMBER ERROR                     ":GOTO inpt_tree
		t$=RIGHT$(t$,LEN(t$)-1)
	WEND
IF VAL(y$)>lasttree THEN:BEEP:PRINT "THERE IS NO TREE WITH THIS NUMBER":GOTO inpt_tree
PRINT SPACE$(33)	'blot out any error message
junk=FNrsrc_gaddr(type_tree,VAL(y$),edit&)

'count the number of objects in this tree
totalobj=0
DO UNTIL PEEKW(edit&+totalobj*24+ob_flags) AND &h20
	INCR totalobj
LOOP

inpt:
LOCATE 7,6
INPUT "Enter Object number (key ""RETURN"" to choose another tree):",y$:t$=y$
	IF y$="" THEN CLS:GOTO inpt_tree
	WHILE LEN(t$)>0
		IF ASC(t$)<"0"% OR ASC(t$)>"9"% THEN BEEP:PRINT "NUMBER ERROR":GOTO inpt
		t$=RIGHT$(t$,LEN(t$)-1)
	WEND

CLS
LOCATE 5,6
IF VAL(y$)=totalobj THEN PRINT "THIS IS THE LAST OBJECT IN THIS TREE: YOU CANNOT SELECT BEYOND IT"
IF VAL(y$)>totalobj THEN BEEP:PRINT "THERE IS NO OBJECT IN THIS TREE WITH THIS NUMBER                 ":GOTO inpt

tree_addr&=FNobject&(edit&,VAL(y$))
obtype=PEEKW(tree_addr&+6)

LOCATE 9,10
PRINT"Object No: ";y$;" is a";type_array$(obtype-20);

IF obtype<>23 THEN PRINT ", not an IMAGE: try again":BEEP:GOTO inpt 
	ted&=PEEKL(tree_addr&+12)	
	img&=PEEKL(ted&)	
	im_w=PEEKW(ted&+4)*8
	im_h=PEEKW(ted&+6)
		
		PRINT
		PRINT:PRINT"Image width in PIXELS:     ";im_w
			  PRINT"Image height in PIXELS:    ";im_h

' show image
		scr&=FNphysbase&
		scr&=scr&+160*25+40
			IF medium THEN scr&=scr&+40
		DECR im_w:DECR im_h
		FOR j=0 TO im_h
			FOR i=0 TO im_w\16	'make it words
				IF medium THEN
					POKEW scr&+160*j+i*4,PEEKW(img&)
					POKEW scr&+160*j+i*4+2,&hFFFF
				ELSE
					POKEW scr&+80*j+i*2,PEEKW(img&) XOR &hFFFF
				END IF
				img&=img&+2
			NEXT
		NEXT
	
	LOCATE 20,2
	PRINT :INPUT "INPUT ""IM"" TO TRANSFER IMAGE (key ""RETURN"" for new input) ",y$
	IF y$=="IM" THEN xfer

	CLS:GOTO inpt		'try again

'** now get the screen image to be transferred
xfer:
CLS
im_addr&=PEEKL(ted&)
im_offset=im_addr&-rscstart&

'load the drawing program
PRINT "NOTE: If your program finishes with ""END"",press a key to go on"
LOCATE 2,23
PRINT "LOAD AND RUN IMAGE DRAWING PROGRAM"

loadit:
file_select	"PRG",ok
IF ok=0 THEN SYSTEM
MOUSE -1
IF FNpexec(0,filename$,y$,z$)<>0 THEN
	MOUSE 0
	junk=FNform_alert(1,"[3][The program "+filename$+"|does not work][ TRY AGAIN ]")
	CLS:GOTO loadit
END IF
MOUSE 0
'use the drag-box to locate the required section of screen
BEEP
LOCATE 1,1:PRINT "USE THE MOUSE TO DRAG YOUR IMAGE RECTANGLE: DOUBLE CLICK TO FIX IT"
x1=200:y1=60		'initial rectangle position
outline x1,y1,im_w,im_h

DO
clks=FNevnt_button(2,1,1,0,0,0,0)
	IF clks=2 THEN EXIT LOOP
WHILE MOUSE(0)<x1 OR MOUSE(0)>x1+im_w OR MOUSE(1)<y1 OR MOUSE(1)>y1+im_h:WEND
	outline x1,y1,im_w,im_h		'print rectangle in XOR mode

	graf_dragbox im_w,im_h,x1,y1,1,1,639,299,x,y
x1=x:y1=y
	
	outline x1,y1,im_w,im_h			'XOR out current rectangle
	LOCATE 22,2:PRINT "Image screen co-ordinates:";x1,y1;
LOOP

outline x1,y1,im_w,im_h			'XOR out final rectangle before GET

'grab the image
DIM im(2*im_h*(im_w\8+1)+3)
GET (x1,y1)-(x1+im_w-1,y1+im_h-1),im

'** now transfer the "GET" image to the RSC array
'for HIGH RES., transfer is Byte for Byte
'for MEDIUM RES., every other word from the PUTarray
'fills consecutive words in the RSC array

'There are also 3 Bytes in the PUTarray, before the image

data_len=(im_w\8)*im_h		'Number of Bytes to xfer
ad&=SADD(im$)+im_offset		'where they go in the RSC file
put_ad&=VARPTR(im(0))+6		'start of image data in PUTarray

IF medium THEN
	FOR j=0 TO data_len STEP 2			
 		POKEW ad&+j,im(j+3)		
	NEXT
	
ELSE
	
	FOR j=0 TO data_len
		POKEB ad&+j,PEEKB(put_ad&+j)
	NEXT
END IF

'put the new file back on disc
OPEN "NEWIMAGE.RSC" FOR OUTPUT AS #1
PRINT#1,im$
CLOSE

BEEP:SYSTEM			'finished

'*** SUB PROGRAMS ***
'draw hollow box
SUB outline(x,y,w,h)
MOUSE -1				'suppress mouse
'set up ptsin array of co-ordinate pairs
pts(0)=x:pts(1)=y:pts(2)=x+w:pts(3)=y
pts(4)=x+w:pts(5)=y+h:pts(6)=x:pts(7)=y+h
pts(8)=x:pts(9)=y:pts(10)=x:pts(11)=y
pts(12)=x:pts(13)=y:pts(14)=x:pts(15)=y+h

vswr_mode 3				'XOR
v_pline	5,pts()
vswr_mode 1				'normal printing
MOUSE 0					'restore mouse
END SUB

'operate file selector
SUB file_select(type$,ok)
	STATIC	path$,drv$,length
	SHARED	filename$

'put together the name for file selector
'this only works properly with HFSEL installed
filename$=""
drv$=CHR$(FNdgetdrv%+"A"%)
path$="                "
dgetpath VARPTR(path$),0
length=INSTR(path$,CHR$(0))-1
path$=drv$+":"+LEFT$(path$,length)+"\"	
fsel_input path$+"*."+type$,filename$,ok
'ok returns error &c.
END SUB

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