/* This program gives you a version command with requesters requires V37+  */
/*
  Don't take this code as some sort of prime example of how to code E please,
  it's my first attempt at this language and isn't very pretty
*/

OPT OSVERSION=37

/* Misc exceptions */
ENUM   NONE, ERR_READFAIL, ERR_MATCHFAIL, ERR_OPENFILE, ERR_ARGS

MODULE 'dos/dos', 'dos/dosextens', 'exec/resident', 'exec/nodes', 'intuition/intuition'

DEF program[50]:STRING, version[10]:STRING, date[12]:STRING, author[50]:STRING
DEF fname[32]:STRING
DEF myargs:PTR TO LONG


PROC find_digit(start:PTR TO CHAR)
/* Look for digits in the string */
CONST LOW="0",HIGH="9"
DEF result

  MOVE.L	start,A0	/* start POINTER */
  MOVE.L	A0,D0
  next_chr:
    CMPI.B	#LOW,(A0)	/* <"0" char ? */
    BLT.S	no_digit
    CMPI.B	#HIGH,(A0)	/* >"9" char ? */
    BGT.S	no_digit
    SUB.L	A0,D0
    NEG.L	D0
    MOVE.L	D0,result	/* A1 Ptr to string start */
    RETURN	result		/* And return it */
    no_digit:
    TST.B	(A0)+
  BNE.S		next_chr
  RETURN 	-1
ENDPROC

PROC display_info(vinfo)
  ENUM MIN_INFO, MED_INFO, MAX_INFO
  DEF pos,pos2,display_kind=MIN_INFO
  DEF s[1]:STRING

  s:=' '		/* Assume blanks as separators */
  IF (pos2:=find_digit(vinfo))> (pos:=InStr(vinfo,' ',1)) THEN pos:=pos2-1

  IF pos<>-1
  /* Extract date and version strings */
    StrCopy(program,vinfo,pos)
    pos2:=InStr(vinfo,' ',pos+1)		/* find next blank */
    MidStr(version,vinfo,pos+1,pos2-pos-1)      /* extract version string */
    pos:=pos2
    IF pos<>-1
      /* Try to extract a date */
      IF (pos2:=InStr(vinfo,'(',pos+1))<>-1
        pos:=pos2;
        s:=')'		/* if we discover a '(' use ')' as separator instead */
      ENDIF
      IF (pos2:=InStr(vinfo,s,pos+1))<>-1
        MidStr(date,vinfo,pos+1,pos2-pos-1)
        date:=TrimStr(date)
        IF StrCmp(date,'',ALL)<>TRUE
          display_kind:=MED_INFO
        ENDIF
      ENDIF

      IF ((pos:=InStr(vinfo,s,pos+1))<>-1)
        /* if there is any author info extract it too */
        MidStr(author,vinfo,pos+1,ALL)
        author:=TrimStr(author)
	IF StrCmp(author,'',ALL)<>TRUE
          display_kind:=MAX_INFO
	ENDIF
      ENDIF
    ENDIF
  ENDIF
  EasyRequestArgs(0,[20,0,'WB-Version request',
    ListItem(['File: \s\n\nName: \s\nVersion: \s\n',
	      'File: \s\n\nName: \s\nVersion: \s\nDate: \s\n',
	      'File: \s\n\nName: \s\nVersion: \s\nDate: \s\nAuthor: \s\n'],display_kind),
  	      'OK'],0,[fname,program,version,date,author])

ENDPROC

PROC display_error(error)
  IF (error<>NONE)
    EasyRequestArgs(0,[20,0,'WB-Version request',ListItem(['',
    'File: \s\nError while reading from file !\n',
    'File: \s\nNo version string found !\n',
    'File: \s\nCoudn''t open file !\n',
    'Usage: CLI> WB-Version FILE/A\n'],error),
    'OK'],0,[fname])
  ENDIF
  Raise(error)
ENDPROC

PROC find_ver(start:PTR TO CHAR,size)
/* Look for version string in the defined memory */
CONST VER_STR=$5645523A		/* VER: */
DEF result

  MOVE.L	start,A0	/* Start pointer */
  MOVE.L	size,D0		/* Size */
  SUBQ.L	#5,D0		/* The string must fit */
  next_char:
    CMPI.B	#$24,(A0)+	/* a $ sign ? */
    BNE.S	no_match
      MOVE.L	A0,A1
      MOVE.B	(A1)+,D2	/* copy a longword */
      LSL.L	#8,D2
      MOVE.B	(A1)+,D2
      LSL.L	#8,D2
      MOVE.B	(A1)+,D2
      LSL.L	#8,D2
      MOVE.B	(A1)+,D2

      MOVE.L	D2,result
      CMP.L	#VER_STR,D2
      BNE.S	no_match
      MOVE.L	A1,result	/* A1 Ptr to string start */
      RETURN	result		/* And return it */
    no_match:
    SUBQ.L	#1,D0
  BGE.S		next_char
  RETURN 	-1
ENDPROC

PROC find_rtc_matchword(base:PTR TO rt,size)
/* Look for rom tags in the defined memory */
CONST ROMTAG_SIZE=26
DEF done=FALSE
  size:=size-ROMTAG_SIZE	/* make sure that the romtag actualy fits */
  WHILE (done=FALSE) AND (size>1)
    done:=(base.matchword=RTC_MATCHWORD) AND (base.matchtag=base) AND ((base.type=NT_DEVICE) OR (base.type=NT_LIBRARY))
    IF done<>TRUE
      base:=base+2		/* Look for romtag structure */
      size:=size-2
    ENDIF
  ENDWHILE
  IF done THEN RETURN base
  RETURN NIL
ENDPROC

PROC main() HANDLE
  CONST BUFFSIZE=2048

  DEF count, c, oldwindow, seg, size, rdargs
  DEF base:PTR TO rt
  DEF str_base:PTR TO CHAR
  DEF str[4]:STRING, vinfo[256]:STRING
  DEF firstseg=NIL, instream=NIL
  DEF me:PTR TO process

  VOID '$VER: WB-Version 1.3 (28.08.93) (C) Håkan Hellberg'

  myargs:=[0]
  fname:='No file selected'

  me:=FindTask(NIL)			/* Make the requester popup on the default public screen */
  oldwindow:=me.windowptr
  me.windowptr:=NIL

  IF rdargs:=ReadArgs('FILE/A',myargs,NIL)
    fname:=FilePart(myargs[0])

    /* Try segloading */
    seg:=LoadSeg(myargs[0]) 		/* seg is a BPTR ! */
    firstseg:=seg			/* save the pointer for unloading later */
    WHILE seg<>NIL
      base:=Shl(seg,2)+4		/* BPTR Conversion and adjustment for seglist */
      str_base:=base
      size:=Long(base-8)-8		/* Get segment size and adjust for seglist */

      IF ((base:=find_rtc_matchword(base,size))<>NIL)
	/* We will end up here if the file includes a library or a device ROMTAG */
        StrCopy(vinfo,base.idstring,ALL)
        display_info(vinfo)
        Raise(NONE)
      ELSE
        IF (base:=find_ver(str_base,size))<>-1
	  /* We will end up here if the segment didn't include a ROMTAG */
          StrCopy(vinfo,base,ALL)
          display_info(vinfo)
          Raise(NONE)
        ENDIF
      ENDIF
      seg:=Long(Shl(seg,2))		/* Next segment */
    ENDWHILE
    IF firstseg<>NIL THEN display_error(ERR_MATCHFAIL)

    IF ((instream:=Open(myargs[0],MODE_OLDFILE))<>NIL)
      /* Segloading failed try another method */
      WHILE ((c:=FgetC(instream))<>-1)
        IF (c="$")
          /* Found the leading '$' sign check for 'VER:' */
          IF (count:=Fread(instream,str,4,1))=1
	    IF StrCmp(str,'VER:',4)
		/* Found $VER: go ahead and pick up the remaining string */
	      IF (Fgets(instream,vinfo,256)<>NIL)
	        display_info(vinfo)
	        Raise(NONE)
	      ELSE
		display_error(ERR_READFAIL)
	      ENDIF
	    ELSE
	      /* No 'VER:' revind back to our old position */
	      Seek(instream,-4,OFFSET_CURRENT)
            ENDIF
          ENDIF
        ENDIF
      ENDWHILE
      display_error(ERR_MATCHFAIL)
    ELSE
      display_error(ERR_OPENFILE)
    ENDIF
  ENDIF
  display_error(ERR_ARGS)

EXCEPT
  FreeArgs(rdargs)
  IF firstseg<>NIL
    UnLoadSeg(firstseg)
  ENDIF
  IF instream<>NIL
    Close(instream)
  ENDIF
  me.windowptr:=oldwindow
ENDPROC