'===========================================================================
' Subject: QB TEXT VIEWER                     Date: 05-31-98 (19:52)       
'  Author: Anders Olofsson                    Code: QB, PDS                
'  Origin: anders.olofsson@mail.bip.net     Packet: TEXT.ABC
'===========================================================================
' Text viewer, by Anders Olofsson 1998.
'  E-mail: anders.olofsson@mail.bip.net
'
'    This text viewer has smooth scrolling. (int 10h and vertical retrace)
'    It pokes everything to videomemory, so every character can be displayed.
'    There are lots of bugs... I hope nobody will find them!
'
'      F1 - Help
'      ENTER - Load new file
'      ESC - Quit
'      PG UP / PG DOWN - Scroll text up / down one page
'      Up / Down keys - Scroll text up / down one row
'      Right / Left Keys - Scroll text vertical
'      F - changes foregroundcolor
'      B - changes backgroundcolor
'
'        To speed up this program, compile it into an .exe-file.
'
' All routines has been written by me, except the following:
'   Getdir - Rich Geldreich (I have it modified to separate files & dirs.)
'   Scroll - Unknown
'   Wrapline - John White/Dan Bridges

DEFINT A-Z
'$DYNAMIC

DECLARE SUB RestorePath ()
DECLARE SUB Quitprogram ()
DECLARE FUNCTION FloppyDriveReady% (drive$)
DECLARE FUNCTION CurrentDirectory$ (Dr$)
DECLARE FUNCTION CHDRiVe% (Dr$)
DECLARE SUB Sort (Arr$(), Start%, E%)
DECLARE SUB Getdir (Entryname$(), EType%, FileDate%, DirNum%, Path$, Status%)
DECLARE SUB Win (R1%, C1%, Wid%, Hei%, S%, WindowC%, TitleC%, ShadowC%)
DECLARE FUNCTION SelectFile$ (FileType$)
DECLARE FUNCTION SaveScrn$ ()
DECLARE FUNCTION Getfilename% ()
DECLARE FUNCTION ErrorText$ (ErrorNum%)
DECLARE SUB Printdocument ()
DECLARE SUB PrintText ()
DECLARE SUB Mouseloop (BTN%)
DECLARE SUB POKES (Start%, S$)
DECLARE FUNCTION PEEK$ (Start%, Length%)
DECLARE FUNCTION RINSTR% (T$, S$)
DECLARE SUB Msgbox (T$, Wid%, BorderC%, TextC%, WindowC%, Title$, Tcolor%, W%)
DECLARE SUB WrapLine (Strlen%, StrIn$, ParsedLines$(), NumOfLines%)
DECLARE SUB UpdateStatusBar ()
DECLARE SUB Writestring (Y%, X%, S$, C%)
DECLARE SUB Help ()
DECLARE SUB MouseArea (X%, Y%, x2%, y2%)
DECLARE SUB ScrollUp ()
DECLARE SUB ScrollDown ()
DECLARE SUB Updatescrollbar ()
DECLARE SUB Loadfile (n$)
DECLARE SUB ReMakeArray ()
DECLARE SUB Center (R%, T$)
DECLARE SUB Scroll (Direction%, NumRows%, Tlrow%, Tlcol%, Brrow%, Brcol%, Fore%, Back%)
DECLARE SUB Readfile (n$)
DECLARE FUNCTION Keyboard% ()
DECLARE SUB Mousehide ()
DECLARE SUB Mouseshow ()
DECLARE SUB Mouse (B1%, B2%, X%, Y%)
DECLARE FUNCTION MouseInit% ()

TYPE RegTypeX
 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

TYPE FileFindBuf
 DOS AS STRING * 21
 Attributes AS STRING * 1
 AccessTime AS STRING * 2
 AccessDate AS STRING * 2
 FileSize AS LONG
 Filename AS STRING * 13
END TYPE


DIM SHARED inreg AS RegTypeX, OutReg AS RegTypeX, Location, UseMouse

DIM SHARED FC, BC          'Foreground- and background colors
DIM SHARED ScreenSegment   'Supports BW and Color monitor

DECLARE SUB INTERRUPTX (intnum AS INTEGER, inreg AS RegTypeX, OutReg AS RegTypeX)

DIM SHARED Text(1) AS STRING, MaxRows, Rows, LL
DIM SHARED QuitScrn AS STRING, PathRestore AS STRING, SaveRow, SaveCol

  SaveRow = CSRLIN
  SaveCol = POS(0)

 Rows = 25         'Can be 25, 50 or 43 on a VGA card.

 ' Setup colors
  
    FC = 7         'Foreground
    BC = 1         'Background


CMD$ = COMMAND$

 IF INSTR(CMD$, "/50") THEN
  Rows = 50
  MID$(CMD$, INSTR(CMD$, "/50"), 3) = "   "
  CMD$ = LTRIM$(RTRIM$(CMD$))
 END IF
 IF INSTR(CMD$, "/43") THEN
  Rows = 43
  MID$(CMD$, INSTR(CMD$, "/43"), 3) = "   "
  CMD$ = LTRIM$(RTRIM$(CMD$))
 END IF

ON ERROR GOTO ErrorHandler

DEF SEG = &H40
 A = PEEK(&H10)

IF A AND 2 ^ 4 THEN       ' Bit 4 will be high if it's a BW card & monitor.
 ScreenSegment = &HB000
ELSE
 ScreenSegment = &HB800
END IF

  PathRestore = CurrentDirectory$("")
  QuitScrn = SaveScrn$
 
  WIDTH 80, Rows

IF MouseInit% THEN UseMouse = -1

CLS

IF INSTR(CMD$, "/?") THEN
 PRINT
 PRINT " Text viewer 1.0 command line options:"
 PRINT "    /43 sets screen resolution to 43 rows"
 PRINT "    /50 sets screen resolution to 50 rows"
 PRINT "    /? you already know that!"
 PRINT
 END
END IF

IF CMD$ = "" THEN
 DEF SEG = ScreenSegment: POKES 0, QuitScrn: DEF SEG
 A = Getfilename
 IF NOT A THEN
  DEF SEG = ScreenSegment: POKES 0, QuitScrn: DEF SEG
  LOCATE SaveRow, SaveCol: PRINT
  RestorePath
  END
 END IF
ELSE
 Loadfile CMD$
END IF

ON TIMER(1) GOSUB Updateit: TIMER ON

Mouseshow


Location = 0
GOSUB Updatescreen

DO
 DO: A = Keyboard: CALL Mouse(B1, B2, mX, mY): LOOP UNTIL A OR B1
 mX = mX \ 8: mY = mY \ 8: mX = mX + 1: mY = mY + 1

  SELECT CASE A
   CASE 70, 102
    FC = FC + 1: IF FC > 15 THEN FC = 0
    GOSUB Updatescreen
    
   CASE 98, 66
    BC = BC + 1: IF BC > 7 THEN BC = 0
    GOSUB Updatescreen
    
   CASE -80, 32
    ScrollDown
    Updatescrollbar

   CASE -72, 8
    ScrollUp
    Updatescrollbar
  
   CASE -77
    LL = LL + 1
     PrintText
     UpdateStatusBar
    
   CASE -75
    OL = LL
    LL = LL - 1: IF LL < 0 THEN LL = 0
    IF LL <> OL THEN PrintText: UpdateStatusBar
     
   CASE -81
     FOR Tmp = 1 TO Rows - 3
      ScrollDown
      WAIT &H3DA, 8
     NEXT
     Updatescrollbar
  
   CASE -73
     FOR Tmp = 1 TO Rows - 3
      ScrollUp
      WAIT &H3DA, 8
     NEXT
     Updatescrollbar
  
   CASE -71
     Location = 0
     GOSUB Updatescreen

   CASE -79
     IF MaxRows > 23 THEN Location = MaxRows - Rows + 3
     GOSUB Updatescreen

   CASE 27
    GOSUB Quit

   CASE 13, -67
     TIMER OFF
      Z = Getfilename
     TIMER ON
    IF Z THEN GOSUB Updatescreen
    
   CASE -59
    Help

  END SELECT

    IF B1 THEN
    
     IF mX = 80 AND mY = 2 THEN
      WAIT &H3DA, 8
      ScrollUp
      Updatescrollbar
    
     ELSEIF mX = 80 AND mY = Rows THEN
      WAIT &H3DA, 8
      ScrollDown
      Updatescrollbar
     
     ELSEIF mX = 80 AND mY = CINT((Location / (MaxRows - 22)) * (Rows - 4) + 3) THEN
      TIMER OFF
      COLOR 0, 0
      CALL Mousehide: CALL MouseArea(79 * 8, 2 * 8, 79 * 8, (Rows - 2) * 8)
      
      DO
       OldmY = mY
       CALL Mouse(B1, B2, mX, mY)
       mX = mX \ 8: mY = mY \ 8: mX = mX + 1: mY = mY + 1
       IF OldmY <> mY THEN
	 'Location = (Location / (MaxRows - 22)) * mY
	 Location = ((mY - 3) / (Rows - 4)) * (MaxRows - 22)
	 Updatescrollbar
       END IF
      LOOP WHILE B1
      
      CALL MouseArea(0, 0, 79 * 8, (Rows - 1) * 8): CALL Mouseshow
      TIMER ON
      GOSUB Updatescreen
      
     ELSEIF mX = 80 AND mY >= 2 AND mY <= ((Location / (MaxRows - 22)) * (Rows - 4)) + 3 THEN
       FOR Tmp = 1 TO Rows - 3
	ScrollUp
	WAIT &H3DA, 8
       NEXT
       Updatescrollbar

     ELSEIF mX = 80 AND mY <= Rows - 1 AND mY >= ((Location / MaxRows) * (Rows - 4)) + 3 THEN
       FOR Tmp = 1 TO Rows - 3
	ScrollDown
	WAIT &H3DA, 8
       NEXT
       Updatescrollbar
    
     ELSEIF mY = 1 AND mX > 1 AND mX < 8 THEN
	GOSUB Quit

     ELSEIF mY = 1 AND mX > 7 AND mX < 14 THEN
	Mousehide
	 Mouseloop 1
	Mouseshow
	Help
    
     END IF
   
    END IF
 
LOOP






Updatescreen:
TIMER OFF
Mousehide
 Scroll 7, 0, 1, 1, 24, 79, FC, BC
  COLOR 0, 7: LOCATE 1, 1: PRINT "  Quit  Help                                                                    ";
  PrintText
 GOSUB Updateit
Mouseshow
TIMER ON
RETURN





Updateit:
 Updatescrollbar
 UpdateStatusBar

RETURN

Quit:
TIMER OFF
 COLOR 0, 3
 CALL Mousehide: PCOPY 0, 1
  IF ScreenSegment = &HB800 THEN
   PALETTE FC, 24
   PALETTE BC, 0
   PALETTE 7, 56
  END IF
 Center Rows \ 2, " Do you really want to quit? (Y/N) "
TIMER ON
 DO: A$ = UCASE$(INKEY$): LOOP UNTIL A$ = "Y" OR A$ = "N"
 PCOPY 1, 0: GOSUB Updateit: CALL Mouseshow
 Savescreen$ = ""

 IF A$ = "Y" THEN
  Quitprogram
 ELSE
  PALETTE
  RETURN
 END IF

ErrorHandler:
 COLOR 0, 0: CLS : PALETTE
 Msgbox ErrorText$(ERR) + ".", 40, 12, 0, 7, "ERROR!", 10, 1
 DEF SEG = ScreenSegment: POKES 0, QuitScrn: DEF SEG
 LOCATE SaveRow, SaveCol: PRINT
END

REM $STATIC
SUB Center (R, T$)
LOCATE R, 41 - (LEN(T$) \ 2)
PRINT T$;
END SUB

FUNCTION CHDRiVe (Dr$)
DIM regsX AS RegTypeX
  IF Dr$ <> "" THEN
    DrNumber = ASC(UCASE$(LEFT$(Dr$, 1))) - 65
    IF DrNumber >= 0 AND DrNumber <= 25 THEN
      regsX.ax = &HE00
      regsX.dx = DrNumber
      INTERRUPTX &H21, regsX, regsX
      regsX.ax = &H1900
      INTERRUPTX &H21, regsX, regsX
      IF DrNumber <> (regsX.ax AND 255) THEN
	CHDRiVe = -1  'no such drive
      END IF
    END IF
  END IF

END FUNCTION

FUNCTION CurrentDirectory$ (Dr$)
DIM regsX AS RegTypeX
  DIM Buffer(128)

  aseg = VARSEG(Buffer(0))
  aptr = VARPTR(Buffer(0))

  IF Dr$ = "" THEN
    regsX.ax = &H1900
    INTERRUPTX &H21, regsX, regsX
    DrCode = (regsX.ax AND 255) + 1
    Dr$ = CHR$(DrCode + 64)
  ELSE
    Dr$ = UCASE$(LEFT$(Dr$, 1))
    DrCode = ASC(Dr$) - 64
  END IF

  regsX.ax = &H4700
  regsX.dx = DrCode
  regsX.ds = aseg
  regsX.si = aptr

  INTERRUPTX &H21, regsX, regsX

  IF regsX.ax = 15 THEN
    ERROR 68       'no such drive
  ELSE
    DEF SEG = aseg
    FOR A = 0 TO 128
      F$ = F$ + CHR$(PEEK(aptr + A))
    NEXT
    DEF SEG

    CurrentDirectory$ = Dr$ + ":\" + LEFT$(F$, INSTR(F$, CHR$(0)) - 1)
  END IF


END FUNCTION

FUNCTION ErrorText$ (ErrorNum)
SELECT CASE ErrorNum
CASE 1: ErrorText$ = "NEXT without FOR"
CASE 2: ErrorText$ = "Syntax error"
CASE 3: ErrorText$ = "RETURN without GOSUB"
CASE 4: ErrorText$ = "Out of DATA"
CASE 5: ErrorText$ = "Illegal function call"
CASE 6: ErrorText$ = "Overflow"
CASE 7: ErrorText$ = "Out of memory"
CASE 8: ErrorText$ = "Label not defined"
CASE 9: ErrorText$ = "Subscript out of range"
CASE 10: ErrorText$ = "Duplicate definition"
CASE 11: ErrorText$ = "Division by zero"
CASE 12: ErrorText$ = "Illegal in direct mode"
CASE 13: ErrorText$ = "Type mismatch"
CASE 14: ErrorText$ = "Out of string space"
CASE 16: ErrorText$ = "String formula too complex"
CASE 17: ErrorText$ = "Cannot continue"
CASE 18: ErrorText$ = "Function not defined"
CASE 19: ErrorText$ = "No RESUME"
CASE 20: ErrorText$ = "RESUME without error"
CASE 24: ErrorText$ = "Device timeout"
CASE 26: ErrorText$ = "Device fault"
CASE 27: ErrorText$ = "Out of paper"
CASE 29: ErrorText$ = "WHILE without WEND"
CASE 30: ErrorText$ = "WEND without WHILE"
CASE 33: ErrorText$ = "Duplicate label"
CASE 35: ErrorText$ = "Subprogram not defined"
CASE 37: ErrorText$ = "Argument-count mismatch"
CASE 38: ErrorText$ = "Array not defined"
CASE 40: ErrorText$ = "Variable required"
CASE 50: ErrorText$ = "FIELD overflow"
CASE 51: ErrorText$ = "Internal error"
CASE 52: ErrorText$ = "Bad file name of number"
CASE 53: ErrorText$ = "File not found"
CASE 54: ErrorText$ = "Bad file mode"
CASE 55: ErrorText$ = "File already open"
CASE 56: ErrorText$ = "FIELD statement active"
CASE 57: ErrorText$ = "Device I/O error"
CASE 58: ErrorText$ = "File already exists"
CASE 59: ErrorText$ = "Bad record length"
CASE 61: ErrorText$ = "Disk full"
CASE 62: ErrorText$ = "Input past end of file"
CASE 63: ErrorText$ = "Bad record number"
CASE 64: ErrorText$ = "Bad file name"
CASE 67: ErrorText$ = "Too many files"
CASE 68: ErrorText$ = "Device unavailable"
CASE 69: ErrorText$ = "Communication-buffer overflow"
CASE 70: ErrorText$ = "Permission denied"
CASE 71: ErrorText$ = "Disk not ready"
CASE 72: ErrorText$ = "Disk-media error"
CASE 73: ErrorText$ = "Feature unavailable"
CASE 74: ErrorText$ = "Rename across disks"
CASE 75: ErrorText$ = "Path/File access error"
CASE 76: ErrorText$ = "Path not found"
END SELECT:

END FUNCTION

FUNCTION FloppyDriveReady% (drive$)

 ' This function may also be used independently from
 ' the Exist% function. It returns -1, true if the
 ' drive is ready, or 0, false, if the drive is not
 ' ready, or the drive letter is an invalid drive.

 drive% = (ASC(drive$) OR 32) - 97

 'reset floppy drive
 inreg.ax = 0
 inreg.dx = drive%
 CALL INTERRUPTX(&H13, inreg, inreg)

 inreg.ax = &H401     'verify disk sector
 inreg.cx = &H101
 inreg.dx = drive%
 CALL INTERRUPTX(&H13, inreg, inreg)
 'call the interrupt twice since if a disk has just been
 'inserted, the first time gives a wrong answer
 inreg.ax = &H401
 inreg.cx = &H101
 inreg.dx = drive%
 CALL INTERRUPTX(&H13, inreg, inreg)

 'if it was a hard disk we just checked forget the whole thing
 IF inreg.ax AND 256 THEN
   inreg.ax = &H1C00      ' check drive type
   inreg.dx = drive% + 1  ' diff. drive number system must add 1
   CALL INTERRUPTX(&H21, inreg, inreg)
   ' check if drive was a valid drive letter.
   IF (inreg.ax AND &HFF) = &HFF THEN HardCheck = 0 ELSE HardCheck = -1
 END IF

 FloppyDriveReady% = ((inreg.flags AND 1) = 0) OR HardCheck

END FUNCTION

SUB Getdir (Entryname$(), EType, FileDate, DirNum, Path$, Status)

IF EType = 1 THEN FT = 32 ELSE FT = 16

  ' Entryname$() is where the file & dir names are stored
  ' EType: If EType = 2 then you'll get dirs in the Entryname$() else
  '        you'll get files.
  ' Filedate: Specify true if you want dates after the file & dir names in
  '           Entryname$().
  ' DirNum: Number of items found
  ' Path$: Where and what to look after. (ex. "C:\*.*")
  ' Status: Status is true if an error has occured

   DirNum = 0
   DIM Buffer AS FileFindBuf

    inreg.ax = &H1A00
    inreg.ds = VARSEG(Buffer)
    inreg.dx = VARPTR(Buffer)
    CALL INTERRUPTX(&H21, inreg, inreg)
    inreg.ax = &H4E00
    inreg.cx = 16
    Npath$ = Path$ + CHR$(0)
    inreg.dx = SADD(Npath$)
    CALL INTERRUPTX(&H21, inreg, inreg)
    FirstFM = (inreg.ax AND &HF)

    IF inreg.flags AND 1 THEN
	Status = -1
	EXIT SUB
    ELSE
	Status = 0
    END IF

    IF FirstFM = 0 THEN
	GOSUB MakeFile
	DO
	    inreg.ax = &H4F00
	    inreg.dx = SADD(Npath$)
	    CALL INTERRUPTX(&H21, inreg, inreg)
	    NextFM = inreg.ax AND &HF
	    IF NextFM <> 0 THEN
		EXIT DO
	    ELSE
		GOSUB MakeFile
	    END IF
	LOOP
    END IF
    EXIT SUB


MakeFile:

 IF (ASC(Buffer.Attributes) = FT OR FT = 32 AND ASC(Buffer.Attributes) < 16) AND LEFT$(Buffer.Filename, 2) <> "." + CHR$(0) THEN

    Entry$ = RTRIM$(Buffer.Filename)
      IF FileDate THEN GOSUB MakeDateTime

	 FOR A = 1 TO LEN(Entry$)
	  Y$ = MID$(Entry$, A, 1)
	  IF Y$ <> CHR$(0) AND Y$ <> " " THEN Lastchar = A
	 NEXT A
   
	Entryname$(DirNum) = LEFT$(Entry$, Lastchar)
	DirNum = DirNum + 1
 END IF

      Buffer.Attributes = ""
      Buffer.AccessTime = ""
      Buffer.AccessDate = ""
      Buffer.FileSize = 0
      Buffer.Filename = SPACE$(13)

RETURN







MakeDateTime:

    Aika% = CVI(Buffer.AccessTime)
     sek = 0
    IF (Aika% AND 1) = 1 THEN sek = sek + 1           '0
    IF (Aika% AND 2) = 2 THEN sek = sek + 2           '1
    IF (Aika% AND 4) = 4 THEN sek = sek + 4           '2
    IF (Aika% AND 8) = 8 THEN sek = sek + 8           '3
    IF (Aika% AND 16) = 16 THEN sek = sek + 16        '4
    sek = sek * 2
     min = 0
    IF (Aika% AND 32) = 32 THEN min = min + 1
    IF (Aika% AND 64) = 64 THEN min = min + 2
    IF (Aika% AND 128) = 128 THEN min = min + 4
    IF (Aika% AND 256) = 256 THEN min = min + 8
    IF (Aika% AND 512) = 512 THEN min = min + 16
    IF (Aika% AND 1024) = 1024 THEN min = min + 32
     hh = 0
    IF (Aika% AND 2048) = 2048 THEN hh = hh + 1
    IF (Aika% AND 4096) = 4096 THEN hh = hh + 2
    IF (Aika% AND 8192) = 8192 THEN hh = hh + 4
    IF (Aika% AND 16384) = 16384 THEN hh = hh + 8
    IF (Aika% AND 32768) = 32768 THEN hh = hh + 16


    Pvm% = CVI(Buffer.AccessDate)
    pv = 0
    IF (Pvm% AND 1) = 1 THEN pv = pv + 1
    IF (Pvm% AND 2) = 2 THEN pv = pv + 2
    IF (Pvm% AND 4) = 4 THEN pv = pv + 4
    IF (Pvm% AND 8) = 8 THEN pv = pv + 8
    IF (Pvm% AND 16) = 16 THEN pv = pv + 16

    kk = 0
    IF (Pvm% AND 32) = 32 THEN kk = kk + 1
    IF (Pvm% AND 64) = 64 THEN kk = kk + 2
    IF (Pvm% AND 128) = 128 THEN kk = kk + 4
    IF (Pvm% AND 256) = 256 THEN kk = kk + 8

    vv = 0
    IF (Pvm% AND 512) = 512 THEN vv = vv + 1
    IF (Pvm% AND 1024) = 1024 THEN vv = vv + 2
    IF (Pvm% AND 2048) = 2048 THEN vv = vv + 4
    IF (Pvm% AND 4096) = 4096 THEN vv = vv + 8
    IF (Pvm% AND 8192) = 8192 THEN vv = vv + 16
    IF (Pvm% AND 16384) = 16384 THEN vv = vv + 32
    IF (Pvm% AND 32768) = 32768 THEN vv = vv + 64
    vv = 1980 + vv

    Aika$ = STRING$(2 - LEN(LTRIM$(STR$(hh))), "0") + LTRIM$(STR$(hh)) + ":" + STRING$(2 - LEN(LTRIM$(STR$(min))), "0") + LTRIM$(STR$(min)) + "." + STRING$(2 - LEN(LTRIM$(STR$(sek))), "0") + LTRIM$(STR$(sek))
    Pvm$ = STRING$(2 - LEN(LTRIM$(STR$(pv))), "0") + LTRIM$(STR$(pv)) + "/" + STRING$(2 - LEN(LTRIM$(STR$(kk))), "0") + LTRIM$(STR$(kk)) + "/" + RIGHT$(STR$(vv), 2)

  Tim$ = Pvm$
  Dat$ = Aika$

 Entry$ = Entry$ + " | " + Tim$ + " " + Dat$

RETURN

END SUB

FUNCTION Getfilename

Filename$ = SelectFile$("*.*")

IF LEN(Filename$) THEN
 Loadfile Filename$
 Getfilename = -1
ELSE
 EXIT FUNCTION
END IF

END FUNCTION

SUB Help

HelpMsg$ = "This help can be called by pressing the F1 key"
HelpMsg$ = HelpMsg$ + " or clicking on help in the menuline. "
HelpMsg$ = HelpMsg$ + "To scroll down, press the down-key and to scroll up,"
HelpMsg$ = HelpMsg$ + " press the up-key. You can also scroll by using the mouse "
HelpMsg$ = HelpMsg$ + "to click on the scrollbar. To scroll one page at once, "
HelpMsg$ = HelpMsg$ + "use the Page Up / Page Down keys. To load a new file, press ENTER or F9."
HelpMsg$ = HelpMsg$ + " This program is freeware"
HelpMsg$ = HelpMsg$ + " and I take no responsibility for any damage. (Yepp, the same"
HelpMsg$ = HelpMsg$ + " words everytime!)"

Msgbox HelpMsg$, 45, 12, 0, 3, "Text viewer, by Anders Olofsson 1998.", 1, 1
END SUB

FUNCTION Keyboard
 S$ = INKEY$
 IF LEN(S$) = 1 THEN
  Keyboard = ASC(S$)
 ELSEIF LEN(S$) = 2 THEN
  Keyboard = -ASC(RIGHT$(S$, 1))
 END IF
END FUNCTION

SUB Loadfile (n$)
ReMakeArray
COLOR 0, 3
F = FREEFILE
OPEN n$ FOR INPUT AS #F
 DO
  LINE INPUT #F, T$
  IF INSTR(T$, CHR$(9)) THEN
   FOR Srch = 1 TO LEN(T$)
    IF INSTR(Srch, T$, CHR$(9)) THEN T$ = LEFT$(T$, INSTR(Srch, T$, CHR$(9)) - 1) + "        " + RIGHT$(T$, LEN(T$) - INSTR(Srch, T$, CHR$(9)))
   NEXT
  END IF
  Text(Counter) = T$
  Counter = Counter + 1
  IF Counter > UBOUND(Text) OR FRE(-1) < 1024 THEN GOTO FileTooLarge
 LOOP UNTIL EOF(F)
CLOSE #F
MaxRows = Counter
EXIT SUB

FileTooLarge:
 Msgbox "The file is too large." + STR$(Counter - 1) + " lines loaded into memory.", 50, 5, 0, 7, "File too large", 10, 1
 MaxRows = Counter - 1
 CLOSE #F
EXIT SUB

END SUB

SUB Mouse (B1, B2, X, Y)
IF NOT UseMouse THEN EXIT SUB
inreg.ax = 3
INTERRUPTX &H33, inreg, inreg
B1 = inreg.BX AND 1
B2 = inreg.BX AND 2
X = inreg.cx
Y = inreg.dx

END SUB

SUB MouseArea (X, Y, x2, y2)
IF NOT UseMouse THEN EXIT SUB
inreg.ax = 7
inreg.cx = X
inreg.dx = x2
INTERRUPTX &H33, inreg, inreg

inreg.ax = 8
inreg.cx = Y
inreg.dx = y2
INTERRUPTX &H33, inreg, inreg

END SUB

SUB Mousehide
IF NOT UseMouse THEN EXIT SUB
inreg.ax = 2
INTERRUPTX &H33, inreg, inreg
END SUB

DEFSNG A-Z
FUNCTION MouseInit%

inreg.ax = 0
CALL INTERRUPTX(&H33, inreg, inreg)
MouseInit% = inreg.ax

END FUNCTION

DEFINT A-Z
SUB Mouseloop (BTN)
DO
 CALL Mouse(B1, B2, X, X)
LOOP WHILE (B1 = BTN) XOR (B2 = BTN)

END SUB

SUB MousePut (X, Y)

inreg.ax = 4
inreg.cx = X%
inreg.dx = Y%
INTERRUPTX &H33, inreg, inreg

END SUB

SUB Mouseshow

inreg.ax = 1
INTERRUPTX &H33, inreg, inreg
END SUB

SUB MouseSoftReset

inreg.ax = 33
INTERRUPTX &H33, inreg, inreg
END SUB

SUB Msgbox (T$, Wid, BorderC, TextC, WindowC, Title$, Tcolor, Waitkey)
DIM Message(50) AS STRING
CALL Mousehide: DEF SEG = ScreenSegment: Savescreen$ = PEEK$(0, 3999): DEF SEG : CALL Mouseshow
WrapLine Wid - 4, T$, Message(), Lines
COLOR BorderC, WindowC
Center Rows \ 2 - (Lines \ 2), CHR$(218) + STRING$(Wid - 2, 196) + CHR$(191)
Center Rows \ 2 - (Lines \ 2), CHR$(180) + SPACE$(LEN(Title$)) + CHR$(195)
COLOR Tcolor
Center Rows \ 2 - (Lines \ 2), Title$
FOR Z = 1 TO Lines
COLOR BorderC, WindowC
Center Rows \ 2 - (Lines \ 2) + Z, "³ " + LEFT$(SPACE$(180), Wid - 4) + " ³"
COLOR TextC
Center Rows \ 2 - (Lines \ 2) + Z, LEFT$(Message(Z) + SPACE$(80), Wid - 4)
NEXT
COLOR BorderC, WindowC
Center Rows \ 2 - (Lines \ 2) + Z, CHR$(192) + STRING$(Wid - 2, 196) + CHR$(217)
COLOR TextC
IF Waitkey THEN
 DO: CALL Mouse(B1, B2, n, n): LOOP UNTIL LEN(INKEY$) OR B1 OR B2: Mouseloop B1
 CALL Mousehide: DEF SEG = ScreenSegment: POKES 0, Savescreen$: DEF SEG : CALL Mouseshow
END IF
END SUB

FUNCTION PEEK$ (Start, Length)
T$ = SPACE$((Length - Start) + 1)
FOR A& = Start TO Length
 Z& = Z& + 1
 MID$(T$, Z&, 1) = CHR$(PEEK(A&))
NEXT A&
SWAP PEEK$, T$

END FUNCTION

SUB POKES (Start, S$)
FOR A& = Start + 1 TO LEN(S$)
 POKE A& - 1, ASC(MID$(S$, A&, 1))
NEXT A&

END SUB

SUB Printdocument
 Msgbox "This sub has'nt been written yet!!! (Since I don't have a printer... But you can write it yourself.)", 30, 4, 0, 7, "Wait for next version!", 10, 1

END SUB

SUB PrintText
 Mousehide
   A = 2
   FOR Z = Location TO Location + (Rows - 3)
    IF Z <= MaxRows AND Z >= LBOUND(Text) THEN Writestring A, 1, LEFT$(MID$(Text(Z), LL + 1, 79) + SPACE$(79), 79), BC * 16 + FC
    ' LOCATE A, 1: PRINT LEFT$(MID$(Text(Z), LL + 1, 79) + SPACE$(79), 79);
    A = A + 1
   NEXT Z
 Mouseshow
END SUB

SUB Quitprogram
   TIMER OFF
   Mousehide
   LOCATE Rows, 1: COLOR 0, 0
    FOR Z = 1 TO Rows
     PRINT SPACE$(80);
     WAIT &H3DA, 8
    NEXT
   COLOR 7, 0: PALETTE
   DEF SEG = ScreenSegment: POKES 0, QuitScrn: DEF SEG
   RestorePath
   LOCATE SaveRow, SaveCol: PRINT
  END
END SUB

SUB ReMakeArray
Location = 0
LL = 0
REDIM Text(1596) AS STRING
END SUB

SUB RestorePath
   Z = CHDRiVe(LEFT$(PathRestore, 2))
   CHDIR PathRestore
END SUB

FUNCTION RINSTR (T$, S$)
 FOR A = LEN(T$) TO 1 STEP -1
  IF INSTR(A, T$, S$) THEN RINSTR = A: EXIT FUNCTION
 NEXT
END FUNCTION

FUNCTION SaveScrn$
DEF SEG = ScreenSegment
 SaveScrn$ = PEEK$(0, 80 * Rows * 2)
DEF SEG
END FUNCTION

SUB Scroll (Direction%, NumRows%, Tlrow%, Tlcol%, Brrow%, Brcol%, Fore%, Back%)
''''''''''
'
'  SCROLL  Scrolls an Individual window on the Screen
'
''''''''''
'
'  Parameters:
'     Direction% = 6 for scroll up, 7 for scroll down
'     NumRows%   = # rows to scroll, 0 for clear area
'     Tlrow%     = top left row of window to be cleared
'     Tlcol%     = top left column of window to be cleared
'     Brrow%     = bottom right row of window to be cleared
'     Brcol%     = bottom right column of window to be cleared
'     Fore%      = foreground color of window
'     Back%      = background color of window
'
'  Interrupt x'10' user for video interface:
'
'      Ah = 6 for scroll window up, 7 for scroll window down
'      Al = # lines to scroll window, 0 for clear window
'      ch,cl = Row,Col of upper left corner of window
'      dh,dl = Row,Col of lower right corner of window
'      bh = clear screen attribute
'
  IF (Direction% < 6 OR Direction% > 7) THEN EXIT SUB  'bad direction code
  inreg.ax = Direction% * 256 + NumRows          'ah=up/dn, al=# lines
  inreg.BX = Fore% * &H100 + Back% * &H1000      'bh=clear attribute
  inreg.cx = (Tlrow% - 1) * &H100 + Tlcol% - 1   'cx=row,col of upper left
  inreg.dx = (Brrow% - 1) * &H100 + Brcol% - 1   'dx=row,col of lower right
  CALL INTERRUPTX(&H10, inreg, OutReg)

END SUB

SUB ScrollDown
IF NOT Location + Rows - 3 < MaxRows THEN EXIT SUB
TIMER OFF
Mousehide
 Location = Location + 1
  Scroll 6, 1, 2, 1, Rows - 1, 79, FC, BC
  Writestring Rows - 1, 1, MID$(Text(Location + Rows - 3), LL + 1, 79), BC * 16 + FC
 UpdateStatusBar
Mouseshow
TIMER ON
END SUB

SUB ScrollUp
IF Location > LBOUND(Text) THEN Location = Location - 1 ELSE EXIT SUB
TIMER OFF
Mousehide
  Scroll 7, 1, 2, 1, Rows - 1, 79, FC, BC
  Writestring 2, 1, MID$(Text(Location), LL + 1, 79), BC * 16 + FC
 UpdateStatusBar
Mouseshow
TIMER ON

END SUB

FUNCTION SelectFile$ (FileType$)

REDIM Files$(0), Dirs$(0)
SScreen$ = SaveScrn$
 Win Rows \ 2 - 8, 17, 80 - 33, 14, 1, 7, 3, 8
 COLOR 3, 0: LOCATE Rows \ 2 - 8, 19: PRINT "";
 COLOR 7: PRINT " Select file to view: ";

 COLOR 0, 7
  LOCATE Rows \ 2 - 6, 25: PRINT "Files"
  LOCATE Rows \ 2 - 6, 44: PRINT "Dirs/Drives"

 SelectedList = 1
 GOSUB RefreshDir
 
  DO
   
    Z = Keyboard
    
     SELECT CASE Z
      CASE -80
       IF SelectedList = 1 THEN
	OldF = SelectedFile
	SelectedFile = SelectedFile + 1
	IF SelectedFile > Num.Files - 1 THEN SelectedFile = Num.Files - 1
	IF SelectedFile > FileLoc + 10 THEN FileLoc = SelectedFile - 10
	IF OldF <> SelectedFile THEN GOSUB RefreshList
       ELSE
	OldD = SelectedDir
	SelectedDir = SelectedDir + 1
	IF SelectedDir > Num.Dirs - 1 THEN SelectedDir = Num.Dirs - 1
	IF SelectedDir > DirLoc + 10 THEN DirLoc = SelectedDir - 10
	IF OldD <> SelectedDir THEN GOSUB RefreshList
       END IF

      CASE -72
       IF SelectedList = 1 THEN
	OldF = SelectedFile
	SelectedFile = SelectedFile - 1
	IF SelectedFile < 0 THEN SelectedFile = 0
	IF SelectedFile < FileLoc THEN FileLoc = SelectedFile
	IF OldF <> SelectedFile THEN GOSUB RefreshList
       ELSE
	OldD = SelectedDir
	SelectedDir = SelectedDir - 1
	IF SelectedDir < 0 THEN SelectedDir = 0
	IF SelectedDir < DirLoc THEN DirLoc = SelectedDir
	IF OldD <> SelectedDir THEN GOSUB RefreshList
       END IF

      CASE -79
       IF SelectedList = 2 THEN
	DirLoc = Num.Dirs - 11: SelectedDir = Num.Dirs - 1
       ELSE
	FileLoc = Num.Files - 11: SelectedFile = Num.Files - 1
       END IF
	GOSUB RefreshList
     
      CASE -71
       IF SelectedList = 2 THEN
	DirLoc = 0: SelectedDir = 0
       ELSE
	FileLoc = 0: SelectedFile = 0
       END IF
	GOSUB RefreshList

      CASE -81
       IF SelectedList = 1 THEN
	OldF = SelectedFile
	SelectedFile = SelectedFile + 10
	IF SelectedFile > Num.Files - 1 THEN SelectedFile = Num.Files - 1
	IF SelectedFile > FileLoc + 10 THEN FileLoc = SelectedFile - 10
	IF SelectedFile <> OldF THEN GOSUB RefreshList
       ELSE
	OldD = SelectedDir
	SelectedDir = SelectedDir + 10
	IF SelectedDir > Num.Dirs - 1 THEN SelectedDir = Num.Dirs - 1
	IF SelectedDir > DirLoc + 10 THEN DirLoc = SelectedDir - 10
	IF OldD <> SelectedDir THEN GOSUB RefreshList
       END IF
     
      CASE -73
       IF SelectedList = 1 THEN
	OldF = SelectedFile
	SelectedFile = SelectedFile - 10
	IF SelectedFile < 0 THEN SelectedFile = 0
	IF SelectedFile < FileLoc THEN FileLoc = SelectedFile
	IF OldF <> SelectedFile THEN GOSUB RefreshList
       ELSE
	OldD = SelectedDir
	SelectedDir = SelectedDir - 10
	IF SelectedDir < 0 THEN SelectedDir = 0
	IF SelectedDir < DirLoc THEN DirLoc = SelectedDir
	IF OldD <> SelectedDir THEN GOSUB RefreshList
       END IF
      
      CASE -77, -75, 9
       SelectedList = (SelectedList AND 1) + 1
       GOSUB RefreshList
     
      CASE 13
       IF SelectedList = 1 THEN
	SelectFile$ = Files$(SelectedFile)
	EXIT FUNCTION
       ELSEIF SelectedList = 2 THEN
	IF MID$(Dirs$(SelectedDir), 5, 1) <> ":" THEN
	 CHDIR Dirs$(SelectedDir)
	ELSE
	 T$ = CurrentDirectory$("")
	 DO
	  IF CHDRiVe(MID$(Dirs$(SelectedDir), 4, 1)) OR NOT FloppyDriveReady(MID$(Dirs$(SelectedDir), 4, 1)) THEN
	   PCOPY 0, 1
	    Msgbox ErrorText$(71) + "! Do you want to try again? (Y/N)", 40, 2, 0, 7, "Drive error!", 10, 0
	    DO: Z = Keyboard: LOOP UNTIL Z
	   IF UCASE$(CHR$(Z)) = "N" THEN
	     Z = CHDRiVe(LEFT$(T$, 2))
	     EXIT DO
	   END IF
	   PCOPY 1, 0
	  ELSE
	   EXIT DO
	  END IF
	 LOOP
	END IF
	GOSUB RefreshDir
       END IF

      CASE 27
	EXIT DO
     
      CASE -83
       IF SelectedList = 1 THEN
	PCOPY 0, 1
	 Msgbox "Do you want to delete " + Files$(SelectedFile) + "? (Y/N)", 50, 12, 0, 3, "Confirm", 10, 0: COLOR 7, 0
	 DO: A$ = UCASE$(CHR$(Keyboard)): LOOP UNTIL A$ = "Y" OR A$ = "N"
	PCOPY 1, 0
	  IF A$ = "Y" THEN
	   KILL Files$(SelectedFile)
	   SF = SelectedFile - 1: IF SF < 0 THEN SF = 0
	   FL = FileLoc: DL = DirLoc: SD = SelectedDir
	   GOSUB RefreshDir
	    SelectedFile = SF: SelectedDir = SD
	    SelectedList = 1: FileLoc = FL: DirLoc = DL
	   GOSUB RefreshList
	  END IF
       END IF
    
      CASE ELSE
       IF SelectedList = 1 AND Z >= 0 THEN
	FOR T = 0 TO Num.Files
	 IF UCASE$(LEFT$(Files$(T), 1)) = UCASE$(CHR$(Z)) THEN
	  SelectedFile = T
	  FileLoc = T
	  GOSUB RefreshList
	  EXIT FOR
	 END IF
	NEXT
       ELSEIF Z >= 0 THEN
	FOR T = 0 TO Num.Dirs
	 IF UCASE$(LEFT$(Dirs$(T), 1)) = UCASE$(CHR$(Z)) THEN
	  SelectedDir = T
	  DirLoc = T
	  GOSUB RefreshList
	  EXIT FOR
	 END IF
	NEXT
       END IF
     END SELECT

  LOOP
 
  DEF SEG = ScreenSegment: POKES 0, SScreen$: DEF SEG

  EXIT FUNCTION

 EXIT FUNCTION




RefreshDir:
 REDIM Files$(768), Dirs$(768)
  CALL Getdir(Files$(), 1, 0, Num.Files, FileType$, Status)
  CALL Getdir(Dirs$(), 2, 0, Num.Dirs, "*.*", Status)
   
   Sort Files$(), 0, Num.Files - 1
   Sort Dirs$(), 0, Num.Dirs - 1
   
    TmpDir$ = CurrentDirectory$("")
     FOR A = 1 TO 26
      IF CHDRiVe(CHR$(64 + A)) <> -1 THEN
       Dirs$(Num.Dirs) = "   " + CHR$(64 + A) + ":"
       Num.Dirs = Num.Dirs + 1
      END IF
     NEXT
    A = CHDRiVe(LEFT$(TmpDir$, 2))

   IF Status THEN ERROR 76
  DirLoc = 0: FileLoc = 0
  SelectedDir = 0
  SelectedFile = 0

RefreshList:
 COLOR 7, 0
 DIM V AS STRING * 15
 FOR R = 0 TO 10
   Num = (R) + FileLoc
   V = LEFT$(Files$(Num), 14)
   LOCATE R + Rows \ 2 - 5, 20: PRINT "  " + V + "  ";
    IF Num = SelectedFile AND SelectedList <> 1 THEN
     COLOR 7, 0
     LOCATE R + Rows \ 2 - 5, 20: PRINT " " + V + " ";
    ELSEIF Num = SelectedFile AND SelectedList = 1 THEN
     IF ScreenSegment = &HB800 THEN COLOR 7, 1 ELSE COLOR 7, 0
     LOCATE R + Rows \ 2 - 5, 20: PRINT " " + V + " ";
     COLOR 7, 0
    END IF
 NEXT
  
 FOR R = 0 TO 10
   Num = (R) + DirLoc
   V = LEFT$(Dirs$(Num), 14)
   LOCATE R + Rows \ 2 - 5, 42: PRINT "  " + V + "  ";
    IF Num = SelectedDir AND SelectedList <> 2 THEN
     COLOR 7, 0
     LOCATE R + Rows \ 2 - 5, 42: PRINT " " + V + " ";
    ELSEIF Num = SelectedDir AND SelectedList = 2 THEN
     IF ScreenSegment = &HB800 THEN COLOR 7, 1 ELSE COLOR 7, 0
     LOCATE R + Rows \ 2 - 5, 42: PRINT " " + V + " ";
     COLOR 7, 0
    END IF
 NEXT


RETURN


END FUNCTION

SUB Sort (Arr$(), Start, E)
FOR Z = Start TO E
 FOR Y = Start TO E
  IF Arr$(Z) < Arr$(Y) THEN SWAP Arr$(Z), Arr$(Y)
 NEXT Y
NEXT Z
END SUB

SUB Updatescrollbar
Mousehide
COLOR 0, 7
FOR Tmp = 3 TO Rows - 1
 LOCATE Tmp, 80: PRINT CHR$(176);
NEXT
LOCATE 2, 80: PRINT CHR$(24);
LOCATE Rows, 80: PRINT CHR$(25);
COLOR 0, 0
LOCATE (Location / (MaxRows - 22)) * (Rows - 4) + 3, 80: PRINT " ";
Mouseshow
END SUB

SUB UpdateStatusBar
TIMER OFF
 Mousehide
 LOCATE Rows, 1
 COLOR 0, 3
  PRINT USING " Row #### "; Location;
 COLOR 0, 7
  PRINT USING " Col #### "; LL + 1;
 COLOR 7, 4
  PRINT " Time: ";
 COLOR 0, 10
  PRINT " "; TIME$; " ";
 COLOR 7, 4
  PRINT " Date: ";
 COLOR 0, 10
  PRINT " "; DATE$; " ";
 COLOR 6, 0
 Mouseshow
TIMER ON
END SUB

SUB Win (R1, C1, Wid, Hei, S, WindowC, TitleC, ShadowC)
COLOR WindowC, TitleC
LOCATE R1, C1: PRINT SPACE$(Wid);

FOR R = R1 + 1 TO R1 + Hei
 LOCATE R, C1
 COLOR 0, WindowC
 PRINT SPACE$(Wid);
  IF S THEN
   COLOR ShadowC, 0
   PRINT CHR$(SCREEN(CSRLIN, POS(0)));
   PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  END IF
NEXT R

IF S THEN
 COLOR ShadowC, 0
  FOR Z = C1 + 1 TO C1 + Wid + 1
   LOCATE R1 + Hei + 1, Z: PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  NEXT
END IF

END SUB

SUB WrapLine (Strlen, StrIn$, ParsedLines$(), NumOfLines)
 
  IF StrIn$ = "" THEN
    NumOfLines = 0
    EXIT SUB
  END IF
  'If string to split is nothing, exit.

  Work$ = StrIn$                     'Keep original value in StrIn$
  Done = False                       'reset flag

  DO
    IF LEN(Work$) > Strlen THEN
      NumOfLines = NumOfLines + 1    'Increment index to array
      WorkPlus$ = LEFT$(Work$, Strlen + 1)
      'WorkPlus$ is used to see if there is a space immediately
      'after the requested split point so we do not split a word.

      FOR SearchStartPos = Strlen TO 1 STEP -1
	LastSpacePos = INSTR(SearchStartPos, WorkPlus$, " ")
	IF LastSpacePos THEN
	  ParsedLines$(NumOfLines) = LTRIM$(RTRIM$(LEFT$(Work$, LastSpacePos)))  'Put left (StrLen) chars in array
	  Work$ = MID$(Work$, SearchStartPos + 1)
	  'Remove parsed segment from Work$
	  EXIT FOR
	END IF
      NEXT SearchStartPos

    ELSE
      Done = -1
    END IF
  
  LOOP UNTIL Done

  NumOfLines = NumOfLines + 1   'Save remainder of StrIn$
  ParsedLines$(NumOfLines) = LTRIM$(Work$)

END SUB

SUB Writestring (Y, X, S$, C)
Memloc = 80 * (Y - 1) + (X - 1)
Memloc = Memloc * 2

DEF SEG = ScreenSegment
 FOR T = 0 TO LEN(S$) - 1
  POKE Memloc, ASC(MID$(S$, T + 1, 1))
  POKE Memloc + 1, C
  Memloc = Memloc + 2
 NEXT T
DEF SEG

END SUB