'===========================================================================
' Subject: BASIC FILE DATABASE                Date: 12-24-97 (15:25)       
'  Author: Sami Kyostila                      Code: QB, PDS                
'  Origin: hiteck@freenet.hut.fi            Packet: MISC.ABC
'===========================================================================
DECLARE FUNCTION Comma$ (Number&)
DECLARE FUNCTION CountComments% (File$)
DECLARE SUB Info (File$)
DECLARE SUB Options ()
DECLARE SUB Help (HelpScreen%)
DECLARE SUB Roller (x%, y%, XLen%, Text$, FCol%, BCol%, RollerPos%, RollerCount%)
DECLARE SUB ChooseCompiler (File%, Item%)
DECLARE FUNCTION FormatNumber$ (Num%, Nums%, Zero$)
DECLARE FUNCTION CountLines% (File$)
DECLARE SUB MapEMS (EMMhandle%, PhysicalPage%, LogicalPage%)
DECLARE SUB ViewFile (File$, me$)
DECLARE SUB SeekFileItem (File%, Item%)
DECLARE SUB DrawFileList (File%, Offset%, Selected%, Max%)
DECLARE SUB QueryFile (Main$)
DECLARE FUNCTION CountItems2% (File%)
DECLARE SUB RemoveTagged (File$)
DECLARE SUB DeleteItem (File$, Item%)
DECLARE SUB SeekLine (File%, Item%)
DECLARE SUB DrawTree (File%, Selected%, Offset%)
DECLARE SUB GetEntry (File%, Entry AS ANY, Item%)
DECLARE FUNCTION InputField$ (Text$, Key$, MaxLen%, TPos%)
DECLARE FUNCTION Query$ (Text$, Topic$, MaxLen%, TextField$)
DECLARE SUB Switch (Var%, Value1%, Value2%)
DECLARE FUNCTION FindGroupNumber% (Find$, group$())
DECLARE FUNCTION CountChildren% (Parent$, group$())
DECLARE SUB PushStack (Name$, Stack$())
DECLARE FUNCTION PopStack$ (Stack$())
DECLARE FUNCTION ViewTree$ (Text$)
DECLARE SUB GenerateTree ()
DECLARE SUB KewlPrint (Text$, Row%)
DECLARE FUNCTION FileFromEms$ (Index%)
DECLARE SUB FileToEms (File$, Index%)
DECLARE SUB ReadFiles2EMS (File%)
DECLARE SUB EndProg ()
DECLARE FUNCTION AllocateEMSPages% (PagesNeeded%, EMMhandle%)
DECLARE FUNCTION DeallocateEMSPages% (handle%)
DECLARE FUNCTION EMMInstalled% ()
DECLARE FUNCTION EnoughEMSAvail% (PagesNeeded%)
DECLARE FUNCTION GetPageFrameAddress% (Segment&)
DECLARE FUNCTION MapEMSPages% (EMMhandle%, PhysicalPage%, LogicalPage%)
DEFINT A-Z
DECLARE SUB SortGroup (File$)
DECLARE SUB NullBuffer (Array%())
DECLARE FUNCTION GetFileName$ (File%, Item%)
DECLARE SUB AddItem (File$, Prog AS STRING, Desc AS STRING, EntryType AS STRING, Compiler AS STRING)
DECLARE SUB SeekItem (File%, Item%)
DECLARE SUB DrawListBox (FileHandle%, Offset%, Selected%, Total%)
DECLARE SUB ReCreate ()
DECLARE SUB InsertItem (File$, Index, Prog AS STRING, Desc AS STRING, EntryType AS STRING, Compiler AS STRING)
DECLARE FUNCTION CreateGroup (Name$, Parent$)
DECLARE SUB ErrorDialog (Desc$)
DECLARE SUB WKey ()
DECLARE FUNCTION Trim$ (Number%)
DECLARE SUB Message (Text$, Topic$)
DECLARE SUB EraseMessage ()
DECLARE SUB Config ()
DECLARE SUB WPrint (x1%, Text$)
DECLARE FUNCTION Exist% (File$)
DECLARE SUB DrawShadow (x%, y%, x2%, y2%)
DECLARE SUB DrawWindow (x%, y%, x2%, y2%, FCol%, BCol%, Topic$, Shadow%)
DECLARE SUB ColPrint (Text$)
DECLARE FUNCTION RealLen% (Text$)
DECLARE SUB Center (Text$, YLen%)
DECLARE SUB DrawDesk (x%, y%, x2%, y2%)
DECLARE FUNCTION ScanDir% (FileSpec$, Output$)
DECLARE FUNCTION DirEntry% (Entry AS STRING)
DECLARE FUNCTION DirFirst$ (Mask AS STRING, Attrib AS INTEGER)
DECLARE FUNCTION DirNext$ ()

TYPE DOSFileInfo
	fiReserved            AS STRING * 21  'for DOS' internal use
	fiAttribute           AS STRING * 1   'file attribute code
	fiFileTime            AS INTEGER      'file time (in DOS format)
	fiFileDate            AS INTEGER      'file date (in DOS format)
	fiSize                AS LONG         'file size (in bytes)
	fiFileName            AS STRING * 13  'file name (without path)
END TYPE


DECLARE SUB GetFileInfo (pFileInfo AS DOSFileInfo)
DECLARE SUB SetDTA (FileInfo AS DOSFileInfo)
DECLARE SUB MHide ()
DECLARE SUB MStatus (x%, y%, B1%, B2%)
DECLARE SUB MLoadCur (File$)
DECLARE SUB MShow ()
DECLARE SUB MSetPos (x, y)
DECLARE SUB MSetRange (x1, x2, Y1, y2)
DECLARE SUB MPressInfo (Button, PressCount, PressX, PressY)
DECLARE SUB MReleseInfo (Button, PressCount, PressX, PressY)
DECLARE SUB MRelLastPos (RX, RY)
DECLARE FUNCTION MInit% ()

TYPE ConfigFile
	Lines AS INTEGER
	KillDisk AS INTEGER
END TYPE

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

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 GrpHeader                  'Total Header size: 57 bytes
	Version AS STRING * 5
	Topic AS STRING * 40
	Parent AS STRING * 12
END TYPE

TYPE GrpEntry                   'Total Entry size: 64 bytes
	Prog AS STRING * 12
	Desc AS STRING * 50
	EntryType AS STRING * 1       '1: Group, 2: File
	Compiler AS STRING * 1
END TYPE


DECLARE FUNCTION Listbox$ (File$, FileInfo AS GrpEntry)
DIM SHARED Grp AS GrpEntry
DIM SHARED Header AS GrpHeader
DIM SHARED Regs AS RegType
DIM SHARED Version AS STRING * 5

' Type directory entry:
CONST IsNONE = 0                'directory entry doesn't exist
CONST IsFILE = 1                'is a file
CONST IsDIRECTORY = 2           'is a directory
CONST IsDEVICE = 3              'is a device
CONST IsVOLUME = 4              'is a volume label

' Maximum length of directory path in DOS
CONST MAXDOSPATH = 67

' Bit value of carry bit in flags register
CONST CARRY = 1

' Boolean values
CONST False = 0, True = -1

CONST F.NOR = &H200  'constant for "normal" files (*files* displayed with DIR)
CONST F.NON = &H100  'constant for files without any attribute
CONST F.ARC = &H20   'constant for archive file attribute
CONST F.DIR = &H10   'constant for directory file attribute
CONST F.VOL = &H8    'constant for volume file attribute
CONST F.SYS = &H4    'constant for system file attribute
CONST F.HID = &H2    'constant for hidden file attribute (may return directory)
CONST F.RDO = &H1    'constant for read-only file attribute
CONST F.ANY = &H0    'constant for any of the above

' Named common block with DOS error code
COMMON SHARED /DOSError/ DOSError AS INTEGER
CONST HeaderLen = 57

CONST EMMInt = &H67, GetPageFrame = &H4100, GetUnallocPageCount = &H4200
CONST AllocatePages = &H4300, MapPages = &H4400, DeallocatePages = &H4500

DIM SHARED handle%
DIM SHARED Segment&
DIM SHARED FileInfo AS DOSFileInfo
DIM SHARED DesktopFCol AS INTEGER
DIM SHARED DesktopBCol AS INTEGER
DIM SHARED DesktopChar$
DIM SHARED Lines AS INTEGER
DIM SHARED GrpFile$
DIM SHARED GrpExt$
DIM SHARED DataDir$
DIM SHARED Row
DIM SHARED Ku$
DIM SHARED Kr$
DIM SHARED Kd$
DIM SHARED Kl$
DIM SHARED Buffer(0 TO 2047) AS INTEGER
DIM SHARED Selected(0 TO 2047) AS INTEGER
DIM SHARED OldOffset AS INTEGER
DIM SHARED OldSelected AS INTEGER
DIM SHARED FList AS STRING * 12
DIM SHARED Compiler$(0 TO 8)
DIM SHARED LongCompiler$(0 TO 8)
DIM SHARED RollerCount AS INTEGER
DIM SHARED RollerPos AS INTEGER
DIM SHARED KillDisk AS INTEGER
DIM SHARED Cfg AS ConfigFile

NullBuffer Selected()
NullBuffer Buffer()


'Define keys
Ku$ = CHR$(0) + CHR$(72)
Kr$ = CHR$(0) + CHR$(77)
Kd$ = CHR$(0) + CHR$(80)
Kl$ = CHR$(0) + CHR$(75)


Compiler$(0) = "         "
Compiler$(1) = "QB       "
Compiler$(2) = "QBasic   "
Compiler$(3) = "PDS      "
Compiler$(4) = "VBDos    "
Compiler$(5) = "VB       "
Compiler$(6) = "ASIC     "
Compiler$(7) = "PB       "
Compiler$(8) = "Liberty  "
																					
LongCompiler$(0) = "None"
LongCompiler$(1) = "Microsoft QBasic v1.1"
LongCompiler$(2) = "Microsoft QuickBasic v4.5"
LongCompiler$(3) = "Microsoft Professional Development System"
LongCompiler$(4) = "Microsoft Visual Basic for DOS"
LongCompiler$(5) = "Microsoft Visual Basic for Windows"
LongCompiler$(6) = "ASIC - All-purpose instruction code"
LongCompiler$(7) = "PowerBasic"
LongCompiler$(8) = "Liberty Basic"


Config

DrawDesk 1, 1, 80, Lines
DrawWindow 20, Lines \ 2 - 5, 60, Lines \ 2 + 5, 7, 1, "%7&0 Welcome! ", True

COLOR 15, 1
KewlPrint "Welcome to QBase v1.0!", Lines \ 2 - 3

Center "&E(C) &FS&Ba&3mi &FK&By&3”stil„ &E1997", Lines \ 2 - 1

COLOR 7, 1
KewlPrint "&7This program is &Ffreeware!", Lines \ 2 + 1
COLOR 7, 1
KewlPrint "You may use this code in your own", Lines \ 2 + 2
KewlPrint "programs as long as you give me", Lines \ 2 + 3
KewlPrint "some credit too.", Lines \ 2 + 4

WKey

DrawDesk 1, 1, 80, Lines + 1
IF NOT EMMInstalled THEN
 ErrorDialog "EMM not installed!"
 WKey
 SYSTEM
END IF

IF NOT EnoughEMSAvail(1) THEN
 ErrorDialog "Not enough EMM available!"
 WKey
 SYSTEM
END IF

IF NOT AllocateEMSPages(1, handle%) THEN
 ErrorDialog "Unable to allocate EMS Pages!"
 WKey
 SYSTEM
END IF

IF NOT MapEMSPages(handle%, 0, 0) THEN
 ErrorDialog "Unable to map EMS Pages!"
 WKey
 IF NOT DeallocateEMSPages(handle%) THEN
	 ErrorDialog "Unable to deallocate EMS Pages!"
	 WKey
 END IF
 SYSTEM
END IF

IF NOT GetPageFrameAddress(Segment&) THEN
 ErrorDialog "Unable to get the Page Frame address!"
 WKey
 IF NOT DeallocateEMSPages(handle%) THEN
	 ErrorDialog "Unable to deallocate EMS Pages!"
	 WKey
 END IF
 SYSTEM
END IF


IF Exist(DataDir$ + GrpFile$) = False THEN
	DrawDesk 1, 1, 80, Lines
	ReCreate
END IF

group$ = "Main"

OldOffset = 0
OldSelected = 0

DO
	NewFile$ = Listbox$(DataDir$ + group$ + GrpExt$, Grp)
	NewFile$ = UCASE$(RTRIM$(NewFile$))
	IF NewFile$ <> "" THEN
		IF RIGHT$(NewFile$, 4) = GrpExt$ THEN
			NullBuffer Selected()
			group$ = LEFT$(NewFile$, INSTR(NewFile$, ".") - 1)
		ELSE
			ViewFile NewFile$, RTRIM$(Grp.Desc) + " - Compiler: " + LongCompiler$(VAL(Grp.Compiler))
		END IF
	END IF
LOOP


HelpData:

DATA 55
DATA "                    &3QBase v1.0 (C) Sami Ky”stil„ - 1997"
DATA "&B ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
DATA " This program stores your basic source files into a database,"
DATA " where you can organise them into separate groups with ease. Groups"
DATA " can be nested, and each one can contain up to 2,047 files. You"
DATA " can enter descriptions for each file and of course view them."
DATA ""
DATA " If you have any comments about this program, you can contact me at
DATA " &9                       hiteck@freenet.hut.fi
DATA ""
DATA "              &3This code may be used freely, as long
DATA "                  &3as you give me credit for it"
DATA "&B ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
DATA ""
DATA "  &CArrows&E - Move the selection bar."
DATA ""
DATA "   &CEnter&E - View selected file/Open group."
DATA ""
DATA "   &CSpace&E - Mark/Unmark the selected file."
DATA ""
DATA " &CBackSpc&E - Move up to the higher level group."
DATA ""
DATA "  &CDelete&E - Delete selected group/file. (See options)"
DATA ""
DATA "      &CF2&E - Sort files by their names."
DATA ""
DATA "      &CF3&E - Search a file/description."
DATA ""
DATA "      &CF4&E - View tree hierarchy, or change the active group file"
DATA ""
DATA "      &CF5&E - Insert a sub group file into the current group file."
DATA "           This is a great way to sort your files into"
DATA "           separate sub-groups, like Graphics, Sound, etc."
DATA ""
DATA "      &CF6&E - Insert a source file into the current group file."
DATA "           Enter the file mask and mark the file(s) you wish"
DATA "           to add with the space bar. Confirm the operation"
DATA "           with Enter. Files must be in current directory."
DATA ""
DATA "      &CF7&E - Enter/Change the description of the selected file."
DATA "           Group file descriptions cannot be changed."
DATA ""
DATA "      &CF8&E - Change the compiler/interpreter of the tagged files."
DATA ""
DATA "      &CF9&E - Move the tagged files to a different group file."
DATA ""
DATA "     &CF10&E - Copy the tagged files to a different group file."
DATA ""
DATA "     &CF11&E - Reinitialize the database. WARNING!! This will"
DATA "           erase all your own groups! This will scan the current"
DATA "           directory for *.BAS files and insert them to the database."
DATA ""
DATA "     &CF12&E - Displays info about the selected file."
DATA ""
DATA "   &CAlt-O&E - Change the program options"


DATA 7
DATA "                    &3QBase v1.0 (C) Sami Ky”stil„ - 1997"
DATA "&B  ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
DATA "                             File Viewer"
DATA ""
DATA "  &CArrows&E - Scroll file"
DATA "      &CF3&E - Search for strings in the document."
DATA "     &CESC&E - Return to the group browser."

SUB AddItem (File$, Prog AS STRING, Desc AS STRING, EntryType AS STRING, Compiler AS STRING)
IF Exist(File$) = False THEN
	ErrorDialog "Group file " + File$ + " not found!"
	WKey
	EraseMessage
	EXIT SUB
END IF

File = FREEFILE

OPEN File$ FOR BINARY AS File

SeekItem File, CountItems2(File) + 1

Grp.Prog = Prog
Grp.Desc = Desc
Grp.EntryType = EntryType
Grp.Compiler = Compiler

PUT File, , Grp
CLOSE File

END SUB

FUNCTION AllocateEMSPages (PagesNeeded%, EMMhandle%)
 DIM InRegs AS RegType, OutRegs AS RegType

 InRegs.ax = AllocatePages
 InRegs.bx = PagesNeeded%
 CALL INTERRUPT(EMMInt, InRegs, OutRegs)
 IF (OutRegs.ax \ 256) = 0 THEN EMMhandle% = OutRegs.dx
 AllocateEMSPages = ((OutRegs.ax \ 256) = 0)
END FUNCTION

SUB Center (Text$, YPos)
LOCATE YPos, 40 - RealLen(Text$) \ 2
ColPrint Text$
END SUB

SUB ChooseCompiler (File, Item)

DrawWindow 30, 4, 50, 14, 15, 7, "&4 Compiler ", True

IF Item = 0 THEN COLOR 15, 1 ELSE COLOR 15, 7
Center " None     ", 5
FOR i = 1 TO 8
	IF Item = i THEN COLOR 15, 1 ELSE COLOR 15, 7
	Center " " + Compiler$(i) + " ", i + 5
NEXT

DO
	k$ = INKEY$
	IF k$ <> "" THEN

		IF k$ = Kd$ THEN
			Item = Item + 1
			IF Item = 9 THEN Item = 0
		END IF

		IF k$ = Ku$ THEN
			Item = Item - 1
			IF Item = -1 THEN Item = 8
		END IF

		IF k$ = CHR$(13) THEN
			FOR i = 0 TO CountItems2(File)
				IF Selected(i) THEN
					SeekItem File, i
					GET File, , Grp
					Grp.Compiler = Trim$(Item)
					SeekItem File, i
					PUT File, , Grp
				END IF
			NEXT
			NullBuffer Selected()
			EXIT DO
		END IF

		IF k$ = CHR$(27) THEN EXIT DO

		IF Item = 0 THEN COLOR 15, 1 ELSE COLOR 15, 7
		Center " None     ", 5
		FOR i = 1 TO 8
			IF Item = i THEN COLOR 15, 1 ELSE COLOR 15, 7
			Center " " + Compiler$(i) + " ", i + 5
		NEXT
	END IF
LOOP

END SUB

SUB ColPrint (Text$)
'----------------------------------------------------------------------------
'                           SśYśSśTśEśM
'----------------------------------------------------------------------------

'----------------------------------------------------------------------------
' Prints color-coded text
'----------------------------------------------------------------------------
' Color codes:
'
'   & followed by a color value between 0-15 (in hex)
'   % same as &, except for backround color
'
' Example:
'
'   This text is &Cred
'----------------------------------------------------------------------------

FOR i = 1 TO LEN(Text$)
	Done = 0
	DO
		IF MID$(Text$, i, 1) = "&" AND INSTR("0123456789ABCDEF", MID$(Text$, i + 1, 1)) AND i < LEN(Text$) THEN
			COLOR VAL("&H" + MID$(Text$, i + 1, 1))
			i = i + 2
		ELSEIF MID$(Text$, i, 1) = "%" AND INSTR("01234567", MID$(Text$, i + 1, 1)) AND i < LEN(Text$) THEN
			COLOR , VAL("&H" + MID$(Text$, i + 1, 1))
			i = i + 2
		ELSE
			Done = 1
		END IF
	LOOP UNTIL Done
	PRINT MID$(Text$, i, 1);
NEXT

END SUB

FUNCTION Comma$ (Number&)
Temp$ = RTRIM$(LTRIM$(STR$(Number&)))
IF Number& < 1000 THEN Comma$ = Temp$: EXIT FUNCTION
IF LEFT$(Temp$, 1) = "." THEN Temp$ = "0" + Temp$

IF INSTR(Temp$, ".") THEN
	StartPos = INSTR(Temp$, ".") - 1
	Temp2$ = Temp2$ + MID$(Temp$, INSTR(Temp$, "."), 255)
ELSE
	StartPos = LEN(Temp$)
END IF

Count = 0
FOR i = StartPos TO 1 STEP -1
	Temp2$ = Temp2$ + MID$(Temp$, i, 1)
	Count = Count + 1
	Count = Count MOD 3
	IF Count = 0 THEN Temp2$ = Temp2$ + ","
NEXT

Temp$ = SPACE$(LEN(Temp2$))
FOR i = 1 TO LEN(Temp2$)
	MID$(Temp$, LEN(Temp2$) - i + 1, 1) = MID$(Temp2$, i, 1)
NEXT

Comma$ = Temp$

END FUNCTION

SUB Config


DesktopFCol = 3
DesktopBCol = 1
DesktopChar$ = "±"

GrpFile$ = "MAIN.GRP"
GrpExt$ = ".GRP"
DataDir$ = ""

Version = "Grp10"

IF Exist("qbase.ini") = False THEN
	Lines = 25
	KillDisk = False

	Cfg.Lines = Lines
	Cfg.KillDisk = KillDisk
	OPEN "qbase.ini" FOR BINARY AS #1
	PUT #1, , Cfg
	CLOSE #1
ELSE
	OPEN "qbase.ini" FOR BINARY AS #1
	GET #1, , Cfg
	CLOSE #1
	Lines = Cfg.Lines
	KillDisk = Cfg.KillDisk
END IF


'----------------------------------------------------------------------------
SCREEN 0: CLS
WIDTH 80, Lines
LOCATE 1, 1, 0
IF DataDir$ <> "" THEN
	IF RIGHT$(DataDir$, 1) <> "\" THEN DataDir$ = DataDir$ + "\"
END IF

END SUB

FUNCTION CountComments% (File$)
Cmt% = 0

CountFile = FREEFILE
OPEN File$ FOR INPUT AS #CountFile

DO
	IF EOF(CountFile) THEN EXIT DO
	LINE INPUT #CountFile, Dummy$
	Dummy$ = UCASE$(Dummy$)
	IF LEFT$(RTRIM$(Dummy$), 1) = "'" THEN Cmt% = Cmt% + 1
	IF LEFT$(RTRIM$(Dummy$), 3) = "REM" THEN Cmt% = Cmt% + 1
LOOP

CountComments% = Cmt%
CLOSE CountFile

END FUNCTION

FUNCTION CountItems2 (File)
SEEK File, 1
GET #File, , Header
Items = 0
DIM TempGrp AS GrpEntry
DO
	GET #File, , TempGrp
	Count$ = UCASE$(TempGrp.Prog)
	Count$ = RTRIM$(LTRIM$(Count$))
	Items = Items + 1
LOOP UNTIL Count$ = STRING$(12, 0)
CountItems2 = Items - 2
END FUNCTION

FUNCTION CountLines% (File$)
'----------------------------------------------------------------------------
'                           SśYśSśTśEśM
'----------------------------------------------------------------------------

Lin% = 0

CountFile = FREEFILE
OPEN File$ FOR INPUT AS #CountFile

DO
	IF EOF(CountFile) THEN EXIT DO
	LINE INPUT #CountFile, Dummy$
	Lin% = Lin% + 1
LOOP
CountLines% = Lin%
CLOSE CountFile


END FUNCTION

FUNCTION CreateGroup (Name$, Parent$)
Filename$ = LEFT$(Name$, 8)
IF INSTR(Filename$, " ") THEN Filename$ = LEFT$(Filename$, INSTR(Filename$, " ") - 1)

IF NOT Exist(DataDrive$ + Filename$ + GrpExt$) THEN
	OPEN DataDrive$ + Filename$ + GrpExt$ FOR BINARY AS #255
	Header.Topic = Name$
	Header.Version = Version
	Header.Parent = Parent$
	PUT #255, , Header
	CLOSE #255
ELSE
	ErrorDialog "Cannot create group '" + Name$ + "'!"
	CreateGroup = 1
	WKey
	EraseMessage
	EXIT FUNCTION
END IF

END FUNCTION

FUNCTION DeallocateEMSPages (handle%)
 DIM InRegs AS RegType, OutRegs AS RegType

 InRegs.ax = DeallocatePages
 InRegs.dx = handle%
 CALL INTERRUPT(EMMInt, InRegs, OutRegs)

 DeallocateEMSPages = ((OutRegs.ax \ 256) = 0)
END FUNCTION

SUB DeleteItem (File$, Index)

IF Exist(File$) = False THEN
	ErrorDialog "Group file " + File$ + " not found!"
	WKey
	EraseMessage
	EXIT SUB
END IF

OPEN "temp.tmp" FOR BINARY AS #2
File = FREEFILE

OPEN File$ FOR BINARY AS File

GET #File, , Header
PUT #2, , Header

DIM Temp AS GrpEntry

FOR i = 0 TO Index - 1
	SeekItem File, i
	GET #File, , Temp
	PUT #2, , Temp
NEXT

FOR i = Index + 1 TO CountItems2(File)
	SeekItem File, i
	GET #File, , Temp
	PUT #2, , Temp
NEXT

CLOSE #2, File
KILL File$
NAME "temp.tmp" AS File$

END SUB

FUNCTION DirEntry% (Entry AS STRING)
'----------------------------------------------------------------------
' Establishes if a directory entry exists and returns type of entry
' (file, subdirectory or device).
' Type of directory entry returned by the function is one of the
' following values:
' 0  (IsNONE     )
' 1  (IsFILE     )
' 2  (IsDIRECTORY)
' 3  (IsDEVICE   )

' Examples:
' FileExist = (DirEntry(FileName$) = IsFILE)
' DirExist = (DirEntry(FileName$) = IsDIRECTORY)
'----------------------------------------------------------------------
	DIM fiAttrib AS INTEGER
	DIM Temp AS STRING
	Temp$ = DirFirst$(Entry, &H77)   'attribute for everything except label
	IF LEN(Temp$) THEN
		fiAttrib = ASC(FileInfo.fiAttribute)
		IF fiAttrib AND &H40 THEN
			DirEntry% = IsDEVICE
		ELSEIF fiAttrib AND &H10 THEN
			DirEntry% = IsDIRECTORY
		ELSE
			DirEntry% = IsFILE
		END IF
	ELSE
		DirEntry% = IsNONE
	END IF
END FUNCTION

FUNCTION DirFirst$ (Mask AS STRING, Attrib AS INTEGER)
'----------------------------------------------------------------------
' Gets the first file name with matching mask and attributes
' If an error is encountered the function returns "" as its value.
'----------------------------------------------------------------------
	DIM MaskZ AS STRING
	DIM Reg   AS RegTypeX
	DIM Zero  AS INTEGER
	MaskZ = Mask + CHR$(0)
	SetDTA FileInfo                       ' Set up FileInfo as DTA
	FileInfo.fiFileName = STRING$(13, 0)  ' Clean the data structure
	Reg.ax = &H4E00
	' search attributes including read-only files
	Reg.cx = Attrib OR 1
	Reg.ds = VARSEG(MaskZ)                ' address of file mask
	Reg.dx = SADD(MaskZ)
	CALL InterruptX(&H21, Reg, Reg)
	IF (Reg.flags AND CARRY) THEN         ' if error
		DOSError = Reg.ax                   ' error number in DOSError
		DirFirst$ = ""
	ELSE
		DOSError = 0
		Zero = INSTR(FileInfo.fiFileName, CHR$(0))
		DirFirst$ = LEFT$(FileInfo.fiFileName, Zero - 1)  ' the file name
	END IF
END FUNCTION

FUNCTION DirNext$
'----------------------------------------------------------------------
' Gets the next file name with matching mask and attributes.
' If an error is encountered the function returns "" as its value.
'----------------------------------------------------------------------
	DIM Reg   AS RegTypeX
	DIM Zero  AS INTEGER
	FileInfo.fiFileName = STRING$(13, 0)  ' Clean the data structure
	Reg.ax = &H4F00
	CALL InterruptX(&H21, Reg, Reg)
	IF (Reg.flags AND CARRY) THEN         ' if error
		DOSError = Reg.ax                   ' error number in DOSError
		DirNext$ = ""
	ELSE
		DOSError = 0
		Zero = INSTR(FileInfo.fiFileName, CHR$(0))
		DirNext$ = LEFT$(FileInfo.fiFileName, Zero - 1)  ' the file name
	END IF
END FUNCTION

SUB DrawDesk (x, y, x2, y2)
'----------------------------------------------------------------------------
'                           SśYśSśTśEśM
'----------------------------------------------------------------------------
SCREEN , , 1, 0
PCOPY 0, 1

IF x2 > 80 THEN x2 = 80
IF y2 > Lines + 1 THEN y2 = Lines + 1
COLOR DesktopFCol, DesktopBCol
FOR i& = y TO y2 - 1
	LOCATE i&, x
	PRINT STRING$(x2 - x + 1, DesktopChar$);
NEXT

PCOPY 1, 0
SCREEN , , 0, 0

END SUB

SUB DrawFileList (File, Offset, Selected, Max)

BlockPos = (Selected + 1) / (Max) * (Lines - 9) + 4

COLOR 0, 7
FOR i = 4 TO Lines - 5
	LOCATE i, 31
	IF i <> BlockPos THEN PRINT "°";
NEXT
LOCATE BlockPos, 31
PRINT "Ū";

LOCATE 3, 31
PRINT CHR$(24);
LOCATE Lines - 4, 31
PRINT CHR$(25)

Count = Offset
SeekFileItem File, Count
FOR i = 3 TO Lines - 4
	GET #File, , FList
	LOCATE i, 16
	IF Count = Selected THEN
		COLOR 15, 1
	ELSE
		COLOR 7, 4
	END IF
	IF Buffer(Count) THEN
		COLOR 10
		PRINT CHR$(16);
	ELSE
		PRINT " ";
	END IF
	PRINT FList;
	Count = Count + 1
NEXT

END SUB

SUB DrawListBox (FileHandle, Offset, Selected, Total)

COLOR 0, 7
IF Total <> 0 THEN BlockPos = Selected / Total * (Lines - 9) + 3

FOR i = 3 TO Lines - 6
	LOCATE i, 80
	IF i <> BlockPos THEN PRINT "°";
NEXT
IF Total <> 0 THEN
	LOCATE BlockPos, 80
	PRINT "Ū";
END IF

LOCATE 2, 80
PRINT CHR$(24);
LOCATE Lines - 5, 80
PRINT CHR$(25)

SeekItem FileHandle, Offset

COLOR 7, 1
Count = Offset
FOR i = 2 TO Lines - 5
	GET #FileHandle, , Grp
	IF Count = Selected THEN
		COLOR 15, 4
	ELSE
		COLOR 7, 1
	END IF
	LOCATE i, 2
	Prog$ = Grp.Prog
	Prog$ = RTRIM$(UCASE$(Prog$))
	IF RIGHT$(Prog$, 4) = GrpExt$ THEN
		COLOR 14
		PRINT " ž Group file";
	ELSE
		IF Selected(Count) = 1 THEN
			COLOR 10
			PRINT CHR$(16);
		ELSE
			PRINT " ";
		END IF
		PRINT Grp.Prog;
	END IF
	COLOR 7, 1
	PRINT " ³ ";
 
	IF Count = Selected THEN
		COLOR 15, 4
	ELSE
		COLOR 7, 1
	END IF
	IF Selected(Count) = 1 THEN
		COLOR 10
	END IF

	IF RIGHT$(Prog$, 4) = GrpExt$ THEN
		COLOR 14
	END IF
	PRINT " "; Grp.Desc;
	PRINT " ";
	IF Grp.EntryType = "2" THEN PRINT Compiler$(VAL(Grp.Compiler)); " ";  ELSE PRINT "         ";
	Count = Count + 1
NEXT

END SUB

SUB DrawShadow (x, y, x2, y2)
'----------------------------------------------------------------------------
'                           SśYśSśTśEśM
'----------------------------------------------------------------------------

YLen = y2 - y
XLen = x2 - x + 1

IF x2 < 80 THEN
FOR i& = y + 1 TO YLen + y
	IF i& = Lines + 1 THEN EXIT FOR
	Char$ = CHR$(SCREEN(i&, x + XLen, 0))
	Col = (SCREEN(i&, x + XLen, 1))
	IF Col < 128 THEN
		Col = Col MOD 16
		Blink = 0
	ELSE
		Col = Col MOD 16
		Blink = 1
	END IF

	IF Blink = 1 THEN COLOR 16, 0 ELSE COLOR 8, 0

	LOCATE i&, x + XLen
	PRINT Char$;

	IF x + XLen + 1 < 81 THEN
	Char$ = CHR$(SCREEN(i&, x + XLen + 1, 0))
	Col = (SCREEN(i&, x + XLen + 1, 1))
	IF Col < 128 THEN
		Col = Col MOD 16
		Blink = 0
	ELSE
		Col = Col MOD 16
		Blink = 1
	END IF

	IF Blink = 1 THEN COLOR 16, 0 ELSE COLOR 8, 0
	PRINT Char$;
	END IF
NEXT
END IF

IF y2 < Lines + 1 THEN
FOR i& = x + 2 TO XLen + x - 1
	LOCATE y + YLen, i&
	Char$ = CHR$(SCREEN(y + YLen, i&, 0))
	Col = (SCREEN(y + YLen, i&, 1))
	IF Col < 128 THEN
		Col = Col MOD 16
		Blink = 0
	ELSE
		Col = Col MOD 16
		Blink = 1
	END IF

	IF Blink = 1 THEN COLOR 16, 0 ELSE COLOR 8, 0

	LOCATE y + YLen, i&
	PRINT Char$;
NEXT
END IF

END SUB

SUB DrawTree (File, Selected, Offset)

SeekLine File, Offset

Count = Offset
FOR i = 1 TO Lines - 2
	IF NOT EOF(File) THEN
		LINE INPUT #File, Ln$
	ELSE
		Ln$ = STRING$(79, " ")
	END IF
	IF Count = Selected THEN
		IF INSTR(Ln$, "&A%1") THEN MID$(Ln$, INSTR(Ln$, "&A%1")) = "&A%4"
	END IF
	LOCATE i, 1
	ColPrint Ln$
	Count = Count + 1
NEXT

END SUB

SUB DrawWindow (x, y, x2, y2, FCol, BCol, Topic$, Shadow)
SCREEN , , 1, 0
PCOPY 0, 1

COLOR FCol, BCol
XLen = x2 - x
LOCATE y, x, 0
PRINT "Ś" + STRING$(XLen - 2, "Ä") + "æ";

FOR i = y + 1 TO y2 - 1
	LOCATE i, x
	PRINT "³" + STRING$(XLen - 2, " ") + "³";
NEXT
LOCATE y2, x, 0
PRINT "Ą" + STRING$(XLen - 2, "Ä") + "Ł";

LOCATE y, x + ((x2 - x) \ 2) - RealLen(Topic$) \ 2
ColPrint Topic$

IF Shadow = True THEN DrawShadow x, y, x2 - 1, y2 + 1

PCOPY 1, 0
SCREEN , , 0, 0

END SUB

FUNCTION EMMInstalled
 DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX

 InRegsX.ax = &H3567     ' Get vector for INT 67h

 CALL InterruptX(&H21, InRegsX, OutRegsX)

 DEF SEG = OutRegsX.es

 Test$ = CHR$(PEEK(&HA)) + CHR$(PEEK(&HB)) + CHR$(PEEK(&HC))

 EMMInstalled = (Test$ = "EMM")
END FUNCTION

SUB EndProg

COLOR 0, 0

FOR i = 0 TO 80
	LOCATE Lines, 1
	PRINT SPACE$(80)
	WAIT &H3DA, 8
	FOR t = 1 TO 32000: NEXT t
	IF INKEY$ <> "" THEN EXIT FOR
NEXT i

COLOR 7, 0
CLS

IF NOT DeallocateEMSPages(handle%) THEN
 ErrorDialog "Unable to deallocate EMS Pages!"
 WKey
 EraseMessage
END IF

END

END SUB

FUNCTION EnoughEMSAvail (PagesNeeded%)
 DIM InRegs AS RegType, OutRegs AS RegType

 InRegs.ax = GetUnallocPageCount
 CALL INTERRUPT(EMMInt, InRegs, OutRegs)

 EnoughEMSAvail = (((OutRegs.ax \ 256) = 0) AND (OutRegs.bx >= PagesNeeded))
END FUNCTION

SUB EraseMessage
PCOPY 2, 0
IF Row > 0 THEN LOCATE Row
END SUB

SUB ErrorDialog (Desc$)
Row = CSRLIN
PCOPY 0, 2
DrawWindow 40 - RealLen(Desc$) \ 2 - 2, Lines \ 2 - 2, 40 + RealLen(Desc$) \ 2 + 3, Lines \ 2 + 2, 7, 4, "&0%7 Error ", True
COLOR 14, 4
Center Desc$, Lines \ 2
END SUB

FUNCTION Exist% (File$)

DEFINT A-Z
'----------------------------------------------------------------------------
'                       Checks if a file exists
'----------------------------------------------------------------------------
'
'    File$ - File to check
'
'----------------------------------------------------------------------------
'  Returns True if file exists, else False
'----------------------------------------------------------------------------


IF File$ = "" THEN Exist = False: EXIT FUNCTION
Checkfile = FREEFILE
OPEN File$ FOR BINARY AS #Checkfile
IF LOF(Checkfile) = 0 THEN
	Exist = False
	CLOSE #Checkfile
	KILL File$
ELSE
	Exist = True
	CLOSE #Checkfile
END IF

END FUNCTION

FUNCTION FileFromEms$ (Index)

DEF SEG = Segment&
File$ = ""

FOR i = Index * 8 TO (Index * 8) + 7
 File$ = File$ + CHR$(PEEK(i))
NEXT

FileFromEms$ = RTRIM$(File$)
DEF SEG

END FUNCTION

SUB FileToEms (File$, Index)
DEF SEG = Segment&

StrPos = 1
FOR i = Index * 8 TO (Index * 8) + 7
 POKE i, ASC(MID$(File$, StrPos, 1))
 StrPos = StrPos + 1
NEXT
DEF SEG

END SUB

FUNCTION FormatNumber$ (Num, Nums, Zero$)
Temp$ = LEFT$(LTRIM$(RTRIM$(STR$(Num))), Nums)
Temp$ = STRING$(Nums - LEN(Temp$), Zero$) + Temp$
FormatNumber$ = Temp$
END FUNCTION

SUB GenerateTree

Message "Generating tree graph...", ""

Groups = ScanDir("*" + GrpExt$, "temp.tmp")

OPEN "temp.tmp" FOR INPUT AS #1
OPEN "temp2.tmp" FOR OUTPUT AS #3

FOR i = 0 TO Groups - 1
	INPUT #1, File$
	OPEN File$ FOR BINARY AS #2
	GET #2, , Header
	PRINT #3, File$
	PRINT #3, Header.Parent
	CLOSE #2
NEXT
CLOSE #1
CLOSE #2
CLOSE #3
KILL "temp.tmp"
NAME "temp2.tmp" AS "temp.tmp"

DIM group$(0 TO 500)
DIM GroupParent$(0 TO 500)
DIM Stack$(0 TO 500)
DIM GroupFound(0 TO 500)

OPEN "temp.tmp" FOR INPUT AS #1
FOR i = 0 TO Groups - 1
	INPUT #1, group$(i)
	INPUT #1, GroupParent$(i)
	group$(i) = LEFT$(group$(i), INSTR(group$(i), ".") - 1)
	GroupParent$(i) = LEFT$(GroupParent$(i), INSTR(GroupParent$(i), ".") - 1)
NEXT
CLOSE #1

OPEN "temp.tmp" FOR OUTPUT AS #1

Trace$ = "MAIN"
Level = 1

PRINT #1, STRING$(79, " ")
PRINT #1, "&A%1MAIN     ";
PRINT #1, "%0&8Ü"
PRINT #1, "%0&8 "; STRING$(9, "ß")
COLOR 14, 0
DO
	Found = 0
	FOR i = 0 TO Groups - 1
		IF GroupParent$(i) = Trace$ AND Trace$ <> group$(i) AND GroupFound(i) = 0 THEN
			PRINT #1, "   ";
			FOR ii = 1 TO Level - 1
				PRINT #1, "    ";
			NEXT
			PRINT #1, "&A%1" + group$(i) + STRING$(9 - LEN(group$(i)), " ");
			PRINT #1, "&8%0Ü"

			PRINT #1, "   ";
			FOR ii = 1 TO Level - 1
				PRINT #1, "    ";
			NEXT
			PRINT #1, "&8%0 "; STRING$(9, "ß")

			GroupFound(i) = 1
			PushStack Trace$, Stack$()
			Trace$ = group$(i)
			Level = Level + 1
			Found = 1
		END IF
	NEXT

	IF Found = 0 THEN
		Trace$ = PopStack$(Stack$())
		Level = Level - 1
	END IF

LOOP UNTIL Level = 0

CLOSE #1

EraseMessage

END SUB

SUB GetEntry (File, Entry AS GrpEntry, Item)
SeekItem File, Item
GET File, , Entry
END SUB

SUB GetFileInfo (pFileInfo AS DOSFileInfo)
'----------------------------------------------------------------------
' Gets FileInfo about file which name was returned by DirFirst/DirNext
'----------------------------------------------------------------------
	pFileInfo = FileInfo
END SUB

FUNCTION GetFileName$ (File, Item)
SeekItem File, Item
GET #File, , Grp
GetFileName$ = Grp.Prog
END FUNCTION

FUNCTION GetPageFrameAddress (Segment&)
 DIM InRegs AS RegType, OutRegs AS RegType

 InRegs.ax = GetPageFrame
 CALL INTERRUPT(EMMInt, InRegs, OutRegs)

 IF (OutRegs.ax \ 256) = 0 THEN
	Segment& = OutRegs.bx
 END IF

 GetPageFrameAddress = ((OutRegs.ax \ 256) = 0)
END FUNCTION

SUB Help (HelpScreen)

PCOPY 0, 2
DrawWindow 4, 3, 76, Lines - 6, 7, 0, "&0%7 Help ", True
COLOR 14, 0
DIM Hlp(0 TO 80)  AS STRING * 70


RESTORE HelpData
FOR i = 1 TO HelpScreen
	READ Temp$
NEXT

READ Max

FOR i = 1 TO Max
	READ Hlp(i - 1)
NEXT
Offset = 0

Tmp = Offset
FOR i = 4 TO Lines - 7
	COLOR 14, 0
	LOCATE i, 5
	ColPrint Hlp(Tmp)
	Tmp = Tmp + 1
	IF Tmp > Max THEN EXIT FOR
NEXT


COLOR 0, 7
IF Max <> 0 THEN BlockPos = Offset / Max * (Lines - 13) + 5

FOR i = 5 TO Lines - 8
	LOCATE i, 75
	IF i <> BlockPos THEN PRINT "°";
NEXT
IF Max <> 0 THEN
	LOCATE BlockPos, 75
	PRINT "Ū";
END IF

LOCATE 4, 75
PRINT CHR$(24);
LOCATE Lines - 7, 75
PRINT CHR$(25)


COLOR 14, 0


DO
	k$ = UCASE$(INKEY$)
	IF k$ <> "" THEN
	 
		IF k$ = Kd$ THEN
			Offset = Offset + 1
			IF Offset > Max THEN Offset = Max
		END IF

		IF k$ = Ku$ THEN
			Offset = Offset - 1
			IF Offset < 0 THEN Offset = 0
		END IF

	 
		IF k$ = CHR$(0) + CHR$(81) THEN
			Offset = Offset + (Lines - 13)
			IF Offset > Max THEN Offset = Max
		END IF

		IF k$ = CHR$(0) + CHR$(73) THEN
			Offset = Offset - (Lines - 13)
			IF Offset < 0 THEN Offset = 0
		END IF

		IF k$ = CHR$(0) + CHR$(79) THEN
			Offset = Max - 1
		END IF

		IF k$ = CHR$(0) + CHR$(71) THEN
			Offset = 0
		END IF

	 
		IF k$ = CHR$(27) THEN EXIT DO


		Tmp = Offset
		FOR i = 4 TO Lines - 7
			COLOR 14, 0
			LOCATE i, 5
			ColPrint Hlp(Tmp)
			Tmp = Tmp + 1
			IF Tmp > Max THEN EXIT FOR
		NEXT

		IF i < Lines - 7 THEN
			FOR ii = i + 1 TO Lines - 7
				COLOR 14, 0
				LOCATE ii, 5
				PRINT STRING$(70, " ");
			NEXT
		END IF

		COLOR 0, 7
		IF Max <> 0 THEN BlockPos = Offset / Max * (Lines - 13) + 5

		FOR i = 5 TO Lines - 8
			LOCATE i, 75
			IF i <> BlockPos THEN PRINT "°";
		NEXT
		IF Max <> 0 THEN
			LOCATE BlockPos, 75
			PRINT "Ū";
		END IF

		COLOR 14, 0
	END IF
LOOP


EraseMessage

END SUB

SUB Info (File$)

IF Exist(File$) = False THEN
	ErrorDialog "File " + File$ + " not found!"
	WKey
	EraseMessage
	EXIT SUB
END IF

OPEN File$ FOR BINARY AS #255
Temp$ = SPACE$(1)
GET #255, , Temp$
CLOSE #255

IF Temp$ = CHR$(252) THEN
	ErrorDialog "This file is probably a QB compressed file!"
	WKey
	EraseMessage
	EXIT SUB
END IF



PCOPY 0, 2
DrawWindow 4, 3, 76, 10, 7, 0, "&0%7 Info - " + File$ + " ", True
COLOR 14, 0
Center "Calculating...", 5


File = FREEFILE
OPEN File$ FOR INPUT AS #File
FSize& = LOF(File)
CLOSE File

NLines = CountLines(File$)
NComments = CountComments(File$)

COLOR 7
Center "              ", 5
LOCATE 5, 10: PRINT " ž File size:", , Comma$(FSize&); " bytes"
LOCATE 6, 10: PRINT " ž Number of lines:", Comma$(INT(NLines))
LOCATE 7, 10: PRINT " ž Commented lines:", Comma$(INT(NComments)), "("; Trim$(INT(NComments / NLines * 100)); "%)"
LOCATE 8, 10: PRINT " ž Raw source:", , Comma$(NLines - NComments), "("; Trim$(INT((NLines - NComments) / NLines * 100)); "%)"
COLOR 8

DO: LOOP UNTIL INKEY$ <> ""
EraseMessage

END SUB

FUNCTION InputField$ (Text$, Key$, MaxLen, TPos)
IF Key$ = "" THEN InputField$ = Text$: EXIT FUNCTION

SELECT CASE Key$
CASE IS = CHR$(8)
	IF LEN(Text$) > 0 THEN
		Text$ = LEFT$(Text$, TPos - 1) + MID$(Text$, TPos + 1, 255)
		TPos = TPos - 1
		IF TPos = -1 THEN TPos = 0
		Key$ = ""
	ELSE
		Key$ = ""
	END IF
CASE IS = CHR$(0) + CHR$(75)
	IF TPos > 0 THEN TPos = TPos - 1
	Key$ = ""
CASE IS = CHR$(0) + CHR$(77)
	TPos = TPos + 1
	IF TPos > MaxLen THEN TPos = MaxLen
	IF TPos > LEN(Text$) THEN TPos = LEN(Text$)
	Key$ = ""
CASE IS = CHR$(0) + "S"
	Text$ = LEFT$(Text$, TPos) + MID$(Text$, TPos + 2, 255)
	Key$ = ""
CASE IS = CHR$(9)
	Key$ = ""
END SELECT

IF LEFT$(Key$, 1) = CHR$(0) THEN Key$ = ""

IF Key$ <> "" THEN
	Text$ = LEFT$(Text$, TPos) + Key$ + MID$(Text$, TPos + 1, 255)
	IF LEN(Text$) > MaxLen THEN Text$ = LEFT$(Text$, MaxLen)
	TPos = TPos + 1
	IF TPos > MaxLen THEN TPos = MaxLen
END IF

InputField$ = Text$

END FUNCTION

SUB InsertItem (File$, Index, Prog AS STRING, Desc AS STRING, EntryType AS STRING, Compiler AS STRING)

IF Exist(File$) = False THEN
	ErrorDialog "Group file " + File$ + " not found!"
	WKey
	EraseMessage
	EXIT SUB
END IF

OPEN "temp.tmp" FOR BINARY AS #1
File = FREEFILE

OPEN File$ FOR BINARY AS File

GET #File, , Header
PUT #1, , Header

Grp.Prog = Prog
Grp.Desc = Desc
Grp.EntryType = EntryType
Grp.Compiler = Compiler

DIM Temp AS GrpEntry

FOR i = 0 TO Index - 1
	SeekItem File, i
	GET #File, , Temp
	PUT #1, , Temp
NEXT

PUT #1, , Grp

FOR i = Index TO CountItems2(File)
	SeekItem File, i
	GET #File, , Temp
	PUT #1, , Temp
NEXT

CLOSE #1, File
KILL File$
NAME "temp.tmp" AS File$

END SUB

SUB KewlPrint (Text$, Row)
FOR i = 1 TO LEN(Text$)
	Center LEFT$(Text$, i), Row
	FOR dl% = 0 TO 4000: NEXT
	IF INKEY$ <> "" THEN EXIT FOR
NEXT
Center Text$, Row
END SUB

FUNCTION Listbox$ (File$, FileInfo AS GrpEntry)

File$ = LTRIM$(RTRIM$(UCASE$(File$)))
File = FREEFILE
OPEN File$ FOR BINARY AS File

GET #File, , Header
IF Header.Version <> Version THEN
	ErrorDialog "Group file version doesn't match current version!"
	WKey
	EraseMessage
END IF


COLOR 0, 3
LOCATE Lines - 2, 1
PRINT STRING$(80, "Ä");
Center "%3&0 QBase (C) Sami Ky”stil„ - 1997 ", Lines - 2

LOCATE Lines - 1, 1
PRINT STRING$(80, " ");
COLOR 0, 3
LOCATE Lines - 1, 1
ColPrint " &EF1&0-Help  &EF2&0-Sort  &EF3&0-Search   &EF4&0-Tree   &EF5&0-Insert grp  &EF6&0-Insert prog  &EF7&0-Desc"

LOCATE Lines, 1
PRINT STRING$(80, " ");
LOCATE Lines, 1
ColPrint " &EF8&0-Comp  &EF9&0-Move &EF10&0-Copy    &EF11&0-Init  &EF12&0-Info     &EAlt-O&0-Options"

COLOR 7, 0
LOCATE Lines - 3, 1
PRINT STRING$(80, " ");


Max = CountItems2(File)
IF Max = -1 THEN Max = 0

COLOR 7, 0
LOCATE Lines - 3, 1
IF Max = 0 THEN
	ColPrint " &E" + STR$(Max + 1) + "&7 item in group"
ELSE
	ColPrint " &E" + STR$(Max + 1) + "&7 items in group"
END IF

Parent$ = Header.Parent
Parent$ = LTRIM$(RTRIM$(UCASE$(Parent$)))

Selected = OldSelected
Offset = OldOffset

IF Selected > Max THEN Selected = Max
IF Offset > Max THEN Offset = Max

LastSearch = 0

DrawWindow 1, 1, 81, Lines - 4, 7, 1, "%7&0 " + RTRIM$(Header.Topic) + " ", False
COLOR 7, 1
LOCATE 1, 16: PRINT "Ā"
COLOR 7, 1
LOCATE Lines - 4, 16: PRINT "Į"

DrawListBox File, Offset, Selected, Max

DO
	k$ = UCASE$(INKEY$)
	IF k$ <> "" THEN
		
		IF k$ = Kd$ THEN
			Selected = Selected + 1
			IF Selected > Max THEN Selected = Max
			IF Selected > Offset + Lines - 7 THEN Offset = Offset + 1
		END IF

		IF k$ = Ku$ THEN
			Selected = Selected - 1
			IF Selected < 0 THEN Selected = 0
			IF Selected < Offset THEN Offset = Offset - 1
			IF Offset < 0 THEN Offset = 0
		END IF

		IF k$ = CHR$(0) + CHR$(81) THEN
			Selected = Selected + (Lines - 7)
			Offset = Offset + (Lines - 7)
			IF Selected > Max THEN Selected = Max
			IF Offset > Max THEN Offset = Max
		END IF


		IF k$ = CHR$(0) + CHR$(73) THEN
			Selected = Selected - (Lines - 7)
			Offset = Offset - (Lines - 7)
			IF Selected < 0 THEN Selected = 0
			IF Offset < 0 THEN Offset = 0
		END IF

		IF k$ = CHR$(0) + CHR$(79) THEN
			Offset = Max - (Lines - 7)
			IF Offset < 0 THEN Offset = 0
			Selected = Max
		END IF

		IF k$ = CHR$(8) AND Parent$ <> File$ THEN
			Listbox$ = Parent$
			EXIT DO
		END IF

		IF k$ = CHR$(0) + CHR$(71) THEN
			Offset = 0
			Selected = 0
		END IF

		IF k$ = CHR$(13) THEN
			OldOffset = Offset
			OldSelected = Selected
			Listbox$ = GetFileName$(File, Selected)
			EXIT DO
		END IF

		IF k$ = CHR$(27) THEN
			Message "&EAre you sure you want to quit? &F[Y/N]", "%7&0 Quit "
			DO
				k$ = UCASE$(INKEY$)
			LOOP UNTIL k$ <> ""
			IF k$ = "Y" OR k$ = CHR$(13) THEN
				CLOSE File
				EndProg
			END IF
			k$ = ""
		END IF

		IF k$ = CHR$(0) + CHR$(59) THEN
			Help 0
		END IF
	
		IF k$ = CHR$(0) + CHR$(60) THEN
			CLOSE File
			SortGroup File$
			EXIT DO
		END IF

		IF k$ = CHR$(0) + CHR$(63) THEN
			CLOSE File
			NewGroup$ = Query$("Enter the name of the group file to be inserted.", "%7&0 New group ", 40, "")
			IF NewGroup$ <> "" THEN
				IF INSTR(NewGroup$, ".") THEN
					ErrorDialog "Name cannot contain a period!"
					WKey
					EraseMessage
				ELSEIF INSTR(NewGroup$, ",") THEN
					ErrorDialog "Name cannot contain a comma!"
					WKey
					EraseMessage
				ELSEIF INSTR(NewGroup$, "/") THEN
					ErrorDialog "Name cannot contain a slash!"
					WKey
					EraseMessage
				ELSEIF INSTR(NewGroup$, "\") THEN
					ErrorDialog "Name cannot contain a backslash!"
					WKey
					EraseMessage
				ELSEIF INSTR(NewGroup$, "*") THEN
					ErrorDialog "Name cannot contain a star!"
					WKey
					EraseMessage
				ELSEIF INSTR(NewGroup$, "+") THEN
					ErrorDialog "Name cannot contain a plus sign!"
					WKey
					EraseMessage
				ELSE
					ErrorFlag = CreateGroup(NewGroup$, File$)

					IF ErrorFlag = 0 THEN
						OldOffset = Offset
						OldSelected = Selected
						Filename$ = LEFT$(NewGroup$, 8)
						IF INSTR(Filename$, " ") THEN Filename$ = LEFT$(Filename$, INSTR(Filename$, " ") - 1)
						Filename$ = Filename$ + GrpExt$

						InsertItem File$, Selected, Filename$, NewGroup$, "1", "0"
					END IF
				END IF
			END IF
			EXIT DO
		END IF

		IF k$ = CHR$(0) + CHR$(65) THEN
			IF INSTR(GetFileName$(File, Selected), GrpExt$) = 0 THEN
				OldOffset = Offset
				OldSelected = Selected
				GetEntry File, Grp, Selected
				NewDesc$ = Query$("      Enter a description for the file " + GetFileName$(File, Selected) + "     ", "%7&0 Description ", 50, RTRIM$(Grp.Desc))
				SeekItem File, Selected
				GET File, , Grp
				Grp.Desc = NewDesc$
				SeekItem File, Selected
				PUT File, , Grp
			END IF
		END IF




		IF k$ = CHR$(0) + CHR$(61) THEN
			Search$ = Query$("                    Enter a search string.                    ", "&0%7 Search ", 60, Search$)
			IF Search$ <> "" THEN
				FOR i = Selected + 1 TO Max + 1
					IF i = Max + 1 THEN
						ErrorDialog "Sorry, No (more) occurances found."
						WKey
						EraseMessage
						EXIT FOR
					END IF
					GetEntry File, Grp, i
					IF INSTR(UCASE$(LEFT$(Grp.Prog, INSTR(Grp.Prog, ".") - 1)), UCASE$(Search$)) THEN
						Offset = i
						Selected = i
						EXIT FOR
					END IF
					IF INSTR(UCASE$(Grp.Desc), UCASE$(Search$)) THEN
						Offset = i
						Selected = i
						EXIT FOR
					END IF
				NEXT
			END IF
		END IF

		IF k$ = CHR$(0) + CHR$(62) THEN
			OldOffset = Offset
			OldSelected = Selected
			CLOSE File
			NewFile$ = ViewTree$("Select a group file you wish to browse.") + GrpExt$
			IF NewFile$ <> GrpExt$ THEN
				Listbox$ = NewFile$
				EXIT DO
			ELSE
				Listbox$ = File$
				EXIT DO
			END IF
		END IF


		IF k$ = CHR$(0) + CHR$(83) THEN
			OldOffset = Offset
			OldSelected = Selected
			GetEntry File, Grp, Selected
			IF INSTR(Grp.Prog, GrpExt$) THEN
				Message "&EAre you sure you want to delete this group? &F[Y/N]", "%7&0 Delete "
				DO
					k$ = UCASE$(INKEY$)
				LOOP UNTIL k$ <> ""
				EraseMessage
				IF k$ = "Y" OR k$ = CHR$(13) THEN
					CLOSE File
					DeleteItem File$, Selected
					KILL RTRIM$(Grp.Prog)
					EXIT DO
				END IF
			ELSE
				Found = 0
				FOR i = 0 TO Max
					IF Selected(i) = 1 THEN Found = 1
				NEXT
				IF Found = 0 THEN
					ErrorDialog "No files tagged!"
					WKey
					EraseMessage
				ELSE
					Message "&EAre you sure you want to delete all tagged files from the database? &F[Y/N]", "%7&0 Delete "
					DO
						k$ = UCASE$(INKEY$)
					LOOP UNTIL k$ <> ""
					EraseMessage
					IF k$ = "Y" OR k$ = CHR$(13) THEN
						CLOSE File
						RemoveTagged File$
						EraseMessage
						NullBuffer Selected()
						EXIT DO
					END IF
				END IF
			END IF
		END IF


		IF k$ = " " THEN
			IF INSTR(GetFileName(File, Selected), GrpExt$) = 0 THEN
				k$ = ""
				Switch Selected(Selected), 1, 0
				Selected = Selected + 1
				IF Selected > Max THEN Selected = Max
				IF Selected > Offset + Lines - 7 THEN Offset = Offset + 1
			END IF
		END IF


		IF LEFT$(k$, 1) <> CHR$(0) THEN
			IF k$ <> LastSearchLetter$ THEN LastSearch = 0
			FOR i = LastSearch + 1 TO Max
				IF UCASE$(LEFT$(GetFileName$(File, i), 1)) = k$ THEN
					Offset = i
					Selected = i
					LastSearch = i
					LastSearchLetter$ = k$
					EXIT FOR
				END IF
			NEXT
		END IF

		IF k$ = CHR$(0) + CHR$(133) THEN
			Message "&EAre you sure? This will erase &Call&E current groups! &F[Y/N]", "%7&0 ReInitialize database "
			DO
				k$ = UCASE$(INKEY$)
			LOOP UNTIL k$ <> ""
			EraseMessage
			IF k$ = "Y" OR k$ = CHR$(13) THEN
				CLOSE File
				KILL "*" + GrpExt$
				ReCreate
				EXIT DO
			END IF
			k$ = ""
		END IF

		IF k$ = CHR$(0) + CHR$(64) THEN
			CLOSE File
			QueryFile File$
			EXIT DO
		END IF

		IF k$ = CHR$(0) + CHR$(24) THEN
			Options
			EXIT DO
		END IF


		IF k$ = CHR$(0) + CHR$(67) THEN
			Found = 0
			FOR i = 0 TO Max
				IF Selected(i) = 1 THEN Found = 1
			NEXT
			IF Found = 0 THEN
				ErrorDialog "No files tagged!"
				WKey
				EraseMessage
			ELSE
				CLOSE File
				Dest$ = ViewTree$("Select the destination group.") + GrpExt$
				OPEN File$ FOR BINARY AS File
				Message "Moving files to group " + Dest$, "%7&0 Move "
				IF Dest$ <> GrpExt$ THEN
					FOR i = 0 TO Max
						IF Selected(i) = 1 THEN
							GetEntry File, Grp, i
							CLOSE File
							AddItem Dest$, Grp.Prog, Grp.Desc, Grp.EntryType, Grp.Compiler
							OPEN File$ FOR BINARY AS File
						END IF
					NEXT
					CLOSE File
					IF KillDisk = True THEN
						KillDisk = False
						RemoveTagged File$
						KillDisk = True
					ELSE
						RemoveTagged File$
					END IF
					EraseMessage
					NullBuffer Selected()
					EXIT DO
				END IF
			END IF
		END IF

		IF k$ = CHR$(0) + CHR$(68) THEN
			Found = 0
			FOR i = 0 TO Max
				IF Selected(i) = 1 THEN Found = 1
			NEXT
			IF Found = 0 THEN
				ErrorDialog "No files tagged!"
				WKey
				EraseMessage
			ELSE
				CLOSE File
				Dest$ = ViewTree$("Select the destination group.") + GrpExt$
				OPEN File$ FOR BINARY AS File
				Message "Copying files to group " + Dest$, "%7&0 Copy "
				IF Dest$ <> GrpExt$ THEN
					FOR i = 0 TO Max
						IF Selected(i) = 1 THEN
							GetEntry File, Grp, i
							CLOSE File
							AddItem Dest$, Grp.Prog, Grp.Desc, Grp.EntryType, Grp.Compiler
							OPEN File$ FOR BINARY AS File
						END IF
					NEXT
					CLOSE File
					EraseMessage
					NullBuffer Selected()
					EXIT DO
				END IF
			END IF
		END IF

		IF k$ = CHR$(0) + CHR$(66) THEN
			Found = 0
			FOR i = 0 TO Max
				IF Selected(i) = 1 THEN Found = 1
			NEXT
			IF Found = 0 THEN
				ErrorDialog "No files tagged!"
				WKey
				EraseMessage
			ELSE
				GetEntry File, Grp, Selected
				ChooseCompiler File, VAL(Grp.Compiler)
			END IF
		END IF

		IF k$ = CHR$(0) + CHR$(134) THEN
			IF INSTR(GetFileName$(File, Selected), GrpExt$) = 0 THEN Info GetFileName$(File, Selected)
		END IF

'    LOCATE 1, 1: PRINT ASC(RIGHT$(k$, 1))
	 
		DrawListBox File, Offset, Selected, Max
	END IF

	COLOR 7, 0
	LOCATE Lines - 3, 70
	PRINT TIME$;

	COLOR 8
	LOCATE Lines - 3, 50
	ColPrint "[&7" + FormatNumber$(Selected + 1, 4, "0") + "&8/&7" + FormatNumber$(Max + 1, 4, "0") + "&8] "

LOOP
CLOSE File
OPEN File$ FOR BINARY AS File
GetEntry File, FileInfo, Selected
CLOSE File

END FUNCTION

SUB MapEMS (EMMhandle%, PhysicalPage%, LogicalPage%)

IF NOT MapEMSPages(EMMhandle%, PhysicalPage%, LogicalPage%) THEN
 ErrorDialog "Unable to map EMS Pages!"
 WKey
 IF NOT DeallocateEMSPages(EMMhandle%) THEN
	 ErrorDialog "Unable to deallocate EMS Pages!"
	 WKey
 END IF
 SYSTEM
END IF

END SUB

FUNCTION MapEMSPages (EMMhandle%, PhysicalPage%, LogicalPage%)
 DIM InRegs AS RegType, OutRegs AS RegType

 InRegs.ax = MapPages + (PhysicalPage% MOD 256)
 InRegs.bx = LogicalPage%
 InRegs.dx = EMMhandle%
 CALL INTERRUPT(EMMInt, InRegs, OutRegs)

 MapEMSPages = ((OutRegs.ax \ 256) = 0)
END FUNCTION

SUB Message (Text$, Topic$)
Row = CSRLIN
PCOPY 0, 2
DrawWindow 40 - RealLen(Text$) \ 2 - 2, Lines \ 2 - 2, 40 + RealLen(Text$) \ 2 + 3, Lines \ 2 + 2, 7, 4, Topic$, True
COLOR 15, 4
Center Text$, Lines \ 2
END SUB

SUB MHide ' Hides mouse (need i say more?)
 
 Regs.ax% = 2
 CALL INTERRUPT(&H33, Regs, Regs)

END SUB

FUNCTION MInit  ' Initializes mouse

 ' Returns -1 if mouse is present, 0 if it isn't

 Regs.ax% = 0
 CALL INTERRUPT(&H33, Regs, Regs)

 MInit = Regs.ax%

END FUNCTION

SUB MLoadCur (File$)

' Loads cursor from FILE$
' use CUREDIT.BAS to make addional cursors

cursor$ = ""
Z$ = ""
OPEN File$ FOR INPUT AS #1
 
INPUT #1, HotSpotX
INPUT #1, HotSpotY

	 FOR i = 1 TO 32
			INPUT #1, a$
			Z$ = "&H"
			FOR Z = 1 TO 16 STEP 4
			 x$ = MID$(a$, Z, 4)
			 x = (2 ^ LEN(x$)) / 2                  '\
			 N = 0                                  '|
			 FOR P = 1 TO LEN(x$)                   '|- Binary to Decimal routine
			 IF MID$(x$, P, 1) = "1" THEN N = N + x '|
			 x = x / 2                              '|
			 NEXT P                                 '/
			 Z$ = Z$ + HEX$(N)
			NEXT Z
			cursor$ = cursor$ + MKI$(VAL(Z$))       ' puts cursor info
	 NEXT                                       ' in memory
	 CLOSE

	 Regs.ax% = 9
	 Regs.bx% = HotSpotX
	 Regs.cx% = HotSpotY
	 Regs.dx% = SADD(cursor$)      ' address of cursor image
	 CALL INTERRUPT(&H33, Regs, Regs)

END SUB

SUB MPressInfo (Button, PressCount, PressX, PressY)

' Button =0: query button 1
' Button =1: query button 2
' PressCount is the # of clicks since last call
' PressX and PressY are horizontal and vertical position
' of cursor at last click

 Regs.ax% = 5
 Regs.bx% = Button
 
 CALL INTERRUPT(&H33, Regs, Regs)
 PressCount = Regs.bx%
 PressX = Regs.cx%
 PressY = Regs.dx%

END SUB

SUB MReleseInfo (Button, ReleseCount, ReleseX, ReleseY)

' Button =0: query button 1
' Button =1: query button 2
' ReleseCount is the # of releses since last call
' ReleseX and ReleseY are horizontal and vertical position
' of cursor at last relese

 Regs.ax% = 6
 Regs.bx% = Button
 
 CALL INTERRUPT(&H33, Regs, Regs)
 ReleseCount = Regs.bx%
 ReleseX = Regs.cx%
 ReleseY = Regs.dx%

END SUB

SUB MRelLastPos (RX, RY)

 ' Returns location of mouse relative to last postion
 ' i.e., if both numbers are negitive, the mouse moved
 ' left & up; positive, down & right
 ' (A use for SGN()! See Demo4 )
				 
 Regs.ax% = 11
 CALL INTERRUPT(&H33, Regs, Regs)
 RX = Regs.cx%
 RY = Regs.dx%
	
END SUB

SUB MSetPos (x, y)

 ' Sets mouse position
 ' X = horizontal mouse positon
 ' Y = vertical mouse position

 Regs.ax% = 4
 Regs.cx% = x
 Regs.dx% = y
 CALL INTERRUPT(&H33, Regs, Regs)
 
END SUB

SUB MSetRange (x1, x2, Y1, y2)

 ' Sets mouse range (like LINE)
 ' X1, Y1 = top, left-hand corner of limits
 ' X2, Y2 = bottom, right-hand corner of limits

 Regs.ax% = 7
 Regs.cx% = x1
 Regs.dx% = Y1
 CALL INTERRUPT(&H33, Regs, Regs)
 Regs.ax% = 8
 Regs.cx% = x2
 Regs.dx% = y2
 CALL INTERRUPT(&H33, Regs, Regs)

END SUB

SUB MShow

 ' Shows mouse & waits for vert. retrace (reduces flicker)

 Regs.ax% = 1
 CALL INTERRUPT(&H33, Regs, Reg)
 WAIT &H3DA, 8
 WAIT &H3DA, 8, 8
END SUB

SUB MStatus (x, y, B1, B2)

 ' Returns location of mouse & status of buttons

 Regs.ax% = 3
 CALL INTERRUPT(&H33, Regs, Regs)
 x = Regs.cx%
 y = Regs.dx%
 B1 = (Regs.bx% AND 1) <> 0
 B2 = (Regs.bx% AND 2) <> 0
END SUB

SUB NullBuffer (Array())
FOR i = 0 TO UBOUND(Array)
	Array(i) = 0
NEXT
END SUB

SUB Options
CLOSE #1
PCOPY 0, 2
DrawWindow 4, 3, 76, 17, 7, 0, "&0%7 Options ", True
COLOR 14, 0
Selected = 1
LOCATE 5, 8: COLOR 15, 4: PRINT " ž Screen lines:", , Lines
LOCATE 6, 8: COLOR 7, 0: PRINT " ž Kill files from disk:", : IF KillDisk = True THEN PRINT "Yes " ELSE PRINT " No "

COLOR 14, 0
Center "Space/Enter - Toggle option     ESC - Exit & Save", 15


COLOR 7
SELECT CASE Selected
CASE 1
	LOCATE 10, 8: PRINT "Toggle number of screen vertical lines (25/43/50)        "
	LOCATE 11, 8: PRINT "                                                         "
CASE 2
	LOCATE 10, 8: PRINT "If Yes, then files that are deleted from the archive will"
	LOCATE 11, 8: PRINT "be deleted from the disk too."
END SELECT


DO
	k$ = INKEY$
	IF k$ <> "" THEN

		IF k$ = Kd$ THEN
			Selected = Selected + 1
			IF Selected = 3 THEN Selected = 2
		END IF

		IF k$ = Ku$ THEN
			Selected = Selected - 1
			IF Selected = 0 THEN Selected = 1
		END IF

		IF k$ = CHR$(0) + CHR$(59) THEN
			Help 52
		END IF
	
		IF k$ = CHR$(27) THEN EXIT DO
	 
		IF k$ = CHR$(13) OR k$ = CHR$(32) THEN
			SELECT CASE Selected
			CASE 1
				SELECT CASE Lines
				CASE 50
					Lines = 25
				CASE 43
					Lines = 50
				CASE 25
					Lines = 43
				END SELECT
			CASE 2
				SELECT CASE KillDisk
				CASE True
					KillDisk = False
				CASE False
					KillDisk = True
				END SELECT
			END SELECT
		END IF

		SELECT CASE Selected
		CASE 1
			LOCATE 5, 8: COLOR 15, 4: PRINT " ž Screen lines:", , Lines
			LOCATE 6, 8: COLOR 7, 0: PRINT " ž Kill files from disk:", : IF KillDisk = True THEN PRINT "Yes " ELSE PRINT " No "
		CASE 2
			LOCATE 5, 8: COLOR 7, 0: PRINT " ž Screen lines:", , Lines
			LOCATE 6, 8: COLOR 15, 4: PRINT " ž Kill files from disk:", : IF KillDisk = True THEN PRINT "Yes " ELSE PRINT " No "
		END SELECT

		COLOR 7, 0
		SELECT CASE Selected
		CASE 1
			LOCATE 10, 8: PRINT "Toggle number of screen vertical lines (25/43/50)        "
			LOCATE 11, 8: PRINT "                                                         "
		CASE 2
			LOCATE 10, 8: PRINT "If Yes, then files that are deleted from the archive will"
			LOCATE 11, 8: PRINT "be deleted from the disk too."
		END SELECT
 
	END IF
LOOP

SCREEN 0: CLS
WIDTH 80, Lines
LOCATE 1, 1, 0


Cfg.Lines = Lines
Cfg.KillDisk = KillDisk
OPEN "qbase.ini" FOR BINARY AS #1
PUT #1, , Cfg
CLOSE #1

EraseMessage

END SUB

FUNCTION PopStack$ (Stack$())
PopStack$ = Stack$(1)
FOR i = 0 TO UBOUND(Stack$) - 1
	Stack$(i) = Stack$(i + 1)
NEXT
END FUNCTION

SUB PushStack (Name$, Stack$())
FOR i = UBOUND(Stack$) TO 1 STEP -1
	Stack$(i) = Stack$(i - 1)
NEXT
Stack$(1) = Name$
END SUB

FUNCTION Query$ (Text$, Topic$, MaxLen, TField$)

Row = CSRLIN
PCOPY 0, 2
DrawWindow 40 - RealLen(Text$) \ 2 - 2, Lines \ 2 - 3, 40 + RealLen(Text$) \ 2 + 3, Lines \ 2 + 3, 7, 4, Topic$, True
COLOR 15, 4
Center Text$, Lines \ 2 - 1

COLOR 0, 3
LOCATE Lines \ 2 + 1, 40 - MaxLen \ 2
PRINT STRING$(MaxLen + 1, " ");

TextField$ = LEFT$(TField$, MaxLen)
TPos = LEN(TextField$)


COLOR 0, 4
LOCATE Lines \ 2 + 2, 40 - MaxLen \ 2 + 1
PRINT STRING$(MaxLen + 1, "ß")
LOCATE Lines \ 2 + 1, 40 + MaxLen \ 2 + 1
PRINT "Ü"

COLOR 0, 3
LOCATE Lines \ 2 + 1, 40 - MaxLen \ 2
PRINT InputField(TextField$, k$, MaxLen, TPos); " ";
LOCATE Lines \ 2 + 1, 40 - MaxLen \ 2 + TPos, 1, 29, 30

DO
	k$ = INKEY$
	IF k$ = CHR$(13) THEN EXIT DO
	IF k$ = CHR$(27) THEN TextField$ = "": EXIT DO
	IF k$ <> "" THEN
		LOCATE Lines \ 2 + 1, 40 - MaxLen \ 2
		COLOR 0, 3
		PRINT InputField(TextField$, k$, MaxLen, TPos); " ";
		LOCATE Lines \ 2 + 1, 40 - MaxLen \ 2 + TPos, 1, 29, 30
	END IF
LOOP

LOCATE 1, 1, 0
Query$ = LTRIM$(RTRIM$(TextField$))
EraseMessage

END FUNCTION

SUB QueryFile (Main$)
WCard$ = Query$("  Enter a wildcard  ", "%7&0 Insert program ", 12, "*.BAS")
EraseMessage
IF WCard$ = "" THEN EXIT SUB
IF INSTR(WCard$, "\") OR INSTR(WCard$, ":") THEN
	ErrorDialog "Must be in current directory!"
	WKey
	EraseMessage
	EXIT SUB
END IF

Max = ScanDir(WCard$, "temp.tmp")

IF Max = 0 THEN
	ErrorDialog "No files found!"
	WKey
	EraseMessage
	EXIT SUB
END IF

Offset = 0
Selected = 0


OPEN "temp.tmp" FOR INPUT AS #1
OPEN "temp2.tmp" FOR OUTPUT AS #2

FOR i = 1 TO Max
	LINE INPUT #1, Temp$
	Temp$ = Temp$ + STRING$(12 - LEN(Temp$), " ")
	PRINT #2, Temp$;
NEXT
CLOSE
KILL "temp.tmp"
NAME "temp2.tmp" AS "temp.tmp"

DrawWindow 15, 2, 32, Lines - 3, 7, 4, "%7&0 Files ", True
LOCATE Lines - 1
COLOR 0, 3
PRINT STRING$(80, " ");
LOCATE Lines, 1
PRINT STRING$(80, " ");
Center " &ESpace&0-Select/Unselect   &EEsc&0-Cancel   &EEnter&0-Engage!", Lines

File = FREEFILE
OPEN "temp.tmp" FOR BINARY AS #File

NullBuffer Buffer()
DrawFileList File, Selected, Offset, Max

DO
	k$ = INKEY$
	IF k$ <> "" THEN
	
		IF k$ = Kd$ THEN
			Selected = Selected + 1
			IF Selected > Max - 1 THEN Selected = Max - 1
			IF Selected > Offset + Lines - 7 THEN Offset = Offset + 1
		END IF

		IF k$ = Ku$ THEN
			Selected = Selected - 1
			IF Selected < 0 THEN Selected = 0
			IF Selected < Offset THEN Offset = Offset - 1
			IF Offset < 0 THEN Offset = 0
		END IF

		IF k$ = CHR$(0) + CHR$(81) THEN
			Selected = Selected + (Lines - 7)
			Offset = Offset + (Lines - 7)
			IF Selected > Max - 1 THEN Selected = Max - 1
			IF Offset > Max - 1 THEN Offset = Max - 1
		END IF


		IF k$ = CHR$(0) + CHR$(73) THEN
			Selected = Selected - (Lines - 7)
			Offset = Offset - (Lines - 7)
			IF Selected < 0 THEN Selected = 0
			IF Offset < 0 THEN Offset = 0
		END IF


		IF k$ = CHR$(0) + CHR$(79) THEN
			Offset = Max - (Lines - 7) - 1
			IF Offset < 0 THEN Offset = 0
			Selected = Max - 1
		END IF

		IF k$ = CHR$(0) + CHR$(71) THEN
			Offset = 0
			Selected = 0
		END IF
	 
	 
		IF k$ = " " THEN
			k$ = ""
			Switch Buffer(Selected), 1, 0
			Selected = Selected + 1
			IF Selected > Max - 1 THEN Selected = Max - 1
			IF Selected > Offset + Lines - 7 THEN Offset = Offset + 1
		END IF

	 
		IF k$ = CHR$(13) THEN
			Found = 0
			FOR i = 0 TO Max
				IF Buffer(i) THEN Found = 1
			NEXT
			IF Found = 0 THEN
				ErrorDialog "No files tagged!"
				WKey
				EraseMessage
			ELSE
				SeekFileItem File, 0
				FOR i = 1 TO Max
					GET #File, , FList
					IF Buffer(i - 1) = 1 THEN
						AddItem Main$, FList, "", "2", "1"
					END IF
				NEXT
				CLOSE #File
				EXIT DO
			END IF
		END IF

		IF k$ = CHR$(27) THEN
			EXIT DO
		END IF
		DrawFileList File, Offset, Selected, Max

	END IF


LOOP
CLOSE
KILL "temp.tmp"


END SUB

SUB ReadFiles2EMS (File)

Items = CountItems2(File)

FOR i = 0 TO Items
	SeekItem File, i
	GET File, , Grp
	File$ = UCASE$(Grp.Prog)
	IF INSTR(File$, ".") > 0 THEN File$ = LEFT$(File$, INSTR(File$, ".") - 1)
	File$ = File$ + STRING$(8 - LEN(File$), " ")
	FileToEms File$, i
NEXT

END SUB

FUNCTION RealLen (Text$)

Ln = LEN(Text$)
FOR i = 1 TO LEN(Text$)
	Done = 0
	DO
		IF MID$(Text$, i, 1) = "&" AND INSTR("0123456789ABCDEF", MID$(Text$, i + 1, 1)) AND i < LEN(Text$) THEN
			Ln = Ln - 2
			i = i + 2
		ELSEIF MID$(Text$, i, 1) = "%" AND INSTR("01234567", MID$(Text$, i + 1, 1)) AND i < LEN(Text$) THEN
			Ln = Ln - 2
			i = i + 2
		ELSE
			Done = 1
		END IF
	LOOP UNTIL Done
NEXT
RealLen = Ln

END FUNCTION

SUB ReCreate
	DrawWindow 20, 8, 60, 17, 7, 4, "&0%7 Initilizing group files ", True
	COLOR 15, 4
	LOCATE 10, 22
	WPrint 22, "Using file MAIN" + GrpExt$
	PRINT

	WPrint 22, "Creating main directory..."
	ErrorFlag = CreateGroup("Main", "MAIN" + GrpExt$)
	ErrorFlag = CreateGroup("Programs", "MAIN" + GrpExt$)
	AddItem "Main" + GrpExt$, "PROGRAMS" + GrpExt$, "Programs", "1", "0"

	COLOR 15, 4
	WPrint 22, "Scanning directory..."
	Found = ScanDir("*.BAS", "temp.tmp")
	IF Found = 0 THEN
		WPrint 22, "&ENo Basic files found!"
		SYSTEM
	END IF
	WPrint 22, "&E" + LTRIM$(STR$(Found)) + "&F Basic source files found."
	OPEN "temp.tmp" FOR INPUT AS #1
	COLOR 0, 4
	LOCATE 16, 22
	PRINT STRING$(36, "ž");
	COLOR 10, 4
	FOR i = 0 TO Found - 1
		INPUT #1, File$
		AddItem "PROGRAMS" + GrpExt$, File$, "", "2", "0"
		LOCATE 16, 22
		PRINT STRING$(i / Found * 36, "ž");
	NEXT
	LOCATE 16, 22
	PRINT STRING$(36, "ž");
	CLOSE #1
	KILL "temp.tmp"
	SortGroup "PROGRAMS" + GrpExt$
END SUB

SUB RemoveTagged (File$)

IF Exist(File$) = False THEN
	ErrorDialog "Group file " + File$ + " not found!"
	WKey
	EraseMessage
	EXIT SUB
END IF

OPEN "temp.tmp" FOR BINARY AS #2
File = FREEFILE

OPEN File$ FOR BINARY AS File

GET #File, , Header
PUT #2, , Header

DIM Temp AS GrpEntry
					 
					 
Message "                         ", "%7&0 Deleting "
LOCATE Lines \ 2, 40 - 10
COLOR 0, 4
PRINT STRING$(20, "ž")

COLOR 10, 4
Max = CountItems2(File)
FOR i = 0 TO Max
	IF Selected(i) = 0 THEN
		SeekItem File, i
		GET #File, , Temp
		PUT #2, , Temp
	ELSEIF Selected(i) = 1 THEN
		IF KillDisk = True THEN
			KillFile$ = GetFileName$(File, i)
			IF Exist(RTRIM$(KillFile$)) THEN KILL RTRIM$(KillFile$)
		END IF
	END IF
	LOCATE Lines \ 2, 40 - 10
	PRINT STRING$((i + 1) / (Max + 1) * 20, "ž")
NEXT

CLOSE #2, File
KILL File$
NAME "temp.tmp" AS File$
EraseMessage

END SUB

SUB Roller (x, y, XLen, Text$, FCol, BCol, RollerPos, RollerCount) STATIC

RollerCount = RollerCount + 1

IF RollerCount >= 3200 THEN
	LOCATE y, x
	COLOR FCol, BCol
	IF RollerPos = 0 THEN RollerPos = 1
	TText$ = SPACE$(XLen) + Text$
	PRINT MID$(TText$, RollerPos, XLen) + STRING$(XLen - LEN(MID$(TText$, RollerPos, XLen)), " ");
	RollerPos = RollerPos + 1
	IF RollerPos > LEN(TText$) THEN RollerPos = 1
	RollerCount = 0
END IF

END SUB

FUNCTION ScanDir (FileSpec$, Output$)

File = FREEFILE
OPEN Output$ FOR OUTPUT AS File

File$ = LTRIM$(RTRIM$(DirFirst$(FileSpec$, F.NOR)))
IF File$ = "" THEN Found = 0 ELSE Found = 1
PRINT #File, File$

DO
	File$ = LTRIM$(RTRIM$(DirNext$))
	IF File$ = "" THEN EXIT DO
	PRINT #File, File$
	Found = Found + 1
LOOP
CLOSE File
ScanDir = Found

END FUNCTION

SUB SeekFileItem (File, Item)
SEEK #File, (Item) * 12 + 1
END SUB

SUB SeekItem (File, Item)
TempItem& = Item
SEEK File, TempItem& * 64& + HeaderLen + 1&
END SUB

SUB SeekLine (File, Item)
IF Item = 0 THEN
	SEEK File, 1
ELSE
	SEEK File, (Item + 1) * 80
END IF

END SUB

SUB SetDTA (FileInfo AS DOSFileInfo)
'----------------------------------------------------------------------
' Sets up FileInfo as Disk Transfer Area
'----------------------------------------------------------------------
	DIM Reg AS RegTypeX
	Reg.ax = &H1A00
	Reg.ds = VARSEG(FileInfo)
	Reg.dx = VARPTR(FileInfo)
	CALL InterruptX(&H21, Reg, Reg)
END SUB

SUB SortGroup (Filename$)

IF NOT Exist(Filename$) = True THEN
	ErrorDialog "Unable to sort file!"
	WKey
	EraseMessage
	EXIT SUB
END IF

PCOPY 0, 1
DrawWindow 4, 1, 76, 5, 7, 4, "%7&0 Sorting group " + Filename$ + " ", True

LOCATE 3, 6
COLOR 0, 4
PRINT STRING$(68, "ž");

NullBuffer Buffer()

IF Exist("temp.tmp") = True THEN KILL "temp.tmp"
OPEN "temp.tmp" FOR BINARY AS #1

File = FREEFILE
OPEN Filename$ FOR BINARY AS #File

GET #File, , Header
PUT #1, , Header

Items = CountItems2(File)
IF Items <= 1 THEN
	CLOSE
	ErrorDialog "Nothing to sort!"
	WKey
	EraseMessage
	EXIT SUB
END IF

IF Items > 2047 THEN
	CLOSE
	ErrorDialog "Too many files in group!"
	WKey
	EraseMessage
	EXIT SUB
END IF

DIM a AS GrpEntry
DIM b AS GrpEntry

COLOR 10, 4

ReadFiles2EMS File

FOR i = 0 TO 2047
	Buffer(i) = i
NEXT

FOR ii = 0 TO Items
	FOR i = 0 TO Items - 1
		File1$ = FileFromEms$(Buffer(i))
		File2$ = FileFromEms$(Buffer(i + 1))
		IF File1$ > File2$ THEN
			SWAP Buffer(i), Buffer(i + 1)
			i = i + 1
		END IF
	NEXT

	LOCATE 3, 6
	PRINT STRING$(ii / Items * 68, "ž");
NEXT

FOR i = 0 TO Items
	SeekItem File, Buffer(i)
	GET #File, , Grp
	PUT #1, , Grp
NEXT
CLOSE
KILL Filename$
NAME "temp.tmp" AS Filename$

NullBuffer Buffer()

OPEN "temp.tmp" FOR BINARY AS #1
File = FREEFILE
OPEN Filename$ FOR BINARY AS #File
PUT #1, , Header

FOR i = 0 TO Items
	SeekItem File, i
	GET #File, , Grp
	File$ = Grp.Prog
	File$ = LTRIM$(RTRIM$(UCASE$(File$)))
	IF RIGHT$(File$, 4) = GrpExt$ THEN
		Buffer(i) = 1
		PUT #1, , Grp
	END IF
NEXT

FOR i = 0 TO Items
	IF Buffer(i) = 0 THEN
		SeekItem File, i
		GET #File, , Grp
		PUT #1, , Grp
	END IF
NEXT
CLOSE #1
CLOSE File

KILL Filename$
NAME "temp.tmp" AS Filename$

PCOPY 1, 0

END SUB

SUB Switch (Var, Value1, Value2)
'----------------------------------------------------------------------------
'                           Switches values
'----------------------------------------------------------------------------
'
'     Var - Variable to be changed
'  Value1 - Value 1
'  Value2 - Value 2
'
'----------------------------------------------------------------------------
'
' if Var = Value1 then Value2 will be assigned to Var
'
' if Var = Value2 then Value1 will be assigned to Var
'
'----------------------------------------------------------------------------


IF Var = Value1 THEN Var = Value2: EXIT SUB
IF Var = Value2 THEN Var = Value1

END SUB

FUNCTION Trim$ (Number)
'-------------------------------------------------------------------
'  Converts integer numbers into strings and removes null padding
'-------------------------------------------------------------------
Trim$ = LTRIM$(RTRIM$(STR$(Number)))

END FUNCTION

SUB ViewFile (File$, me$)
me$ = RTRIM$(me$)

IF Exist(File$) = False THEN
	ErrorDialog "File " + File$ + " not found!"
	WKey
	EraseMessage
	EXIT SUB
END IF

OPEN File$ FOR BINARY AS #1
Temp$ = SPACE$(1)
GET #1, , Temp$
CLOSE

IF Temp$ = CHR$(252) THEN
	ErrorDialog "This file is probably a QB compressed file!"
	WKey
	EraseMessage
	EXIT SUB
END IF

PCOPY 0, 1
DrawWindow 4, 1, 76, 5, 7, 4, "%7&0 Reading file " + File$ + " ", True

LOCATE 3, 6
COLOR 0, 4
PRINT STRING$(68, "ž");

DIM LinePos(0 TO 16000) AS LONG

FLines = CountLines(File$)
IF FLines > 16000 THEN
	ErrorDialog "Too many lines in file, only first 16000 will be read!"
	WKey
	EraseMessage
	PCOPY 0, 1
	FLines = 16000
END IF

COLOR 10, 4
Count = 0
OPEN File$ FOR INPUT AS #1

LinePos(0) = 1
DO
	IF EOF(1) OR Count = 16001 THEN EXIT DO
	LINE INPUT #1, Ln$
	Count = Count + 1
	LinePos(Count) = SEEK(1)

	IF Count MOD 100 = 0 THEN
		LOCATE 3, 6
		PRINT STRING$(SEEK(1) / LOF(1) * 68, "ž");
	END IF
LOOP
CLOSE #1
EraseMessage

File = FREEFILE
OPEN File$ FOR INPUT AS File
DrawWindow 1, 1, 81, Lines - 1, 15, 7, "&4%7 " + File$ + " ", False

XPos = 1
COLOR 15, 7

COLOR 0, 7
LOCATE Lines - 1, 3
PRINT STRING$(76, "°");

FOR i = 3 TO Lines - 3
	LOCATE i, 80
	PRINT "°";
NEXT

HBlock = 3
VBlock = 3

COLOR 0, 7
LOCATE HBlock, 80
PRINT "Ū";
LOCATE Lines - 1, VBlock
PRINT "Ū";

LOCATE 2, 80
PRINT CHR$(24);
LOCATE Lines - 2, 80
PRINT CHR$(25)

LOCATE Lines - 1, 2
PRINT CHR$(27);
LOCATE Lines - 1, 79
PRINT CHR$(26);

COLOR 8, 7
FOR i = 2 TO Lines - 2
	LOCATE i, 2
	IF NOT EOF(File) THEN
		LINE INPUT #1, Temp$
		Ln$ = ""
		FOR ii = 1 TO LEN(Temp$)
			IF MID$(Temp$, ii, 1) = CHR$(9) THEN Ln$ = Ln$ + "  " ELSE Ln$ = Ln$ + MID$(Temp$, ii, 1)
		NEXT
	ELSE
		FOR ii = i TO Lines - 2
			LOCATE ii, 2
			PRINT STRING$(78, " ");
		NEXT
		EXIT FOR
	END IF
	IF INSTR(Ln$, "REM") OR INSTR(Ln$, "'") THEN
		IF INSTR(UCASE$(Ln$), "'") AND INSTR(Ln$, "'") < XPos + 78 THEN
			IF INSTR(Ln$, "'") < XPos THEN
				COLOR 14
				PRINT MID$(Ln$, XPos, 78);
				PRINT STRING$(78 - LEN(MID$(Ln$, XPos, 78)), " ");
			ELSE
				COLOR 8
				PRINT MID$(Ln$, XPos, INSTR(Ln$, "'") - XPos);
				COLOR 14
				PRINT MID$(Ln$, INSTR(Ln$, "'"), XPos + 78 - INSTR(Ln$, "'"));
				IF POS(1) < 80 THEN PRINT STRING$(80 - POS(1), " ");
			END IF
		ELSEIF INSTR(UCASE$(Ln$), " REM") AND INSTR(UCASE$(Ln$), " REM") < XPos + 78 THEN
			IF INSTR(UCASE$(Ln$), " REM") < XPos THEN
				COLOR 14
				PRINT MID$(Ln$, XPos, 78);
				PRINT STRING$(78 - LEN(MID$(Ln$, XPos, 78)), " ");
			ELSE
				COLOR 8
				PRINT MID$(Ln$, XPos, INSTR(UCASE$(Ln$), " REM") - XPos);
				COLOR 14
				PRINT MID$(Ln$, INSTR(UCASE$(Ln$), " REM"), XPos + 78 - INSTR(UCASE$(Ln$), " REM"));
				IF POS(1) < 80 THEN PRINT STRING$(80 - POS(1), " ");
			END IF
		END IF

	ELSE
		COLOR 8
		PRINT MID$(Ln$, XPos, 78);
		PRINT STRING$(78 - LEN(MID$(Ln$, XPos, 78)), " ");
	END IF
NEXT

COLOR 0, 3
LOCATE Lines, 1
PRINT STRING$(80, " ");
LOCATE Lines, 1
ColPrint " &EF1&0-Help  &EF3&0-Search   &EEsc&0-Back   &0³"

COLOR 0, 3
LOCATE Lines, 69
PRINT "["; FormatNumber$(INT(FilePos&), 5, "0"); ":";
PRINT FormatNumber$(INT(XPos), 3, "0"); "]";

DO
	k$ = INKEY$
	Roller 35, Lines, 30, me$, 0, 3, RollerPos, RollerCount
	IF k$ <> "" THEN

		IF k$ = Kd$ THEN
			FilePos& = FilePos& + 1
			IF FilePos& > FLines THEN FilePos& = FLines
		END IF

		IF k$ = Ku$ THEN
			FilePos& = FilePos& - 1
			IF FilePos& < 0 THEN FilePos& = 0
		END IF

		IF k$ = Kr$ THEN
			XPos = XPos + 4
			IF XPos > 175 THEN XPos = 175
		END IF

		IF k$ = Kl$ THEN
			XPos = XPos - 4
			IF XPos < 1 THEN XPos = 1
		END IF

		IF k$ = CHR$(0) + CHR$(59) THEN
			Help 56
		END IF
	 
		IF k$ = CHR$(0) + CHR$(81) THEN
			FilePos& = FilePos& + (Lines - 2)
			IF FilePos& > FLines THEN FilePos& = FLines
		END IF

		IF k$ = CHR$(0) + CHR$(73) THEN
			FilePos& = FilePos& - (Lines - 2)
			IF FilePos& < 0 THEN FilePos& = 0
		END IF

		IF k$ = CHR$(0) + CHR$(79) THEN
			FilePos& = FLines - (Lines - 2)
		END IF

		IF k$ = CHR$(0) + CHR$(71) THEN
			FilePos& = 0
		END IF

		IF k$ = CHR$(27) THEN EXIT DO


		IF k$ = CHR$(0) + CHR$(61) AND FilePos& < FLines THEN
			SEEK #File, LinePos(FilePos& + 1)
			Search$ = Query$("                    Enter a search string.                    ", "&0%7 Search ", 60, Search$)
			EraseMessage
			IF Search$ <> "" THEN
				COLOR 14, 3
				LOCATE Lines, 35
				PRINT STRING$(46, " ");
				LOCATE Lines, 65
				PRINT "Searching...";
				Ln& = FilePos&
				Found& = 0
				DO UNTIL EOF(1)
					LINE INPUT #File, Ln$
					Ln& = Ln& + 1
					IF INSTR(UCASE$(Ln$), UCASE$(Search$)) THEN Found& = Ln&: EXIT DO
				LOOP
				IF Found& = 0 THEN
					ErrorDialog "Sorry, No (more) occurances found."
					WKey
					EraseMessage
				ELSE
					FilePos& = Found&
				END IF
				COLOR 14, 3
				LOCATE Lines, 35
				PRINT STRING$(46, " ");
			END IF
		END IF

		SEEK #File, LinePos(FilePos&)

		COLOR 15, 7
		FOR i = 2 TO Lines - 2
			LOCATE i, 2
			IF NOT EOF(File) THEN
				LINE INPUT #1, Temp$
				Ln$ = ""
				FOR ii = 1 TO LEN(Temp$)
					IF MID$(Temp$, ii, 1) = CHR$(9) THEN Ln$ = Ln$ + "  " ELSE Ln$ = Ln$ + MID$(Temp$, ii, 1)
				NEXT
			ELSE
				FOR ii = i TO Lines - 2
					LOCATE ii, 2
					PRINT STRING$(78, " ");
				NEXT
				EXIT FOR
			END IF
			IF INSTR(Ln$, "REM") OR INSTR(Ln$, "'") THEN
				IF INSTR(UCASE$(Ln$), "'") AND INSTR(Ln$, "'") < XPos + 78 THEN
					IF INSTR(Ln$, "'") < XPos THEN
						COLOR 14
						PRINT MID$(Ln$, XPos, 78);
						PRINT STRING$(78 - LEN(MID$(Ln$, XPos, 78)), " ");
					ELSE
						COLOR 8
						PRINT MID$(Ln$, XPos, INSTR(Ln$, "'") - XPos);
						COLOR 14
						PRINT MID$(Ln$, INSTR(Ln$, "'"), XPos + 78 - INSTR(Ln$, "'"));
						IF POS(1) < 80 THEN PRINT STRING$(80 - POS(1), " ");
					END IF
				ELSEIF INSTR(UCASE$(Ln$), " REM") AND INSTR(UCASE$(Ln$), " REM") < XPos + 78 THEN
					IF INSTR(UCASE$(Ln$), " REM") < XPos THEN
						COLOR 14
						PRINT MID$(Ln$, XPos, 78);
						PRINT STRING$(78 - LEN(MID$(Ln$, XPos, 78)), " ");
					ELSE
						COLOR 8
						PRINT MID$(Ln$, XPos, INSTR(UCASE$(Ln$), " REM") - XPos);
						COLOR 14
						PRINT MID$(Ln$, INSTR(UCASE$(Ln$), " REM"), XPos + 78 - INSTR(UCASE$(Ln$), " REM"));
						IF POS(1) < 80 THEN PRINT STRING$(80 - POS(1), " ");
					END IF
				END IF

			ELSE
				COLOR 8
				PRINT MID$(Ln$, XPos, 78);
				PRINT STRING$(78 - LEN(MID$(Ln$, XPos, 78)), " ");
			END IF
		NEXT

		OldHBlock = HBlock
		OldVBlock = VBlock

		HBlock = (LinePos(FilePos&) + 1) / (LOF(1) + 1) * (Lines - 6) + 3
		VBlock = XPos / 175 * 75 + 3

		COLOR 0, 7
		IF HBlock <> OldHBlock THEN
			LOCATE OldHBlock, 80
			PRINT "°";
			LOCATE HBlock, 80
			PRINT "Ū";
		END IF

		IF VBlock <> OldVBlock THEN
			LOCATE Lines - 1, OldVBlock
			PRINT "°";
			LOCATE Lines - 1, VBlock
			PRINT "Ū";
		END IF

		COLOR 0, 3
		LOCATE Lines, 69
		PRINT "["; FormatNumber$(INT(FilePos&), 5, "0"); ":";
		PRINT FormatNumber$(INT(XPos), 3, "0"); "]";
	END IF
LOOP
CLOSE

END SUB

FUNCTION ViewTree$ (Text$)
GenerateTree
PCOPY 0, 1
COLOR 7, 0
CLS

OPEN "temp.tmp" FOR INPUT AS #1
OPEN "temp2.tmp" FOR OUTPUT AS #2

Max = 0
DO
	IF EOF(1) THEN EXIT DO
	LINE INPUT #1, Ln$
	Max = Max + 1
	PRINT #2, Ln$ + STRING$(79 - LEN(Ln$), " ")
LOOP
CLOSE #1
CLOSE #2
KILL "temp.tmp"
NAME "temp2.tmp" AS "temp.tmp"

Offset = 0
Selected = 1

File = FREEFILE
OPEN "temp.tmp" FOR INPUT AS #File
COLOR 0, 3
LOCATE Lines, 1
PRINT SPACE$(80);
Center Text$, Lines
COLOR 7, 0


DrawTree File, Selected, Offset

DO
	k$ = INKEY$
	IF k$ <> "" THEN
	 
		IF k$ = Kd$ THEN
			Selected = Selected + 2
			IF Selected > Max - 2 THEN Selected = Max - 2
			IF Selected > Offset + Lines - 4 THEN Offset = Offset + 2
		END IF

		IF k$ = Ku$ THEN
			Selected = Selected - 2
			IF Selected < 1 THEN Selected = 1
			IF Selected < Offset THEN Offset = Offset - 2
			IF Offset < 0 THEN Offset = 0
		END IF

		IF k$ = CHR$(13) THEN
			SeekLine File, Selected - 1
			Ln$ = SPACE$(79)
			DO
				LINE INPUT #File, Ln$
			LOOP UNTIL INSTR(Ln$, "Ü")
			Ln$ = MID$(Ln$, INSTR(Ln$, "&A%1") + 4, 8)
			Ln$ = RTRIM$(Ln$)
			ViewTree$ = Ln$
			EXIT DO
		END IF

		IF k$ = CHR$(27) THEN
			EXIT DO
		END IF

		DrawTree File, Selected, Offset
		
	END IF
LOOP

CLOSE File
KILL "temp.tmp"
EraseMessage
END FUNCTION

SUB WKey
DO: LOOP UNTIL INKEY$ <> ""
END SUB

SUB WPrint (x1, Text$)

LOCATE , x1
ColPrint Text$
PRINT

END SUB