'===========================================================================
' Subject: TEXT COMPILER FOR ASCII TEXTS     Date: 03-29-99 (03:44)       
' Author:  Andrew S. Gibson                  Code: QB, PDS                
' Origin:  gibsons3@ix.netcom.com          Packet: TEXT.ABC
'===========================================================================
'---------------------------------------------------------------------------
' TEXE.BAS for Power Basic 3.2 ported to QuickBASIC by Zapf DingBat (Ver 0.3)
' Text compiler for ASCII texts
' Freeware (c) 1997 by Dieter Folger
' NOTE: Do not use in IDE - compile first!
'---------------------------------------------------------------------------
' Dieter's words:
'
' If you want to convert an ASCII text file, e.g. a readme file, to an
' executable program, i.e. a self displaying EXE file, you need a text
' compiler. Then the user can read this file without the help of an
' ASCII viewer or an editor. TEXE is such a compiler. It converts any
' text file up to 10000 lines.

' How TEXE works: When TEXE is started the file length is compared with
' the predefined value of FileEnd&. If they match, then there is no
' text file included yet and the user is prompted for two file names:
' the name of the text file and the compiled file name.
' This EXE file is written via SHELL using the DOS COPY command.

' When the EXE file is started, it reads its own file name (ProgName$
' is a very useful function!), opens this file and reads the text into
' an array. Variable FileEnd& tells the program the position from where
' to start reading (= length of EXE without text). You have to adjust
' this value if you make any changes to the code. Otherwise the program
' wouldn't work correctly. Then the text is shown and can be scrolled
' down, left, up and right. The Esc key gets the user back to the command
' line.
'
' Zapf's Words:
'
' This port to QuickBasic functions like the PB version, I have added
' the extra code to redraw both info line because some text files destroyed
' the display. You can save the text file to disk only once in a directory.
' To avoid having to change the FileEnd& variable (if you're
' using QuickBASIC) compile the program like this: BC TEXE/O/AH;
'
' and Link it like this (of course you'll probably need to change
' some stuff):
'
' C:\ABCRX>link TEXE/FAR/PACKC/EX
'
' Microsoft (R) Overlay Linker  Version 3.69
' Copyright (C) Microsoft Corp 1983-1988.  All rights reserved.
'
' RUN File(TEXE.EXE):
' List File [NUL.MAP]:
' Libraries [.LIB]: c:\QB45\BCOM45+
' Libraries [.LIB]: c:\QB45\QB
'
' I forgot Whom coded the Dir$ function, Ethan Winer did the ExeName$
' function (same as the Progname function), and I coded the EXTRACT$
' function. (SFX means Source For eXtraction). Remember you *can't*
' compress your resulting file, it won't work !!! You can save the
' document to disk, only once in a directory.
' Email me Zapf_DingBat@JUNO.COM or Zapf_DingBat@DepecheMode.COM
'---------------------------------------------------------------------------
'$DYNAMIC
DEFINT A-Z
DECLARE FUNCTION Dir$ (FileSpec$)
DECLARE FUNCTION ExeName$ ()
DECLARE FUNCTION Exist (Name$)
DECLARE FUNCTION EXTRACT$ (SFX$, Char$)

TYPE RegType
  AX    AS INTEGER
  BX    AS INTEGER
  CX    AS INTEGER
  DX    AS INTEGER
  BP    AS INTEGER
  SI    AS INTEGER
  DI    AS INTEGER
  flags AS INTEGER
  DS    AS INTEGER
  ES    AS INTEGER
END TYPE

CONST FALSE = 0: CONST TRUE = NOT FALSE, SSpc$ = " "
CONST DOS = &H21, SetDTA = &H1A00, FindFirst = &H4E00, FindNext = &H4F00
DIM SHARED Registers AS RegType

' You have to change FileEnd& if you make any changes in source:
FileEnd& = 46692              ' length of EXE file without text

Program$ = ExeName$         ' program reads its own name
'PRINT Program$
OPEN Program$ FOR INPUT AS #1 ' open this EXE file
'---------------------------------------------------------------------------
' This part writes the self displaying EXE file
'---------------------------------------------------------------------------
IF LOF(1) = FileEnd& THEN     ' EXE is without text
   INPUT "Textfile to compile: ", TextFile$
   IF Dir$(TextFile$) = "" THEN
      IF LEN(TextFile$) = 0 THEN
         PRINT "What you don't want to make a file ?"
      ELSE
         PRINT TextFile$; " not found."
      END IF
      END
   END IF
   INPUT "Name of EXE file: ", ExeFile$
   IF ExeFile$ = "" THEN END
   ' Force an *.EXE filename:
   IF INSTR(ExeFile$, ".") = 0 THEN ExeFile$ = ExeFile$ + ".EXE"
   IF INSTR(ExeFile$, ".EXE") = 0 THEN ExeFile$ = EXTRACT$(ExeFile$, ".") + ".EXE"
   'This does it:
   SHELL "COPY /B " + Program$ + " + " + TextFile$ + SSpc$ + ExeFile$ + " > nul"
   PRINT UCASE$(ExeFile$); " written"
   END
END IF
'---------------------------------------------------------------------------
' This part displays the text
'---------------------------------------------------------------------------
Extracted = FALSE 'Whether text has been extracted already, default NO
DocumentName$ = EXTRACT$(Program$, ".") + ".TXT" 'make document name

SEEK #1, FileEnd&             ' go to start of text
DO                            ' get number of text lines
  IF EOF(1) THEN EXIT DO
  LINE INPUT #1, Dummy$
  Lin = Lin + 1
LOOP UNTIL EOF(1)
IF Lin > 10000 THEN Lin = 10000 ' max lines, I don't know what the limit is.

' Bob Perkins' code really clever, works in IDE under other
' circumstances (other viewers, such as NeatView seen it before ?!)
' dim array for text lines
maxmem& = FRE(-1) - 65535
maxlines% = CINT(maxmem& \ 128)
REDIM L(1 TO maxlines%) AS STRING * 128

SEEK #1, FileEnd&             ' go to start of text again
FOR i = 1 TO Lin
    LINE INPUT #1, L(i)      ' read text lines in array
NEXT: CLOSE

'make screen and show text:
COLOR 14, 1
LOCATE 1, 1: PRINT SPACE$(80);
LOCATE 1, 2: PRINT Program$;
P = POS(0)
LOCATE 25, 1: PRINT SPACE$(80);
LOCATE 25, 2
PRINT "Action Keys:"; SSpc$; CHR$(25); SSpc$; CHR$(24); SSpc$; CHR$(27); SSpc$; CHR$(26); SSpc$; "Home End PageUp PageDown (S)ave ESCape";
Start = 1: Offset = 1
DO
    'make screen and show text:
    COLOR 14, 1
    LOCATE 1, 1: PRINT SPACE$(80);
    LOCATE 1, 2: PRINT Program$;
    P = POS(0)
    LOCATE 1, P: COLOR 14, 1
    PRINT " Line"; Start; "of"; Lin - 1; "       ";
    LOCATE 25, 1: PRINT SPACE$(80);
    LOCATE 25, 2
    PRINT "Action Keys:"; SSpc$; CHR$(25); SSpc$; CHR$(24); SSpc$; CHR$(27); SSpc$; CHR$(26); SSpc$; "Home End PageUp PageDown (S)ave ESCape";
    COLOR 0, 3
    FOR i = 2 TO 24
        LOCATE i, 1
        PRINT MID$(L(Start + i - 2) + SPACE$(80), Offset, 80);
    NEXT
    DO: K$ = INKEY$: LOOP UNTIL LEN(K$)
    SELECT CASE RIGHT$(K$, 1)
           CASE "P" 'Cursor down
                Start = Start + 1
           CASE "M" 'Cursor right
                Offset = Offset + 1
           CASE "K" 'Cursor left
                Offset = Offset - 1
           CASE "H" 'Cursor up
                Start = Start - 1
           CASE "G": 'Home
                Start = 1
           CASE "O": 'End
                Start = Lin - 22
           CASE "Q": 'PgDn
                Start = Start + 23
           CASE "I": 'PgUp
                Start = Start - 23
           CASE CHR$(83), CHR$(115) 'Save document to disk
                IF Exist(DocumentName$) = FALSE AND Extracted = FALSE THEN
                   OPEN Program$ FOR INPUT AS #1
                   OPEN DocumentName$ FOR OUTPUT AS #2
                    SEEK #1, FileEnd&             ' go to start of text again
                        FOR i = 1 TO Lin
                           LINE INPUT #1, XX$
                           PRINT #2, XX$
                        NEXT: CLOSE : XX$ = ""
                   Extracted = TRUE
                ELSE
                   OUT 97, INP(97) OR &H3: OUT 67, 182
                   OUT 66, 119: OUT 66, 2: FOR ZZZ! = 0 TO 400: NEXT ZZZ!
                   OUT 97, INP(97) AND &HFC
                END IF
           CASE CHR$(27): END 'Quit
           CASE ELSE
                OUT 97, INP(97) OR &H3: OUT 67, 182
                OUT 66, 41: OUT 66, 21: FOR ZZZ! = 0 TO 555: NEXT ZZZ!
                OUT 97, INP(97) AND &HFC
     END SELECT
     IF Start > Lin - 22 THEN Start = Lin - 22
     IF Start < 1 THEN Start = 1
     IF Offset < 1 THEN Offset = 1
LOOP
END
'==== eof ==================================================================

REM $STATIC
FUNCTION Dir$ (FileSpec$)
'
' Returns a file from current directory
'
DIM DTA AS STRING * 44
Null$ = CHR$(0)

'-----  Set up our own DTA so we don't destroy COMMAND$
Registers.AX = SetDTA                   'Set DTA function
Registers.DX = VARPTR(DTA)              'DS:DX points to our DTA
Registers.DS = -1                       'Use current value for DS
CALL InterruptX(DOS, Registers, Registers)          'Do the interrupt

'-----  Check to see if this is First or Next
IF LEN(FileSpec$) THEN             'FileSpec$ isn't null, so
                'FindFirst
  FileSpecZ$ = FileSpec$ + Null$   'Make FileSpec$ into an ASCIIZ
                'string
  Registers.AX = FindFirst              'Perform a FindFirst
  Registers.CX = 0                      'Only look for normal files
  Registers.DX = SADD(FileSpecZ$)       'DS:DX points to ASCIIZ file
  Registers.DS = -1                     'Use current DS
ELSE                               'We have a null FileSpec$,
  Registers.AX = FindNext               'so FindNext
END IF

CALL InterruptX(DOS, Registers, Registers)         'Do the interrupt

'-----  Return file name or null
IF Registers.flags AND 1 THEN           'No files found
  Dir$ = ""                        'Return null string
ELSE
  Null = INSTR(31, DTA, Null$)     'Get the filename found
  Dir$ = MID$(DTA, 31, Null - 30)  'It's an ASCIIZ string starting
END IF                              'at offset 30 of the DTA
END FUNCTION

FUNCTION ExeName$
  'Returns the name of the currently running program; requires DOS 3.0 +

  '---- DOS Interrupt &H21 service &H62 returns the PSP segment in BX
  Registers.AX = &H6200
  CALL InterruptX(DOS, Registers, Registers)

  '---- The environment segment is at address &H2C/&H2D in PSP segment
  DEF SEG = Registers.BX
  DEF SEG = PEEK(&H2C) + PEEK(&H2D) * 256

  '---- Search the environment segment for two zero bytes in a row.  A count
  '     word (which we skip over) follows that, and the program name follows
  '     the count word.
  Byte = 0
  DO
    IF PEEK(Byte) = 0 THEN              'this is zero
      IF PEEK(Byte + 1) = 0 THEN        'this is too
        Byte = Byte + 2                 'so skip both
        EXIT DO                         'all done
      END IF
    END IF                              'else,
    Byte = Byte + 1                     'keep looking
  LOOP
  IF PEEK(Byte) = 1 THEN                'if this count byte = 1
    Byte = Byte + 2                     'the name follows
    DO WHILE PEEK(Byte)                 'up to another zero
      Tmp$ = Tmp$ + CHR$(PEEK(Byte))    'this is a different Tmp$ on purpose
      Byte = Byte + 1
    LOOP
    ExeName$ = Tmp$                     'assign the function output
  END IF
END FUNCTION

FUNCTION Exist (Name$)
OPEN Name$ FOR BINARY AS #1
IF LOF(1) <> 0 THEN
   Exist = TRUE: CLOSE
ELSE
   Exist = FALSE: CLOSE
   KILL Name$
END IF
END FUNCTION

FUNCTION EXTRACT$ (SFX$, Char$)
'QB Version of PB's EXTRACT$
Temp$ = ""
 FOR X = 1 TO LEN(SFX$)
     IF MID$(SFX$, X, 1) = Char$ THEN EXIT FOR
     Temp$ = Temp$ + MID$(SFX$, X, 1)
 NEXT X
EXTRACT$ = Temp$
END FUNCTION