!*! 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