!*! Updated on 11-Feb-92 at 10:46 AM by Sylvan Malis; edit time: 0:22:01
!
!*****************************************************************************
!*! Created on 18-Nov-91 at 10:56 AM by Dave Jackson; edit time: 0:53:57
!****************************************************************************
!                                                                           *
!  EXTRAC.BAS - A d/BASIC utility module for d/PAINT files.
!                                                                           *
!     
program extrac,1.0(100)
!
binary 1 B
string 80 L,X,Y,D,S
float v,l,p,c

S= dupstr$("A",80)
D= dupstr$("D",80)
X= dupstr$("*",80)
Y= dupstr$("Y",80)

Map1 OutFile,S,24,"PNT.LST"

Map1 Fl$,S,24

strsiz 80

! Main Section of program --  Get the file name to be processed.
! The output is also displayed on the terminal minus the control characters
! to check if the information compairs with your dPAINT module.

print tab(-1,0);

 	open #2,OutFile,output		! place for data

! The input call is for Microsabio's INFLD but AMOS's input is ok with minor
! change the the xcall input

	print tab(4,1);"Enter d/PAINT Location, File Name and extension "
	xcall input,4,50,24,0,"E*",Fl$,inxctl,1,1,extcde
	if inxctl end
	
! Add error checking of input if needed. Such as has the extension been
! entered or not etc..  I chose not to error check the open statement
! tells the user about the error.

 	OPEN #1,Fl$,input

 	print #2,"*** Section I  ***  Prompt elements"

 	call Begin
 	close #1
 	close #2

 	print "The data is listed in the file ";OutFile
end


!********************* Subroutines

Begin:

   swch= 1 : l= 0 : c= 0 : v=0 : print tab(-1,0);

! Read the file one byte at a time checking for the lead character

do get byte #1,A until eof(1)
   if swch and A= 128 then call Get'RowCol	! String variable preamble
   if swch and A= 129 then call Get'String	! Screen Position preamble
   if A= 255 and swch= 1 then print #2,"*** Section II ***  Data Elements"
   if A= 255 swch= 0 : call Get'Var		! Data Element preamble
enddo
   print #2,Fl$,plural$("Element",v)		! Lazy programmer
   print tab(1,1);plural$("Element",v);		! Lazy Programmer
   print tab(23,1);
   stop						! wait to view data
   print tab(-1,0)				! clear view
return



Get'RowCol:
   get byte #1,R
   get byte #1,C
return



Get'String:
   p= 0
do get byte #1,A until A= 0
   p+=1 : L[p;1]= chr$(A)
enddo



   print #2,using "#Z",R;
   print #2,",";
   print #2,using "#Z",C;
   print #2,",";
   print #2,L[1;p]

   print tab(R,C);L[1;p];
   L= Space(80)

return

Get'Var:
	call Get'RowCol
	if R= 0 then return		! incase no row and col follow
	v+= 1				! bump element counter.
 	print tab(R,C);			! ready to print on screen
	get byte #1,Siz
	get byte #1,Typ

!
! The following number of elements at this time are unknown to me.  I do
! know after 13 bytes any additional bytes are related to the exit code.
!
!	get byte #1,A0
!	get byte #1,A1
!	get byte #1,A2
!	get byte #1,A3
!	get byte #1,A4
!	get byte #1,A5
!	get byte #1,A6
!	get byte #1,A7
!	get byte #1,A8
!	get byte #1,A9
!

 	if Typ=0 then print X[1;Siz];		! Alpha/Numerics
 	if Typ=1 then print S[1;Siz];		! Alpha
 	if Typ=2 then print D[1;Siz];		! Numerics
 	if Typ=16 then print Y[1;Siz];		! Yes/No

! other Type are unknown to me.

	print #2,using "#Z",R;
	print #2,",";
	print #2,using "#Z",C;
	print #2,",";
	print #2,using "#Z",Siz;
	print #2,",";
	print #2,using "#Z",0;
	print #2,",";

	if Typ= 0 then print #2,"*"
	if Typ= 1 then print #2,"A"
	if Typ= 2 then print #2,"N"
	if Typ= 16 then print #2,"Y"

return

!Start Test code
!
! This section prints the decimal bytes based on the above information.
! Some times the string size may become greater then what may be d/VUE'd.
!
! This is just extra code if you wish to see the .PNT file numerically.
! 

TST:
   swch= 1
do get byte #1,A until eof(1)
   if A= 23 or A= 128 or A= 255 or A= 129 then print #2
   print #2,A;
enddo
  print #2

return