'===========================================================================
' Subject: Text Compiler                      Date: 06-13-03 (  :  )       
'  Author: Dieter Folger                      Code: PB                     
'  Origin: ba2049@bnv-bamberg.de            Packet: TEXT.ABC
'===========================================================================
'---------------------------------------------------------------------------
'TEXE2.BAS Textcompiler for PowerBasic
'Freeware by Dieter Folger 1999
'This is an improved version of the text compiler
'that is already in the 1997 ABC archive
'---------------------------------------------------------------------------
DEFINT A-Z
IF BIT (PbvHost,5) THEN       ' Don't start in IDE
   PRINT "Don't start in IDE" ' ProgName$ would be "PB.EXE"
   END
END IF
'---------------------------------------------------------------------------
' Test if we have text to display or a new file to create
'---------------------------------------------------------------------------
Program$ = ProgName$          ' program reads its own name
OPEN Program$ FOR INPUT AS #1 ' open this EXE file
  FLength& = LOF(1)
  SEEK #1, FLength& - 10
  LINE INPUT #1, Test$        'Test$: file length and "TEXE" ?
CLOSE #1
'---------------------------------------------------------------------------
' This part writes the self displaying EXE file
'---------------------------------------------------------------------------
IF RIGHT$(TEST$,4) <> "TEXE" THEN 'User wants to write a new EXE
   INPUT "Textfile to compile: ", TextFile$
   IF DIR$(TextFile$) = "" THEN
      PRINT TextFile$; " not found" : 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"
   IF DIR$(ExeFile$) <> "" THEN KILL ExeFile$

   OPEN Program$  FOR BINARY AS #1
   OPEN TextFile$ FOR BINARY AS #2
   OPEN ExeFile$  FOR BINARY AS #3
   WHILE NOT EOF(1) 'copy TEXE.EXE into new file
         GET$ #1, 1024, P$
         PUT$ #3, P$
   WEND
   WHILE NOT EOF(2) 'copy textfile into new file
         GET$ #2, 1024, T$
         PUT$ #3, T$
   WEND
   Test$ = STR$(FLength&)
   Test$ = SPACE$(6 - LEN(Test$)) + Test$ + "TEXE"
   PUT$ #3, Test$   'add this Test$ at eof
   CLOSE
   PRINT UCASE$(ExeFile$); " written"
   END
'---------------------------------------------------------------------------
' This part displays the text
'---------------------------------------------------------------------------
ELSE 'we have text to display
   FLength& = VAL(MID$(Test$,1,6))
   OPEN Program$ FOR INPUT AS #1
   SEEK #1,FLength&              ' go to start of text
   DO                            ' get number of text lines
     IF EOF(1) THEN EXIT LOOP
     LINE INPUT #1, L$
     INCR Lin
   LOOP UNTIL EOF(1)
   IF Lin > 10000 THEN Lin = 10000 ' max lines
   DIM L$(Lin)                     ' dim array for text lines
   SEEK #1, FLength&               ' go to start of text again
   DECR Lin
   FOR i=1 TO Lin
       LINE INPUT #1,L$(i)         ' read text lines in array
   NEXT
   '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 "Keys ";CHR$(25);" "CHR$(24);" ";CHR$(26);" ";CHR$(27);" Esc";
   Start=1 : Offset=1
   DO
       LOCATE 1,P : COLOR 14,1
       Print " Line"; Start; "of"; Lin; "       ";
       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
                INCR Start
           CASE "M" 'Cursor right
                INCR Offset
           CASE "K" 'Cursor left
                 DECR Offset
           CASE "H" 'Cursor up
                DECR Start
           CASE "G" :'Home
                Start = 1
           CASE "O": 'End
                Start = Lin - 22
           CASE "Q": 'PgDn
                INCR Start,23
           CASE "I": 'PgUp
                DECR Start,23
           CASE CHR$(27) : END
        END SELECT
        IF Start > Lin - 22 THEN Start = Lin - 22
        If Start < 1 THEN Start = 1
        If Offset < 1 THEN Offset = 1
   LOOP
END IF
END
'---------------------------------------------------------------------------
FUNCTION ProgName$ ' get path and name of running program
'---------------------------------------------------------------------------
 ! mov ax,&h6200
 ! int &h21
 ! mov es,bx
 ! mov ax, word ptr es:[&h2c]
 ! mov pbvDefSeg, ax
 FOR i = 0 TO 1024
     IF PEEK$(i,4) = CHR$(0,0,1,0) THEN EXIT FOR
 NEXT
 WHILE PEEK(i + 4) <> 0
   Tmp$ = Tmp$ + CHR$(PEEK(i+4))
   INCR i
 WEND
 DEF SEG
 ProgName$ = Tmp$
END FUNCTION
'==== eof ==================================================================